Compare commits
2 commits
bc6205b3ce
...
0bf199388a
| Author | SHA1 | Date | |
|---|---|---|---|
| 0bf199388a | |||
| eaa006941e |
3 changed files with 39 additions and 24 deletions
|
|
@ -95,17 +95,29 @@
|
|||
|
||||
(defun forward-connect (msg scope)
|
||||
(let* ((data (shape:data msg))
|
||||
(tgt (car (find-cells (cells scope) (getf data :target)))))
|
||||
(setf (getf data :target) tgt)
|
||||
(tgt (getf data :target)))
|
||||
(when (listp tgt)
|
||||
(setf (getf data :target) (find-cell (cells scope) tgt)))
|
||||
(forward (message:create (shape:head msg) :data data) scope)))
|
||||
|
||||
;;;; public shortcuts
|
||||
|
||||
(defun send-value (cat-loc val &key (domain csys:*domain*) (env *env*))
|
||||
(defun send-value (cat-loc val &key (domain csys:*domain*) (env *env*) delay)
|
||||
(let ((head (cons domain (cons :value cat-loc))))
|
||||
(actor:send env (message:create head :data `(:value ,val)))))
|
||||
|
||||
(defun send-connect (env &rest args &key (domain csys:*domain*) addr to target op)
|
||||
(defun send-connect (rcvr target &key (domain csys:*domain*) (env *env*) op)
|
||||
(let* ((cat-loc (when (listp rcvr) rcvr))
|
||||
(head (cons domain (cons :connect cat-loc)))
|
||||
(data (unless cat-loc (list :to rcvr))))
|
||||
(when op (util:plist-add data :op op))
|
||||
(when (and (listp target) (< (length target) 3))
|
||||
(setf target (cons domain target)))
|
||||
(util:plist-add data :target target)
|
||||
(util:lgi rcvr target cat-loc head data)
|
||||
(actor:send env (message:create head :data data))))
|
||||
|
||||
(defun x-send-connect (env &rest args &key (domain csys:*domain*) to target op)
|
||||
(let ((head (list domain :connect)))
|
||||
(actor:send env (message:create head :data args))))
|
||||
|
||||
|
|
|
|||
|
|
@ -54,10 +54,13 @@
|
|||
(defun b1-next-one ()
|
||||
(lambda (msg scope)
|
||||
(let ((self actor:*self*)
|
||||
(environ:*env* (csys:environ scope))
|
||||
(env (csys:environ scope)))
|
||||
(environ:send-connect env :to self :target '(:csys :e01 "1-0")
|
||||
:op (csys:multiply -1))
|
||||
(environ:send-connect env :to self :target '(:csys :e01 "1-1"))
|
||||
(environ:send-connect self '(:e01 "1-0") :op (csys:multiply -1))
|
||||
;(environ:send-connect env :to self :target '(:csys :e01 "1-0")
|
||||
; :op (csys:multiply -1))
|
||||
;(environ:send-connect env :to self :target '(:csys :e01 "1-1"))
|
||||
(environ:send-connect self '(:e01 "1-1"))
|
||||
;; switch :active
|
||||
nil)))
|
||||
|
||||
|
|
@ -77,26 +80,23 @@
|
|||
|
||||
(defun b2-next-zero ()
|
||||
(lambda (msg scope)
|
||||
(let ((self actor:*self*)
|
||||
(env (csys:environ scope)))
|
||||
(let ((self actor:*self*))
|
||||
(csys:send-create self :cat :c02 :loc "0-1" :value 2 :stage :basic)
|
||||
(csys:send-create self :cat :s02 :loc "1-0" :connect :pred)
|
||||
(csys:send-create self :cat :e02 :loc "2-0" :connect :succ)
|
||||
;(environ:send-connect env :to self :target '(:csys :c02 "0-1") :op (csys:multiply -1))
|
||||
;; switch :active
|
||||
nil)))
|
||||
|
||||
(defun b2-next-one ()
|
||||
(lambda (msg scope)
|
||||
(let ((self actor:*self*)
|
||||
(env (csys:environ scope)))
|
||||
(env (csys:environ scope))
|
||||
(environ:*env* (csys:environ scope))
|
||||
(zero '(:csys :c02 "0-0")))
|
||||
(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 env :to self :target '(:csys :c02 "0-0")
|
||||
:op (csys:multiply -1))
|
||||
(actor:send env
|
||||
(message:create '(:csys :connect :c02 "0-0")
|
||||
:data (list :target '(:csys :c02 "0-1") :op (csys:multiply -1))))
|
||||
(environ:send-connect self '(:c02 "0-0") :op (csys:multiply -1))
|
||||
(environ:send-connect '(:c02 "0-0") self :op (csys:multiply -1))
|
||||
;; switch :active
|
||||
nil)))
|
||||
|
||||
|
|
|
|||
|
|
@ -52,7 +52,7 @@
|
|||
(test-basic-0)
|
||||
(test-basic-1)
|
||||
(test-basic-2)
|
||||
(sleep 0.1)
|
||||
(sleep 0.02)
|
||||
(tc:check-expected)
|
||||
(t:show-result))))
|
||||
|
||||
|
|
@ -71,26 +71,29 @@
|
|||
(deftest test-basic-0 ()
|
||||
(let ((environ:*env* (setup-test (list (basic:prog-b0)))))
|
||||
;(rcvr (tc:receiver t:*test-suite*))
|
||||
(sleep 0.1)
|
||||
(sleep 0.02)
|
||||
;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1)))
|
||||
(environ:send-value '(:s00 "0-1") 1)
|
||||
(environ:send-value '(:s00 "0-1") 2)
|
||||
(sleep 0.1)
|
||||
(sleep 0.03)
|
||||
(core:shutdown)))
|
||||
|
||||
(deftest test-basic-1 ()
|
||||
(let ((environ:*env* (setup-test (basic:config-b1))))
|
||||
(sleep 0.1)
|
||||
(sleep 0.02)
|
||||
(environ:send-value '(:s01 "0-0") 1)
|
||||
(environ:send-value '(:s01 "0-1") 2)
|
||||
(sleep 0.1)
|
||||
(sleep 0.03)
|
||||
(core:shutdown)))
|
||||
|
||||
(deftest test-basic-2 ()
|
||||
(let ((environ:*env* (setup-test (basic:config-b2))))
|
||||
(sleep 0.2)
|
||||
(sleep 0.02)
|
||||
(environ:send-value '(:s02 "1-0") 1)
|
||||
(environ:send-value '(:s02 "1-1") 1) ;; 2 => loop
|
||||
(sleep 0.1)
|
||||
(sleep 0.0001)
|
||||
(environ:send-value '(:s02 "1-1") 2) ;; 2 => loop
|
||||
(sleep 0.0001)
|
||||
(environ:send-value '(:s02 "1-0") 2) ;; stop loop
|
||||
(sleep 0.03)
|
||||
(core:shutdown)))
|
||||
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue