Parse do expressions/pipelines
This commit is contained in:
Scott Richmond
parent
174eb2d6a5
commit
89f813c2f3
|
|
@ -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:
|
||||
|
|
|
|||
Loading…
Reference in New Issue
Block a user