cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

csys: get rid of env paramater - just set it in neuron lambda function

Browse source
This commit is contained in:
Helmut Merz 2026-04-05 10:20:34 +02:00
parent 8bf7e8ae0c
commit 133e6ebed9
2 changed files with 29 additions and 30 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

53
csys/csys.lisp
View file

@ -29,39 +29,39 @@
;(defvar *environment* (make-instance 'environment))
(defvar *environment* nil)
(defun add-action (key fn &optional (env *environment*))
;(util:lgi key fn env)
(setf (gethash key (actions env)) fn))
(defun add-action (key fn)
;(util:lgi key fn *environment*)
(setf (gethash key (actions *environment*)) fn))
(defun add-sensors (key sns &optional (env *environment*))
;(util:lgi key sns env)
(setf (gethash key (sensors env)) sns))
(defun add-sensors (key sns)
;(util:lgi key sns *environment*)
(setf (gethash key (sensors *environment*)) sns))
;;;; neurons (= behavior factories) and synapses (connection factories)
(defun neuron (proc &optional state syns (env *environment*))
(lambda (msg)
(funcall proc msg state syns env)))
(let ((*environment* env))
(funcall proc msg state syns))))
(defun synapse (rcvr &optional (op #'identity))
(lambda (msg)
(actor:send rcvr (funcall op msg))))
(defun make-neuron (syn-target &key proc state
(syn-op #'identity) (env *environment*))
(let ((proc (or proc (gethash :default (procs env) #'std-proc)))
(defun make-neuron (syn-target &key proc state (syn-op #'identity))
(let ((proc (or proc (gethash :default (procs *environment*) #'std-proc)))
(syns (if syn-target (list (synapse syn-target syn-op)) nil)))
(actor:create (neuron proc state syns env))))
(actor:create (neuron proc state syns))))
(defun update-neuron (proc state syns &optional (env *environment*))
(actor:become (neuron proc state syns env)))
(defun update-neuron (proc state syns)
(actor:become (neuron proc state syns)))
(defun std-proc (msg state syns env)
(defun std-proc (msg state syns)
;(util:lgi msg state syns env)
(destructuring-bind (nmsg nst nsyns)
(handle-action msg state syns env :default #'remember)
(handle-action msg state syns :default #'remember)
(forward nmsg nsyns)
(update-neuron (next-proc nst) nst nsyns env)))
(update-neuron (next-proc nst) nst nsyns)))
;;;; neuron state methods
@ -88,7 +88,7 @@
;;;; effector procs for pseudo-neurons embedded in environment
(defun do-log (msg state syns env)
(defun do-log (msg state syns)
(util:lgi msg))
;;;; helper / utility funtions
@ -97,28 +97,27 @@
(dolist (s syns)
(funcall s msg)))
(defun handle-action (msg state syns env &key (default #'no-op))
(defun handle-action (msg state syns &key (default #'no-op))
(let* ((key (shape:head-value msg :action))
(act (gethash key (actions env) default)))
(funcall act msg state syns env)))
(act (gethash key (actions *environment*) default)))
(funcall act msg state syns)))
;;;; predefined neuron actions
(defun no-op (msg state syns env)
(defun no-op (msg state syns)
(list msg state syns))
(defun remember (msg state syns env)
(defun remember (msg state syns)
;(list msg (make-neuron-state (shape:data msg) syns))
(list msg (shape:data msg) syns))
(defun create-sensor (msg state syns env)
(defun create-sensor (msg state syns)
(let* ((key (shape:data msg))
(sensor (make-neuron actor:*self* :state key :env env))
(sensor (make-neuron actor:*self* :state key))
(nmsg (message:create (list :csys :created (car key) (cadr key)))))
;(setf (gethash key (sensors env)) (list sensor))
(add-sensors key (list sensor) env)
(add-sensors key (list sensor))
(list nmsg state syns)))
(defun add (msg state syns env)
(defun add (msg state syns)
(list msg (+ (shape:data msg) state) syns))

6
test/test-csys.lisp
View file

@ -36,10 +36,10 @@
(config:add-action '(:csys) (constantly nil))
)
(defun eff-proc (msg state syns env)
(let ((t:*test-suite* (test-suite env)))
(defun eff-proc (msg state syns)
(let ((t:*test-suite* (test-suite csys:*environment*)))
(destructuring-bind (nmsg nst nsyns)
(csys:handle-action msg state syns env)
(csys:handle-action msg state syns)
(util:lgi nmsg)
(actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg))))