Add tuple patterns & matching
This commit is contained in:
parent
a4c5927ec4
commit
8368d6362d
|
@ -18,11 +18,39 @@
|
||||||
(recur word (::parent ctx))
|
(recur word (::parent ctx))
|
||||||
(throw (new Exception (str "Unbound name: " word)))))))
|
(throw (new Exception (str "Unbound name: " word)))))))
|
||||||
|
|
||||||
(declare interpret)
|
(declare interpret match)
|
||||||
|
|
||||||
|
(defn- match-tuple [pattern value ctx-atom]
|
||||||
|
(cond
|
||||||
|
(not (vector? value)) {:success false :reason "Could not match non-tuple value to tuple"}
|
||||||
|
|
||||||
|
(not (= ::colls/tuple (first value))) {:success false :reason "Could not match list to tuple"}
|
||||||
|
|
||||||
|
(not (= (:length pattern) (dec (count value))))
|
||||||
|
{:success false :reason "Cannot match tuples of different lengths"}
|
||||||
|
|
||||||
|
(= 0 (:length pattern) (dec (count value))) {:success true :ctx {}}
|
||||||
|
|
||||||
|
:else (let [members (:members pattern)]
|
||||||
|
(loop [i (dec (:length pattern))
|
||||||
|
ctx {}]
|
||||||
|
(if (= 0 i)
|
||||||
|
{:success true :ctx ctx}
|
||||||
|
(let [match? (match (nth members i) (nth value (inc i)) ctx-atom)]
|
||||||
|
(if (:success match?)
|
||||||
|
(recur (dec i) (merge ctx (:ctx match?)))
|
||||||
|
{:success false :reason (str "Could not match " pattern " with " value)}
|
||||||
|
))
|
||||||
|
)
|
||||||
|
|
||||||
|
))
|
||||||
|
))
|
||||||
|
|
||||||
(defn- match [pattern value ctx-atom]
|
(defn- match [pattern value ctx-atom]
|
||||||
(let [ctx @ctx-atom]
|
(let [ctx @ctx-atom]
|
||||||
(case (::ast/type pattern)
|
(case (::ast/type pattern)
|
||||||
|
::ast/placeholder {:success true :ctx {}}
|
||||||
|
|
||||||
::ast/atom
|
::ast/atom
|
||||||
(let [match-value (:value pattern)]
|
(let [match-value (:value pattern)]
|
||||||
(if (= match-value value)
|
(if (= match-value value)
|
||||||
|
@ -36,6 +64,8 @@
|
||||||
{:success false :reason (str "Name " word " is already bound")}
|
{:success false :reason (str "Name " word " is already bound")}
|
||||||
{:success true :ctx {word value}}
|
{:success true :ctx {word value}}
|
||||||
))
|
))
|
||||||
|
|
||||||
|
::ast/tuple (match-tuple pattern value ctx-atom)
|
||||||
|
|
||||||
(do
|
(do
|
||||||
(println "ERROR! Unexpected pattern:")
|
(println "ERROR! Unexpected pattern:")
|
||||||
|
@ -127,7 +157,7 @@
|
||||||
(do
|
(do
|
||||||
|
|
||||||
(def source "
|
(def source "
|
||||||
|
let (:foo, 1, :bar) = (:foo, 1, :bar)
|
||||||
")
|
")
|
||||||
|
|
||||||
(println "")
|
(println "")
|
||||||
|
|
|
@ -30,7 +30,7 @@
|
||||||
(get-in parser [::ast ::ast/type]))
|
(get-in parser [::ast ::ast/type]))
|
||||||
|
|
||||||
;; some forward declarations
|
;; some forward declarations
|
||||||
(declare parse-expr parse-word)
|
(declare parse-expr parse-word parse-pattern)
|
||||||
|
|
||||||
;; handle some errors
|
;; handle some errors
|
||||||
(def sync-on #{
|
(def sync-on #{
|
||||||
|
@ -314,14 +314,48 @@
|
||||||
|
|
||||||
(def sync-pattern (s/union sync-on #{::token/equals ::token/rarrow}))
|
(def sync-pattern (s/union sync-on #{::token/equals ::token/rarrow}))
|
||||||
|
|
||||||
|
(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}))
|
||||||
|
|
||||||
|
(::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/eof
|
||||||
|
(panic (assoc origin ::errors (::errors parser)) "Unterminated tuple" ::token/eof)
|
||||||
|
|
||||||
|
(let [parsed (parse-pattern parser)]
|
||||||
|
(recur parsed members (::ast parsed)))))))
|
||||||
|
|
||||||
(defn- parse-pattern [parser]
|
(defn- parse-pattern [parser]
|
||||||
(let [curr (current parser)
|
(let [curr (current parser)
|
||||||
type (::token/type curr)]
|
type (::token/type curr)]
|
||||||
(case type
|
(case type
|
||||||
|
::token/placeholder (-> parser
|
||||||
|
(advance)
|
||||||
|
(assoc ::ast {::ast/type ::ast/placeholder}))
|
||||||
|
|
||||||
::token/word (parse-word parser)
|
::token/word (parse-word parser)
|
||||||
|
|
||||||
(::token/number ::token/string ::token/keyword) (parse-atom parser)
|
(::token/number ::token/string ::token/keyword) (parse-atom parser)
|
||||||
|
|
||||||
|
::token/lparen (parse-tuple-pattern parser)
|
||||||
|
|
||||||
::token/error
|
::token/error
|
||||||
(panic parser (:message (current parser)) sync-pattern)
|
(panic parser (:message (current parser)) sync-pattern)
|
||||||
|
|
||||||
|
@ -428,7 +462,7 @@
|
||||||
|
|
||||||
(do
|
(do
|
||||||
(def pp pp/pprint)
|
(def pp pp/pprint)
|
||||||
(def source "42")
|
(def source "let () = ()")
|
||||||
(def lexed (scanner/scan source))
|
(def lexed (scanner/scan source))
|
||||||
(def tokens (:tokens lexed))
|
(def tokens (:tokens lexed))
|
||||||
(def p (parser tokens))
|
(def p (parser tokens))
|
||||||
|
@ -441,7 +475,7 @@
|
||||||
|
|
||||||
(-> p
|
(-> p
|
||||||
(parse-script)
|
(parse-script)
|
||||||
;;(::ast)
|
(::ast)
|
||||||
(pp)
|
(pp)
|
||||||
)
|
)
|
||||||
)
|
)
|
||||||
|
|
Loading…
Reference in New Issue
Block a user