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

core/actor: first version of bg-actor (=process)

Browse source
This commit is contained in:
Helmut Merz 2025-04-14 18:59:36 +02:00
parent ca78d3b65e
commit 40b8a0791b
2 changed files with 49 additions and 11 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

46
core/actor.lisp
View file

@ -2,10 +2,13 @@
(defpackage :scopes/core/actor (defpackage :scopes/core/actor
(:use :common-lisp) (:use :common-lisp)
(:local-nicknames (:util :scopes/util)) (:local-nicknames (:async :scopes/util/async)
(:export #:actor #:become #:create #:send (:util :scopes/util))
(:export #:actor #:bg-actor #:become #:create #:send
#:content
#:*logger* #:*root*
#:echo #:inc #:lgi #:echo #:inc #:lgi
#:calculator #:plus #:minus #:show)) #:calculator #:plus #:minus #:show #:send-value))
(in-package :scopes/core/actor) (in-package :scopes/core/actor)
@ -21,17 +24,33 @@
(defclass actor () (defclass actor ()
((behavior :accessor behavior :initarg :behavior :initform #'no-op))) ((behavior :accessor behavior :initarg :behavior :initform #'no-op)))
(defclass bg-actor (actor)
((task :accessor task :initform nil)))
(defgeneric start (ac)
(:method ((ac actor)))
(:method ((ac bg-actor))
(setf (task ac)
(async:make-task
:handle-message #'(lambda (ax msg)
(funcall (behavior ac) ac msg))))
(async:start (task ac))))
(defgeneric deliver (ac msg) (defgeneric deliver (ac msg)
(:method ((ac actor) msg) (:method ((ac actor) msg)
(funcall (behavior ac) ac msg))) (funcall (behavior ac) ac msg))
(:method ((ac bg-actor) msg)
(async:send (task ac) msg)))
;;;; the core (Hewitt) actor API ;;;; the core (classical, i.e. Hewitt) actor API
(defun become (ac bhv) (defun become (ac bhv)
(setf (behavior ac) bhv)) (setf (behavior ac) bhv))
(defun create (bhv &optional (cls 'actor)) (defun create (bhv &optional (cls 'actor))
(make-instance cls :behavior bhv)) (let ((ac (make-instance cls :behavior bhv)))
(start ac)
ac))
(defun send (addr content &key customer) (defun send (addr content &key customer)
(let ((ac addr) (msg (message content customer))) (let ((ac addr) (msg (message content customer)))
@ -47,7 +66,18 @@
(defun echo (ac msg) (defun echo (ac msg)
(send (customer msg) msg)) (send (customer msg) msg))
;;;; example behavior: calculator ;;;; predefined global actors
(defvar *logger* (create #'lgi))
(defclass root (actor) ())
(defun root-bhv (ac msg)
(send *logger* msg))
(defvar *root* (create #'root-bhv 'root))
;;;; example behavior: calculator
(defun calculator (&optional (val 0)) (defun calculator (&optional (val 0))
#'(lambda (ac msg) #'(lambda (ac msg)
@ -59,4 +89,6 @@
(defun minus (ac msg val param) (defun minus (ac msg val param)
(become ac (calculator (- val param)))) (become ac (calculator (- val param))))
(defun show (ac msg val param) (defun show (ac msg val param)
(send (or (customer msg) *logger*) val))
(defun send-value (ac msg val param)
(send (customer msg) val)) (send (customer msg) val))

12
test/test-core.lisp
View file

@ -127,11 +127,17 @@
(== (shape:head-value rec :username) :u1))) (== (shape:head-value rec :username) :u1)))
(deftest test-actor () (deftest test-actor ()
(let ((calc (actor:create (actor:calculator))) (let* ((calc (actor:create (actor:calculator) 'actor:bg-actor))
(logger (actor:create #'actor:lgi))) val
(collector
(actor:create
#'(lambda (ac msg) (setf val (actor:content msg))))))
(actor:send calc '(actor:plus 2)) (actor:send calc '(actor:plus 2))
(actor:send calc '(actor:minus 3)) (actor:send calc '(actor:minus 3))
(actor:send calc '(actor:show) :customer logger) (actor:send calc '(actor:show))
(actor:send calc '(actor:send-value) :customer collector)
(sleep 0.1)
(== val -1)
)) ))
(deftest test-send () (deftest test-send ()