98 lines
3 KiB
Common Lisp
98 lines
3 KiB
Common Lisp
;;;; cl-scopes/csys - concurrent cybernetic communication systems
|
|
|
|
(defpackage :scopes/csys
|
|
(:use :common-lisp)
|
|
(:local-nicknames (:actor :scopes/core/actor)
|
|
(:config :scopes/config)
|
|
(:message :scopes/core/message)
|
|
(:shape :scopes/shape)
|
|
(:util :scopes/util)
|
|
(:alx :alexandria))
|
|
(:export #:scope #:environ
|
|
#:neuron #:synapse #:std-proc #:update #:create
|
|
#:handle-action))
|
|
|
|
(in-package :scopes/csys)
|
|
|
|
;;;; scope: information a neuron has access to
|
|
|
|
(defclass scope ()
|
|
((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 :accessor 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 (or (getf args :program) (program scope))
|
|
:categ (or (getf args :categ) (categ scope))
|
|
:environ (or (getf args :environ) (environ scope))
|
|
args))
|
|
|
|
;;;; neurons (= async tasks) and synapses (= connections)
|
|
|
|
(defun neuron (scope)
|
|
(actor:create (process scope)))
|
|
|
|
(defun synapse (rcvr &optional (op #'identity))
|
|
(lambda (msg)
|
|
(actor:send rcvr (funcall op msg))))
|
|
|
|
(defun update (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)
|
|
(destructuring-bind (nmsg nscope)
|
|
(handle-action msg scope :default #'remember)
|
|
(forward nmsg (syns nscope))
|
|
(update nscope)))
|
|
|
|
(defun create (msg scope)
|
|
(let ((new (neuron (apply #'reset scope (shape:data msg)))))
|
|
(notify-created msg new scope)))
|
|
|
|
(defun do-log (msg scope)
|
|
(util:lgi msg))
|
|
|
|
(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 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 (message:domain msg) :created))
|
|
(data (util:plist-merge (shape:data scope) '(:new new :parent actor:*self*)))
|
|
(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 scope))
|