csys action handlers: always defined as closures; + some minor clean-ups and rearrangements
This commit is contained in:
parent
6facc4f22e
commit
42195f0cef
3 changed files with 27 additions and 28 deletions
|
|
@ -53,8 +53,9 @@
|
|||
(let* ((domain (car categ))
|
||||
(addr (list domain (cadr categ) name))
|
||||
(msg (message:create (list domain :create) :data (list :addr addr)))
|
||||
(scope (scope prg env :categ categ)))
|
||||
(create msg scope)))
|
||||
(scope (scope prg env :categ categ))
|
||||
(zero (neuron scope)))
|
||||
(notify-created msg zero scope)))
|
||||
|
||||
;;;; neurons (= async tasks) and synapses (= connections)
|
||||
|
||||
|
|
@ -73,7 +74,7 @@
|
|||
(defun process (scope)
|
||||
(lambda (msg) (funcall (proc scope) msg scope)))
|
||||
|
||||
(defun std-proc (msg scope &key (default #'remember) params actions)
|
||||
(defun std-proc (msg scope &key (default (remember)) actions params)
|
||||
(util:mv-bind (nmsg (nscope scope))
|
||||
(handle-action msg scope :default default :actions actions :params params)
|
||||
(when nmsg (forward nmsg (syns nscope)))
|
||||
|
|
@ -86,24 +87,17 @@
|
|||
(when nmsg (notify nmsg nscope))
|
||||
(update nscope)))
|
||||
|
||||
(defun create (msg scope)
|
||||
(let ((new (neuron (apply #'reset-scope scope (shape:data msg)))))
|
||||
(notify-created msg new scope)))
|
||||
|
||||
(defun do-log (msg scope)
|
||||
(util:lgi msg))
|
||||
|
||||
(defun notify (msg scope)
|
||||
(actor:send (environ scope) msg))
|
||||
(defun handle-action (msg scope &key (default (no-op)) actions params)
|
||||
(let* ((key (message:action msg))
|
||||
(act (getf actions key (getf actions :default default))))
|
||||
(apply act msg scope params)))
|
||||
|
||||
(defun forward (msg syns)
|
||||
(dolist (s syns)
|
||||
(funcall s msg)))
|
||||
|
||||
(defun handle-action (msg scope &key (default (no-op)) actions params)
|
||||
(let* ((key (message:action msg))
|
||||
(act (getf actions key (getf actions :default default))))
|
||||
(apply act msg scope params)))
|
||||
(defun notify (msg scope)
|
||||
(actor:send (environ scope) msg))
|
||||
|
||||
(defun notify-created (msg new scope)
|
||||
(let* ((head (list (message:domain msg) :created))
|
||||
|
|
@ -111,12 +105,18 @@
|
|||
(msg1 (message:create head :data data)))
|
||||
(notify msg1 scope)))
|
||||
|
||||
;;;; predefined neuron actions
|
||||
;;;; action handlers
|
||||
|
||||
(defun no-op (&key stop)
|
||||
(defun no-op (&key no-forward)
|
||||
(lambda (msg scope)
|
||||
(unless stop msg)))
|
||||
(unless no-forward msg)))
|
||||
|
||||
(defun remember (msg scope)
|
||||
(defun remember ()
|
||||
(lambda (msg scope)
|
||||
(setf (value scope) (shape:data-value msg :value))
|
||||
(values msg scope))
|
||||
(values msg scope)))
|
||||
|
||||
(defun create ()
|
||||
(lambda (msg scope)
|
||||
(let ((new (neuron (apply #'reset-scope scope (shape:data msg)))))
|
||||
(notify-created msg new scope))))
|
||||
|
|
|
|||
|
|
@ -21,14 +21,14 @@
|
|||
(let ((prg (csys:make-program proc)))
|
||||
(csys:neuron (csys:scope prg meta-env :cls 'scope :categ '(:env :c00)))))
|
||||
|
||||
;;;; action handlers, public callables
|
||||
;;;; action handlers
|
||||
|
||||
(defun actions ()
|
||||
(list :created #'cell-created
|
||||
:notify (csys:no-op)
|
||||
:effect (csys:no-op)
|
||||
:value #'forward
|
||||
:default (csys:no-op :stop t)))
|
||||
:default (csys:no-op :no-forward t)))
|
||||
|
||||
(defun cell-created (msg scope)
|
||||
(let* ((data (shape:data msg))
|
||||
|
|
|
|||
|
|
@ -31,8 +31,7 @@
|
|||
(config:add :test-receiver :setup #'tc:setup)
|
||||
;(config:add-action '(:csys :effect :c00 "0-0") (value-in '(1)))
|
||||
(config:add-action '(:csys :effect) #'tc:check-message)
|
||||
(config:add-action '(:csys) (constantly nil))
|
||||
)
|
||||
(config:add-action '(:csys) (constantly nil)))
|
||||
|
||||
(defun proc-env (msg scope)
|
||||
(let ((t:*test-suite* (csys:environ scope)))
|
||||
|
|
@ -60,12 +59,12 @@
|
|||
(let* ((recv (core:find-service :test-receiver))
|
||||
(env (environ:create #'proc-env t:*test-suite*)))
|
||||
(setf (tc:receiver t:*test-suite*) recv)
|
||||
;(csys:create-zero (test-program) env)
|
||||
(csys:create-zero prg env)
|
||||
env))
|
||||
|
||||
(deftest test-basic-0 ()
|
||||
(let ((env (setup-test (csys:make-program #'csys:eff-proc)))
|
||||
;(env (setup-test (test-program))
|
||||
(rcvr (tc:receiver t:*test-suite*)))
|
||||
(sleep 0.1)
|
||||
(tc:expect rcvr (message:create '(:csys :effect :c00 "0-0") :data '(:value 1)))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue