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

cljfmt

Browse Source
This commit is contained in:
Scott Richmond 2022-08-04 18:45:56 -04:00
parent 9684c2f4c5
commit cd0cad8ac3
1 changed files with 143 additions and 149 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

292
src/ludus/parser.clj
View File

@ -1,10 +1,10 @@
(ns ludus.parser (ns ludus.parser
(:require (:require
[ludus.token :as token] [ludus.token :as token]
[ludus.scanner :as scanner] [ludus.scanner :as scanner]
[ludus.ast :as ast] [ludus.ast :as ast]
[clojure.pprint :as pp] [clojure.pprint :as pp]
[clojure.set :as s])) [clojure.set :as s]))
;; a parser map and some functions to work with them ;; a parser map and some functions to work with them
(defn- parser [tokens] (defn- parser [tokens]
@ -47,8 +47,8 @@
:origin origin :origin origin
:end end}] :end end}]
(-> parser (-> parser
(assoc ::ast poison) (assoc ::ast poison)
(update ::errors conj poison)))) (update ::errors conj poison))))
(defn- poisoned? [parser] (defn- poisoned? [parser]
(= ::ast/poison (get-in parser [::ast ::ast/type]))) (= ::ast/poison (get-in parser [::ast ::ast/type])))
@ -74,8 +74,8 @@
(if (contains? tokens type) (if (contains? tokens type)
(advance parser) (advance parser)
(-> parser (-> parser
(advance) (advance)
(panic message tokens))))) (panic message tokens)))))
(defn- expect* [tokens message parser] (defn- expect* [tokens message parser]
(let [curr (current parser) (let [curr (current parser)
@ -106,10 +106,10 @@
(defn- parse-atom [parser] (defn- parse-atom [parser]
(let [token (current parser)] (let [token (current parser)]
(-> parser (-> parser
(advance) (advance)
(assoc ::ast {::ast/type ::ast/atom (assoc ::ast {::ast/type ::ast/atom
:token token :token token
:value (::token/literal token)})))) :value (::token/literal token)}))))
;; just a quick and dirty map to associate atomic words with values ;; just a quick and dirty map to associate atomic words with values
(def atomic-words {::token/nil nil (def atomic-words {::token/nil nil
@ -119,10 +119,10 @@
(defn parse-atomic-word [parser] (defn parse-atomic-word [parser]
(let [token (current parser)] (let [token (current parser)]
(-> parser (-> parser
(advance) (advance)
(assoc ::ast {::ast/type ::ast/atom (assoc ::ast {::ast/type ::ast/atom
:token token :token token
:value (get atomic-words (::token/type token))})))) :value (get atomic-words (::token/type token))}))))
(defn- parse-datatype [parser] (defn- parse-datatype [parser]
(let [token (current parser)] (let [token (current parser)]
@ -147,16 +147,16 @@
(case (token-type parser) (case (token-type parser)
::token/rparen (let [ms (add-member members current_member)] ::token/rparen (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/tuple {::ast/type ::ast/tuple
:length (count ms) :length (count ms)
:members ms :members ms
:token (current origin) :token (current origin)
:partial (contains-placeholder? ms)})) :partial (contains-placeholder? ms)}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbrace ::token/rbracket) (::token/rbrace ::token/rbracket)
(panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr)))
@ -164,11 +164,11 @@
::token/placeholder ::token/placeholder
(if (contains-placeholder? members) (if (contains-placeholder? members)
(recur (recur
(advance parser) (advance parser)
members members
(panic parser "Partially applied functions must be unary. (Only one placeholder allowed in partial application.)" curr)) (panic parser "Partially applied functions must be unary. (Only one placeholder allowed in partial application.)" curr))
(recur (recur
(advance parser) members {::ast/type ::ast/placeholder :token curr})) (advance parser) members {::ast/type ::ast/placeholder :token curr}))
::token/eof ::token/eof
(panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof) (panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof)
@ -184,24 +184,24 @@
(case (token-type parser) (case (token-type parser)
::token/rparen (let [ms (add-member members current_member)] ::token/rparen (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/tuple {::ast/type ::ast/tuple
:token (current origin) :token (current origin)
:length (count ms) :length (count ms)
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbrace ::token/rbracket) (::token/rbrace ::token/rbracket)
(panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr)))
::token/placeholder ::token/placeholder
(recur (recur
(advance parser) (advance parser)
members members
(panic parser "Placeholders in tuples may only be in function calls." curr)) (panic parser "Placeholders in tuples may only be in function calls." curr))
::token/eof ::token/eof
(panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof) (panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof)
@ -219,14 +219,14 @@
(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
:token (current origin) :token (current origin)
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbrace ::token/rparen) (::token/rbrace ::token/rparen)
(panic parser (str "Mismatched enclosure in list: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in list: " (::token/lexeme curr)))
@ -242,8 +242,8 @@
:token curr :expr (::ast splatted)}) :token curr :expr (::ast splatted)})
(panic parser "You may only splat words and synthetic expressions"))) (panic parser "You may only splat words and synthetic expressions")))
(if current_member (if current_member
(panic parser "Comma expected between list members") (panic parser "Comma expected between list members")
(let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rbracket})] (let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rbracket})]
(recur parsed members (::ast parsed)))))))) (recur parsed members (::ast parsed))))))))
@ -255,14 +255,14 @@
(case (token-type parser) (case (token-type parser)
::token/rbrace (let [ms (add-member members current_member)] ::token/rbrace (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/set {::ast/type ::ast/set
:token (current origin) :token (current origin)
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbracket ::token/rparen) (::token/rbracket ::token/rparen)
(panic parser (str "Mismatched enclosure in set: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in set: " (::token/lexeme curr)))
@ -291,14 +291,14 @@
(case (token-type parser) (case (token-type parser)
::token/rbrace (let [ms (add-member members current_member)] ::token/rbrace (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/dict {::ast/type ::ast/dict
:token (current origin) :token (current origin)
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbracket ::token/rparen) (::token/rbracket ::token/rparen)
(panic parser (str "Mismatched enclosure in dict: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in dict: " (::token/lexeme curr)))
@ -338,14 +338,14 @@
(case (token-type parser) (case (token-type parser)
::token/rbrace (let [ms (add-member members current_member)] ::token/rbrace (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/struct {::ast/type ::ast/struct
:token (current origin) :token (current origin)
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbracket ::token/rparen) (::token/rbracket ::token/rparen)
(panic parser (str "Mismatched enclosure in struct: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in struct: " (::token/lexeme curr)))
@ -356,12 +356,12 @@
::token/word ::token/word
(if (not current_member) (let [parsed (parse-word parser) word (get-in parsed [::ast :word])] (if (not current_member) (let [parsed (parse-word parser) word (get-in parsed [::ast :word])]
(recur parsed members {(keyword word) (::ast parsed)})) (recur parsed members {(keyword word) (::ast parsed)}))
(panic parser "Struct entries must be single words or keyword+expression pairs." #{::token/rbrace})) (panic parser "Struct entries must be single words or keyword+expression pairs." #{::token/rbrace}))
::token/keyword ::token/keyword
(if (not current_member) (let [kw (parse-atom parser) expr (parse-expr kw #{::token/comma ::token/newline ::token/rbrace})] (if (not current_member) (let [kw (parse-atom parser) expr (parse-expr kw #{::token/comma ::token/newline ::token/rbrace})]
(recur expr members {(:value (::ast kw)) (::ast expr)})) (recur expr members {(:value (::ast kw)) (::ast expr)}))
(panic parser "Struct entries must be single words or keyword+expression pairs." #{::token/rbrace})) (panic parser "Struct entries must be single words or keyword+expression pairs." #{::token/rbrace}))
(panic parser "Struct entries must be single words or keyword+expression pairs" #{::token/rbrace}))))) (panic parser "Struct entries must be single words or keyword+expression pairs" #{::token/rbrace})))))
@ -381,15 +381,15 @@
(case (token-type parser) (case (token-type parser)
::token/rbrace (let [ms (add-member members current_member)] ::token/rbrace (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/ns {::ast/type ::ast/ns
:token (current ns-root) :token (current ns-root)
:name (get-in (parse-word (advance ns-root)) [::ast :word]) :name (get-in (parse-word (advance ns-root)) [::ast :word])
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbracket ::token/rparen) (::token/rbracket ::token/rparen)
(panic parser (str "Mismatched enclosure in ns: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in ns: " (::token/lexeme curr)))
@ -400,12 +400,12 @@
::token/word ::token/word
(if (not current_member) (let [parsed (parse-word parser) word (get-in parsed [::ast :word])] (if (not current_member) (let [parsed (parse-word parser) word (get-in parsed [::ast :word])]
(recur parsed members {(keyword word) (::ast parsed)})) (recur parsed members {(keyword word) (::ast parsed)}))
(panic parser "ns entries must be single words or keyword+expression pairs." #{::token/rbrace})) (panic parser "ns entries must be single words or keyword+expression pairs." #{::token/rbrace}))
::token/keyword ::token/keyword
(if (not current_member) (let [kw (parse-atom parser) expr (parse-expr kw #{::token/comma ::token/newline ::token/rbrace})] (if (not current_member) (let [kw (parse-atom parser) expr (parse-expr kw #{::token/comma ::token/newline ::token/rbrace})]
(recur expr members {(:value (::ast kw)) (::ast expr)})) (recur expr members {(:value (::ast kw)) (::ast expr)}))
(panic parser "ns entries must be single words or keyword+expression pairs." #{::token/rbrace})) (panic parser "ns entries must be single words or keyword+expression pairs." #{::token/rbrace}))
(panic parser "ns entries must be single words or keyword+expression pairs" #{::token/rbrace}))))))) (panic parser "ns entries must be single words or keyword+expression pairs" #{::token/rbrace})))))))
@ -425,8 +425,8 @@
(::token/semicolon ::token/newline) (::token/semicolon ::token/newline)
(recur (recur
(accept-many #{::token/newline ::token/semicolon} parser) (accept-many #{::token/newline ::token/semicolon} parser)
(add-member exprs current_expr) nil) (add-member exprs current_expr) nil)
(::token/rbracket ::token/rparen) (::token/rbracket ::token/rparen)
(panic parser (str "Mismatched enclosure in block: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in block: " (::token/lexeme curr)))
@ -440,8 +440,6 @@
(parse-expr parser))] (parse-expr parser))]
(recur parsed exprs (::ast parsed))))))) (recur parsed exprs (::ast parsed)))))))
(defn- parse-synthetic [parser] (defn- parse-synthetic [parser]
(loop [parser parser (loop [parser parser
terms []] terms []]
@ -463,34 +461,33 @@
(defn- parse-word [parser] (defn- parse-word [parser]
(let [curr (current parser)] (let [curr (current parser)]
(-> parser (-> parser
(advance) (advance)
(assoc ::ast {::ast/type ::ast/word :token (current parser) :word (::token/lexeme curr)})))) (assoc ::ast {::ast/type ::ast/word :token (current parser) :word (::token/lexeme curr)}))))
(def sync-pattern (s/union sync-on #{::token/equals ::token/rarrow})) (def sync-pattern (s/union sync-on #{::token/equals ::token/rarrow}))
(defn- parse-list-tuple-splat-pattern [origin] (defn- parse-list-tuple-splat-pattern [origin]
(let [splatted (advance origin)] (let [splatted (advance origin)]
(case (token-type splatted) (case (token-type splatted)
::token/word ::token/word
(assoc (advance splatted) ::ast (assoc (advance splatted) ::ast
{::ast/type ::ast/splat {::ast/type ::ast/splat
:token (current origin) :token (current origin)
:into (::ast (parse-word splatted))}) :into (::ast (parse-word splatted))})
::token/placeholder ::token/placeholder
(assoc (advance splatted) ::ast (assoc (advance splatted) ::ast
{::ast/type ::ast/splat {::ast/type ::ast/splat
:token (current origin) :token (current origin)
:into {::ast/type ::ast/placeholder :token (current splatted)}}) :into {::ast/type ::ast/placeholder :token (current splatted)}})
(::token/comma ::token/newline ::token/rbrace ::token/rparen ::token/rbracket) (::token/comma ::token/newline ::token/rbrace ::token/rparen ::token/rbracket)
(assoc splatted ::ast (assoc splatted ::ast
{::ast/type ::ast/splat {::ast/type ::ast/splat
:token (current origin) :token (current origin)
:into {::ast/type ::ast/placeholder :token (current origin)}}) :into {::ast/type ::ast/placeholder :token (current origin)}})
(panic origin "Splat patterns may only splat into words or placeholders.") (panic origin "Splat patterns may only splat into words or placeholders."))))
)))
(defn- parse-list-pattern [origin] (defn- parse-list-pattern [origin]
(loop [parser (accept-many #{::token/newline ::token/comma} (advance origin)) (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin))
@ -502,16 +499,16 @@
(let [ms (add-member members current_member)] (let [ms (add-member members current_member)]
(if (not-any? #(= (::ast/type %) ::ast/splat) (drop-last ms)) (if (not-any? #(= (::ast/type %) ::ast/splat) (drop-last ms))
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/list {::ast/type ::ast/list
:token (current origin) :token (current origin)
:length (count ms) :length (count ms)
:members ms}) :members ms})
(panic parser "A splat my only appear once in a list pattern, at the end of the pattern."))) (panic parser "A splat my only appear once in a list pattern, at the end of the pattern.")))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbrace ::token/rparen) (::token/rbrace ::token/rparen)
(panic parser (str "Mismatched enclosure in list pattern: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in list pattern: " (::token/lexeme curr)))
@ -537,7 +534,7 @@
(if (current-key members) (if (current-key members)
(panic parser (str "Dict patterns may not duplicate keys: " current-key)) (panic parser (str "Dict patterns may not duplicate keys: " current-key))
(let [ms (add-member members current_member)] (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/dict {::ast/type ::ast/dict
:token (current origin) :token (current origin)
:members ms})))) :members ms}))))
@ -547,8 +544,8 @@
(if (current-key members) (if (current-key members)
(panic parser (str "Dict patterns may not duplicate keys: " current-key)) (panic parser (str "Dict patterns may not duplicate keys: " current-key))
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil))) (add-member members current_member) nil)))
(::token/rbracket ::token/rparen) (::token/rbracket ::token/rparen)
(panic parser (str "Mismatched enclosure in dict pattern: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in dict pattern: " (::token/lexeme curr)))
@ -593,14 +590,14 @@
(case (token-type parser) (case (token-type parser)
::token/rbrace (let [ms (add-member members current_member)] ::token/rbrace (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/struct {::ast/type ::ast/struct
:token (current origin) :token (current origin)
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbracket ::token/rparen) (::token/rbracket ::token/rparen)
(panic parser (str "Mismatched enclosure in struct pattern: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in struct pattern: " (::token/lexeme curr)))
@ -637,28 +634,26 @@
(panic parser "Struct patterns may only include single words or keyword+pattern pairs." #{::token/rbrace}))))) (panic parser "Struct patterns may only include single words or keyword+pattern pairs." #{::token/rbrace})))))
(defn- parse-tuple-pattern [origin] (defn- parse-tuple-pattern [origin]
(loop [parser (accept-many #{::token/newline ::token/comma} (advance origin)) (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin))
members [] members []
current_member nil] current_member nil]
(let [curr (current parser)] (let [curr (current parser)]
(case (token-type parser) (case (token-type parser)
::token/rparen ::token/rparen
(let [ms (add-member members current_member)] (let [ms (add-member members current_member)]
(if (not-any? #(= (::ast/type %) ::ast/splat) (drop-last ms)) (if (not-any? #(= (::ast/type %) ::ast/splat) (drop-last ms))
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/tuple {::ast/type ::ast/tuple
:token (current origin) :token (current origin)
:length (count ms) :length (count ms)
:members ms}) :members ms})
(panic parser "A splat my only appear once in a tuple pattern, at the end of the pattern."))) (panic parser "A splat my only appear once in a tuple pattern, at the end of the pattern.")))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(accept-many #{::token/comma ::token/newline} parser) (accept-many #{::token/comma ::token/newline} parser)
(add-member members current_member) nil) (add-member members current_member) nil)
(::token/rbrace ::token/rbracket) (::token/rbrace ::token/rbracket)
(panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr)))
@ -679,8 +674,8 @@
(case type (case type
(::token/placeholder ::token/ignored) (::token/placeholder ::token/ignored)
(-> parser (-> parser
(advance) (advance)
(assoc ::ast {::ast/type ::ast/placeholder :token curr})) (assoc ::ast {::ast/type ::ast/placeholder :token curr}))
::token/word (parse-word parser) ::token/word (parse-word parser)
@ -874,12 +869,12 @@
(defn- parse-cond-clause [parser] (defn- parse-cond-clause [parser]
(let [expr (if (let [expr (if
(contains? #{::token/else ::token/placeholder} (token-type parser)) (contains? #{::token/else ::token/placeholder} (token-type parser))
(-> parser (-> parser
(advance) (advance)
(assoc ::ast {::ast/type ::ast/atom (assoc ::ast {::ast/type ::ast/atom
:token (current parser) :token (current parser)
:value true})) :value true}))
(parse-expr parser)) (parse-expr parser))
rarrow (expect* #{::token/rarrow} "Expected arrow after expression in cond clause" expr)] rarrow (expect* #{::token/rarrow} "Expected arrow after expression in cond clause" expr)]
(if (:success rarrow) (if (:success rarrow)
@ -1046,37 +1041,36 @@
(if (= (token-type dt) ::token/datatype) (if (= (token-type dt) ::token/datatype)
(let [dt-ast (parse-datatype dt) (let [dt-ast (parse-datatype dt)
after-dt (token-type dt-ast)] after-dt (token-type dt-ast)]
(case after-dt (case after-dt
::token/newline (assoc dt-ast ::ast {::ast/type ::ast/datatype ::token/newline (assoc dt-ast ::ast {::ast/type ::ast/datatype
:token (current parser) :token (current parser)
:constructor-type :nullary}) :constructor-type :nullary})
::token/lparen ::token/lparen
(let [pattern (parse-tuple-pattern (advance dt-ast))] (let [pattern (parse-tuple-pattern (advance dt-ast))]
(assoc pattern ::ast {::ast/type ::ast/datatype (assoc pattern ::ast {::ast/type ::ast/datatype
:token (current parser) :token (current parser)
:constructor-type :tuple :constructor-type :tuple
:pattern (::ast pattern)})) :pattern (::ast pattern)}))
::token/lbrace ::token/lbrace
(let [pattern (parse-struct-pattern (advance dt-ast))] (let [pattern (parse-struct-pattern (advance dt-ast))]
(assoc pattern ::ast {::ast/type ::ast/datatype (assoc pattern ::ast {::ast/type ::ast/datatype
:token (current parser) :token (current parser)
:constructor-type :struct :constructor-type :struct
:pattern (::ast pattern)})) :pattern (::ast pattern)}))
(panic dt-ast (str "Undexpected " (get-in dt-ast [::token :lexeme]) "after datatype declaration.")))) (panic dt-ast (str "Undexpected " (get-in dt-ast [::token :lexeme]) "after datatype declaration."))))
(panic dt "Expected datatype name after data reserved word.")))) (panic dt "Expected datatype name after data reserved word."))))
(defn- parse-toplevel [parser] (defn- parse-toplevel [parser]
(case (token-type parser) (case (token-type parser)
::token/ns (parse-ns parser) ::token/ns (parse-ns parser)
::token/import (parse-import parser) ::token/import (parse-import parser)
::token/data (parse-data parser) ::token/data (parse-data parser)
(parse-expr parser))) (parse-expr parser)))
(defn parse-script [origin] (defn parse-script [origin]
(loop [parser (accept-many #{::token/newline ::token/semicolon} origin) (loop [parser (accept-many #{::token/newline ::token/semicolon} origin)
@ -1090,11 +1084,11 @@
(assoc parser ::ast {::ast/type ::ast/script (assoc parser ::ast {::ast/type ::ast/script
:token (current origin) :exprs es}))) :token (current origin) :exprs es})))
(::token/semicolon ::token/newline) (::token/semicolon ::token/newline)
(recur (recur
(accept-many #{::token/semicolon ::token/newline} parser) (accept-many #{::token/semicolon ::token/newline} parser)
(add-member exprs current_expr) (add-member exprs current_expr)
nil) nil)
(let [parsed (let [parsed
(if current_expr (if current_expr
@ -1189,9 +1183,9 @@
(defn parse [lexed] (defn parse [lexed]
(-> lexed (-> lexed
(:tokens) (:tokens)
(parser) (parser)
(parse-script))) (parse-script)))
(do (do
(def source " (def source "