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