csys improvements, start with public shortcuts: send-connect

csys/csys.lisp

@@ -9,12 +9,12 @@
                     (:util :scopes/util)
                     (:alx :alexandria))
   (:export #:scope #:environ
-           #:make-program
+           #:make-program #:create-zero
-           #:neuron #:std-proc #:eff-proc #:create-zero
+           #:neuron #:std-proc #:eff-proc
-           #:handle-action
+           #:handle-action #:forward #:notify
-           #:notify
+           #:basic-actions #:no-op #:value-add #:create #:connect
-           #:basic-actions #:no-op #:value-add #:create
+           #:multiply
-           #:multiply))
+           #:send-connect))
 
 (in-package :scopes/csys)
 
@@ -84,6 +84,10 @@
 (defun update (scope)
   (actor:become (process scope)))
 
+(defun process (scope)
+  (lambda (msg) 
+    (funcall (proc scope) msg scope)))
+  
 (defun synapse (rcvr &optional op)
   (lambda (msg)
     (let ((nmsg (if op (funcall op msg) msg)))
@@ -92,10 +96,6 @@
 
 ;;;; message handlers, proc steps
 
-(defun process (scope)
-  (lambda (msg) 
-    (funcall (proc scope) msg scope)))
-
 (defun std-proc (&key (default (remember)) actions)
   (lambda (msg scope) 
     (util:mv-bind (nmsg (nscope scope)) 
@@ -124,12 +124,6 @@
 (defun notify (msg scope)
   (actor:send (environ scope) msg))
 
-(defun notify-created (msg new scope)
-  (let* ((head (list (message:domain msg) :created))
-         (data (util:plist-merge (shape:data msg) `(:new ,new :parent ,actor:*self*)))
-         (msg1 (message:create head :data data))) 
-    (notify msg1 scope)))
-
 ;;;; action handlers
 
 (defun basic-actions ()
@@ -166,8 +160,8 @@
            (new (neuron (apply #'reset-scope scope data))))
       (notify-created msg new scope)
       (case (getf data :connect)
-        (:succ (send-connect actor:*self* new msg))
+        (:succ (send-connect-msg actor:*self* new msg))
-        (:pred (send-connect new actor:*self* msg)))
+        (:pred (send-connect-msg new actor:*self* msg)))
       nil)))
 
 (defun connect ()
@@ -185,14 +179,26 @@
       (setf (getf data :value) (* (getf data :value 0) n))
       (message:create (shape:head msg) :data data))))
 
-;;;; helpers
+;;;; public shortcuts
+
+(defun send-connect (rcvr target &key op (domain :csys))
+  (actor:send rcvr 
+    (message:create (list domain :connect) 
+                    :data (list :target target :op op))))
+
+;;;; internal helpers
  
 (defun new-msg-head (msg scope)
   (list (message:domain msg) (message:action msg) (cadr (categ scope))))
   
-(defun send-connect (rcvr target msg)
+(defun notify-created (msg new scope)
+  (let* ((head (list (message:domain msg) :created))
+         (data (util:plist-merge (shape:data msg) `(:new ,new :parent ,actor:*self*)))
+         (msg1 (message:create head :data data))) 
+    (notify msg1 scope)))
+
+(defun send-connect-msg (rcvr target msg)
   (let ((data (shape:data msg)))
-    (actor:send rcvr 
+    (send-connect rcvr target 
-      (message:create (list (message:domain msg) :connect) 
+                  :domain (message:domain msg) 
-                      :data (list :target target 
+                  :op (getf data :op))))
-                                  :op (getf data :op))))))

csys/environ.lisp

@@ -58,7 +58,7 @@
       (index:put idx key cell))))
 
 (defun find-cells (reg addr)
-  (destructuring-bind (dom cat key) addr
+  (destructuring-bind (dom cat &optional (key "")) addr
     (let ((idx (gethash (list dom cat) reg)))
       (when idx
         (index:query idx key)))))

test/test-csys.lisp

@@ -83,9 +83,9 @@
         (message:create cr :data '(:categ (:csys :e01) :connect :succ)))
       (actor:send self
         (message:create cr :data '(:addr (:csys :s01 "0-1") :connect :pred)))
-      (actor:send self
+      (csys:send-connect self self :op (csys:multiply -1))
-        (message:create conn :data (list :target self :op (csys:multiply -1))))
+      ;(actor:send self
-      ;; connect *self* :op (multiply -1)
+      ;  (message:create conn :data (list :target self :op (csys:multiply -1))))
       ;; switch :active
       nil)))