Path: ...!eternal-september.org!feeder3.eternal-september.org!news.eternal-september.org!.POSTED!not-for-mail
From: Dmitri Volkov <dmitri.s.volkov@gmail.com>
Newsgroups: comp.lang.scheme
Subject: Toy asynchronous implementation
Date: Sun, 29 Sep 2024 16:56:46 -0400
Organization: A noiseless patient Spider
Lines: 101
Message-ID: <vdceue$1sli1$1@dont-email.me>
MIME-Version: 1.0
Content-Type: text/plain; charset=UTF-8; format=flowed
Content-Transfer-Encoding: 7bit
Injection-Date: Sun, 29 Sep 2024 22:56:47 +0200 (CEST)
Injection-Info: dont-email.me; posting-host="256c60e8b983c7252dba75bd9ff5a2ac";
	logging-data="1988161"; mail-complaints-to="abuse@eternal-september.org";	posting-account="U2FsdGVkX1+fbmc0MEB37n/Wr8b1WaUV"
User-Agent: Mozilla Thunderbird
Cancel-Lock: sha1:iNhUpo3Rhk7tDp0j93k7gSJQp3s=
Content-Language: en-US
Bytes: 3301

Wrote a toy implementation of asynchronous programming using 
continuations. Posting here in case anyone might find it interesting:

(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)))))

; example 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)))))