csys, work in progress: environ:actions
This commit is contained in:
parent
b7546b3c0f
commit
20ed5134e5
3 changed files with 21 additions and 16 deletions
|
|
@ -9,9 +9,10 @@
|
||||||
(:util :scopes/util)
|
(:util :scopes/util)
|
||||||
(:alx :alexandria))
|
(:alx :alexandria))
|
||||||
(:export #:scope #:environ
|
(:export #:scope #:environ
|
||||||
#:neuron #:synapse #:std-proc #:update #:create
|
|
||||||
#:make-prog
|
#:make-prog
|
||||||
#:handle-action))
|
#:neuron #:std-proc #:create
|
||||||
|
#:handle-action
|
||||||
|
#:notify))
|
||||||
|
|
||||||
(in-package :scopes/csys)
|
(in-package :scopes/csys)
|
||||||
|
|
||||||
|
|
@ -19,12 +20,12 @@
|
||||||
|
|
||||||
(defclass scope ()
|
(defclass scope ()
|
||||||
((value :accessor value :initarg :value :initform 0)
|
((value :accessor value :initarg :value :initform 0)
|
||||||
(params :accessor params :initarg :params :initform nil) ; <- program
|
;(params :accessor params :initarg :params :initform nil) ; <- program
|
||||||
(categ :accessor categ :initarg :categ :initform '(:csys :c00))
|
(categ :accessor categ :initarg :categ :initform '(:csys :c00))
|
||||||
(stage :accessor stage :initform :initial)
|
(stage :accessor stage :initform :initial)
|
||||||
(proc :accessor proc :initarg :proc :initform #'std-proc)
|
(proc :accessor proc :initarg :proc :initform #'std-proc)
|
||||||
(program :reader program :initarg :program :initform nil)
|
(program :reader program :initarg :program :initform nil)
|
||||||
(actions :accessor actions :initarg :actions :initform nil) ; <- program
|
;(actions :accessor actions :initarg :actions :initform nil) ; <- program
|
||||||
(syns :accessor syns :initform nil)
|
(syns :accessor syns :initform nil)
|
||||||
(environ :reader environ :initarg :environ)))
|
(environ :reader environ :initarg :environ)))
|
||||||
|
|
||||||
|
|
@ -43,8 +44,8 @@
|
||||||
(setf (proc scope) (funcall (program scope) scope))
|
(setf (proc scope) (funcall (program scope) scope))
|
||||||
scope)
|
scope)
|
||||||
|
|
||||||
(defun make-prog (fn)
|
(defgeneric make-prog (spec)
|
||||||
(lambda (scope) fn))
|
(:method ((fn function)) (lambda (scope) fn)))
|
||||||
|
|
||||||
;;;; neurons (= async tasks) and synapses (= connections)
|
;;;; neurons (= async tasks) and synapses (= connections)
|
||||||
|
|
||||||
|
|
@ -66,7 +67,7 @@
|
||||||
(defun std-proc (msg scope)
|
(defun std-proc (msg scope)
|
||||||
;(util:lgi msg state syns env)
|
;(util:lgi msg state syns env)
|
||||||
(destructuring-bind (nmsg nscope)
|
(destructuring-bind (nmsg nscope)
|
||||||
(handle-action msg scope :default #'remember)
|
(handle-action msg scope :default #'remember) ; + params, actions
|
||||||
(forward nmsg (syns nscope))
|
(forward nmsg (syns nscope))
|
||||||
(update nscope)))
|
(update nscope)))
|
||||||
|
|
||||||
|
|
@ -84,11 +85,11 @@
|
||||||
(dolist (s syns)
|
(dolist (s syns)
|
||||||
(funcall s msg)))
|
(funcall s msg)))
|
||||||
|
|
||||||
(defun handle-action (msg scope &key (default #'no-op))
|
(defun handle-action (msg scope &key (default #'no-op) actions params)
|
||||||
(let* ((key (message:action msg))
|
(let* ((key (message:action msg))
|
||||||
;(act (select-action msg state default))
|
;(act (gethash key (actions scope) default))
|
||||||
(act (gethash key (actions scope) default)))
|
(act (getf actions key default)))
|
||||||
(funcall act msg scope)))
|
(apply act msg scope params)))
|
||||||
|
|
||||||
(defun notify-created (msg new scope)
|
(defun notify-created (msg new scope)
|
||||||
(let* ((head (list (message:domain msg) :created))
|
(let* ((head (list (message:domain msg) :created))
|
||||||
|
|
|
||||||
|
|
@ -6,16 +6,20 @@
|
||||||
(:csys :scopes/csys)
|
(:csys :scopes/csys)
|
||||||
(:message :scopes/core/message)
|
(:message :scopes/core/message)
|
||||||
)
|
)
|
||||||
(:export #:forward)
|
(:export #:actions
|
||||||
)
|
#:forward))
|
||||||
|
|
||||||
(in-package :scopes/csys/environ)
|
(in-package :scopes/csys/environ)
|
||||||
|
|
||||||
(defclass scope (csys:scope)
|
(defclass scope (csys:scope)
|
||||||
((cells :reader cells :initarg :cells :initform (make-hash-table :test #'equal))))
|
((cells :reader cells :initform (make-hash-table :test #'equal))))
|
||||||
|
|
||||||
;;;; action handlers, public callables
|
;;;; action handlers, public callables
|
||||||
|
|
||||||
|
(defun actions ()
|
||||||
|
'(:created #'cell-created
|
||||||
|
:default #'csys:notify))
|
||||||
|
|
||||||
(defun cell-created (msg scope))
|
(defun cell-created (msg scope))
|
||||||
|
|
||||||
(defun forward-message (head scope &key data customer)
|
(defun forward-message (head scope &key data customer)
|
||||||
|
|
|
||||||
|
|
@ -35,8 +35,8 @@
|
||||||
)
|
)
|
||||||
|
|
||||||
(defun proc-env (msg scope)
|
(defun proc-env (msg scope)
|
||||||
(let ((t:*test-suite* (csys:environ scope)))
|
(let ((t:*test-suite* (csys:environ scope))) (destructuring-bind (nmsg scope)
|
||||||
(destructuring-bind (nmsg scope) (csys:handle-action msg scope)
|
(csys:handle-action msg scope :actions (environ:actions))
|
||||||
(util:lgi nmsg)
|
(util:lgi nmsg)
|
||||||
(actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg))))
|
(actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg))))
|
||||||
|
|
||||||
|
|
|
||||||
Loading…
Add table
Reference in a new issue