Merge branch 'master' of https://git.webbieweb.org/akko/nothoughts

src/cljs/emptyhead/newlib/core.cljs

@@ -9,7 +9,7 @@
   (fn [_thought parent]
     [parent nil]))
 
-;; Container: Used for chaining multiple operations. Returns intself rather than its parent!
+;; Container: Used for chaining multiple operations. Returns itself rather than its parent!
 (def/define! [:EH :CORE :CONTAINER]
   (fn  [thought _parent]
     [thought nil]))

src/cljs/emptyhead/newlib/delegate.cljs

@@ -13,7 +13,15 @@
   (let [remover (thought/register-thought! [:EH :CORE :NOP] :ext-stages [[:EH :MSG :REMOVE-DELEGATE msg del]])]
     (eval/execute! remover)))
 
+
+;; Forget idea stored in `thought`'s data. Used to make destructors.
+(def/define! [:EH :IDEA :FORGET]
+  (fn  [thought parent]
+    (idea/forget-idea! (thought/data thought))
+    [parent nil]))
+
 ;; FIXME Delegate order is currently undefined! Give this a proper order.
+;; FIXME needs to be called with a list as second arg??
 (defn add-delegate
   "Register `del` as a delegate for `msg`: implementations defined for `del` will now run trigger on `msg` as well.
   For instance, if message =(:foo :bar)= is defined and we =(add-delegate :quux :bar)= then =(:foo :quux)= will alias to =(:foo :bar)=.
@@ -31,6 +39,7 @@
 (defn get-delegates
   "Get possible delegates for `msg`."
   [msg]
-  (let [stage [:EH :MSG :DELEGATE msg]]
+  (let [stage [:EH :MSG :DELEGATE msg]
-    (-> (thought/register-thought! [:EH :CORE :CONTAINER] :ext-stages [stage])
+        dels (-> (thought/register-thought! [:EH :CORE :CONTAINER] :ext-stages [stage])
-        eval/execute! thought/pop-stack second)))
+                 eval/execute! thought/empty-stack second)]
+    (mapcat #(cons % (get-delegates %)) dels)))

src/cljs/emptyhead/newlib/math/arithmetic.cljs

@@ -2,28 +2,46 @@
   "Airthmetic operators."
   (:require [emptyhead.thought.define :as def]
             [emptyhead.thought.crud :as thought]
-            [emptyhead.newlib.message :as msg]))
+            [emptyhead.newlib.message :as msg]
+            [emptyhead.newlib.delegate :as del]
+            [emptyhead.thought.extend :as extend]
+            [emptyhead.thought.eval :as eval]
+            [emptyhead.newlib.util :as util]))
+;; TODO values are now consumed when used instantly, this will give issues once we have variables
 
 ;; Initial addition, e.g. =5 +=. Returns partially applied pointer.
 (def/define! [:EH :PRIM [:EH :PRIM :NUM] :+]
   (fn [thought parent]
     (let [to (:to (thought/data parent))
-          pointer (-> (str "PART<" to "+_>.") gensym keyword)
+          th (thought/register-thought! [:EH :IO :RETURN]
-          th (thought/register-thought! [:EH :PRIM :PARTIAL :+] :transient false :data to)]
+                                        :data to
-      (msg/register-impl pointer [:EH :PRIM :NUM] th)
+                                        :reference (str "<" to "+_>"))]
-      [parent pointer])))
 
-;; Final addition, e.g. =(5 +) 5=. Returns a thunk.
+      (del/add-delegate th [:EH :PRIM :PARTIAL :+])
-(def/define! [:EH :PRIM :PARTIAL :+]
+      [parent th])))
+
+;; Final addition, e.g. =(5 +) 5=.
+(def/define! [:EH :PRIM :PARTIAL :+ [:EH :PRIM :NUM]]
   (fn [thought parent]
     (let [from (:from (thought/data parent))
-          to (thought/data thought)
+          [_ to] (thought/pop-stack (eval/execute! (:to (thought/data parent)) parent))
-          pointer (-> (str "LAZY<" from "+" to">.") gensym keyword)
+          th (thought/register-thought! [:EH :IO :RETURN]
-          lazy (thought/register-thought! [:EH :PRIM :LAZY :+] :transient true :data [from to])]
+                                        :data [to from]
-      (msg/register-impl pointer [:EH :PRIM :REIFY] lazy)
+                                        :reference (str "<" to "+" from ">"))]
-      [parent pointer])))
+      (del/add-delegate th [:EH :LAZY [:EH :PRIM :NUM]])
+      [parent th])))
 
