UNB/ CS/ David Bremner/ teaching/ cs4613/ lectures/ lecture15/ printer.rkt
#lang plait
(define (checkpoint-error) (error 'checkpoint "outside with-checkpoint"))
(define cpthunk (make-parameter checkpoint-error))

(define (checkpoint!) ((parameter-ref cpthunk)))
(define-syntax-rule (with-checkpoint body ...)
  (let* ([last-checkpoint (none)])
    (lambda ()
      (parameterize
          ([cpthunk
            (lambda ()
              (let/cc k
                (set! last-checkpoint (some k))))])
        (type-case (Optionof (Void -> 'a)) last-checkpoint
          [(none) (begin body ...)]
          [(some k) (k (void))])))))

(define printer
  (with-checkpoint
    (display "first\n")
        (checkpoint!)
        (display "second\n")))

(printer)
(printer)
(printer)