more cleanups

src/cljs/emptyhead/thought/eval.cljs

@@ -14,19 +14,15 @@
     (if-not impl-idea
       (logging/error (str "No implementation for thought `" (thought/operator thought) "`.")
                      {:thought thought :parent parent :type :unimplemented-thought})
-      ((prtc/copy-fn :implementation impl-idea) thought parent))))
+      ((: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]]
+  [thought parent]
-
+  (loop [th (prtc/val-fn #(assoc % :_parent (prtc/value parent)) thought)
-  (loop [th (assoc (prtc/value thought) :_parent (prtc/value parent))
          parent parent]
-    (let [cur (first (thought/stages th))
+    (let [[extensions th cur] (extend/pop-stage th)
-          [extensions th] (extend/pop-stage th)
 
           ;; Execute extensions, potentially modifying th
           th (reduce #(execute! %2 %1) th extensions)

src/cljs/emptyhead/thought/extend.cljs

@@ -19,7 +19,7 @@
     (prop/remove-property! thought (magic/extension-prop stage)))
   thought)
 
-(defn get-extensions
+(defn extensions-of-stage
   "Get extensions for `stage`;
   e.g. for `stage` of [:foo :bar :baz], get extensions for [:foo :bar :baz], [:foo :bar], [:foo]"
   [stage]
@@ -30,26 +30,25 @@
       (recur (butlast property-segment)
              (union acc (prop/with-property (magic/extension-prop property-segment)))))))
 
-;; XXX contains references to scrapped "contract" subsys
+(defn extensions-of-thought
-(defn extensions
   "Get extensions of `thought`.
   Returns a map of {stage => #{thought}}."
   [thought]
   (let [stages (thought/stages thought)
-        aspects (map get-extensions stages)]
+        all-extensions (map extensions-of-stage stages)]
-    (zipmap stages aspects)))
+    (zipmap stages all-extensions)))
 
 (defn pop-stage
   "Get aspects of next stage of thought execution.
-  Returns a tuple of (#{extensions},
+  Returns a tuple of (#{extensions}, though w/ (tail stages), :stage)"
-  a copy of `thought` with its first extension-stage removed)."
   [thought]
   (let [stages (thought/stages thought)
-        aspects (get-extensions (first stages))
+        extensions (extensions-of-stage (first stages))
+        stage-name (first stages)
 
         modified (prtc/copy-fn #(assoc % :ext-stages (rest stages))
                                thought)]
-    (list aspects modified)))
+    (list extensions modified stage-name)))
 
 (defn has-stage?
   "Return true if `thought` has extension stage `stage`.

src/cljs/emptyhead/thought/return.cljs

@@ -2,9 +2,12 @@
   "Utilities for handling thoughts' return values to their parents."
   (:require [emptyhead.idea.protocol :as prtc]))
 
-(defn with-return [thought data]
+(defn with-return
+  "Returns a copy of the thought with all values in data
+   added to the top of its stack."
+  [thought data]
   (if (first data)
-    (prtc/val-fn
+    (prtc/copy-fn
      #(update % :return (fnil into []) data) thought)
     thought))