New changes

This commit is contained in:
2026-01-24 16:32:03 +01:00
parent 31d0cc4d26
commit 335377587b
5 changed files with 52 additions and 21 deletions

View File

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

View File

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

View File

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

View File

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

View File

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