akko/nothoughts
1
0
Fork 0
Code Issues 7 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

13
src/cljs/emptyhead/idea/crud.cljs
View File

@@ -3,7 +3,9 @@
The 'R' in 'CRUD' is implemented by [[emptyhead.idea.protocol/value]]."
(:require [emptyhead.idea.state :refer [state]]
[emptyhead.idea.property :as prop]
[emptyhead.idea.protocol :as prtc]))
[emptyhead.idea.protocol :as prtc]
[emptyhead.idea.memtag :as memtag]
[clojure.set :as set]))
(defn- register-idea!
"Helper function to scaffold an 'empty' idea."
@@ -48,11 +50,14 @@
"Instantiate up to `count` new ideas, optionally prefixing reference symbol with `prefix`.
Additionally allows you to immediately attach `properties` and `data`.
Returns a single idea or a list of ideas depending on whether `count` was given."
[& {:keys [prefix count properties data]
:or {count 1 prefix "idea" properties []}}]
[& {:keys [prefix count properties data shadowing]
:or {count 1 prefix "idea" properties [] shadowing []}}]
(let [fun #(register-idea! (gensym (str prefix "$")))
ideas (take count (repeatedly fun))]
ideas (take count (repeatedly fun))
shadowing (apply set/union (map prop/with-property shadowing))]
(run! forget-idea! shadowing)
(run! #(apply prop/register-property! % properties) ideas)
(run! #(prop/register-property! % (memtag/uid-of %)) ideas)
(when data (run! #(extend-idea! % data) ideas))
(if (= count 1)
(first ideas)

12
src/cljs/emptyhead/idea/memtag.cljs Normal file
View File

@@ -0,0 +1,12 @@
(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))
(defn uid-of [idea]
[:emptyhead :memtag :uid (prtc/ref-fn keyword idea)])

9
src/cljs/emptyhead/idea/protocol.cljs
View File

@@ -9,8 +9,10 @@
(let [ref (get-in val [:_meta :_reference])]
(cond
(get-in val [:_meta :_stale-reference])
(do
(println "fucky wucky " val)
(log/error (str "Attempt to find stale reference `" ref "` -- this is a copy.")
{:value val :type :stale-reference})
{:value val :type :stale-reference}))
(not (symbol? ref))
(log/error (str "Attempt to find invalid reference `" ref "` -- invalid idea?")
@@ -42,14 +44,15 @@
[idea]
(assoc-in (value idea) [:_meta :_stale-reference] true))
(defn- non-copy [idea] (assoc-in (value idea) [:_meta :_stale-reference] false))
(defn non-copy [idea] (assoc-in (value idea) [:_meta :_stale-reference] false))
(defn uncopy!
"Takes a copied idea and 'uncopies' it, making its reference active again
and updating what is in the game state."
[copy-obj]
(let [idea (non-copy copy-obj)]
(swap! state assoc (to-reference idea) idea)))
(swap! state assoc (reference idea) idea)
(reference idea)))
(defn force-reference
"Get the (now stale!) reference of a copied idea."

15
src/cljs/emptyhead/lib/compose.cljs Normal file
View File

@@ -0,0 +1,15 @@
(ns emptyhead.lib.compose
(:require [emptyhead.idea.memtag :as memtag]
[emptyhead.thought.extend :as extend]
[emptyhead.thought.crud :as thought]
[emptyhead.thought.define :as def]))
;; Append `(:data thought)` as execution child of `parent`.
(def/define! [:emptyhead :compose :append]
(fn [thought parent]
(let [op (:data thought)
stage [:emptyhead :compose :append (memtag/uid-of parent) (memtag/uid-of op)]
op (extend/register-extension! op stage)
parent (thought/add-ext-stage! parent stage)]
[parent nil])))

18
src/cljs/emptyhead/lib/context.cljs Normal file
View File

@@ -0,0 +1,18 @@
(ns emptyhead.lib.context
(:require [emptyhead.idea.memtag :as memtag]
[emptyhead.thought.define :as def]
[emptyhead.thought.crud :as thought]
[emptyhead.idea.protocol :as prtc]))
(def/define! [:emptyhead :core :context]
(fn [thought parent]
[parent nil])
:constr-fn
(fn [thought parent]
{:data {:parent (memtag/uid-of parent)}}))
(defn new-context [& name]
(let [ctx (thought/register-thought! [:emptyhead :core :context])]
(-> ctx prtc/copy
(assoc-in [:data :parent] (memtag/uid-of ctx))
prtc/uncopy!)))

92
src/cljs/emptyhead/lib/core.cljs
View File

@@ -1,6 +1,92 @@
(ns emptyhead.lib.core
"Core components of the stdlib."
(:require [emptyhead.thought.crud :as thought]))
(:require [emptyhead.thought.crud :as thought]
[emptyhead.thought.define :as def]
[emptyhead.idea.protocol :as prtc]
[emptyhead.idea.property :as prop]
[emptyhead.thought.eval :as eval]
[emptyhead.idea.memtag :as memtag]
[emptyhead.thought.extend :as extend]
[emptyhead.lib.io.print]
[emptyhead.lib.context]
[emptyhead.lib.compose]))
(def/define! [:emptyhead :core :get-data]
(fn [thought parent]
[parent (prtc/val-fn :data parent)]))
(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})))
(def/define! [:emptyhead :core :nop]
(fn [thought parent]
[parent nil]))
(def/define! [:emptyhead :core :add-ext-stage]
(fn [thought parent]
(let [[down stage] (thought/pop-stack parent)
[_ op] (thought/pop-stack down)
exe (prop/just-property op)]
(thought/add-ext-stage! exe stage)
[parent nil])))
(def/define! [:emptyhead :core :add-prop]
(fn [thought parent]
(let [[down prop] (thought/pop-stack parent)
[_ op] (thought/pop-stack down)
exe (prop/just-property op)]
(prop/register-property! exe prop)
[parent nil])))
(def/define! [:emptyhead :core :just-prop]
(fn [thought parent]
(let [[_ prop] (thought/pop-stack parent)]
[parent (memtag/uid-of (prop/just-property prop))])))
(def/define! [:emptyhead :core :swap-stack]
(fn [thought parent]
(let [[parent first] (thought/pop-stack parent)
[parent second] (thought/pop-stack parent)]
[parent first second])))
(def/define! [:emptyhead :core :gobble]
(fn [thought parent]
(let [[parent top] (thought/pop-stack parent)
[parent next] (if (sequential? top) (thought/pop-stack parent) [parent nil])
out (if (sequential? top) top (list top))
out (if next (cons next out) out)]
[parent out])))
(def/define! [:emptyhead :core :execute]
(fn [thought parent]
(let [[parent top] (thought/pop-stack parent)
exe (prop/just-property top)]
[(eval/execute! exe parent) top])))
(def/define! [:emptyhead :describe :print-stack]
(fn [thought parent]
(run! println (reverse (thought/stack parent)))
[parent nil]))
(def/define! [:emptyhead :core :clear-stack]
(fn [thought parent]
[(assoc parent :return []) nil]))
(def/define! [:emptyhead :core :extend]
(fn [thought parent]
(let [[down stage] (thought/pop-stack parent)
[_ op] (thought/pop-stack down)
exe (prop/just-property op)]
(extend/register-extension! exe stage)
[parent nil])))
(def/define! [:emptyhead :core :pop]
(fn [thought parent]
(let [[parent _] (thought/pop-stack parent)]
[parent nil])))
(defn data [data]
(thought/make-thought :emptyhead.core.data :data data))

16
src/cljs/emptyhead/lib/io/print.cljs
View File

@@ -1,7 +1,15 @@
(ns emptyhead.lib.io.print
"Basic printing thoughts."
(:require [emptyhead.thought.define :as def]))
(: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]))
(def/define! [:emptyhead :io :print]
(fn [thought parent]
(-> parent prtc/value :return last println)
[parent nil]))
; should this be [:emptyhead :io :print :print]? should internal and external namespaces match?
(def/define! "emptyhead.io.print"
(fn [arg] (print arg)))

