;;;; 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 #:environment #:*environment* #:add-action #:add-sensor
           #:send #:send-message
           #:neuron #:synapse #:std-proc
           #:make-neuron #:update-neuron #:create-sensor
           #: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 :test #'equal))
   (sensors :reader sensors :initarg :sensors 
            :initform (make-hash-table :test #'equal :synchronized t))
   (procs :reader procs :initarg :procs
          :initform (make-hash-table :test #'equal))))

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

(defun add-action (key fn)
  ;(util:lgi key fn *environment*)
  (setf (gethash key (actions *environment*)) fn))

(defun add-sensor (key sn)
  (let ((sns (sensors *environment*)))
    (setf (gethash key sns) (adjoin sn (gethash key sns)))))

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

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

(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))
  (let ((proc (or proc (gethash :default (procs *environment*) #'std-proc)))
        (syns (if syn-target (list (synapse syn-target syn-op)) nil)))
    (actor:create (neuron proc state syns))))

(defun update-neuron (proc state syns)
  (actor:become (neuron proc state syns)))

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

;;;; neuron state methods

(defgeneric next-proc (state &optional default)
  (:method (state &optional (default #'std-proc)) default))

(defgeneric value (state)
  (:method (state) state))
 
 ;;;; 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)
  (dolist (sn (find-sensors msg)) 
    (actor:send sn msg)))

(defun find-sensors (msg)
  (let* ((key (message:object-key msg))
         (sns (gethash key (sensors *environment*))))
    ;(util:lgi key sns *environment*)
    sns))

;;;; effector procs for pseudo-neurons embedded in environment

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

;;;; helper / utility funtions

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

(defun handle-action (msg state syns &key (default #'no-op))
  (let* ((key (message:action-key msg))
         (act (gethash key (actions *environment*) default)))
    (funcall act msg state syns)))

;;;; predefined neuron actions

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

(defun remember (msg state syns)
  ;(list msg (make-neuron-state (shape:data msg) syns))
  (list msg (shape:data msg) syns))
 
(defun create-sensor (msg state syns)
  (let* ((key (cons (car (shape:head msg)) (shape:data msg)))
         (sensor (make-neuron actor:*self* :state key))
         (nmsg (message:create (list :csys :created (car key) (cadr key)))))
    (add-sensor key sensor)
    (list nmsg state syns)))

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