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

Interpret do expressions

Browse Source
This commit is contained in:
Scott Richmond 2022-04-05 19:09:38 -04:00
parent 0a34e22a98
commit 5a95f58ec1
1 changed files with 37 additions and 30 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

67
src/ludus/interpreter.clj
View File

@ -123,41 +123,40 @@
))) )))
(defn- call-fn [fn tuple ctx] (defn- call-fn [fn tuple ctx]
(let [passed (interpret-ast tuple ctx)] (case (::data/type fn)
(case (::data/type fn) ::data/clj (apply (:body fn) (next tuple))
::data/clj (apply (:body fn) (next passed))
::data/fn ::data/fn
(let [clauses (:clauses fn)] (let [clauses (:clauses fn)]
(loop [clause (first clauses) (loop [clause (first clauses)
clauses (rest clauses)] clauses (rest clauses)]
(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 (atom {::parent ctx})
match? (match pattern passed 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)) (swap! 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" {:fn-name (:name fn)}))))) (throw (ex-info "Match Error: No match found" {:fn-name (:name fn)})))))
;; TODO: clean this up ;; TODO: clean this up
;; TODO: error with a passed tuple longer than 1 ;; TODO: error with a passed tuple longer than 1
(if (= clojure.lang.Keyword (type fn)) (if (= clojure.lang.Keyword (type fn))
(if (= 2 (count passed)) (if (= 2 (count tuple))
(let [target (second passed) kw fn] (let [target (second tuple) kw fn]
(if (::data/struct target) (if (::data/struct target)
(if (contains? target kw) (if (contains? target kw)
(kw target) (kw target)
(throw (ex-info (str "Struct error: no member at " kw) {}))) (throw (ex-info (str "Struct error: no member at " kw) {})))
(kw target))) (kw target)))
(throw (ex-info "Called keywords take a single argument" {}))) (throw (ex-info "Called keywords take a single argument" {})))
(throw (ex-info "I don't know how to call that" {:fn fn})))))) (throw (ex-info "I don't know how to call that" {:fn fn})))))
;; TODO: add placeholder partial application ;; TODO: add placeholder partial application
(defn- interpret-synthetic-term [prev-value curr ctx] (defn- interpret-synthetic-term [prev-value curr ctx]
@ -168,7 +167,7 @@
(get prev-value (:value curr)) (get prev-value (:value curr))
(throw (ex-info (str "Struct error: no member " (:value curr)) {}))) (throw (ex-info (str "Struct error: no member " (:value curr)) {})))
(get prev-value (:value curr))) (get prev-value (:value curr)))
(call-fn prev-value curr ctx)))) (call-fn prev-value (interpret-ast curr ctx) ctx))))
(defn- interpret-synthetic [ast ctx] (defn- interpret-synthetic [ast ctx]
(let [terms (:terms ast) (let [terms (:terms ast)
@ -197,6 +196,12 @@
(swap! ctx update-ctx {name fn}) (swap! ctx update-ctx {name fn})
fn)))))) fn))))))
(defn- interpret-do [ast ctx]
(let [exprs (:exprs ast)
origin (interpret-ast (first exprs) ctx)
fns (rest exprs)]
(reduce #(call-fn (interpret-ast %2 ctx) [::data/tuple %1] ctx) origin fns)))
(defn- map-values [f] (defn- map-values [f]
(map (fn [kv] (map (fn [kv]
(let [[k v] kv] (let [[k v] kv]
@ -219,6 +224,8 @@
::ast/fn (interpret-fn ast ctx) ::ast/fn (interpret-fn ast ctx)
::ast/pipeline (interpret-do ast ctx)
::ast/block ::ast/block
(let [exprs (:exprs ast) (let [exprs (:exprs ast)
inner (pop exprs) inner (pop exprs)
@ -267,7 +274,7 @@
(def source " (def source "
panic! (\"whoops\")
") ")