112
src/cljs/emptyhead/repl/core.cljs Normal file
View File

@@ -0,0 +1,112 @@
(ns emptyhead.repl.core
(:require [clojure.string :as str]
[emptyhead.thought.extend :as extend]
[emptyhead.thought.eval :as teval]
[emptyhead.idea.property :as prop]
[emptyhead.idea.protocol :as prtc]
[emptyhead.idea.memtag :as memtag]
[emptyhead.thought.define :as def]
[emptyhead.thought.crud :as thought]
[emptyhead.lib.core]
[emptyhead.lib.context :as ctx]))
(defonce context (ctx/new-context))
(defn clear-context [] (set! context (ctx/new-context)))
(defn undot-operator [dotted-sym]
(mapv keyword (str/split (name dotted-sym) #"\.")))
(defn eval! [thought & [parent]]
(set! context (teval/execute! thought parent)))
(defn parse-command [cmd]
(cond
(= cmd '.BEGIN) (thought/register-thought! [:emptyhead :repl :begin-block])
(= cmd '.END) (thought/register-thought! [:emptyhead :repl :end-block])
(symbol? cmd) (thought/register-thought!
[:emptyhead :compose :append]
:data (thought/register-thought! (undot-operator cmd)))
:else (thought/register-thought!
[:emptyhead :compose :append]
:data (thought/register-thought! [:emptyhead :core :return] :data cmd))))
(def/define! [:emptyhead :repl :begin-block]
(fn [thought parent]
(let [ctx-creator (thought/register-thought! [:emptyhead :core :context :construct])
;; Create a new context with `parent` as parent.
[parent ctx] (->> parent (teval/execute! ctx-creator) thought/pop-stack)
ctx (prop/just-property ctx)
;; Make `parent` put the new context on its stack during its execution flow
;; TODO refactor
parent (teval/execute! (thought/register-thought!
[:emptyhead :compose :append]
:data (thought/register-thought! [:emptyhead :core :return]
:data (memtag/uid-of ctx)))
parent)]
;; NOTE `ctx` becomes the new `parent`!
[ctx
ctx])))
(def/define! [:emptyhead :repl :end-block]
;; Exiting context, so its parent becomes the new parent.
(fn [thought parent]
(let [parent-ctx (-> parent prtc/value :data :parent prop/just-property)]
[parent-ctx (memtag/uid-of parent)])))
(defn read [& input]
(map parse-command input))
(defn pprint-tos [thought]
(let [printer #(println (str "EMPTYHEAD> " %))
tos (-> thought prtc/value :return last)]
(-> tos printer)
tos))
(defn run [& input]
(clear-context)
(run! #(eval! % context) (apply read input))
(pprint-tos context)
(prtc/reference (teval/execute! context context)))
;; XXX an annoying class of bug is eg forgetting the return value here, which yields just
;; >No protocol method Idea.value defined for type null:
;; In this case originationg from [[emptyhead.thought.eval/execute!]]
;; Widely catching these errors earlier would be wise since we don't have
;; a good stack trace for this stuff
(def/define! [:emptyhead :debug :track]
(fn [thought parent]
(let [ctx (:_parent (prtc/value parent))]
(print "RUNNING " (:operator (prtc/value parent)) " ON ")
(print "CONTEXT " (prtc/reference ctx) " WITH ")
(print "STACK: ")
(print (:return ctx))
(print "\n\n")
[parent nil]
)))
(def sample (thought/register-thought! [:foo]))
;; XXX This has to have no stages otherwise it will loop on itself ww
(defonce tracker (thought/register-thought! [:emptyhead :debug :track] :ext-stages [[:EXECUTE]]))
(defn enable-tracking []
(extend/register-extension! tracker [:PRE-EXECUTE]))
;; XXX accidentally registering one extension multiple times is a known footgun right now
;; and probably needs some feature to prevent this
;; (but mind that it shouldn't be *illegal*)
;; Another issue is just general... garbage collection, that's a big thing
(defn disable-tracking []
(map #(extend/remove-extension! % [:PRE-EXECUTE]) (extend/get-extensions [:PRE-EXECUTE])))
;; FIXME something is going wrong with the context management here
;; It would probably be good to name contexts somehow to keep easier track of them
(def tst
'(.BEGIN
"hello"
emptyhead.io.print
.END
))

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))

24
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]
(let [impl-prop (magic/thought-impl-prop operator)]
(idea/have-idea! :prefix (str "impl_thought#" (magic/symbolize-ns operator))
:properties [(magic/thought-impl-prop operator)]
:data {:implementation impl}))
: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]]
(let [thought (prtc/value thought)
parent (prtc/value parent)]
[parent
(memtag/uid-of
(thought/register-thought!
operator
(merge defaults {:operator operator}
(constr-fn (merge parent thought))))]))))
(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]

1
src/cljs/miim/core/init.cljs Normal file
View File

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

30
src/cljs/miim/graphics/pixi.cljs Normal file
View File

@@ -0,0 +1,30 @@
(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)))