work in progress: actor
This commit is contained in:
parent
b4ee477329
commit
b4762d5003
3 changed files with 27 additions and 13 deletions
|
@ -2,22 +2,34 @@
|
||||||
|
|
||||||
(defpackage :scopes/core/actor
|
(defpackage :scopes/core/actor
|
||||||
(:use :common-lisp)
|
(:use :common-lisp)
|
||||||
(:export #:actor #:behave #:create #:send
|
(:local-nicknames (:util :scopes/util))
|
||||||
#:handle-message))
|
(:export #:actor #:become #:create #:send
|
||||||
|
#:echo #:lgi))
|
||||||
|
|
||||||
(in-package :scopes/core/actor)
|
(in-package :scopes/core/actor)
|
||||||
|
|
||||||
|
;;;; basic actor and message implementation
|
||||||
|
|
||||||
(defclass actor ()
|
(defclass actor ()
|
||||||
((behavior :accessor behavior :initarg :behavior)))
|
((behavior :accessor behavior :initarg :behavior :initform #'no-op)))
|
||||||
|
|
||||||
(defun behave (ac new-bhv)
|
(defun become (ac bhv)
|
||||||
(setf (behavior ac) new-bhv))
|
(setf (behavior ac) bhv))
|
||||||
|
|
||||||
(defun create (ac-cls bhv &rest params)
|
(defun create (bhv &optional (cls 'actor))
|
||||||
(make-instance ac-cls :behavior bhv))
|
(make-instance cls :behavior bhv))
|
||||||
|
|
||||||
(defun send (addr msg &key customer))
|
(defun send (addr msg &key customer)
|
||||||
|
(let ((ac addr))
|
||||||
|
;(setf (customer msg) customer)
|
||||||
|
(funcall (behavior ac) ac msg)))
|
||||||
|
|
||||||
;;;; behaviors
|
;;;; predefined behaviors
|
||||||
|
|
||||||
(defun handle-message (ac msg))
|
(defun no-op (ac msg))
|
||||||
|
|
||||||
|
(defun lgi (ac msg)
|
||||||
|
(util:lgi msg))
|
||||||
|
|
||||||
|
(defun echo (ac msg)
|
||||||
|
(send (customer msg) msg))
|
||||||
|
|
|
@ -108,7 +108,7 @@
|
||||||
(pushd (reverse *buffer*))))
|
(pushd (reverse *buffer*))))
|
||||||
|
|
||||||
(defun call (code)
|
(defun call (code)
|
||||||
(util:lgi code)
|
;(util:lgi code)
|
||||||
(let ((*code* code))
|
(let ((*code* code))
|
||||||
(do ((fn (pop *code*) (pop *code*)))
|
(do ((fn (pop *code*) (pop *code*)))
|
||||||
((null fn))
|
((null fn))
|
||||||
|
|
|
@ -62,8 +62,8 @@
|
||||||
(test-util-crypt)
|
(test-util-crypt)
|
||||||
(test-util-iter)
|
(test-util-iter)
|
||||||
(test-shape)
|
(test-shape)
|
||||||
(test-actor)
|
|
||||||
(core:setup-services)
|
(core:setup-services)
|
||||||
|
(test-actor)
|
||||||
(setf (receiver t:*test-suite*) (core:find-service :test-receiver))
|
(setf (receiver t:*test-suite*) (core:find-service :test-receiver))
|
||||||
(test-send))
|
(test-send))
|
||||||
(core:shutdown)
|
(core:shutdown)
|
||||||
|
@ -128,7 +128,9 @@
|
||||||
|
|
||||||
(deftest test-actor ()
|
(deftest test-actor ()
|
||||||
(let (a1 a2 a3)
|
(let (a1 a2 a3)
|
||||||
(setf a1 (actor:create 'actor:actor 'actor:handle-message))))
|
(setf a1 (actor:create 'actor:lgi))
|
||||||
|
(actor:send a1 "Hello World")
|
||||||
|
))
|
||||||
|
|
||||||
(deftest test-send ()
|
(deftest test-send ()
|
||||||
(let ((rcvr (receiver t:*test-suite*))
|
(let ((rcvr (receiver t:*test-suite*))
|
||||||
|
|
Loading…
Add table
Reference in a new issue