diff --git a/csys/csys.lisp b/csys/csys.lisp index 0e1ce30..339ce00 100644 --- a/csys/csys.lisp +++ b/csys/csys.lisp @@ -9,12 +9,12 @@ (:util :scopes/util) (:alx :alexandria)) (:export #:scope #:environ - #:make-program - #:neuron #:std-proc #:eff-proc #:create-zero - #:handle-action - #:notify - #:basic-actions #:no-op #:value-add #:create - #:multiply)) + #:make-program #:create-zero + #:neuron #:std-proc #:eff-proc + #:handle-action #:forward #:notify + #:basic-actions #:no-op #:value-add #:create #:connect + #:multiply + #:send-connect)) (in-package :scopes/csys) @@ -83,7 +83,11 @@ (defun update (scope) (actor:become (process scope))) - + +(defun process (scope) + (lambda (msg) + (funcall (proc scope) msg scope))) + (defun synapse (rcvr &optional op) (lambda (msg) (let ((nmsg (if op (funcall op msg) msg))) @@ -92,10 +96,6 @@ ;;;; message handlers, proc steps -(defun process (scope) - (lambda (msg) - (funcall (proc scope) msg scope))) - (defun std-proc (&key (default (remember)) actions) (lambda (msg scope) (util:mv-bind (nmsg (nscope scope)) @@ -123,12 +123,6 @@ (defun notify (msg scope) (actor:send (environ scope) msg)) - -(defun notify-created (msg new scope) - (let* ((head (list (message:domain msg) :created)) - (data (util:plist-merge (shape:data msg) `(:new ,new :parent ,actor:*self*))) - (msg1 (message:create head :data data))) - (notify msg1 scope))) ;;;; action handlers @@ -166,8 +160,8 @@ (new (neuron (apply #'reset-scope scope data)))) (notify-created msg new scope) (case (getf data :connect) - (:succ (send-connect actor:*self* new msg)) - (:pred (send-connect new actor:*self* msg))) + (:succ (send-connect-msg actor:*self* new msg)) + (:pred (send-connect-msg new actor:*self* msg))) nil))) (defun connect () @@ -185,14 +179,26 @@ (setf (getf data :value) (* (getf data :value 0) n)) (message:create (shape:head msg) :data data)))) -;;;; helpers +;;;; public shortcuts +(defun send-connect (rcvr target &key op (domain :csys)) + (actor:send rcvr + (message:create (list domain :connect) + :data (list :target target :op op)))) + +;;;; internal helpers + (defun new-msg-head (msg scope) (list (message:domain msg) (message:action msg) (cadr (categ scope)))) + +(defun notify-created (msg new scope) + (let* ((head (list (message:domain msg) :created)) + (data (util:plist-merge (shape:data msg) `(:new ,new :parent ,actor:*self*))) + (msg1 (message:create head :data data))) + (notify msg1 scope))) -(defun send-connect (rcvr target msg) +(defun send-connect-msg (rcvr target msg) (let ((data (shape:data msg))) - (actor:send rcvr - (message:create (list (message:domain msg) :connect) - :data (list :target target - :op (getf data :op)))))) + (send-connect rcvr target + :domain (message:domain msg) + :op (getf data :op)))) diff --git a/csys/environ.lisp b/csys/environ.lisp index 1bc916e..3640f5b 100644 --- a/csys/environ.lisp +++ b/csys/environ.lisp @@ -58,7 +58,7 @@ (index:put idx key cell)))) (defun find-cells (reg addr) - (destructuring-bind (dom cat key) addr + (destructuring-bind (dom cat &optional (key "")) addr (let ((idx (gethash (list dom cat) reg))) (when idx (index:query idx key))))) diff --git a/test/test-csys.lisp b/test/test-csys.lisp index e7609f9..8667717 100644 --- a/test/test-csys.lisp +++ b/test/test-csys.lisp @@ -83,9 +83,9 @@ (message:create cr :data '(:categ (:csys :e01) :connect :succ))) (actor:send self (message:create cr :data '(:addr (:csys :s01 "0-1") :connect :pred))) - (actor:send self - (message:create conn :data (list :target self :op (csys:multiply -1)))) - ;; connect *self* :op (multiply -1) + (csys:send-connect self self :op (csys:multiply -1)) + ;(actor:send self + ; (message:create conn :data (list :target self :op (csys:multiply -1)))) ;; switch :active nil)))