pcdemo7.scm

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