csys: provide a standard neuron processor with delegation to action handlers
This commit is contained in:
parent
f3491a5aa3
commit
abdd00f1ad
3 changed files with 24 additions and 15 deletions
|
|
@ -13,11 +13,11 @@
|
||||||
(:export #:environment #:*environment* #:actions #:set-action
|
(:export #:environment #:*environment* #:actions #:set-action
|
||||||
#:send #:send-message #:*sensors*
|
#:send #:send-message #:*sensors*
|
||||||
#:neuron #:synapse
|
#:neuron #:synapse
|
||||||
#:logger))
|
#:std-proc))
|
||||||
|
|
||||||
(in-package :scopes/csys)
|
(in-package :scopes/csys)
|
||||||
|
|
||||||
;;;; environment: common information, with list of generally available actions
|
;;;; environment: common information, with list of globally available actions
|
||||||
|
|
||||||
(defclass environment ()
|
(defclass environment ()
|
||||||
((actions :reader actions :initarg :actions :initform (make-hash-table))))
|
((actions :reader actions :initarg :actions :initform (make-hash-table))))
|
||||||
|
|
@ -69,17 +69,24 @@
|
||||||
|
|
||||||
;;;; predefined neuron processors and helper / utility funtions
|
;;;; predefined neuron processors and helper / utility funtions
|
||||||
|
|
||||||
(defun logger (msg state syns env)
|
(defun std-proc (msg state syns env)
|
||||||
(util:lgi msg state)
|
(util:lgi msg state)
|
||||||
(destructuring-bind (msg state syns) (handle-action msg state syns env)
|
(destructuring-bind (nmsg nst syns)
|
||||||
(forward msg syns)
|
(handle-action msg state syns env :default #'remember)
|
||||||
(actor:become (neuron #'logger (shape:data msg) syns env))))
|
(forward nmsg syns)
|
||||||
|
(actor:become (neuron #'std-proc nst syns env))))
|
||||||
|
|
||||||
(defun forward (msg syns)
|
(defun forward (msg syns)
|
||||||
(dolist (s syns)
|
(dolist (s syns)
|
||||||
(funcall s msg)))
|
(funcall s msg)))
|
||||||
|
|
||||||
(defun handle-action (msg state syns env)
|
(defun handle-action (msg state syns env &key default)
|
||||||
(let ((act (action env (shape:head-value msg :action))))
|
(let ((act (or (action env (shape:head-value msg :action)) default)))
|
||||||
(or (and act (funcall act msg state syns env))
|
(or (and act (funcall act msg state syns env))
|
||||||
(list msg state syns))))
|
(list msg state syns))))
|
||||||
|
|
||||||
|
;;;; predefined neuron actions
|
||||||
|
|
||||||
|
(defun remember (msg state syns env)
|
||||||
|
(list msg (shape:data msg) syns))
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -4,8 +4,8 @@
|
||||||
|
|
||||||
(config:root)
|
(config:root)
|
||||||
|
|
||||||
(config:add-action '(:csys :sensor :log)
|
(config:add-action '(:csys :sensor :std)
|
||||||
(csys:neuron #'csys:logger :testing
|
(csys:neuron #'csys:std-proc 0
|
||||||
(list (csys:synapse *probe*))
|
(list (csys:synapse *probe*))
|
||||||
))
|
))
|
||||||
|
|
||||||
|
|
@ -14,4 +14,3 @@
|
||||||
:logfile (t:test-path "scopes-test.log" "log")
|
:logfile (t:test-path "scopes-test.log" "log")
|
||||||
:console nil)
|
:console nil)
|
||||||
|
|
||||||
|
|
||||||
|
|
|
||||||
|
|
@ -30,6 +30,9 @@
|
||||||
|
|
||||||
(defvar *probe* nil)
|
(defvar *probe* nil)
|
||||||
|
|
||||||
|
(defun add (msg state syns env)
|
||||||
|
(list msg (+ (shape:data msg) state) syns env))
|
||||||
|
|
||||||
;;;; test runner
|
;;;; test runner
|
||||||
|
|
||||||
(defun run ()
|
(defun run ()
|
||||||
|
|
@ -49,8 +52,8 @@
|
||||||
(t:show-result))))
|
(t:show-result))))
|
||||||
|
|
||||||
(deftest test-basic ()
|
(deftest test-basic ()
|
||||||
(csys:send-message '(:csys :add :log :s1) 1)
|
(csys:send-message '(:csys :add :std :s1) 1)
|
||||||
(csys:send-message '(:csys :add :log :s1) 3)
|
(csys:send-message '(:csys :add :std :s1) 3)
|
||||||
(csys:send-message '(:csys :sub :log :s2) 4)
|
(csys:send-message '(:csys :sub :std :s2) 4)
|
||||||
(csys:send-message '(:csys :add :log :s2) 5)
|
(csys:send-message '(:csys :add :std :s2) 5)
|
||||||
)
|
)
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue