csys, work in progress: set up program from hash-table, more actions, test-specific settings

This commit is contained in:
Helmut Merz 2026-07-27 09:01:09 +02:00
parent d9eb8ac692
commit e7480b638e
4 changed files with 35 additions and 8 deletions

View file

@ -61,7 +61,7 @@
(let ((*self* tsk))
(handler-case (funcall bhv msg)
(error (err)
(util:lg :error "behavior" msg err))
(util:lg :error "behavior" msg tsk bhv err))
;(invoke-debugger err))
)))

View file

@ -47,7 +47,18 @@
scope)
(defgeneric make-program (spec)
(:method ((fn function)) (lambda (scp) fn)))
(:method ((proc function)) (lambda (scp) proc))
(:method ((spec hash-table))
(lambda (scp)
(let* ((cat (cadr (categ scp)))
(stg (stage scp))
(proc (gethash (list cat stg) spec
(gethash (list cat :default) spec
(gethash (list :default stg) spec
(gethash :default spec))))))
(unless proc
(util:lgw "proc not found" cat stg spec))
proc))))
(defun create-zero (prg env &key (categ '(:csys :c00)) (name "0-0"))
(let* ((domain (car categ))
@ -72,7 +83,8 @@
;;;; message handlers, proc steps
(defun process (scope)
(lambda (msg) (funcall (proc scope) msg scope)))
(lambda (msg)
(funcall (proc scope) msg scope)))
(defun std-proc (&key (default (remember)) actions)
(lambda (msg scope)
@ -111,7 +123,8 @@
(defun basic-actions ()
(list :value (value-add)
:create (create)))
:create (create)
:next (no-op :no-forward t)))
(defun no-op (&key no-forward)
(lambda (msg scope)
@ -141,6 +154,8 @@
(notify-created msg new scope)
nil)))
;;;; synapse ops
;;;; helpers
(defun new-msg-head (msg scope)

View file

@ -36,7 +36,9 @@
(new (getf data :new)))
(when addr
(register-cell (cells scope) addr new))
;send startup message / create more cells
;;;send :next message / create more cells:
;(actor:send new
; (message:create (list (message:domain msg) :next) :data (shape:data msg))
msg))
(defun forward (msg scope)

View file

@ -60,11 +60,21 @@
(csys:create-zero prg env)
env))
(defun actions () (csys:basic-actions))
(defun test-program ()
(csys:make-program (csys:eff-proc :actions (actions-zero))))
(defun next-zero ()
(lambda (msg scope)
(util:lgi msg)
nil))
(defun actions-zero ()
(let ((acts (csys:basic-actions)))
(setf (getf acts :next) (next-zero))
acts))
(deftest test-basic-0 ()
(let ((env (setup-test (csys:make-program (csys:eff-proc :actions (actions)))))
;(env (setup-test (test-program))
(let ((env (setup-test (test-program)))
(rcvr (tc:receiver t:*test-suite*)))
(sleep 0.1)
(tc:expect rcvr (message:create '(:csys :effect :c00) :data '(:value 1)))