From 335377587b47972d23fd8cfdec1ddafa575e4c5a Mon Sep 17 00:00:00 2001 From: Akko Date: Sat, 24 Jan 2026 16:32:03 +0100 Subject: [PATCH] New changes --- src/cljs/emptyhead/newlib/delegate.cljs | 9 ++-- .../emptyhead/newlib/math/arithmetic.cljs | 49 +++++++++++++------ src/cljs/emptyhead/newlib/scratch.cljs | 4 +- src/cljs/emptyhead/newlib/util.cljs | 7 +++ src/cljs/emptyhead/thought/crud.cljs | 4 +- 5 files changed, 52 insertions(+), 21 deletions(-) create mode 100644 src/cljs/emptyhead/newlib/util.cljs diff --git a/src/cljs/emptyhead/newlib/delegate.cljs b/src/cljs/emptyhead/newlib/delegate.cljs index f64f741..32f73dd 100644 --- a/src/cljs/emptyhead/newlib/delegate.cljs +++ b/src/cljs/emptyhead/newlib/delegate.cljs @@ -14,6 +14,7 @@ (eval/execute! remover))) ;; 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 +32,8 @@ (defn get-delegates "Get possible delegates for `msg`." [msg] - (let [stage [:EH :MSG :DELEGATE msg]] - (-> (thought/register-thought! [:EH :CORE :CONTAINER] :ext-stages [stage]) - eval/execute! thought/pop-stack second))) + (let [stage [:EH :MSG :DELEGATE msg] + dels (-> (thought/register-thought! [:EH :CORE :CONTAINER] :ext-stages [stage]) + eval/execute! thought/pop-stack second)] + (mapcat #(cons % (get-delegates %)) dels) + )) diff --git a/src/cljs/emptyhead/newlib/math/arithmetic.cljs b/src/cljs/emptyhead/newlib/math/arithmetic.cljs index cd4a793..e9a673d 100644 --- a/src/cljs/emptyhead/newlib/math/arithmetic.cljs +++ b/src/cljs/emptyhead/newlib/math/arithmetic.cljs @@ -2,28 +2,47 @@ "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 :PRIM :PARTIAL :+] :transient false :data to)] - (msg/register-impl pointer [:EH :PRIM :NUM] th) - [parent pointer]))) + th (thought/register-thought! [:EH :IO :RETURN] + :data to + :reference (str "<" to "+_>"))] + (del/add-delegate th [[:EH :PRIM :PARTIAL :+]]) + (extend/register-extension! th [th]) + [parent th]))) -;; Final addition, e.g. =(5 +) 5=. Returns a thunk. -(def/define! [:EH :PRIM :PARTIAL :+] +;; 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) - pointer (-> (str "LAZY<" from "+" to">.") gensym keyword) - lazy (thought/register-thought! [:EH :PRIM :LAZY :+] :transient true :data [from to])] - (msg/register-impl pointer [:EH :PRIM :REIFY] lazy) - [parent pointer]))) + [_ to] (thought/pop-stack (eval/execute! (:to (thought/data parent)) parent)) + th (thought/register-thought! [:EH :IO :RETURN] + :data [to from] + :reference (str "<" to "+" from ">"))] + (del/add-delegate th [[:EH :LAZY [:EH :PRIM :NUM]]]) + (extend/register-extension! th [th]) + [parent th]))) -(def/define! [:EH :PRIM :LAZY :+] +(def/define! [:EH :LAZY [:EH :PRIM :NUM] :REIFY] (fn [thought parent] - (let [[from to] (thought/data thought)] - [parent (+ from to)]))) + (let [[_ [to from]] (thought/pop-stack (eval/execute! (:to (thought/data parent)) parent)) + 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]) diff --git a/src/cljs/emptyhead/newlib/scratch.cljs b/src/cljs/emptyhead/newlib/scratch.cljs index 3fe2065..8b3d8b9 100644 --- a/src/cljs/emptyhead/newlib/scratch.cljs +++ b/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]]) diff --git a/src/cljs/emptyhead/newlib/util.cljs b/src/cljs/emptyhead/newlib/util.cljs new file mode 100644 index 0000000..df06ab8 --- /dev/null +++ b/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)) diff --git a/src/cljs/emptyhead/thought/crud.cljs b/src/cljs/emptyhead/thought/crud.cljs index a64ccc0..a81eff7 100644 --- a/src/cljs/emptyhead/thought/crud.cljs +++ b/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)))