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

Fix bug allowing repeated names everywhere

Browse Source
This commit is contained in:
Scott Richmond 2022-06-25 18:18:54 -04:00
parent 80fe4d370d
commit d2cefb79f0
1 changed files with 117 additions and 101 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

74
src/ludus/interpreter.clj
View File

@ -67,17 +67,20 @@
(= 0 (:length pattern) (dec (count value))) {:success true :ctx {}} (= 0 (:length pattern) (dec (count value))) {:success true :ctx {}}
:else (let [members (:members pattern) :else
(let [members (:members pattern)
ctx-diff (volatile! @ctx-vol)] ctx-diff (volatile! @ctx-vol)]
(loop [i (:length pattern) (loop [i (:length pattern)]
ctx {}]
(if (= 0 i) (if (= 0 i)
{:success true :ctx ctx} {:success true :ctx @ctx-diff}
(let [match? (match (nth members (dec i)) (nth value i) ctx-diff)] (let [match? (match (nth members (dec i)) (nth value i) ctx-diff)]
(if (:success match?) (if (:success match?)
(recur (dec i) (vswap! ctx-diff #(merge % (:ctx match?)))) (do
(vswap! ctx-diff #(merge % (:ctx match?)))
(recur (dec i)))
{:success false :reason (str "Could not match " pattern " with " value " because " (:reason match?))}))))))) {:success false :reason (str "Could not match " pattern " with " value " because " (:reason match?))})))))))
;; TODO: fix repeated name bug in list patterns
(defn- match-list [pattern value ctx-vol] (defn- match-list [pattern value ctx-vol]
(cond (cond
(not (vector? value)) {:success false :reason "Could not match non-list value to list"} (not (vector? value)) {:success false :reason "Could not match non-list value to list"}
@ -90,38 +93,48 @@
(= 0 (count (:members pattern)) (count value)) {:success true :ctx {}} (= 0 (count (:members pattern)) (count value)) {:success true :ctx {}}
:else (let [members (:members pattern)] :else
(loop [i (dec (count members)) (let [members (:members pattern)
ctx {}] ctx-diff (volatile! @ctx-vol)]
(loop [i (dec (count members))]
(if (> 0 i) (if (> 0 i)
{:success true :ctx ctx} {:success true :ctx @ctx-diff}
(let [match? (match (nth members i) (nth value i) ctx-vol)] (let [match? (match (nth members i) (nth value i) ctx-diff)]
(if (:success match?) (if (:success match?)
(recur (dec i) (merge ctx (:ctx match?))) (do
{:success false :reason (str "Could not match " pattern " with " value)}))))))) (vswap! ctx-diff #(merge % (:ctx match?)))
(recur (dec i)))
{:success false :reason (str "Could not match " pattern " with " value " because " (:reason match?))})))))))
;; TODO: investigate if there is a repeated name bug in dict patterns
(defn- match-dict [pattern value ctx-vol] (defn- match-dict [pattern value ctx-vol]
(cond (cond
(not (map? value)) (not (map? value))
{:success false :reason "Could not match non-dict value to dict pattern"} {:success false :reason "Could not match non-dict value to dict pattern"}
(not (::data/dict value)) (not (::data/dict value))
{:success false :reason "Cannot match non-dict data types a dict pattern"} {:success false :reason "Cannot match non-dict data types to a dict pattern"}
:else :else
(let [members (:members pattern) (let [members (:members pattern)
kws (keys members)] kws (keys members)
(loop [i (dec (count kws)) ctx {}] ctx-diff (volatile! @ctx-vol)]
(loop [i (dec (count kws))]
(if (> 0 i) (if (> 0 i)
{:success true :ctx ctx} {:success true :ctx @ctx-diff}
(let [kw (nth kws i)] (let [kw (nth kws i)]
(if (contains? value kw) (if (contains? value kw)
(let [match? (match (kw members) (kw value) ctx-vol)] (let [match? (match (kw members) (kw value) ctx-diff)]
(if (:success match?) (if (:success match?)
(recur (dec i) (merge ctx (:ctx match?))) (do
{:success false :reason (str "Could not match " pattern " with " value " at key " kw)})) (println (:ctx match?))
{:success false :reason (str "Could not match " pattern " with " value " at key " kw)}))))))) (vswap! ctx-diff #(merge % (:ctx match?)))
(recur (dec i)))
{:success false :reason (str "Could not match " pattern " with " value " at key " kw " because " (:reason match?))}))
{:success false
:reason (str "Could not match " pattern " with " value " at key " kw " because there is no value at " kw)})))))))
;; TODO: investigate if there is a repeated name bug in struct patterns
(defn- match-struct [pattern value ctx-vol] (defn- match-struct [pattern value ctx-vol]
(cond (cond
(not (map? value)) (not (map? value))
@ -132,17 +145,20 @@
:else :else
(let [members (:members pattern) (let [members (:members pattern)
kws (keys members)] kws (keys members)
(loop [i (dec (count kws)) ctx {}] ctx-diff (volatile! @ctx-vol)]
(loop [i (dec (count kws))]
(if (> 0 i) (if (> 0 i)
{:success true :ctx ctx} {:success true :ctx @ctx-diff}
(let [kw (nth kws i)] (let [kw (nth kws i)]
(if (contains? value kw) (if (contains? value kw)
(let [match? (match (kw members) (kw value) ctx-vol)] (let [match? (match (kw members) (kw value) ctx-diff)]
(if (:success match?) (if (:success match?)
(recur (dec i) (merge ctx (:ctx match?))) (do
{:success false :reason (str "Could not match " pattern " with " value " at key " kw)})) (vswap! ctx-diff #(merge % (:ctx match?)))
{:success false :reason (str "Could not match " pattern " with " value " at key " kw)}))))))) (recur (dec i)))
{:success false :reason (str "Could not match " pattern " with " value " at key " kw " because " (:reason match?))}))
{:success false :reason (str "Could not match " pattern " with " value " at key " kw ", because there is no value at " kw)})))))))
(defn- match [pattern value ctx-vol] (defn- match [pattern value ctx-vol]
(let [ctx @ctx-vol] (let [ctx @ctx-vol]
@ -687,8 +703,8 @@
(do (do
(process/start-vm) (process/start-vm)
(def source " (def source "
let (a, b) = (1, 2) let #{a, a} = #{:a 1}
a
") ")
(println "") (println "")