Compare commits

...

2 Commits

Author SHA1 Message Date
Scott Richmond
2027490614 improve some things 2024-07-16 20:12:21 -04:00
Scott Richmond
cb7098ac4e start fixing off-by-one errors: script, block, tuple, args, tup-patt 2024-07-16 19:40:40 -04:00

View File

@ -3,6 +3,9 @@
### We still need to scan some things ### We still need to scan some things
(import /src/scanner :as s) (import /src/scanner :as s)
# stash janet type
(def janet-type type)
(defmacro declare (defmacro declare
"Forward-declares a function name, so that it can be called in a mutually recursive manner." "Forward-declares a function name, so that it can be called in a mutually recursive manner."
[& names] [& names]
@ -18,6 +21,26 @@
(if-not (dyn name) (error "recursive functions must be declared before they are defined")) (if-not (dyn name) (error "recursive functions must be declared before they are defined"))
~(set ,name (defn- ,name ,;forms))) ~(set ,name (defn- ,name ,;forms)))
### Some more human-readable formatting
(defn- pp-tok [token]
(if (not token) (break "nil"))
(def {:line line :lexeme lex :type type :start start} token)
(string "<" line "[" start "]" ": " type ": " lex ">"))
(defn- pp-ast [ast &opt indent]
(default indent 0)
(def {:token token :data data :type type} ast)
(def pretty-tok (pp-tok token))
(def data-rep (if (= :array (janet-type data))
(string "[\n"
(string/join (map (fn [x] (pp-ast x (inc indent))) data)
(string (string/repeat " " indent) "\n"))
"\n" (string/repeat " " indent) "]")
data
))
(string (string/repeat " " indent) type ": " pretty-tok " " data-rep)
)
### Next: a data structure for a parser ### Next: a data structure for a parser
(defn- new-parser (defn- new-parser
"Creates a new parser data structure to pass around" "Creates a new parser data structure to pass around"
@ -75,7 +98,9 @@
(has-value? terminators ttype)) (has-value? terminators ttype))
# breakers are what terminate panics # breakers are what terminate panics
(def breaking [:break :newline :semicolon :comma :eof :then :else]) (def breaking [:break :newline :semicolon :comma :eof
# :then :else :arrow
])
(defn- breaks? (defn- breaks?
"Returns true if the current token in the parser should break a panic" "Returns true if the current token in the parser should break a panic"
@ -89,12 +114,12 @@
[parser message] [parser message]
# (print "Panic in the parser: " message) # (print "Panic in the parser: " message)
(def origin (current parser)) (def origin (current parser))
(advance parser) (def skipped @[])
(def skipped @[origin])
(while (not (breaks? parser)) (while (not (breaks? parser))
(array/push skipped (current parser)) (array/push skipped (current parser))
(advance parser)) (advance parser))
(array/push skipped (current parser)) (array/push skipped (current parser))
# (advance parser)
(def err {:type :error :data skipped :token origin :msg message}) (def err {:type :error :data skipped :token origin :msg message})
(update parser :errors array/push err) (update parser :errors array/push err)
(error err)) (error err))
@ -279,8 +304,8 @@
(def origin (current parser)) (def origin (current parser))
(advance parser) # consume the :lparen (advance parser) # consume the :lparen
(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 (not (check parser :rparen)) (while (not (check parser :rparen))
(accept-many parser ;separates)
(when (check parser :eof) (when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed paren"}) (def err {:type :error :token origin :msg "unclosed paren"})
(array/push (parser :errors) err) (array/push (parser :errors) err)
@ -299,8 +324,7 @@
{:type :placeholder :token origin})) {:type :placeholder :token origin}))
(capture nonbinding parser))) (capture nonbinding parser)))
(array/push (ast :data) term) (array/push (ast :data) term)
(try (separators parser) (capture separators parser))
([e] (array/push (ast :data) e))))
(advance parser) (advance parser)
ast) ast)
@ -337,16 +361,15 @@
(def origin (current parser)) (def origin (current parser))
(advance parser) # consume the :lparen (advance parser) # consume the :lparen
(def ast {:type :tuple :data @[] :token origin}) (def ast {:type :tuple :data @[] :token origin})
(while (separates? parser) (advance parser)) # consume any separators
(while (not (check parser :rparen)) (while (not (check parser :rparen))
(accept-many parser ;separates)
(when (check parser :eof) (when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed paren"}) (def err {:type :error :token origin :msg "unclosed paren"})
(array/push (parser :errors) err) (array/push (parser :errors) err)
(error err)) (error err))
(def term (capture nonbinding parser)) (def term (capture nonbinding parser))
(array/push (ast :data) term) (array/push (ast :data) term)
(try (separators parser) (capture separators parser))
([e] (array/push (ast :data) e))))
(advance parser) (advance parser)
ast) ast)
@ -354,8 +377,8 @@
(def origin (current parser)) (def origin (current parser))
(advance parser) (advance parser)
(def ast {:type :list :data @[] :token origin}) (def ast {:type :list :data @[] :token origin})
(while (separates? parser) (advance parser))
(while (not (check parser :rbracket)) (while (not (check parser :rbracket))
(accept-many parser ;separates)
(when (check parser :eof) (when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed bracket"}) (def err {:type :error :token origin :msg "unclosed bracket"})
(array/push (parser :errors) err) (array/push (parser :errors) err)
@ -369,8 +392,7 @@
) )
(capture nonbinding parser))) (capture nonbinding parser)))
(array/push (ast :data) term) (array/push (ast :data) term)
(try (separators parser) (capture separators parser))
([e] (array/push (ast :data) e))))
(advance parser) (advance parser)
ast) ast)
@ -378,8 +400,8 @@
(def origin (current parser)) (def origin (current parser))
(advance parser) (advance parser)
(def ast {:type :set :data @[] :token origin}) (def ast {:type :set :data @[] :token origin})
(while (separates? parser) (advance parser))
(while (not (check parser :rbrace)) (while (not (check parser :rbrace))
(accept-many parser ;separates)
(when (check parser :eof) (when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed brace"}) (def err {:type :error :token origin :msg "unclosed brace"})
(array/push (parser :errors) err) (array/push (parser :errors) err)
@ -393,8 +415,7 @@
) )
(capture nonbinding parser))) (capture nonbinding parser)))
(array/push (ast :data) term) (array/push (ast :data) term)
(try (separators parser) (capture separators parser))
([e] (array/push (ast :data) e))))
(advance parser) (advance parser)
ast) ast)
@ -402,8 +423,8 @@
(def origin (current parser)) (def origin (current parser))
(advance parser) (advance parser)
(def ast {:type :dict :data @[] :token origin}) (def ast {:type :dict :data @[] :token origin})
(while (separates? parser) (advance parser))
(while (not (check parser :rbrace)) (while (not (check parser :rbrace))
(accept-many parser ;separates)
(when (check parser :eof) (when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed brace"}) (def err {:type :error :token origin :msg "unclosed brace"})
(array/push (parser :errors) err) (array/push (parser :errors) err)
@ -423,7 +444,7 @@
(try (panic parser (string "expected dict term, got " (type origin))) ([e] e)) (try (panic parser (string "expected dict term, got " (type origin))) ([e] e))
)) ))
(array/push (ast :data) term) (array/push (ast :data) term)
(try (separators parser) ([e] (array/push (ast :data) e)))) (capture separators parser))
(advance parser) (advance parser)
ast) ast)
@ -452,8 +473,8 @@
(def origin (current parser)) (def origin (current parser))
(advance parser) # consume the :lparen (advance parser) # consume the :lparen
(def ast {:type :tuple :data @[] :token origin}) (def ast {:type :tuple :data @[] :token origin})
(while (separates? parser) (advance parser)) # consume any separators
(while (not (check parser :rparen)) (while (not (check parser :rparen))
(accept-many parser ;separates)
(when (check parser :eof) (when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed paren"}) (def err {:type :error :token origin :msg "unclosed paren"})
(array/push (parser :errors) err) (array/push (parser :errors) err)
@ -466,8 +487,7 @@
{:type :splat :data splatted :token origin}) {:type :splat :data splatted :token origin})
(capture pattern parser))) (capture pattern parser)))
(array/push (ast :data) term) (array/push (ast :data) term)
(try (separators parser) (capture separators parser))
([e] (array/push (ast :data) e))))
(advance parser) (advance parser)
ast) ast)
@ -475,8 +495,8 @@
(def origin (current parser)) (def origin (current parser))
(advance parser) (advance parser)
(def ast {:type :list :data @[] :token origin}) (def ast {:type :list :data @[] :token origin})
(while (separates? parser) (advance parser))
(while (not (check parser :rbracket)) (while (not (check parser :rbracket))
(accept-many parser ;separates)
(when (check parser :eof) (when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed bracket"}) (def err {:type :error :token origin :msg "unclosed bracket"})
(array/push (parser :errors) err) (array/push (parser :errors) err)
@ -489,8 +509,7 @@
{:type :splat :data splatted :token origin}) {:type :splat :data splatted :token origin})
(capture pattern parser))) (capture pattern parser)))
(array/push (ast :data) term) (array/push (ast :data) term)
(try (separators parser) (capture separators parser))
([e] (array/push (ast :data) e))))
(advance parser) (advance parser)
ast) ast)
@ -498,8 +517,8 @@
(def origin (current parser)) (def origin (current parser))
(advance parser) (advance parser)
(def ast {:type :dict :data @[] :token origin}) (def ast {:type :dict :data @[] :token origin})
(while (separates? parser) (advance parser))
(while (not (check parser :rbrace)) (while (not (check parser :rbrace))
(accept-many parser ;separates)
(when (check parser :eof) (when (check parser :eof)
(def err {:type :error :token origin :msg "unclosed brace"}) (def err {:type :error :token origin :msg "unclosed brace"})
(array/push (parser :errors) err) (array/push (parser :errors) err)
@ -519,7 +538,7 @@
(try (panic parser (string "expected dict term, got " (type origin))) ([e] e)) (try (panic parser (string "expected dict term, got " (type origin))) ([e] e))
)) ))
(array/push (ast :data) term) (array/push (ast :data) term)
(try (separators parser) ([e] (array/push (ast :data) e)))) (capture separators parser))
(advance parser) (advance parser)
ast) ast)
@ -560,22 +579,25 @@
(defn- iff [parser] (defn- iff [parser]
(def ast {:type :if :data @[] :token (current parser)}) (def ast {:type :if :data @[] :token (current parser)})
(advance parser) #consume the if (advance parser) #consume the if
(array/push (ast :data) (capture simple parser)) (array/push (ast :data) (simple parser))
(accept-many parser :newline) (accept-many parser :newline)
(if-let [err (expect-ret parser :then)] (if-let [err (expect-ret parser :then)]
(array/push (ast :data) err) (array/push (ast :data) err)
(advance parser)) (advance parser))
(array/push (ast :data) (capture nonbinding parser)) (array/push (ast :data) (nonbinding parser))
(accept-many parser :newline) (accept-many parser :newline)
(if-let [err (expect-ret parser :else)] (if-let [err (expect-ret parser :else)]
(array/push (ast :data) err) (array/push (ast :data) err)
(advance parser)) (advance parser))
(array/push (ast :data) (capture nonbinding parser)) (array/push (ast :data) (nonbinding parser))
ast) ast)
(defn- literal-terminator? [token]
(def tok-type (token :type))
(or (= :newline tok-type) (= :semicolon tok-type)))
(defn- terminator [parser] (defn- terminator [parser]
(if-not (terminates? parser) (if-not (terminates? parser)
# this line panics, captures the panic, advances the parser, and re-throws the error; solves an off-by-one error
(panic parser "expected terminator")) (panic parser "expected terminator"))
(advance parser) (advance parser)
(while (terminates? parser) (advance parser))) (while (terminates? parser) (advance parser)))
@ -798,13 +820,13 @@
(defn- block [parser] (defn- block [parser]
(def origin (current parser)) (def origin (current parser))
(expect parser :lbrace) (advance parser) (expect parser :lbrace) (advance parser)
(accept-many parser ;terminators)
(def data @[]) (def data @[])
(while (not (check parser :rbrace)) (while (not (check parser :rbrace))
(accept-many parser ;terminators)
(if (check parser :eof) (if (check parser :eof)
(error {:type :error :token origin :data data :msg "unclosed brace"})) (error {:type :error :token origin :data data :msg "unclosed brace"}))
(array/push data (capture expr parser)) (array/push data (capture expr parser))
(terminator parser)) (capture terminator parser))
(advance parser) (advance parser)
{:type :block :data data :token origin}) {:type :block :data data :token origin})
@ -1103,7 +1125,8 @@
(def origin (current parser)) (def origin (current parser))
(def lines @[]) (def lines @[])
(while (not (check parser :eof)) (while (not (check parser :eof))
(accept-many parser :newline) (print "starting script loop with " (pp-tok origin))
(accept-many parser ;terminators)
(array/push lines (capture toplevel parser)) (array/push lines (capture toplevel parser))
(capture terminator parser)) (capture terminator parser))
{:type :script :data lines :token origin}) {:type :script :data lines :token origin})
@ -1114,13 +1137,16 @@
(set (parser :ast) ast) (set (parser :ast) ast)
parser) parser)
# (do (do
(comment # (comment
(def source ` (def source `
[...x] (,,,,,1, 2 bar, foo)
`) `)
(def scanned (s/scan source)) (def scanned (s/scan source))
# (print "\n***NEW PARSE***\n") # (print "\n***NEW PARSE***\n")
(def a-parser (new-parser scanned)) (def a-parser (new-parser scanned))
(try (def parsed (pattern a-parser)) ([e] (pp e))) (def parsed (script a-parser))
(pp (map (fn [err] (err :msg)) ((parse scanned) :errors)))
(print (pp-ast ((parse scanned) :ast)))
) )