Skip to content

Instantly share code, notes, and snippets.

@nkoguro

nkoguro/pcdemo7.scm Secret

Created Jun 1, 2020
Embed
What would you like to do?
(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