work in progress: :next action; minor fixes and rearrangements
This commit is contained in:
parent
e7480b638e
commit
93f9a5a835
4 changed files with 17 additions and 12 deletions
|
|
@ -61,7 +61,7 @@
|
|||
(let ((*self* tsk))
|
||||
(handler-case (funcall bhv msg)
|
||||
(error (err)
|
||||
(util:lg :error "behavior" msg tsk bhv err))
|
||||
(util:lg :error "behavior" msg err))
|
||||
;(invoke-debugger err))
|
||||
)))
|
||||
|
||||
|
|
|
|||
|
|
@ -97,8 +97,9 @@
|
|||
(lambda (msg scope)
|
||||
(util:mv-bind (nmsg (nscope scope))
|
||||
(handle-action msg scope :default (no-op) :actions actions)
|
||||
(setf (nth 1 (shape:head nmsg)) :effect)
|
||||
(when nmsg (notify nmsg nscope))
|
||||
(when nmsg
|
||||
(setf (nth 1 (shape:head nmsg)) :effect)
|
||||
(notify nmsg nscope))
|
||||
(update nscope))))
|
||||
|
||||
(defun handle-action (msg scope &key (default (no-op)) actions)
|
||||
|
|
|
|||
|
|
@ -37,9 +37,9 @@
|
|||
(when addr
|
||||
(register-cell (cells scope) addr new))
|
||||
;;;send :next message / create more cells:
|
||||
;(actor:send new
|
||||
; (message:create (list (message:domain msg) :next) :data (shape:data msg))
|
||||
msg))
|
||||
(actor:send new
|
||||
(message:create (list (message:domain msg) :next) :data (shape:data msg)))
|
||||
nil))
|
||||
|
||||
(defun forward (msg scope)
|
||||
(dolist (cell (find-cells (cells scope) (message:addr msg)))
|
||||
|
|
|
|||
|
|
@ -37,7 +37,7 @@
|
|||
(let ((t:*test-suite* (csys:environ scope)))
|
||||
(util:mv-bind (nmsg (scope scope))
|
||||
(csys:handle-action msg scope :actions (environ:actions))
|
||||
(util:lgi nmsg (tc:receiver t:*test-suite*))
|
||||
(util:lgi msg nmsg)
|
||||
(when nmsg
|
||||
(actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg)))))
|
||||
|
||||
|
|
@ -60,18 +60,22 @@
|
|||
(csys:create-zero prg env)
|
||||
env))
|
||||
|
||||
;;;; test-specific 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))
|
||||
|
||||
(defun next-zero ()
|
||||
(lambda (msg scope)
|
||||
(util:lgi msg)
|
||||
nil))
|
||||
|
||||
;;;; test definitions
|
||||
|
||||
(deftest test-basic-0 ()
|
||||
(let ((env (setup-test (test-program)))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue