(use data.queue) | |
(use gauche.parameter) | |
;;; Copied from https://github.com/kahua/Kahua/blob/66f593dd09966b4cfaac79e3119e189a791d4564/src/kahua/partcont.scm | |
(define meta-continuation | |
(make-parameter | |
(lambda _ (error "stale meta-continuation invoked")))) | |
(define-syntax reset/pc | |
(syntax-rules () | |
((reset/pc expr) | |
(%reset (lambda () expr))))) | |
(define-syntax let/pc | |
(syntax-rules () | |
((let/pc kont . body) | |
(call/pc (lambda (kont) . body))))) | |
(define (%abort thunk) | |
(receive v (thunk) | |
(apply (meta-continuation) v))) | |
(define (%reset thunk) | |
(let1 save (meta-continuation) | |
(call/cc | |
(lambda (k) | |
(meta-continuation (lambda vals | |
(meta-continuation save) | |
(apply k vals))) | |
(%abort thunk))))) | |
(define (call/pc proc) | |
(call/cc | |
(lambda (k) | |
(%abort (lambda () | |
(proc (lambda vals (reset/pc (apply k vals))))))))) | |
;;; | |
(define queue (make-queue)) | |
(define (wrap thunk) | |
(lambda () | |
(guard (e (else (print "catch!") | |
(raise e))) | |
(reset/pc | |
(thunk))) | |
'end-of-wrap)) | |
(define (yield) | |
(call/pc (lambda (cont) | |
(enqueue! queue (wrap cont)) | |
'end-of-shift))) | |
(define (main args) | |
(enqueue! queue (wrap (lambda () | |
(let1 counter 0 | |
(while #t | |
(inc! counter) | |
(when (= counter 10000) | |
(set! counter 0) | |
(format #t "~s~%" (gc-stat))) | |
(yield)))))) | |
(while #t | |
(let1 next (dequeue! queue #f) | |
(when next | |
(next)))) | |
0) |
Sign up for free
to join this conversation on GitHub.
Already have an account?
Sign in to comment