csys, work in progress: set up program from hash-table, more actions, test-specific settings
This commit is contained in:
parent
d9eb8ac692
commit
e7480b638e
4 changed files with 35 additions and 8 deletions
|
|
@ -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))
|
||||
)))
|
||||
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)
|
||||
|
|
|
|||
|
|
@ -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)))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue