diff --git a/core/actor-ng.lisp b/core/actor-ng.lisp index fde376e..6f84a5c 100644 --- a/core/actor-ng.lisp +++ b/core/actor-ng.lisp @@ -5,6 +5,7 @@ (:local-nicknames (:async :scopes/util/async) (:lp :lparallel) (:lpq :lparallel.queue) + (:shape :scopes/shape) (:util :scopes/util)) (:export #:start #:stop #:become #:create #:send #:message #:content #:customer @@ -23,6 +24,9 @@ ((content :reader content :initarg :content :initform nil) (customer :reader customer :initarg :customer :initform nil))) +(defmethod x-print-object ((msg message) stream) + (shape:print-slots msg stream 'content 'customer)) + (defun message (content &optional customer) (make-instance 'message :content content :customer customer)) @@ -55,6 +59,7 @@ (values mb (start mb bhv)))) (defun send (mb msg) + ;(util:lgi msg) (lpq:push-queue msg mb)) ;;;; predefined behaviors @@ -80,7 +85,7 @@ (defun calculator (&optional (val 0)) (lambda (msg) - (format t "calc ~a ~a~%" val (content msg)) + ;(format t "calc ~a ~a~%" val (content msg)) (destructuring-bind (fn &optional param) (content msg) (funcall fn msg val param)))) diff --git a/core/core.lisp b/core/core.lisp index 586619b..93c124c 100644 --- a/core/core.lisp +++ b/core/core.lisp @@ -69,12 +69,7 @@ (name :reader name :initarg :name) (services :reader services :initform (make-hash-table)))) -(defun x-default-setup (cfg &optional (cls 'context) &rest args &key &allow-other-keys) - (apply #'actor:create #'handle-message cls :config cfg :name (config:name cfg) args)) - (defun make-setup (&key (class 'context) (behavior #'handle-message) args) - ;(lambda (cfg) - ; (apply #'actor:create behavior class :config cfg :name (config:name cfg) args)) (lambda (cfg) (let* ((ctx (apply #'make-instance class :config cfg :name (config:name cfg) args)) (bhv (lambda (msg) (funcall behavior ctx msg)))) @@ -88,7 +83,6 @@ (defun setup-services (&optional (cfg config:*root*)) (async:init) - ;(setf *root* (actor:make-actor #'handle-message 'root-service :config cfg)) (let* ((ctx (make-instance 'context :config cfg)) (bhv (lambda (msg) (funcall #'handle-message ctx msg)))) (setf (mailbox ctx) (lpq:make-queue)) @@ -126,9 +120,8 @@ (add-action child (car a) (cadr a))) (setf (gethash (config:name cfg) services) child))))) -(defgeneric handle-message (ctx msg) - (:method ((ctx base-context) msg) - (do-actions ctx (actor:content msg)))) +(defun handle-message (ctx msg) + (do-actions ctx msg)) (defun do-actions (ctx msg &optional (acts #'actions)) (let ((hdlrs (select msg (funcall acts ctx)))) diff --git a/core/message.lisp b/core/message.lisp index dbbd116..d019257 100644 --- a/core/message.lisp +++ b/core/message.lisp @@ -2,7 +2,7 @@ (defpackage :scopes/core/message (:use :common-lisp) - (:local-nicknames (:actor :scopes/core/actor) + (:local-nicknames (:actor :scopes/core/actor-ng) (:shape :scopes/shape)) (:export #:message-meta #:message #:create #:head #:data)) @@ -24,4 +24,4 @@ (shape:print-slots msg stream 'shape:head 'actor:customer 'shape:data)) (defmethod actor:content ((msg message)) - (list (shape:head-plist) (shape:data))) + (list (shape:head-plist msg) (shape:data msg))) diff --git a/scopes-core.asd b/scopes-core.asd index e3524fc..a6ce511 100644 --- a/scopes-core.asd +++ b/scopes-core.asd @@ -10,16 +10,14 @@ :flexi-streams :ironclad :local-time :log4cl :lparallel :qbase64 :serapeum :str) :components ((:file "config" :depends-on ("util/util")) - (:file "core/actor" - :depends-on ("shape/shape" "util/async" "util/util")) (:file "core/actor-ng" :depends-on ("shape/shape" "util/async" "util/util")) (:file "core/core" :depends-on ("config" - "core/actor" "core/message" + "core/actor-ng" "core/message" "forge/forge" "logging" "util/async" "util/util")) - (:file "core/message" :depends-on ("core/actor" "shape/shape")) + (:file "core/message" :depends-on ("core/actor-ng" "shape/shape")) (:file "forge/forge" :depends-on ("util/iter" "util/util")) (:file "logging" :depends-on ("config" "util/util")) (:file "shape/shape") diff --git a/test/test-core.lisp b/test/test-core.lisp index 8f0bb92..838b9b5 100644 --- a/test/test-core.lisp +++ b/test/test-core.lisp @@ -4,7 +4,6 @@ (:use :common-lisp) (:local-nicknames (:alx :alexandria) (:actor :scopes/core/actor-ng) - (:actorx :scopes/core/actor) (:async :scopes/util/async) (:config :scopes/config) (:core :scopes/core) @@ -51,7 +50,7 @@ ;;;; test runner (defclass test-suite (t:test-suite) - ((receiver :accessor receiver :initarg :receiver))) + ((receiver :accessor receiver :initarg :receiver :initform nil))) (defun run () (async:init) @@ -65,10 +64,10 @@ (test-util-iter) (test-shape) (core:setup-services) - (test-actor-x) (test-actor) (setf (receiver t:*test-suite*) (core:find-service :test-receiver)) - (test-send)) + (test-send) + ) (core:shutdown) (check-expected) (t:show-result)))) @@ -130,20 +129,6 @@ (setf (shape:head-value rec :username) :u1) (== (shape:head-value rec :username) :u1))) -(deftest test-actor-x () - (let* ((calc (actorx:create (actorx:calculator) 'actorx:bg-actor)) - val - (collector - (actorx:create - #'(lambda (ac msg) (setf val (actorx:content msg)))))) - (actorx:send calc '(actorx:plus 2)) - (actorx:send calc '(actorx:minus 3)) - (actorx:send calc '(actorx:show)) - (actorx:send calc '(actorx:send-value) :customer collector) - (sleep 0.1) - (== val -1) - )) - (deftest test-actor () ;(async:init) (let* ((calc (actor:create (actor:calculator))) @@ -153,7 +138,7 @@ (actor:send calc (actor:message '(actor:plus 2))) (actor:send calc (actor:message '(actor:minus 3))) (actor:send calc (actor:message '(actor:show))) - (actor:send calc (actor:message '(actor:send-value) collector)) + (actor:send calc (actor:message '(actor:show) collector)) (actor:stop calc) (sleep 0.1) (== val -1) @@ -165,4 +150,5 @@ (msg-exp (message:create '(:test :dummy) :data "dummy payload"))) (expect rcvr msg-exp) (== (core:name rcvr) :test-receiver) - (actor:send (core:mailbox rcvr) (actor:message msg)))) + (actor:send (core:mailbox rcvr) msg) + ))