;;;; 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)))