Created
September 29, 2024 16:47
-
-
Save sporkl/ebf4e11397249f17477bf2bebb9ace3e to your computer and use it in GitHub Desktop.
Toy asynchronous runtime in Racket, inspired by the new OCaml 5 effect system, as an example of where continuations can be useful.
This file contains bidirectional Unicode text that may be interpreted or compiled differently than what appears below. To review, open the file in an editor that reveals hidden Unicode characters.
Learn more about bidirectional Unicode characters
#lang racket | |
(require racket/trace) | |
; the core idea | |
; list of effects | |
; effect handler has continuation at top | |
; effects append to list of effects then jump to effect handler | |
; effect handler handles an effect then jumps to itself (using continuation) | |
; an effect is one of | |
; `(exit ,any) | |
; `(wait-until ,time ,k) | |
; `(output ,s ,k) | |
; `(continue ,k) | |
; an effectinfo is | |
; `(effect-info ,eh ,(box (list effect))) | |
(define pop-effect! | |
(lambda (es) | |
(match (unbox es) | |
[`() `(exit (void))] | |
[`(,a . ,d) | |
(begin | |
(set-box! es d) | |
a)]))) | |
(define queue-effect! | |
(lambda (e es) | |
(set-box! | |
es | |
(append (unbox es) (list e))))) | |
(define handle-effects | |
(lambda (es) | |
(let ([eh (let/cc k k)]) | |
(match (pop-effect! es) | |
[`(exit ,any) any] | |
[`(wait-until ,time ,k) | |
(cond | |
[(> (current-milliseconds) time) | |
(begin | |
(k `(effect-info ,eh ,es)) | |
(eh eh))] | |
[else | |
(begin | |
(queue-effect! `(wait-until ,time ,k) es) | |
(eh eh))])] | |
[`(output ,s ,k) | |
(begin | |
(println s) | |
(k `(effect-info ,eh ,es)) | |
(eh eh))] | |
[`(continue ,k) | |
(begin | |
(k `(effect-info ,eh ,es)) | |
(eh eh))])))) | |
(define exit | |
(lambda (any ei) | |
(match-let ([`(effect-info ,eh ,es) ei]) | |
(begin | |
(queue-effect! `(exit ,any) es) | |
(eh eh))))) | |
(define wait | |
(lambda (ms ei) | |
(match-let ([`(effect-info ,eh ,es) ei]) | |
(let/cc k | |
(begin | |
(queue-effect! `(wait-until ,(+ (current-milliseconds) ms) ,k) es) | |
(eh eh)))))) | |
(define output | |
(lambda (s ei) | |
(match-let ([`(effect-info ,eh ,es) ei]) | |
(let/cc k | |
(begin | |
(queue-effect! `(output ,s ,k) es) | |
(eh eh)))))) | |
(define continue | |
(lambda (ei) | |
(match-let ([`(effect-info ,eh ,es) ei]) | |
(let/cc k | |
(begin | |
(queue-effect! `(continue ,k) es) | |
(eh eh)))))) | |
(define run | |
(lambda (l) | |
(let | |
([initial-effects | |
(map | |
(lambda (f) | |
`(continue ,f)) | |
l)]) | |
(handle-effects (box initial-effects))))) | |
; (trace run continue output wait exit handle-effects queue-effect! pop-effect!) | |
; examples of use | |
#;(run | |
(list | |
(lambda (ei) | |
(begin | |
(wait 5000 ei) | |
(output "a" ei))) | |
(lambda (ei) | |
(begin | |
(wait 3000 ei) | |
(output "c" ei))) | |
(lambda (ei) | |
(begin | |
(wait 500 ei) | |
(output "b" ei))))) | |
#;(run | |
(list | |
(lambda (ei) | |
(letrec | |
([f | |
(lambda (x) | |
(begin | |
(output x ei) | |
(f (add1 x))))]) | |
(f 0))) | |
(lambda (ei) | |
(begin | |
(wait 3000 ei) | |
(exit 'done ei))))) | |
(define sleepsort | |
(lambda (l) | |
(let* ([sl '()] | |
[fs | |
(map | |
(lambda (n) | |
(lambda (ei) | |
(begin | |
(wait n ei) | |
(set! sl (cons n sl))))) | |
l)]) | |
(begin | |
(run fs) | |
sl)))) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment