cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

csys, work in progress: program basic-1

Browse source
This commit is contained in:
Helmut Merz 2026-08-04 08:53:07 +02:00
parent e7b76391c2
commit 9a80b76eeb
3 changed files with 61 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

17
csys/environ.lisp
View file

@ -10,7 +10,7 @@
(:util :scopes/util))
(:export #:create
#:actions
#:send-value))
#:send-value #:send-connect))
(in-package :scopes/csys/environ)
@ -28,6 +28,7 @@
:notify (csys:no-op)
:effect (csys:no-op)
:value #'forward
:connect #'forward
:default (csys:no-op :no-forward t)))
(defun cell-created (msg scope)
@ -42,8 +43,14 @@
nil))
(defun forward (msg scope)
(dolist (cell (find-cells (cells scope) (message:addr msg)))
(actor:send cell msg))
(let ((addr (message:addr msg)))
(if addr
(dolist (cell (find-cells (cells scope) (message:addr msg)))
(actor:send cell msg))
(let ((rcvr (getf (shape:data msg) :to)))
(if rcvr
(actor:send rcvr msg)
(util:lgw "no addr and no :to field in message" msg scope)))))
nil)
;;;; public shortcuts
@ -52,6 +59,10 @@
(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)
(let ((head (list domain :connect)))
(actor:send env (message:create head args))))
;;;; internal helpers
(defun register-cell (reg addr cell)

46
csys/program.lisp
View file

@ -4,8 +4,9 @@
(:use :common-lisp)
(:local-nicknames (:actor :scopes/core/actor)
(:csys :scopes/csys)
(:environ :scopes/csys/environ)
(:util :scopes/util))
(:export #:basic-0))
(:export #:basic-0 #:basic-1))
(in-package :scopes/csys/program)
@ -13,15 +14,15 @@
(defun basic-0 ()
(csys:make-program
(list '(:c00 :initial) (csys:std-proc :actions (actions-zero-initial))
(list '(:c00 :initial) (csys:std-proc :actions (b0-actions-zero-initial))
'(:e01 :initial) (csys:eff-proc :actions (csys:basic-actions))
':default (csys:std-proc :actions (csys:basic-actions)))))
(defun actions-zero-initial ()
(defun b0-actions-zero-initial ()
(util:plist-merge (csys:basic-actions)
(list :next (next-zero-initial))))
(list :next (b0-next-zero-initial))))
(defun next-zero-initial ()
(defun b0-next-zero-initial ()
(lambda (msg scope)
(let ((self actor:*self*))
(csys:send-create self :cat :e01 :connect :succ)
@ -30,3 +31,38 @@
;; switch :active
nil)))
;;;; basic-1: minimal cross-linked system
(defun basic-1 ()
(csys:make-program
(list '(:s00 :initial) (csys:std-proc :actions (b1-zero-actions-initial))
'(:s00 :basic) (csys:std-proc :actions (b1-one-actions-basic))
'(:e00 :default) (csys:eff-proc :actions (csys:basic-actions))
':default (csys:std-proc :actions (csys:basic-actions)))))
(defun b1-zero-actions-initial ()
(util:plist-merge (csys:basic-actions)
(list :next (b1-next-zero-initial))))
(defun b1-next-zero-initial ()
(lambda (msg scope)
(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")
;; switch :active
nil)))
(defun b1-one-actions-basic ()
(util:plist-merge (csys:basic-actions)
(list :next (b1-next-one-basic))))
(defun b1-next-one-basic ()
(lambda (msg scope)
(let ((self actor:*self*)
(env (env scope)))
(environ:send-connect env :to self :target '(:csys :e00 "1-0")
:op (csys:multiply -1))
(environ:send-connect env :to self :target '(:csys :e00 "1-1"))
;; switch :active
nil)))

12
test/test-csys.lisp
View file

@ -52,20 +52,20 @@
(tc:check-expected)
(t:show-result))))
(defun setup-test (prg)
(defun setup-test (prg &key (zero-cat :c00))
(setup-config)
(core:setup-services)
(let* ((recv (core:find-service :test-receiver))
(let* ((rcvr (core:find-service :test-receiver))
(env (environ:create #'proc-env t:*test-suite*)))
(setf (tc:receiver t:*test-suite*) recv)
(csys:create-zero prg env)
(setf (tc:receiver t:*test-suite*) rcvr)
(csys:create-zero prg env :categ (list :csys zero-cat))
env))
;;;; test definitions
(deftest test-basic-0 ()
(let ((env (setup-test (program:basic-0)))
(rcvr (tc:receiver t:*test-suite*)))
(let ((env (setup-test (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 env 1 :cat :s01 :loc "0-1")