From 859ebfc2eec17e722a1a58b52328e67fc4622c7f Mon Sep 17 00:00:00 2001 From: apt-get Date: Tue, 19 Aug 2025 22:53:18 +0200 Subject: [PATCH] more cleanups --- src/cljs/emptyhead/thought/eval.cljs | 12 ++++-------- src/cljs/emptyhead/thought/extend.cljs | 17 ++++++++--------- src/cljs/emptyhead/thought/return.cljs | 7 +++++-- 3 files changed, 17 insertions(+), 19 deletions(-) diff --git a/src/cljs/emptyhead/thought/eval.cljs b/src/cljs/emptyhead/thought/eval.cljs index 009f8ec..8cabd65 100644 --- a/src/cljs/emptyhead/thought/eval.cljs +++ b/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]] - - (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) diff --git a/src/cljs/emptyhead/thought/extend.cljs b/src/cljs/emptyhead/thought/extend.cljs index 4935a83..3bc6db0 100644 --- a/src/cljs/emptyhead/thought/extend.cljs +++ b/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 +(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`. diff --git a/src/cljs/emptyhead/thought/return.cljs b/src/cljs/emptyhead/thought/return.cljs index cd90415..e666311 100644 --- a/src/cljs/emptyhead/thought/return.cljs +++ b/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))