Make context volatile!, not atom
This commit is contained in:
parent
ceb8a2aa63
commit
0c77de908c
|
@ -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 "
|
||||||
|
|
||||||
|
|
Loading…
Reference in New Issue
Block a user