From 05703a27fabd65862bb13f282883277319479362 Mon Sep 17 00:00:00 2001
From: Scott Richmond <kredati@users.noreply.github.com>
Date: Mon, 29 Apr 2024 18:38:08 -0400
Subject: [PATCH] complete simple expressions

---
 janet/recursive.janet | 252 +++++++++++++++++++++++++++++++++++++++---
 janet/scanner.janet   |   2 +-
 2 files changed, 235 insertions(+), 19 deletions(-)

diff --git a/janet/recursive.janet b/janet/recursive.janet
index f01b433..11659ae 100644
--- a/janet/recursive.janet
+++ b/janet/recursive.janet
@@ -4,7 +4,7 @@
 ### First, some mutual recursion helpers
 (defn unreachable 
  "A function that errors out if called."
- [&] (error "cannot call recursive function before definition"))
+ [&] (error "reached the unreachable"))
 
 (defmacro declare
  "Forward-declares a function name, so that it can be called in a mutually recursive manner."
@@ -37,7 +37,6 @@
   (error "no more tokens")
   curr))
 
-
 (defn- peek [parser] (get (parser :tokens) (inc (parser :current))))
 
 (defn- advance [parser] (update parser :current inc))
@@ -49,7 +48,7 @@
  (= type current-type))
 
 ### Parsing functions
-(declare nonbinding binding)
+(declare nonbinding binding synthetic)
 
 # errors
 (def terminators [:break :newline :semicolon :eof])
@@ -59,17 +58,26 @@
  (def ttype (type curr))
  (has-value? terminators ttype))
 
+(def breaking [:break :newline :semicolon :comma :eof :then :else])
+
+(defn- breaks? [parser]
+ (def curr (current parser))
+ (def ttype (type curr))
+ (has-value? breaking ttype))
+
 (defn- panic [parser message]
- (print "Panic in the parser: " message)
+ # (print "Panic in the parser: " message)
  (def origin (current parser))
  (advance parser)
  (def skipped @[origin])
- (while (not (terminates? parser))
+ (while (not (breaks? parser))
   (array/push skipped (current parser))
   (advance parser))
  (array/push skipped (current parser))
- (advance parser)
- (error {:type :error :data skipped :token origin}))
+ # (advance parser)
+ (def err {:type :error :data skipped :token origin :msg message})
+ (update parser :errors array/push err)
+ (error err))
 
 (defn- expected [parser ttype]
  (panic parser (string "expected " ttype ", got " (-> parser current type))))
@@ -96,6 +104,7 @@
 
 (defn- kw [parser]
  (expect parser :keyword)
+ (if (= :lparen (-> parser peek type)) (break (synthetic parser)))
  (def curr (-> parser current))
  (advance parser)
  {:type :keyword :data (curr :literal) :token curr}
@@ -114,6 +123,7 @@
  {:type :string :data (curr :literal) :token curr}
  )
 
+# words & synthetic expressions
 (def separates [:break :newline :comma])
 
 (defn- separates? [parser]
@@ -126,14 +136,57 @@
   (panic parser (string "expected separator, got " (-> parser current type))))
  (while (separates? parser) (advance parser)))
 
-(defn- tup-term [parser]
- (def term (nonbinding parser))
- (if (separates? parser)
-  (do
-   (while (separates? parser) (advance parser))
-   term)
-  (panic parser (string "expected separator, got " (type (current parser))))))
+(def sequels [:lparen :keyword])
 
+(defn- word [parser]
+ (expect parser :word)
+ (if (has-value? sequels (-> parser peek type)) (break (synthetic parser)))
+ (def curr (-> parser current))
+ (advance parser)
+ {:type :word :data (curr :lexeme) :token curr}
+ )
+
+(defn- args [parser]
+ (def origin (current parser))
+ (advance parser) # consume the :lparen
+ (def ast @{:type :args :data @[] :token origin :partial false})
+ (while (separates? parser) (advance parser)) # consume any separators
+ (while (not (check parser :rparen))
+  (def origin (current parser))
+  (def term (if (check parser :placeholder)
+   (if (ast :partial) 
+    (do
+     (def err {:type :error :data [] :token origin :msg "partially applied functions may only use one placeholder"})
+     (advance parser)
+     (update parser :errors array/push err)
+     err)
+    (do
+     (set (ast :partial) true)
+     (advance parser)
+     {:type :placeholder :token origin}))
+   (try (nonbinding parser) ([e] e))))
+  (array/push (ast :data) term)
+  (try (separators parser) 
+   ([e] (pp e) (array/push (ast :data) e))))
+ (advance parser)
+ ast)
+
+(defrec synthetic [parser]
+ (def origin (current parser))
+ (def ast {:type :synthetic :data @[origin] :token origin})
+ (advance parser)
+ (while (has-value? sequels (-> parser current type))
+  (def term 
+   (case (-> parser current type)
+    :lparen (args parser)
+    :keyword (kw parser)
+  ))
+  (array/push (ast :data) term)
+ )
+ ast
+)
+
+# collections
 (defn- tup [parser]
  (def origin (current parser))
  (advance parser) # consume the :lparen
@@ -147,6 +200,96 @@
  (advance parser)
  ast)
 
+(defn- list [parser]
+ (def origin (current parser))
+ (advance parser)
+ (def ast {:type :list :data @[] :token origin})
+ (while (separates? parser) (advance parser))
+ (while (not (check parser :rbracket))
+  (def origin (current parser))
+  (def term (if (check parser :splat)
+   (do
+    (advance parser)
+    (def splatted (try (word parser) ([e] e)))
+    {:type :splat :data splatted :token origin}
+   )
+   (try (nonbinding parser) ([e] e))))
+  (array/push (ast :data) term)
+  (try (separators parser)
+   ([e] (array/push (ast :data) e))))
+ (advance parser)
+ ast)
+
+(defn- set [parser]
+ (def origin (current parser))
+ (advance parser)
+ (def ast {:type :set :data @[] :token origin})
+ (while (separates? parser) (advance parser))
+ (while (not (check parser :rbrace))
+  (def origin (current parser))
+  (def term (if (check parser :splat)
+   (do
+    (advance parser)
+    (def splatted (try (word parser) ([e] e)))
+    {:type :splat :data splatted :token origin}
+   )
+   (try (nonbinding parser) ([e] e))))
+  (array/push (ast :data) term)
+  (try (separators parser)
+   ([e] (array/push (ast :data) e))))
+ (advance parser)
+ ast)
+
+(defn- dict [parser]
+ (def origin (current parser))
+ (advance parser)
+ (def ast {:type :dict :data @[] :token origin})
+ (while (separates? parser) (advance parser))
+ (while (not (check parser :rbrace))
+  (def origin (current parser))
+  (def term (case (type origin)
+   :splat {:type :splat :data (try (word (advance parser)) ([e] e)) :token origin}
+   :word (try (word parser) ([e] e))
+   :keyword (do
+    (def key (try (kw parser) ([e] e)))
+    (def value (try (nonbinding parser) ([e] e)))
+    {:type :pair :data [key value] :token origin})
+   (try (panic parser (string expect "expected dict term, got " (type origin))) ([e] e))
+  ))
+  (array/push (ast :data) term)
+  (try (separators parser) ([e] (array/push (ast :data) e))))
+ (advance parser)
+ ast)
+
+
+### expressions
+# four levels of expression complexity:
+# simple (atoms, collections, synthetic expressions; no conditionals or binding or blocks)
+# nonbinding (excludes let, ref, named fn: what is allowed inside collections)
+# plain old exprs (anything but toplevel)
+# toplevel (exprs + ns, pkg, test, import, use)
+
+# simple expressions: what can go anywhere you expect an expression
+(defrec simple [parser]
+ (def curr (current parser))
+ (case (type curr)
+  :nil (nill parser)
+  :true (bool parser)
+  :false (bool parser)
+  :number (num parser)
+  :keyword (kw parser)
+  :string (str parser)
+  :lparen (tup parser)
+  :lbracket (list parser)
+  :startdict (dict parser)
+  :startset (sett parser)
+  :word (word parser)
+  (panic parser (string expect "expected simple expression, got " (type curr)))
+ )
+)
+
+# non-binding expressions
+# the rhs of lets, clauses, inside conditional forms, etc.
 (defrec nonbinding [parser]
  (def curr (current parser))
  (case (type curr)
@@ -160,19 +303,92 @@
   # strings
   :string (str parser)
   ### TODO: interpolated strings
+  :interpolated (unreachable)
 
-  # tuples
+  # collection literals
   :lparen (tup parser)
+  :lbracket (list parser)
+  :startdict (dict parser)
+  :startset (sett parser)
+
+  # synthetic
+  :word (word parser)
+
+  # conditional forms
+  :if (unreachable)
+  :cond (unreachable)
+  :match (unreachable)
+  :with (unreachable)
+
+  # do
+  :do (unreachable)
+
+  # fn: but only lambda
+  :fn (unreachable)
+
+  # blocks
+  :lbrace (unreachable)
 
   (panic parser (string "expected nonbinding expression, got " (type curr)))
  )
 )
 
