;;;; cl-scopes/csys/environ - communication system environment

(defpackage :scopes/csys/environ
  (:use :common-lisp)
  (:local-nicknames (:actor :scopes/core/actor)
                    (:csys :scopes/csys)
                    (:index :scopes/util/index)
                    (:message :scopes/core/message)
                    (:shape :scopes/shape)
                    (:util :scopes/util))
  (:export #:create
           #:actions
           #:send-value))

(in-package :scopes/csys/environ)

(defclass scope (csys:scope)
  ((cells :reader cells :initform (make-hash-table :test #'equal))))

(defun create (proc meta-env)
  (let ((prg (csys:make-program proc)))
    (csys:neuron (csys:scope prg meta-env :cls 'scope :categ '(:env :c00)))))

;;;; action handlers

(defun actions () 
  (list :created #'cell-created
        :notify (csys:no-op)
        :effect (csys:no-op)
        :value #'forward
        :default (csys:no-op :no-forward t)))

(defun cell-created (msg scope)
  (let* ((data (shape:data msg))
         (addr (getf data :addr (getf data :categ)))
         (new (getf data :new)))
    (when addr
      (register-cell (cells scope) addr new))
    ;(csys:send-message new (list (message:domain msg) :next) :data data)
    (actor:send new 
      (message:create (list (message:domain msg) :next) :data data))
    nil))

(defun forward (msg scope)
  (dolist (cell (find-cells (cells scope) (message:addr msg))) 
    (actor:send cell msg))
  nil)

;;;; public shortcuts

(defun send-value (env val &key (domain :csys) (cat :c00) (name ""))
  (let ((head (list domain :value cat name)))
   (actor:send env (message:create head :data `(:value ,val)))))
 
;;;; internal helpers

(defun register-cell (reg addr cell)
  (destructuring-bind (dom cat &optional (key "")) addr
    (let* ((dcat (list dom cat))
           (idx (gethash dcat reg)))
      (unless idx
        (setf idx (index:create))
        (setf (gethash dcat reg) idx))
      (index:put idx key cell))))

(defun find-cells (reg addr)
  (destructuring-bind (dom cat &optional (key "")) addr
    (let ((idx (gethash (list dom cat) reg)))
      (when idx
        (index:query idx key)))))