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

Actually add hashmap patterns. Whoops.

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

24
src/ludus/interpreter.clj
View File

@ -70,10 +70,24 @@
(not (map? value)) (not (map? value))
{:success false :reason "Could not match non-hashmap value to hashmap pattern"} {:success false :reason "Could not match non-hashmap value to hashmap pattern"}
(not) (not (::data/hashmap value))
{:success false :reason "Cannot match non-hashmap data types a hashmap 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] (defn- match [pattern value ctx-vol]
(let [ctx @ctx-vol] (let [ctx @ctx-vol]
@ -97,6 +111,8 @@
::ast/list (match-list pattern value ctx-vol) ::ast/list (match-list pattern value ctx-vol)
::ast/hash (match-hashmap pattern value ctx-vol)
(throw (ex-info "Unknown pattern on line " {:pattern pattern}))))) (throw (ex-info "Unknown pattern on line " {:pattern pattern})))))
(defn- update-ctx [ctx new-ctx] (defn- update-ctx [ctx new-ctx]
@ -445,7 +461,7 @@
(def source " (def source "
let #{foo, bar} = @{:foo :bar, :bar nil}
") ")