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)
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