csys: add send-create shortcut
This commit is contained in:
parent
28e86a723a
commit
0a39d11add
3 changed files with 20 additions and 15 deletions
|
|
@ -14,7 +14,7 @@
|
||||||
#:handle-action #:forward #:notify
|
#:handle-action #:forward #:notify
|
||||||
#:basic-actions #:no-op #:value-add #:create #:connect
|
#:basic-actions #:no-op #:value-add #:create #:connect
|
||||||
#:multiply
|
#:multiply
|
||||||
#:send-connect))
|
#:send-create #:send-connect))
|
||||||
|
|
||||||
(in-package :scopes/csys)
|
(in-package :scopes/csys)
|
||||||
|
|
||||||
|
|
@ -52,6 +52,8 @@
|
||||||
(setf (proc scope) (funcall (program scope) scope))
|
(setf (proc scope) (funcall (program scope) scope))
|
||||||
scope)
|
scope)
|
||||||
|
|
||||||
|
;;;; system initialization
|
||||||
|
|
||||||
(defgeneric make-program (spec)
|
(defgeneric make-program (spec)
|
||||||
(:method ((proc function)) (lambda (scope) proc))
|
(:method ((proc function)) (lambda (scope) proc))
|
||||||
(:method ((spec list))
|
(:method ((spec list))
|
||||||
|
|
@ -181,11 +183,20 @@
|
||||||
|
|
||||||
;;;; public shortcuts
|
;;;; public shortcuts
|
||||||
|
|
||||||
|
(defun send-create (rcvr &rest args &key (domain :csys) (cat :c00) name connect op)
|
||||||
|
(let ((args+ (if name
|
||||||
|
`(:addr ,(list domain cat name))
|
||||||
|
`(:categ ,(list domain cat)))))
|
||||||
|
(setf args (alx:remove-from-plist :domain :cat :name))
|
||||||
|
(actor:send rcvr
|
||||||
|
(message:create (list domain :create) :data (append args+ args)))))
|
||||||
|
|
||||||
(defun send-connect (rcvr target &key op (domain :csys))
|
(defun send-connect (rcvr target &key op (domain :csys))
|
||||||
(actor:send rcvr
|
(actor:send rcvr
|
||||||
(message:create (list domain :connect)
|
(message:create (list domain :connect)
|
||||||
:data (list :target target :op op))))
|
:data (list :target target :op op))))
|
||||||
|
|
||||||
|
|
||||||
;;;; internal helpers
|
;;;; internal helpers
|
||||||
|
|
||||||
(defun new-msg-head (msg scope)
|
(defun new-msg-head (msg scope)
|
||||||
|
|
|
||||||
|
|
@ -36,9 +36,9 @@
|
||||||
(new (getf data :new)))
|
(new (getf data :new)))
|
||||||
(when addr
|
(when addr
|
||||||
(register-cell (cells scope) addr new))
|
(register-cell (cells scope) addr new))
|
||||||
;;;send :next message / create more cells:
|
;(csys:send-message new (list (message:domain msg) :next) :data data)
|
||||||
(actor:send new
|
(actor:send new
|
||||||
(message:create (list (message:domain msg) :next) :data (shape:data msg)))
|
(message:create (list (message:domain msg) :next) :data data))
|
||||||
nil))
|
nil))
|
||||||
|
|
||||||
(defun forward (msg scope)
|
(defun forward (msg scope)
|
||||||
|
|
|
||||||
|
|
@ -70,22 +70,15 @@
|
||||||
':default (csys:std-proc :actions (csys:basic-actions)))))
|
':default (csys:std-proc :actions (csys:basic-actions)))))
|
||||||
|
|
||||||
(defun actions-zero-initial ()
|
(defun actions-zero-initial ()
|
||||||
(let ((acts (csys:basic-actions)))
|
(util:plist-merge (list :next (next-zero-initial))
|
||||||
(setf (getf acts :next) (next-zero-initial))
|
(csys:basic-actions)))
|
||||||
acts))
|
|
||||||
|
|
||||||
(defun next-zero-initial ()
|
(defun next-zero-initial ()
|
||||||
(lambda (msg scope)
|
(lambda (msg scope)
|
||||||
(let ((self actor:*self*)
|
(let ((self actor:*self*))
|
||||||
(cr '(:csys :create :c00 "0-0"))
|
(csys:send-create self :cat :e01 :connect :succ)
|
||||||
(conn '(:csys :connect :c00 "0-0")))
|
(csys:send-create self :cat :s01 :name "0-1" :connect :pred)
|
||||||
(actor:send self
|
|
||||||
(message:create cr :data '(:categ (:csys :e01) :connect :succ)))
|
|
||||||
(actor:send self
|
|
||||||
(message:create cr :data '(:addr (:csys :s01 "0-1") :connect :pred)))
|
|
||||||
(csys:send-connect self self :op (csys:multiply -1))
|
(csys:send-connect self self :op (csys:multiply -1))
|
||||||
;(actor:send self
|
|
||||||
; (message:create conn :data (list :target self :op (csys:multiply -1))))
|
|
||||||
;; switch :active
|
;; switch :active
|
||||||
nil)))
|
nil)))
|
||||||
|
|
||||||
|
|
@ -96,6 +89,7 @@
|
||||||
(rcvr (tc:receiver t:*test-suite*)))
|
(rcvr (tc:receiver t:*test-suite*)))
|
||||||
(sleep 0.1)
|
(sleep 0.1)
|
||||||
;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1)))
|
;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1)))
|
||||||
|
;(environ:send-value 1 :cat :s01 :name "0-1")
|
||||||
(actor:send env (message:create '(:csys :value :s01 "0-1") :data '(:value 1)))
|
(actor:send env (message:create '(:csys :value :s01 "0-1") :data '(:value 1)))
|
||||||
(actor:send env (message:create '(:csys :value :s01 "0-1") :data '(:value 2)))
|
(actor:send env (message:create '(:csys :value :s01 "0-1") :data '(:value 2)))
|
||||||
(sleep 0.1)
|
(sleep 0.1)
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue