;;;; 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
           #:send #:send-message #:*sensors* 
           #:neuron #:synapse
           #:logger))

(in-package :scopes/csys)

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

(defclass environment ()
  ((actions :reader actions :initarg :actions :initform (make-hash-table))))

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

(defun action (env key)
  (gethash key (actions env)))

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

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

(defvar *sensors* (make-hash-table :test #'equal))

(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-create-sensors msg)) 
      (actor:send sn msg))
    (core:handle-message core:*root* msg)))

(defun find-create-sensors (msg)
  (let* ((key (cddr (shape:head msg)))
         (sns (gethash key *sensors*)))
    (format t "~&~a ~a" key sns)
    (or sns
        (let* ((mx (message:create 
                     (list :csys :sensor (shape:head-value msg :class))))
               (hdlrs (core:select mx (core:actions core:*root*))))
          (if hdlrs
            (let ((tsks (mapcar #'actor:create hdlrs)))
              (setf (gethash key *sensors*) tsks))
            (util:lgw "no action selected" msg))))))

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

(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 logger (msg state syns env)
  (util:lgi msg state)
  (destructuring-bind (msg state syns) (handle-action msg state syns env)
    (forward msg syns)
    (actor:become (neuron #'logger (shape:data msg) syns env))))

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

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