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

Update struct match

Browse Source
This commit is contained in:
Scott Richmond 2023-05-31 11:51:02 -04:00
parent 3bd34f1269
commit 82a539a112
1 changed files with 54 additions and 29 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

83
src/ludus/interpreter.clj
View File

@ -170,7 +170,6 @@
(let [ctx-diff (volatile! @ctx-vol) (let [ctx-diff (volatile! @ctx-vol)
splat? (= :splattern (-> members peek :type)) splat? (= :splattern (-> members peek :type))
length (count kws)] length (count kws)]
(if splat? (println "Pattern has splat!!"))
(loop [i 0] (loop [i 0]
(cond (cond
(> length i) (> length i)
@ -193,11 +192,9 @@
(let [splat (-> members peek) (let [splat (-> members peek)
splat-data (-> splat :data first) splat-data (-> splat :data first)
splat-type (-> splat-data :type)] splat-type (-> splat-data :type)]
(println "!!!!Matching splat")
(if (= :word splat-type) (if (= :word splat-type)
(let [unmatched (apply dissoc dict kws) (let [unmatched (assoc (apply dissoc dict kws) ::data/dict true)
match? (match splat-data unmatched ctx-diff)] match? (match splat-data unmatched ctx-diff)]
(println "Splatting " unmatched "\ninto " )
(if (:success match?) (if (:success match?)
{:success true :ctx (merge @ctx-diff (:ctx match?))} {:success true :ctx (merge @ctx-diff (:ctx match?))}
{:success false {:success false
@ -211,31 +208,59 @@
)))))) ))))))
;; TODO: update this to use new AST representation (defn- match-struct [pattern dict ctx-vol]
(defn- match-struct [pattern value ctx-vol] (let [members (:data pattern)
(cond pattern-map (pattern-to-map pattern)
(not (map? value)) kws (keys pattern-map)]
{:success false :reason "Could not match non-struct value to struct pattern"} (cond
(not (map? dict))
{:success false :reason "Could not match non-struct value to struct pattern"}
(not (::data/struct value)) (not (::data/dict dict))
{:success false :reason "Cannot match non-struct data types a struct pattern"} {:success false :reason "Cannot match non-struct value to struct pattern"}
:else (empty? members)
(let [members (:members pattern) {:success true :ctx {}}
kws (keys members)
ctx-diff (volatile! @ctx-vol)] :else
(loop [i (dec (count kws))] (let [ctx-diff (volatile! @ctx-vol)
(if (> 0 i) splat? (= :splattern (-> members peek :type))
{:success true :ctx @ctx-diff} length (count kws)]
(let [kw (nth kws i)] (loop [i 0]
(if (contains? value kw) (cond
(let [match? (match (kw members) (kw value) ctx-diff)] (> length i)
(if (:success match?) (let [kw (nth kws i)
(do pattern-at (kw pattern-map)
(vswap! ctx-diff #(merge % (:ctx match?))) value (kw dict)]
(recur (dec i))) (if (contains? dict kw)
{:success false :reason (str "Could not match " pattern " with " value " at key " kw " because " (:reason match?))})) (let [match? (match pattern-at value ctx-diff)]
{:success false :reason (str "Could not match " pattern " with " value " at key " kw ", because there is no value at " kw)}))))))) (if (:success match?)
(do
(vswap! ctx-diff #(merge % (:ctx match?)))
(recur (inc i)))
{:success false
:reason (str "Could not match " pattern " with value " dict " at key " kw " because " (:reason match?))}
))
{:success false
:reason (str "Could not match " pattern " with " dict " at key " kw " because there is no value at " kw)}))
splat?
(let [splat (-> members peek)
splat-data (-> splat :data first)
splat-type (-> splat-data :type)]
(if (= :word splat-type)
(let [unmatched (assoc (apply dissoc dict kws) ::data/dict true)
match? (match splat-data unmatched ctx-diff)]
(if (:success match?)
{:success true :ctx (merge @ctx-diff (:ctx match?))}
{:success false
:reason (str "Could not match " pattern " with value " dict " because " (:reason match?))}
))
{:success true :ctx @ctx-diff}
))
:else
{:success true :ctx @ctx-diff}))))))
(defn- match-typed [pattern value ctx] (defn- match-typed [pattern value ctx]
(let [data (:data pattern) (let [data (:data pattern)
@ -936,8 +961,8 @@
(do (do
(def source " (def source "
let #{a as :number} = #{:a 1} let #{...x} = #{:a 1}
a x
") ")
(println "") (println "")