cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

Compare commits

base: cco:0c47aec77d27e822aca14ed0cebb58ac96e46902
Branches Tags
cco:master
..
compare: cco:94b35fcefd3afea70f51bf35ba60896e03e35ed2
Branches Tags
cco:master

No commits in common. "0c47aec77d27e822aca14ed0cebb58ac96e46902" and "94b35fcefd3afea70f51bf35ba60896e03e35ed2" have entirely different histories.
0c47aec77d ... 94b35fcefd

6 changed files with 36 additions and 41 deletions
Show stats Expand all files Collapse all files

13
csys/csys.lisp
View file

@ -8,8 +8,7 @@
(:shape :scopes/shape)
(:util :scopes/util)
(:alx :alexandria))
(:export #:*domain*
#:scope #:environ
(:export #:scope #:environ
#:make-program #:create-zero
#:neuron #:std-proc #:eff-proc
#:handle-action #:basic-actions #:forward #:notify
@ -19,8 +18,6 @@
(in-package :scopes/csys)
(defvar *domain* :csys)
;;;; scope: information a neuron has access to
(defclass scope ()
@ -195,7 +192,7 @@
(defun send-message (cell head data)
(actor:send cell (message:create head :data data)))
(defun send-create (cell &rest args &key (domain *domain*)
(defun send-create (cell &rest args &key (domain :csys)
(cat :c00) loc connect op &allow-other-keys)
(let ((args+ (if loc
`(:addr ,(list domain cat loc))
@ -203,13 +200,11 @@
(setf args (alx:remove-from-plist args :domain :cat :loc))
(send-message cell (list domain :create) (append args+ args))))
(defun send-connect (cell target &key op (domain *domain*))
(defun send-connect (cell target &key op (domain :csys))
(send-message cell (list domain :connect) (list :target target :op op)))
(defun printer ()
(actor:create
(lambda (msg)
(format t "~&~s~%" msg))))
(actor:create (lambda (msg) (print msg))))
;;;; internal helpers

8
csys/environ.lisp
View file

@ -20,7 +20,7 @@
(defclass scope (csys:scope)
((cells :reader cells :initform (make-hash-table :test #'equal))))
(defun create (proc meta-env &key eff-contacts)
(defun create (proc meta-env &key eff-contacts) ; meta-env example: (csys:printer)
(let* ((prg (csys:make-program proc))
(scope (csys:scope prg meta-env :cls 'scope :categ '(:env :c00)))
(env (csys:neuron scope)))
@ -30,7 +30,7 @@
(defun simple-setup (cfg)
(destructuring-bind (prg &key (zero-cat :c00) eff-contacts) cfg
(let ((env (create #'simple-proc (csys:printer) :eff-contacts eff-contacts)))
(csys:create-zero prg env :categ (list csys:*domain* zero-cat))
(csys:create-zero prg env :categ (list :csys zero-cat))
env)))
(defun simple-proc (msg scope)
@ -101,11 +101,11 @@
;;;; public shortcuts
(defun send-value (cat-loc val &key (domain csys:*domain*) (env *env*))
(defun send-value (cat-loc val &key (domain :csys) (env *env*))
(let ((head (cons domain (cons :value cat-loc))))
(actor:send env (message:create head :data `(:value ,val)))))
(defun send-connect (env &rest args &key (domain csys:*domain*) addr to target op)
(defun send-connect (env &rest args &key (domain :csys) addr to target op)
(let ((head (list domain :connect)))
(actor:send env (message:create head :data args))))

32
csys/program/basic.lisp → csys/program.lisp
View file

@ -1,6 +1,6 @@
;;;; cl-scopes/csys/program/basic - common and general csys program definitions
;;;; cl-scopes/csys/program - common and general csys program definitions
(defpackage :scopes/csys/program/basic
(defpackage :scopes/csys/program
(:use :common-lisp)
(:local-nicknames (:actor :scopes/core/actor)
(:csys :scopes/csys)
@ -8,21 +8,21 @@
(:util :scopes/util))
(:export #:basic-0 #:config-basic-1))
(in-package :scopes/csys/program/basic)
(in-package :scopes/csys/program)
;;;; basic-0: minimal recursive system
(defun basic-0 ()
(csys:make-program
(list '(:c00 :initial) (csys:std-proc :next (b0-next-zero))
'(:e00 :initial) (csys:eff-proc)
'(:e01 :initial) (csys:eff-proc)
':default (csys:std-proc))))
(defun b0-next-zero ()
(lambda (msg scope)
(let ((self actor:*self*))
(csys:send-create self :cat :e00 :connect :succ)
(csys:send-create self :cat :s00 :loc "0-1" :connect :pred)
(csys:send-create self :cat :e01 :connect :succ)
(csys:send-create self :cat :s01 :loc "0-1" :connect :pred)
(csys:send-connect self self :op (csys:multiply -1))
;; switch :active
nil)))
@ -30,23 +30,23 @@
;;;; basic-1: minimal cross-linked system
(defun config-basic-1 ()
(list (basic-1) :zero-cat :s01
:eff-contacts '(:e01 ("1-0" "1-1"))))
(list (basic-1) :zero-cat :s00
:eff-contacts '(:e00 ("1-0" "1-1"))))
(defun basic-1 ()
(csys:make-program
(list '(:s01 :initial) (csys:std-proc :next (b1-next-zero))
'(:s01 :basic) (csys:std-proc :next (b1-next-one))
'(:e01 :default) (csys:eff-proc :value (csys:value-add :bias 2))
(list '(:s00 :initial) (csys:std-proc :next (b1-next-zero))
'(:s00 :basic) (csys:std-proc :next (b1-next-one))
'(:e00 :default) (csys:eff-proc :value (csys:value-add :bias 2))
':default (csys:std-proc))))
(defun b1-next-zero ()
(lambda (msg scope)
(let ((self actor:*self*))
(csys:send-create self :cat :e01 :loc "1-0" :value 2 :connect :succ)
(csys:send-create self :cat :e01 :loc "1-1" :value 2
(csys:send-create self :cat :e00 :loc "1-0" :value 2 :connect :succ)
(csys:send-create self :cat :e00 :loc "1-1" :value 2
:connect :succ :op (csys:multiply -1))
(csys:send-create self :cat :s01 :loc "0-1" :stage :basic)
(csys:send-create self :cat :s00 :loc "0-1" :stage :basic)
;; switch :active
nil)))
@ -54,8 +54,8 @@
(lambda (msg scope)
(let ((self actor:*self*)
(env (csys:environ scope)))
(environ:send-connect env :to self :target '(:csys :e01 "1-0")
(environ:send-connect env :to self :target '(:csys :e00 "1-0")
:op (csys:multiply -1))
(environ:send-connect env :to self :target '(:csys :e01 "1-1"))
(environ:send-connect env :to self :target '(:csys :e00 "1-1"))
;; switch :active
nil)))

3
scopes-csys.asd
View file

@ -11,7 +11,8 @@
:depends-on (:scopes-core)
:components ((:file "csys/csys")
(:file "csys/environ" :depends-on ("csys/csys"))
(:file "csys/program/basic" :depends-on ("csys/csys" "csys/environ")))
(:file "csys/program" :depends-on ("csys/csys" "csys/environ"))
)
:long-description "scopes/csys: Concurrent cybernetic communication systems."
:in-order-to ((test-op (test-op "scopes-csys/test"))))

4
scratch.lisp
View file

@ -8,11 +8,11 @@
;;;; csys stuff
(add-package-local-nickname :basic :scopes/csys/program/basic)
(add-package-local-nickname :environ :scopes/csys/environ)
(add-package-local-nickname :program :scopes/csys/program)
(scopes/util/async:init)
(setf environ:*env* (environ:simple-setup (basic:config-basic-1)))
(setf environ:*env* (environ:simple-setup (program:config-basic-1)))
;(environ:send-value '(:s00 "0-1") 2)

17
test/test-csys.lisp
View file

@ -5,7 +5,6 @@
(:local-nicknames (:alx :alexandria)
(:actor :scopes/core/actor)
(:async :scopes/util/async)
(:basic :scopes/csys/program/basic)
(:config :scopes/config)
(:core :scopes/core)
(:csys :scopes/csys)
@ -31,8 +30,8 @@
(defun setup-config ()
(config:add :test-receiver :setup #'tc:setup)
(config:add-action '(:csys :effect :e00) (value-in '(1 2)))
(config:add-action '(:csys :effect :e01) (value-in '(1 2 3 4)))
(config:add-action '(:csys :effect :e01) (value-in '(1 2)))
(config:add-action '(:csys :effect :e00) (value-in '(1 2 3 4)))
;(config:add-action '(:csys :effect) #'tc:check-message)
(config:add-action '(:csys) (constantly nil)))
@ -68,19 +67,19 @@
;;;; test definitions
(deftest test-basic-0 ()
(let ((environ:*env* (setup-test (list (basic:basic-0)))))
(let ((environ:*env* (setup-test (list (program:basic-0)))))
;(rcvr (tc:receiver t:*test-suite*))
(sleep 0.1)
;(tc:expect rcvr (message:create '(:csys :effect :e01) :data '(:value 1)))
(environ:send-value '(:s00 "0-1") 1)
(environ:send-value '(:s00 "0-1") 2)
(environ:send-value '(:s01 "0-1") 1)
(environ:send-value '(:s01 "0-1") 2)
(sleep 0.1)
(core:shutdown)))
(deftest test-basic-1 ()
(let ((environ:*env* (setup-test (basic:config-basic-1))))
(let ((environ:*env* (setup-test (program:config-basic-1))))
(sleep 0.1)
(environ:send-value '(:s01 "0-0") 1)
(environ:send-value '(:s01 "0-1") 2)
(environ:send-value '(:s00 "0-0") 1)
(environ:send-value '(:s00 "0-1") 2)
(sleep 0.1)
(core:shutdown)))