csys improvements: make-neuron, update-neuron, ...
This commit is contained in:
parent
78be34bfae
commit
8e66cd63ed
2 changed files with 21 additions and 22 deletions
|
|
@ -10,11 +10,11 @@
|
|||
(:shape :scopes/shape)
|
||||
(:util :scopes/util)
|
||||
(:alx :alexandria))
|
||||
(:export #:environment #:*environment* #:actions #:set-action
|
||||
#:init-zero
|
||||
(:export #:environment #:*environment*
|
||||
#:init
|
||||
#:send #:send-message
|
||||
#:neuron #:synapse
|
||||
#:std-proc))
|
||||
#:create-neuron #:update-neuron))
|
||||
|
||||
(in-package :scopes/csys)
|
||||
|
||||
|
|
@ -27,16 +27,10 @@
|
|||
|
||||
(defvar *environment* (make-instance 'environment))
|
||||
|
||||
(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
|
||||
|
||||
(defun init-zero (probe)
|
||||
(set-action *environment* :sensor #'create-sensor)
|
||||
(defun init (probe)
|
||||
(setf (gethash :sensor (actions *environment*)) #'create-sensor)
|
||||
(let ((zero (actor:create (neuron #'std-proc 0 (list (synapse probe))))))
|
||||
(setf (gethash '(:init :zero) (sensors *environment*)) (list zero))))
|
||||
|
||||
|
|
@ -52,7 +46,7 @@
|
|||
(defun find-sensors (msg)
|
||||
(let* ((key (cddr (shape:head msg)))
|
||||
(sns (gethash key (sensors *environment*))))
|
||||
(util:lgi key sns)
|
||||
;(util:lgi key sns)
|
||||
sns))
|
||||
|
||||
;;;; neurons (= behavior factories) and synapses (connection factories)
|
||||
|
|
@ -65,10 +59,17 @@
|
|||
(lambda (msg)
|
||||
(actor:send rcvr (funcall op msg))))
|
||||
|
||||
(defun make-neuron (syn-target &key (proc #'std-proc) state
|
||||
(syn-op #'identity) (env *environment*))
|
||||
(actor:create (neuron proc state (list (synapse syn-target syn-op)) env)))
|
||||
|
||||
(defun update-neuron (proc state syns &optional (env *environment*))
|
||||
(actor:become (neuron proc state syns env)))
|
||||
|
||||
;;;; predefined neuron processors and helper / utility funtions
|
||||
|
||||
(defun std-proc (msg state syns env)
|
||||
(util:lgi msg state)
|
||||
;(util:lgi msg state)
|
||||
(destructuring-bind (nmsg nst syns)
|
||||
(handle-action msg state syns env :default #'remember)
|
||||
(forward nmsg syns)
|
||||
|
|
@ -78,18 +79,15 @@
|
|||
(dolist (s syns)
|
||||
(funcall s msg)))
|
||||
|
||||
(defun handle-action (msg state syns env &key default)
|
||||
(defun handle-action (msg state syns env &key (default #'no-op))
|
||||
(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)))
|
||||
))
|
||||
(act (gethash key (actions env) default)))
|
||||
(funcall act msg state syns env)))
|
||||
|
||||
;;;; predefined neuron actions
|
||||
|
||||
(defun no-op (msg state syns env)
|
||||
(list msg (shape:data msg) syns))
|
||||
(list msg state syns))
|
||||
|
||||
(defun remember (msg state syns env)
|
||||
(list msg (shape:data msg) syns))
|
||||
|
|
|
|||
|
|
@ -26,9 +26,10 @@
|
|||
(defun probe (msg state syns env)
|
||||
(let ((t:*test-suite* (test-suite env))
|
||||
(val (shape:data msg)))
|
||||
(util:lgi msg state)
|
||||
(unless (consp val)
|
||||
(let ((nst (in-seq val state :remove t)))
|
||||
(actor:become (csys:neuron #'probe nst syns env))))))
|
||||
(csys:update-neuron #'probe nst syns env)))))
|
||||
|
||||
(defvar *probe* nil)
|
||||
|
||||
|
|
@ -54,7 +55,7 @@
|
|||
(t:show-result))))
|
||||
|
||||
(deftest test-init ()
|
||||
(csys:init-zero *probe*)
|
||||
(csys:init *probe*)
|
||||
(csys:send-message '(:csys :sensor :init :zero) '(:std :s1))
|
||||
(csys:send-message '(:csys :sensor :init :zero) '(:std :s2))
|
||||
(sleep 0.1)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue