csys/csys.lisp

@@ -11,8 +11,9 @@
   (:export #:scope #:environ
            #:make-program #:create-zero
            #:neuron #:std-proc #:eff-proc
-           #:handle-action #:basic-actions #:forward #:notify
-           #:no-op #:printer #:value-add #:create #:connect
+           #:handle-action #:forward #:notify
+           #:basic-actions #:merge-actions
+           #:no-op #:value-add #:create #:connect
            #:multiply
            #:send-create #:send-connect))
 
@@ -116,7 +117,6 @@
           (handle-action msg scope :default (no-op) :actions actions)
         (when nmsg 
           (setf (nth 1 (shape:head nmsg)) :effect)
-          (forward nmsg (syns nscope))
           (notify nmsg nscope))
         (update nscope)))))
 
@@ -189,9 +189,6 @@
 
 ;;;; public shortcuts
 
-(defun send-message (cell head data)
-  (actor:send cell (message:create head :data data)))
-
 (defun send-create (cell &rest args &key (domain :csys) 
                          (cat :c00) loc connect op &allow-other-keys)
   (let ((args+ (if loc 
@@ -206,9 +203,6 @@
     (message:create (list domain :connect) 
                     :data (list :target target :op op))))
 
-(defun printer ()
-  (actor:create (lambda (msg) (print msg))))
- 
 ;;;; internal helpers
  
 (defun new-msg-head (msg scope)

csys/environ.lisp

@@ -8,7 +8,7 @@
                     (:message :scopes/core/message)
                     (:shape :scopes/shape)
                     (:util :scopes/util))
-  (:export #:create #:simple-proc
+  (:export #:create
            #:actions
            #:send-value #:send-connect))
 
@@ -17,38 +17,9 @@
 (defclass scope (csys:scope)
   ((cells :reader cells :initform (make-hash-table :test #'equal))))
 
-(defun create (proc meta-env &key eff-contacts)  ; meta-env example: (csys:printer)
-  (let* ((prg (csys:make-program proc))
-         (scope (csys:scope prg meta-env :cls 'scope :categ '(:env :c00)))
-         (env (csys:neuron scope)))
-    (create-contact-cells eff-contacts env (cells scope))
-    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))))
-
-;;;; eff contact cells
-
-(defclass contact-scope (csys:scope)
-  ((loc :reader loc :initarg :loc)))
-
-(defun create-contact-cells (eff-contacts env cells)
-  (util:loop-plist eff-contacts cat locs do
-    (dolist (loc locs)
-      (let ((ct (csys:neuron 
-                  (csys:scope (csys:make-program #'proc-contact) env 
-                              :cls 'contact-scope
-                              :categ (list :env cat) :loc loc))))
-        ;(util:lgi cells cat loc)
-        (register-cell cells (list :env cat loc) ct)))))
-
-(defun proc-contact (msg scope)
-  (setf (nth 3 (shape:head msg)) (loc scope))
-  (actor:send (csys:environ scope) msg))
+(defun create (proc meta-env)
+  (let ((prg (csys:make-program proc)))
+    (csys:neuron (csys:scope prg meta-env :cls 'scope :categ '(:env :c00)))))
 
 ;;;; action handlers
 
@@ -66,9 +37,6 @@
          (new (getf data :new)))
     (when addr
       (register-cell (cells scope) addr new))
-      (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)
     (actor:send new 
       (message:create (list (message:domain msg) :next) :data data))
@@ -105,11 +73,11 @@
 
 (defun register-cell (reg addr cell)
   (destructuring-bind (dom cat &optional (key "")) addr
-    (let* ((categ (list dom cat))
-           (idx (gethash categ reg)))
+    (let* ((dcat (list dom cat))
+           (idx (gethash dcat reg)))
       (unless idx
         (setf idx (index:create))
-        (setf (gethash categ reg) idx))
+        (setf (gethash dcat reg) idx))
       (index:put idx key cell))))
 
 (defun find-cells (reg addr)
@@ -120,9 +88,3 @@
         (util:lgw "not found" addr reg idx))
       cells)))
  
-(defun find-cell (reg addr)
-  (let ((cells (find-cells reg addr)))
-    (when (> (length cells) 1)
-      (util:lgw "more than one cell found" addr reg cells))
-    (car cells)))
-

csys/program.lisp

@@ -6,7 +6,7 @@
                     (:csys :scopes/csys)
                     (:environ :scopes/csys/environ)
                     (:util :scopes/util))
-  (:export #:basic-0 #:config-basic-1))
+  (:export #:basic-0 #:basic-1))
 
 (in-package :scopes/csys/program)
 
@@ -29,10 +29,6 @@
  
 ;;;; basic-1: minimal cross-linked system
 
-(defun config-basic-1 ()
-  (list (basic-1) :zero-cat :s00
-        :eff-contacts '(:e00 ("1-0" "1-1"))))
-
 (defun basic-1 ()
   (csys:make-program
     (list '(:s00 :initial) (csys:std-proc :next (b1-next-zero))
@@ -45,7 +41,7 @@
     (let ((self actor:*self*))
       (csys:send-create self :cat :e00 :loc "1-0" :connect :succ)
       (csys:send-create self :cat :e00 :loc "1-1" :connect :succ :op (csys:multiply -1))
-      (csys:send-create self :cat :s00 :loc "0-1" :stage :basic)
+      (csys:send-create self :cat :s00 :stage :basic :loc "0-1")
       ;; switch :active
       nil)))
  

test/test-csys.lisp

@@ -54,20 +54,19 @@
       (tc:check-expected)
       (t:show-result))))
 
-(defun setup-test (cfg)
+(defun setup-test (prg &key (zero-cat :c00))
   (setup-config)
   (core:setup-services)
-  (destructuring-bind (prg &key (zero-cat :c00) eff-contacts) cfg
-    (let ((rcvr (core:find-service :test-receiver))
-          (env (environ:create #'proc-env t:*test-suite* :eff-contacts eff-contacts)))
-      (setf (tc:receiver t:*test-suite*) rcvr)
-      (csys:create-zero prg env :categ (list :csys zero-cat))
-      env)))
+  (let* ((rcvr (core:find-service :test-receiver))
+         (env (environ:create #'proc-env t:*test-suite*)))
+    (setf (tc:receiver t:*test-suite*) rcvr)
+    (csys:create-zero prg env :categ (list :csys zero-cat))
+    env))
 
 ;;;; test definitions
  
 (deftest test-basic-0 ()
-  (let ((env (setup-test (list (program:basic-0)))))
+  (let ((env (setup-test (program:basic-0))))
         ;(rcvr (tc:receiver t:*test-suite*))
     (sleep 0.1)
     ;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1)))
@@ -77,7 +76,7 @@
     (core:shutdown)))
 
 (deftest test-basic-1 ()
-  (let ((env (setup-test (program:config-basic-1))))
+  (let ((env (setup-test (program:basic-1) :zero-cat :s00)))
     (sleep 0.1)
     (environ:send-value env 1 :cat :s00 :loc "0-0")
     (environ:send-value env 2 :cat :s00 :loc "0-1")