Make context volatile!, not atom

This commit is contained in:
Scott Richmond 2022-04-25 18:44:44 -04:00
parent ceb8a2aa63
commit 0c77de908c

View File

@ -11,8 +11,8 @@
;; it's got runtime checking ;; it's got runtime checking
;; we should be able to do these checks statically ;; we should be able to do these checks statically
;; that's for later, tho ;; that's for later, tho
(defn- resolve-word[word ctx-atom] (defn- resolve-word[word ctx-vol]
(let [ctx @ctx-atom] (let [ctx @ctx-vol]
(if (contains? ctx word) (if (contains? ctx word)
(get ctx word) (get ctx word)
(if (contains? ctx ::parent) (if (contains? ctx ::parent)
@ -21,7 +21,7 @@
(declare interpret-ast match interpret) (declare interpret-ast match interpret)
(defn- match-tuple [pattern value ctx-atom] (defn- match-tuple [pattern value ctx-vol]
(cond (cond
(not (vector? value)) {:success false :reason "Could not match non-tuple value to tuple"} (not (vector? value)) {:success false :reason "Could not match non-tuple value to tuple"}
@ -37,13 +37,13 @@
ctx {}] ctx {}]
(if (= 0 i) (if (= 0 i)
{:success true :ctx ctx} {:success true :ctx ctx}
(let [match? (match (nth members (dec i)) (nth value i) ctx-atom)] (let [match? (match (nth members (dec i)) (nth value i) ctx-vol)]
(if (:success match?) (if (:success match?)
(recur (dec i) (merge ctx (:ctx match?))) (recur (dec i) (merge ctx (:ctx match?)))
{:success false :reason (str "Could not match " pattern " with " value)}))))))) {:success false :reason (str "Could not match " pattern " with " value)})))))))
(defn- match [pattern value ctx-atom] (defn- match [pattern value ctx-vol]
(let [ctx @ctx-atom] (let [ctx @ctx-vol]
(case (::ast/type pattern) (case (::ast/type pattern)
::ast/placeholder {:success true :ctx {}} ::ast/placeholder {:success true :ctx {}}
@ -60,7 +60,7 @@
{:success false :reason (str "Name " word " is already bound")} {:success false :reason (str "Name " word " is already bound")}
{:success true :ctx {word value}})) {:success true :ctx {word value}}))
::ast/tuple (match-tuple pattern value ctx-atom) ::ast/tuple (match-tuple pattern value ctx-vol)
(throw (ex-info "Unknown pattern" {:pattern pattern}))))) (throw (ex-info "Unknown pattern" {:pattern pattern})))))
@ -76,7 +76,7 @@
match (match pattern value ctx) match (match pattern value ctx)
success (:success match)] success (:success match)]
(if success (if success
(swap! ctx update-ctx (:ctx match)) (vswap! ctx update-ctx (:ctx match))
(throw (ex-info (:reason match) {}))) (throw (ex-info (:reason match) {})))
value)) value))
@ -98,13 +98,13 @@
(if clause (if clause
(let [pattern (:pattern clause) (let [pattern (:pattern clause)
body (:body clause) body (:body clause)
new-ctx (atom {::parent ctx}) new-ctx (volatile! {::parent ctx})
match? (match pattern expr new-ctx) match? (match pattern expr new-ctx)
success (:success match?) success (:success match?)
clause-ctx (:ctx match?)] clause-ctx (:ctx match?)]
(if success (if success
(do (do
(swap! new-ctx #(merge % clause-ctx)) (vswap! new-ctx #(merge % clause-ctx))
(interpret-ast body new-ctx)) (interpret-ast body new-ctx))
(recur (first clauses) (rest clauses)))) (recur (first clauses) (rest clauses))))
(throw (ex-info "Match Error: No match found" {})))))) (throw (ex-info "Match Error: No match found" {}))))))
@ -159,13 +159,13 @@
(if clause (if clause
(let [pattern (:pattern clause) (let [pattern (:pattern clause)
body (:body clause) body (:body clause)
new-ctx (atom {::parent ctx}) new-ctx (volatile! {::parent ctx})
match? (match pattern tuple new-ctx) match? (match pattern tuple new-ctx)
success (:success match?) success (:success match?)
clause-ctx (:ctx match?)] clause-ctx (:ctx match?)]
(if success (if success
(do (do
(swap! new-ctx #(merge % clause-ctx)) (vswap! new-ctx #(merge % clause-ctx))
(interpret-ast body new-ctx)) (interpret-ast body new-ctx))
(recur (first clauses) (rest clauses)))) (recur (first clauses) (rest clauses))))
@ -218,7 +218,7 @@
(if (contains? @ctx name) (if (contains? @ctx name)
(throw (ex-info (str "Name " name " is already bound") {})) (throw (ex-info (str "Name " name " is already bound") {}))
(do (do
(swap! ctx update-ctx {name fn}) (vswap! ctx update-ctx {name fn})
fn)))))) fn))))))
(defn- interpret-do [ast ctx] (defn- interpret-do [ast ctx]
@ -242,7 +242,7 @@
(map-values #(interpret-ast % ctx)) (map-values #(interpret-ast % ctx))
members)] members)]
(do (do
(swap! ctx update-ctx {name ns}) (vswap! ctx update-ctx {name ns})
ns))))) ns)))))
(defn- interpret-import [ast ctx] (defn- interpret-import [ast ctx]
@ -256,7 +256,7 @@
(scanner/scan) (scanner/scan)
(parser/parse) (parser/parse)
(interpret))] (interpret))]
(swap! ctx update-ctx {name result}) (vswap! ctx update-ctx {name result})
result ;; TODO: test this! result ;; TODO: test this!
)))) ))))
@ -291,7 +291,7 @@
(let [exprs (:exprs ast) (let [exprs (:exprs ast)
inner (pop exprs) inner (pop exprs)
last (peek exprs) last (peek exprs)
ctx (atom {::parent ctx})] ctx (volatile! {::parent ctx})]
(run! #(interpret-ast % ctx) inner) (run! #(interpret-ast % ctx) inner)
(interpret-ast last ctx)) (interpret-ast last ctx))
@ -299,7 +299,7 @@
(let [exprs (:exprs ast) (let [exprs (:exprs ast)
inner (pop exprs) inner (pop exprs)
last (peek exprs) last (peek exprs)
ctx (atom prelude/prelude)] ctx (volatile! prelude/prelude)]
(run! #(interpret-ast % ctx) inner) (run! #(interpret-ast % ctx) inner)
(interpret-ast last ctx)) (interpret-ast last ctx))
@ -333,7 +333,7 @@
(defn interpret [parsed] (defn interpret [parsed]
(interpret-ast (::parser/ast parsed) {})) (interpret-ast (::parser/ast parsed) {}))
(comment (do
(def source " (def source "