csys: start with just one :zero neuron that creates two sensors (:s1 and :s2)
This commit is contained in:
parent
abdd00f1ad
commit
78be34bfae
4 changed files with 44 additions and 33 deletions
|
|
@ -5,7 +5,7 @@
|
||||||
(:local-nicknames (:async :scopes/util/async)
|
(:local-nicknames (:async :scopes/util/async)
|
||||||
(:shape :scopes/shape)
|
(:shape :scopes/shape)
|
||||||
(:util :scopes/util))
|
(:util :scopes/util))
|
||||||
(:export #:start #:stop #:create #:send #:become
|
(:export #:start #:stop #:create #:send #:become #:*self*
|
||||||
#:customer-message #:message #:content #:customer #:set-content
|
#:customer-message #:message #:content #:customer #:set-content
|
||||||
#:*logger* #:*root*
|
#:*logger* #:*root*
|
||||||
#:echo #:inc #:lgi
|
#:echo #:inc #:lgi
|
||||||
|
|
|
||||||
|
|
@ -11,7 +11,8 @@
|
||||||
(:util :scopes/util)
|
(:util :scopes/util)
|
||||||
(:alx :alexandria))
|
(:alx :alexandria))
|
||||||
(:export #:environment #:*environment* #:actions #:set-action
|
(:export #:environment #:*environment* #:actions #:set-action
|
||||||
#:send #:send-message #:*sensors*
|
#:init-zero
|
||||||
|
#:send #:send-message
|
||||||
#:neuron #:synapse
|
#:neuron #:synapse
|
||||||
#:std-proc))
|
#:std-proc))
|
||||||
|
|
||||||
|
|
@ -20,42 +21,39 @@
|
||||||
;;;; environment: common information, with list of globally 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))
|
||||||
|
(sensors :reader sensors :initarg :sensors
|
||||||
|
:initform (make-hash-table :test #'equal))))
|
||||||
|
|
||||||
(defvar *environment* (make-instance 'environment))
|
(defvar *environment* (make-instance 'environment))
|
||||||
|
|
||||||
(defun action (env key)
|
(defun action (env key &optional default)
|
||||||
(gethash key (actions env)))
|
(gethash key (actions env) default))
|
||||||
|
|
||||||
(defun set-action (env key act)
|
(defun set-action (env key act)
|
||||||
(setf (gethash key (actions env)) act))
|
(setf (gethash key (actions env)) act))
|
||||||
|
|
||||||
;;;; sensors: automatically created actors (neuron), addressable via message head
|
;;;; 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)
|
(defun send-message (head data &key customer)
|
||||||
(send (message:create head :data data :customer customer)))
|
(send (message:create head :data data :customer customer)))
|
||||||
|
|
||||||
(defun send (msg)
|
(defun send (msg)
|
||||||
(if (eq (shape:head-value msg :domain) :csys)
|
(if (eq (shape:head-value msg :domain) :csys)
|
||||||
(dolist (sn (find-create-sensors msg))
|
(dolist (sn (find-sensors msg))
|
||||||
(actor:send sn msg))
|
(actor:send sn msg))
|
||||||
(core:handle-message core:*root* msg)))
|
(core:handle-message core:*root* msg)))
|
||||||
|
|
||||||
(defun find-create-sensors (msg)
|
(defun find-sensors (msg)
|
||||||
(let* ((key (cddr (shape:head msg)))
|
(let* ((key (cddr (shape:head msg)))
|
||||||
(sns (gethash key *sensors*)))
|
(sns (gethash key (sensors *environment*))))
|
||||||
;(format t "~&~a ~a" key sns)
|
|
||||||
(util:lgi key sns)
|
(util:lgi key sns)
|
||||||
(or sns
|
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))))))
|
|
||||||
|
|
||||||
;;;; neurons (= behavior factories) and synapses (connection factories)
|
;;;; neurons (= behavior factories) and synapses (connection factories)
|
||||||
|
|
||||||
|
|
@ -81,12 +79,24 @@
|
||||||
(funcall s msg)))
|
(funcall s msg)))
|
||||||
|
|
||||||
(defun handle-action (msg state syns env &key default)
|
(defun handle-action (msg state syns env &key default)
|
||||||
(let ((act (or (action env (shape:head-value msg :action)) default)))
|
(let* ((key (shape:head-value msg :action))
|
||||||
(or (and act (funcall act msg state syns env))
|
(act (action env key default)))
|
||||||
(list msg state syns))))
|
(funcall act msg state syns env)
|
||||||
|
;(or (and act (funcall act msg state syns env))
|
||||||
|
;(list msg state syns)))
|
||||||
|
))
|
||||||
|
|
||||||
;;;; predefined neuron actions
|
;;;; predefined neuron actions
|
||||||
|
|
||||||
|
(defun no-op (msg state syns env)
|
||||||
|
(list msg (shape:data msg) syns))
|
||||||
|
|
||||||
(defun remember (msg state syns env)
|
(defun remember (msg state syns env)
|
||||||
(list msg (shape:data msg) syns))
|
(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)))
|
||||||
|
|
|
||||||
|
|
@ -4,11 +4,6 @@
|
||||||
|
|
||||||
(config:root)
|
(config:root)
|
||||||
|
|
||||||
(config:add-action '(:csys :sensor :std)
|
|
||||||
(csys:neuron #'csys:std-proc 0
|
|
||||||
(list (csys:synapse *probe*))
|
|
||||||
))
|
|
||||||
|
|
||||||
(config:add :logger :class 'logging:config
|
(config:add :logger :class 'logging:config
|
||||||
:loglevel (config:from-env :loglevel :info)
|
:loglevel (config:from-env :loglevel :info)
|
||||||
:logfile (t:test-path "scopes-test.log" "log")
|
:logfile (t:test-path "scopes-test.log" "log")
|
||||||
|
|
|
||||||
|
|
@ -24,9 +24,11 @@
|
||||||
((test-suite :reader test-suite :initarg :test-suite)))
|
((test-suite :reader test-suite :initarg :test-suite)))
|
||||||
|
|
||||||
(defun probe (msg state syns env)
|
(defun probe (msg state syns env)
|
||||||
(let ((t:*test-suite* (test-suite env)))
|
(let ((t:*test-suite* (test-suite env))
|
||||||
(let ((state (in-seq (shape:data msg) state :remove t)))
|
(val (shape:data msg)))
|
||||||
(actor:become (csys:neuron #'probe state syns env)))))
|
(unless (consp val)
|
||||||
|
(let ((nst (in-seq val state :remove t)))
|
||||||
|
(actor:become (csys:neuron #'probe nst syns env))))))
|
||||||
|
|
||||||
(defvar *probe* nil)
|
(defvar *probe* nil)
|
||||||
|
|
||||||
|
|
@ -38,20 +40,24 @@
|
||||||
(defun run ()
|
(defun run ()
|
||||||
(async:init)
|
(async:init)
|
||||||
(let* ((t:*test-suite* (make-instance 't:test-suite :name "csys"))
|
(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*))
|
(csys:*environment* (make-instance 'test-env :test-suite t:*test-suite*))
|
||||||
(*probe* (actor:create
|
(*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"))
|
(load (t:test-path "config-csys" "etc"))
|
||||||
(core:setup-services)
|
(core:setup-services)
|
||||||
(unwind-protect
|
(unwind-protect
|
||||||
(progn
|
(progn
|
||||||
(test-basic))
|
(test-init))
|
||||||
(sleep 0.1)
|
(sleep 0.1)
|
||||||
(async:finish)
|
(async:finish)
|
||||||
(t:show-result))))
|
(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) 1)
|
||||||
(csys:send-message '(:csys :add :std :s1) 3)
|
(csys:send-message '(:csys :add :std :s1) 3)
|
||||||
(csys:send-message '(:csys :sub :std :s2) 4)
|
(csys:send-message '(:csys :sub :std :s2) 4)
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue