Fixed buge with get-delegates

This commit is contained in:
2026-01-25 17:12:19 +01:00
parent 335377587b
commit 48dbfef16e
3 changed files with 13 additions and 7 deletions

View File

@@ -13,6 +13,13 @@
(let [remover (thought/register-thought! [:EH :CORE :NOP] :ext-stages [[:EH :MSG :REMOVE-DELEGATE msg del]])] (let [remover (thought/register-thought! [:EH :CORE :NOP] :ext-stages [[:EH :MSG :REMOVE-DELEGATE msg del]])]
(eval/execute! remover))) (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 Delegate order is currently undefined! Give this a proper order.
;; FIXME needs to be called with a list as second arg?? ;; FIXME needs to be called with a list as second arg??
(defn add-delegate (defn add-delegate
@@ -34,6 +41,5 @@
[msg] [msg]
(let [stage [:EH :MSG :DELEGATE msg] (let [stage [:EH :MSG :DELEGATE msg]
dels (-> (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) (mapcat #(cons % (get-delegates %)) dels)))
))

View File

@@ -16,7 +16,7 @@
th (thought/register-thought! [:EH :IO :RETURN] th (thought/register-thought! [:EH :IO :RETURN]
:data to :data to
:reference (str "<" to "+_>"))] :reference (str "<" to "+_>"))]
(del/add-delegate th [[:EH :PRIM :PARTIAL :+]]) (del/add-delegate th [:EH :PRIM :PARTIAL :+])
(extend/register-extension! th [th]) (extend/register-extension! th [th])
[parent th]))) [parent th])))
@@ -28,7 +28,7 @@
th (thought/register-thought! [:EH :IO :RETURN] th (thought/register-thought! [:EH :IO :RETURN]
:data [to from] :data [to from]
:reference (str "<" to "+" from ">"))] :reference (str "<" to "+" from ">"))]
(del/add-delegate th [[:EH :LAZY [:EH :PRIM :NUM]]]) (del/add-delegate th [:EH :LAZY [:EH :PRIM :NUM]])
(extend/register-extension! th [th]) (extend/register-extension! th [th])
[parent th]))) [parent th])))
@@ -39,7 +39,7 @@
from (if (symbol? from) (msg/apply-msg to [:EH :REIFY]) from)] from (if (symbol? from) (msg/apply-msg to [:EH :REIFY]) from)]
[parent (+ to from)]))) [parent (+ to from)])))
(del/add-delegate [:EH :LAZY [:EH :PRIM :NUM]] [[:EH :PRIM :NUM]]) (del/add-delegate [:EH :LAZY [:EH :PRIM :NUM]] [:EH :PRIM :NUM])
(thought/register-singleton! [:EH :PRIM :PARTIAL :+ [: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]]) (msg/register-single-impl [:EH :PRIM :PARTIAL :+] [:EH :PRIM :NUM] [:EH :PRIM :PARTIAL :+ [:EH :PRIM :NUM]])

View File

@@ -8,4 +8,4 @@
[emptyhead.newlib.math.number])) [emptyhead.newlib.math.number]))
;; XXX why does the second arg need to be wrapped like this? ;; XXX why does the second arg need to be wrapped like this?
(del/add-delegate :! [[:EH :REIFY]]) (del/add-delegate :! [:EH :REIFY])