diff --git a/csys/csys.lisp b/csys/csys.lisp index bafbbe6..5f07445 100644 --- a/csys/csys.lisp +++ b/csys/csys.lisp @@ -11,9 +11,8 @@ (:export #:scope #:environ #:make-program #:create-zero #:neuron #:std-proc #:eff-proc - #:handle-action #:forward #:notify - #:basic-actions #:merge-actions - #:no-op #:value-add #:create #:connect + #:handle-action #:basic-actions #:forward #:notify + #:no-op #:printer #:value-add #:create #:connect #:multiply #:send-create #:send-connect)) @@ -203,6 +202,9 @@ (message:create (list domain :connect) :data (list :target target :op op)))) +(defun printer () + (actor:create (lambda (msg) (print msg)))) + ;;;; internal helpers (defun new-msg-head (msg scope) diff --git a/csys/environ.lisp b/csys/environ.lisp index a68c427..c36197f 100644 --- a/csys/environ.lisp +++ b/csys/environ.lisp @@ -8,7 +8,7 @@ (:message :scopes/core/message) (:shape :scopes/shape) (:util :scopes/util)) - (:export #:create + (:export #:create #:simple-proc #:actions #:send-value #:send-connect)) @@ -17,10 +17,18 @@ (defclass scope (csys:scope) ((cells :reader cells :initform (make-hash-table :test #'equal)))) -(defun create (proc meta-env) +(defun create (proc &optional (meta-env (csys:printer))) + ;; + create contact cells (<- &key contact-cells) (let ((prg (csys:make-program proc))) (csys:neuron (csys:scope prg meta-env :cls 'scope :categ '(:env :c00))))) +(defun simple-proc (msg scope) + (util:mv-bind (nmsg (scope scope)) + (csys:handle-action msg scope :actions (actions)) + (util:lgi msg nmsg) + (when nmsg + (actor:send (env scope) nmsg)))) + ;;;; action handlers (defun actions () @@ -37,6 +45,8 @@ (new (getf data :new))) (when addr (register-cell (cells scope) addr new)) + ;; check: if corresponding env (contact) cell present? e.g. (:env :e00 "1-0") + ;; => connect ;(csys:send-message new (list (message:domain msg) :next) :data data) (actor:send new (message:create (list (message:domain msg) :next) :data data)) @@ -73,11 +83,11 @@ (defun register-cell (reg addr cell) (destructuring-bind (dom cat &optional (key "")) addr - (let* ((dcat (list dom cat)) - (idx (gethash dcat reg))) + (let* ((categ (list dom cat)) + (idx (gethash categ reg))) (unless idx (setf idx (index:create)) - (setf (gethash dcat reg) idx)) + (setf (gethash categ reg) idx)) (index:put idx key cell)))) (defun find-cells (reg addr) @@ -88,3 +98,9 @@ (util:lgw "not found" addr reg idx)) cells))) +(defun find-cell (reg addr) + (let ((cells (find-cells reg addr))) + (when (> (length cells) 1) + (util:lgw "more than one cell found" addr reg cells)) + (car cells))) + diff --git a/csys/program.lisp b/csys/program.lisp index cdee4c5..63f472f 100644 --- a/csys/program.lisp +++ b/csys/program.lisp @@ -41,7 +41,7 @@ (let ((self actor:*self*)) (csys:send-create self :cat :e00 :loc "1-0" :connect :succ) (csys:send-create self :cat :e00 :loc "1-1" :connect :succ :op (csys:multiply -1)) - (csys:send-create self :cat :s00 :stage :basic :loc "0-1") + (csys:send-create self :cat :s00 :loc "0-1" :stage :basic) ;; switch :active nil)))