;;;; 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))
  (:export #:actions
           #:forward))

(in-package :scopes/csys/environ)

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

;;;; action handlers, public callables

(defun actions () 
  '(:created #'cell-created
    :default #'csys:notify))

(defun cell-created (msg scope)
  (let* ((data (shape:data msg))
         (addr (getf data :addr)))
    (when addr
      (register-cell (cells scope) addr (getf data :new)))))

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

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

(defun register-cell (reg addr cell)
  (destructuring-bind (cat key) addr
    (let ((idx (getf cat reg)))
      (unless idx
        (setf idx (index:create))
        (setf (getf cat reg) idx))
      (index:put idx key cell))))

(defun find-cells (reg addr)
  (destructuring-bind (cat key) addr
    (let ((idx (getf cat reg)))
      (when idx
        (index:query idx key)))))