twc/ludus
4
0
Fork 0
Code Issues 32 Pull Requests Packages Projects 8 Releases Wiki Activity

Fix infinite hang bug with panics

Browse Source
This commit is contained in:
Scott Richmond 2022-03-12 13:30:33 -05:00
parent 0e4673a1a1
commit 1a1f720358
1 changed files with 14 additions and 9 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

21
src/ludus/parser.clj
View File

@ -41,6 +41,7 @@
::token/rparen ::token/rparen
::token/rbracket ::token/rbracket
::token/rbrace ::token/rbrace
::token/eof
}) })
(defn- sync [parser message origin end] (defn- sync [parser message origin end]
@ -62,10 +63,10 @@
([parser message sync-on] ([parser message sync-on]
(println "PANIC!!! in the parser") (println "PANIC!!! in the parser")
(let [ (let [
sync-on (if (set? sync-on) sync-on #{sync-on}) sync-on (conj (if (set? sync-on) sync-on #{sync-on}) ::token/eof)
origin (current parser) origin (current parser)
] ]
(loop [parser (advance parser)] (loop [parser parser]
(let [ (let [
curr (current parser) curr (current parser)
type (::token/type curr) type (::token/type curr)
@ -250,7 +251,7 @@
(parse-expr parser))] (parse-expr parser))]
(recur parsed exprs (::ast parsed))))))) (recur parsed exprs (::ast parsed)))))))
(defn- parse-script* [parser] (defn- parse-script [parser]
(loop [ (loop [
parser (accept-many #{::token/newline ::token/semicolon} parser) parser (accept-many #{::token/newline ::token/semicolon} parser)
exprs [] exprs []
@ -314,7 +315,6 @@
(::token/number ::token/string ::token/keyword) (parse-atom parser) (::token/number ::token/string ::token/keyword) (parse-atom parser)
::token/error ::token/error
(panic parser (:message (current parser)) sync-pattern) (panic parser (:message (current parser)) sync-pattern)
@ -329,12 +329,16 @@
(defn- parse-assignment [parser] (defn- parse-assignment [parser]
(let [assignment (expect ::token/equals "Expected assignment" parser)] (let [assignment (expect ::token/equals "Expected assignment" parser)]
(if (poisoned? assignment) (if (poisoned? assignment)
(panic parser (get-in assignment [::ast :message]) #{::token/newline ::token/semicolon}) assignment
(parse-let-expr assignment parser)))) (parse-let-expr assignment parser))))
(defn- parse-let [parser] (defn- parse-let [parser]
(let [pattern (parse-pattern (advance parser))] (let [pattern (parse-pattern (advance parser))]
(parse-assignment pattern))) (if (poisoned? pattern)
(panic (advance parser) "Expected pattern")
(parse-assignment pattern)
)
))
(defn- parse-if [parser] (defn- parse-if [parser]
(let [ (let [
@ -403,7 +407,8 @@
(do (do
(def pp pp/pprint) (def pp pp/pprint)
(def source "let foo") (def source "let then = 42
let foo = bar")
(def lexed (scanner/scan source)) (def lexed (scanner/scan source))
(def tokens (:tokens lexed)) (def tokens (:tokens lexed))
(def p (parser tokens)) (def p (parser tokens))
@ -415,7 +420,7 @@
(println "*** *** NEW PARSE *** ***") (println "*** *** NEW PARSE *** ***")
(-> p (-> p
(parse-script*) (parse-script)
(::ast) (::ast)
(pp) (pp)
) )