diff --git a/core/actor.lisp b/core/actor.lisp index 8c7786d..77c16bb 100644 --- a/core/actor.lisp +++ b/core/actor.lisp @@ -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)) diff --git a/forge/forge.lisp b/forge/forge.lisp index 58efe37..8c4dc3c 100644 --- a/forge/forge.lisp +++ b/forge/forge.lisp @@ -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)) diff --git a/test/test-core.lisp b/test/test-core.lisp index bc85184..320887d 100644 --- a/test/test-core.lisp +++ b/test/test-core.lisp @@ -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*))