aio.el (15546B)
1 ;;; aio.el --- async/await for Emacs Lisp -*- lexical-binding: t; -*- 2 3 ;; This is free and unencumbered software released into the public domain. 4 5 ;; Author: Christopher Wellons <wellons@nullprogram.com> 6 ;; URL: https://github.com/skeeto/emacs-aio 7 ;; Version: 1.0 8 ;; Package-Requires: ((emacs "26.1")) 9 10 ;;; Commentary: 11 12 ;; The main components of this package are `aio-defun' / `aio-lambda' 13 ;; to define async function, and `aio-await' to pause these functions 14 ;; while they wait on asynchronous events. When an asynchronous 15 ;; function is paused, the main thread is not blocked. It is no more 16 ;; or less powerful than callbacks, but is nicer to use. 17 18 ;; This is implementation is based on Emacs 25 generators, and 19 ;; asynchronous functions are actually iterators in disguise, operated 20 ;; as stackless, asymmetric coroutines. 21 22 ;;; Code: 23 24 (require 'cl-lib) 25 (require 'generator) 26 27 ;; Register new error types 28 (define-error 'aio-cancel "Promise was canceled") 29 (define-error 'aio-timeout "Timeout was reached") 30 31 (defun aio-promise () 32 "Create a new promise object." 33 (record 'aio-promise nil ())) 34 35 (defsubst aio-promise-p (object) 36 "Return non-nil if OBJECT is a promise." 37 (and (eq 'aio-promise (type-of object)) 38 (= 3 (length object)))) 39 40 (defsubst aio-result (promise) 41 "Return the result of PROMISE, or nil if it is unresolved. 42 43 Promise results are wrapped in a function. The result must be 44 called (e.g. `funcall') in order to retrieve the value." 45 (unless (aio-promise-p promise) 46 (signal 'wrong-type-argument (list 'aio-promise-p promise))) 47 (aref promise 1)) 48 49 (defun aio-listen (promise callback) 50 "Add CALLBACK to PROMISE. 51 52 If the promise has already been resolved, the callback will be 53 scheduled for the next event loop turn." 54 (let ((result (aio-result promise))) 55 (if result 56 (run-at-time 0 nil callback result) 57 (push callback (aref promise 2))))) 58 59 (defun aio-resolve (promise value-function) 60 "Resolve this PROMISE with VALUE-FUNCTION. 61 62 A promise can only be resolved once, and any further calls to 63 `aio-resolve' are silently ignored. The VALUE-FUNCTION must be a 64 function that takes no arguments and either returns the result 65 value or rethrows a signal." 66 (unless (functionp value-function) 67 (signal 'wrong-type-argument (list 'functionp value-function))) 68 (unless (aio-result promise) 69 (let ((callbacks (nreverse (aref promise 2)))) 70 (setf (aref promise 1) value-function 71 (aref promise 2) ()) 72 (dolist (callback callbacks) 73 (run-at-time 0 nil callback value-function))))) 74 75 (defun aio--step (iter promise yield-result) 76 "Advance ITER to the next promise. 77 78 PROMISE is the return promise of the iterator, which was returned 79 by the originating async function. YIELD-RESULT is the value 80 function result directly from the previously yielded promise." 81 (condition-case _ 82 (cl-loop for result = (iter-next iter yield-result) 83 then (iter-next iter (lambda () result)) 84 until (aio-promise-p result) 85 finally (aio-listen result 86 (lambda (value) 87 (aio--step iter promise value)))) 88 (iter-end-of-sequence))) 89 90 (defmacro aio-with-promise (promise &rest body) 91 "Evaluate BODY and resolve PROMISE with the result. 92 93 If the body signals an error, this error will be stored in the 94 promise and rethrown in the promise's listeners." 95 (declare (indent defun)) 96 (cl-assert (eq lexical-binding t)) 97 `(aio-resolve ,promise 98 (condition-case error 99 (let ((result (progn ,@body))) 100 (lambda () result)) 101 (error (lambda () 102 (signal (car error) (cdr error))))))) 103 104 (defmacro aio-await (expr) 105 "If EXPR evaluates to a promise, pause until the promise is resolved. 106 107 Pausing an async function does not block Emacs' main thread. If 108 EXPR doesn't evaluate to a promise, the value is returned 109 immediately and the function is not paused. Since async functions 110 return promises, async functions can await directly on other 111 async functions using this macro. 112 113 This macro can only be used inside an async function, either 114 `aio-lambda' or `aio-defun'." 115 `(funcall (iter-yield ,expr))) 116 117 (defmacro aio-lambda (arglist &rest body) 118 "Like `lambda', but defines an async function. 119 120 The body of this function may use `aio-await' to wait on 121 promises. When an async function is called, it immediately 122 returns a promise that will resolve to the function's return 123 value, or any uncaught error signal." 124 (declare (indent defun) 125 (doc-string 3)) 126 (let ((args (make-symbol "args")) 127 (promise (make-symbol "promise")) 128 (split-body (macroexp-parse-body body))) 129 `(lambda (&rest ,args) 130 ,@(car split-body) 131 (let* ((,promise (aio-promise)) 132 (iter (apply (iter-lambda ,arglist 133 (aio-with-promise ,promise 134 ,@(cdr split-body))) 135 ,args))) 136 (prog1 ,promise 137 (aio--step iter ,promise nil)))))) 138 139 (defmacro aio-defun (name arglist &rest body) 140 "Like `aio-lambda' but gives the function a name like `defun'." 141 (declare (indent defun) 142 (doc-string 3)) 143 `(defalias ',name (aio-lambda ,arglist ,@body))) 144 145 (defun aio-wait-for (promise) 146 "Synchronously wait for PROMISE, blocking the current thread." 147 (while (null (aio-result promise)) 148 (accept-process-output)) 149 (funcall (aio-result promise))) 150 151 (defun aio-cancel (promise &optional reason) 152 "Attempt to cancel PROMISE, returning non-nil if successful. 153 154 All awaiters will receive an aio-cancel signal. The actual 155 underlying asynchronous operation will not actually be canceled." 156 (unless (aio-result promise) 157 (aio-resolve promise (lambda () (signal 'aio-cancel reason))))) 158 159 (defmacro aio-with-async (&rest body) 160 "Evaluate BODY asynchronously as if it was inside `aio-lambda'. 161 162 Since BODY is evalued inside an asynchronous lambda, `aio-await' 163 is available here. This macro evaluates to a promise for BODY's 164 eventual result." 165 (declare (indent 0)) 166 `(let ((promise (funcall (aio-lambda () 167 (aio-await (aio-sleep 0)) 168 ,@body)))) 169 (prog1 promise 170 ;; The is the main feature: Force the final result to be 171 ;; realized so that errors are reported. 172 (aio-listen promise #'funcall)))) 173 174 (defmacro aio-chain (expr) 175 "`aio-await' on EXPR and replace place EXPR with the next promise. 176 177 EXPR must be setf-able. Returns (cdr result). This macro is 178 intended to be used with `aio-make-callback' in order to follow 179 a chain of promise-yielding promises." 180 (let ((result (make-symbol "result"))) 181 `(let ((,result (aio-await ,expr))) 182 (setf ,expr (car ,result)) 183 (cdr ,result)))) 184 185 ;; Useful promise-returning functions: 186 187 (require 'url) 188 189 (aio-defun aio-all (promises) 190 "Return a promise that resolves when all PROMISES are resolved." 191 (dolist (promise promises) 192 (aio-await promise))) 193 194 (defun aio-catch (promise) 195 "Return a new promise that wraps PROMISE but will never signal. 196 197 The promise value is a cons where the car is either :success or 198 :error. For :success, the cdr will be the result value. For 199 :error, the cdr will be the error data." 200 (let ((result (aio-promise))) 201 (cl-flet ((callback (value) 202 (aio-resolve result 203 (lambda () 204 (condition-case error 205 (cons :success (funcall value)) 206 (error (cons :error error))))))) 207 (prog1 result 208 (aio-listen promise #'callback))))) 209 210 (defun aio-sleep (seconds &optional result) 211 "Create a promise that is resolved after SECONDS with RESULT. 212 213 The result is a value, not a value function, and it will be 214 automatically wrapped with a value function (see `aio-resolve')." 215 (let ((promise (aio-promise))) 216 (prog1 promise 217 (run-at-time seconds nil 218 #'aio-resolve promise (lambda () result))))) 219 220 (defun aio-idle (seconds &optional result) 221 "Create a promise that is resolved after idle SECONDS with RESULT. 222 223 The result is a value, not a value function, and it will be 224 automatically wrapped with a value function (see `aio-resolve')." 225 (let ((promise (aio-promise))) 226 (prog1 promise 227 (run-with-idle-timer seconds nil 228 #'aio-resolve promise (lambda () result))))) 229 230 (defun aio-timeout (seconds) 231 "Create a promise with a timeout error after SECONDS." 232 (let ((timeout (aio-promise))) 233 (prog1 timeout 234 (run-at-time seconds nil#'aio-resolve timeout 235 (lambda () (signal 'aio-timeout seconds)))))) 236 237 (defun aio-url-retrieve (url &optional silent inhibit-cookies) 238 "Wraps `url-retrieve' in a promise. 239 240 This function will never directly signal an error. Instead any 241 errors will be delivered via the returned promise. The promise 242 result is a cons of (status . buffer). This buffer is a clone of 243 the buffer created by `url-retrieve' and should be killed by the 244 caller." 245 (let ((promise (aio-promise))) 246 (prog1 promise 247 (condition-case error 248 (url-retrieve url (lambda (status) 249 (let ((value (cons status (clone-buffer)))) 250 (aio-resolve promise (lambda () value)))) 251 silent inhibit-cookies) 252 (error (aio-resolve promise 253 (lambda () 254 (signal (car error) (cdr error))))))))) 255 256 (cl-defun aio-make-callback (&key tag once) 257 "Return a new callback function and its first promise. 258 259 Returns a cons (callback . promise) where callback is function 260 suitable for repeated invocation. This makes it useful for 261 process filters and sentinels. The promise is the first promise 262 to be resolved by the callback. 263 264 The promise resolves to: 265 (next-promise . callback-args) 266 Or when TAG is supplied: 267 (next-promise TAG . callback-args) 268 Or if ONCE is non-nil: 269 callback-args 270 271 The callback resolves next-promise on the next invocation. This 272 creates a chain of promises representing the sequence of calls. 273 Note: To avoid keeping lots of garbage in memory, avoid holding 274 onto the first promise (i.e. capturing it in a closure). 275 276 The `aio-chain' macro makes it easier to use these promises." 277 (let* ((promise (aio-promise)) 278 (callback 279 (if once 280 (lambda (&rest args) 281 (let ((result (if tag 282 (cons tag args) 283 args))) 284 (aio-resolve promise (lambda () result)))) 285 (lambda (&rest args) 286 (let* ((next-promise (aio-promise)) 287 (result (if tag 288 (cons next-promise (cons tag args)) 289 (cons next-promise args)))) 290 (aio-resolve promise (lambda () result)) 291 (setf promise next-promise)))))) 292 (cons callback promise))) 293 294 ;; A simple little queue 295 296 (defsubst aio--queue-empty-p (queue) 297 "Return non-nil if QUEUE is empty. 298 An empty queue is (nil . nil)." 299 (null (caar queue))) 300 301 (defsubst aio--queue-get (queue) 302 "Get the next item from QUEUE, or nil for empty." 303 (let ((head (car queue))) 304 (cond ((null head) 305 nil) 306 ((eq head (cdr queue)) 307 (prog1 (car head) 308 (setf (car queue) nil 309 (cdr queue) nil))) 310 ((prog1 (car head) 311 (setf (car queue) (cdr head))))))) 312 313 (defsubst aio--queue-put (queue element) 314 "Append ELEMENT to QUEUE, returning ELEMENT." 315 (let ((new (list element))) 316 (prog1 element 317 (if (null (car queue)) 318 (setf (car queue) new 319 (cdr queue) new) 320 (setf (cdr (cdr queue)) new 321 (cdr queue) new))))) 322 323 ;; An efficient select()-like interface for promises 324 325 (defun aio-make-select (&optional promises) 326 "Create a new `aio-select' object for waiting on multiple promises." 327 (let ((select (record 'aio-select 328 ;; Membership table 329 (make-hash-table :test 'eq) 330 ;; "Seen" table (avoid adding multiple callback) 331 (make-hash-table :test 'eq :weakness 'key) 332 ;; Queue of pending resolved promises 333 (cons nil nil) 334 ;; Callback to resolve select's own promise 335 nil))) 336 (prog1 select 337 (dolist (promise promises) 338 (aio-select-add select promise))))) 339 340 (defun aio-select-add (select promise) 341 "Add PROMISE to the set of promises in SELECT. 342 343 SELECT is created with `aio-make-select'. It is valid to add a 344 promise that was previously removed." 345 (let ((members (aref select 1)) 346 (seen (aref select 2))) 347 (prog1 promise 348 (unless (gethash promise seen) 349 (setf (gethash promise seen) t 350 (gethash promise members) t) 351 (aio-listen promise 352 (lambda (_) 353 (when (gethash promise members) 354 (aio--queue-put (aref select 3) promise) 355 (remhash promise members) 356 (let ((callback (aref select 4))) 357 (when callback 358 (setf (aref select 4) nil) 359 (funcall callback)))))))))) 360 361 (defun aio-select-remove (select promise) 362 "Remove PROMISE form the set of promises in SELECT. 363 364 SELECT is created with `aio-make-select'." 365 (remhash promise (aref select 1))) 366 367 (defun aio-select-promises (select) 368 "Return a list of promises in SELECT. 369 370 SELECT is created with `aio-make-select'. " 371 (cl-loop for key being the hash-keys of (aref select 1) 372 collect key)) 373 374 (defun aio-select (select) 375 "Return a promise that resolves when any promise in SELECT resolves. 376 377 SELECT is created with `aio-make-select'. This function is 378 level-triggered: if a promise in SELECT is already resolved, it 379 returns immediately with that promise. Promises returned by 380 `aio-select' are automatically removed from SELECT. Use this 381 function to repeatedly wait on a set of promises. 382 383 Note: The promise returned by this function resolves to another 384 promise, not that promise's result. You will need to `aio-await' 385 on it, or use `aio-result'." 386 (let* ((result (aio-promise)) 387 (callback (lambda () 388 (let ((promise (aio--queue-get (aref select 3)))) 389 (aio-resolve result (lambda () promise)))))) 390 (prog1 result 391 (if (aio--queue-empty-p (aref select 3)) 392 (setf (aref select 4) callback) 393 (funcall callback))))) 394 395 ;; Semaphores 396 397 (defun aio-sem (init) 398 "Create a new semaphore with initial value INIT." 399 (record 'aio-sem 400 ;; Semaphore value 401 init 402 ;; Queue of waiting async functions 403 (cons nil nil))) 404 405 (defun aio-sem-post (sem) 406 "Increment the value of SEM. 407 408 If asynchronous functions are awaiting on SEM, then one will be 409 woken up. This function is not awaitable." 410 (when (<= (cl-incf (aref sem 1)) 0) 411 (let ((waiting (aio--queue-get (aref sem 2)))) 412 (when waiting 413 (aio-resolve waiting (lambda () nil)))))) 414 415 (defun aio-sem-wait (sem) 416 "Decrement the value of SEM. 417 418 If SEM is at zero, returns a promise that will resolve when 419 another asynchronous function uses `aio-sem-post'." 420 (when (< (cl-decf (aref sem 1)) 0) 421 (aio--queue-put (aref sem 2) (aio-promise)))) 422 423 (provide 'aio) 424 425 ;;; aio.el ends here