From 6cf09fb177b80cbbbe49dd66fd78990f1dcc4703 Mon Sep 17 00:00:00 2001 From: Scott Richmond Date: Mon, 22 May 2023 16:56:24 -0400 Subject: [PATCH] Complete interpreter, less process system: spawn, receive --- src/ludus/grammar.clj | 14 ++-- src/ludus/interpreter.clj | 145 ++++++++++++++++++++-------------- src/ludus/interpreter_new.clj | 4 +- src/ludus/process.clj | 74 ++++++++--------- src/ludus/show.clj | 2 +- 5 files changed, 131 insertions(+), 108 deletions(-) diff --git a/src/ludus/grammar.clj b/src/ludus/grammar.clj index e5f3c9a..09ff1db 100644 --- a/src/ludus/grammar.clj +++ b/src/ludus/grammar.clj @@ -137,7 +137,7 @@ (zero+ struct-entry) (quiet :rbrace)]))) -(def dict-term (flat (choice :dict-term [:word pair splat]))) +(def dict-term (flat (choice :dict-term [splat :word pair]))) (def dict-entry (order-1 :dict-entry [dict-term separators])) @@ -246,12 +246,12 @@ (def importt (group (order-1 :import [(quiet :import) :string (quiet :as) :word]))) -(def nss (group (order-1 :nss [(quiet :ns) - :word - (quiet :lbrace) - (quiet (zero+ separator)) - (zero+ struct-entry) - (quiet :rbrace)]))) +(def nss (group (order-1 :ns [(quiet :ns) + :word + (quiet :lbrace) + (quiet (zero+ separator)) + (zero+ struct-entry) + (quiet :rbrace)]))) (def toplevel (flat (choice :toplevel [importt nss expression testt]))) diff --git a/src/ludus/interpreter.clj b/src/ludus/interpreter.clj index dfe24dc..e13e1f7 100644 --- a/src/ludus/interpreter.clj +++ b/src/ludus/interpreter.clj @@ -495,21 +495,10 @@ (let [[k v] kv] [k (f v)])))) -(defn- interpret-ns [ast ctx] - (let [members (:members ast) - name (:name ast)] - (if (contains? @ctx name) - (throw (ex-info (str "ns name " name " is already bound") {:ast ast})) - (let [ns (into - {::data/struct true ::data/type ::data/ns ::data/name name} - (map-values #(interpret-ast % ctx)) - members)] - (vswap! ctx update-ctx {name ns}) - ns)))) - (defn- interpret-import [ast ctx] - (let [path (:path ast) - name (:name ast) + (let [data (:data ast) + path (-> data first :data first) + name (-> data second :data first) file (ludus-resolve :file ctx) from (if (= ::not-found file) :cwd file)] (if (contains? @ctx name) @@ -521,14 +510,14 @@ (throw (ex-info (ex-message e) {:ast ast})) (throw e)))) result (-> source (scanner/scan) (parser/parse) (interpret-file path))] - ;; (pp/pprint @ctx) (vswap! ctx update-ctx {name result}) - ;; (pp/pprint @ctx) result )))) (defn- interpret-ref [ast ctx] - (let [name (:name ast) expr (:expr ast)] + (let [data (:data ast) + name (-> data first :data first) + expr (-> data second)] (when (contains? @ctx name) (throw (ex-info (str "Name " name " is already bound") {:ast ast}))) (let [value (interpret-ast expr ctx) @@ -579,24 +568,25 @@ (defn- list-term [ctx] (fn [list member] - (if (= (::ast/type member) ::ast/splat) - (let [splatted (interpret-ast (:expr member) ctx) - splat-list? (and - (vector? splatted) - (not (= (first splatted) ::data/tuple)))] - (if splat-list? - (concat list splatted) + (if (= (:type member) :splat) + (let [splatted (interpret-ast (-> member :data first) ctx) + splattable? (vector? splatted) + tuple-splat? (= (first splatted) ::data/tuple)] + (if splattable? + (if tuple-splat? + (into [] (concat list (rest splatted))) + (concat list splatted)) (throw (ex-info "Cannot splat non-list into list" {:ast member})))) - (concat list [(interpret-ast member ctx)])))) + (conj list (interpret-ast member ctx))))) (defn- interpret-list [ast ctx] - (let [members (:members ast)] + (let [members (:data ast)] (into [] (reduce (list-term ctx) [] members)))) (defn- set-term [ctx] (fn [set member] - (if (= (::ast/type member) ::ast/splat) - (let [splatted (interpret-ast (:expr member) ctx) + (if (= (:type member) :splat) + (let [splatted (interpret-ast (-> member :data first) ctx) splat-set? (set? splatted)] (if splat-set? (clojure.set/union set splatted) @@ -604,26 +594,68 @@ (conj set (interpret-ast member ctx))))) (defn- interpret-set [ast ctx] - (let [members (:members ast)] + (let [members (:data ast)] (reduce (set-term ctx) #{} members))) (defn- dict-term [ctx] (fn [dict member] - (if (= (::ast/type member) ::ast/splat) - (let [splatted (interpret-ast (:expr member) ctx) - splat-map? (and - (map? splatted) - (::data/dict splatted))] - (if splat-map? - (merge dict splatted) - (throw (ex-info "Cannot splat non-dict into dict" {:ast member})))) - (let [k (first member) v (second member)] - (assoc dict k (interpret-ast v ctx)))))) + (case (:type member) + :splat (let [splatted (interpret-ast (-> member :data first) ctx) + splat-map? (or (::data/dict splatted) + (::data/struct splatted))] + (if splat-map? + (merge dict splatted) + (throw (ex-info "Cannot splat non-dict into dict" {:ast member})))) + :word (let [data (:data member) k (-> data first keyword)] + (assoc dict k (interpret-ast member ctx))) + + :pair (let [data (:data member) k (-> data first :data first) v (second data)] + (assoc dict k (interpret-ast v ctx)))))) (defn- interpret-dict [ast ctx] - (let [members (:members ast)] + (let [members (:data ast)] (assoc (reduce (dict-term ctx) {} members) ::data/dict true))) +(defn- struct-term [ctx] + (fn [struct member] + (case (:type member) + :splat (throw (ex-info "Cannot splat into struct" {:ast member})) + + :word (let [data (:data member) k (-> data first keyword)] + (assoc struct k (interpret-ast member ctx))) + + :pair (let [data (:data member) k (-> data first :data first) v (second data)] + (assoc struct k (interpret-ast v ctx)))))) + +(defn- interpret-struct [ast ctx] + (let [members (:data ast)] + (assoc (reduce (struct-term ctx) {} members) ::data/struct true))) + +(defn- ns-term [ctx] + (fn [ns member] + (case (:type member) + :splat (throw (ex-info "Cannot splat into ns" {:ast member})) + + :word (let [data (:data member) k (-> data first keyword)] + (assoc ns k (interpret-ast member ctx))) + + :pair (let [data (:data member) k (-> data first :data first) v (second data)] + (assoc ns k (interpret-ast v ctx)))))) + +(defn- interpret-ns [ast ctx] + (let [data (:data ast) + name (-> data first :data first) + members (rest data)] + (if (contains? @ctx name) + (throw (ex-info (str "ns name " name " is already bound") {:ast ast})) + (let [ns (merge { + ::data/struct true + ::data/type ::data/ns + ::data/name name} + (reduce (ns-term ctx) {} members))] + (vswap! ctx update-ctx {name ns}) + ns)))) + (defn- interpret-receive [ast ctx] (let [process-atom (get @process/processes self) inbox (promise) @@ -668,7 +700,7 @@ msg)) (defn- interpret-spawn [ast ctx] - (let [expr (:expr ast) + (let [expr (-> ast :data first) process (process/new-process) pid (:pid @process)] (with-bindings {#'self pid} @@ -710,16 +742,14 @@ :placeholder ::data/placeholder - ::ast/ns (interpret-ns ast ctx) + :ns (interpret-ns ast ctx) - ::ast/import (interpret-import ast ctx) + :import (interpret-import ast ctx) - ::ast/ref (interpret-ref ast ctx) + :ref (interpret-ref ast ctx) ::ast/spawn (interpret-spawn ast ctx) - ::ast/send (interpret-send ast ctx) - ::ast/receive (interpret-receive ast ctx) :recur @@ -749,15 +779,14 @@ (let [members (:data ast)] (into [::data/tuple] (map #(interpret-ast % ctx)) members)) - ::ast/list (interpret-list ast ctx) + :list (interpret-list ast ctx) - ::ast/set (interpret-set ast ctx) + :set (interpret-set ast ctx) - ::ast/dict (interpret-dict ast ctx) + :dict (interpret-dict ast ctx) - ::ast/struct - (let [members (:members ast)] - (into {::data/struct true} (map-values #(interpret-ast % ctx)) members)) + :struct + (let [members (:members ast)] (interpret-struct ast ctx)) (throw (ex-info "Unknown AST node type" {:ast ast})))) @@ -777,7 +806,7 @@ process (process/new-process)] (process/start-vm) (with-bindings {#'self (:pid @process)} - (let [result (interpret-ast (::parser/ast parsed) base-ctx)] + (let [result (interpret-ast (::parser/ast parsed) {::parent base-ctx})] (swap! process #(assoc % :status :dead)) (process/stop-vm) result))) @@ -789,7 +818,7 @@ (defn interpret-safe [parsed] (try - (let [base-ctx (volatile! (merge {} prelude/prelude)) + (let [base-ctx (volatile! {::parent (volatile! prelude/prelude)}) process (process/new-process)] (process/start-vm) (with-bindings {#'self (:pid @process)} @@ -835,13 +864,7 @@ (do (process/start-vm) (def source " - loop (4) with { - (0) -> print (:done) - (x) -> { - print (x) - recur (dec (x)) - } - } + ref a = 1 ") (println "") diff --git a/src/ludus/interpreter_new.clj b/src/ludus/interpreter_new.clj index 0ec7620..d22c685 100644 --- a/src/ludus/interpreter_new.clj +++ b/src/ludus/interpreter_new.clj @@ -5,13 +5,13 @@ [ludus.scanner :as s])) (def source - "fn () -> {recur (x)} + "spawn foo " ) (def tokens (-> source s/scan :tokens)) -(def result (p/apply-parser g/script tokens)) +(def result (p/apply-parser g/spawn tokens)) (-> result :data) diff --git a/src/ludus/process.clj b/src/ludus/process.clj index 0259cc7..30926f0 100644 --- a/src/ludus/process.clj +++ b/src/ludus/process.clj @@ -1,6 +1,6 @@ (ns ludus.process - (:require - [ludus.data :as data]) + (:require + [ludus.data :as data]) (:import (java.util.concurrent Executors))) ;; virtual thread patch from https://ales.rocks/notes-on-virtual-threads-and-clojure @@ -20,13 +20,13 @@ (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)) + :queue clojure.lang.PersistentQueue/EMPTY + :inbox nil + :status :occupied + })] + (swap! processes #(assoc % pid process)) + (swap! current-pid inc) + process)) (def vm-state (atom :stopped)) @@ -37,7 +37,7 @@ (defn process-msg [process] ;;(println "processing message" self) (let [q (:queue process) - inbox (:inbox process)] + inbox (:inbox process)] (when (not (realized? inbox)) ;;(println "delivering message in" self) (deliver inbox (peek q)) @@ -45,9 +45,9 @@ (defn run-process [process-atom] (let [process @process-atom - status (:status process) - q (:queue process) - inbox (:inbox process)] + 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)))) @@ -59,10 +59,10 @@ (reset! vm-state :running) (loop [] (when (= @vm-state :running) - (run! run-process (values @processes)) - (recur) - ;; (println "Ludus VM shutting down") - ))))) + (run! run-process (values @processes)) + (recur) + ;; (println "Ludus VM shutting down") + ))))) (defn stop-vm [] (reset! vm-state :stopped) @@ -71,26 +71,26 @@ nil) (def process {"process" { - ::data/struct true - ::data/type ::data/ns - ::data/name "process" + ::data/struct true + ::data/type ::data/ns + ::data/name "process" - :list {::data/type ::data/clj - :name "list" - :body (fn [] (into [] (keys @processes)))} + "list" {::data/type ::data/clj + :name "list" + :body (fn [] (into [] (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 ::data/dict true)))} + "info" {::data/type ::data/clj + :name "info" + :body (fn [pid] + (let [process @(get @processes pid) + queue (into [] (:queue process))] + (assoc process :queue queue ::data/dict true)))} - :flush {::data/type ::data/clj - :name "flush" - :body (fn [pid] - (let [process (get @processes pid) - queue (into [] (:queue @process))] - (swap! process #(assoc % :queue clojure.lang.PersistentQueue/EMPTY)) - queue))} - }}) \ No newline at end of file + "flush" {::data/type ::data/clj + :name "flush" + :body (fn [pid] + (let [process (get @processes pid) + queue (into [] (:queue @process))] + (swap! process #(assoc % :queue clojure.lang.PersistentQueue/EMPTY)) + queue))} + }}) \ No newline at end of file diff --git a/src/ludus/show.clj b/src/ludus/show.clj index 82f1fc1..5cff408 100644 --- a/src/ludus/show.clj +++ b/src/ludus/show.clj @@ -25,7 +25,7 @@ (str "@{" (apply str (into [] show-keyed (dissoc v ::data/struct))) "}") (::data/ref v) ;; TODO: reconsider this - (str "ref:" (::data/name v) " <" (deref (::data/value v)) ">") + (str "ref: " (::data/name v) " [" (deref (::data/value v)) "]") (::data/dict v) (str "#{" (apply str (into [] show-keyed (dissoc v ::data/dict))) "}")