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

Fix unbound name errors, import bug, process:in->process:inbox

Browse Source
This commit is contained in:
Scott Richmond 2022-06-02 17:38:16 -04:00
parent 2f5ebe85f7
commit 2de1d94a4a
1 changed files with 30 additions and 21 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

51
src/ludus/interpreter.clj
View File

@ -17,13 +17,19 @@
;; 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-vol] (defn- ludus-resolve [key ctx-vol]
(let [ctx @ctx-vol] (let [ctx @ctx-vol]
(if (contains? ctx word) (if (contains? ctx key)
(get ctx word) (get ctx key)
(if (contains? ctx ::parent) (if (contains? ctx ::parent)
(recur word (::parent ctx)) (recur key (::parent ctx))
(throw (ex-info (str "Unbound name: " word) {})))))) ::not-found))))
(defn- resolve-word [word ctx]
(let [value (ludus-resolve (:word word) ctx)]
(if (= ::not-found value)
(throw (ex-info (str "Unbound name: " (:word word)) {:ast word}))
value)))
(declare interpret-ast match interpret) (declare interpret-ast match interpret)
@ -35,7 +41,7 @@
(let [pid @current-pid (let [pid @current-pid
process (atom {:pid pid process (atom {:pid pid
:queue clojure.lang.PersistentQueue/EMPTY :queue clojure.lang.PersistentQueue/EMPTY
:in nil :inbox nil
:status :occupied :status :occupied
})] })]
(swap! processes #(assoc % pid process)) (swap! processes #(assoc % pid process))
@ -49,19 +55,19 @@
(defn- process-msg [process] (defn- process-msg [process]
;;(println "processing message" self) ;;(println "processing message" self)
(let [q (:queue process) (let [q (:queue process)
in (:in process)] inbox (:inbox process)]
(when (not (realized? in)) (when (not (realized? inbox))
;;(println "delivering message in" self) ;;(println "delivering message in" self)
(deliver in (peek q)) (deliver inbox (peek q))
(assoc process :queue (pop q) :in nil)))) (assoc process :queue (pop q) :inbox nil))))
(defn- run-process [process-atom] (defn- run-process [process-atom]
(let [process @process-atom (let [process @process-atom
status (:status process) status (:status process)
q (:queue process) q (:queue process)
in (:in process)] inbox (:inbox process)]
;;(println "running process" self ":" (into [] q)) ;;(println "running process" self ":" (into [] q))
(when (and (= status :idle) (not-empty q) in) (when (and (= status :idle) (not-empty q) inbox)
(swap! process-atom process-msg)))) (swap! process-atom process-msg))))
(defn- start-vm [] (defn- start-vm []
@ -388,14 +394,16 @@
(if (contains? @ctx name) (if (contains? @ctx name)
(throw (ex-info (str "Name " name " is alrady bound") {:ast ast})) (throw (ex-info (str "Name " name " is alrady bound") {:ast ast}))
(let [source (try (let [source (try
(loader/load-import path (resolve-word ::file ctx)) (loader/load-import path (ludus-resolve :file ctx))
(catch Exception e (catch Exception e
(if (::loader/error (ex-data e)) (if (::loader/error (ex-data e))
(throw (ex-info (ex-message e) {:ast ast})) (throw (ex-info (ex-message e) {:ast ast}))
(throw e)))) (throw e))))
result (-> source (scanner/scan) (parser/parse) (interpret path))] result (-> source (scanner/scan) (parser/parse) (interpret path))]
;; (pp/pprint @ctx)
(vswap! ctx update-ctx {name result}) (vswap! ctx update-ctx {name result})
result ;; TODO: test this! ;; (pp/pprint @ctx)
result
)))) ))))
(defn- interpret-ref [ast ctx] (defn- interpret-ref [ast ctx]
@ -484,11 +492,12 @@
(defn- interpret-receive [ast ctx] (defn- interpret-receive [ast ctx]
(let [process-atom (get @processes self) (let [process-atom (get @processes self)
in (promise) inbox (promise)
clauses (:clauses ast)] clauses (:clauses ast)]
;; (println "receiving in" self) (println "receiving inbox" self)
(swap! process-atom #(assoc % :in in :status :idle)) (swap! process-atom #(assoc % :inbox inbox :status :idle))
(let [msg @in] (println "awaiting message in" self)
(let [msg @inbox]
(swap! process-atom #(assoc % :status :occupied)) (swap! process-atom #(assoc % :status :occupied))
;; (println "message received by" self ":" msg) ;; (println "message received by" self ":" msg)
(loop [clause (first clauses) (loop [clause (first clauses)
@ -532,8 +541,8 @@
(try (interpret-ast expr ctx) (try (interpret-ast expr ctx)
(catch Exception e (catch Exception e
(println "Panic in Ludus process" (str self ":") (ex-message e)) (println "Panic in Ludus process" (str self ":") (ex-message e))
(pp/pprint (ex-data e)) ;; (pp/pprint (ex-data e))
(println "On line" (get-in (ex-data e) [:ast :token ::token/line]) "in" (resolve-word :file ctx)))) (println "On line" (get-in (ex-data e) [:ast :token ::token/line]) "in" (ludus-resolve :file ctx))))
(swap! @process #(assoc % :status :dead)))) (swap! @process #(assoc % :status :dead))))
pid)) pid))
@ -543,7 +552,7 @@
::ast/atom (:value ast) ::ast/atom (:value ast)
::ast/word (resolve-word (:word ast) ctx) ::ast/word (resolve-word ast ctx)
::ast/let (interpret-let ast ctx) ::ast/let (interpret-let ast ctx)