;;;; 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)))
      (environ:send-connect self '(:e01 "1-0") :op (csys:multiply -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*)
          (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))
      ;; switch :active
      nil)))