Add tuple patterns & matching

This commit is contained in:
Scott Richmond 2022-03-19 18:23:15 -04:00
parent a4c5927ec4
commit 8368d6362d
2 changed files with 69 additions and 5 deletions

View File

@ -18,11 +18,39 @@
(recur word (::parent ctx))
(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]
(let [ctx @ctx-atom]
(case (::ast/type pattern)
::ast/placeholder {:success true :ctx {}}
::ast/atom
(let [match-value (:value pattern)]
(if (= match-value value)
@ -36,6 +64,8 @@
{:success false :reason (str "Name " word " is already bound")}
{:success true :ctx {word value}}
))
::ast/tuple (match-tuple pattern value ctx-atom)
(do
(println "ERROR! Unexpected pattern:")
@ -127,7 +157,7 @@
(do
(def source "
let (:foo, 1, :bar) = (:foo, 1, :bar)
")
(println "")

View File

@ -30,7 +30,7 @@
(get-in parser [::ast ::ast/type]))
;; some forward declarations
(declare parse-expr parse-word)
(declare parse-expr parse-word parse-pattern)
;; handle some errors
(def sync-on #{
@ -314,14 +314,48 @@
(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]
(let [curr (current parser)
type (::token/type curr)]
(case type
::token/placeholder (-> parser
(advance)
(assoc ::ast {::ast/type ::ast/placeholder}))
::token/word (parse-word parser)
(::token/number ::token/string ::token/keyword) (parse-atom parser)
::token/lparen (parse-tuple-pattern parser)
::token/error
(panic parser (:message (current parser)) sync-pattern)
@ -428,7 +462,7 @@
(do
(def pp pp/pprint)
(def source "42")
(def source "let () = ()")
(def lexed (scanner/scan source))
(def tokens (:tokens lexed))
(def p (parser tokens))
@ -441,7 +475,7 @@
(-> p
(parse-script)
;;(::ast)
(::ast)
(pp)
)
)