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
|
||||
(:use :common-lisp)
|
||||
(:export #:actor #:behave #:create #:send
|
||||
#:handle-message))
|
||||
(:local-nicknames (:util :scopes/util))
|
||||
(:export #:actor #:become #:create #:send
|
||||
#:echo #:lgi))
|
||||
|
||||
(in-package :scopes/core/actor)
|
||||
|
||||
;;;; basic actor and message implementation
|
||||
|
||||
(defclass actor ()
|
||||
((behavior :accessor behavior :initarg :behavior)))
|
||||
((behavior :accessor behavior :initarg :behavior :initform #'no-op)))
|
||||
|
||||
(defun behave (ac new-bhv)
|
||||
(setf (behavior ac) new-bhv))
|
||||
(defun become (ac bhv)
|
||||
(setf (behavior ac) bhv))
|
||||
|
||||
(defun create (ac-cls bhv &rest params)
|
||||
(make-instance ac-cls :behavior bhv))
|
||||
(defun create (bhv &optional (cls 'actor))
|
||||
(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*))))
|
||||
|
||||
(defun call (code)
|
||||
(util:lgi code)
|
||||
;(util:lgi code)
|
||||
(let ((*code* code))
|
||||
(do ((fn (pop *code*) (pop *code*)))
|
||||
((null fn))
|
||||
|
|
|
@ -62,8 +62,8 @@
|
|||
(test-util-crypt)
|
||||
(test-util-iter)
|
||||
(test-shape)
|
||||
(test-actor)
|
||||
(core:setup-services)
|
||||
(test-actor)
|
||||
(setf (receiver t:*test-suite*) (core:find-service :test-receiver))
|
||||
(test-send))
|
||||
(core:shutdown)
|
||||
|
@ -128,7 +128,9 @@
|
|||
|
||||
(deftest test-actor ()
|
||||
(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 ()
|
||||
(let ((rcvr (receiver t:*test-suite*))
|
||||
|
|
Loading…
Add table
Reference in a new issue