first draft of all the things; many bugs abound

This commit is contained in:
Scott Richmond 2024-05-10 15:02:22 -04:00
parent 232261b646
commit 8f284f1e65

View File

@ -71,7 +71,7 @@
# errors # errors
# terminators are what terminate expressions # terminators are what terminate expressions
(def terminators [:break :newline :semicolon :eof]) (def terminators [:break :newline :semicolon])
(defn- terminates? (defn- terminates?
"Returns true if the current token in the parser is a terminator" "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}) (def ast @{:type :args :data @[] :token origin :partial false})
(while (separates? parser) (advance parser)) # consume any separators (while (separates? parser) (advance parser)) # consume any separators
(while (not (check parser :rparen)) (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 origin (current parser))
(def term (if (check parser :placeholder) (def term (if (check parser :placeholder)
(if (ast :partial) (if (ast :partial)
@ -314,6 +318,10 @@
(def ast {:type :tuple :data @[] :token origin}) (def ast {:type :tuple :data @[] :token origin})
(while (separates? parser) (advance parser)) # consume any separators (while (separates? parser) (advance parser)) # consume any separators
(while (not (check parser :rparen)) (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))) (def term (try (nonbinding parser) ([e] e)))
(array/push (ast :data) term) (array/push (ast :data) term)
(try (separators parser) (try (separators parser)
@ -327,6 +335,10 @@
(def ast {:type :list :data @[] :token origin}) (def ast {:type :list :data @[] :token origin})
(while (separates? parser) (advance parser)) (while (separates? parser) (advance parser))
(while (not (check parser :rbracket)) (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 origin (current parser))
(def term (if (check parser :splat) (def term (if (check parser :splat)
(do (do
@ -347,6 +359,10 @@
(def ast {:type :set :data @[] :token origin}) (def ast {:type :set :data @[] :token origin})
(while (separates? parser) (advance parser)) (while (separates? parser) (advance parser))
(while (not (check parser :rbrace)) (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 origin (current parser))
(def term (if (check parser :splat) (def term (if (check parser :splat)
(do (do
@ -367,6 +383,10 @@
(def ast {:type :dict :data @[] :token origin}) (def ast {:type :dict :data @[] :token origin})
(while (separates? parser) (advance parser)) (while (separates? parser) (advance parser))
(while (not (check parser :rbrace)) (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 origin (current parser))
(def term (case (type origin) (def term (case (type origin)
:splat {:type :splat :data (try (word (advance parser)) ([e] e)) :token origin} :splat {:type :splat :data (try (word (advance parser)) ([e] e)) :token origin}
@ -397,14 +417,78 @@
(advance parser) (advance parser)
{:type :word :data (origin :lexeme) :token origin}) {: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- list-pattern [parser]
(def origin (current parser))
(defn- dict-pattern [parser]) (advance parser)
(def ast {:type :list :data @[] :token origin})
(defn- string-pattern [parser]) (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] (defrec pattern [parser]
(case (-> parser current type) (case (-> parser current type)
:nil (nill parser) :nil (nill parser)
@ -415,13 +499,27 @@
:string (str parser) :string (str parser)
:word (word-pattern parser) :word (word-pattern parser)
:placeholder (placeholder parser) :placeholder (placeholder parser)
:lparen (tuple-pattern parser) :ignored (placeholder parser)
:lparen (tup-pattern parser)
:lbracket (list-pattern parser) :lbracket (list-pattern parser)
:startdict (dict-pattern parser) :startdict (dict-pattern parser)
:interpolated (string-pattern parser) :interpolated (interpolated parser)
(panic parser "expected pattern") (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 ### conditional forms
# if {simple} then {nonbinding} else {nonbinding} # if {simple} then {nonbinding} else {nonbinding}
(defn- iff [parser] (defn- iff [parser]
@ -464,8 +562,10 @@
(accept-many parser :newline :semicolon :break) # ...and any additional ones (accept-many parser :newline :semicolon :break) # ...and any additional ones
err))) err)))
# when { {when-clause}+ }
(defn- whenn [parser] (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 (advance parser) # consume when
(if-let [err (expect-ret parser :lbrace)] (if-let [err (expect-ret parser :lbrace)]
(do (do
@ -473,22 +573,256 @@
(break ast)) # early return; just bail if we don't have { (break ast)) # early return; just bail if we don't have {
(advance parser)) (advance parser))
(accept-many parser :newline) (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))) (array/push (ast :data) (capture when-clause parser)))
(advance parser) (advance parser)
ast) 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 ### 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 ### 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 ### expressions
# four levels of expression complexity: # four levels of expression complexity:
@ -519,6 +853,7 @@
# non-binding expressions # non-binding expressions
# the rhs of lets, clauses, inside conditional forms, etc. # the rhs of lets, clauses, inside conditional forms, etc.
# any form that does not bind a name
(defrec nonbinding [parser] (defrec nonbinding [parser]
(def curr (current parser)) (def curr (current parser))
(case (type curr) (case (type curr)
@ -532,7 +867,7 @@
# strings # strings
:string (str parser) :string (str parser)
### TODO: interpolated strings ### TODO: interpolated strings
:interpolated (unreachable) :interpolated (interpolated parser)
# collection literals # collection literals
:lparen (tup parser) :lparen (tup parser)
@ -546,17 +881,17 @@
# conditional forms # conditional forms
:if (iff parser) :if (iff parser)
:when (whenn parser) :when (whenn parser)
:match (unreachable) :match (matchh parser)
:with (unreachable) :with (withh parser)
# do # do
:do (unreachable) :do (doo parser)
# fn: but only lambda # fn: but only lambda
:fn (unreachable) :fn (lambda parser)
# blocks # blocks
:lbrace (unreachable) :lbrace (block parser)
(panic parser (string "expected nonbinding expression, got " (type curr))) (panic parser (string "expected nonbinding expression, got " (type curr)))
) )
@ -565,9 +900,12 @@
(defrec expr [parser] (defrec expr [parser]
(def curr (current parser)) (def curr (current parser))
(case (type curr) (case (type curr)
:let (unreachable) # binding forms
:fn (unreachable) :let (lett parser)
:ref (unreachable) :fn (fnn parser)
:ref (ref parser)
# nonbinding forms
:nil (nill parser) :nil (nill parser)
:true (bool parser) :true (bool parser)
:false (bool parser) :false (bool parser)
@ -581,10 +919,10 @@
:word (word parser) :word (word parser)
:if (iff parser) :if (iff parser)
:when (whenn parser) :when (whenn parser)
:match (unreachable) :match (matchh parser)
:with (unreachable) :with (withh parser)
:do (unreachable) :do (doo parser)
:lbrace (unreachable) :lbrace (block parser)
(panic parser (string "expected expression, got " (type curr))) (panic parser (string "expected expression, got " (type curr)))
) )
) )
@ -592,41 +930,41 @@
(defrec toplevel [parser] (defrec toplevel [parser]
(def curr (current parser)) (def curr (current parser))
(case (type curr) (case (type curr)
:pkg (unreachable) # toplevel-only
:ns (unreachable) :pkg (pkg parser)
:test (unreachable) :ns (ns parser)
:import (unreachable) :test (testt parser)
:use (unreachable) :import (importt parser)
:let (unreachable) :use (usee parser)
:fn (unreachable)
:ref (unreachable) # all the other expressions
:nil (nill parser) (expr 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)))
) )
) )
(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 (do
#(comment #(comment
(def source `"foo { bar } baz \{quux} {fuzz}"`) (def source `match foo with {
1 -> 2 4
_ -> :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 (simple a-parser)) (def parsed (try (matchh a-parser) ([e] e)))
(-> 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