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

(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))
         (new (getf data :new)))
    (when addr
      (register-cell (cells scope) addr new))
    ;;;send :next message / create more cells:
    (actor:send new 
      (message:create (list (message:domain msg) :next) :data (shape:data msg)))
    nil))

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

(defun register-cell (reg addr cell)
  (destructuring-bind (dom cat 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 key) addr
    (let ((idx (gethash (list dom cat) reg)))
      (when idx
        (index:query idx key)))))