diff --git a/core/actor.lisp b/core/actor.lisp index 3069130..6ce553a 100644 --- a/core/actor.lisp +++ b/core/actor.lisp @@ -60,7 +60,10 @@ (defun ac-step (tsk bhv msg) (let ((*self* tsk)) (handler-case (funcall bhv msg) - (error (error) (util:lg :error "behavior" msg error))))) + (error (err) + ;(util:lg :error "behavior" msg err) + (invoke-debugger err)) + ))) ;;;; the core (classical, i.e. Hewitt) actor API diff --git a/csys/csys.lisp b/csys/csys.lisp index 33f613a..54135e4 100644 --- a/csys/csys.lisp +++ b/csys/csys.lisp @@ -10,13 +10,33 @@ (:shape :scopes/shape) (:util :scopes/util) (:alx :alexandria)) - (:export #:send #:*sensors* #:neuron - #:nprint)) + (:export #:environment #:*environment* #:actions #:set-action + #:send #:send-message #:*sensors* + #:neuron #:synapse + #:logger)) (in-package :scopes/csys) +;;;; environment: common information, with list of generally available actions + +(defclass environment () + ((actions :reader actions :initarg :actions :initform (make-hash-table)))) + +(defvar *environment* (make-instance 'environment)) + +(defun action (env key) + (gethash key (actions env))) + +(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 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)) @@ -36,13 +56,29 @@ (setf (gethash key *sensors*) tsks)) (util:lgw "no action selected" msg)))))) -;;;; neurons (= behavior generators) +;;;; neurons (= behavior generators) and synapses (connection generators) -(defun neuron (proc &optional state syns env) - (lambda (msg) (funcall proc msg state syns env))) +(defun neuron (proc &optional state syns (env *environment*)) + (lambda (msg) + (funcall proc msg state syns env))) -;;;; predefined neuron processors +(defun synapse (rcvr &optional (op #'identity)) + (lambda (msg) + (actor:send rcvr (funcall op msg)))) -(defun nprint (msg state syns env) +;;;; predefined neuron processors and helper / utility funtions + +(defun logger (msg state syns env) (util:lgi msg state) - (actor:become (neuron #'nprint (shape:data msg) syns env))) + (destructuring-bind (msg state syns) (handle-action msg state syns env) + (forward msg syns) + (actor:become (neuron #'logger (shape:data msg) syns env)))) + +(defun forward (msg syns) + (dolist (s syns) + (funcall s msg))) + +(defun handle-action (msg state syns env) + (let ((act (action env (shape:head-value msg :action)))) + (or (and act (funcall act msg state syns env)) + (list msg state syns)))) diff --git a/test/etc/config-csys.lisp b/test/etc/config-csys.lisp index 70de0e1..429520f 100644 --- a/test/etc/config-csys.lisp +++ b/test/etc/config-csys.lisp @@ -4,8 +4,7 @@ (config:root) -(config:add-action '(:csys :sensor :log) - (csys:neuron #'csys:nprint :testing)) +(config:add-action '(:csys :sensor :log) (csys:neuron #'csys:logger :testing)) (config:add :logger :class 'logging:config :loglevel (config:from-env :loglevel :info) diff --git a/test/test-csys.lisp b/test/test-csys.lisp index bae8ac2..4869855 100644 --- a/test/test-csys.lisp +++ b/test/test-csys.lisp @@ -33,9 +33,9 @@ (deftest test-nodispatch () (core:setup-services) - (csys:send (message:create '(:csys :add :log :s1) :data 1)) - (csys:send (message:create '(:csys :add :log :s1) :data 3)) - (csys:send (message:create '(:csys :sub :log :s2) :data 4)) - (csys:send (message:create '(:csys :add :log :s2) :data 5)) + (csys:send-message '(:csys :add :log :s1) 1) + (csys:send-message '(:csys :add :log :s1) 3) + (csys:send-message '(:csys :sub :log :s2) 4) + (csys:send-message '(:csys :add :log :s2) 5) (sleep 0.1) )