From 89f813c2f32ce4c275fd06f3c84e2667a35f660d Mon Sep 17 00:00:00 2001 From: Scott Richmond Date: Tue, 5 Apr 2022 15:54:28 -0400 Subject: [PATCH] Parse do expressions/pipelines --- src/ludus/parser.clj | 155 ++++++++++++++++++++++++------------------- 1 file changed, 86 insertions(+), 69 deletions(-) diff --git a/src/ludus/parser.clj b/src/ludus/parser.clj index db869bb..3c871d2 100644 --- a/src/ludus/parser.clj +++ b/src/ludus/parser.clj @@ -1,10 +1,10 @@ (ns ludus.parser (:require - [ludus.token :as token] - [ludus.scanner :as scanner] - [ludus.ast :as ast] - [clojure.pprint :as pp] - [clojure.set :as s])) + [ludus.token :as token] + [ludus.scanner :as scanner] + [ludus.ast :as ast] + [clojure.pprint :as pp] + [clojure.set :as s])) ;; a parser map and some functions to work with them (defn- parser [tokens] @@ -47,8 +47,8 @@ :origin origin :end end}] (-> parser - (assoc ::ast poison) - (update ::errors conj poison)))) + (assoc ::ast poison) + (update ::errors conj poison)))) (defn- poisoned? [parser] (= ::ast/poison (get-in parser [::ast ::ast/type]))) @@ -74,8 +74,8 @@ (if (contains? tokens type) (advance parser) (-> parser - (advance) - (panic message tokens))))) + (advance) + (panic message tokens))))) (defn- expect* [tokens message parser] (let [curr (current parser) @@ -106,10 +106,10 @@ (defn- parse-atom [parser] (let [token (current parser)] (-> parser - (advance) - (assoc ::ast {::ast/type ::ast/atom - :token token - :value (::token/literal token)})))) + (advance) + (assoc ::ast {::ast/type ::ast/atom + :token token + :value (::token/literal token)})))) ;; just a quick and dirty map to associate atomic words with values (def atomic-words {::token/nil nil @@ -119,10 +119,10 @@ (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))})))) + (advance) + (assoc ::ast {::ast/type ::ast/atom + :token token + :value (get atomic-words (::token/type token))})))) (defn- add-member [members member] (if (nil? member) @@ -137,14 +137,14 @@ (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})) + {::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) + (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))) @@ -163,13 +163,13 @@ (case (token-type parser) ::token/rbracket (let [ms (add-member members current_member)] (assoc (advance parser) ::ast - {::ast/type ::ast/list - :members ms})) + {::ast/type ::ast/list + :members ms})) (::token/comma ::token/newline) (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) + (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))) @@ -188,13 +188,13 @@ (case (token-type parser) ::token/rbrace (let [ms (add-member members current_member)] (assoc (advance parser) ::ast - {::ast/type ::ast/set - :members ms})) + {::ast/type ::ast/set + :members ms})) (::token/comma ::token/newline) (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) + (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))) @@ -213,13 +213,13 @@ (case (token-type parser) ::token/rbrace (let [ms (add-member members current_member)] (assoc (advance parser) ::ast - {::ast/type ::ast/hash - :members ms})) + {::ast/type ::ast/hash + :members ms})) (::token/comma ::token/newline) (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) + (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))) @@ -230,12 +230,12 @@ ::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})) + (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}))))) @@ -247,13 +247,13 @@ (case (token-type parser) ::token/rbrace (let [ms (add-member members current_member)] (assoc (advance parser) ::ast - {::ast/type ::ast/struct - :members ms})) + {::ast/type ::ast/struct + :members ms})) (::token/comma ::token/newline) (recur - (accept-many #{::token/comma ::token/newline} parser) - (add-member members current_member) nil) + (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))) @@ -264,12 +264,12 @@ ::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})) + (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}))))) @@ -288,8 +288,8 @@ (::token/semicolon ::token/newline) (recur - (accept-many #{::token/newline ::token/semicolon} 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))) @@ -316,9 +316,9 @@ (::token/semicolon ::token/newline) (recur - (accept-many #{::token/semicolon ::token/newline} parser) - (add-member exprs current_expr) - nil) + (accept-many #{::token/semicolon ::token/newline} parser) + (add-member exprs current_expr) + nil) (let [parsed (if current_expr @@ -348,8 +348,8 @@ (defn- parse-word [parser] (let [curr (current parser)] (-> parser - (advance) - (assoc ::ast {::ast/type ::ast/word :word (::token/lexeme curr)})))) + (advance) + (assoc ::ast {::ast/type ::ast/word :word (::token/lexeme curr)})))) (def sync-pattern (s/union sync-on #{::token/equals ::token/rarrow})) @@ -361,14 +361,14 @@ (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})) + {::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) + (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))) @@ -384,8 +384,8 @@ 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) @@ -538,6 +538,24 @@ (panic parser "Expected name or clause after fn")))) +(defn- parse-do [parser] + (let [first (advance parser)] + (loop [parser first + exprs []] + (println "parsing do") + (pp/pprint parser) + (pp/pprint exprs) + (let [expr (parse-expr parser) + expr+newline (accept ::token/newline expr) + next (token-type expr+newline)] + (println "current ast " (::ast expr)) + (println "next token " next) + (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)) ([parser sync-on] @@ -584,6 +602,8 @@ ::token/fn (parse-fn parser) + ::token/do (parse-do parser) + ;; TODO: improve handling of comments? ;; Scanner now just skips comments ;; ::token/comment (advance parser) @@ -600,19 +620,16 @@ (defn parse [lexed] (-> lexed - (:tokens) - (parser) - (parse-script))) + (:tokens) + (parser) + (parse-script))) (comment (def pp pp/pprint) - (def source " - -fn maybe_foo (mf) -> if eq (mf, :foo) - then (:ok, :foo) - else (:error, mf) - - + (def source "do foo + > bar + > baz + foo ") (def lexed (scanner/scan source)) (def tokens (:tokens lexed)) @@ -625,9 +642,9 @@ fn maybe_foo (mf) -> if eq (mf, :foo) (println "*** *** NEW PARSE *** ***") (-> p - (parse-script) - (::ast) - (pp))) + (parse-script) + (::ast) + (pp))) (comment " Further thoughts/still to do: