more on actor-ng - now working with core

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))))
 

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)
+(defun handle-message (ctx msg)
-  (:method ((ctx base-context) msg)
+  (do-actions ctx msg))
-    (do-actions ctx (actor:content msg))))
 
 (defun do-actions (ctx msg &optional (acts #'actions))
   (let ((hdlrs (select msg (funcall acts ctx))))

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)))

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")

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)
+    ))