csys: creation of two additional cells (with addr / categ) OK

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)))

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

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)))