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

Parse do expressions/pipelines

Browse Source
This commit is contained in:
Scott Richmond 2022-04-05 15:54:28 -04:00
parent 174eb2d6a5
commit 89f813c2f3
1 changed files with 86 additions and 69 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

155
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- add-member [members member] (defn- add-member [members member]
(if (nil? member) (if (nil? member)
@ -137,14 +137,14 @@
(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/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)))
@ -163,13 +163,13 @@
(case (token-type parser) (case (token-type parser)
::token/rbracket (let [ms (add-member members current_member)] ::token/rbracket (let [ms (add-member members current_member)]
(assoc (advance parser) ::ast (assoc (advance parser) ::ast
{::ast/type ::ast/list {::ast/type ::ast/list
:members ms})) :members ms}))
(::token/comma ::token/newline) (::token/comma ::token/newline)
(recur (recur
(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)))
@ -188,13 +188,13 @@
(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
: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)))
@ -213,13 +213,13 @@
(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/hash {::ast/type ::ast/hash
: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 hashmap: " (::token/lexeme curr))) (panic parser (str "Mismatched enclosure in hashmap: " (::token/lexeme curr)))
@ -230,12 +230,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 "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 ::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 "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}))))) (panic parser "Hashmap entries must be single words or keyword+expression pairs" #{::token/rbrace})))))
@ -247,13 +247,13 @@
(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
: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)))
@ -264,12 +264,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})))))
@ -288,8 +288,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)))
@ -316,9 +316,9 @@
(::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
@ -348,8 +348,8 @@
(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 :word (::token/lexeme curr)})))) (assoc ::ast {::ast/type ::ast/word :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}))
@ -361,14 +361,14 @@
(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/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)))
@ -384,8 +384,8 @@
type (::token/type curr)] type (::token/type curr)]
(case type (case type
::token/placeholder (-> parser ::token/placeholder (-> parser
(advance) (advance)
(assoc ::ast {::ast/type ::ast/placeholder})) (assoc ::ast {::ast/type ::ast/placeholder}))
::token/word (parse-word parser) ::token/word (parse-word parser)
@ -538,6 +538,24 @@
(panic parser "Expected name or clause after fn")))) (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 (defn- parse-expr
([parser] (parse-expr parser sync-on)) ([parser] (parse-expr parser sync-on))
([parser sync-on] ([parser sync-on]
@ -584,6 +602,8 @@
::token/fn (parse-fn parser) ::token/fn (parse-fn parser)
::token/do (parse-do parser)
;; TODO: improve handling of comments? ;; TODO: improve handling of comments?
;; Scanner now just skips comments ;; Scanner now just skips comments
;; ::token/comment (advance parser) ;; ::token/comment (advance parser)
@ -600,19 +620,16 @@
(defn parse [lexed] (defn parse [lexed]
(-> lexed (-> lexed
(:tokens) (:tokens)
(parser) (parser)
(parse-script))) (parse-script)))
(comment (comment
(def pp pp/pprint) (def pp pp/pprint)
(def source " (def source "do foo
> bar
fn maybe_foo (mf) -> if eq (mf, :foo) > baz
then (:ok, :foo) foo
else (:error, mf)
") ")
(def lexed (scanner/scan source)) (def lexed (scanner/scan source))
(def tokens (:tokens lexed)) (def tokens (:tokens lexed))
@ -625,9 +642,9 @@ fn maybe_foo (mf) -> if eq (mf, :foo)
(println "*** *** NEW PARSE *** ***") (println "*** *** NEW PARSE *** ***")
(-> p (-> p
(parse-script) (parse-script)
(::ast) (::ast)
(pp))) (pp)))
(comment " (comment "
Further thoughts/still to do: Further thoughts/still to do: