Complete interpreter, less process system: spawn, receive

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) 
+(def nss (group (order-1 :ns [(quiet :ns) 
-                              	:word 
+                             	:word 
-                              	(quiet :lbrace)
+                             	(quiet :lbrace)
-                              	(quiet (zero+ separator))
+                             	(quiet (zero+ separator))
-                              	(zero+ struct-entry)
+                             	(zero+ struct-entry)
-                              	(quiet :rbrace)])))
+                             	(quiet :rbrace)])))
 
 (def toplevel (flat (choice :toplevel [importt nss expression testt])))
 

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)
+  (let [data (:data ast)
-        name (:name 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)
+    (if (= (:type member) :splat)
-      (let [splatted (interpret-ast (:expr member) ctx)
+      (let [splatted (interpret-ast (-> member :data first) ctx)
-            splat-list? (and
+            splattable? (vector? splatted)
-                          (vector? splatted)
+            tuple-splat? (= (first splatted) ::data/tuple)]
-                          (not (= (first splatted) ::data/tuple)))]
+        (if splattable?
-        (if splat-list?
+          (if tuple-splat?
-          (concat list splatted)
+            (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)
+    (if (= (:type member) :splat)
-      (let [splatted (interpret-ast (:expr member) ctx)
+      (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)
+    (case (:type member)
-      (let [splatted (interpret-ast (:expr member) ctx)
+      :splat (let [splatted (interpret-ast (-> member :data first) ctx)
-            splat-map? (and
+                   splat-map? (or (::data/dict splatted)
-                         (map? splatted)
+                                (::data/struct splatted))]
-                         (::data/dict splatted))]
+               (if splat-map?
-        (if splat-map?
+                 (merge dict splatted)
-          (merge dict splatted)
+                 (throw (ex-info "Cannot splat non-dict into dict" {:ast member}))))
-          (throw (ex-info "Cannot splat non-dict into dict" {:ast member}))))
+      :word (let [data (:data member) k (-> data first keyword)]
-      (let [k (first member) v (second member)]
+              (assoc dict k (interpret-ast member ctx)))
-        (assoc dict k (interpret-ast v 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
+    :struct
-    (let [members (:members ast)]
+    (let [members (:members ast)] (interpret-struct ast ctx))
-      (into {::data/struct true} (map-values #(interpret-ast % ctx)) members))
 
     (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 {
+    ref a = 1
-      (0) -> print (:done)
-      (x) -> {
-        print (x)
-        recur (dec (x))
-      }
-    }
       ")
 
   (println "")

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) 
 

src/ludus/process.clj

@@ -1,6 +1,6 @@
 (ns ludus.process
-	(:require
+ 	(:require
-		[ludus.data :as data])
+  		[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
+                       :queue clojure.lang.PersistentQueue/EMPTY
-                         :inbox nil
+                       :inbox nil
-                         :status :occupied
+                       :status :occupied
-                         })]
+                       })]
-      (swap! processes #(assoc % pid process))
+    (swap! processes #(assoc % pid process))
-      (swap! current-pid inc)
+    (swap! current-pid inc)
-      process))
+    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)
+        status (:status process)
-    q (:queue process)
+        q (:queue process)
-    inbox (:inbox 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))
+          (run! run-process (values @processes))
-            (recur)
+          (recur)
-            ;; (println "Ludus VM shutting down")
+          ;; (println "Ludus VM shutting down")
-            )))))
+          )))))
 
 (defn stop-vm []
   (reset! vm-state :stopped)
@@ -71,26 +71,26 @@
   nil)
 
 (def process {"process" {
-	::data/struct true
+                        	::data/struct true
-	::data/type ::data/ns
+                        	::data/type ::data/ns
-	::data/name "process"
+                        	::data/name "process"
 
-	:list {::data/type ::data/clj
+                        	"list" {::data/type ::data/clj
-			:name "list"
+                              			:name "list"
-			:body (fn [] (into [] (keys @processes)))}
+                              			:body (fn [] (into [] (keys @processes)))}
 
-	:info {::data/type ::data/clj
+                        	"info" {::data/type ::data/clj
-			:name "info"
+                              			:name "info"
-			:body (fn [pid]
+                              			:body (fn [pid]
-				(let [process @(get @processes pid)
+                                     				(let [process @(get @processes pid)
-					queue (into [] (:queue process))]
+                                          					queue (into [] (:queue process))]
-					(assoc process :queue queue ::data/dict true)))}
+                                      					(assoc process :queue queue ::data/dict true)))}
 
-  :flush {::data/type ::data/clj
+                         "flush" {::data/type ::data/clj
-      :name "flush"
+                                  :name "flush"
-      :body (fn [pid]
+                                  :body (fn [pid]
-        (let [process (get @processes pid)
+                                          (let [process (get @processes pid)
-          queue (into [] (:queue @process))]
+                                                queue (into [] (:queue @process))]
-          (swap! process #(assoc % :queue clojure.lang.PersistentQueue/EMPTY))
+                                            (swap! process #(assoc % :queue clojure.lang.PersistentQueue/EMPTY))
-          queue))}
+                                            queue))}
-	}})
+                        	}})

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))) "}")