more cleanups & docs

org/apt-notes.org

@@ -0,0 +1,19 @@
+#+title: Apt Notes
+* ideas
+** state
+state is a global hashmap.
+top keys are references, which uniquely identify an idea.
+top values are the content of the ideas.
+** fields
+ideas have stuff in _meta field
+notably [:_meta :_properties] and [:meta :_reference]
+there is also _parent.
+*** TODO _parent and _meta need getters
+** uid-of
+uses property system to deref ideas
+should be used rather than prtc/value
+
+* properties
+** in state
+state has a top-level _property key
+below that is a hierarchical map of the different property keys (like :foo into :bar into :baz) that finally has a :_node key, which is a set of all idea references for that property

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,7 @@
 (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]
+(defn uid-of
-  (let [group (or group
+  "Returns the property containing the idea's reference."
-                  [:emptyhead :memtag :group (keyword (gensym "memtag#group$"))])]
+  [idea]
-    (prop/register-property! idea group)
-    group))
-
-(defn uid-of [idea]
   [:emptyhead :memtag :uid (prtc/ref-fn keyword idea)])

src/cljs/emptyhead/idea/property.cljs

@@ -33,10 +33,12 @@
         iref (prtc/reference idea)]
     (when property
       (reduce
-       (fn [acc property]
+       ; iterate over each segment in the property. e.g. for [:foo :bar :baz] => first foo, then bar, then baz
-         (swap! state/state update-in (conj acc property :_node) (fnil conj #{}) iref)
+       ; acc grows iteratively into (conj [:_properties] property) by the end
-         (swap! state/state update-in [iref :_meta :_properties] (fnil conj #{}) (conj (vec (rest acc)) property))
+       (fn [acc property-segment]
-         (conj acc property))
+         (swap! state/state update-in (conj acc property-segment :_node) (fnil conj #{}) iref)
+         (swap! state/state update-in [iref :_meta :_properties] (fnil conj #{}) (conj (vec (rest acc)) property-segment))
+         (conj acc property-segment))
        [:_properties] property))
     (when tail
       (run! #(register-property! idea %) tail))

src/cljs/emptyhead/idea/protocol.cljs

@@ -44,7 +44,7 @@
   [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

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/core.cljs

@@ -13,7 +13,7 @@
 
 (def/define! [:emptyhead :core :get-data]
   (fn [thought parent]
-    [parent (prtc/val-fn :data parent)]))
+    [parent (thought/data parent)]))
 
 (def/define! [:emptyhead :core :return]
   (fn [thought parent]

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/repl/core.cljs

@@ -5,7 +5,6 @@
             [emptyhead.idea.property :as prop]
             [emptyhead.util.magic :as magic]
             [emptyhead.idea.protocol :as prtc]
-            [emptyhead.idea.crud :as idea]
             [emptyhead.idea.memtag :as memtag]
             [emptyhead.thought.define :as def]
             [emptyhead.thought.crud :as thought]
@@ -71,8 +70,7 @@
   (clear-context)
   (run! #(eval! % context) (apply read input))
   (pprint-tos context)
-  (prtc/reference (teval/execute! context 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:
@@ -82,13 +80,12 @@
 (def/define! [:emptyhead :debug :track]
   (fn [thought parent]
     (let [ctx (:_parent (prtc/value parent))]
-      (print "RUNNING " (:operator (prtc/value parent)) " ON ")
+      (print "RUNNING " (thought/operator parent) " ON ")
       (print "CONTEXT " ctx " WITH \n")
       (print "STACK: ")
       (print (:return ctx))
       (print "\n\n")
-      [parent nil]
+      [parent nil])))
-      )))
 
 (def sample (thought/register-thought! [:foo]))
 
@@ -115,7 +112,7 @@
 
 (defn deref-name
   [self name]
-  (or (and (= (prtc/val-fn :operator self) [:emptyhead :core :context])
+  (or (and (= (thought/operator self) [:emptyhead :core :context])
            (resolve-name self name))
       (and (prtc/val-fn :_parent self)
            (deref-name (prtc/val-fn :_parent self) name))))
@@ -182,5 +179,4 @@
 
     [:meme]
     emptyhead.core.deref-name
-    emptyhead.core.execute
+    emptyhead.core.execute))
-    ))

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,40 +3,28 @@
   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-stages]
-               :or {data {} ext-contract {}
+               :or {data {}
-                    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
             :ext-stages ext-stages
-            :return []
+            :return []))
-            :transient nil))
 
 (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 +51,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,13 +1,12 @@
 (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]
             [emptyhead.idea.protocol :as prtc]))
 
-(defn register-implementation!
+(defn- register-implementation!
   [operator impl]
   (let [impl-prop (magic/thought-impl-prop operator)]
     (idea/have-idea! :prefix (str "impl_thought#" (magic/symbolize-ns operator))
@@ -15,7 +14,8 @@
                      :shadowing [impl-prop]
                      :data {:implementation impl})))
 
-(defn register-constructor!
+; TODO add documentation / elaborate on this whole constr-fn stuff
+(defn- register-constructor!
   [operator & {:keys [constr-fn defaults]
                :or {constr-fn (fn [thought parent] {})
                     defaults {}}}]
@@ -32,11 +32,12 @@
             (merge defaults
                    (thought/make-thought operator)
                    {:data (thought/data thought)}
-                    (constr-fn thought parent)
+                   (constr-fn thought parent))))])))))
-                   )))])))))
 
 (defn define!
+  "Define a new kind of thought, with its operator name and implementation.
+   TODO explain what constr-fn and defaults does"
   [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

@@ -1,6 +1,5 @@
 (ns emptyhead.thought.extend
-  (:require [emptyhead.contract.eval :as contract]
+  (:require [emptyhead.idea.property :as prop]
-            [emptyhead.idea.property :as prop]
             [emptyhead.idea.protocol :as prtc]
             [emptyhead.thought.crud :as thought]
             [emptyhead.util.magic :as magic]
@@ -37,26 +36,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/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)))