103 lines
3.5 KiB
Common Lisp
103 lines
3.5 KiB
Common Lisp
;;;; cl-scopes/csys/program/basic - common and general csys program definitions
|
|
|
|
(defpackage :scopes/csys/program/basic
|
|
(:use :common-lisp)
|
|
(:local-nicknames (:actor :scopes/core/actor)
|
|
(:csys :scopes/csys)
|
|
(:environ :scopes/csys/environ)
|
|
(:message :scopes/core/message)
|
|
(:util :scopes/util))
|
|
(:export #:prog-b0 #:config-b1 #:config-b2))
|
|
|
|
(in-package :scopes/csys/program/basic)
|
|
|
|
;;;; basic-0: minimal recursive system
|
|
|
|
(defun prog-b0 ()
|
|
(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-b1 ()
|
|
(list (prog-b1) :zero-cat :s01
|
|
:eff-contacts '(:e01 ("1-0" "1-1"))))
|
|
|
|
(defun prog-b1 ()
|
|
(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*)
|
|
(environ:*env* (csys:environ scope))
|
|
(env (csys:environ scope)))
|
|
(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)))
|
|
|
|
;;;; basic-2: three-layer recursive system
|
|
|
|
(defun config-b2 ()
|
|
(list (prog-b2) :zero-cat :c02 :zero-val 2
|
|
:eff-contacts '(:e02 ("2-0" "2-1"))))
|
|
|
|
(defun prog-b2 ()
|
|
(let ((val-action (csys:value-add :bias 2)))
|
|
(csys:make-program
|
|
(list '(:c02 :initial) (csys:std-proc :value val-action :next (b2-next-zero))
|
|
'(:c02 :basic) (csys:std-proc :value val-action :next (b2-next-one))
|
|
'(:e02 :default) (csys:eff-proc)
|
|
':default (csys:std-proc)))))
|
|
|
|
(defun b2-next-zero ()
|
|
(lambda (msg 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)
|
|
;; switch :active
|
|
nil)))
|
|
|
|
(defun b2-next-one ()
|
|
(lambda (msg scope)
|
|
(let ((self actor:*self*)
|
|
(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 self '(:c02 "0-0") :op (csys:multiply -1))
|
|
(environ:send-connect '(:c02 "0-0") self :op (csys:multiply -1))
|
|
;; switch :active
|
|
nil)))
|
|
|
|
|