;;; -*- Mode: Scheme -*-

;;;; SRFI p: Composable Continuations
;;;; Reference Implementation

;;; This code is written by Taylor Campbell and placed in the Public
;;; Domain.  All warranties are disclaimed.

(define-record-type :continuation-delimiter
  (%make-continuation-delimiter link)
  continuation-delimiter?
  (link continuation-delimiter-link set-continuation-delimiter-link!))

(define (make-continuation-delimiter)
  (letrec ((delimiter (lambda vals
                        (error "outside delimited context"
                               delimiter
                               vals))))
    delimiter))

(define (delimit-continuation delimiter thunk)
  (call-with-values thunk
    (lambda vals
      (apply (continuation-delimiter-link delimiter)
             vals))))

(define (with-delimited-continuation delimiter thunk)
  (let ((old-link (continuation-delimiter-link delimiter)))
    (call-with-current-continuation
      (lambda (new-link)
        (set-continuation-delimiter-link!
         delimiter
         (lambda vals
           (set-continuation-delimiter-link! delimiter old-link)
           (apply new-link vals)))
        (delimit-continuation delimiter thunk)))))

(define (call-with-continuation-delimiter recipient)
  (let ((delimiter (make-continuation-delimiter)))
    (with-delimited-continuation delimiter
      (lambda ()
        (recipient delimiter)))))

(define (call-with-composable-continuation delimiter recipient)
  (call-with-current-continuation
    (lambda (return-arguments)
      (delimit-continuation delimiter
        (lambda ()
          (recipient (lambda args
                       (with-delimited-continuation delimiter
                         (lambda ()
                           (apply return-arguments args))))))))))