diff --git a/src/ludus/parser.clj b/src/ludus/parser.clj index bac7dba..4034a0e 100644 --- a/src/ludus/parser.clj +++ b/src/ludus/parser.clj @@ -34,18 +34,18 @@ ;; handle some errors (def sync-on #{::token/newline - ::token/semicolon - ::token/comma - ::token/rparen - ::token/rbracket - ::token/rbrace - ::token/eof}) + ::token/semicolon + ::token/comma + ::token/rparen + ::token/rbracket + ::token/rbrace + ::token/eof}) (defn- psync [parser message origin end] (let [poison {::ast/type ::ast/poison - :message message - :origin origin - :end end}] + :message message + :origin origin + :end end}] (-> parser (assoc ::ast poison) (update ::errors conj poison)))) @@ -58,10 +58,10 @@ ([parser message sync-on] (println (str "PANIC!!! in the parser: " message)) (let [sync-on (conj (if (set? sync-on) sync-on #{sync-on}) ::token/eof) - origin (current parser)] + origin (current parser)] (loop [parser parser] (let [curr (current parser) - type (::token/type curr)] + type (::token/type curr)] (if (or (at-end? parser) (contains? sync-on type)) (psync parser message origin curr) (recur (advance parser)))))))) @@ -69,8 +69,8 @@ ;; some helper functions (defn- expect [tokens message parser] (let [curr (current parser) - tokens (if (set? tokens) tokens #{tokens}) - type (::token/type curr)] + tokens (if (set? tokens) tokens #{tokens}) + type (::token/type curr)] (if (contains? tokens type) (advance parser) (-> parser @@ -79,16 +79,16 @@ (defn- expect* [tokens message parser] (let [curr (current parser) - tokens (if (set? tokens) tokens #{tokens}) - type (::token/type curr)] + tokens (if (set? tokens) tokens #{tokens}) + type (::token/type curr)] (if (contains? tokens type) {:success true :parser (advance parser)} {:success false :parser (panic (advance parser) message)}))) (defn- accept [tokens parser] (let [curr (current parser) - tokens (if (set? tokens) tokens #{tokens}) - type (::token/type curr)] + tokens (if (set? tokens) tokens #{tokens}) + type (::token/type curr)] (if (contains? tokens type) (advance parser) parser))) @@ -97,7 +97,7 @@ (let [tokens (if (set? tokens) tokens #{tokens})] (loop [parser parser] (let [curr (current parser) - type (::token/type curr)] + type (::token/type curr)] (if (contains? tokens type) (recur (advance parser)) parser))))) @@ -108,21 +108,21 @@ (-> parser (advance) (assoc ::ast {::ast/type ::ast/atom - :token token - :value (::token/literal token)})))) + :token token + :value (::token/literal token)})))) ;; just a quick and dirty map to associate atomic words with values (def atomic-words {::token/nil nil - ::token/true true - ::token/false false}) + ::token/true true + ::token/false false}) (defn parse-atomic-word [parser] (let [token (current parser)] (-> parser (advance) (assoc ::ast {::ast/type ::ast/atom - :token token - :value (get atomic-words (::token/type token))})))) + :token token + :value (get atomic-words (::token/type token))})))) (defn- add-member [members member] (if (nil? member) @@ -134,261 +134,304 @@ (defn- parse-fn-tuple [origin] (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin)) - members [] - current_member nil] - (let [curr (current parser)] - (case (token-type parser) - ::token/rparen (let [ms (add-member members current_member)] - (assoc (advance parser) ::ast - {::ast/type ::ast/tuple - :length (count ms) - :members ms - :partial (contains-placeholder? ms)})) + members [] + current_member nil] + (let [curr (current parser)] + (case (token-type parser) + ::token/rparen (let [ms (add-member members current_member)] + (assoc (advance parser) ::ast + {::ast/type ::ast/tuple + :length (count ms) + :members ms + :partial (contains-placeholder? ms)})) - (::token/comma ::token/newline) - (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) + (::token/comma ::token/newline) + (recur + (accept-many #{::token/comma ::token/newline} parser) + (add-member members current_member) nil) - (::token/rbrace ::token/rbracket) - (panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr))) + (::token/rbrace ::token/rbracket) + (panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr))) - ::token/placeholder - (if (contains-placeholder? members) - (recur - (advance parser) - members - (panic parser "Partially applied functions must be unary. (Only one placeholder allowed in partial application.)" curr)) - (recur - (advance parser) members {::ast/type ::ast/placeholder})) - - ::token/eof - (panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof) - - (let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rparen})] - (recur parsed members (::ast parsed))))))) - -(defn- parse-tuple [origin] - (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin)) - members [] - current_member nil] - (let [curr (current parser)] - (case (token-type parser) - ::token/rparen (let [ms (add-member members current_member)] - (assoc (advance parser) ::ast - {::ast/type ::ast/tuple - :length (count ms) - :members ms})) - - (::token/comma ::token/newline) - (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) - - (::token/rbrace ::token/rbracket) - (panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr))) - - ::token/placeholder + ::token/placeholder + (if (contains-placeholder? members) (recur (advance parser) members - (panic parser "Placeholders in tuples may only be in function calls." curr)) + (panic parser "Partially applied functions must be unary. (Only one placeholder allowed in partial application.)" curr)) + (recur + (advance parser) members {::ast/type ::ast/placeholder})) - ::token/eof - (panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof) + ::token/eof + (panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof) - (let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rparen})] - (recur parsed members (::ast parsed))))))) + (let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rparen})] + (recur parsed members (::ast parsed))))))) + +(defn- parse-tuple [origin] + (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin)) + members [] + current_member nil] + (let [curr (current parser)] + (case (token-type parser) + ::token/rparen (let [ms (add-member members current_member)] + (assoc (advance parser) ::ast + {::ast/type ::ast/tuple + :length (count ms) + :members ms})) + + (::token/comma ::token/newline) + (recur + (accept-many #{::token/comma ::token/newline} parser) + (add-member members current_member) nil) + + (::token/rbrace ::token/rbracket) + (panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr))) + + ::token/placeholder + (recur + (advance parser) + members + (panic parser "Placeholders in tuples may only be in function calls." curr)) + + ::token/eof + (panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof) + + (let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rparen})] + (recur parsed members (::ast parsed))))))) (defn- parse-list [origin] (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin)) - members [] - current_member nil] - (let [curr (current parser)] - (case (token-type parser) - ::token/rbracket (let [ms (add-member members current_member)] - (assoc (advance parser) ::ast - {::ast/type ::ast/list - :members ms})) + members [] + current_member nil] + (let [curr (current parser)] + (case (token-type parser) + ::token/rbracket (let [ms (add-member members current_member)] + (assoc (advance parser) ::ast + {::ast/type ::ast/list + :members ms})) - (::token/comma ::token/newline) - (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) + (::token/comma ::token/newline) + (recur + (accept-many #{::token/comma ::token/newline} parser) + (add-member members current_member) nil) - (::token/rbrace ::token/rparen) - (panic parser (str "Mismatched enclosure in list: " (::token/lexeme curr))) + (::token/rbrace ::token/rparen) + (panic parser (str "Mismatched enclosure in list: " (::token/lexeme curr))) - ::token/eof - (panic (assoc origin ::errors (::errors parser)) "Unterminated list" ::token/eof) + ::token/eof + (panic (assoc origin ::errors (::errors parser)) "Unterminated list" ::token/eof) - (let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rbracket})] - (recur parsed members (::ast parsed))))))) + (let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rbracket})] + (recur parsed members (::ast parsed))))))) (defn- parse-set [origin] (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin)) - members [] - current_member nil] - (let [curr (current parser)] - (case (token-type parser) - ::token/rbrace (let [ms (add-member members current_member)] - (assoc (advance parser) ::ast - {::ast/type ::ast/set - :members ms})) + members [] + current_member nil] + (let [curr (current parser)] + (case (token-type parser) + ::token/rbrace (let [ms (add-member members current_member)] + (assoc (advance parser) ::ast + {::ast/type ::ast/set + :members ms})) - (::token/comma ::token/newline) - (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) + (::token/comma ::token/newline) + (recur + (accept-many #{::token/comma ::token/newline} parser) + (add-member members current_member) nil) - (::token/rbracket ::token/rparen) - (panic parser (str "Mismatched enclosure in set: " (::token/lexeme curr))) + (::token/rbracket ::token/rparen) + (panic parser (str "Mismatched enclosure in set: " (::token/lexeme curr))) - ::token/eof - (panic (assoc origin ::errors (::errors parser)) "Unterminated set" ::token/eof) + ::token/eof + (panic (assoc origin ::errors (::errors parser)) "Unterminated set" ::token/eof) - (let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rbrace})] - (recur parsed members (::ast parsed))))))) + (let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rbrace})] + (recur parsed members (::ast parsed))))))) (defn- parse-hash [origin] (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin)) - members {} - current_member nil] - (let [curr (current parser)] - (case (token-type parser) - ::token/rbrace (let [ms (add-member members current_member)] - (assoc (advance parser) ::ast - {::ast/type ::ast/hash - :members ms})) + members {} + current_member nil] + (let [curr (current parser)] + (case (token-type parser) + ::token/rbrace (let [ms (add-member members current_member)] + (assoc (advance parser) ::ast + {::ast/type ::ast/hash + :members ms})) - (::token/comma ::token/newline) - (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) + (::token/comma ::token/newline) + (recur + (accept-many #{::token/comma ::token/newline} parser) + (add-member members current_member) nil) - (::token/rbracket ::token/rparen) - (panic parser (str "Mismatched enclosure in hashmap: " (::token/lexeme curr))) + (::token/rbracket ::token/rparen) + (panic parser (str "Mismatched enclosure in hashmap: " (::token/lexeme curr))) - ::token/eof - (panic (assoc origin ::errors (::errors parser)) "Unterminated hashmap" ::token/eof) + ::token/eof + (panic (assoc origin ::errors (::errors parser)) "Unterminated hashmap" ::token/eof) - ::token/word - (if (not current_member) (let [parsed (parse-word parser) word (get-in parsed [::ast :word])] - (recur parsed members {(keyword word) (::ast parsed)})) - (panic parser "Hashmap entries must be single words or keyword+expression pairs." #{::token/rbrace})) + ::token/word + (if (not current_member) (let [parsed (parse-word parser) word (get-in parsed [::ast :word])] + (recur parsed members {(keyword word) (::ast parsed)})) + (panic parser "Hashmap entries must be single words or keyword+expression pairs." #{::token/rbrace})) - ::token/keyword - (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)})) - (panic parser "Hashmap entries must be single words or keyword+expression pairs." #{::token/rbrace})) + ::token/keyword + (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)})) + (panic parser "Hashmap entries must be single words or keyword+expression pairs." #{::token/rbrace})) - (panic parser "Hashmap entries must be single words or keyword+expression pairs" #{::token/rbrace}))))) + (panic parser "Hashmap entries must be single words or keyword+expression pairs" #{::token/rbrace}))))) (defn- parse-struct [origin] (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin)) - members {} - current_member nil] - (let [curr (current parser)] - (case (token-type parser) - ::token/rbrace (let [ms (add-member members current_member)] - (assoc (advance parser) ::ast - {::ast/type ::ast/struct - :members ms})) + members {} + current_member nil] + (let [curr (current parser)] + (case (token-type parser) + ::token/rbrace (let [ms (add-member members current_member)] + (assoc (advance parser) ::ast + {::ast/type ::ast/struct + :members ms})) - (::token/comma ::token/newline) - (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) + (::token/comma ::token/newline) + (recur + (accept-many #{::token/comma ::token/newline} parser) + (add-member members current_member) nil) - (::token/rbracket ::token/rparen) - (panic parser (str "Mismatched enclosure in struct: " (::token/lexeme curr))) + (::token/rbracket ::token/rparen) + (panic parser (str "Mismatched enclosure in struct: " (::token/lexeme curr))) - ::token/eof - (panic (assoc origin ::errors (::errors parser)) "Unterminated struct" ::token/eof) + ::token/eof + (panic (assoc origin ::errors (::errors parser)) "Unterminated struct" ::token/eof) - ::token/word - (if (not current_member) (let [parsed (parse-word parser) word (get-in parsed [::ast :word])] - (recur parsed members {(keyword word) (::ast parsed)})) - (panic parser "Struct entries must be single words or keyword+expression pairs." #{::token/rbrace})) + ::token/word + (if (not current_member) (let [parsed (parse-word parser) word (get-in parsed [::ast :word])] + (recur parsed members {(keyword word) (::ast parsed)})) + (panic parser "Struct entries must be single words or keyword+expression pairs." #{::token/rbrace})) - ::token/keyword - (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)})) - (panic parser "Struct entries must be single words or keyword+expression pairs." #{::token/rbrace})) + ::token/keyword + (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)})) + (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}))))) + +(defn- parse-ns [parser] + (let [name (expect* #{::token/word} "Expected ns name" (advance parser)) + origin (expect* #{::token/lbrace} "Expected { after ns name" (:parser name))] + (cond + (not (:success name)) (panic parser "Expected ns name" #{::token/newline}) + + (not (:success origin)) (panic (:parser name) "Expected { after ns name") + + :else + (loop [parser (accept-many #{::token/newline ::token/comma} (advance (:parser name))) + members {} + current_member nil] + (let [curr (current parser)] + (case (token-type parser) + ::token/rbrace (let [ms (add-member members current_member)] + (assoc (advance parser) ::ast + {::ast/type ::ast/ns + :name (::ast name) + :members ms})) + + (::token/comma ::token/newline) + (recur + (accept-many #{::token/comma ::token/newline} parser) + (add-member members current_member) nil) + + (::token/rbracket ::token/rparen) + (panic parser (str "Mismatched enclosure in ns: " (::token/lexeme curr))) + + ::token/eof + (panic (assoc origin ::errors (::errors parser)) "Unterminated ns" ::token/eof) + + ::token/word + (if (not current_member) (let [parsed (parse-word parser) word (get-in parsed [::ast :word])] + (recur parsed members {(keyword word) (::ast parsed)})) + (panic parser "ns entries must be single words or keyword+expression pairs." #{::token/rbrace})) + + ::token/keyword + (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)})) + (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}))))))) (defn- parse-block [origin] (loop [parser (accept-many #{::token/newline ::token/semicolon} (advance origin)) - exprs [] - current_expr nil] - (let [curr (current parser)] - (case (token-type parser) - ::token/rbrace - (let [es (add-member exprs current_expr)] - (if (empty? es) - (advance (panic parser "Blocks must have at least one expression")) - (assoc (advance parser) ::ast {::ast/type ::ast/block - :exprs es}))) - - (::token/semicolon ::token/newline) - (recur - (accept-many #{::token/newline ::token/semicolon} parser) - (add-member exprs current_expr) nil) - - (::token/rbracket ::token/rparen) - (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] - (loop [parser (accept-many #{::token/newline ::token/semicolon} parser) - exprs [] - current_expr nil] + exprs [] + current_expr nil] + (let [curr (current parser)] (case (token-type parser) - ::token/eof + ::token/rbrace (let [es (add-member exprs current_expr)] (if (empty? es) - (panic parser "Scripts must have at least one expression") - (assoc parser ::ast {::ast/type ::ast/script :exprs es}))) + (advance (panic parser "Blocks must have at least one expression")) + (assoc (advance parser) ::ast {::ast/type ::ast/block + :exprs es}))) (::token/semicolon ::token/newline) (recur - (accept-many #{::token/semicolon ::token/newline} parser) - (add-member exprs current_expr) - nil) + (accept-many #{::token/newline ::token/semicolon} parser) + (add-member exprs current_expr) nil) + + (::token/rbracket ::token/rparen) + (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))] + (if current_expr + (panic parser "Expected end of expression" #{::token/semicolon ::token/newline}) + (parse-expr parser))] + (recur parsed exprs (::ast parsed))))))) - (recur parsed exprs (::ast parsed)))))) +(defn parse-script [parser] + (loop [parser (accept-many #{::token/newline ::token/semicolon} parser) + exprs [] + current_expr nil] + (case (token-type parser) + ::token/eof + (let [es (add-member exprs current_expr)] + (if (empty? es) + (panic parser "Scripts must have at least one expression") + (assoc parser ::ast {::ast/type ::ast/script :exprs es}))) + + (::token/semicolon ::token/newline) + (recur + (accept-many #{::token/semicolon ::token/newline} parser) + (add-member exprs current_expr) + nil) + + (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-synthetic [parser] (loop [parser parser - terms []] - (let [curr (current parser) - type (::token/type curr)] - (case type - ::token/keyword - (recur (advance parser) (conj terms (::ast (parse-atom parser)))) + terms []] + (let [curr (current parser) + type (::token/type curr)] + (case type + ::token/keyword + (recur (advance parser) (conj terms (::ast (parse-atom parser)))) - ::token/word - (recur (advance parser) (conj terms (::ast (parse-word parser)))) + ::token/word + (recur (advance parser) (conj terms (::ast (parse-word parser)))) - ::token/lparen - (let [parsed (parse-fn-tuple parser)] - (recur parsed (conj terms (::ast parsed)))) + ::token/lparen + (let [parsed (parse-fn-tuple parser)] + (recur parsed (conj terms (::ast parsed)))) - (assoc parser ::ast {::ast/type ::ast/synthetic :terms terms}))))) + (assoc parser ::ast {::ast/type ::ast/synthetic :terms terms}))))) (defn- parse-word [parser] (let [curr (current parser)] @@ -400,37 +443,37 @@ (defn- parse-tuple-pattern [origin] (loop [parser (accept-many #{::token/newline ::token/comma} (advance origin)) - members [] - current_member nil] - (let [curr (current parser)] - (case (token-type parser) - ::token/rparen (let [ms (add-member members current_member)] - (assoc (advance parser) ::ast - {::ast/type ::ast/tuple - :length (count ms) - :members ms})) + members [] + current_member nil] + (let [curr (current parser)] + (case (token-type parser) + ::token/rparen (let [ms (add-member members current_member)] + (assoc (advance parser) ::ast + {::ast/type ::ast/tuple + :length (count ms) + :members ms})) - (::token/comma ::token/newline) - (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) + (::token/comma ::token/newline) + (recur + (accept-many #{::token/comma ::token/newline} parser) + (add-member members current_member) nil) - (::token/rbrace ::token/rbracket) - (panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr))) + (::token/rbrace ::token/rbracket) + (panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr))) - ::token/eof - (panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof) + ::token/eof + (panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof) - (let [parsed (parse-pattern parser)] - (recur parsed members (::ast parsed))))))) + (let [parsed (parse-pattern parser)] + (recur parsed members (::ast parsed))))))) (defn- parse-pattern [parser] (let [curr (current parser) - type (::token/type curr)] + type (::token/type curr)] (case type ::token/placeholder (-> parser - (advance) - (assoc ::ast {::ast/type ::ast/placeholder})) + (advance) + (assoc ::ast {::ast/type ::ast/placeholder})) ::token/word (parse-word parser) @@ -446,11 +489,11 @@ (defn- parse-let-expr [parser pattern] (let [expr (parse-expr parser)] (assoc expr ::ast {::ast/type ::ast/let - :pattern (::ast pattern) :expr (::ast expr)}))) + :pattern (::ast pattern) :expr (::ast expr)}))) (defn- parse-assignment [parser] (let [assignment (expect* ::token/equals "Expected assignment" parser) - success (:success assignment)] + success (:success assignment)] (if success (parse-let-expr (:parser assignment) parser) (panic parser "Expected assignment")))) @@ -461,116 +504,116 @@ (defn- parse-else [parser] (let [ast (::ast parser) - else-kw (expect* ::token/else "Expected else clause after then" parser) - success (:success else-kw) - else-kw-parser (:parser else-kw)] + else-kw (expect* ::token/else "Expected else clause after then" parser) + success (:success else-kw) + else-kw-parser (:parser else-kw)] (if success (let [expr (parse-expr else-kw-parser) - else-expr (::ast expr)] + else-expr (::ast expr)] (assoc expr ::ast (assoc ast :else else-expr))) else-kw-parser))) (defn- parse-then [parser] (let [ast (::ast parser) - then-kw (expect* ::token/then "Expected then clause after if" parser) - success (:success then-kw) - then-kw-parser (:parser then-kw)] + then-kw (expect* ::token/then "Expected then clause after if" parser) + success (:success then-kw) + then-kw-parser (:parser then-kw)] (if success (let [expr (parse-expr then-kw-parser (conj sync-on ::token/else)) - then-expr (::ast expr)] + then-expr (::ast expr)] (parse-else (accept ::token/newline (assoc expr ::ast (assoc ast :then then-expr))))) then-kw-parser))) (defn- parse-if [parser] (let [if-expr (parse-expr (advance parser) #{::token/newline ::token/then}) - ast (assoc if-expr ::ast {::ast/type ::ast/if :if (::ast if-expr)})] + ast (assoc if-expr ::ast {::ast/type ::ast/if :if (::ast if-expr)})] (parse-then (accept ::token/newline ast)))) (defn- parse-match-clause [parser] (let [pattern (if (= ::token/else (token-type parser)) - (-> parser (advance) (assoc ::ast {::ast/type ::ast/placeholder})) - (parse-pattern parser)) - rarrow (expect* #{::token/rarrow} "Expected arrow after pattern" pattern)] - (if (:success rarrow) - (let [body (parse-expr (:parser rarrow))] - (assoc body ::ast {::ast/type ::ast/clause - :pattern (::ast pattern) :body (::ast body)})) - (panic pattern "Expected -> in match clause. Clauses must be in the form pattern -> expression" #{::token/newline ::token/rbrace})))) + (-> parser (advance) (assoc ::ast {::ast/type ::ast/placeholder})) + (parse-pattern parser)) + rarrow (expect* #{::token/rarrow} "Expected arrow after pattern" pattern)] + (if (:success rarrow) + (let [body (parse-expr (:parser rarrow))] + (assoc body ::ast {::ast/type ::ast/clause + :pattern (::ast pattern) :body (::ast body)})) + (panic pattern "Expected -> in match clause. Clauses must be in the form pattern -> expression" #{::token/newline ::token/rbrace})))) (defn- parse-match-clauses [parser] (loop [parser (accept-many #{::token/newline} (advance parser)) - clauses []] - (let [curr (current parser)] - (case (::token/type curr) - ::token/rbrace - (if (< 0 (count clauses)) - (assoc (advance parser) ::ast {::ast/type ::ast/clauses :clauses clauses}) - (panic parser "Expected one or more clauses" #{::rbrace})) + clauses []] + (let [curr (current parser)] + (case (::token/type curr) + ::token/rbrace + (if (< 0 (count clauses)) + (assoc (advance parser) ::ast {::ast/type ::ast/clauses :clauses clauses}) + (panic parser "Expected one or more clauses" #{::rbrace})) - ::token/newline - (recur (accept-many #{::token/newline} parser) clauses) + ::token/newline + (recur (accept-many #{::token/newline} parser) clauses) - (let [clause (parse-match-clause parser)] - (recur (accept-many #{::token/newline} clause) (conj clauses (::ast clause)))))))) + (let [clause (parse-match-clause parser)] + (recur (accept-many #{::token/newline} clause) (conj clauses (::ast clause)))))))) (defn- parse-match [parser] (let [match-expr (parse-expr (advance parser) #{::token/with}) - match-header (expect* #{::token/with} "Expected with" match-expr)] + match-header (expect* #{::token/with} "Expected with" match-expr)] (if (:success match-header) (let [clauses (:parser match-header)] (if (= (token-type clauses) ::token/lbrace) ;; match expression with one or many clauses in braces (let [clauses (parse-match-clauses clauses)] (assoc clauses ::ast {::ast/type ::ast/match - :expr (::ast match-expr) - :clauses (get-in clauses [::ast :clauses])})) + :expr (::ast match-expr) + :clauses (get-in clauses [::ast :clauses])})) ;; match expression with single match clause (let [clause (parse-match-clause clauses)] (assoc clause ::ast {::ast/type ::ast/match - :expr (::ast match-expr) - :clauses [(::ast clause)]})))) + :expr (::ast match-expr) + :clauses [(::ast clause)]})))) (panic parser "Expected with after match expression")))) (defn- parse-cond-clause [parser] (let [expr (if (= ::token/else (token-type parser)) - (-> parser - (advance) - (assoc ::ast {::ast/type ::ast/atom - :token ::token/else - :value true})) - (parse-expr parser)) - rarrow (expect* #{::token/rarrow} "Expected arrow after expression in cond clause" expr)] - (if (:success rarrow) - (let [body (parse-expr (:parser rarrow))] - (assoc body ::ast {::ast/type ::ast/clause - :test (::ast expr) :body (::ast body)})) - (panic expr "Expected -> in cond clause. Clauses must be in the form test_expression -> result_expression" #{::token/newline ::token/rbrace})))) + (-> parser + (advance) + (assoc ::ast {::ast/type ::ast/atom + :token ::token/else + :value true})) + (parse-expr parser)) + rarrow (expect* #{::token/rarrow} "Expected arrow after expression in cond clause" expr)] + (if (:success rarrow) + (let [body (parse-expr (:parser rarrow))] + (assoc body ::ast {::ast/type ::ast/clause + :test (::ast expr) :body (::ast body)})) + (panic expr "Expected -> in cond clause. Clauses must be in the form test_expression -> result_expression" #{::token/newline ::token/rbrace})))) (defn- parse-cond-clauses [parser] (loop [parser (accept-many #{::token/newline} parser) - clauses []] - (let [curr (current parser)] - (case (::token/type curr) - ::token/rbrace - (if (< 0 (count clauses)) - (assoc (advance parser) ::ast {::ast/type ::ast/clauses :clauses clauses}) - (panic parser "Expected one or more clauses" #{::rbrace})) + clauses []] + (let [curr (current parser)] + (case (::token/type curr) + ::token/rbrace + (if (< 0 (count clauses)) + (assoc (advance parser) ::ast {::ast/type ::ast/clauses :clauses clauses}) + (panic parser "Expected one or more clauses" #{::rbrace})) - ::token/newline - (recur (accept-many #{::token/newline} parser) clauses) + ::token/newline + (recur (accept-many #{::token/newline} parser) clauses) - (let [clause (parse-cond-clause parser)] - (recur (accept-many #{::token/newline} clause) (conj clauses (::ast clause)))))))) + (let [clause (parse-cond-clause parser)] + (recur (accept-many #{::token/newline} clause) (conj clauses (::ast clause)))))))) (defn- parse-cond [parser] (let [header - (expect* #{::token/lbrace} "Expected { after cond" (advance parser))] + (expect* #{::token/lbrace} "Expected { after cond" (advance parser))] (if (:success header) (let [clauses (parse-cond-clauses (:parser header))] (assoc clauses ::ast {::ast/type ::ast/cond - :clauses (get-in clauses [::ast :clauses])}) + :clauses (get-in clauses [::ast :clauses])}) ) (panic parser "Expected { after cond") ) @@ -581,28 +624,28 @@ (if (not (= ::token/lparen (token-type parser))) (panic parser "Function clauses must begin with tuple patterns") (let [pattern (parse-tuple-pattern parser) - arrow (expect* #{::token/rarrow} "Expected arrow" pattern) - body (parse-expr (:parser arrow))] + arrow (expect* #{::token/rarrow} "Expected arrow" pattern) + body (parse-expr (:parser arrow))] (if (:success arrow) (assoc body ::ast {::ast/type ::ast/clause - :pattern (::ast pattern) :body (::ast body)}) + :pattern (::ast pattern) :body (::ast body)}) (panic pattern "Expected -> in function clause. Clauses must be in the form of (pattern) -> expression"))))) (defn- parse-fn-clauses [parser] (loop [parser (accept-many #{::token/newline} (advance parser)) - clauses []] - (let [curr (current parser)] - (case (::token/type curr) - ::token/rbrace - (if (< 0 (count clauses)) - (assoc (advance parser) ::ast {::ast/type ::ast/clauses :clauses clauses}) - (panic parser "Expected one or more function clauses" #{::token/rbrace})) + clauses []] + (let [curr (current parser)] + (case (::token/type curr) + ::token/rbrace + (if (< 0 (count clauses)) + (assoc (advance parser) ::ast {::ast/type ::ast/clauses :clauses clauses}) + (panic parser "Expected one or more function clauses" #{::token/rbrace})) - ::token/newline - (recur (accept-many #{::token/newline} parser) clauses) + ::token/newline + (recur (accept-many #{::token/newline} parser) clauses) - (let [clause (parse-fn-clause parser)] - (recur (accept-many #{::token/newline} clause) (conj clauses (::ast clause)))))))) + (let [clause (parse-fn-clause parser)] + (recur (accept-many #{::token/newline} clause) (conj clauses (::ast clause)))))))) (defn- parse-named-fn [parser] (let [name (parse-word parser)] @@ -610,14 +653,14 @@ ::token/lparen (let [clause (parse-fn-clause name)] (assoc clause ::ast {::ast/type ::ast/fn - :name (get-in name [::ast :word]) - :clauses [(::ast clause)]})) + :name (get-in name [::ast :word]) + :clauses [(::ast clause)]})) ::token/lbrace (let [clauses (parse-fn-clauses name)] (assoc clauses ::ast {::ast/type ::ast/fn - :name (get-in name [::ast :word]) - :clauses (get-in clauses [::ast :clauses])})) + :name (get-in name [::ast :word]) + :clauses (get-in clauses [::ast :clauses])})) (panic name "Expected one or more function clauses")))) @@ -627,8 +670,8 @@ ::token/lparen (let [clause (parse-fn-clause first)] (assoc clause ::ast {::ast/type ::ast/fn - :name ::ast/anon - :clauses [(::ast clause)]})) + :name ::ast/anon + :clauses [(::ast clause)]})) ::token/word (parse-named-fn first) @@ -637,15 +680,15 @@ (defn- parse-do [parser] (let [first (advance parser)] (loop [parser first - exprs []] - (let [expr (parse-expr parser) - expr+newline (accept ::token/newline expr) - next (token-type expr+newline)] - (if (= ::token/pipeline next) - (recur (advance expr+newline) (conj exprs (::ast expr))) - (assoc expr ::ast {::ast/type ::ast/pipeline - :exprs (conj exprs (::ast expr))}) - ))))) + exprs []] + (let [expr (parse-expr parser) + expr+newline (accept ::token/newline expr) + next (token-type expr+newline)] + (if (= ::token/pipeline next) + (recur (advance expr+newline) (conj exprs (::ast expr))) + (assoc expr ::ast {::ast/type ::ast/pipeline + :exprs (conj exprs (::ast expr))}) + ))))) (defn- parse-expr ([parser] (parse-expr parser sync-on)) @@ -658,14 +701,14 @@ ::token/keyword (let [next (ppeek parser) - type (::token/type next)] + type (::token/type next)] (if (= type ::token/lparen) (parse-synthetic parser) (parse-atom parser))) ::token/word (let [next (ppeek parser) - type (::token/type next)] + type (::token/type next)] (case type (::token/lparen ::token/keyword) (parse-synthetic parser) (parse-word parser))) @@ -697,6 +740,8 @@ ::token/cond (parse-cond parser) + ::token/ns (parse-ns parser) + ;; TODO: improve handling of comments? ;; Scanner now just skips comments ;; ::token/comment (advance parser) @@ -717,14 +762,14 @@ (parser) (parse-script))) -(comment +(do (def pp pp/pprint) - (def source "match foo with { - 1 -> :foo - else -> bar + (def source "ns foo { + :bar 42 + :baz 23 } - ") + ") (def lexed (scanner/scan source)) (def tokens (:tokens lexed)) (def p (parser tokens)) @@ -755,24 +800,24 @@ * ref/swap * Splats in lists, hashmaps, sets * AST nodes should include tokens/locations - - at current, only atoms do this + - at current, only atoms do this * Improve error handling in hashmap parsing * Consider error handling in match expressions * Add treatment of ignored variables * Placeholders - * How much in parser, how much in analysis? + * How much in parser, how much in analysis? Some architectural changes: * UGH, this code is just kind of a mess and hard to reason about * Especially sequential forms * Parsers are hard * One idea: - * Refactor everything so that it returns a success or failure - * Because this is all stateless, in sequential forms, you can just do all the things - * This lets you do one let (with everything building up) and then a cond with bespoke errors/panics - * This also still lets you encapsulate parsererrors with poisoned nodes + * Refactor everything so that it returns a success or failure + * Because this is all stateless, in sequential forms, you can just do all the things + * This lets you do one let (with everything building up) and then a cond with bespoke errors/panics + * This also still lets you encapsulate parsererrors with poisoned nodes -") + ")