akko/nothoughts
1
0
Fork 0
Code Issues 8 Pull Requests Projects Releases Wiki Activity

sdfsdfs

Browse Source
This commit is contained in:
Akko
2025-08-04 18:57:35 +02:00
parent be5d5350f4
commit 25b94b8d85
15 changed files with 380 additions and 45 deletions
Download Patch File Download Diff File Expand all files Collapse all files

30
src/cljs/emptyhead/thought/crud.cljs
View File

@@ -7,27 +7,30 @@
[emptyhead.contract.eval :as contract]
[emptyhead.util.magic :as magic]))
;; TODO groups
(defn make-thought
"Helper function to make thought object.
You may want `register-thought!` instead."
[operator & {:keys [data ext-contract ext-stages transient]
:or {data {} ext-contract {}
ext-stages [[:thought operator]]
ext-stages [[:thought operator :pre] [:thought operator]
[:PRE-EXECUTE] [:EXECUTE] [:POST-EXECUTE]
[:thought operator :post]]
transient true}}]
(hash-map :operator operator
:data data
:ext-contract ext-contract
:ext-stages ext-stages
:return {}
:return []
:transient (not (false? transient))))
(defn register-thought!
"Create a thought and register it in the state.
Returns a reference to the created thought."
[operator & {:keys [data ext-contract ext-stages transient]
[operator & {:keys [data ext-contract ext-stages transient group]
:as args}]
(idea/have-idea!
:prefix (str "thought_" (magic/symbolize-ns operator) "_")
:prefix (str "emptyhead.thought#" (magic/symbolize-ns operator))
:properties [magic/thought-ns]
:data (make-thought operator args)))
@@ -48,3 +51,22 @@
Returns the operator keyword."
[thought]
(prtc/val-fn :operator thought))
(defn data
"Get the data field of a `thought`."
[thought]
(prtc/val-fn :data thought))
(defn stack
[thought]
(prtc/val-fn :return thought))
(defn pop-stack
[thought]
[(assoc thought :return (-> thought prtc/copy stack butlast vec)) (-> thought prtc/copy stack peek)])
(def root-thought (make-thought :root))
(defn add-ext-stage!
[thought stage]
(idea/mutate-idea! #(update % :ext-stages conj stage) thought))

32
src/cljs/emptyhead/thought/define.cljs
View File

@@ -3,30 +3,40 @@
(:require [emptyhead.thought.crud :as thought]
[emptyhead.thought.eval :as eval]
[emptyhead.idea.crud :as idea]
[emptyhead.util.magic :as magic]))
[emptyhead.util.magic :as magic]
[emptyhead.idea.memtag :as memtag]
[emptyhead.idea.protocol :as prtc]))
(defn register-implementation!
[operator impl]
(idea/have-idea! :prefix (str "impl_thought#" (magic/symbolize-ns operator))
:properties [(magic/thought-impl-prop operator)]
:data {:implementation impl}))
(let [impl-prop (magic/thought-impl-prop operator)]
(idea/have-idea! :prefix (str "impl_thought#" (magic/symbolize-ns operator))
:properties [impl-prop]
:shadowing [impl-prop]
:data {:implementation impl})))
(defn register-constructor!
[operator & {:keys [constr-fn defaults]
:or {constr-fn identity
:or {constr-fn (fn [thought parent] {})
defaults {}}}]
(let [constr-op (conj operator :construct)]
(register-implementation!
constr-op
(fn [thought & [parent]]
[parent
(thought/register-thought!
operator
(merge defaults {:operator operator}
(constr-fn (merge parent thought))))]))))
(let [thought (prtc/value thought)
parent (prtc/value parent)]
[parent
(memtag/uid-of
(thought/register-thought!
operator
(merge defaults
(thought/make-thought operator)
{:data (thought/data thought)}
(constr-fn thought parent)
)))])))))
(defn define!
[operator impl & {:keys [constr-fn defaults]
:as constr-args}]
(register-implementation! operator impl)
(register-constructor! operator constr-args))
(register-constructor! operator constr-args) )

26
src/cljs/emptyhead/thought/eval.cljs
View File

@@ -17,29 +17,37 @@
{:thought thought :parent parent :type :unimplemented-thought})
((prtc/copy-fn :implementation impl-idea) thought parent))))
(def root-thought (thought/make-thought :root))
;; at what point do returns get cleared?
;; 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/copy thought)
parent (or parent root-thought)]
(let [cur (first (thought/stages thought))
;; FIXME parent may change mid execution, breaking deep inspection
(loop [th (assoc (prtc/value thought) :_parent (prtc/value parent))
parent parent]
(let [cur (first (thought/stages th))
[extensions th] (extend/pop-stage th)
;; Execute extensions, potentially modifying th
th (reduce #(execute! %2 %1) th extensions)
;; If it's time for `thought`'s implementation to run, do so,
;; potentially modifying `parent`.
[parent return]
(if (= cur [:thought (thought/operator th)])
[parent & returns]
(if (= cur [:EXECUTE]) ;; NOTE the magic value is now [:EXECUTE] since otherwise nothing could be bound to the global [:emptyhead] propspace
(impl! th parent)
parent)
[parent nil])
;; Fold return value into `parent`.
parent (return/with-return parent (thought/operator th) return)]
parent (return/with-return parent returns)]
; XXX FUCK IT WE BALL (??)
(prtc/uncopy! parent)
(prtc/uncopy! thought)
;; Recur if there's remaining aspects, otherwise return `parent`.
(if (not-empty (thought/stages th))

9
src/cljs/emptyhead/thought/extend.cljs
View File

@@ -6,7 +6,7 @@
[emptyhead.util.magic :as magic]
[clojure.set :refer [union]]))
(defn register-extension
(defn register-extension!
"Register `thought` as extension for one or more `stages`."
[thought & stages]
(doseq [stage stages]
@@ -20,7 +20,7 @@
(prop/remove-property! thought (magic/extension-prop stage)))
thought)
(defn- get-extensions
(defn get-extensions
"Get extensions for `stage`;
e.g. for `stage` of [:foo :bar :baz], get extensions for [:foo :bar :baz], [:foo :bar], [:foo]"
[stage]
@@ -31,6 +31,7 @@
(recur (butlast property-segment)
(union acc (prop/with-property (magic/extension-prop property-segment)))))))
;; XXX contains references to scrapped "contract" subsys
(defn extensions
"Get extensions of `thought`.
Returns a map of {stage => #{thought}}."
@@ -50,6 +51,10 @@
(let [stages (thought/stages thought)
aspects (filter #(contract/evaluate (thought/contract thought) %)
(get-extensions (first stages)))
;; FIXME idk why this was here, but it's wrong--
;; I've commented it out now, probably breaks something elsewhere!
;; aspects (prop/with-property (magic/extension-prop (first stages)))
modified (prtc/copy-fn #(assoc % :ext-stages (rest stages))
thought)]
(list aspects modified)))

8
src/cljs/emptyhead/thought/return.cljs
View File

@@ -3,10 +3,10 @@
(:require [emptyhead.thought.crud :as thought]
[emptyhead.idea.protocol :as prtc]))
(defn with-return [thought namespace data]
(if data
(prtc/copy-fn
#(update-in % [:return namespace] (fnil conj []) data) thought)
(defn with-return [thought data]
(if (first data)
(prtc/val-fn
#(update % :return (fnil into []) data) thought)
thought))
(defn return-vals [thought namespace]