diff --git a/src/cljs/emptyhead/lib/context.cljs b/src/cljs/emptyhead/lib/context.cljs index 1e57a81..3065f79 100644 --- a/src/cljs/emptyhead/lib/context.cljs +++ b/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)}})) diff --git a/src/cljs/emptyhead/lib/core.cljs b/src/cljs/emptyhead/lib/core.cljs index adb30e1..4809219 100644 --- a/src/cljs/emptyhead/lib/core.cljs +++ b/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]))) diff --git a/src/cljs/emptyhead/repl/core.cljs b/src/cljs/emptyhead/repl/core.cljs index 5ad399f..73d0bb0 100644 --- a/src/cljs/emptyhead/repl/core.cljs +++ b/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 )) diff --git a/src/cljs/emptyhead/thought/crud.cljs b/src/cljs/emptyhead/thought/crud.cljs index dfa43fa..f4790d8 100644 --- a/src/cljs/emptyhead/thought/crud.cljs +++ b/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 diff --git a/src/cljs/emptyhead/thought/eval.cljs b/src/cljs/emptyhead/thought/eval.cljs index 7cbf070..07a2bc6 100644 --- a/src/cljs/emptyhead/thought/eval.cljs +++ b/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])