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

Add struct patterns

Browse Source
This commit is contained in:
Scott Richmond 2022-05-19 20:03:39 -04:00
parent 34da4dd6fe
commit 4d7b12eb34
1 changed files with 29 additions and 1 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

30
src/ludus/interpreter.clj
View File

@ -89,6 +89,30 @@
{:success false :reason (str "Could not match " pattern " with " value " at key " kw)}
)))))))
(defn- match-struct [pattern value ctx-vol]
(cond
(not (map? value))
{:success false :reason "Could not match non-struct value to struct pattern"}
(not (::data/struct value))
{:success false :reason "Cannot match non-struct data types a struct pattern"}
:else
(let [members (:members pattern)
kws (keys members)]
(loop [i (dec (count kws)) ctx {}]
(if (> 0 i)
{:success true :ctx ctx}
(let [kw (nth kws i)]
(if (contains? value kw)
(let [match? (match (kw members) (kw value) ctx-vol)]
(if (:success match?)
(recur (dec i) (merge ctx (:ctx match?)))
{:success false :reason (str "Could not match " pattern " with " value " at key " kw)}
))
{:success false :reason (str "Could not match " pattern " with " value " at key " kw)}
)))))))
(defn- match [pattern value ctx-vol]
(let [ctx @ctx-vol]
(case (::ast/type pattern)
@ -113,6 +137,8 @@
::ast/hash (match-hashmap pattern value ctx-vol)
::ast/struct (match-struct pattern value ctx-vol)
(throw (ex-info "Unknown pattern on line " {:pattern pattern})))))
(defn- update-ctx [ctx new-ctx]
@ -461,7 +487,9 @@
(def source "
let #{foo, bar} = @{:foo :bar, :bar nil}
let @{foo, bar} = @{:foo :bar, :bar nil, :baz 42}
")