more cleanups
This commit is contained in:
@@ -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]]
|
||||
|
||||
(loop [th (assoc (prtc/value thought) :_parent (prtc/value parent))
|
||||
[thought parent]
|
||||
(loop [th (prtc/val-fn #(assoc % :_parent (prtc/value parent)) thought)
|
||||
parent parent]
|
||||
(let [cur (first (thought/stages th))
|
||||
[extensions th] (extend/pop-stage th)
|
||||
(let [[extensions th cur] (extend/pop-stage th)
|
||||
|
||||
;; Execute extensions, potentially modifying th
|
||||
th (reduce #(execute! %2 %1) th extensions)
|
||||
|
||||
@@ -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
|
||||
(defn extensions-of-thought
|
||||
"Get extensions of `thought`.
|
||||
Returns a map of {stage => #{thought}}."
|
||||
[thought]
|
||||
(let [stages (thought/stages thought)
|
||||
aspects (map get-extensions stages)]
|
||||
(zipmap stages aspects)))
|
||||
all-extensions (map extensions-of-stage stages)]
|
||||
(zipmap stages all-extensions)))
|
||||
|
||||
(defn pop-stage
|
||||
"Get aspects of next stage of thought execution.
|
||||
Returns a tuple of (#{extensions},
|
||||
a copy of `thought` with its first extension-stage removed)."
|
||||
Returns a tuple of (#{extensions}, though w/ (tail stages), :stage)"
|
||||
[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`.
|
||||
|
||||
@@ -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))
|
||||
|
||||
|
||||
Reference in New Issue
Block a user