code cleanup

This commit is contained in:
2025-08-06 21:02:44 +02:00
parent 8040c7f7a6
commit d278185ff3
19 changed files with 21 additions and 226 deletions

View File

@@ -1,7 +0,0 @@
(ns emptyhead.contract.eval
"Implements contract evaluation on ideas."
(:require [emptyhead.idea.protocol :as prtc]))
;; TODO stub
(defn evaluate [contract idea]
true)

View File

@@ -1,12 +1,5 @@
(ns emptyhead.idea.memtag
(:require [emptyhead.idea.property :as prop]
[emptyhead.idea.protocol :as prtc]))
(defn add-group! [idea & group]
(let [group (or group
[:emptyhead :memtag :group (keyword (gensym "memtag#group$"))])]
(prop/register-property! idea group)
group))
(:require [emptyhead.idea.protocol :as prtc]))
(defn uid-of [idea]
[:emptyhead :memtag :uid (prtc/ref-fn keyword idea)])

View File

@@ -2,12 +2,7 @@
"Implements the state object.")
(def empty-state
{:_properties {}
:_descriptions
{:_properties "Property-to-idea mapping."
:property {}
:property_fns {}}})
{:_properties {}})
(defonce state
(atom empty-state))

View File

@@ -1,15 +1,9 @@
(ns emptyhead.lib.io.print
"Basic printing thoughts."
(:require [emptyhead.thought.define :as def]
[emptyhead.idea.protocol :as prtc]
[emptyhead.thought.crud :as thought]
[emptyhead.thought.eval :as eval]
[emptyhead.thought.extend :as extend]
[emptyhead.idea.property :as prop]
[emptyhead.idea.memtag :as memtag]))
[emptyhead.idea.protocol :as prtc]))
(def/define! [:emptyhead :io :print]
(fn [thought parent]
(fn [_ parent]
(-> parent prtc/value :return last println)
[parent nil]))

View File

@@ -1,13 +0,0 @@
(ns emptyhead.test.fixtures
(:require [cljs.test :as t :include-macros true]
[emptyhead.idea.state :as s]))
(defn temporary-state [tests]
(let [orig-state (swap! s/state identity)]
(s/reset-state!)
(tests)
(reset! s/state orig-state)))
(defn pre-reset [tests]
(s/reset-state!)
(tests))

View File

@@ -1,30 +0,0 @@
(ns emptyhead.test.idea.crud
(:require [cljs.test :as t :include-macros true]
[emptyhead.idea.crud :as crud]
[emptyhead.idea.state :as s :refer [state]]
[emptyhead.idea.protocol :as prtc]
[emptyhead.test.fixtures :as fx]))
(t/use-fixtures :once fx/temporary-state)
(t/use-fixtures :each fx/pre-reset)
(t/deftest have-idea!
(t/testing "Idea creation"
(let [idea (crud/have-idea!)]
(t/is (get @state idea)))))
(t/deftest idea-updating
(t/testing "Idea updating"
(let [idea (crud/have-idea!)]
(crud/extend-idea! idea {:foo :bar})
(t/is (= :bar (prtc/val-fn :foo idea)))
(crud/swap-idea! idea {:baz :quux})
(t/is (not (prtc/val-fn :foo idea)))
(t/is (= :quux (prtc/val-fn :baz idea)))
)))
(t/deftest forget!
(t/testing "Idea deletion"
(let [idea (crud/have-idea!)]
(crud/forget-idea! idea)
(t/is (= nil (get @state idea))))))

View File

@@ -1,25 +0,0 @@
(ns emptyhead.test.idea.property
(:require [cljs.test :as t :include-macros true]
[emptyhead.idea.crud :as crud]
[emptyhead.idea.property :as prop]
[emptyhead.test.fixtures :as fx]))
(t/use-fixtures :once fx/temporary-state)
(t/use-fixtures :each fx/pre-reset)
(t/deftest properties
(t/testing "Property addition and removal"
(let [idea (crud/have-idea!)]
(prop/register-property! idea [:a :b :c] [:a :d :e])
(t/is (= #{[:a :b :c] [:a :d :e] [:a] [:a :b] [:a :d]}
(prop/properties idea)))
(t/is (prop/has-property? idea [:a :b]))
(t/is (not (prop/has-property? idea [:invalid])))
(t/is (contains? (prop/with-property [:a :d]) idea))
(t/is (not (contains? (prop/with-property [:invalid]) idea)))
(prop/remove-property! idea [:a :b])
(t/is (not (prop/has-property? idea [:a :b :c]))))))

View File

@@ -1,22 +0,0 @@
(ns emptyhead.test.idea.protocol
(:require [cljs.test :as t :include-macros true]
[emptyhead.idea.crud :as crud]
[emptyhead.idea.protocol :as prtc]
[emptyhead.test.utils :refer [expect-error]]
[emptyhead.test.fixtures :as fx]))
(t/use-fixtures :once fx/temporary-state)
(t/use-fixtures :each fx/pre-reset)
(t/deftest protocol
(t/testing "Value/reference semantics"
(let [idea (crud/have-idea!)]
;; Repeatedly going between value and reference shouldn't mangle idea
(t/is (= idea (-> idea prtc/value prtc/reference)))
(t/is (= (prtc/value idea) (-> idea prtc/reference prtc/value)))
;; Attempting to get a reference to a copy should be an error
(expect-error :stale-reference #(prtc/reference (prtc/copy idea)))
;; Attempting to get a reference to an invalid idea should be an error
(expect-error :invalid-reference #(prtc/reference {})))))

View File

@@ -1,8 +0,0 @@
(ns emptyhead.test.main
(:require [cljs.test :as t :include-macros true]
[emptyhead.test.idea.crud]
[emptyhead.test.idea.property]
[emptyhead.test.idea.protocol]))
(defn run []
(t/run-all-tests #"emptyhead\.test\..*"))

View File

@@ -1,10 +0,0 @@
(ns emptyhead.test.utils
(:require [cljs.test :as t :include-macros true]))
(defn expect-error [type fun]
(t/is
(= type
(try (fun)
nil
(catch :default e
(-> e ex-data :data first :type))))))

View File

@@ -3,18 +3,14 @@
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.idea.property :as prop]
[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]
[operator & {:keys [data ext-contract ext-stages]
:or {data {} ext-contract {}
ext-stages [[:PRE-EXECUTE] [:EXECUTE] [:POST-EXECUTE]]
transient true}}]
ext-stages [[:PRE-EXECUTE] [:EXECUTE] [:POST-EXECUTE]]}}]
(hash-map :operator operator
:data data
:ext-contract ext-contract
@@ -25,18 +21,12 @@
(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 group]
[operator & {:keys [data ext-stages]
:as args}]
(idea/have-idea!
:prefix (str "emptyhead.thought#" (magic/symbolize-ns operator))
:properties [magic/thought-ns]
:data (make-thought operator args)))
(defn contract
"Get the extension contract of a `thought`.
Returns the contract."
[thought]
(prtc/val-fn :ext-contract thought))
(idea/have-idea!
:prefix (str "emptyhead.thought#" (magic/symbolize-ns operator))
:properties [magic/thought-ns]
:data (make-thought operator args)))
(defn stages
"Get the extension stages of a `thought`.
@@ -63,8 +53,6 @@
[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))

View File

@@ -1,7 +1,6 @@
(ns emptyhead.thought.define
"Utilities for defining new thoughts."
(:require [emptyhead.thought.crud :as thought]
[emptyhead.thought.eval :as eval]
[emptyhead.idea.crud :as idea]
[emptyhead.util.magic :as magic]
[emptyhead.idea.memtag :as memtag]
@@ -32,11 +31,10 @@
(merge defaults
(thought/make-thought operator)
{:data (thought/data thought)}
(constr-fn thought parent)
)))])))))
(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))

