code cleanup

src/cljs/emptyhead/contract/eval.cljs

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

src/cljs/emptyhead/idea/memtag.cljs

@@ -1,12 +1,5 @@
 (ns emptyhead.idea.memtag
-  (:require [emptyhead.idea.property :as prop]
+  (:require [emptyhead.idea.protocol :as prtc]))
-            [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)])

src/cljs/emptyhead/idea/state.cljs

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

src/cljs/emptyhead/lib/io/print.cljs

@@ -1,15 +1,9 @@
 (ns emptyhead.lib.io.print
   "Basic printing thoughts."
   (:require [emptyhead.thought.define :as def]
-            [emptyhead.idea.protocol :as prtc]
+            [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]
+  (fn [_ parent]
     (-> parent prtc/value :return last println)
     [parent nil]))
-

src/cljs/emptyhead/test/fixtures.cljs

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

src/cljs/emptyhead/test/idea/crud.cljs

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

src/cljs/emptyhead/test/idea/property.cljs

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

src/cljs/emptyhead/test/idea/protocol.cljs

@@ -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 {})))))

src/cljs/emptyhead/test/main.cljs

@@ -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\..*"))

src/cljs/emptyhead/test/utils.cljs

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

src/cljs/emptyhead/thought/crud.cljs

@@ -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]]
+                    ext-stages [[:PRE-EXECUTE] [:EXECUTE] [:POST-EXECUTE]]}}]
-                    transient true}}]
   (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!
+  (idea/have-idea!
-     :prefix (str "emptyhead.thought#" (magic/symbolize-ns operator))
+   :prefix (str "emptyhead.thought#" (magic/symbolize-ns operator))
-     :properties [magic/thought-ns]
+   :properties [magic/thought-ns]
-     :data (make-thought operator args)))
+   :data (make-thought operator args)))
-
-(defn contract
-  "Get the extension contract of a `thought`.
-  Returns the contract."
-  [thought]
-  (prtc/val-fn :ext-contract thought))
 
 (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))

src/cljs/emptyhead/thought/define.cljs

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

src/cljs/emptyhead/thought/eval.cljs

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

src/cljs/emptyhead/thought/extend.cljs

@@ -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 stages)]
-        aspects (map
-                 #(->> % get-extensions (filter filter-fn))
-                 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) %)
+        aspects (get-extensions (first stages))
-                        (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?

src/cljs/emptyhead/thought/return.cljs

@@ -1,7 +1,6 @@
 (ns emptyhead.thought.return
   "Utilities for handling thoughts' return values to their parents."
-  (:require [emptyhead.thought.crud :as thought]
+  (:require [emptyhead.idea.protocol :as prtc]))
-            [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))

src/cljs/emptyhead/util/logging.cljs

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

src/cljs/emptyhead/util/magic.cljs

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

src/cljs/miim/core/init.cljs

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

src/cljs/miim/graphics/pixi.cljs

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