diff --git a/core/message.lisp b/core/message.lisp index 6a8faad..62bfdda 100644 --- a/core/message.lisp +++ b/core/message.lisp @@ -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))) diff --git a/csys/csys.lisp b/csys/csys.lisp index 73d29b8..77bfe57 100644 --- a/csys/csys.lisp +++ b/csys/csys.lisp @@ -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)) diff --git a/test/test-csys.lisp b/test/test-csys.lisp index e38e095..2148b7d 100644 --- a/test/test-csys.lisp +++ b/test/test-csys.lisp @@ -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)