61 lines
2 KiB
Common Lisp
61 lines
2 KiB
Common Lisp
;;;; cl-scopes/csys/program - common and general csys program definitions
|
|
|
|
(defpackage :scopes/csys/program
|
|
(:use :common-lisp)
|
|
(:local-nicknames (:actor :scopes/core/actor)
|
|
(:csys :scopes/csys)
|
|
(:environ :scopes/csys/environ)
|
|
(:util :scopes/util))
|
|
(:export #:basic-0 #:config-basic-1))
|
|
|
|
(in-package :scopes/csys/program)
|
|
|
|
;;;; basic-0: minimal recursive system
|
|
|
|
(defun basic-0 ()
|
|
(csys:make-program
|
|
(list '(:c00 :initial) (csys:std-proc :next (b0-next-zero))
|
|
'(:e00 :initial) (csys:eff-proc)
|
|
':default (csys:std-proc))))
|
|
|
|
(defun b0-next-zero ()
|
|
(lambda (msg scope)
|
|
(let ((self actor:*self*))
|
|
(csys:send-create self :cat :e00 :connect :succ)
|
|
(csys:send-create self :cat :s00 :loc "0-1" :connect :pred)
|
|
(csys:send-connect self self :op (csys:multiply -1))
|
|
;; switch :active
|
|
nil)))
|
|
|
|
;;;; basic-1: minimal cross-linked system
|
|
|
|
(defun config-basic-1 ()
|
|
(list (basic-1) :zero-cat :s01
|
|
:eff-contacts '(:e01 ("1-0" "1-1"))))
|
|
|
|
(defun basic-1 ()
|
|
(csys:make-program
|
|
(list '(:s01 :initial) (csys:std-proc :next (b1-next-zero))
|
|
'(:s01 :basic) (csys:std-proc :next (b1-next-one))
|
|
'(:e01 :default) (csys:eff-proc :value (csys:value-add :bias 2))
|
|
':default (csys:std-proc))))
|
|
|
|
(defun b1-next-zero ()
|
|
(lambda (msg scope)
|
|
(let ((self actor:*self*))
|
|
(csys:send-create self :cat :e01 :loc "1-0" :value 2 :connect :succ)
|
|
(csys:send-create self :cat :e01 :loc "1-1" :value 2
|
|
:connect :succ :op (csys:multiply -1))
|
|
(csys:send-create self :cat :s01 :loc "0-1" :stage :basic)
|
|
;; switch :active
|
|
nil)))
|
|
|
|
(defun b1-next-one ()
|
|
(lambda (msg scope)
|
|
(let ((self actor:*self*)
|
|
(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"))
|
|
;; switch :active
|
|
nil)))
|