csys: parameterize program config; space:put: check if location already occpied

csys/csys.lisp

@@ -14,7 +14,7 @@
            #:neuron #:std-proc #:eff-proc
            #:handle-action #:basic-actions #:forward #:notify
            #:no-op #:printer #:value-add #:create #:connect
-           #:modify-value #:multiply #:divide
+           #:modify-value #:add #:multiply
            #:send-message #:send-create #:send-connect #:send-switch))
 
 (in-package :scopes/csys)
@@ -216,11 +216,11 @@
       (setf (getf data :value) (apply fn (getf data :value 0) args))
       (message:create (shape:head msg) :data data))))
 
-(defun multiply (n)
+(defun add (n)
-  (modify-value #'* n))
+  (modify-value #'+))
 
-(defun divide (n)
+(defun multiply (n)
-  (modify-value #'floor n))
+  (modify-value (lambda (val) (floor (* val n)))))
 
 ;;;; public shortcuts
 

csys/environ.lisp

@@ -130,7 +130,7 @@
       (space:put idx loc cell))))
 
 (defun find-cell (reg addr &key no-warn)
-  (destructuring-bind (dom cat loc) addr
+  (destructuring-bind (dom cat &optional loc) addr
     (let* ((idx (getf reg dom))
            (cell (space:fetch idx loc)))
       (unless (or no-warn cell)

csys/program/basic.lisp

@@ -7,7 +7,7 @@
                     (:environ :scopes/csys/environ)
                     (:message :scopes/core/message)
                     (:util :scopes/util))
-  (:export #:prog-b0 #:config-b1 #:config-b2))
+  (:export #:prog-b0 #:config-b1 #:config-b2 #:config-b2a))
 
 (in-package :scopes/csys/program/basic)
 
@@ -32,7 +32,7 @@
 ;;;; basic-1: minimal cross-linked system - "distinction"
 
 (defun config-b1 ()
-  (let* ((ops (list :inhibit (csys:divide -1)))
+  (let* ((ops (list :inhibit (csys:multiply -1)))
          (std (list :bias 0 :cat :s01 :ops ops))
          (eff (list :bias 2))
          (cfg (list :std std :eff eff)))
@@ -75,9 +75,9 @@
 
 ;;;; basic-2: three-layer recursive system - "delayed distinction"
 
-(defun config-b2 ()
+(defun config-b2 (&key (threshold 1) (bias 2) (op-inhibit (csys:multiply -1)))
-  (let* ((ops (list :inhibit (csys:divide -1)))
+  (let* ((ops (list :inhibit op-inhibit))
-         (std (list :bias 2 :cat :c02 :ops ops))
+         (std (list :threshold threshold :bias bias :cat :c02 :ops ops))
          (cfg (list :std std))) 
     (list (prog-b2 cfg) :std std
           :contacts '(:e02 (#(2 0) #(2 1))))))
@@ -117,3 +117,9 @@
         (environ:send-connect '(:c02 #(0 0)) self :op op-inhibit)
         (csys:send-switch self :active)
         nil))))
+
+;;;; basic-2 variations: basic-2 with changed params
+
+(defun config-b2a ()
+  (config-b2 :threshold 4 :bias 7 :op-inhibit (csys:multiply -1/2)))
+

csys/space.lisp

@@ -3,7 +3,9 @@
 
 (defpackage :scopes/csys/space
   (:use :common-lisp)
-  (:local-nicknames (:alx :alexandria))
+  (:local-nicknames (:alx :alexandria)
+                    (:util :scopes/util)
+                    )
   (:export #:create #:put #:fetch #:query))
 
 (in-package :scopes/csys/space)
@@ -12,7 +14,10 @@
   (make-hash-table :test #'equalp))
 
 (defun put (space key value)
-  (setf (gethash key space) value))
+  (let ((current (gethash key space))) 
+    (if current
+      (util:lgw "location already occupied" space key current value)
+      (setf (gethash key space) value))))
 
 (defun fetch (space key)
   (gethash key space))

scratch.lisp

@@ -12,11 +12,14 @@
 (add-package-local-nickname :environ :scopes/csys/environ)
 (add-package-local-nickname :message :scopes/core/message)
 (add-package-local-nickname :shape :scopes/shape)
+(add-package-local-nickname :space :scopes/csys/space)
 
 (scopes/util/async:init)
-(setf environ:*env* (environ:simple-setup (basic:config-b2)))
 
-;(environ:send-value '(:s02 "1-0") 2)
+;(setf environ:*env* (environ:simple-setup (basic:config-b2)))
+(setf environ:*env* (environ:simple-setup (basic:config-b2a)))
+
+;(environ:send-value '(:s02 #(1 0)) 2)
 
 ;;;; iterator experiments - obsolete?
 

test/test-csys.lisp

@@ -82,7 +82,7 @@
     (space:put idx #(1 1) 42)
     (space:put idx #(1 2) 46)
     (space:put idx #(1 1) 43)
-    (== (space:fetch idx #(1 1)) 43)
+    (== (space:fetch idx #(1 1)) 42)
     (== (space:fetch idx #(1 2)) 46)
     ))