From 8752ee0da10438186382f57f38df9ed671b5b396 Mon Sep 17 00:00:00 2001 From: Scott Richmond Date: Thu, 2 Jun 2022 18:42:02 -0400 Subject: [PATCH] Add some process functions --- src/ludus/interpreter.clj | 92 ++++++++------------------------------- src/ludus/process.clj | 77 ++++++++++++++++++++++++++++++++ src/ludus/repl.clj | 5 ++- 3 files changed, 99 insertions(+), 75 deletions(-) create mode 100644 src/ludus/process.clj diff --git a/src/ludus/interpreter.clj b/src/ludus/interpreter.clj index 0495ba9..2a21108 100644 --- a/src/ludus/interpreter.clj +++ b/src/ludus/interpreter.clj @@ -8,10 +8,11 @@ [ludus.show :as show] [ludus.loader :as loader] [ludus.token :as token] + [ludus.process :as process] [clojure.pprint :as pp] [clojure.set])) -(def ^:dynamic self 1001) +(def ^:dynamic self @process/current-pid) ;; right now this is not very efficient: ;; it's got runtime checking @@ -33,61 +34,6 @@ (declare interpret-ast match interpret interpret-file) -(def processes (atom {})) - -(def current-pid (atom 1001)) - -(defn new-process [] - (let [pid @current-pid - process (atom {:pid pid - :queue clojure.lang.PersistentQueue/EMPTY - :inbox nil - :status :occupied - })] - (swap! processes #(assoc % pid process)) - (swap! current-pid inc) - process)) - -(def vm-state (atom :stopped)) - -(defn- values [m] (into [] (map (fn [[_ v]] v)) m)) - -(defn- process-msg [process] - ;;(println "processing message" self) - (let [q (:queue process) - inbox (:inbox process)] - (when (not (realized? inbox)) - ;;(println "delivering message in" self) - (deliver inbox (peek q)) - (assoc process :queue (pop q) :inbox nil)))) - -(defn- run-process [process-atom] - (let [process @process-atom - status (:status process) - q (:queue process) - inbox (:inbox process)] - ;;(println "running process" self ":" (into [] q)) - (when (and (= status :idle) (not-empty q) inbox) - (swap! process-atom process-msg)))) - -(defn- start-vm [] - ;; (println "Starting Ludus VM") - (when (= @vm-state :stopped) - (future - (reset! vm-state :running) - (loop [] - (when (= @vm-state :running) - (run! run-process (values @processes)) - (recur) - ;; (println "Ludus VM shutting down") - ))))) - -(defn- stop-vm [] - (reset! vm-state :stopped) - (reset! processes {}) - (reset! current-pid 1001) - nil) - (defn- match-tuple [pattern value ctx-vol] (cond (not (vector? value)) {:success false :reason "Could not match non-tuple value to tuple"} @@ -491,7 +437,7 @@ (assoc (reduce (dict-term ctx) {} members) ::data/dict true))) (defn- interpret-receive [ast ctx] - (let [process-atom (get @processes self) + (let [process-atom (get @process/processes self) inbox (promise) clauses (:clauses ast)] ;; (println "receiving in" self) @@ -521,7 +467,7 @@ (defn- interpret-send [ast ctx] (let [msg (interpret-ast (:msg ast) ctx) pid (interpret-ast (:pid ast) ctx) - process-atom (get @processes pid) + process-atom (get @process/processes pid) process @process-atom q (:queue process) status (:status process)] @@ -534,7 +480,7 @@ (defn- interpret-spawn [ast ctx] (let [expr (:expr ast) - process (new-process) + process (process/new-process) pid (:pid @process)] (with-bindings {#'self pid} (future @@ -543,7 +489,7 @@ (println "Panic in Ludus process" (str self ":") (ex-message e)) ;; (pp/pprint (ex-data e)) (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)) (defn interpret-ast [ast ctx] @@ -628,7 +574,7 @@ (defn interpret-file [parsed file] (try - (let [base-ctx (volatile! (merge {:file file} prelude/prelude))] + (let [base-ctx (volatile! (merge {:file file} prelude/prelude process/process))] (interpret-ast (::parser/ast parsed) base-ctx)) (catch clojure.lang.ExceptionInfo e (println "Ludus panicked in" file) @@ -638,13 +584,13 @@ (defn interpret [parsed file] (try - (let [base-ctx (volatile! (merge {:file file} prelude/prelude)) - process (new-process)] - (start-vm) + (let [base-ctx (volatile! (merge {:file file} prelude/prelude process/process)) + process (process/new-process)] + (process/start-vm) (with-bindings {#'self (:pid @process)} (let [result (interpret-ast (::parser/ast parsed) base-ctx)] (swap! process #(assoc % :status :dead)) - (stop-vm) + (process/stop-vm) result))) (catch clojure.lang.ExceptionInfo e (println "Ludus panicked in" file) @@ -655,15 +601,15 @@ (defn interpret-safe [parsed] (try (let [base-ctx (volatile! (merge {} prelude/prelude)) - process (new-process)] - (start-vm) + process (process/new-process)] + (process/start-vm) (with-bindings {#'self (:pid @process)} (let [result (interpret-ast (::parser/ast parsed) base-ctx)] (swap! process #(assoc % :status :dead)) result)) - (stop-vm)) + (process/stop-vm)) (catch clojure.lang.ExceptionInfo e - (stop-vm) + (process/stop-vm) (println "Ludus panicked!") (println "On line" (get-in (ex-data e) [:ast :token ::token/line])) (println (ex-message e)) @@ -672,10 +618,10 @@ (defn interpret-repl ([parsed ctx] (let [orig-ctx @ctx - process (new-process) + process (process/new-process) pid (:pid @process)] (try - (start-vm) + (process/start-vm) (with-bindings {#'self pid} (let [result (interpret-ast (::parser/ast parsed) ctx)] {:result result :ctx ctx :pid pid})) @@ -686,7 +632,7 @@ ([parsed ctx pid] (let [orig-ctx @ctx] (try - (start-vm) + (process/start-vm) (with-bindings {#'self pid} (let [result (interpret-ast (::parser/ast parsed) ctx)] {:result result :ctx ctx :pid pid})) @@ -698,7 +644,7 @@ (comment - (start-vm) + (process/start-vm) (def source " fn echo () -> { & print (self, :echoing) diff --git a/src/ludus/process.clj b/src/ludus/process.clj new file mode 100644 index 0000000..991fc94 --- /dev/null +++ b/src/ludus/process.clj @@ -0,0 +1,77 @@ +(ns ludus.process + (:require + [ludus.data :as data])) + +(def processes (atom {})) + +(def current-pid (atom 1001)) + +(defn new-process [] + (let [pid @current-pid + process (atom {:pid pid + :queue clojure.lang.PersistentQueue/EMPTY + :inbox nil + :status :occupied + })] + (swap! processes #(assoc % pid process)) + (swap! current-pid inc) + process)) + +(def vm-state (atom :stopped)) + +(defn- values [m] (into [] (map (fn [[_ v]] v)) m)) + +(defn- map-values [m f] (into {} (map (fn [[k v]] [k (f v)])) m)) + +(defn process-msg [process] + ;;(println "processing message" self) + (let [q (:queue process) + inbox (:inbox process)] + (when (not (realized? inbox)) + ;;(println "delivering message in" self) + (deliver inbox (peek q)) + (assoc process :queue (pop q) :inbox nil)))) + +(defn run-process [process-atom] + (let [process @process-atom + status (:status process) + q (:queue process) + inbox (:inbox process)] + ;;(println "running process" self ":" (into [] q)) + (when (and (= status :idle) (not-empty q) inbox) + (swap! process-atom process-msg)))) + +(defn start-vm [] + ;; (println "Starting Ludus VM") + (when (= @vm-state :stopped) + (future + (reset! vm-state :running) + (loop [] + (when (= @vm-state :running) + (run! run-process (values @processes)) + (recur) + ;; (println "Ludus VM shutting down") + ))))) + +(defn stop-vm [] + (reset! vm-state :stopped) + (reset! processes {}) + (reset! current-pid 1001) + nil) + +(def process {"process" { + ::data/struct true + ::data/type ::data/ns + ::data/name "process" + + :list {::data/type ::data/clj + :name "list" + :body (fn [] (keys @processes))} + + :info {::data/type ::data/clj + :name "info" + :body (fn [pid] + (let [process @(get @processes pid) + queue (into [] (:queue process))] + (assoc process :queue queue)))} + }}) \ No newline at end of file diff --git a/src/ludus/repl.clj b/src/ludus/repl.clj index 78b2e70..6b5fcd1 100644 --- a/src/ludus/repl.clj +++ b/src/ludus/repl.clj @@ -5,7 +5,8 @@ [ludus.interpreter :as interpreter] [ludus.prelude :as prelude] [ludus.show :as show] - [ludus.data :as data])) + [ludus.data :as data] + [ludus.process :as process])) (declare repl-prelude new-session) @@ -19,7 +20,7 @@ (println "\nGoodbye!") (System/exit 0)) -(def base-ctx (merge prelude/prelude +(def base-ctx (merge prelude/prelude process/process {::repl true "repl" {::data/struct true