Compare commits
No commits in common. "20ed5134e51f36e24760f7f6aa3bf87a5ca7dc55" and "8e784b59600c6f7a12c20a2cb19c1200e10ed6de" have entirely different histories.
20ed5134e5
...
8e784b5960
6 changed files with 26 additions and 49 deletions
|
|
@ -6,7 +6,7 @@
|
|||
(:shape :scopes/shape)
|
||||
(:util :scopes/util))
|
||||
(:export #:message-meta #:message #:create
|
||||
#:action #:addr #:categ #:domain #:dom-act))
|
||||
#:action #:addr #:categ #:domain))
|
||||
|
||||
(in-package :scopes/core/message)
|
||||
|
||||
|
|
@ -29,13 +29,7 @@
|
|||
(defmethod actor:content ((msg message))
|
||||
(list (shape:head-plist msg) (shape:data msg)))
|
||||
|
||||
(defun domain (msg)
|
||||
(car (shape:head msg)))
|
||||
|
||||
(defun action (msg)
|
||||
(cadr (shape:head msg)))
|
||||
|
||||
(defun dom-act (msg)
|
||||
(let ((head (shape:head msg)))
|
||||
(list (car head) (cadr head))))
|
||||
|
||||
|
|
@ -46,3 +40,6 @@
|
|||
(defun categ (msg)
|
||||
(let ((head (shape:head msg)))
|
||||
(list (car head) (caddr head))))
|
||||
|
||||
(defun domain (msg)
|
||||
(car (shape:head msg)))
|
||||
|
|
|
|||
|
|
@ -9,10 +9,8 @@
|
|||
(:util :scopes/util)
|
||||
(:alx :alexandria))
|
||||
(:export #:scope #:environ
|
||||
#:make-prog
|
||||
#:neuron #:std-proc #:create
|
||||
#:handle-action
|
||||
#:notify))
|
||||
#:neuron #:synapse #:std-proc #:update #:create
|
||||
#:handle-action))
|
||||
|
||||
(in-package :scopes/csys)
|
||||
|
||||
|
|
@ -20,32 +18,23 @@
|
|||
|
||||
(defclass scope ()
|
||||
((value :accessor value :initarg :value :initform 0)
|
||||
;(params :accessor params :initarg :params :initform nil) ; <- program
|
||||
(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) ; <- program
|
||||
(actions :accessor actions :initarg :actions :initform nil)
|
||||
(syns :accessor syns :initform nil)
|
||||
(environ :reader environ :initarg :environ)))
|
||||
|
||||
(defun scope (&optional (program (make-prog #'std-proc)) &rest args)
|
||||
(let ((sc (apply #'make-instance 'scope :program program args)))
|
||||
(set-proc sc)))
|
||||
(defun scope (&optional (program #'std-proc) &rest args)
|
||||
(apply #'make-instance 'scope :program program args))
|
||||
|
||||
(defun reset-scope (scope &rest args)
|
||||
(let ((sc (apply #'scope (or (getf args :program) (program scope))
|
||||
(apply #'scope (or (getf args :program) (program scope))
|
||||
:categ (or (getf args :categ) (categ scope))
|
||||
:environ (or (getf args :environ) (environ scope))
|
||||
args)))
|
||||
(set-proc sc)))
|
||||
|
||||
(defun set-proc (scope)
|
||||
(setf (proc scope) (funcall (program scope) scope))
|
||||
scope)
|
||||
|
||||
(defgeneric make-prog (spec)
|
||||
(:method ((fn function)) (lambda (scope) fn)))
|
||||
args))
|
||||
|
||||
;;;; neurons (= async tasks) and synapses (= connections)
|
||||
|
||||
|
|
@ -67,7 +56,7 @@
|
|||
(defun std-proc (msg scope)
|
||||
;(util:lgi msg state syns env)
|
||||
(destructuring-bind (nmsg nscope)
|
||||
(handle-action msg scope :default #'remember) ; + params, actions
|
||||
(handle-action msg scope :default #'remember)
|
||||
(forward nmsg (syns nscope))
|
||||
(update nscope)))
|
||||
|
||||
|
|
@ -85,11 +74,11 @@
|
|||
(dolist (s syns)
|
||||
(funcall s msg)))
|
||||
|
||||
(defun handle-action (msg scope &key (default #'no-op) actions params)
|
||||
(defun handle-action (msg scope &key (default #'no-op))
|
||||
(let* ((key (message:action msg))
|
||||
;(act (gethash key (actions scope) default))
|
||||
(act (getf actions key default)))
|
||||
(apply act msg scope params)))
|
||||
;(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))
|
||||
|
|
|
|||
|
|
@ -6,20 +6,16 @@
|
|||
(:csys :scopes/csys)
|
||||
(:message :scopes/core/message)
|
||||
)
|
||||
(:export #:actions
|
||||
#:forward))
|
||||
(:export #:forward #:forward-message)
|
||||
)
|
||||
|
||||
(in-package :scopes/csys/environ)
|
||||
|
||||
(defclass scope (csys:scope)
|
||||
((cells :reader cells :initform (make-hash-table :test #'equal))))
|
||||
(cells :reader cells :initarg :cells :initform (make-hash-table :test #'equal)))
|
||||
|
||||
;;;; action handlers, public callables
|
||||
|
||||
(defun actions ()
|
||||
'(:created #'cell-created
|
||||
:default #'csys:notify))
|
||||
|
||||
(defun cell-created (msg scope))
|
||||
|
||||
(defun forward-message (head scope &key data customer)
|
||||
|
|
|
|||
|
|
@ -125,7 +125,6 @@
|
|||
(index:put idx "1-1" 43)
|
||||
(== (index:query idx "1-1") '(43 42))
|
||||
(== (index:query idx "1-2") '(46))
|
||||
(== (index:query idx "*") '(46 43 42))
|
||||
))
|
||||
|
||||
(deftest test-shape ()
|
||||
|
|
|
|||
|
|
@ -35,8 +35,8 @@
|
|||
)
|
||||
|
||||
(defun proc-env (msg scope)
|
||||
(let ((t:*test-suite* (csys:environ scope))) (destructuring-bind (nmsg scope)
|
||||
(csys:handle-action msg scope :actions (environ:actions))
|
||||
(let ((t:*test-suite* (csys:environ scope)))
|
||||
(destructuring-bind (nmsg scope) (csys:handle-action msg scope)
|
||||
(util:lgi nmsg)
|
||||
(actor:send (core:mailbox (tc:receiver t:*test-suite*)) nmsg))))
|
||||
|
||||
|
|
@ -56,8 +56,7 @@
|
|||
(core:setup-services)
|
||||
(setf (tc:receiver t:*test-suite*) (core:find-service :test-receiver))
|
||||
;(csys:add-action '(:csys :sensor) #'csys:create-sensor)
|
||||
(let* ((prog (csys:make-prog #'proc-env))
|
||||
(env (csys:neuron (csys:scope prog
|
||||
(let ((env (csys:neuron (csys:scope #'proc-env
|
||||
:environ (tc:receiver t:*test-suite*)))))
|
||||
;(csys:create) ; or: (environ:setup program:basic-0 #'proc-env)
|
||||
))
|
||||
|
|
|
|||
|
|
@ -4,7 +4,6 @@
|
|||
|
||||
(defpackage :scopes/util/index
|
||||
(:use :common-lisp)
|
||||
(:local-nicknames (:alx :alexandria))
|
||||
(:export #:create #:put #:query))
|
||||
|
||||
(in-package :scopes/util/index)
|
||||
|
|
@ -21,8 +20,6 @@
|
|||
(cur (gethash key data)))
|
||||
(setf (gethash key data) (cons value cur)))))
|
||||
|
||||
(defgeneric query (idx pat)
|
||||
(:method ((idx index) pat)
|
||||
(if (equal pat "*")
|
||||
(alx:flatten (alx:hash-table-values (data idx)))
|
||||
(gethash pat (data idx)))))
|
||||
(defgeneric query (idx key)
|
||||
(:method ((idx index) key)
|
||||
(gethash key (data idx))))
|
||||
|
|
|
|||
Loading…
Add table
Reference in a new issue