(import continuations simple-tests)

;; export continuation ...
(define 1+ #f)
;; ... with catch
(define (init)
  (+ 1 (catch cont
              (set! 1+ (continuation->procedure cont))
              (throw cont 0))))
;; ... with continuation
(define (init-again)
  (+ 1 (let ((cc (continuation)))
         (cond
           ((continuation? cc)
            (set! 1+ (continuation->procedure cc))
            (throw cc 0))
           (else cc)))))
(define (search ok? lst)
  (catch return
         (for-each (lambda (item)
                     (if (ok? item)
                       (throw return item)))
                   lst)
         #f))
(define (search-with-goto ok? lst)
  (let ((start (continuation)))
    (cond
      ((null? lst) #f)
      ((ok? (car lst)) (car lst))
      (else
        (set! lst (cdr lst))
        (goto start)))))
;; nonlocal return: throw and catch in different procedures
(define (treat ok?)
  (lambda (item cont)
    (if (ok? item)
      (throw cont item))))
(define (handled-search handle lst)
  (catch return
         (for-each (lambda (item)
                     (handle item return))
                   lst)
         #f))

(define-checks (continuations? verbose?)
  (let ((cc (continuation)))
    (cond
      ((continuation? cc)
       (throw cc (lambda (arg) #f)))
      ((procedure? cc)
       (cc cc))))
  #f
  (+ 1 (call (lambda (cc) (* 5 (cc 4)))))
  5
  (search even? '(1 2 3))
  2
  (search even? '(1 3))
  #f
  (search-with-goto odd? '(0 1 2 3))
  1
  (search-with-goto odd? '(0 2))
  #f
  (handled-search (treat even?) '(1 2 3))
  2
  )

(define (product . nums)
  (let ((cc (escape-procedure)))
    (cond
      ((escape-procedure? cc) ; continuation cc just created
       (print "NORMAL BODY")
       (cond 
         ((null? nums) 1)
         ((zero? (car nums))
          (cc 0))
         (else
           (* (car nums) (apply product (cdr nums))))))
      ((number? cc) ; cc has been thrown a number
       (print "EXCEPTIONAL CASE")
       cc)
      )))

(define ep #f)

(define-checks (escape-procedures? verbose?)
  (let ((cc (escape-procedure)))
    (cond
      ((escape-procedure? cc)
       (cc 'normal-value))
      (else
        cc)))
  'normal-value
  (product 1 2 0 3 4)
  0
  (product 1 2 3 4)
  24
  (call/ep (lambda (k)
             (+ 10 (k 1))))
  1
  (string? (let/ep k (set! ep k)
           "continuation exported to ep, but not called"))
  #t
  (escape-procedure? ep)
  #t
  (escape-procedure? +)
  #f
  )
  
(check-all CONTINUATIONS
  (continuations?)
  (escape-procedures?)
  )