work in progress: csys:space; + minor improvements, todo comments, ...

core/actor.lisp

@@ -6,7 +6,7 @@
                     (:shape :scopes/shape)
                     (:util :scopes/util))
   (:export #:start #:stop #:create #:send #:become #:*self*
-           #:customer-message #:message #:content #:customer #:set-content
+           #:customer-message #:message #:content #:customer #:update-content
            #:*logger* #:*root*
            #:echo #:inc #:lgi
            #:calculator #:plus #:minus #:show))
@@ -22,7 +22,7 @@
   (:method (msg) nil))
 
 (defclass customer-message ()
-  ((customer :reader customer :initarg :customer :initform nil)))
+  ((customer :accessor customer :initarg :customer :initform nil)))
 
 (defclass message (customer-message)
   ((content :reader content :initarg :content :initform nil)))
@@ -30,7 +30,7 @@
 (defun message (content &optional customer)
   (make-instance 'message :content content :customer customer))
 
-(defgeneric set-content (msg fn)
+(defgeneric update-content (msg fn)
   (:documentation "Create a new message with content returned by calling `fn`
                    with the content of the input `msg`.")
   (:method (msg fn) (funcall fn msg))

core/message.lisp

@@ -29,6 +29,9 @@
 (defmethod actor:content ((msg message))
   (list (shape:head-plist msg) (shape:data msg)))
 
+(defmethod actor:update-content ((msg message) fn)
+  (create (shape:head msg) :data (fn (shape:data msg)) :customer (actor:customer msg)))
+
 (defun domain (msg)
   (car (shape:head msg)))
 

csys/csys.lisp

@@ -134,6 +134,7 @@
     (funcall s msg)))
 
 (defun notify (msg scope)
+  (setf (actor:customer msg) actor:*self*)
   (actor:send (environ scope) msg))
 
 ;;;; action handlers
@@ -182,6 +183,7 @@
       nil)))
 
 (defun connect ()
+  ;; TODO: target may be a list => check if already connected
   (lambda (msg scope)
     (let* ((data (shape:data msg))
            (syn (synapse (getf data :target) (getf data :op))))
@@ -197,8 +199,8 @@
       (values nil scope))))
 
 (defun retire (msg scope)
-  #+// (environ:unregister *self*)
-  #+// (environ:remove-pred-syns *self*)
+  #+// (environ:unregister actor:*self*)
+  #+// (environ:remove-pred-syns actor:*self*)
   (setf (stage scope) :retired)
   (setf (syns scope) nil)
   (setf (proc scope)
@@ -255,7 +257,7 @@
   
 (defun notify-created (msg new scope)
   (let* ((head (list (message:domain msg) :created))
-         (data (util:plist-merge (shape:data msg) `(:new ,new :parent ,actor:*self*)))
+         (data (util:plist-merge (shape:data msg) `(:new ,new)))
          (msg1 (message:create head :data data))) 
     (notify msg1 scope)))
 

csys/environ.lisp

@@ -97,6 +97,7 @@
   nil)
 
 (defun forward-connect (msg scope)
+  ;; TODO: target may be nil => replace with list of candidates
   (let* ((data (shape:data msg))
          (tgt (getf data :target)))
     (when (listp tgt) 
@@ -113,6 +114,7 @@
     (send-message head `(:value ,val) :env env)))
 
 (defun send-connect (rcvr target &key (domain csys:*domain*) (env *env*) op)
+  ;; TODO: use msg.customer instead of :to in data
   (let* ((cat-loc (when (listp rcvr) rcvr))
          (head (cons domain (cons :connect cat-loc)))
          (data (unless cat-loc (list :to rcvr))))

csys/program/basic.lisp

@@ -111,6 +111,7 @@
     (lambda (msg scope) 
       (let ((self actor:*self*)
             (environ:*env* (csys:environ scope)))
+        ;(environ:send-create self :cat :s02 :connect :pred) ;find loc -> csys:...
         (csys:send-create self :cat :s02 :loc #(1 1) :connect :pred)
         (csys:send-create self :cat :e02 :loc #(2 1) :connect :succ)
         (environ:send-connect self '(:c02 #(0 0)) :op op-inhibit)

csys/space.lisp

@@ -4,24 +4,35 @@
 (defpackage :scopes/csys/space
   (:use :common-lisp)
   (:local-nicknames (:alx :alexandria)
-                    (:util :scopes/util)
-                    )
-  (:export #:create #:put #:fetch #:query))
+                    (:util :scopes/util))
+  (:export #:create #:put #:del #:fetch #:query 
+           #:neighbors #:free-loc-at #:distance-sq))
 
 (in-package :scopes/csys/space)
 
 (defun create ()
   (make-hash-table :test #'equalp))
 
-(defun put (space key value)
-  (let ((current (gethash key space))) 
+(defun put (spc loc obj)
+  (let ((current (gethash loc spc))) 
     (if current
-      (util:lgw "location already occupied" space key current value)
-      (setf (gethash key space) value))))
+      ;(util:lgw "location already occupied" spc loc current obj)
+      (error "location already occupied! space: ~s, loc: ~s, current: ~s, new: ~s" 
+             spc loc current obj)
+      (setf (gethash loc spc) obj))))
 
-(defun fetch (space key)
-  (gethash key space))
+(defun del (spc loc)
+  (remhash loc spc))
 
-(defun query (space pattern)
+(defun fetch (spc loc)
+  (gethash loc spc))
+
+(defun query (spc pattern)
   nil)
 
+(defun neighbors (spc loc &key (dist 2)))
+
+(defun free-loc-at (spc loc &key (dist 2)))
+
+(defun distance-sq (spc loc1 loc2))
+

test/test-csys.lisp

@@ -78,12 +78,15 @@
 ;;;; test definitions
 
  (deftest test-space ()
-  (let ((idx (space:create)))
-    (space:put idx #(1 1) 42)
-    (space:put idx #(1 2) 46)
-    (space:put idx #(1 1) 43)
-    (== (space:fetch idx #(1 1)) 42)
-    (== (space:fetch idx #(1 2)) 46)
+  (let ((spc (space:create)))
+    (space:put spc #(1 1) 42)
+    (space:put spc #(1 2) 46)
+    (ignore-errors 
+      (space:put spc #(1 1) 43))
+    (== (space:fetch spc #(1 1)) 42)
+    (== (space:fetch spc #(1 2)) 46)
+    (space:del spc #(1 1))
+    (== (space:fetch spc #(1 1)) nil)
     ))
  
 (deftest test-basic-0 ()