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

(defpackage :scopes/csys
  (:use :common-lisp)
  (:local-nicknames (:actor :scopes/core/actor)
                    (:async :scopes/util/async)
                    (:config :scopes/config)
                    (:core :scopes/core)
                    (:message :scopes/core/message)
                    (:shape :scopes/shape)
                    (:util :scopes/util)
                    (:alx :alexandria))
  (:export #:environment #:*environment* #:procs
           #:init
           #:send #:send-message
           #:neuron #:synapse
           #:make-neuron #:update-neuron 
           #:handle-action))

(in-package :scopes/csys)

;;;; environment: common information, with list of globally available actions

(defclass environment ()
  ((actions :reader actions :initarg :actions :initform (make-hash-table))
   (sensors :reader sensors :initarg :sensors 
            :initform (make-hash-table :test #'equal))
   (procs :reader procs :initarg :procs
          :initform (make-hash-table :test #'equal))))

(defvar *environment* (make-instance 'environment))

(defun init ()
  (setf (gethash :sensor (actions *environment*)) #'create-sensor)
  (setf (gethash :default (procs *environment*)) #'std-proc)
  (let* ((eff-proc (gethash '(:effect :default) (procs *environment*) #'std-proc))
         (zero (make-neuron nil :proc eff-proc))) 
    (setf (gethash '(:init :zero) (sensors *environment*)) (list zero))))

;;;; sensors: neurons receiving messages from environment, addressable via message head

(defun send-message (head data &key customer)
  (send (message:create head :data data :customer customer)))

(defun send (msg)
  (if (eq (shape:head-value msg :domain) :csys)
    (dolist (sn (find-sensors msg)) 
      (actor:send sn msg))
    (core:handle-message core:*root* msg)))

(defun find-sensors (msg)
  (let* ((key (cddr (shape:head msg)))
         (sns (gethash key (sensors *environment*))))
    (util:lgi key sns)
    sns))

;;;; detectors: pseudo-neurons embedded in environment, addressable via message head

(defun do-log (msg state syns env)
  (util:lgi msg))

;;;; neurons (= behavior factories) and synapses (connection factories)

(defun neuron (proc &optional state syns (env *environment*))
  (lambda (msg) 
    (funcall proc msg state syns env)))

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

(defun make-neuron (syn-target &key proc state 
                                    (syn-op #'identity) (env *environment*))
  (let ((proc (or proc (gethash :default (procs env) #'std-proc)))
        (syns (if syn-target (list (synapse syn-target syn-op)) nil)))
    (actor:create (neuron proc state syns env))))

(defun update-neuron (proc state syns &optional (env *environment*))
  (actor:become (neuron proc state syns env)))

;;;; predefined neuron processors and helper / utility funtions

(defun std-proc (msg state syns env)
  ;(util:lgi msg state)
  (destructuring-bind (nmsg nst nsyns) 
        (handle-action msg state syns env :default #'remember)
    (forward nmsg nsyns)
    (update-neuron #'std-proc nst nsyns env)))

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

(defun handle-action (msg state syns env &key (default #'no-op))
  (let* ((key (shape:head-value msg :action))
         (act (gethash key (actions env) default)))
    (funcall act msg state syns env)))

;;;; predefined neuron actions

(defun no-op (msg state syns env)
  (list msg state syns))

(defun remember (msg state syns env)
  (list msg (shape:data msg) syns))
 
(defun create-sensor (msg state syns env)
  (let* ((key (shape:data msg))
         (sensor (make-neuron actor:*self* :state key)))
    (setf (gethash key (sensors env)) (list sensor))
    (list msg state syns)))

(defun add (msg state syns env)
  (list msg (+ (shape:data msg) state) syns env))