diff --git a/src/cljs/emptyhead/lib/core.cljs b/src/cljs/emptyhead/lib/core.cljs index 7a34ca6..a990235 100644 --- a/src/cljs/emptyhead/lib/core.cljs +++ b/src/cljs/emptyhead/lib/core.cljs @@ -17,11 +17,7 @@ (def/define! [:emptyhead :core :return] (fn [thought parent] - [parent (thought/data thought)]) - :constr-fn - (fn [thought parent] - (let [[_ data] (thought/pop-stack parent)] - {:data data}))) + [parent (thought/data thought)])) (def/define! [:emptyhead :core :nop] (fn [thought parent] diff --git a/src/cljs/emptyhead/thought/crud.cljs b/src/cljs/emptyhead/thought/crud.cljs index a51eec1..416720f 100644 --- a/src/cljs/emptyhead/thought/crud.cljs +++ b/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)) diff --git a/src/cljs/emptyhead/thought/eval.cljs b/src/cljs/emptyhead/thought/eval.cljs index 98d5cb3..1a029e1 100644 --- a/src/cljs/emptyhead/thought/eval.cljs +++ b/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) - parent parent] + (loop [parent (or parent (thought/make-thought [:EH :NOP])) + 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))))) diff --git a/src/cljs/emptyhead/thought/return.cljs b/src/cljs/emptyhead/thought/return.cljs index 22a54c5..fb0da4f 100644 --- a/src/cljs/emptyhead/thought/return.cljs +++ b/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)) diff --git a/src/cljs/emptyhead/util/magic.cljs b/src/cljs/emptyhead/util/magic.cljs index 00e3b75..1a3c61b 100644 --- a/src/cljs/emptyhead/util/magic.cljs +++ b/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)))