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