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

Improve parse-block

Browse Source
This commit is contained in:
Scott Richmond 2022-02-21 14:57:23 -05:00
parent 3357248b3c
commit 33fad7656c
1 changed files with 59 additions and 44 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

103
src/ludus/parser.clj
View File

@ -61,9 +61,9 @@
([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 (if (set? sync-on) sync-on #{sync-on})
origin (current parser) origin (current parser)
] ]
(loop [parser (advance parser)] (loop [parser (advance parser)]
(let [ (let [
curr (current parser) curr (current parser)
@ -162,7 +162,7 @@
(recur parsed members (::ast parsed))))))) (recur parsed members (::ast parsed)))))))
(defn- parse-list [origin] (defn- parse-list [origin]
(loop [ (loop [
parser (accept-many #{::token/newline ::token/comma} (advance origin)) parser (accept-many #{::token/newline ::token/comma} (advance origin))
members [] members []
current_member nil current_member nil
@ -170,9 +170,9 @@
(let [curr (current parser)] (let [curr (current parser)]
(case (token-type parser) (case (token-type parser)
::token/rbracket (let [ms (add-member members current_member)] ::token/rbracket (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/list {::ast/type ::ast/list
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
@ -189,7 +189,7 @@
(recur parsed members (::ast parsed))))))) (recur parsed members (::ast parsed)))))))
(defn- parse-set [origin] (defn- parse-set [origin]
(loop [ (loop [
parser (accept-many #{::token/newline ::token/comma} (advance origin)) parser (accept-many #{::token/newline ::token/comma} (advance origin))
members [] members []
current_member nil current_member nil
@ -215,27 +215,41 @@
(let [parsed (parse-expr parser)] (let [parsed (parse-expr parser)]
(recur parsed members (::ast parsed))))))) (recur parsed members (::ast parsed)))))))
(defn- parse-block [parser] (defn- parse-block [origin]
(loop [parser (advance parser) (loop [
parser (accept-many #{::token/newline ::token/semicolon} (advance origin))
exprs [] exprs []
current_expr nil] current_expr nil
(case (::token/type (current parser)) ]
::token/rbrace (let [curr (current parser)]
(assoc (advance parser) ::ast (case (token-type parser)
(if (and (empty? exprs) (nil? current_expr)) ::token/rbrace (let [es (add-member exprs current_expr)]
{::ast/type ::ast/poison :message "Blocks must have at least one expression"} (if (empty? es)
{::ast/type ::ast/block :exprs (add-member exprs current_expr)})) (panic parser "Blocks must have at least one expression")
(assoc (advance parser) ::ast {
(::token/semicolon ::token/newline) ::ast/type ::ast/block
(recur (advance parser) (add-member exprs current_expr) nil) :exprs es
})))
(if current_expr
(-> parser (::token/semicolon ::token/newline)
(advance) (recur (advance parser) (add-member exprs current_expr) nil)
(assoc ::ast {::ast/type ::ast/poison :message "Expected end of expression"}))
(let [parsed (parse-expr parser)] (::token/rbracket ::token/rparen)
(recur parsed exprs (::ast parsed)))) (panic parser (str "Mismatched enclosure in block: " (::token/lexeme curr)))
)))
::token/eof
(panic (assoc origin ::errors (::errors parser)) "Unterminated block" ::token/eof)
(let [parsed
(if current_expr
(panic parser "Expected end of expression" #{::token/semicolon ::token/newline})
(parse-expr parser))]
(recur parsed exprs (::ast parsed))
)
)
)
))
(defn- parse-script [parser] (defn- parse-script [parser]
(loop [parser parser (loop [parser parser
@ -243,25 +257,25 @@
current_expr nil] current_expr nil]
(if (at-end? parser) (if (at-end? parser)
(assoc parser ::ast (assoc parser ::ast
{::ast/type ::ast/script :exprs (add-member exprs current_expr)}) {::ast/type ::ast/script :exprs (add-member exprs current_expr)})
(case (::token/type (current parser)) (case (::token/type (current parser))
::token/eof (assoc parser ::ast ::token/eof (assoc parser ::ast
{::ast/type ::ast/script :exprs (add-member exprs current_expr)}) {::ast/type ::ast/script :exprs (add-member exprs current_expr)})
(::token/semicolon ::token/newline) (::token/semicolon ::token/newline)
(recur (advance parser) (add-member exprs current_expr) nil) (recur (advance parser) (add-member exprs current_expr) nil)
(if current_expr (if current_expr
(if (poisoned? current_expr) (if (poisoned? current_expr)
(panic parser (:message current_expr) #{::token/newline ::token/semicolon}) (panic parser (:message current_expr) #{::token/newline ::token/semicolon})
(let [synced (panic parser "Expected end of expression" #{::token/newline ::token/semicolon})] (let [synced (panic parser "Expected end of expression" #{::token/newline ::token/semicolon})]
(recur synced exprs (::ast synced)) (recur synced exprs (::ast synced))
))
(let [parsed (parse-expr parser)]
(recur parsed exprs (::ast parsed))
)) ))
(let [parsed (parse-expr parser)]
(recur parsed exprs (::ast parsed))
))
)))) ))))
(defn- parse-synthetic [parser] (defn- parse-synthetic [parser]
(loop [parser parser (loop [parser parser
@ -396,7 +410,8 @@
(do (do
(def pp pp/pprint) (def pp pp/pprint)
(def source "${32, (23, 42}") (def source "{ 1; 2; \"foo
}")
(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))