minor clean-ups, improvements, functions for future use

csys/csys.lisp

@@ -11,9 +11,8 @@
   (:export #:scope #:environ
            #:make-program #:create-zero
            #:neuron #:std-proc #:eff-proc
-           #:handle-action #:forward #:notify
-           #:basic-actions #:merge-actions
-           #:no-op #:value-add #:create #:connect
+           #:handle-action #:basic-actions #:forward #:notify
+           #:no-op #:printer #:value-add #:create #:connect
            #:multiply
            #:send-create #:send-connect))
 
@@ -203,6 +202,9 @@
     (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
+  (:export #:create #:simple-proc
            #:actions
            #:send-value #:send-connect))
 
@@ -17,10 +17,18 @@
 (defclass scope (csys:scope)
   ((cells :reader cells :initform (make-hash-table :test #'equal))))
 
-(defun create (proc meta-env)
+(defun create (proc &optional (meta-env (csys:printer)))
+  ;; + create contact cells (<- &key contact-cells)
   (let ((prg (csys:make-program proc)))
     (csys:neuron (csys:scope prg meta-env :cls 'scope :categ '(:env :c00)))))
 
+(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))))
+
 ;;;; action handlers
 
 (defun actions () 
@@ -37,6 +45,8 @@
          (new (getf data :new)))
     (when addr
       (register-cell (cells scope) addr new))
+      ;; check: if corresponding env (contact) cell present? e.g. (:env :e00 "1-0") 
+      ;; => connect
     ;(csys:send-message new (list (message:domain msg) :next) :data data)
     (actor:send new 
       (message:create (list (message:domain msg) :next) :data data))
@@ -73,11 +83,11 @@
 
 (defun register-cell (reg addr cell)
   (destructuring-bind (dom cat &optional (key "")) addr
-    (let* ((dcat (list dom cat))
-           (idx (gethash dcat reg)))
+    (let* ((categ (list dom cat))
+           (idx (gethash categ reg)))
       (unless idx
         (setf idx (index:create))
-        (setf (gethash dcat reg) idx))
+        (setf (gethash categ reg) idx))
       (index:put idx key cell))))
 
 (defun find-cells (reg addr)
@@ -88,3 +98,9 @@
         (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

@@ -41,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 :stage :basic :loc "0-1")
+      (csys:send-create self :cat :s00 :loc "0-1" :stage :basic)
       ;; switch :active
       nil)))