Coverage report: /home/ellis/comp/core/std/async.lisp

KindCoveredAll%
expression0102 0.0
branch012 0.0
Key
Not instrumented
Conditionalized out
Executed
Not executed
 
Both branches taken
One branch taken
Neither branch taken
1
 ;;; async.lisp --- Aynchronous Functions
2
 
3
 ;; Futures, Promises, etc
4
 
5
 ;;; Commentary:
6
 
7
 ;; based on LPARALLEL
8
 
9
 #|
10
            promise-base
11
              /     \
12
           promise  plan
13
                    /  \
14
  speculation = future  delay
15
 |#
16
 ;; NOTE: instead of 'force' we use 'await'
17
 
18
 ;; ref: https://github.com/lmj/lparallel
19
 
20
 ;; ref: https://doc.rust-lang.org/book/ch17-01-futures-and-syntax.html
21
 
22
 ;;; Code:
23
 (in-package :std/async)
24
 
25
 (defconstant +no-result+ :null)
26
 
27
 (defstruct (promise (:constructor promise))
28
   "An placeholder object for a result which is not-yet-known."
29
   (result +no-result+)
30
   (lock (make-mutex))
31
   (cvar nil)
32
   (availablep t :type boolean))
33
 
34
 (defstruct future
35
   "A promise which is fulfilled in parallel by evaluating the FN slot."
36
   (result +no-result+)
37
   (lock (make-mutex))
38
   (canceledp nil :type boolean)
39
   (fn nil :type (or null function)))
40
 
41
 (defun fulfill-promise (obj fn)
42
   (loop while (and (promise-availablep obj) (eq (promise-result obj) +no-result+))
43
         do (with-mutex ((promise-lock obj) :wait-p nil)
44
              (unwind-protect
45
                   (setf (promise-availablep obj) nil
46
                         ;; TODO 2025-04-04: 
47
                         (promise-result obj) (multiple-value-list (funcall fn)))
48
                (setf (promise-availablep obj) t))
49
              (when-let ((cvar (promise-cvar obj))) (condition-notify cvar))
50
              (return t))))
51
 
52
 (defun await-promise (obj)
53
   (let ((res (promise-result obj))
54
         (lock (promise-lock obj))
55
         (cvar (promise-cvar obj)))
56
     (unless cvar
57
       (setf cvar (sb-thread:make-waitqueue)))
58
     (loop while (eq res +no-result+)
59
           do (condition-wait cvar lock))
60
     (condition-notify cvar)))
61
 
62
 (defun fulfill-future (obj fn)
63
   (when (eq (future-result obj) +no-result+)
64
     (with-mutex ((future-lock obj) :wait-p nil)
65
       ;; task has been stolen from pool
66
       (setf (future-canceledp obj) t)
67
       ;; TODO 2025-04-04: 
68
       (funcall fn (future-fn obj)))))
69
 
70
 (defun await-future (obj)
71
   ;; task has been stolen from pool
72
   (setf (future-canceledp obj) t)
73
   ;; TODO 2025-04-04:
74
   (setf (future-result obj) (funcall (future-fn obj))
75
         (future-fn obj) nil))
76
 
77
 (defun fulfill (obj fn)
78
   (etypecase obj
79
     (promise (fulfill-promise obj fn))
80
     (future (fulfill-future obj fn))))
81
 
82
 (defun result (obj)
83
   (etypecase obj
84
     (promise (promise-result obj))
85
     (future (future-result obj))))
86
 
87
 (defmacro future (&body body)
88
   "Create a future which is fulfilled in parallel by the implicit progn BODY."
89
   `(make-future :fn (lambda () ,@body)))
90
 
91
 (defmacro while-waiting-for (obj &body body)
92
   (with-gensyms (lock canceledp res)
93
     `(let ((,lock (future-lock ,obj))
94
            (,canceledp (future-canceledp ,obj))
95
            (,res (future-result ,obj)))
96
        (when (and (not ,canceledp)
97
                   (eq ,res +no-result+))
98
          (with-mutex (,lock :wait-p nil)
99
            ,@body)))))
100
 
101
 (defun fulfilledp (obj)
102
   (typecase obj
103
     (promise (not (eq (promise-result obj) +no-result+)))
104
     (future (not (eq (future-result obj) +no-result+)))
105
     (t t)))
106
 
107
 (defun await (object)
108
   (typecase object
109
     ((or promise future)
110
      (while-waiting-for object
111
        (etypecase object
112
          (future (await-future object))
113
          (promise (await-promise object))))
114
      (result object))
115
     (t object)))