;;;; 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* #:actions #:set-action
           #:init-zero
           #:send #:send-message
           #:neuron #:synapse
           #:std-proc))

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

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

(defun action (env key &optional default)
  (gethash key (actions env) default))

(defun set-action (env key act)
  (setf (gethash key (actions env)) act))

;;;; sensors: automatically created actors (neuron), addressable via message head

(defun init-zero (probe)
  (set-action *environment* :sensor #'create-sensor)
  (let ((zero (actor:create (neuron #'std-proc 0 (list (synapse probe))))))
    (setf (gethash '(:init :zero) (sensors *environment*)) (list zero))))

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

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

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

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

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

(defun handle-action (msg state syns env &key default)
  (let* ((key (shape:head-value msg :action))
         (act (action env key default)))
    (funcall act msg state syns env)
    ;(or (and act (funcall act msg state syns env))
    ;(list msg state syns)))
))

;;;; predefined neuron actions

(defun no-op (msg state syns env)
  (list msg (shape:data msg) 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 (actor:create 
                  (neuron #'std-proc 0 (list (synapse actor:*self*))))))
    (setf (gethash key (sensors env)) (list sensor))
    (list msg state syns)))