114 lines
4.2 KiB
Common Lisp
114 lines
4.2 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 - "self-inhibit"
|
|
|
|
(defun prog-b0 ()
|
|
(let ((val-action (csys:value-add)))
|
|
(csys:make-program
|
|
(list '(:c00 :initial) (csys:std-proc :value val-action :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))
|
|
(csys:send-switch self :active)
|
|
nil)))
|
|
|
|
;;;; basic-1: minimal cross-linked system - "distinction"
|
|
|
|
(defun config-b1 ()
|
|
(let* ((ops (list :inhibit (csys:divide -1)))
|
|
(std (list :bias 0 :cat :s01 :ops ops))
|
|
(eff (list :bias 2))
|
|
(cfg (list :std std :eff eff)))
|
|
(list (prog-b1 cfg) :std std
|
|
:eff-contacts '(:e01 (#(1 0) #(1 1))))))
|
|
|
|
(defun prog-b1 (cfg)
|
|
(let* ((std (getf cfg :std))
|
|
(eff (getf cfg :eff))
|
|
(bias (getf eff :bias 0))
|
|
(val-action (csys:value-add :bias bias)))
|
|
(csys:make-program
|
|
(list '(:s01 :initial) (csys:std-proc :next (b1-next-zero std eff))
|
|
'(:s01 :basic) (csys:std-proc :next (b1-next-one std))
|
|
'(:e01 :default) (csys:eff-proc :value val-action)
|
|
':default (csys:std-proc)))))
|
|
|
|
(defun b1-next-zero (std eff)
|
|
(let ((bias (getf eff :bias 0))
|
|
(op-inhibit (getf (getf std :ops) :inhibit)))
|
|
(lambda (msg scope)
|
|
(let ((self actor:*self*))
|
|
(csys:send-create self :cat :e01 :loc #(1 0) :value bias :connect :succ)
|
|
(csys:send-create self :cat :e01 :loc #(1 1) :value bias
|
|
:connect :succ :op op-inhibit)
|
|
(csys:send-create self :cat :s01 :loc #(0 1) :stage :basic)
|
|
(csys:send-switch self :active)
|
|
nil))))
|
|
|
|
(defun b1-next-one (std)
|
|
(let ((op-inhibit (getf (getf std :ops) :inhibit)))
|
|
(lambda (msg scope)
|
|
(let ((self actor:*self*)
|
|
(environ:*env* (csys:environ scope)))
|
|
(environ:send-connect self '(:e01 #(1 0)) :op op-inhibit)
|
|
(environ:send-connect self '(:e01 #(1 1)))
|
|
(csys:send-switch self :active)
|
|
nil))))
|
|
|
|
;;;; basic-2: three-layer recursive system - "delayed distinction"
|
|
|
|
(defun config-b2 ()
|
|
(let* ((ops (list :inhibit (csys:divide -1)))
|
|
(std (list :bias 2 :cat :c02 :ops ops))
|
|
(cfg (list :std std)))
|
|
(list (prog-b2 cfg) :std std
|
|
:eff-contacts '(:e02 (#(2 0) #(2 1))))))
|
|
|
|
(defun prog-b2 (cfg)
|
|
(let* ((std (getf cfg :std))
|
|
(val-action (csys:value-add :bias 2)))
|
|
(csys:make-program
|
|
(list '(:c02 :initial)
|
|
(csys:std-proc :value val-action :next (b2-next-zero cfg))
|
|
'(:c02 :basic)
|
|
(csys:std-proc :value val-action :next (b2-next-one cfg))
|
|
'(:c02 :default) (csys:std-proc :value val-action)
|
|
'(:e02 :default) (csys:eff-proc)
|
|
':default (csys:std-proc)))))
|
|
|
|
(defun b2-next-zero (cfg)
|
|
(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)
|
|
(csys:send-switch self :active)
|
|
nil)))
|
|
|
|
(defun b2-next-one (cfg)
|
|
(lambda (msg scope)
|
|
(let ((self actor:*self*)
|
|
(environ:*env* (csys:environ scope)))
|
|
(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))
|
|
(csys:send-switch self :active)
|
|
nil)))
|