Implement transient thoughts

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