From 362e76c323abeab33262ba3fa2aaa29e9ee8e783 Mon Sep 17 00:00:00 2001 From: Scott Richmond Date: Wed, 18 May 2022 18:32:57 -0400 Subject: [PATCH] Parse loop/recur, and reindent all the things --- src/ludus/parser.clj | 819 +++++++++++++++++++++++-------------------- 1 file changed, 446 insertions(+), 373 deletions(-) diff --git a/src/ludus/parser.clj b/src/ludus/parser.clj index 65dd437..c07c474 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,193 +134,193 @@ (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/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)) + (::token/comma ::token/newline) (recur - (advance parser) members {::ast/type ::ast/placeholder})) + (accept-many #{::token/comma ::token/newline} parser) + (add-member members current_member) nil) - ::token/eof - (panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof) + (::token/rbrace ::token/rbracket) + (panic parser (str "Mismatched enclosure in tuple: " (::token/lexeme curr))) - (let [parsed (parse-expr parser #{::token/comma ::token/newline ::token/rparen})] - (recur parsed members (::ast parsed))))))) + ::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})) + 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/placeholder - (recur - (advance parser) - members - (panic parser "Placeholders in tuples may only be in function calls." 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) + ::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-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 [ns-root] (let [name (expect* #{::token/word} "Expected ns name" (advance ns-root)) - origin (expect* #{::token/lbrace} "Expected { after ns name" (:parser name))] + origin (expect* #{::token/lbrace} "Expected { after ns name" (:parser name))] (cond (not (:success name)) (panic parser "Expected ns name" #{::token/newline}) @@ -328,110 +328,110 @@ :else (loop [parser (accept-many #{::token/newline ::token/comma} (:parser 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/ns - :name (get-in (parse-word (advance ns-root)) [::ast :word]) - :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/ns + :name (get-in (parse-word (advance ns-root)) [::ast :word]) + :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 ns: " (::token/lexeme curr))) + (::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/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/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})) + ::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}))))))) + (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}))) + 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/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/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) + ::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))))))) + (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] - (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}))) + 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) + (::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))] + (let [parsed + (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-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)] @@ -443,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 ::token/ignored) (-> parser - (advance) - (assoc ::ast {::ast/type ::ast/placeholder})) + (advance) + (assoc ::ast {::ast/type ::ast/placeholder})) ::token/word (parse-word parser) @@ -489,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")))) @@ -505,11 +505,11 @@ (defn- parse-ref-expr [parser name] (let [expr (parse-expr parser)] (assoc expr ::ast {::ast/type ::ast/ref - :name name :expr (::ast expr)}))) + :name name :expr (::ast expr)}))) (defn- parse-ref-assignment [parser name] (let [assignment (expect* ::token/equals "Expected assignment" (advance parser)) - success (:success assignment)] + success (:success assignment)] (if success (parse-ref-expr (:parser assignment) name) (panic parser "Expected assignment"))) @@ -517,123 +517,186 @@ (defn- parse-ref [parser] (let [name (advance parser)] - (if (= ::token/word (token-type name)) - (parse-ref-assignment name (::token/lexeme (current name))) - (panic parser "Expected reference name")))) + (if (= ::token/word (token-type name)) + (parse-ref-assignment name (::token/lexeme (current name))) + (panic parser "Expected reference name")))) (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-loop-clause [parser] + (if (not (= ::token/lparen (token-type parser))) + (panic parser "Loop clauses must begin with tuple patterns") + (let [pattern (parse-tuple-pattern parser) + 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)}) + (panic pattern "Expected -> in loop clause. Clauses must be in the form of (pattern) -> expression"))))) + +(defn- parse-loop-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 loop clauses" #{::token/rbrace})) + + ::token/newline + (recur (accept-many #{::token/newline} parser) clauses) + + (let [clause (parse-loop-clause parser)] + (recur (accept-many #{::token/newline} clause) (conj clauses (::ast clause)))))))) + +(defn- parse-loop [parser] + (let [next (advance parser)] + (if (= ::token/lparen (token-type next)) + (let [loop-tup (parse-tuple (advance next)) + loop-header (expect* #{::token/with} "Expected with" loop-tup)] + (if (:success loop-header) + (let [clauses (:parser loop-header)] + (if (= (token-type clauses) ::token/lbrace) + ;; loop expression with one or many clauses in braces + (let [clauses (parse-loop-clauses clauses)] + (assoc clauses ::ast {::ast/type ::ast/loop + :expr (::ast loop-tup) + :clauses (get-in clauses [::ast :clauses])})) + ;; loop expression with single match clause + (let [clause (parse-loop-clause clauses)] + (assoc clause ::ast {::ast/type ::ast/loop + :expr (::ast loop-tup) + :clauses [(::ast clause)]})))) + + (panic parser "Expected with after loop expression"))) + (panic parser "Expected tuple as loop expression") + ))) + +(defn- parse-recur [parser] + (let [next (advance parser)] + (if (= ::token/lparen (token-type next)) + (let [tuple (parse-tuple (advance next))] + (assoc tuple ::ast {::ast/type ::ast/recur + :tuple (::ast tuple)}) + ) + (panic parser "Expected tuple after recur") + ) + ) + ) + + (defn- parse-cond-clause [parser] (let [expr (if - (contains? #{::token/else ::token/placeholder} (token-type parser)) - (-> parser - (advance) - (assoc ::ast {::ast/type ::ast/atom - :token (current parser) - :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})))) + (contains? #{::token/else ::token/placeholder} (token-type parser)) + (-> parser + (advance) + (assoc ::ast {::ast/type ::ast/atom + :token (current parser) + :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") ) @@ -644,28 +707,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)] @@ -673,14 +736,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")))) @@ -690,8 +753,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) @@ -700,26 +763,26 @@ (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-import [parser] (let [path (parse-atom (advance parser)) - as (expect* #{::token/as} "Expected as after path" path) - named? (if (:success as) - (expect* #{::token/word} "Expected name binding after as" (:parser as)) - nil) - name (if (:success named?) - (parse-word (:parser as)) - nil - )] + as (expect* #{::token/as} "Expected as after path" path) + named? (if (:success as) + (expect* #{::token/word} "Expected name binding after as" (:parser as)) + nil) + name (if (:success named?) + (parse-word (:parser as)) + nil + )] (cond (not= ::token/string (token-type (advance parser))) (panic parser "Expected path after import" #{::token/newline}) @@ -732,8 +795,8 @@ :else (assoc name ::ast {::ast/type ::ast/import - :path (get-in path [::ast :value]) - :name (get-in name [::ast :word])})))) + :path (get-in path [::ast :value]) + :name (get-in name [::ast :word])})))) (defn- parse-expr ([parser] (parse-expr parser sync-on)) @@ -746,14 +809,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))) @@ -791,6 +854,10 @@ ::token/ref (parse-ref parser) + ::token/loop (parse-loop parser) + + ::token/recur (parse-recur parser) + ;; TODO: improve handling of comments? ;; Scanner now just skips comments ;; ::token/comment (advance parser) @@ -813,7 +880,13 @@ (do (def pp pp/pprint) - (def source "ref foo = 42 + (def source "loop (10) with { + (0) -> print (:boom) + (n) -> { + print (:tick) + recur (dec (n)) + } + } ") (def lexed (scanner/scan source))