diff --git a/csys/csys.lisp b/csys/csys.lisp index 04aee41..316e8d7 100644 --- a/csys/csys.lisp +++ b/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))) diff --git a/csys/environ.lisp b/csys/environ.lisp index 43fdc9e..b78d9c5 100644 --- a/csys/environ.lisp +++ b/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 - (let* ((categ (list dom cat)) - (idx (gethash categ reg))) - (unless idx - (setf idx (index:create)) - (setf (gethash categ reg) idx)) - (index:put idx key cell)))) + (destructuring-bind (dom cat &optional (loc "")) addr + (let ((idx (getf reg dom))) + (index:put idx loc cell)))) (defun find-cells (reg addr &key no-warn) - (destructuring-bind (dom cat &optional (key "")) addr - (let* ((idx (gethash (list dom cat) reg)) - (cells (when idx (index:query idx key)))) + (destructuring-bind (dom cat &optional (loc "")) addr + (let* ((idx (getf reg dom)) + (cells (when idx (index:query idx loc)))) (unless (or no-warn cells) (util:lgw "not found" addr reg idx)) cells))) diff --git a/csys/program/basic.lisp b/csys/program/basic.lisp index 88d1bf9..8b47b80 100644 --- a/csys/program/basic.lisp +++ b/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 diff --git a/shape/space.lisp b/shape/space.lisp new file mode 100644 index 0000000..77b7d8a --- /dev/null +++ b/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) + diff --git a/space/space.lisp b/space/space.lisp deleted file mode 100644 index beb9d08..0000000 --- a/space/space.lisp +++ /dev/null @@ -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)) - - diff --git a/test/test-csys.lisp b/test/test-csys.lisp index 7ddba16..cc7a98a 100644 --- a/test/test-csys.lisp +++ b/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-1") 2) (sleep 0.0001) + (environ:send-value '(:s02 "1-0") 1) (sleep 0.0002) + (environ:send-value '(:s02 "1-1") 1) (sleep 0.0002) (environ:send-value '(:s02 "1-0") 2) (teardown)))