-(def/define! [:EH :PRIM :LAZY :+]
+(def/define! [:EH :LAZY [:EH :PRIM :NUM] :REIFY]
   (fn [thought parent]
-    (let [[from to] (thought/data thought)]
+    (let [[_ [to from]] (thought/pop-stack (eval/execute! (:to (thought/data parent)) parent))
-      [parent (+ from to)])))
+          to (if (symbol? to) (msg/apply-msg to [:EH :REIFY]) to)
+          from (if (symbol? from) (msg/apply-msg to [:EH :REIFY]) from)]
+      [parent (+ to from)])))
+
+(del/add-delegate [:EH :LAZY [:EH :PRIM :NUM]] [:EH :PRIM :NUM])
+
+(thought/register-singleton! [:EH :PRIM :PARTIAL :+ [:EH :PRIM :NUM]])
+(msg/register-single-impl [:EH :PRIM :PARTIAL :+] [:EH :PRIM :NUM] [:EH :PRIM :PARTIAL :+ [:EH :PRIM :NUM]])
+
+(thought/register-singleton! [:EH :LAZY [:EH :PRIM :NUM] :REIFY])
+(msg/register-single-impl [:EH :LAZY [:EH :PRIM :NUM]] [:EH :REIFY] [:EH :LAZY [:EH :PRIM :NUM] :REIFY])

src/cljs/emptyhead/newlib/message.cljs

@@ -22,8 +22,8 @@
 ;; TODO Proper warnings when intend impl does not exist
 (defn register-single-impl
   "Wrapper around register-impl for singleton operators."
-  [to from impl]
+  [to from impl-op]
-  (let [th (prtc/reference (thought/get-singleton impl))]
+  (let [th (prtc/reference (thought/get-singleton impl-op))]
     (register-impl to from th)))
 
 (defn apply-ext
@@ -48,7 +48,7 @@
      (second (thought/pop-stack (eval/execute! th)))))
 
 (defn multi-msg
-  "Apply multiple messages sequentially. =(:foo :bar :baz)= <-> =((:foo :bar) :baz)."
+  "Apply multiple messages sequentially. =(:foo :bar :baz)= <-> =((:foo :bar) :baz)=."
   [& msgs]
   (reduce apply-msg msgs))
 
@@ -76,8 +76,8 @@
 (def/define! [:EH :MSG :MATCH]
   (fn [_thought parent]
     (let [data (thought/data parent)
-          [to from] (map #(get-in data [:delegates %]) [(:to data) (:from data)])
+          [to-dels from-dels] (map #(get-in data [:delegates %]) [(:to data) (:from data)])
-          stages (for [a to b from] [:EH :IMPL a b])
+          stages (for [a to-dels b from-dels] [:EH :IMPL a b])
           parent (assoc parent :ext-stages (vec stages))]
       [parent nil])))
 

src/cljs/emptyhead/newlib/scratch.cljs

@@ -2,8 +2,10 @@
   "Scratch namespace for development."
   (:require [emptyhead.newlib.message :as msg]
             [emptyhead.newlib.delegate :as del]
+            [emptyhead.thought.crud :as thought]
+            [emptyhead.thought.eval :as eval]
             [emptyhead.newlib.math.arithmetic]
             [emptyhead.newlib.math.number]))
 
 ;; XXX why does the second arg need to be wrapped like this?
-(del/add-delegate :! [[:EH :PRIM :REIFY]])
+(del/add-delegate :! [:EH :REIFY])

src/cljs/emptyhead/newlib/util.cljs

@@ -0,0 +1,7 @@
+(ns emptyhead.newlib.util
+  (:require [emptyhead.thought.crud :as thought]
+            [emptyhead.thought.eval :as eval]))
+
+(defn get-stage-data [stage]
+  (-> (thought/register-thought! [:EH :CORE :CONTAINER] :ext-stages [stage])
+      eval/execute! thought/pop-stack second))

src/cljs/emptyhead/thought/crud.cljs

@@ -23,10 +23,10 @@
 (defn register-thought!
   "Create a thought and register it in the state.
   Returns a reference to the created thought."
-  [operator & {:keys [data ext-stages return transient]
+  [operator & {:keys [data ext-stages return transient reference]
                :as args}]
   (idea/have-idea!
-   :prefix (str "emptyhead.thought#" (magic/symbolize-ns operator))
+   :prefix (or reference (str "emptyhead.thought#" (magic/symbolize-ns operator)))
    :properties [magic/thought-ns
                 (magic/operator-property [operator])]
    :data (make-thought operator args)))