From b5def30348850526591fd884aaec2c5f2f09f88e Mon Sep 17 00:00:00 2001 From: Scott Richmond Date: Fri, 10 May 2024 16:10:57 -0400 Subject: [PATCH] add a pretty-printer (that sometimes causes errors!), lots of bugs but functions for all the things --- janet/recursive.janet | 122 +++++++++++++++++++++++++++++++++++------- 1 file changed, 102 insertions(+), 20 deletions(-) diff --git a/janet/recursive.janet b/janet/recursive.janet index bf070f2..22860f5 100644 --- a/janet/recursive.janet +++ b/janet/recursive.janet @@ -296,9 +296,20 @@ (advance parser) ast) +(defn- synth-root [parser] + (def origin (current parser)) + (advance parser) + (case (type origin) + :word {:type :word :data (origin :lexeme) :token origin} + :keyword {:type :keyword :data (origin :literal) :token origin} + :pkg-name {:type :pkg-name :data (origin :lexem) :token origin} + (panic parser "expected word, keyword, or package") + ) +) + (defrec synthetic [parser] (def origin (current parser)) - (def ast {:type :synthetic :data @[origin] :token origin}) + (def ast {:type :synthetic :data @[(synth-root origin)] :token origin}) (advance parser) (while (has-value? sequels (-> parser current type)) (def term @@ -367,7 +378,7 @@ (def term (if (check parser :splat) (do (advance parser) - (def splatted (try (word parser) ([e] e))) + (def splatted (capture word parser)) {:type :splat :data splatted :token origin} ) (try (nonbinding parser) ([e] e)))) @@ -415,7 +426,13 @@ (expect parser :word) (def origin (current parser)) (advance parser) - {:type :word :data (origin :lexeme) :token origin}) + (def the-word {:type :word :data (origin :lexeme) :token origin}) + (if (check parser :as) + (do + (advance parser) + (def type (kw parser)) + {:type :typed :data [type the-word] :token origin}) + the-word)) (defn- tup-pattern [parser] (def origin (current parser)) @@ -585,12 +602,15 @@ (do (def ast {:type :clause :data @[] :origin (current parser)}) (def lhs (pattern parser)) + (def guard (when (check parser :if) + (advance parser) + (simple parser))) (expect parser :arrow) (advance parser) (accept-many parser :newline) (def rhs (nonbinding parser)) (terminator parser) - [lhs rhs]) + [lhs guard rhs]) ([err] (accept-many parser ;terminators) err))) @@ -618,10 +638,13 @@ (try (do (def lhs (pattern parser)) + (def guard (when (check parser :if) + (advance parser) + (simple parser))) (expect parser :equals) (advance parser) (def rhs (nonbinding parser)) (terminator parser) - [lhs rhs] + [lhs guard rhs] ) ([err] (accept-many parser ;terminators) @@ -662,10 +685,13 @@ (defn- fn-simple [parser] (try (do - (def lhs (tuple-pattern parser)) + (def lhs (tup-pattern parser)) + (def guard (when (check parser :if) + (advance parser) + (simple parser))) (expect parser :arrow) (advance parser) (def rhs (nonbinding parser)) - [[lhs rhs]] + [[lhs guard rhs]] ) ([err] err) ) @@ -675,11 +701,14 @@ (def origin (current parser)) (try (do - (def lhs (tuple-pattern parser)) + (def lhs (tup-pattern parser)) + (def guard (when (check parser :if) + (advance parser) + (simple parser))) (expect parser :arrow) (advance parser) (def rhs (nonbinding parser)) (terminator parser) - [lhs rhs]) + [lhs guard rhs]) ([err] (advance parser) (accept-many parser ;terminators) @@ -705,7 +734,7 @@ (def origin (current parser)) (expect parser :fn) (advance parser) (def name (word parser)) - (def data (case (-> parser peek type) + (def data (case (-> parser current type) :lbrace (fn-clauses parser) :lparen (fn-simple parser) (panic parser (string "expected clause or clauses, got " (-> current parser type))))) @@ -761,6 +790,7 @@ (defn- pkg-name [parser] (expect parser :pkg-name) (def origin (current parser)) + (if (= :keyword (-> parser peek type)) (break (synthetic parser))) (advance parser) {:type :pkg-name :data (origin :lexeme) :token origin}) @@ -776,9 +806,9 @@ (try (do (def origin (current parser)) - (expect :pkg) (advance parser) + (expect parser :pkg) (advance parser) (def name (pkg-name parser)) - (expect :lbrace) (advance parser) + (expect parser :lbrace) (advance parser) (accept-many parser ;terminators) (def data @[]) (while (not (check parser :rbrace)) @@ -802,7 +832,7 @@ (try (do (def origin (current parser)) - (expect :ns) (advance parser) + (expect parser :ns) (advance parser) (def name (pkg-name parser)) (def body (block parser)) {:type :ns :data body :name name :token origin}) @@ -824,6 +854,34 @@ (def body (nonbinding parser)) {:type :test :data [desc body] :token origin}) +### loops and repeates +(defn- loopp [parser] + (def origin (current parser)) + (expect parser :loop) (advance parser) + (def args (tup parser)) + (expect parser :with) (advance parser) + (def clauses (case (-> parser current type) + :lparen (fn-simple parser) + :lbrace (fn-clauses parser) + )) + {:type :loop :data [args clauses] :token origin}) + +(defn- recur [parser] + (def origin (current parser)) + (expect parser :recur) (advance parser) + (def args (tup parser)) + {:type :recur :data args :token origin}) + +(defn- repeatt [parser] + (def origin (current parser)) + (def times (case (-> parser current type) + :number (num parser) + :word (word parser) + (panic parser "expected number or word") + )) + (def body (block parser)) + {:type :repeat :data [times body] :token origin}) + ### expressions # four levels of expression complexity: # simple (atoms, collections, synthetic expressions; no conditionals or binding or blocks) @@ -847,6 +905,8 @@ :startdict (dict parser) :startset (sett parser) :word (word parser) + :pkg-name (pkg-name parser) + :recur (recur parser) (panic parser (string expect "expected simple expression, got " (type curr))) ) ) @@ -877,6 +937,8 @@ # synthetic :word (word parser) + :pkg-name (pkg-name parser) + :recur (recur parser) # conditional forms :if (iff parser) @@ -917,6 +979,8 @@ :startdict (dict parser) :startset (sett parser) :word (word parser) + :pkg-name (pkg-name parser) + :recur (recur parser) :if (iff parser) :when (whenn parser) :match (matchh parser) @@ -942,7 +1006,7 @@ ) ) -(def script [parser] +(defn- script [parser] (def origin (current parser)) (def lines @[]) (while (not (check parser :eof)) @@ -950,21 +1014,39 @@ (capture terminator parser)) {:type :script :data lines :token origin}) +(defn- indent-by [n] + (def indentation @"") + (repeat n (buffer/push indentation "..")) + indentation) + +(defn- pp-ast [ast &opt indent] + (default indent 0) + (def {:type t :name n :data d :msg m} ast) + (string (indent-by indent) t ": " n m + (if (indexed? d) + (string "\n" (string/join (map (fn [a] (pp-ast a (inc indent))) d))) + d + ) + "\n" + ) +) + + (do #(comment -(def source `match foo with { - 1 -> 2 4 - _ -> :foo -} +(def source ` +fn foo (x) -> :foo `) (def scanned (s/scan source)) (def a-parser (new-parser scanned)) -(def parsed (try (matchh a-parser) ([e] e))) +(def parsed (script a-parser)) +(print "\n***NEW PARSE***\n") +(print (pp-ast parsed)) ) # 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 +