csys/environ: add simple-setup function for interactive tests

csys/csys.lisp

@@ -14,7 +14,7 @@
            #:handle-action #:basic-actions #:forward #:notify
            #:no-op #:printer #:value-add #:create #:connect
            #:multiply
-           #:send-create #:send-connect))
+           #:send-message #:send-create #:send-connect))
 
 (in-package :scopes/csys)
 
@@ -117,7 +117,7 @@
         (when nmsg 
           (setf (nth 1 (shape:head nmsg)) :effect)
           (forward nmsg (syns nscope))
-          (notify nmsg nscope))
+          (unless (syns nscope) (notify nmsg nscope)))
         (update nscope)))))
 
 (defun handle-action (msg scope &key (default (no-op)) actions)
@@ -198,13 +198,10 @@
                  `(:addr ,(list domain cat loc))
                  `(:categ ,(list domain cat)))))
     (setf args (alx:remove-from-plist args :domain :cat :loc))
-    (actor:send cell 
+    (send-message cell (list domain :create) (append args+ args))))
-      (message:create (list domain :create) :data (append args+ args)))))
 
 (defun send-connect (cell target &key op (domain :csys))
-  (actor:send cell 
+  (send-message cell (list domain :connect) (list :target target :op op)))
-    (message:create (list domain :connect) 
-                    :data (list :target target :op op))))
 
 (defun printer ()
   (actor:create (lambda (msg) (print msg))))

csys/environ.lisp

@@ -8,12 +8,15 @@
                     (:message :scopes/core/message)
                     (:shape :scopes/shape)
                     (:util :scopes/util))
-  (:export #:create #:simple-proc
+  (:export #:*env*
+           #:create #:simple-setup #:simple-proc
            #:actions
            #:send-value #:send-connect))
 
 (in-package :scopes/csys/environ)
 
+(defvar *env* nil)
+
 (defclass scope (csys:scope)
   ((cells :reader cells :initform (make-hash-table :test #'equal))))
 
@@ -24,12 +27,18 @@
     (create-contact-cells eff-contacts env (cells scope))
     env))
 
+(defun simple-setup (cfg)
+  (destructuring-bind (prg &key (zero-cat :c00) eff-contacts) cfg
+    (let ((env (create #'simple-proc (csys:printer) :eff-contacts eff-contacts)))
+      (csys:create-zero prg env :categ (list :csys zero-cat))
+      env)))
+
 (defun simple-proc (msg scope)
   (util:mv-bind (nmsg (scope scope)) 
       (csys:handle-action msg scope :actions (actions))
     (util:lgi msg nmsg)
     (when nmsg
-      (actor:send (env scope) nmsg))))
+      (actor:send (csys:environ scope) nmsg))))
 
 ;;;; eff contact cells
 
@@ -47,8 +56,9 @@
         (register-cell cells (list :env cat loc) ct)))))
 
 (defun proc-contact (msg scope)
-  (setf (nth 3 (shape:head msg)) (loc scope))
+  (let ((head (copy-list (shape:head msg)))) 
-  (actor:send (csys:environ scope) msg))
+    (setf (nth 3 head) (loc scope))
+    (csys:send-message (csys:environ scope) head (shape:data msg))))
 
 ;;;; action handlers
 
@@ -69,9 +79,7 @@
       (let* ((ct-addr (cons :env (cdr addr)))
              (ct (find-cell (cells scope) ct-addr)))
         (when ct (csys:send-connect new ct)))
-    ;(csys:send-message new (list (message:domain msg) :next) :data data)
+    (csys:send-message new (list (message:domain msg) :next) data)
-    (actor:send new 
-      (message:create (list (message:domain msg) :next) :data data))
     nil))
 
 (defun forward (msg scope)
@@ -93,8 +101,8 @@
 
 ;;;; public shortcuts
 
-(defun send-value (env val &key (domain :csys) (cat :c00) (loc ""))
+(defun send-value (cat-loc val &key (domain :csys) (env *env*))
-  (let ((head (list domain :value cat loc)))
+  (let ((head (cons domain (cons :value cat-loc))))
     (actor:send env (message:create head :data `(:value ,val)))))
 
 (defun send-connect (env &rest args &key (domain :csys) addr to target op)

test/test-csys.lisp

@@ -67,19 +67,19 @@
 ;;;; test definitions
  
 (deftest test-basic-0 ()
-  (let ((env (setup-test (list (program:basic-0)))))
+  (let ((environ:*env* (setup-test (list (program:basic-0)))))
         ;(rcvr (tc:receiver t:*test-suite*))
     (sleep 0.1)
     ;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1)))
-    (environ:send-value env 1 :cat :s01 :loc "0-1")
+    (environ:send-value '(:s01 "0-1") 1)
-    (environ:send-value env 2 :cat :s01 :loc "0-1")
+    (environ:send-value '(:s01 "0-1") 2)
     (sleep 0.1)
     (core:shutdown)))
 
 (deftest test-basic-1 ()
-  (let ((env (setup-test (program:config-basic-1))))
+  (let ((environ:*env* (setup-test (program:config-basic-1))))
     (sleep 0.1)
-    (environ:send-value env 1 :cat :s00 :loc "0-0")
+    (environ:send-value '(:s00 "0-0") 1)
-    (environ:send-value env 2 :cat :s00 :loc "0-1")
+    (environ:send-value '(:s00 "0-1") 2)
     (sleep 0.1)
     (core:shutdown)))