;;; simplifying Feeley's continuation interface

(module continuations
  (continuations catch capture graft throw continuation? continuation->procedure)

  (import scheme
          (rename (only chicken
                        continuation-capture
                        continuation-graft
                        continuation-return
                        continuation?)
                  (continuation-capture capture)
                  (continuation-graft graft)
                  (continuation-return throw)))

(define-syntax catch
  (syntax-rules ()
    ((_ cont xpr . xprs)
     (capture (lambda (cont) xpr . xprs)))))

(define (continuation->procedure cont)
  (lambda vals (apply throw cont vals)))

(define (continuations . args)
  (let ((lst '(catch capture continuation? continuation->procedure graft throw)))
    (if (null? args)
      lst
      (case (car args)
        ((catch)
         '(macro ()
             ((_ cont xpr . xprs)
              #t
              (capture (lambda (cont) xpr . xprs)))))
        ((capture)
         '(procedure (result)
            ((_ proc)
             (procedure? proc)
             "alias for continuation-capture")))
        ((continuation?)
         '(procedure (result)
            ((_ xpr) #t (boolean? result))))
        ((continuation->procedure)
         '(procedure (result)
            ((_ cont)
             (continuation? cont)
             (procedure? result))))
        ((graft)
         '(procedure (return)
            ((_ cont thunk)
             (and (continuation? cont) (procedure? thunk))
             "alias for continuation-graft")))
        ((throw)
         '(procedure (result)
            ((_ cont . vals)
             (continuation? cont)
             "alias for continuation-return")))
        (else lst)))))

) ; end continuations