Compare commits
No commits in common. "b0488a8a1d2d8feec729185dc8172a8df6949c09" and "cd30c9226e4d46935b0947c3ed6bfd11ca30d3a8" have entirely different histories.
b0488a8a1d
...
cd30c9226e
3 changed files with 23 additions and 28 deletions
|
|
@ -14,7 +14,7 @@
|
|||
#:handle-action #:basic-actions #:forward #:notify
|
||||
#:no-op #:printer #:value-add #:create #:connect
|
||||
#:multiply
|
||||
#:send-message #:send-create #:send-connect))
|
||||
#:send-create #:send-connect))
|
||||
|
||||
(in-package :scopes/csys)
|
||||
|
||||
|
|
@ -117,7 +117,7 @@
|
|||
(when nmsg
|
||||
(setf (nth 1 (shape:head nmsg)) :effect)
|
||||
(forward nmsg (syns nscope))
|
||||
(unless (syns nscope) (notify nmsg nscope)))
|
||||
(notify nmsg nscope))
|
||||
(update nscope)))))
|
||||
|
||||
(defun handle-action (msg scope &key (default (no-op)) actions)
|
||||
|
|
@ -198,10 +198,13 @@
|
|||
`(:addr ,(list domain cat loc))
|
||||
`(:categ ,(list domain cat)))))
|
||||
(setf args (alx:remove-from-plist args :domain :cat :loc))
|
||||
(send-message cell (list domain :create) (append args+ args))))
|
||||
(actor:send cell
|
||||
(message:create (list domain :create) :data (append args+ args)))))
|
||||
|
||||
(defun send-connect (cell target &key op (domain :csys))
|
||||
(send-message cell (list domain :connect) (list :target target :op op)))
|
||||
(actor:send cell
|
||||
(message:create (list domain :connect)
|
||||
:data (list :target target :op op))))
|
||||
|
||||
(defun printer ()
|
||||
(actor:create (lambda (msg) (print msg))))
|
||||
|
|
|
|||
|
|
@ -8,15 +8,12 @@
|
|||
(:message :scopes/core/message)
|
||||
(:shape :scopes/shape)
|
||||
(:util :scopes/util))
|
||||
(:export #:*env*
|
||||
#:create #:simple-setup #:simple-proc
|
||||
(:export #:create #:simple-proc
|
||||
#:actions
|
||||
#:send-value #:send-connect))
|
||||
|
||||
(in-package :scopes/csys/environ)
|
||||
|
||||
(defvar *env* nil)
|
||||
|
||||
(defclass scope (csys:scope)
|
||||
((cells :reader cells :initform (make-hash-table :test #'equal))))
|
||||
|
||||
|
|
@ -27,18 +24,12 @@
|
|||
(create-contact-cells eff-contacts env (cells scope))
|
||||
env))
|
||||
|
||||
(defun simple-setup (cfg)
|
||||
(destructuring-bind (prg &key (zero-cat :c00) eff-contacts) cfg
|
||||
(let ((env (create #'simple-proc (csys:printer) :eff-contacts eff-contacts)))
|
||||
(csys:create-zero prg env :categ (list :csys zero-cat))
|
||||
env)))
|
||||
|
||||
(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 (csys:environ scope) nmsg))))
|
||||
(actor:send (env scope) nmsg))))
|
||||
|
||||
;;;; eff contact cells
|
||||
|
||||
|
|
@ -56,9 +47,8 @@
|
|||
(register-cell cells (list :env cat loc) ct)))))
|
||||
|
||||
(defun proc-contact (msg scope)
|
||||
(let ((head (copy-list (shape:head msg))))
|
||||
(setf (nth 3 head) (loc scope))
|
||||
(csys:send-message (csys:environ scope) head (shape:data msg))))
|
||||
(setf (nth 3 (shape:head msg)) (loc scope))
|
||||
(actor:send (csys:environ scope) msg))
|
||||
|
||||
;;;; action handlers
|
||||
|
||||
|
|
@ -79,7 +69,9 @@
|
|||
(let* ((ct-addr (cons :env (cdr addr)))
|
||||
(ct (find-cell (cells scope) ct-addr)))
|
||||
(when ct (csys:send-connect new ct)))
|
||||
(csys:send-message new (list (message:domain msg) :next) data)
|
||||
;(csys:send-message new (list (message:domain msg) :next) :data data)
|
||||
(actor:send new
|
||||
(message:create (list (message:domain msg) :next) :data data))
|
||||
nil))
|
||||
|
||||
(defun forward (msg scope)
|
||||
|
|
@ -101,8 +93,8 @@
|
|||
|
||||
;;;; public shortcuts
|
||||
|
||||
(defun send-value (cat-loc val &key (domain :csys) (env *env*))
|
||||
(let ((head (cons domain (cons :value cat-loc))))
|
||||
(defun send-value (env val &key (domain :csys) (cat :c00) (loc ""))
|
||||
(let ((head (list domain :value cat loc)))
|
||||
(actor:send env (message:create head :data `(:value ,val)))))
|
||||
|
||||
(defun send-connect (env &rest args &key (domain :csys) addr to target op)
|
||||
|
|
|
|||
|
|
@ -67,19 +67,19 @@
|
|||
;;;; test definitions
|
||||
|
||||
(deftest test-basic-0 ()
|
||||
(let ((environ:*env* (setup-test (list (program:basic-0)))))
|
||||
(let ((env (setup-test (list (program:basic-0)))))
|
||||
;(rcvr (tc:receiver t:*test-suite*))
|
||||
(sleep 0.1)
|
||||
;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1)))
|
||||
(environ:send-value '(:s01 "0-1") 1)
|
||||
(environ:send-value '(:s01 "0-1") 2)
|
||||
(environ:send-value env 1 :cat :s01 :loc "0-1")
|
||||
(environ:send-value env 2 :cat :s01 :loc "0-1")
|
||||
(sleep 0.1)
|
||||
(core:shutdown)))
|
||||
|
||||
(deftest test-basic-1 ()
|
||||
(let ((environ:*env* (setup-test (program:config-basic-1))))
|
||||
(let ((env (setup-test (program:config-basic-1))))
|
||||
(sleep 0.1)
|
||||
(environ:send-value '(:s00 "0-0") 1)
|
||||
(environ:send-value '(:s00 "0-1") 2)
|
||||
(environ:send-value env 1 :cat :s00 :loc "0-0")
|
||||
(environ:send-value env 2 :cat :s00 :loc "0-1")
|
||||
(sleep 0.1)
|
||||
(core:shutdown)))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue