add a pretty-printer (that sometimes causes errors!), lots of bugs but functions for all the things

This commit is contained in:
Scott Richmond 2024-05-10 16:10:57 -04:00
parent b0cffea71f
commit b5def30348

View File

@ -296,9 +296,20 @@
(advance parser) (advance parser)
ast) 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] (defrec synthetic [parser]
(def origin (current 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) (advance parser)
(while (has-value? sequels (-> parser current type)) (while (has-value? sequels (-> parser current type))
(def term (def term
@ -367,7 +378,7 @@
(def term (if (check parser :splat) (def term (if (check parser :splat)
(do (do
(advance parser) (advance parser)
(def splatted (try (word parser) ([e] e))) (def splatted (capture word parser))
{:type :splat :data splatted :token origin} {:type :splat :data splatted :token origin}
) )
(try (nonbinding parser) ([e] e)))) (try (nonbinding parser) ([e] e))))
@ -415,7 +426,13 @@
(expect parser :word) (expect parser :word)
(def origin (current parser)) (def origin (current parser))
(advance 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] (defn- tup-pattern [parser]
(def origin (current parser)) (def origin (current parser))
@ -585,12 +602,15 @@
(do (do
(def ast {:type :clause :data @[] :origin (current parser)}) (def ast {:type :clause :data @[] :origin (current parser)})
(def lhs (pattern parser)) (def lhs (pattern parser))
(def guard (when (check parser :if)
(advance parser)
(simple parser)))
(expect parser :arrow) (expect parser :arrow)
(advance parser) (advance parser)
(accept-many parser :newline) (accept-many parser :newline)
(def rhs (nonbinding parser)) (def rhs (nonbinding parser))
(terminator parser) (terminator parser)
[lhs rhs]) [lhs guard rhs])
([err] ([err]
(accept-many parser ;terminators) (accept-many parser ;terminators)
err))) err)))
@ -618,10 +638,13 @@
(try (try
(do (do
(def lhs (pattern parser)) (def lhs (pattern parser))
(def guard (when (check parser :if)
(advance parser)
(simple parser)))
(expect parser :equals) (advance parser) (expect parser :equals) (advance parser)
(def rhs (nonbinding parser)) (def rhs (nonbinding parser))
(terminator parser) (terminator parser)
[lhs rhs] [lhs guard rhs]
) )
([err] ([err]
(accept-many parser ;terminators) (accept-many parser ;terminators)
@ -662,10 +685,13 @@
(defn- fn-simple [parser] (defn- fn-simple [parser]
(try (try
(do (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) (expect parser :arrow) (advance parser)
(def rhs (nonbinding parser)) (def rhs (nonbinding parser))
[[lhs rhs]] [[lhs guard rhs]]
) )
([err] err) ([err] err)
) )
@ -675,11 +701,14 @@
(def origin (current parser)) (def origin (current parser))
(try (try
(do (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) (expect parser :arrow) (advance parser)
(def rhs (nonbinding parser)) (def rhs (nonbinding parser))
(terminator parser) (terminator parser)
[lhs rhs]) [lhs guard rhs])
([err] ([err]
(advance parser) (advance parser)
(accept-many parser ;terminators) (accept-many parser ;terminators)
@ -705,7 +734,7 @@
(def origin (current parser)) (def origin (current parser))
(expect parser :fn) (advance parser) (expect parser :fn) (advance parser)
(def name (word parser)) (def name (word parser))
(def data (case (-> parser peek type) (def data (case (-> parser current type)
:lbrace (fn-clauses parser) :lbrace (fn-clauses parser)
:lparen (fn-simple parser) :lparen (fn-simple parser)
(panic parser (string "expected clause or clauses, got " (-> current parser type))))) (panic parser (string "expected clause or clauses, got " (-> current parser type)))))
@ -761,6 +790,7 @@
(defn- pkg-name [parser] (defn- pkg-name [parser]
(expect parser :pkg-name) (expect parser :pkg-name)
(def origin (current parser)) (def origin (current parser))
(if (= :keyword (-> parser peek type)) (break (synthetic parser)))
(advance parser) (advance parser)
{:type :pkg-name :data (origin :lexeme) :token origin}) {:type :pkg-name :data (origin :lexeme) :token origin})
@ -776,9 +806,9 @@
(try (try
(do (do
(def origin (current parser)) (def origin (current parser))
(expect :pkg) (advance parser) (expect parser :pkg) (advance parser)
(def name (pkg-name parser)) (def name (pkg-name parser))
(expect :lbrace) (advance parser) (expect parser :lbrace) (advance parser)
(accept-many parser ;terminators) (accept-many parser ;terminators)
(def data @[]) (def data @[])
(while (not (check parser :rbrace)) (while (not (check parser :rbrace))
@ -802,7 +832,7 @@
(try (try
(do (do
(def origin (current parser)) (def origin (current parser))
(expect :ns) (advance parser) (expect parser :ns) (advance parser)
(def name (pkg-name parser)) (def name (pkg-name parser))
(def body (block parser)) (def body (block parser))
{:type :ns :data body :name name :token origin}) {:type :ns :data body :name name :token origin})
@ -824,6 +854,34 @@
(def body (nonbinding parser)) (def body (nonbinding parser))
{:type :test :data [desc body] :token origin}) {: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 ### expressions
# four levels of expression complexity: # four levels of expression complexity:
# simple (atoms, collections, synthetic expressions; no conditionals or binding or blocks) # simple (atoms, collections, synthetic expressions; no conditionals or binding or blocks)
@ -847,6 +905,8 @@
:startdict (dict parser) :startdict (dict parser)
:startset (sett parser) :startset (sett parser)
:word (word parser) :word (word parser)
:pkg-name (pkg-name parser)
:recur (recur parser)
(panic parser (string expect "expected simple expression, got " (type curr))) (panic parser (string expect "expected simple expression, got " (type curr)))
) )
) )
@ -877,6 +937,8 @@
# synthetic # synthetic
:word (word parser) :word (word parser)
:pkg-name (pkg-name parser)
:recur (recur parser)
# conditional forms # conditional forms
:if (iff parser) :if (iff parser)
@ -917,6 +979,8 @@
:startdict (dict parser) :startdict (dict parser)
:startset (sett parser) :startset (sett parser)
:word (word parser) :word (word parser)
:pkg-name (pkg-name parser)
:recur (recur parser)
:if (iff parser) :if (iff parser)
:when (whenn parser) :when (whenn parser)
:match (matchh parser) :match (matchh parser)
@ -942,7 +1006,7 @@
) )
) )
(def script [parser] (defn- script [parser]
(def origin (current parser)) (def origin (current parser))
(def lines @[]) (def lines @[])
(while (not (check parser :eof)) (while (not (check parser :eof))
@ -950,21 +1014,39 @@
(capture terminator parser)) (capture terminator parser))
{:type :script :data lines :token origin}) {: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 (do
#(comment #(comment
(def source `match foo with { (def source `
1 -> 2 4 fn foo (x) -> :foo
_ -> :foo
}
`) `)
(def scanned (s/scan source)) (def scanned (s/scan source))
(def a-parser (new-parser scanned)) (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: # FIXME:
# TODO: # TODO:
# - if guards on patterns
# DECIDE: # DECIDE:
# - when to use a flat try/catch format, and when to use capture/expect-ret to get values instead of errors # - when to use a flat try/catch format, and when to use capture/expect-ret to get values instead of errors