View File

@@ -6,7 +6,6 @@
[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]]
@@ -17,8 +16,6 @@
{:thought thought :parent parent :type :unimplemented-thought})
((prtc/copy-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!
@@ -26,7 +23,6 @@
Returns (potentially modified) `parent`."
[thought & [parent]]
;; 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))
@@ -38,7 +34,7 @@
;; If it's time for `thought`'s implementation to run, do so,
;; potentially modifying `parent`.
[parent & returns]
(if (= '() (thought/stages th)) ;; NOTE the magic value is now [:EXECUTE] since otherwise nothing could be bound to the global [:emptyhead] propspace
(if (= '() (thought/stages th))
(impl! th parent)
[parent nil])

View File

@@ -37,26 +37,19 @@
Returns a map of {stage => #{thought}}."
[thought]
(let [stages (thought/stages thought)
filter-fn #(contract/evaluate (thought/contract thought) %)
aspects (map
#(->> % get-extensions (filter filter-fn))
stages)]
aspects (map get-extensions stages)]
(zipmap stages aspects)))
(defn pop-stage
"Get aspects of next stage of thought execution.
Returns a tuple of (#{extension-dhammas},
Returns a tuple of (#{extensions},
a copy of `thought` with its first extension-stage removed)."
[thought]
(let [stages (thought/stages thought)
aspects (filter #(contract/evaluate (thought/contract thought) %)
(get-extensions (first stages)))
aspects (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)]
thought)]
(list aspects modified)))
(defn has-stage?

View File

@@ -1,7 +1,6 @@
(ns emptyhead.thought.return
"Utilities for handling thoughts' return values to their parents."
(:require [emptyhead.thought.crud :as thought]
[emptyhead.idea.protocol :as prtc]))
(:require [emptyhead.idea.protocol :as prtc]))
(defn with-return [thought data]
(if (first data)
@@ -10,7 +9,7 @@
thought))
(defn return-vals [thought namespace]
(prtc/copy-fn #(get-in % [:return namespace]) thought))
(prtc/val-fn #(get-in % [:return namespace]) thought))
(defn clear-returns [thought]
(prtc/copy-fn #(assoc % :return {}) thought))
(prtc/val-fn #(assoc % :return {}) thought))

View File

@@ -1,10 +0,0 @@
(ns emptyhead.util.logging)
(defn error [message & data]
(throw (ex-info message {:data data})))
(defn warn [message & data]
(error message data))
(defn message [message & data]
(println message {:data data}))

View File

@@ -9,10 +9,5 @@
(defn thought-impl-prop [operator]
(conj thought-impl-ns operator))
(def extension-ns (conj thought-ns :extends))
(defn extension-prop [stage]
(conj extension-ns stage))
(defn symbolize-ns [ns]
(str/join "." (map name ns)))

View File

@@ -1 +0,0 @@
(ns miim.core.init)

View File

@@ -1,30 +0,0 @@
(ns miim.graphics.pixi
(:require ["pixi.js" :as PIXI]
[emptyhead.lib.io.print]
[emptyhead.thought.crud :as thought]
[emptyhead.thought.eval :as eval]
[emptyhead.idea.protocol :as prtc]
[emptyhead.thought.define :as def]))
(def/define!
[:miim :graphics :make-screen]
(fn [thought parent]
(let [[parent args] (thought/pop-stack parent)
app (PIXI/Application.)]
(println args)
(-> (.init app (clj->js args))
(.then (fn [] (.appendChild js/document.body (.-canvas app)))))
[parent app])))
(def populate
(thought/register-thought!
[:emptyhead :core :pure]
:data {:height 256 :width 256 :background "29028F"}))
(def combined
(let [operations [populate (thought/register-thought! [:miim :graphics :make-screen])]
pure (eval/execute! (thought/register-thought! [:emptyhead :core :pure] :data operations))
meme (eval/execute! (thought/make-thought [:emptyhead :core :sequence])
pure
)]
(-> meme thought/pop-stack last)))