cco/cl-scopes
3
0
Fork 0
Code Issues 1 Pull requests Releases Wiki Activity Actions

work in progress: new (minimal, recursive) actor definition (actor-ng)

Browse source
This commit is contained in:
Helmut Merz 2025-05-31 14:23:39 +02:00
parent 0c35d7bf97
commit 751163b801
6 changed files with 53 additions and 14 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

30
core/actor-ng.lisp Normal file
View file

@ -0,0 +1,30 @@
;;;; cl-scopes/core/actor - basic actor definitions
(defpackage :scopes/core/actor-ng
(:use :common-lisp)
(:local-nicknames (:async :scopes/util/async)
(:util :scopes/util))
(:export #:ac-loop #:become #:create #:send
#:message #:content #:customer
#:*logger* #:*root*
#:echo #:inc #:lgi
#:calculator #:plus #:minus #:show #:send-value))
(in-package :scopes/core/actor-ng)
;;;; virtual actor - async:task + behavior
(eval-when (:compile-toplevel :load-toplevel :execute)
(when (not (boundp '+quit-message+))
(defconstant +quit-message+ (gensym "QUIT"))))
(defun ac-loop (tsk bhv)
(let ((next (ac-step tsk bhv)))
(unless (eq next +quit-message+)
(ac-loop tsk (or next bhv)))))
(defun ac-step (tsk bhv)
(let ((msg (async:receive tsk)))
(funcall bhv tsk msg)))

4
core/actor.lisp
View file

@ -4,7 +4,7 @@
(:use :common-lisp)
(:local-nicknames (:async :scopes/util/async)
(:util :scopes/util))
(:export #:actor #:bg-actor #:fg-actor #:make-actor #:start #:stop
(:export #:bg-actor #:fg-actor #:make-actor #:start #:stop
#:become #:create #:send
#:message #:content #:customer
#:*logger* #:*root*
@ -46,7 +46,7 @@
(:method ((ac bg-actor))
(async:stop (task ac))))
(defun make-actor (bhv &optional (cls 'actor) &rest args &key &allow-other-keys)
(defun make-actor (bhv &optional (cls 'bg-actor) &rest args &key &allow-other-keys)
(apply #'make-instance cls :behavior bhv args))
(defun make-task (ac &optional (cls 'async:bg-task))

2
core/core.lisp
View file

@ -60,7 +60,7 @@
(defvar *root* nil)
(defclass base-context (actor:actor)
(defclass base-context (actor:bg-actor)
((actions :accessor actions :initform nil)))
(defclass context (base-context)

2
scopes-core.asd
View file

@ -12,6 +12,8 @@
: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"

24
test/test-core.lisp
View file

@ -3,7 +3,8 @@
(defpackage :scopes/test-core
(:use :common-lisp)
(:local-nicknames (:alx :alexandria)
(:actor :scopes/core/actor)
(:actor :scopes/core/actor-ng)
(:actorx :scopes/core/actor)
(:async :scopes/util/async)
(:config :scopes/config)
(:core :scopes/core)
@ -63,6 +64,7 @@
(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))
@ -126,24 +128,26 @@
(setf (shape:head-value rec :username) :u1)
(== (shape:head-value rec :username) :u1)))
(deftest test-actor ()
(let* ((calc (actor:create (actor:calculator) 'actor:bg-actor))
(deftest test-actor-x ()
(let* ((calc (actorx:create (actorx:calculator) 'actorx:bg-actor))
val
(collector
(actor:create
#'(lambda (ac msg) (setf val (actor:content msg))))))
(actor:send calc '(actor:plus 2))
(actor:send calc '(actor:minus 3))
(actor:send calc '(actor:show))
(actor:send calc '(actor:send-value) :customer 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 ())
(deftest test-send ()
(let ((rcvr (receiver t:*test-suite*))
(msg (message:create '(:test :dummy) :data "dummy payload"))
(msg-exp (message:create '(:test :dummy) :data "dummy payload")))
(expect rcvr msg-exp)
(== (core:name rcvr) :test-receiver)
(actor:send rcvr msg)))
(actorx:send rcvr msg)))

5
util/async.lisp
View file

@ -5,7 +5,7 @@
(:local-nicknames (:util :scopes/util)
(:lp :lparallel)
(:lpq :lparallel.queue))
(:export #:init #:finish #:bg-task #:fg-task
(:export #:init #:finish #:bg-task #:fg-task #:receive
#:make-task #:start #:stop #:status #:data #:send))
(in-package :scopes/util/async)
@ -53,6 +53,9 @@
(status :accessor status :initform :new)
(data :accessor data :initform nil)))
(defun receive (tsk)
(lpq:pop-queue (mailbox tsk)))
(defclass bg-task (fg-task)
((channel :reader channel :initform (lp:make-channel))))