code cleanup
This commit is contained in:
@@ -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)
|
@@ -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)])
|
||||
|
@@ -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))
|
||||
|
@@ -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]))
|
||||
|
||||
|
@@ -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))
|
@@ -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))))))
|
@@ -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]))))))
|
@@ -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 {})))))
|
@@ -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\..*"))
|
@@ -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))))))
|
@@ -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))
|
||||
|
@@ -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))
|
||||
|
@@ -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])
|
||||
|
||||
|
@@ -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?
|
||||
|
@@ -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))
|
||||
|
@@ -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}))
|
@@ -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)))
|
||||
|
@@ -1 +0,0 @@
|
||||
(ns miim.core.init)
|
@@ -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)))
|
Reference in New Issue
Block a user