diff --git a/core/actor.lisp b/core/actor.lisp index f07077c..473c31f 100644 --- a/core/actor.lisp +++ b/core/actor.lisp @@ -5,7 +5,7 @@ (:local-nicknames (:async :scopes/util/async) (:shape :scopes/shape) (:util :scopes/util)) - (:export #:start #:stop #:create #:send #:become + (:export #:start #:stop #:create #:send #:become #:*self* #:customer-message #:message #:content #:customer #:set-content #:*logger* #:*root* #:echo #:inc #:lgi diff --git a/csys/csys.lisp b/csys/csys.lisp index 1070baa..409b170 100644 --- a/csys/csys.lisp +++ b/csys/csys.lisp @@ -11,7 +11,8 @@ (:util :scopes/util) (:alx :alexandria)) (:export #:environment #:*environment* #:actions #:set-action - #:send #:send-message #:*sensors* + #:init-zero + #:send #:send-message #:neuron #:synapse #:std-proc)) @@ -20,42 +21,39 @@ ;;;; environment: common information, with list of globally available actions (defclass environment () - ((actions :reader actions :initarg :actions :initform (make-hash-table)))) + ((actions :reader actions :initarg :actions :initform (make-hash-table)) + (sensors :reader sensors :initarg :sensors + :initform (make-hash-table :test #'equal)))) (defvar *environment* (make-instance 'environment)) -(defun action (env key) - (gethash key (actions env))) +(defun action (env key &optional default) + (gethash key (actions env) default)) (defun set-action (env key act) (setf (gethash key (actions env)) act)) ;;;; sensors: automatically created actors (neuron), addressable via message head -(defvar *sensors* (make-hash-table :test #'equal)) +(defun init-zero (probe) + (set-action *environment* :sensor #'create-sensor) + (let ((zero (actor:create (neuron #'std-proc 0 (list (synapse probe)))))) + (setf (gethash '(:init :zero) (sensors *environment*)) (list zero)))) (defun send-message (head data &key customer) (send (message:create head :data data :customer customer))) (defun send (msg) (if (eq (shape:head-value msg :domain) :csys) - (dolist (sn (find-create-sensors msg)) + (dolist (sn (find-sensors msg)) (actor:send sn msg)) (core:handle-message core:*root* msg))) -(defun find-create-sensors (msg) +(defun find-sensors (msg) (let* ((key (cddr (shape:head msg))) - (sns (gethash key *sensors*))) - ;(format t "~&~a ~a" key sns) + (sns (gethash key (sensors *environment*)))) (util:lgi key sns) - (or sns - (let* ((mx (message:create - (list :csys :sensor (shape:head-value msg :class)))) - (hdlrs (core:select mx (core:actions core:*root*)))) - (if hdlrs - (let ((tsks (mapcar #'actor:create hdlrs))) - (setf (gethash key *sensors*) tsks)) - (util:lgw "no action selected" msg)))))) + sns)) ;;;; neurons (= behavior factories) and synapses (connection factories) @@ -81,12 +79,24 @@ (funcall s msg))) (defun handle-action (msg state syns env &key default) - (let ((act (or (action env (shape:head-value msg :action)) default))) - (or (and act (funcall act msg state syns env)) - (list msg state syns)))) + (let* ((key (shape:head-value msg :action)) + (act (action env key default))) + (funcall act msg state syns env) + ;(or (and act (funcall act msg state syns env)) + ;(list msg state syns))) +)) ;;;; predefined neuron actions +(defun no-op (msg state syns env) + (list msg (shape:data msg) syns)) + (defun remember (msg state syns env) (list msg (shape:data msg) syns)) +(defun create-sensor (msg state syns env) + (let ((key (shape:data msg)) + (sensor (actor:create + (neuron #'std-proc 0 (list (synapse actor:*self*)))))) + (setf (gethash key (sensors env)) (list sensor)) + (list msg state syns))) diff --git a/test/etc/config-csys.lisp b/test/etc/config-csys.lisp index 2bcc90a..2777e60 100644 --- a/test/etc/config-csys.lisp +++ b/test/etc/config-csys.lisp @@ -4,11 +4,6 @@ (config:root) -(config:add-action '(:csys :sensor :std) - (csys:neuron #'csys:std-proc 0 - (list (csys:synapse *probe*)) - )) - (config:add :logger :class 'logging:config :loglevel (config:from-env :loglevel :info) :logfile (t:test-path "scopes-test.log" "log") diff --git a/test/test-csys.lisp b/test/test-csys.lisp index 4e68852..70be216 100644 --- a/test/test-csys.lisp +++ b/test/test-csys.lisp @@ -24,9 +24,11 @@ ((test-suite :reader test-suite :initarg :test-suite))) (defun probe (msg state syns env) - (let ((t:*test-suite* (test-suite env))) - (let ((state (in-seq (shape:data msg) state :remove t))) - (actor:become (csys:neuron #'probe state syns env))))) + (let ((t:*test-suite* (test-suite env)) + (val (shape:data msg))) + (unless (consp val) + (let ((nst (in-seq val state :remove t))) + (actor:become (csys:neuron #'probe nst syns env)))))) (defvar *probe* nil) @@ -38,20 +40,24 @@ (defun run () (async:init) (let* ((t:*test-suite* (make-instance 't:test-suite :name "csys")) - (csys:*sensors* (make-hash-table :test #'equal)) (csys:*environment* (make-instance 'test-env :test-suite t:*test-suite*)) (*probe* (actor:create - (csys:neuron #'probe '(1 3 4 5) nil csys:*environment*)))) + (csys:neuron #'probe '(1 3 4 5) + nil csys:*environment*)))) (load (t:test-path "config-csys" "etc")) (core:setup-services) (unwind-protect (progn - (test-basic)) + (test-init)) (sleep 0.1) (async:finish) (t:show-result)))) -(deftest test-basic () +(deftest test-init () + (csys:init-zero *probe*) + (csys:send-message '(:csys :sensor :init :zero) '(:std :s1)) + (csys:send-message '(:csys :sensor :init :zero) '(:std :s2)) + (sleep 0.1) (csys:send-message '(:csys :add :std :s1) 1) (csys:send-message '(:csys :add :std :s1) 3) (csys:send-message '(:csys :sub :std :s2) 4)