csys: steps towards multi-cell system: create, connect, synapse

csys/csys.lisp

@@ -47,11 +47,13 @@
   scope)
 
 (defgeneric make-program (spec)
-  (:method ((proc function)) (lambda (scp) proc))
+  (:method ((proc function)) (lambda (scope) proc))
+  (:method ((spec list))
+    (make-program (alx:plist-hash-table spec :test :equal)))
   (:method ((spec hash-table))
-    (lambda (scp)
+    (lambda (scope)
-      (let* ((cat (cadr (categ scp)))
+      (let* ((cat (cadr (categ scope)))
-             (stg (stage scp))
+             (stg (stage scope))
              (proc (gethash (list cat stg) spec
                      (gethash (list cat :default) spec
                        (gethash (list :default stg) spec
@@ -76,9 +78,11 @@
 (defun update (scope)
   (actor:become (process scope)))
  
-(defun synapse (rcvr &optional (op #'identity))
+(defun synapse (rcvr &optional op)
   (lambda (msg)
-    (actor:send rcvr (funcall op msg))))
+    (let ((nmsg (if op (funcall op msg) msg)))
+      (when nmsg
+        (actor:send rcvr nmsg)))))
 
 ;;;; message handlers, proc steps
 
@@ -125,6 +129,7 @@
 (defun basic-actions ()
   (list :value (value-add)
         :create (create)
+        :connect (connect)
         :next (no-op :no-forward t)))
  
 (defun no-op (&key no-forward) 
@@ -151,13 +156,37 @@
  
 (defun create () 
   (lambda (msg scope)
-    (let ((new (neuron (apply #'reset-scope scope (shape:data msg)))))
+    (let* ((data (shape:data msg))
+           (new (neuron (apply #'reset-scope scope data))))
       (notify-created msg new scope)
+      (case (getf data :connect)
+        (:succ (send-connect actor:*self* new msg))
+        (:pred (send-connect new actor:*self* msg)))
       nil)))
 
+(defun connect ()
+  (lambda (msg scope)
+    (let ((data (shape:data msg)))
+      (setf (syns scope) 
+            (cons (synapse (getf data :target) (getf data :op)) (syns scope)))
+      (values nil scope))))
+
 ;;;; synapse ops
 
+(defun multiply (n)
+  (lambda (msg)
+    (let* ((data (shape:data (copy-list msg))))
+      (setf (getf data :value) (* (getf data :value 0) n))
+      (message:create (shape:head msg) :data data))))
+
 ;;;; helpers
 
 (defun new-msg-head (msg scope)
   (list (message:domain msg) (message:action msg) (cadr (categ scope))))
+
+(defun send-connect (rcvr target msg)
+  (let ((data (shape:data msg)))
+    (actor:send rcvr 
+      (message:create (list (message:domain msg) :connect) 
+                      :data (list :target (getf data :target) 
+                                  :op (getf data :op))))))

test/test-csys.lisp

@@ -60,19 +60,23 @@
     (csys:create-zero prg env)
     env))
 
-;;;; test-specific actions
+;;;; test-specific programs / actions 
+;;;; (move to scopes/csys/programs)
 
 (defun test-program ()
-  (csys:make-program (csys:eff-proc :actions (actions-zero))))
+  ;; set up plist for (:default :initial), :default
+  (csys:make-program (csys:eff-proc :actions (actions-zero-initial))))
 
-(defun actions-zero () 
+(defun actions-zero-initial () 
   (let ((acts (csys:basic-actions)))
-    (setf (getf acts :next) (next-zero))
+    (setf (getf acts :next) (next-zero-initial))
     acts))
 
-(defun next-zero ()
+(defun next-zero-initial ()
   (lambda (msg scope) 
     (util:lgi msg)
+    ;; create :succ :e01; create :pred :s01; connect *self* :op (multiply -1)
+    ;; switch :active
     nil))
  
 ;;;; test definitions