diff --git a/csys/csys.lisp b/csys/csys.lisp index b785c0d..3527f3f 100644 --- a/csys/csys.lisp +++ b/csys/csys.lisp @@ -36,11 +36,16 @@ (set-proc sc)) (defun reset-scope (scp &rest args) - (apply #'scope - (getf args :program (program scp)) - (getf args :environ (environ scp)) - :categ (getf args :categ (categ scp)) - args)) + (let* ((addr (getf args :addr)) + (categ (if addr + (list (car addr) (cadr addr)) + (getf args :categ (categ scp))))) + (setf args (alx:remove-from-plist args :categ :addr)) + (apply #'scope + (getf args :program (program scp)) + (getf args :environ (environ scp)) + :categ categ + args))) (defun set-proc (scope) (setf (proc scope) (funcall (program scope) scope)) @@ -49,7 +54,7 @@ (defgeneric make-program (spec) (:method ((proc function)) (lambda (scope) proc)) (:method ((spec list)) - (make-program (alx:plist-hash-table spec :test :equal))) + (make-program (alx:plist-hash-table spec :test #'equal))) (:method ((spec hash-table)) (lambda (scope) (let* ((cat (cadr (categ scope))) diff --git a/csys/environ.lisp b/csys/environ.lisp index 596b81a..1bc916e 100644 --- a/csys/environ.lisp +++ b/csys/environ.lisp @@ -32,7 +32,7 @@ (defun cell-created (msg scope) (let* ((data (shape:data msg)) - (addr (getf data :addr)) + (addr (getf data :addr (getf data :categ))) (new (getf data :new))) (when addr (register-cell (cells scope) addr new)) @@ -49,7 +49,7 @@ ;;;; helpers (defun register-cell (reg addr cell) - (destructuring-bind (dom cat key) addr + (destructuring-bind (dom cat &optional (key "")) addr (let* ((dcat (list dom cat)) (idx (gethash dcat reg))) (unless idx diff --git a/test/test-csys.lisp b/test/test-csys.lisp index 149d9f6..9d92b0d 100644 --- a/test/test-csys.lisp +++ b/test/test-csys.lisp @@ -64,9 +64,13 @@ ;;;; (move to scopes/csys/programs) (defun test-program () - ;; set up plist for (:default :initial), :default (csys:make-program (csys:eff-proc :actions (actions-zero-initial)))) +(defun prog-b0 () + (csys:make-program + (list '(:c00 :initial) (csys:eff-proc :actions (actions-zero-initial)) + ':default (csys:std-proc)))) + (defun actions-zero-initial () (let ((acts (csys:basic-actions))) (setf (getf acts :next) (next-zero-initial)) @@ -74,15 +78,19 @@ (defun next-zero-initial () (lambda (msg scope) - (util:lgi msg) - ;; create :succ :e01; create :pred :s01; connect *self* :op (multiply -1) - ;; switch :active - nil)) + (let ((head '(:csys :create :c00 "0-0"))) + (actor:send actor:*self* + (message:create head :data '(:categ (:csys :e01)))) + (actor:send actor:*self* + (message:create head :data '(:addr (:csys :s01 "0-1")))) + ;; create :succ :e01; create :pred :s01; connect *self* :op (multiply -1) + ;; switch :active + nil))) ;;;; test definitions (deftest test-basic-0 () - (let ((env (setup-test (test-program))) + (let ((env (setup-test (prog-b0))) (rcvr (tc:receiver t:*test-suite*))) (sleep 0.1) (tc:expect rcvr (message:create '(:csys :effect :c00) :data '(:value 1)))