From 8f284f1e65c135f3a5d4fe94273c07dd339879e6 Mon Sep 17 00:00:00 2001
From: Scott Richmond <kredati@users.noreply.github.com>
Date: Fri, 10 May 2024 15:02:22 -0400
Subject: [PATCH] first draft of all the things; many bugs abound

---
 janet/recursive.janet | 454 ++++++++++++++++++++++++++++++++++++------
 1 file changed, 396 insertions(+), 58 deletions(-)

diff --git a/janet/recursive.janet b/janet/recursive.janet
index c1c8161..bf070f2 100644
--- a/janet/recursive.janet
+++ b/janet/recursive.janet
@@ -71,7 +71,7 @@
 
 # errors
 # terminators are what terminate expressions
-(def terminators [:break :newline :semicolon :eof])
+(def terminators [:break :newline :semicolon])
 
 (defn- terminates? 
  "Returns true if the current token in the parser is a terminator"
@@ -273,6 +273,10 @@
  (def ast @{:type :args :data @[] :token origin :partial false})
  (while (separates? parser) (advance parser)) # consume any separators
  (while (not (check parser :rparen))
+  (when (check parser :eof)
+   (def err {:type :error :token origin :msg "unclosed paren"})
+   (array/push (parser :errors) err)
+   (error err))
   (def origin (current parser))
   (def term (if (check parser :placeholder)
    (if (ast :partial) 
@@ -314,6 +318,10 @@
  (def ast {:type :tuple :data @[] :token origin})
  (while (separates? parser) (advance parser)) # consume any separators
  (while (not (check parser :rparen))
+  (when (check parser :eof)
+   (def err {:type :error :token origin :msg "unclosed paren"})
+   (array/push (parser :errors) err)
+   (error err))
   (def term (try (nonbinding parser) ([e] e)))
   (array/push (ast :data) term)
   (try (separators parser) 
@@ -327,6 +335,10 @@
  (def ast {:type :list :data @[] :token origin})
  (while (separates? parser) (advance parser))
  (while (not (check parser :rbracket))
+  (when (check parser :eof)
+   (def err {:type :error :token origin :msg "unclosed bracket"})
+   (array/push (parser :errors) err)
+   (error err))
   (def origin (current parser))
   (def term (if (check parser :splat)
    (do
@@ -347,6 +359,10 @@
  (def ast {:type :set :data @[] :token origin})
  (while (separates? parser) (advance parser))
  (while (not (check parser :rbrace))
+  (when (check parser :eof)
+   (def err {:type :error :token origin :msg "unclosed brace"})
+   (array/push (parser :errors) err)
+   (error err))
   (def origin (current parser))
   (def term (if (check parser :splat)
    (do
@@ -367,6 +383,10 @@
  (def ast {:type :dict :data @[] :token origin})
  (while (separates? parser) (advance parser))
  (while (not (check parser :rbrace))
+  (when (check parser :eof)
+   (def err {:type :error :token origin :msg "unclosed brace"})
+   (array/push (parser :errors) err)
+   (error err))
   (def origin (current parser))
   (def term (case (type origin)
    :splat {:type :splat :data (try (word (advance parser)) ([e] e)) :token origin}
@@ -397,14 +417,78 @@
  (advance parser)
  {:type :word :data (origin :lexeme) :token origin})
 
-(defn- tuple-pattern [parser])
+(defn- tup-pattern [parser]
+ (def origin (current parser))
+ (advance parser) # consume the :lparen
+ (def ast {:type :tuple :data @[] :token origin})
+ (while (separates? parser) (advance parser)) # consume any separators
+ (while (not (check parser :rparen))
+  (when (check parser :eof)
+   (def err {:type :error :token origin :msg "unclosed paren"})
+   (array/push (parser :errors) err)
+   (error err))
+  (def origin (current parser))
+  (def term (if (check parser :splat)
+   (do
+    (advance parser)
+    (def splatted (if (check parser :word) (word parser) nil))
+    {:type :splat :data splatted :token origin})
+   (try (pattern parser) ([e] e))))
+  (array/push (ast :data) term)
+  (try (separators parser) 
+   ([e] (pp e) (array/push (ast :data) e))))
+ (advance parser)
+ ast)
 
-(defn- list-pattern [parser])
-
-(defn- dict-pattern [parser])
-
-(defn- string-pattern [parser])
+(defn- list-pattern [parser]
+ (def origin (current parser))
+ (advance parser)
+ (def ast {:type :list :data @[] :token origin})
+ (while (separates? parser) (advance parser))
+ (while (not (check parser :rbracket))
+  (when (check parser :eof)
+   (def err {:type :error :token origin :msg "unclosed bracket"})
+   (array/push (parser :errors) err)
+   (error err))
+  (def origin (current parser))
+  (def term (if (check parser :splat)
+   (do
+    (advance parser)
+    (def splatted (if (check parser :word) (word parser) nil))
+    {:type :splat :data splatted :token origin})
+   (try (pattern parser) ([e] e))))
+  (array/push (ast :data) term)
+  (try (separators parser)
+   ([e] (array/push (ast :data) e))))
+ (advance parser)
+ ast)
 
+(defn- dict-pattern [parser]
+ (def origin (current parser))
+ (advance parser)
+ (def ast {:type :dict :data @[] :token origin})
+ (while (separates? parser) (advance parser))
+ (while (not (check parser :rbrace))
+  (when (check parser :eof)
+   (def err {:type :error :token origin :msg "unclosed brace"})
+   (array/push (parser :errors) err)
+   (error err))
+  (def origin (current parser))
+  (def term (case (type origin)
+   :splat {:type :splat :data (try (word (advance parser)) ([_] nil)) :token origin}
+   :word (try (word parser) ([e] e))
+   :keyword (do
+    (def key (capture kw parser))
+    (def value (capture pattern parser))
+    {: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)
+ 
+### TODO: add as patterns
 (defrec pattern [parser]
  (case (-> parser current type)
   :nil (nill parser)
@@ -415,13 +499,27 @@
   :string (str parser)
   :word (word-pattern parser)
   :placeholder (placeholder parser)
-  :lparen (tuple-pattern parser)
+  :ignored (placeholder parser)
+  :lparen (tup-pattern parser)
   :lbracket (list-pattern parser)
   :startdict (dict-pattern parser)
-  :interpolated (string-pattern parser)
+  :interpolated (interpolated parser)
   (panic parser "expected pattern")
  ))
 
+### let
+# let {pattern} = {nonbinding}
+(defn- lett [parser]
+ (def ast {:type :let :data @[] :token (current parser)})
+ (advance parser) # consume the let
+ (array/push (ast :data) (capture pattern parser))
+ (if-let [err (expect-ret parser :equals)]
+  (do (array/push (ast :data) err) (break ast))
+  (advance parser))
+ (accept-many parser :newline)
+ (array/push (ast :data) (capture nonbinding parser))
+ ast)
+
 ### conditional forms
 # if {simple} then {nonbinding} else {nonbinding}
 (defn- iff [parser]
@@ -464,8 +562,10 @@
    (accept-many parser :newline :semicolon :break) # ...and any additional ones
    err)))
 
+# when { {when-clause}+ }
 (defn- whenn [parser]
- (def ast {:type :when :data @[] :origin (current parser)})
+ (def origin (current parser))
+ (def ast {:type :when :data @[] :token origin})
  (advance parser) # consume when
  (if-let [err (expect-ret parser :lbrace)]
   (do
@@ -473,22 +573,256 @@
    (break ast)) # early return; just bail if we don't have {
   (advance parser))
  (accept-many parser :newline)
- (while (not (check parser :rbrace :eof)) # make sure we don't roll past eof
+ (while (not (check parser :rbrace )) # make sure we don't roll past eof
+  (when (check parser :eof) (error {:type :error :token origin :data ast :msg "unclosed brace"}))
   (array/push (ast :data) (capture when-clause parser)))
  (advance parser)
  ast)
 
-(defn- match [parser])
+### TODO: add guards to patterns
+(defn- match-clause [parser]
+ (try 
+  (do 
+   (def ast {:type :clause :data @[] :origin (current parser)})
+   (def lhs (pattern parser))
+   (expect parser :arrow)
+   (advance parser)
+   (accept-many parser :newline)
+   (def rhs (nonbinding parser))
+   (terminator parser)
+   [lhs rhs])
+  ([err]
+   (accept-many parser ;terminators)
+   err)))
+
+(defn- matchh [parser]
+ (def origin (current parser))
+ (def ast {:type :match :data @[] :token origin})
+ (expect parser :match)
+ (advance parser)
+ (try
+  (do
+   (simple parser)
+   (expect parser :with) (advance parser)
+   (expect parser :lbrace) (advance parser)
+   (accept-many parser :newline)
+   (while (not (check parser :rbrace))
+    (when (check parser :eof) (error {:type :error :token origin :data ast :msg "unclosed brace"}))
+    (array/push (ast :data) (match-clause parser)))
+   (advance parser)
+   ast)
+  ([err] err)))
+
+# {pattern} = {nonbinding} {terminators}
+(defn- with-clause [parser]
+ (try
+  (do
+   (def lhs (pattern parser))
+   (expect parser :equals) (advance parser)
+   (def rhs (nonbinding parser))
+   (terminator parser)
+   [lhs rhs]
+  )
+  ([err] 
+   (accept-many parser ;terminators)
+   err)
+ )
+)
+
+# with { {clauses}+ } {terminators}? then {nonbinding} {terminators}? else {nonbinding}
+(defn- withh [parser]
+ (def origin (current parser))
+ (expect parser :with) (advance parser)
+ (try
+  (do
+   (expect parser :lbrace) (advance parser)
+   (accept-many parser ;terminators)
+   (def data @[])
+   (def clauses @[])
+   (array/push clauses (with-clause parser))
+   (accept-many parser ;terminators)
+   (while (not (check parser :rbrace))
+    (if (check parser :eof)
+     (error {:type :error :data data :token origin :msg "unclosed brace"}))
+    (array/push clauses (with-clause parser))
+    (accept-many parser ;terminators))
+   (array/push data clauses)
+   (accept-many parser :newline)
+   (expect parser :then) (advance parser)
+   (array/push data (nonbinding parser))
+   (accept-many parser :newline)
+   (expect parser :else) (advance parser)
+   (array/push data (nonbinding parser))
+   {:type :with :data data :token origin})
+  ([err] err)
+ )
+)
 
 ### function forms
-(defn- fnn [parser])
+(defn- fn-simple [parser]
+ (try
+  (do
+   (def lhs (tuple-pattern parser))
+   (expect parser :arrow) (advance parser)
+   (def rhs (nonbinding parser))
+   [[lhs rhs]]
+  )
+  ([err] err)
+ )
+)
 
-(defn- lambda [parser])
+(defn- fn-clause [parser]
+ (def origin (current parser))
+ (try
+  (do
+   (def lhs (tuple-pattern parser))
+   (expect parser :arrow) (advance parser)
+   (def rhs (nonbinding parser))
+   (terminator parser)
+   [lhs rhs])
+  ([err]
+   (advance parser)
+   (accept-many parser ;terminators)
+   err
+  )
+ )
+)
+
+(defn- fn-clauses [parser]
+ (def origin (current parser))
+ (expect parser :lbrace) (advance parser)
+ (accept-many parser ;terminators)
+ (def data @[])
+ (while (not (check parser :rbrace))
+  (if (check parser :eof) 
+   (error {:type :error :token origin :data data :msg "unclosed brace"}))
+  (array/push data (capture fn-clause parser)))
+ data)
+
+(defn- fnn [parser]
+ (try
+  (do
+   (def origin (current parser))
+   (expect parser :fn) (advance parser)
+   (def name (word parser))
+   (def data (case (-> parser peek type)
+    :lbrace (fn-clauses parser)
+    :lparen (fn-simple parser)
+    (panic parser (string "expected clause or clauses, got " (-> current parser type)))))
+   {:type :fn :name name :data data :token origin}
+  )
+  ([err] err)))
+
+(defn- lambda [parser]
+ (def origin (current parser))
+ (expect parser :fn) (advance parser)
+ {:type :fn :data (fn-simple parser) :token origin})
 
 ### compoound forms
-(defn- block [parser])
+(defn- block [parser]
+ (def origin (current parser))
+ (expect parser :lbrace) (advance parser)
+ (accept-many parser ;terminators)
+ (def data @[])
+ (while (not (check parser :rbrace))
+  (if (check parser :eof)
+   (error {:type :error :token origin :data data :msg "unclosed brace"}))
+  (array/push data (capture expr parser))
+  (terminator parser))
+ {:type :block :data data :token origin})
 
-(defn- doo [parser])
+### TODO: decide whether this design works
+# newlines are allowed AFTER pipelines, but not before
+# eg. `do foo > \n bar > \n baz`
+# but not `do foo \n > bar \n > baz`
+# Otherwise, this isn't LR
+(defn- doo [parser]
+ (def origin (current parser))
+ (expect parser :do) (advance parser)
+ (def data @[])
+ (array/push data (capture simple parser))
+ (while (check parser :pipeline)
+  (accept-many parser :newline)
+  (array/push data (capture simple parser)))
+ {:type :do :data data :token origin})
+
+### refs, pkgs, nses, etc.
+(defn- ref [parser]
+ (def origin (current parser))
+ (expect parser :ref) (advance parser)
+ (try
+  (do
+   (def name (word parser))
+   (expect parser :equals) (advance parser)
+   (def value (nonbinding parser))
+   {:type :ref :data value :name name :token origin})
+  ([err] err)))
+
+(defn- pkg-name [parser]
+ (expect parser :pkg-name)
+ (def origin (current parser))
+ (advance parser)
+ {:type :pkg-name :data (origin :lexeme) :token origin})
+
+(defn- usee [parser]
+ (def origin (current parser))
+ (expect parser :use) (advance parser)
+ (try
+  (do
+   {:type :use :data (pkg-name parser) :token origin})
+ ([err] err)))
+
+(defn- pkg [parser]
+ (try
+  (do
+   (def origin (current parser))
+   (expect :pkg) (advance parser)
+   (def name (pkg-name parser))
+   (expect :lbrace) (advance parser)
+   (accept-many parser ;terminators)
+   (def data @[])
+   (while (not (check parser :rbrace))
+    (when (check parser :eof)
+     (def err {:type :error :token origin :data data :msg "unclosed brace"})
+     (array/push (parser :errors) err)
+     (error err))
+    (case (-> parser current type)
+     :keyword (do
+      (def origin (current parser))
+      (def key (capture kw parser))
+      (def value (capture simple parser))
+      (array/push data {:type :pair :data [key value] :token origin}))
+     :word (array/push (capture word parser))
+     (panic parser "expected dict term"))
+    (terminator parser))
+   {:type :pkg :data data :token origin :name name})
+  ([err] err)))
+
+(defn- ns [parser]
+ (try 
+  (do  
+   (def origin (current parser))
+   (expect :ns) (advance parser)
+   (def name (pkg-name parser))
+   (def body (block parser))
+   {:type :ns :data body :name name :token origin})
+  ([err] err)))
+
+(defn- importt [parser]
+ (def origin (current parser))
+ (expect parser :import) (advance parser)
+ (def path (str parser))
+ (expect parser :as) (advance parser)
+ (def name (pkg-name parser))
+ {:type :import :data path :name name :token origin})
+
+### tests
+(defn- testt [parser]
+ (def origin (current parser))
+ (expect parser :test) (advance parser)
+ (def desc (str parser))
+ (def body (nonbinding parser))
+ {:type :test :data [desc body] :token origin})
 
 ### expressions
 # four levels of expression complexity:
@@ -519,6 +853,7 @@
 
 # non-binding expressions
 # the rhs of lets, clauses, inside conditional forms, etc.
+# any form that does not bind a name
 (defrec nonbinding [parser]
  (def curr (current parser))
  (case (type curr)
@@ -532,7 +867,7 @@
   # strings
   :string (str parser)
   ### TODO: interpolated strings
-  :interpolated (unreachable)
+  :interpolated (interpolated parser)
 
   # collection literals
   :lparen (tup parser)
@@ -546,17 +881,17 @@
   # conditional forms
   :if (iff parser)
   :when (whenn parser)
-  :match (unreachable)
-  :with (unreachable)
+  :match (matchh parser)
+  :with (withh parser)
 
   # do
-  :do (unreachable)
+  :do (doo parser)
 
   # fn: but only lambda
-  :fn (unreachable)
+  :fn (lambda parser)
 
   # blocks
-  :lbrace (unreachable)
+  :lbrace (block parser)
 
   (panic parser (string "expected nonbinding expression, got " (type curr)))
  )
@@ -565,9 +900,12 @@
 (defrec expr [parser]
  (def curr (current parser))
  (case (type curr)
-  :let (unreachable)
-  :fn (unreachable)
-  :ref (unreachable)
+  # binding forms
+  :let (lett parser)
+  :fn (fnn parser)
+  :ref (ref parser)
+
+  # nonbinding forms
   :nil (nill parser)
   :true (bool parser)
   :false (bool parser)
@@ -581,10 +919,10 @@
   :word (word parser)
   :if (iff parser)
   :when (whenn parser)
-  :match (unreachable)
-  :with (unreachable)
-  :do (unreachable)
-  :lbrace (unreachable)
+  :match (matchh parser)
+  :with (withh parser)
+  :do (doo parser)
+  :lbrace (block parser)
   (panic parser (string "expected expression, got " (type curr)))
  )
 )
@@ -592,41 +930,41 @@
 (defrec toplevel [parser]
  (def curr (current parser))
  (case (type curr)
-  :pkg (unreachable)
-  :ns (unreachable)
-  :test (unreachable)
-  :import (unreachable)
-  :use (unreachable)
-  :let (unreachable)
-  :fn (unreachable)
-  :ref (unreachable)
-  :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 (iff parser)
-  :when (whenn parser)
-  :match (unreachable)
-  :with (unreachable)
-  :do (unreachable)
-  :lbrace (unreachable)
-  (panic parser (string "expected expression, got " (type curr)))
+  # toplevel-only
+  :pkg (pkg parser)
+  :ns (ns parser)
+  :test (testt parser)
+  :import (importt parser)
+  :use (usee parser)
+
+  # all the other expressions
+  (expr parser)
  )
 )
 
+(def script [parser]
+ (def origin (current parser))
+ (def lines @[])
+ (while (not (check parser :eof))
+  (array/push lines (capture toplevel parser))
+  (capture terminator parser))
+ {:type :script :data lines :token origin})
+
 (do
 #(comment
-(def source `"foo { bar } baz \{quux} {fuzz}"`)
+(def source `match foo with {
+ 1 -> 2 4
+ _ -> :foo
+}
+`)
 (def scanned (s/scan source))
 (def a-parser (new-parser scanned))
-(def parsed (simple a-parser))
-(-> parsed)
+(def parsed (try (matchh a-parser) ([e] e)))
 )
 
+
+# FIXME:
+# TODO:
+# - if guards on patterns
+# DECIDE:
+# - when to use a flat try/catch format, and when to use capture/expect-ret to get values instead of errors