65 lines
1.8 KiB
Common Lisp
65 lines
1.8 KiB
Common Lisp
;;;; 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))
|
|
msg))
|
|
|
|
(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)))))
|
|
|