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,7 +246,7 @@
 
 (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 
                              	(quiet :lbrace)
                              	(quiet (zero+ separator))

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?
                  (merge dict splatted)
                  (throw (ex-info "Cannot splat non-dict into dict" {:ast member}))))
-      (let [k (first member) v (second 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
+    :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

@@ -75,18 +75,18 @@
                         	::data/type ::data/ns
                         	::data/name "process"
 
-	:list {::data/type ::data/clj
+                        	"list" {::data/type ::data/clj
                               			:name "list"
                               			:body (fn [] (into [] (keys @processes)))}
 
-	:info {::data/type ::data/clj
+                        	"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
+                         "flush" {::data/type ::data/clj
                                   :name "flush"
                                   :body (fn [pid]
                                           (let [process (get @processes pid)

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