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 {}}
:else (let [members (:members pattern)
:else
(let [members (:members pattern)
ctx-diff (volatile! @ctx-vol)]
(loop [i (:length pattern)
ctx {}]
(loop [i (:length pattern)]
(if (= 0 i)
{:success true :ctx ctx}
{:success true :ctx @ctx-diff}
(let [match? (match (nth members (dec i)) (nth value i) ctx-diff)]
(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?))})))))))
;; TODO: fix repeated name bug in list patterns
(defn- match-list [pattern value ctx-vol]
(cond
(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 {}}
:else (let [members (:members pattern)]
(loop [i (dec (count members))
ctx {}]
:else
(let [members (:members pattern)
ctx-diff (volatile! @ctx-vol)]
(loop [i (dec (count members))]
(if (> 0 i)
{:success true :ctx ctx}
(let [match? (match (nth members i) (nth value i) ctx-vol)]
{:success true :ctx @ctx-diff}
(let [match? (match (nth members i) (nth value i) ctx-diff)]
(if (:success match?)
(recur (dec i) (merge ctx (:ctx match?)))
{:success false :reason (str "Could not match " pattern " with " value)})))))))
(do
(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]
(cond
(not (map? value))
{:success false :reason "Could not match non-dict value to dict pattern"}
(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
(let [members (:members pattern)
kws (keys members)]
(loop [i (dec (count kws)) ctx {}]
kws (keys members)
ctx-diff (volatile! @ctx-vol)]
(loop [i (dec (count kws))]
(if (> 0 i)
{:success true :ctx ctx}
{:success true :ctx @ctx-diff}
(let [kw (nth kws i)]
(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?)
(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)})))))))
(do
(println (:ctx match?))
(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]
(cond
(not (map? value))
@ -132,17 +145,20 @@
:else
(let [members (:members pattern)
kws (keys members)]
(loop [i (dec (count kws)) ctx {}]
kws (keys members)
ctx-diff (volatile! @ctx-vol)]
(loop [i (dec (count kws))]
(if (> 0 i)
{:success true :ctx ctx}
{:success true :ctx @ctx-diff}
(let [kw (nth kws i)]
(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?)
(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)})))))))
(do
(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)})))))))
(defn- match [pattern value ctx-vol]
(let [ctx @ctx-vol]
@ -687,8 +703,8 @@
(do
(process/start-vm)
(def source "
let (a, b) = (1, 2)
let #{a, a} = #{:a 1}
a
")
(println "")