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

work in progress: util/async for asynchronous (concurrent / parallel) tasks

Browse source
This commit is contained in:
Helmut Merz 2025-02-16 16:38:25 +01:00
parent 0da989d73a
commit 2e6966276c
3 changed files with 36 additions and 0 deletions
Show stats Download patch file Download diff file Expand all files Collapse all files

1
scopes-core.asd
View file

@ -18,6 +18,7 @@
(:file "logging" :depends-on ("config" "util/util")) (:file "logging" :depends-on ("config" "util/util"))
(:file "shape/shape") (:file "shape/shape")
(:file "util/util") (:file "util/util")
(:file "util/async" :depends-on ("util/util"))
(:file "util/crypt" :depends-on ("util/util")) (:file "util/crypt" :depends-on ("util/util"))
(:file "util/iter") (:file "util/iter")
(:file "testing" :depends-on ("util/util"))) (:file "testing" :depends-on ("util/util")))

6
test/test-core.lisp
View file

@ -3,6 +3,7 @@
(defpackage :scopes/test-core (defpackage :scopes/test-core
(:use :common-lisp) (:use :common-lisp)
(:local-nicknames (:alx :alexandria) (:local-nicknames (:alx :alexandria)
(:async :scopes/util/async)
(:config :scopes/config) (:config :scopes/config)
(:core :scopes/core) (:core :scopes/core)
(:crypt :scopes/util/crypt) (:crypt :scopes/util/crypt)
@ -56,6 +57,7 @@
(unwind-protect (unwind-protect
(progn (progn
(test-util) (test-util)
(test-util-async)
(test-util-crypt) (test-util-crypt)
(test-util-iter) (test-util-iter)
(test-shape) (test-shape)
@ -82,6 +84,10 @@
(== (util:plist-add pl :b 1) '(:b 1 :a 0)) (== (util:plist-add pl :b 1) '(:b 1 :a 0))
(== pl '(:b 1 :a 0)))) (== pl '(:b 1 :a 0))))
(deftest test-util-async ()
(let ((tsk (async:task)))
(format t "~%~a~%" (async::taskid tsk))))
(deftest test-util-crypt () (deftest test-util-crypt ()
(util:lgi (crypt:create-secret)) (util:lgi (crypt:create-secret))
) )

29
util/async.lisp Normal file
View file

@ -0,0 +1,29 @@
;;;; cl-scopes/util/async - utilities for asynchronous (concurrent or parallel) operations
(defpackage :scopes/util/async
(:use :common-lisp)
(:local-nicknames (:util :scopes/util)
(:lp :lparallel)
(:lpq :lparallel.queue))
(:export #:startup #:shutdown
#:task #:start #:restart #:stop #:kill #:status
#:mailbox #:send #:receive))
(in-package :scopes/util/async)
(when (not (boundp '+quit-message+))
(defconstant +quit-message+ (gensym "QUIT")))
(when (null lp:*kernel*)
(setf lp:*kernel* (lp:make-kernel 2)))
(defclass task ()
((job :reader job :initarg :job)
(taskid :reader taskid :initform (gensym "TSK"))
(channel :reader channel :initform (lp:make-channel))
(mailbox :reader mailbox :initarg :mailbox :initform nil)
(status :accessor status :initform :new)
(logdata :accessor logdata :initform nil)))
(defun task ()
(make-instance 'task))