environ: cell registry: now a predefined property list named *spaces*

csys/csys.lisp

@@ -154,7 +154,7 @@
     (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) (limits '(0 10)))
   (lambda (msg scope)
     (let* ((val (getf (shape:data msg) :value))
            (newval (+ val (value scope)))

csys/environ.lisp

@@ -18,13 +18,14 @@
 (defvar *env* nil)
 
 (defclass scope (csys:scope)
-  ((cells :reader cells :initform (make-hash-table :test #'equal))))
+  ((spaces :reader spaces :initarg :spaces)))
 
-(defun create (proc meta-env &key eff-contacts)
+(defun create (proc meta-env &key eff-contacts (spaces '(:env :csys)))
   (let* ((prg (csys:make-program proc))
-         (scope (csys:scope prg meta-env :cls 'scope :categ '(:env :c00)))
+         (spcs (loop for d in spaces append (list d (index:create))))
+         (scope (csys:scope prg meta-env :cls 'scope :categ '(:env :c00) :spaces spcs))
          (env (csys:neuron scope)))
-    (create-contact-cells eff-contacts env (cells scope))
+    (create-contact-cells eff-contacts env (spaces scope))
     env))
 
 (defun simple-setup (cfg)
@@ -75,9 +76,9 @@
          (addr (getf data :addr (getf data :categ)))
          (new (getf data :new)))
     (when addr
-      (register-cell (cells scope) addr new))
+      (register-cell (spaces scope) addr new))
       (let* ((ct-addr (cons :env (cdr addr)))
-             (ct (find-cell (cells scope) ct-addr :no-warn t)))
+             (ct (find-cell (spaces scope) ct-addr :no-warn t)))
         (when ct (csys:send-connect new ct)))
     (csys:send-message new (list (message:domain msg) :next) data)
     nil))
@@ -85,7 +86,7 @@
 (defun forward (msg scope)
   (let ((addr (message:addr msg))) 
     (if addr 
-      (let ((cell (find-cell (cells scope) (message:addr msg)))) 
+      (let ((cell (find-cell (spaces scope) (message:addr msg)))) 
         (actor:send cell msg))
       (let ((rcvr (getf (shape:data msg) :to)))
         (if rcvr
@@ -97,7 +98,7 @@
   (let* ((data (shape:data msg))
          (tgt (getf data :target)))
     (when (listp tgt) 
-      (setf (getf data :target) (find-cell (cells scope) tgt)))
+      (setf (getf data :target) (find-cell (spaces scope) tgt)))
     (forward (message:create (shape:head msg) :data data) scope)))
 
 ;;;; public shortcuts
@@ -122,18 +123,14 @@
 ;;;; internal helpers
 
 (defun register-cell (reg addr cell)
-  (destructuring-bind (dom cat &optional (key "")) addr
+  (destructuring-bind (dom cat &optional (loc "")) addr
-    (let* ((categ (list dom cat))
+    (let ((idx (getf reg dom)))
-           (idx (gethash categ reg)))
+      (index:put idx loc cell))))
-      (unless idx
-        (setf idx (index:create))
-        (setf (gethash categ reg) idx))
-      (index:put idx key cell))))
 
 (defun find-cells (reg addr &key no-warn)
-  (destructuring-bind (dom cat &optional (key "")) addr
+  (destructuring-bind (dom cat &optional (loc "")) addr
-    (let* ((idx (gethash (list dom cat) reg))
+    (let* ((idx (getf reg dom))
-           (cells (when idx (index:query idx key))))
+           (cells (when idx (index:query idx loc))))
       (unless (or no-warn cells)
         (util:lgw "not found" addr reg idx))
       cells)))

csys/program/basic.lisp

@@ -11,7 +11,7 @@
 
 (in-package :scopes/csys/program/basic)
 
-;;;; basic-0: minimal recursive system
+;;;; basic-0: minimal recursive system - "self-inhibit"
 
 (defun prog-b0 ()
   (let ((val-action (csys:value-add :limits '(0)))) 
@@ -29,7 +29,7 @@
       (csys:send-switch self :active)
       nil)))
  
-;;;; basic-1: minimal cross-linked system
+;;;; basic-1: minimal cross-linked system - "distinction"
 
 (defun config-b1 ()
   (list (prog-b1) :zero-cat :s01
@@ -62,7 +62,7 @@
       (csys:send-switch self :active)
       nil)))
 
-;;;; basic-2: three-layer recursive system
+;;;; basic-2: three-layer recursive system - "delayed distinction"
 
 (defun config-b2 ()
   (list (prog-b2) :zero-cat :c02 :zero-val 2

shape/space.lisp

@@ -0,0 +1,22 @@
+;;;; cl-scopes/shape/space
+;;;; definitions for (spatial) registering and retrieving objects by location
+
+(defpackage :scopes/shape/space
+  (:use :common-lisp)
+  (:local-nicknames (:alx :alexandria))
+  (:export #:create #:put #:get #:query))
+
+(in-package :scopes/shape/space)
+
+(defun create ()
+  (make-hash-table :test #'equalp))
+
+(defun put (space key value)
+  (setf (gethash key space) value))
+
+(defun get (space key)
+  (gethash key space))
+
+(defun query (space pattern)
+  nil)
+

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-csys.lisp

@@ -89,8 +89,8 @@
 
 (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-0") 1) (sleep 0.0002)
-    (environ:send-value '(:s02 "1-1") 2) (sleep 0.0001)
+    (environ:send-value '(:s02 "1-1") 1) (sleep 0.0002)
     (environ:send-value '(:s02 "1-0") 2)
     (teardown)))