stuff

src/cljs/emptyhead/lib/context.cljs

@@ -6,7 +6,7 @@
 
 (def/define! [:emptyhead :core :context]
   (fn [thought parent]
-    [parent nil])
+    (into [parent] (-> thought :data :proc-ret)))
   :constr-fn
   (fn [thought parent]
     {:data {:parent (memtag/uid-of parent)}}))

src/cljs/emptyhead/lib/core.cljs

@@ -29,8 +29,8 @@
 
 (def/define! [:emptyhead :core :add-ext-stage]
   (fn [thought parent]
-    (let [[down stage] (thought/pop-stack parent)
-          [_ op] (thought/pop-stack down)
+    (let [[parent stage] (thought/pop-stack parent)
+          [_ op] (thought/pop-stack parent)
           exe (prop/just-property op)]
       (thought/add-ext-stage! exe stage)
       [parent nil])))

src/cljs/emptyhead/repl/core.cljs

@@ -3,7 +3,9 @@
             [emptyhead.thought.extend :as extend]
             [emptyhead.thought.eval :as teval]
             [emptyhead.idea.property :as prop]
+            [emptyhead.util.magic :as magic]
             [emptyhead.idea.protocol :as prtc]
+            [emptyhead.idea.crud :as idea]
             [emptyhead.idea.memtag :as memtag]
             [emptyhead.thought.define :as def]
             [emptyhead.thought.crud :as thought]
@@ -69,7 +71,8 @@
   (clear-context)
   (run! #(eval! % context) (apply read input))
   (pprint-tos context)
-  (prtc/reference (teval/execute! context context)))
+  (prtc/reference (teval/execute! context context))
+  )
 
 ;; XXX an annoying class of bug is eg  forgetting the return value here, which yields just
 ;; >No protocol method Idea.value defined for type null:
@@ -89,7 +92,7 @@
 
 (def sample (thought/register-thought! [:foo]))
 
-;; XXX This has to have no stages otherwise it will loop on itself ww
+;; XXX This has to have no :PRE-EXECUTE stage otherwise it will loop on itself ww
 (defonce tracker (thought/register-thought! [:emptyhead :debug :track] :ext-stages [[:EXECUTE]]))
 
 (defn enable-tracking []
@@ -102,14 +105,82 @@
 (defn disable-tracking []
   (map #(extend/remove-extension! % [:PRE-EXECUTE]) (extend/get-extensions [:PRE-EXECUTE])))
 
-;; FIXME something is going wrong with the context management here
-;; It would probably be good to name contexts somehow to keep easier track of them
+(defn name-idea
+  [idea context name]
+  (prop/register-property! idea [:emptyhead :name name (prtc/reference context)]))
+
+(defn resolve-name
+  [context name]
+  (prop/just-property [:emptyhead :name name (prtc/reference context)]))
+
+(defn deref-name
+  [self name]
+  (or (and (= (prtc/val-fn :operator self) [:emptyhead :core :context])
+           (resolve-name self name))
+      (and (prtc/val-fn :_parent self)
+           (deref-name (prtc/val-fn :_parent self) name))))
+
+(def/define! [:GRAB]
+  (fn [thought parent]
+    (let [arg-num (inc (or (get-in parent [:data :last-arg]) -1))]
+      [(assoc-in parent [:data :last-arg] arg-num)
+       (-> parent prtc/value :_parent prtc/value :return (#(nth % (- (count %) arg-num 1))))])))
+
+(def/define! [:RETURN]
+  (fn [thought parent]
+    (let [[parent val] (thought/pop-stack parent)]
+      [(update-in parent [:data :proc-ret] (fnil conj []) val) nil])))
+
+;; FIXME this wil bind two things to the same name if you name severa things the same
+;; FIXME this needs to wrap data in an [:emptyhead :core :return] and then evaluate that on deref
+(def/define! [:emptyhead :core :assign-name]
+  (fn [_ parent]
+    (let [[parent name] (thought/pop-stack parent)
+          [_ op] (thought/pop-stack parent)
+          exe (prop/just-property op)]
+      (extend/register-extension! exe (into [:_name] name))
+      [parent nil])))
+
+;; FIXME this is a weird use of the extension system -- figure out how names should actually work!
+;; (in light of the way extensions usually work, see e.g. [emptyhead.thought.extend/get-extensions]) comment
+;; FIXME this needs to wrap data in an [:emptyhead :core :return] and then evaluate that on deref
+(def/define! [:emptyhead :core :deref-name]
+  (fn [_ parent]
+    (let [[parent name] (thought/pop-stack parent)
+          deref (memtag/uid-of
+                 (prop/just-property (magic/extension-prop (into [:_name] name))))]
+      [parent deref])))
+
 (def tst
   '(.BEGIN
-    "hello"
+    "<> -- COMMENCE PROCEDURE -- <>"
     emptyhead.io.print
+
+    GRAB emptyhead.io.print
+    GRAB emptyhead.io.print
+
+    "<> -- PROCEDURE COMPLETE -- <>"
+
+    42 RETURN
+    69 RETURN
     .END
+    emptyhead.io.print
+
+    [:meme]
+    emptyhead.core.assign-name
+
+    "hello"
+    "goodbye"
+    [:meme]
+    emptyhead.core.deref-name
     emptyhead.core.execute
-    emptyhead.core.execute
+    emptyhead.core.pop ;; pop deref'd name
+
+    "\nReturn values of previous:\n"
+    emptyhead.io.print
+    emptyhead.core.pop
+
+    [:meme]
+    emptyhead.core.deref-name
     emptyhead.core.execute
     ))

src/cljs/emptyhead/thought/crud.cljs

@@ -13,9 +13,7 @@
   You may want `register-thought!` instead."
   [operator & {:keys [data ext-contract ext-stages transient]
                :or {data {} ext-contract {}
-                    ext-stages [[:thought operator :pre] [:thought operator]
-                                [:PRE-EXECUTE] [:EXECUTE] [:POST-EXECUTE]
-                                [:thought operator :post]]
+                    ext-stages [[:PRE-EXECUTE] [:EXECUTE] [:POST-EXECUTE]]
                     transient true}}]
   (hash-map :operator operator
             :data data

src/cljs/emptyhead/thought/eval.cljs

@@ -38,7 +38,7 @@
           ;; If it's time for `thought`'s implementation to run, do so,
           ;; potentially modifying `parent`.
           [parent & returns]
-          (if (= cur [:EXECUTE]) ;; NOTE the magic value is now [:EXECUTE] since otherwise nothing could be bound to the global [:emptyhead] propspace
+          (if (= '() (thought/stages th)) ;; NOTE the magic value is now [:EXECUTE] since otherwise nothing could be bound to the global [:emptyhead] propspace
             (impl! th parent)
             [parent nil])