test.scm

(import format)

(define (test)
  (define cont-queue (vector-unfold values 10))
  (define cont-queue-front 0)
  (define cont-queue-back 0)

  (define (cont-queue-size)
    (- cont-queue-front cont-queue-back))

  (define (cont-push c)
    (assert (< (cont-queue-size) 10))
    (set! (vector-ref cont-queue (modulo cont-queue-front 10)) c)
    (set! cont-queue-front (+ cont-queue-front 1)))

  (define (cont-pop)
    (assert (> (cont-queue-size) 0))
    (set! cont-queue-back (+ cont-queue-back 1))
    (let* ((index (modulo (- cont-queue-back 1) 10))
           (cont (vector-ref cont-queue  index)))
      (set! (vector-ref cont-queue index) 0)
      (cont #f)))

  (define (suspend)
    (call/cc (lambda (cont)
               (cont-push cont)
               (cont-pop))))

  (define (spawn f)
    (cont-push (lambda is-nil (f))))

  (define (run)
    (when (> (cont-queue-size) 0)
      (display (format "size: ~A\n" (cont-queue-size)))
      (cont-pop)
      (run)))

  (define (do-times n f)
    (define (go i)
      (when (< i n)
        (begin (f i) (go (+ i 1)))))
    (go 0))

  (define (mk-job job-name)
    (let ((ended #f))
      (lambda ()
        (display (format "~A:start\n" job-name))
        (suspend)
        (do-times
         4
         (lambda (i)
           (display (format "~A ~A:pre\n" job-name i))
           (suspend)
           (display (format "~A ~A:post\n" job-name i))))
        (assert (not ended))
        (set! ended #t)
        (display (format "End! ~A\n" job-name)))))

  (spawn (mk-job "A"))
  (spawn (mk-job "B"))
  ; (spawn (mk-job "C"))
  (run))
(test)