csys/csys.lisp

@@ -95,7 +95,6 @@
   
 (defun synapse (rcvr &optional op)
   (lambda (msg)
-    ;(if (eql (message:domain msg) :_meta) (setf op (handle-syn-meta msg rcvr op)) (...))
     (let ((nmsg (if op (funcall op msg) msg)))
       (when nmsg
         (actor:send rcvr nmsg)))))
@@ -154,20 +153,17 @@
     (setf (value scope) (shape:data-value msg :value))
     (values msg scope)))
 
-(defun value-add (&key (bias 0) (threshold 1) limits)
+(defun value-add (&key (bias 0) (threshold 1))
   (lambda (msg scope)
     (let* ((val (getf (shape:data msg) :value))
-           (newval (+ val (value scope)))
+           (newval (+ val (value scope))))
-           (limit2 (cadr limits)))
+      (util:lgi newval (length (syns scope)))
-      ;(util:lgi newval (length (syns scope)))
-      (when limit2 (setf newval (min newval limit2)))
       (if (>= newval threshold)
         (let* ((head (new-msg-head msg scope))
                (msg (message:create head :data (list :value newval))))
           (setf (value scope) bias)
           (values msg scope))
-        (let ((limit1 (car limits)))
+        (progn
-          (when limit1 (setf newval (max newval limit1)))
           (setf (value scope) newval)
           (values nil scope))))))
  
@@ -183,9 +179,9 @@
 
 (defun connect ()
   (lambda (msg scope)
-    (let* ((data (shape:data msg))
+    (let ((data (shape:data msg)))
-           (syn (synapse (getf data :target) (getf data :op))))
+      (setf (syns scope) 
-      (push syn (syns scope))
+            (cons (synapse (getf data :target) (getf data :op)) (syns scope)))
       (values nil scope))))
 
 (defun switch (&key (default :active))
@@ -193,21 +189,9 @@
     (let ((data (shape:data msg)))
       (setf (stage scope) (getf data :stage default))
       (set-proc scope)
-      ;(util:lgi (stage scope) (proc scope) (syns scope))
+      (util:lgi (stage scope) (proc scope) (syns scope))
       (values nil scope))))
 
-(defun retire (msg scope)
-  #+// (environ:unregister *self*)
-  #+// (environ:remove-pred-syns *self*)
-  (setf (stage scope) :retired)
-  (setf (syns scope) nil)
-  (setf (proc scope)
-    (lambda (msg scope) 
-      (util:lgw "message for retired cell" msg scope)
-      ;(notify ...)
-      nil))
-  (values nil scope))
-
 ;;;; synapse ops
 
 (defun multiply (n)

csys/environ.lisp

@@ -85,7 +85,7 @@
 (defun forward (msg scope)
   (let ((addr (message:addr msg))) 
     (if addr 
-      (let ((cell (find-cell (cells scope) (message:addr msg)))) 
+      (dolist (cell (find-cells (cells scope) (message:addr msg))) 
         (actor:send cell msg))
       (let ((rcvr (getf (shape:data msg) :to)))
         (if rcvr

csys/program/basic.lisp

@@ -14,11 +14,10 @@
 ;;;; basic-0: minimal recursive system
 
 (defun prog-b0 ()
-  (let ((val-action (csys:value-add :limits '(0)))) 
+  (csys:make-program
-    (csys:make-program
+    (list '(:c00 :initial) (csys:std-proc :next (b0-next-zero))
-      (list '(:c00 :initial) (csys:std-proc :value val-action :next (b0-next-zero))
+          '(:e00 :initial) (csys:eff-proc)
-            '(:e00 :initial) (csys:eff-proc)
+          ':default (csys:std-proc))))
-            ':default (csys:std-proc)))))
 
 (defun b0-next-zero ()
   (lambda (msg scope) 
@@ -36,12 +35,11 @@
         :eff-contacts '(:e01 ("1-0" "1-1"))))
 
 (defun prog-b1 ()
-  (let ((val-action (csys:value-add :bias 2 :limits '(0)))) 
+  (csys:make-program
-    (csys:make-program
+    (list '(:s01 :initial) (csys:std-proc :next (b1-next-zero))
-      (list '(:s01 :initial) (csys:std-proc :next (b1-next-zero))
+          '(:s01 :basic) (csys:std-proc :next (b1-next-one))
-            '(:s01 :basic) (csys:std-proc :next (b1-next-one))
+          '(:e01 :default) (csys:eff-proc :value (csys:value-add :bias 2))
-            '(:e01 :default) (csys:eff-proc :value val-action)
+          ':default (csys:std-proc))))
-            ':default (csys:std-proc)))))
 
 (defun b1-next-zero ()
   (lambda (msg scope) 
@@ -69,7 +67,7 @@
         :eff-contacts '(:e02 ("2-0" "2-1"))))
 
 (defun prog-b2 ()
-  (let ((val-action (csys:value-add :bias 2 :limits '(0)))) 
+  (let ((val-action (csys:value-add :bias 2))) 
     (csys:make-program
       (list '(:c02 :initial) (csys:std-proc :value val-action :next (b2-next-zero))
             '(:c02 :basic) (csys:std-proc :value val-action :next (b2-next-one))

scopes-core.asd

@@ -17,6 +17,7 @@
                                    "core/actor" "core/message" 
                                    "forge/forge" "logging" 
                                    "util/async" "util/util"))
+               (:file "csys/csys" :depends-on ("core/core"))
                (:file "core/message" :depends-on ("core/actor" "shape/shape"))
                (:file "forge/forge" :depends-on ("util/iter" "util/util"))
                (:file "logging" :depends-on ("config" "util/util"))

scratch.lisp

@@ -10,8 +10,6 @@
 
 (add-package-local-nickname :basic :scopes/csys/program/basic)
 (add-package-local-nickname :environ :scopes/csys/environ)
-(add-package-local-nickname :message :scopes/core/message)
-(add-package-local-nickname :shape :scopes/shape)
 
 (scopes/util/async:init)
 (setf environ:*env* (environ:simple-setup (basic:config-b2)))

space/space.lisp

@@ -1,18 +0,0 @@
-;;;; cl-scopes/space
-
-;;;; definitions for spatial registering and retrieving objects by location
-
-(defpackage :scopes/space
-  (:use :common-lisp)
-  (:local-nicknames (:alx :alexandria))
-  (:export #:create #:put #:query))
-
-(in-package :scopes/space)
-
-(defclass index ()
-  ((data :reader data :initform (make-hash-table :test #'equal))))
-
-(defun create ()
-  (make-instance 'index))
-
-

test/test-core.lisp

@@ -1,5 +1,4 @@
-;;;; cl-scopes/test-core - testing for the scopes-core system
+;;;; cl-scopes/test-core - testing for the scopes-core system.
-;;;; including shape and util packages.
 
 (defpackage :scopes/test-core
   (:use :common-lisp)

test/test-csys.lisp

@@ -90,7 +90,7 @@
 (deftest test-basic-2 ()
   (let ((environ:*env* (setup (basic:config-b2) :delay 0.03)))
     (environ:send-value '(:s02 "1-0") 1) (sleep 0.0001)
-    (environ:send-value '(:s02 "1-1") 2) (sleep 0.0001)
+    (environ:send-value '(:s02 "1-1") 2) (sleep 0.0001) ;; 2 => loop
-    (environ:send-value '(:s02 "1-0") 2)
+    (environ:send-value '(:s02 "1-0") 2) ;; stop loop
     (teardown)))