more csys refactoring (still in progress) with scope class, action handlers
This commit is contained in:
parent
8471173a99
commit
a20170368b
3 changed files with 40 additions and 16 deletions
|
|
@ -6,7 +6,7 @@
|
|||
(:shape :scopes/shape)
|
||||
(:util :scopes/util))
|
||||
(:export #:message-meta #:message #:create
|
||||
#:action-key #:object-key))
|
||||
#:action #:addr #:categ #:domain))
|
||||
|
||||
(in-package :scopes/core/message)
|
||||
|
||||
|
|
@ -29,11 +29,17 @@
|
|||
(defmethod actor:content ((msg message))
|
||||
(list (shape:head-plist msg) (shape:data msg)))
|
||||
|
||||
(defun action-key (msg)
|
||||
(defun action (msg)
|
||||
(let ((head (shape:head msg)))
|
||||
(list (car head) (cadr head))))
|
||||
|
||||
(defun object-key (msg)
|
||||
(defun addr (msg)
|
||||
(let ((head (shape:head msg)))
|
||||
(cons (car head) (cddr head))))
|
||||
|
||||
(defun categ (msg)
|
||||
(let ((head (shape:head msg)))
|
||||
(list (car head) (caddr head))))
|
||||
|
||||
(defun domain (msg)
|
||||
(car (shape:head msg)))
|
||||
|
|
|
|||
|
|
@ -18,29 +18,38 @@
|
|||
;;;; scope: information a neuron has access to
|
||||
|
||||
(defclass scope ()
|
||||
((value :reader value :initarg :value :initform 0)
|
||||
(stage :reader stage :initform :initial)
|
||||
(syns :reader syns :initform nil)
|
||||
((value :accessor value :initarg :value :initform 0)
|
||||
(params :accessor params :initarg :params :initform nil)
|
||||
(categ :accessor categ :initarg :categ :initform '(:csys :c00))
|
||||
(stage :accessor stage :initform :initial)
|
||||
(proc :accessor proc :initarg :proc :initform #'std-proc)
|
||||
(program :reader program :initarg :program :initform nil)
|
||||
(actions :reader actions :initarg :actions :initform nil)
|
||||
(syns :accessor syns :initform nil)
|
||||
(environ :reader environ :initarg :environ)))
|
||||
|
||||
(defun scope (&optional (program #'std-proc) &rest args)
|
||||
(apply #'make-instance 'scope :program program args))
|
||||
|
||||
(defun reset-scope (scope &rest args)
|
||||
(apply #'scope (program scope) :environ (environ scope) args))
|
||||
|
||||
;;;; neurons (= async tasks) and synapses (= connections)
|
||||
|
||||
(defun neuron (scope)
|
||||
(actor:create
|
||||
(lambda (msg) (funcall msg scope))))
|
||||
(actor:create (process scope)))
|
||||
|
||||
(defun synapse (rcvr &optional (op #'identity))
|
||||
(lambda (msg)
|
||||
(actor:send rcvr (funcall op msg))))
|
||||
|
||||
(defun update (scope)
|
||||
(actor:become
|
||||
(lambda (msg) (funcall msg scope))))
|
||||
(actor:become (process scope)))
|
||||
|
||||
;;;; message handlers, proc steps
|
||||
|
||||
(defun process (scope)
|
||||
(lambda (msg) (funcall (proc scope) msg scope)))
|
||||
|
||||
(defun std-proc (msg scope)
|
||||
;(util:lgi msg state syns env)
|
||||
|
|
@ -49,29 +58,39 @@
|
|||
(forward nmsg (syns nscope))
|
||||
(update nscope)))
|
||||
|
||||
|
||||
;;;; effector procs for pseudo-neurons embedded in environment
|
||||
(defun create (msg scope)
|
||||
(let ((new (neuron (reset scope))))
|
||||
(notify-created msg new scope)))
|
||||
|
||||
(defun do-log (msg scope)
|
||||
(util:lgi msg))
|
||||
|
||||
;;;; helper / utility funtions
|
||||
(defun notify (msg scope)
|
||||
(actor:send (environ scope) msg))
|
||||
|
||||
(defun forward (msg syns)
|
||||
(dolist (s syns)
|
||||
(funcall s msg)))
|
||||
|
||||
(defun handle-action (msg scope &key (default #'no-op))
|
||||
(let* ((key (message:action-key msg))
|
||||
(let* ((key (message:action msg))
|
||||
;(act (select-action msg state default))
|
||||
(act (gethash key (actions scope) default)))
|
||||
(funcall act msg scope)))
|
||||
|
||||
(defun notify-created (msg new scope)
|
||||
(let* ((head (list (car (shape:head msg)) :created))
|
||||
(data (list :new new :old actor:*self*)) ; todo: update existing data
|
||||
(msg1 (message:create head :data data)))
|
||||
(notify msg1 scope))
|
||||
)
|
||||
|
||||
;;;; predefined neuron actions
|
||||
|
||||
(defun no-op (msg scope)
|
||||
(list msg scope))
|
||||
|
||||
(defun remember (msg scope)
|
||||
(setf (value scope) (shape:data-value msg :value))
|
||||
;(list msg (make-neuron-state (shape:data msg) syns))
|
||||
(list msg (shape:data msg) syns))
|
||||
(list msg scope))
|
||||
|
|
|
|||
|
|
@ -68,7 +68,6 @@
|
|||
)
|
||||
|
||||
(deftest x-test-init ()
|
||||
(setup-test-init)
|
||||
(csys:send-message '(:csys :sensor :init :zero) '(:std :s1))
|
||||
(csys:send-message '(:csys :sensor :init :zero) '(:std :s2))
|
||||
(sleep 0.1)
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue