;;;; cl-scopes/csys - concurrent cybernetic communication systems

(defpackage :scopes/csys
  (:use :common-lisp)
  (:local-nicknames (:actor :scopes/core/actor)
                    (:config :scopes/config)
                    (:message :scopes/core/message)
                    (:shape :scopes/shape)
                    (:util :scopes/util)
                    (:alx :alexandria))
  (:export #:scope #:environ
           #:make-program
           #:neuron #:std-proc #:create
           #:handle-action
           #:notify))

(in-package :scopes/csys)

;;;; scope: information a neuron has access to

(defclass scope ()
  ((value :accessor value :initarg :value :initform 0)
   ;(params :accessor params :initarg :params :initform nil)     ; <- program
   (categ :accessor categ :initarg :categ :initform '(:csys :c00))
   (stage :accessor stage :initarg :stage :initform :initial)
   (proc :accessor proc)
   (program :reader program :initarg :program)
   ;(actions :accessor actions :initarg :actions :initform nil)  ; <- program
   (syns :accessor syns :initform nil)
   (environ :reader environ :initarg :environ)))

(defun scope (prg env &rest args &key (cls 'scope) &allow-other-keys)
  (remf args :cls)
  (apply #'make-instance cls :program prg :environ env args))

(defmethod initialize-instance :after ((sc scope) &key &allow-other-keys)
  (set-proc sc))

(defun reset-scope (scope &rest args)
  (apply #'scope 
         (getf args :program) (program scope) 
         (getf args :environ (environ scope))
         :categ (getf args :categ (categ scope))
         args))

(defun set-proc (scope)
  (setf (proc scope) (funcall (program scope) scope))
  scope)

(defgeneric make-program (spec)
  (:method ((fn function)) (lambda (scope) fn)))

;;;; neurons (= async tasks) and synapses (= connections)

(defun neuron (scope)
  (actor:create (process scope)))

(defun synapse (rcvr &optional (op #'identity))
  (lambda (msg)
    (actor:send rcvr (funcall op msg))))

(defun update (scope)
  (actor:become (process scope)))

;;;; message handlers, proc steps

(defun process (scope)
  (lambda (msg) (funcall (proc scope) msg scope)))

(defun std-proc (msg scope)
  ;(util:lgi msg state syns env)
  (destructuring-bind (nmsg nscope) 
        (handle-action msg scope :default #'remember) ; + params, actions
    (forward nmsg (syns nscope))
    (update nscope)))

(defun create (msg scope)
  (let ((new (neuron (apply #'reset-scope scope (shape:data msg)))))
    (notify-created msg new scope)))

(defun do-log (msg scope)
  (util:lgi msg))

(defun notify (msg scope)
  (actor:send (environ scope) msg))

(defun forward (msg syns)
  (dolist (s syns) 
    (funcall s msg)))

(defun handle-action (msg scope &key (default #'no-op) actions params)
  (let* ((key (message:action msg))
         ;(act (gethash key (actions scope) default))
         (act (getf actions key (getf actions :default default))))
    (apply act msg scope params)))

(defun notify-created (msg new scope)
  (let* ((head (list (message:domain msg) :created))
         (data (util:plist-merge (shape:data msg) '(:new new :parent actor:*self*)))
         (msg1 (message:create head :data data))) 
    (notify msg1 scope))
  )

;;;; predefined neuron actions

(defun no-op (msg scope)
  (list msg scope))

(defun remember (msg scope)
  (setf (value scope) (shape:data-value msg :value))
  ;(list msg (make-neuron-state (shape:data msg) syns))
  (list msg scope))