diff --git a/src/cljs/emptyhead/idea/crud.cljs b/src/cljs/emptyhead/idea/crud.cljs index c35f6e4..b677c48 100644 --- a/src/cljs/emptyhead/idea/crud.cljs +++ b/src/cljs/emptyhead/idea/crud.cljs @@ -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) diff --git a/src/cljs/emptyhead/idea/memtag.cljs b/src/cljs/emptyhead/idea/memtag.cljs new file mode 100644 index 0000000..bdc56cf --- /dev/null +++ b/src/cljs/emptyhead/idea/memtag.cljs @@ -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)]) diff --git a/src/cljs/emptyhead/idea/protocol.cljs b/src/cljs/emptyhead/idea/protocol.cljs index 99cd50b..f51d6bb 100644 --- a/src/cljs/emptyhead/idea/protocol.cljs +++ b/src/cljs/emptyhead/idea/protocol.cljs @@ -9,8 +9,10 @@ (let [ref (get-in val [:_meta :_reference])] (cond (get-in val [:_meta :_stale-reference]) - (log/error (str "Attempt to find stale reference `" ref "` -- this is a copy.") - {:value val :type :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})) (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." diff --git a/src/cljs/emptyhead/lib/compose.cljs b/src/cljs/emptyhead/lib/compose.cljs new file mode 100644 index 0000000..bd1df2c --- /dev/null +++ b/src/cljs/emptyhead/lib/compose.cljs @@ -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]))) diff --git a/src/cljs/emptyhead/lib/context.cljs b/src/cljs/emptyhead/lib/context.cljs new file mode 100644 index 0000000..1e57a81 --- /dev/null +++ b/src/cljs/emptyhead/lib/context.cljs @@ -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!))) diff --git a/src/cljs/emptyhead/lib/core.cljs b/src/cljs/emptyhead/lib/core.cljs index 7330ca4..adb30e1 100644 --- a/src/cljs/emptyhead/lib/core.cljs +++ b/src/cljs/emptyhead/lib/core.cljs @@ -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)) diff --git a/src/cljs/emptyhead/lib/io/print.cljs b/src/cljs/emptyhead/lib/io/print.cljs index 7d752bb..01876e5 100644 --- a/src/cljs/emptyhead/lib/io/print.cljs +++ b/src/cljs/emptyhead/lib/io/print.cljs @@ -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))) diff --git a/src/cljs/emptyhead/repl/core.cljs b/src/cljs/emptyhead/repl/core.cljs new file mode 100644 index 0000000..a4514c7 --- /dev/null +++ b/src/cljs/emptyhead/repl/core.cljs @@ -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 + )) diff --git a/src/cljs/emptyhead/thought/crud.cljs b/src/cljs/emptyhead/thought/crud.cljs index 2221d21..418b93c 100644 --- a/src/cljs/emptyhead/thought/crud.cljs +++ b/src/cljs/emptyhead/thought/crud.cljs @@ -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)) diff --git a/src/cljs/emptyhead/thought/define.cljs b/src/cljs/emptyhead/thought/define.cljs index 91d3792..03df570 100644 --- a/src/cljs/emptyhead/thought/define.cljs +++ b/src/cljs/emptyhead/thought/define.cljs @@ -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) ) diff --git a/src/cljs/emptyhead/thought/eval.cljs b/src/cljs/emptyhead/thought/eval.cljs index 97d3baf..e9398f6 100644 --- a/src/cljs/emptyhead/thought/eval.cljs +++ b/src/cljs/emptyhead/thought/eval.cljs @@ -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)) diff --git a/src/cljs/emptyhead/thought/extend.cljs b/src/cljs/emptyhead/thought/extend.cljs index f4a4274..2becca8 100644 --- a/src/cljs/emptyhead/thought/extend.cljs +++ b/src/cljs/emptyhead/thought/extend.cljs @@ -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))) diff --git a/src/cljs/emptyhead/thought/return.cljs b/src/cljs/emptyhead/thought/return.cljs index 14cba81..7b98c4a 100644 --- a/src/cljs/emptyhead/thought/return.cljs +++ b/src/cljs/emptyhead/thought/return.cljs @@ -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] diff --git a/src/cljs/miim/core/init.cljs b/src/cljs/miim/core/init.cljs new file mode 100644 index 0000000..a610b9a --- /dev/null +++ b/src/cljs/miim/core/init.cljs @@ -0,0 +1 @@ +(ns miim.core.init) diff --git a/src/cljs/miim/graphics/pixi.cljs b/src/cljs/miim/graphics/pixi.cljs new file mode 100644 index 0000000..d922612 --- /dev/null +++ b/src/cljs/miim/graphics/pixi.cljs @@ -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)))