Compare commits

..

No commits in common. "20ed5134e51f36e24760f7f6aa3bf87a5ca7dc55" and "8e784b59600c6f7a12c20a2cb19c1200e10ed6de" have entirely different histories.

6 changed files with 26 additions and 49 deletions

View file

@ -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)))

View file

@ -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))

View file

@ -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)

View file

@ -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 ()

View file

@ -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)
))

View file

@ -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))))