-(defrec binding [parser]
+(defrec expr [parser]
  (def curr (current parser))
  (case (type curr)
   :let nil
   :fn nil
+  :ref nil
+  :nil (nill parser)
+  :true (bool parser)
+  :false (bool parser)
+  :number (num parser)
+  :keyword (kw parser)
+  :string (str parser)
+  :lparen (tup parser)
+  :lbracket (list parser)
+  :startdict (dict parser)
+  :startset (sett parser)
+  :word (word parser)
+  :if (unreachable)
+  :cond (unreachable)
+  :match (unreachable)
+  :with (unreachable)
+  :do (unreachable)
+  :lbrace (unreachable)
+  (panic parser (string "expected expression, got " (type curr)))
+ )
+)
+
+(defrec toplevel [parser]
+ (def curr (current parser))
+ (case (type curr)
+  :pkg nil
+  :ns nil
+  :test nil
+  :import nil
+  :use nil
+  :let nil
+  :fn nil
+  :ref nil
+  :nil (nill parser)
+  :true (bool parser)
+  :false (bool parser)
+  :number (num parser)
+  :keyword (kw parser)
+  :string (str parser)
+  :lparen (tup parser)
+  :lbracket (list parser)
+  :startdict (dict parser)
+  :startset (sett parser)
+  :word (word parser)
+  :if (unreachable)
+  :cond (unreachable)
+  :match (unreachable)
+  :with (unreachable)
+  :do (unreachable)
+  :lbrace (unreachable)
+  (panic parser (string "expected expression, got " (type curr)))
  )
 )
 
@@ -181,10 +397,10 @@
 (do
 #(comment
 
-(def scanned (s/scan "(1, (2 3), 3)"))
+(def scanned (s/scan "#{}"))
 (def a-parser (new-parser scanned))
 (def parsed (nonbinding a-parser))
-(-> parsed (get :data) )
+(-> parsed)
 )
 
 
diff --git a/janet/scanner.janet b/janet/scanner.janet
index 391ce9b..520f22f 100644
--- a/janet/scanner.janet
+++ b/janet/scanner.janet
@@ -297,7 +297,7 @@
       ## splats
       "." (let [after_next (current-char (advance scanner))]
            (if (= ".." (string next after_next))
-             (add-token (advance (advance scanner)) :splat)
+             (add-token (advance scanner) :splat)
              (add-error scanner (string "Expected splat: ... . Got " (string "." next after_next)))))
 
       ## strings