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

Add asts to thrown errors.

Browse Source
This commit is contained in:
Scott Richmond 2022-05-19 17:14:20 -04:00
parent 1fb41d8b71
commit cfe790b9c5
1 changed files with 17 additions and 16 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

33
src/ludus/interpreter.clj
View File

@ -63,7 +63,7 @@
::ast/tuple (match-tuple pattern value ctx-vol) ::ast/tuple (match-tuple pattern value ctx-vol)
(throw (ex-info "Unknown pattern" {:pattern pattern}))))) (throw (ex-info "Unknown pattern on line " {:pattern pattern})))))
(defn- update-ctx [ctx new-ctx] (defn- update-ctx [ctx new-ctx]
(merge ctx new-ctx)) (merge ctx new-ctx))
@ -108,14 +108,14 @@
(vswap! 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" {:ast ast}))))))
(defn- interpret-cond [ast ctx] (defn- interpret-cond [ast ctx]
(let [clauses (:clauses ast)] (let [clauses (:clauses ast)]
(loop [clause (first clauses) (loop [clause (first clauses)
clauses (rest clauses)] clauses (rest clauses)]
(if (not clause) (if (not clause)
(throw (ex-info "Cond Error: No match found" {})) (throw (ex-info "Cond Error: No match found" {:ast ast}))
(let [test-expr (:test clause) (let [test-expr (:test clause)
body (:body clause) body (:body clause)
truthy? (boolean (interpret-ast test-expr ctx))] truthy? (boolean (interpret-ast test-expr ctx))]
@ -130,15 +130,15 @@
(defn- interpret-called-kw [kw tuple ctx] (defn- interpret-called-kw [kw tuple ctx]
;; TODO: check this statically ;; TODO: check this statically
(if (not (= 1 (:length tuple))) (if (not (= 1 (:length tuple)))
(throw (ex-info "Called keywords must be unary" {})) (throw (ex-info "Called keywords must be unary" {:ast kw}))
(let [kw (interpret-ast kw ctx) (let [kw (interpret-ast kw ctx)
map (second (interpret-ast tuple ctx))] map (second (interpret-ast tuple ctx))]
(if (::data/struct map) (if (::data/struct map)
(if (contains? map kw) (if (contains? map kw)
(kw map) (kw map)
(if (= (::data/type map) ::data/ns) (if (= (::data/type map) ::data/ns)
(throw (ex-info (str "Namespace error: no member " kw " in ns " (::data/name map)) {})) (throw (ex-info (str "Namespace error: no member " kw " in ns " (::data/name map)) {:ast kw}))
(throw (ex-info (str "Struct error: no member at " kw) {})))) (throw (ex-info (str "Struct error: no member at " kw) {:ast kw}))))
(get map kw)) (get map kw))
))) )))
@ -173,7 +173,7 @@
(interpret-ast body fn-ctx)) (interpret-ast body fn-ctx))
(recur (first clauses) (rest clauses)))) (recur (first clauses) (rest clauses))))
(throw (ex-info "Match Error: No match found" {:fn-name (:name lfn)}))))) (throw (ex-info "Match Error: No match found" {:ast (:ast lfn)})))))
(keyword? lfn) (keyword? lfn)
(if (= 2 (count tuple)) (if (= 2 (count tuple))
@ -182,14 +182,14 @@
(if (contains? target kw) (if (contains? target kw)
(kw target) (kw target)
(if (= (::data/type target) ::data/ns) (if (= (::data/type target) ::data/ns)
(throw (ex-info (str "Namespace error: no member " kw " in ns" (::data/name target)) {})) (throw (ex-info (str "Namespace error: no member " kw " in ns" (::data/name target)) {:ast kw}))
(throw (ex-info (str "Struct error: no member at " kw) {})) (throw (ex-info (str "Struct error: no member at " kw) {:ast kw}))
) )
) )
(kw target))) (kw target)))
(throw (ex-info "Called keywords take a single argument" {}))) (throw (ex-info "Called keywords take a single argument" {:ast lfn})))
:else (throw (ex-info "I don't know how to call that" {:fn lfn})))) :else (throw (ex-info "I don't know how to call that" {:ast lfn}))))
(defn- interpret-synthetic-term [prev-value curr ctx] (defn- interpret-synthetic-term [prev-value curr ctx]
(let [type (::ast/type curr)] (let [type (::ast/type curr)]
@ -220,6 +220,7 @@
(if (= name ::ast/anon) (if (= name ::ast/anon)
{::data/type ::data/fn {::data/type ::data/fn
:name name :name name
:ast ast
:clauses clauses :clauses clauses
:ctx ctx} :ctx ctx}
(let [fn {::data/type ::data/fn (let [fn {::data/type ::data/fn
@ -227,7 +228,7 @@
:clauses clauses :clauses clauses
:ctx ctx}] :ctx ctx}]
(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") {:ast ast}))
(do (do
(vswap! ctx update-ctx {name fn}) (vswap! ctx update-ctx {name fn})
fn)))))) fn))))))
@ -247,7 +248,7 @@
(let [members (:members ast) (let [members (:members ast)
name (:name ast)] name (:name ast)]
(if (contains? @ctx name) (if (contains? @ctx name)
(throw (ex-info (str "ns name " name " is already bound") {})) (throw (ex-info (str "ns name " name " is already bound") {:ast ast}))
(let [ns (into (let [ns (into
{::data/struct true ::data/type ::data/ns ::data/name name} {::data/struct true ::data/type ::data/ns ::data/name name}
(map-values #(interpret-ast % ctx)) (map-values #(interpret-ast % ctx))
@ -273,7 +274,7 @@
(defn- interpret-ref [ast ctx] (defn- interpret-ref [ast ctx]
(let [name (:name ast) expr (:expr ast)] (let [name (:name ast) expr (:expr ast)]
(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") {:ast ast})))
(let [value (interpret-ast expr ctx) (let [value (interpret-ast expr ctx)
box (atom value) box (atom value)
ref {::data/ref true ::data/value box ::data/name name}] ref {::data/ref true ::data/value box ::data/name name}]
@ -299,7 +300,7 @@
(interpret-ast body new-ctx)) (interpret-ast body new-ctx))
(recur (first clauses) (rest clauses)))) (recur (first clauses) (rest clauses))))
(throw (ex-info (str "Match Error: No match found in loop for " input) {}))))] (throw (ex-info (str "Match Error: No match found in loop for " input) {:ast ast}))))]
(if (::data/recur output) (if (::data/recur output)
(recur (:tuple output)) (recur (:tuple output))
output output
@ -382,7 +383,7 @@
(let [members (:members ast)] (let [members (:members ast)]
(into {::data/struct true} (map-values #(interpret-ast % ctx)) members)) (into {::data/struct true} (map-values #(interpret-ast % ctx)) members))
(throw (ex-info "Unknown AST node type" {:node ast})))) (throw (ex-info "Unknown AST node type" {:ast ast}))))
(defn interpret [parsed] (defn interpret [parsed]
(try (try