Implement transient thoughts

src/cljs/emptyhead/lib/core.cljs

@@ -17,11 +17,7 @@
 
 (def/define! [:emptyhead :core :return]
   (fn [thought parent]
-    [parent (thought/data thought)])
+    [parent (thought/data thought)]))
-  :constr-fn
-  (fn [thought parent]
-    (let [[_ data] (thought/pop-stack parent)]
-      {:data data})))
 
 (def/define! [:emptyhead :core :nop]
   (fn [thought parent]

src/cljs/emptyhead/thought/crud.cljs

@@ -3,30 +3,55 @@
   Since thoughts are ideas, 'missing' operations here are implemented in [[emptyhead.idea.crud]]."
   (:require [emptyhead.idea.protocol :as prtc]
             [emptyhead.idea.crud :as idea]
-            [emptyhead.util.magic :as magic]))
+            [emptyhead.util.magic :as magic]
+            [emptyhead.idea.property :as prop]))
 
 (defn make-thought
   "Helper function to make thought object.
   You may want `register-thought!` instead."
-  [operator & {:keys [data ext-stages return]
+  [operator & {:keys [data ext-stages return transient]
                :or {data {}
                     ext-stages [[:PRE-EXECUTE] [:EXECUTE] [:POST-EXECUTE]]
+                    transient true
                     return []}}]
   (hash-map :operator operator
             :data data
             :ext-stages ext-stages
+            :transient transient
             :return return))
 
 (defn register-thought!
   "Create a thought and register it in the state.
   Returns a reference to the created thought."
-  [operator & {:keys [data ext-stages]
+  [operator & {:keys [data ext-stages return transient]
                :as args}]
   (idea/have-idea!
    :prefix (str "emptyhead.thought#" (magic/symbolize-ns operator))
-   :properties [magic/thought-ns]
+   :properties [magic/thought-ns
+                (magic/operator-property [operator])]
    :data (make-thought operator args)))
 
+(defn deref-primitive_
+  [operator]
+  (prop/with-property (magic/operator-property [operator])))
+
+(defn deref-primitive
+  [operator]
+  (let [existing (deref-primitive_ operator)
+        n (count existing)]
+    (when (> n 1)
+      (throw (ex-info (str "ERROR: Primitive " operator " has " n " implementations.")
+                      {:n n :operator operator})))
+  (first existing)))
+
+(defn register-singleton!
+  "Register a thought of which only one is meant to exist."
+  [operator & {:keys [data ext-stages]
+               :as args}]
+  (let [existing (deref-primitive_ operator)]
+    (run! idea/forget-idea! existing)
+    (register-thought! operator args)))
+
 (defn stages
   "Get the extension stages of a `thought`.
   Returns the list of stages."
@@ -52,6 +77,20 @@
   [thought]
   [(assoc thought :return (-> thought prtc/copy stack butlast vec)) (-> thought prtc/copy stack peek)])
 
+(defn empty-stack
+  [thought]
+  [(assoc thought :return []) (:return thought)])
+
+(defn pop-args
+  [thought dest]
+  (let [sentinel (into [:_FOR] (prtc/val-fn :operator dest))
+        stack (prtc/val-fn :return thought)
+        idx (.lastIndexOf stack sentinel)
+        before (subvec stack 0 idx)
+        after (subvec stack (+ 1 idx))]
+    [(assoc thought :return before)
+     after]))
+
 (defn add-ext-stage!
   [thought stage]
   (idea/mutate-idea! #(update % :ext-stages conj stage) thought))

src/cljs/emptyhead/thought/eval.cljs

@@ -6,6 +6,7 @@
             [emptyhead.util.logging :as logging]
             [emptyhead.thought.return :as return]
             [emptyhead.idea.property :as prop]
+            [emptyhead.idea.crud :as idea]
             [emptyhead.util.magic :as magic]))
 
 (defn- impl! [thought & [parent]]
@@ -16,14 +17,12 @@
                      {:thought thought :parent parent :type :unimplemented-thought})
       ((prtc/val-fn :implementation impl-idea) thought parent))))
 
-;; FIXME I don't think omitting the parent here is actually valid?
-;; might need to use thought.crud/root-thought, but better making parent mandatory tabun
 (defn execute!
   "Execute `thought` with `parent`, applying aspects to `thought` according to its :extension-stages.
   Returns (potentially modified) `parent`."
   [thought & [parent]]
-  (loop [th (prtc/val-fn #(assoc % :_parent (prtc/value parent)) thought)
+  (loop [parent (or parent (thought/make-thought [:EH :NOP]))
-         parent parent]
+         th (prtc/val-fn #(assoc % :_parent (prtc/value parent)) thought)]
     (let [[extensions th cur] (extend/pop-stage th)
 
           ;; Execute extensions, potentially modifying th
@@ -42,4 +41,7 @@
       ;; Recur if there's remaining aspects, otherwise return `parent`.
       (if (not-empty (thought/stages th))
         (recur th parent)
-        parent))))
+        (do
+          (when (prtc/val-fn :transient thought)
+            (prtc/ref-fn idea/forget-idea! thought))
+          parent)))))

src/cljs/emptyhead/thought/return.cljs

@@ -11,6 +11,10 @@
      #(update % :return (fnil into []) data) thought)
     thought))
 
+(defn update-return
+  [thought fn]
+  (prtc/val-fn #(update-in % [:return] fn) thought))
+
 (defn return-vals [thought namespace]
   (prtc/val-fn #(get-in % [:return namespace]) thought))
 

src/cljs/emptyhead/util/magic.cljs

@@ -2,7 +2,11 @@
   "Magic values for EmptyHead."
   (:require [clojure.string :as str]))
 
-(def thought-ns [:emptyhead :thought])
+(def thought-ns [:EH :THOUGHT])
+
+(defn operator-property
+  [op]
+  (into [:EH :OPERATOR] op))
 
 (def thought-impl-ns (conj thought-ns :implementation))
 
@@ -15,4 +19,9 @@
   (conj extension-ns stage))
 
 (defn symbolize-ns [ns]
-  (str/join "." (map name ns)))
+  (str/join
+   "." (map
+        #(if (sequential? %)
+           (symbolize-ns (concat [:<] % [:>]))
+           (name %))
+        ns)))