tests.ss
(module tests mzscheme
  (require (file "delim-control.ss"))
  
  ;------------------------------------------------------------------------
  ;			Shift tests
  (display "shift tests") (newline)
  
  (display (+ 10 (reset (+ 2 (shift k (+ 100 (k (k 3))))))))
  (newline)
  ; --> 117
  
  (display (* 10 (reset (* 2 (shift g (reset 
                                       (* 5 (shift f (+ (f 1) 1)))))))))
  (newline)
  ; --> 60
  
  (display (let ((f (lambda (x) (shift k (k (k x))))))
             (+ 1 (reset (+ 10 (f 100))))))
  (newline)
  ; --> 121
  
  (display (reset
            (let ((x (shift f (cons 'a (f '())))))
              (shift g x))))
  (newline)
  ; ==> '(a)
  
  (define (p x) (if (eq? x p) '(p p) `(p ,x)))
  (define (shift* p) (shift f (p f)))
  (reset (display (let ((x 'abcde)) (eq? x ((shift* shift*) x)))))
  (newline)
  
  (define traverse0
    (lambda (xs)
      (letrec ((visit
                (lambda (xs)
                  (if (null? xs)
                      '()
                      (visit (control*
                              #t #t
                              (lambda (k)
                                (cons (car xs) (k (cdr xs))))))))))
        (prompt*
         (lambda ()
           (visit xs))))))
  
  (display "Ex by Oliview Danvy") (newline)
  (display (traverse0 '(1 2 3 4 5)))
  (newline)
  
  ;------------------------------------------------------------------------
  ;			Control tests
  ; Example from Sitaram, Felleisen
  
  (newline)
  (display "control tests") (newline)
  
  (display "Ex 1") (newline)
  (display
   (let ((g (prompt (* 2 (control k k)))))
     (* 3 (prompt (* 5 (abort (g 7)))))))
  (newline)
  
  
  ; Olivier Danvy's puzzle
  
  (define traverse1
    (lambda (xs)
      (letrec ((visit
                (lambda (xs)
                  (if (null? xs)
                      '()
                      (visit (control*
                              #f #t
                              (lambda (k)
                                (cons (car xs) (k (cdr xs))))))))))
        (prompt*
         (lambda ()
           (visit xs))))))
  
  (display "Ex by Oliview Danvy") (newline)
  (display (traverse1 '(1 2 3 4 5)))
  (newline)
  
  (display (+ 10 (prompt (+ 2 (control k (+ 100 (k (k 3))))))))
  (newline)
  ; --> 117
  
  (display (prompt (let ((x (control f (cons 'a (f '()))))) (control g x))))
  (newline)
  ; ==> '()
  
  (display (prompt ((lambda (x) (control l 2)) (control l (+ 1 (l 0))))))
  (newline)
  ;  ==> 2
  (display (prompt (control f (cons 'a (f '())))))
  (newline)
  ; ==> '(a)
  (display (prompt (let ((x (control f (cons 'a (f '()))))) (control g (g x)))))
  (newline)
  ; ==> '(a)
  
  (prompt (display (let ((x 'abcde)) (eq? x (((lambda (f) (control* #f #t f))
                                              (lambda (f) (control* #f #t f))) x)))))
  (newline)
  
  
  ;------------------------------------------------------------------------
  ;			shift0/control0 tests
  
  (display "control0 tests") (newline)
  
  (display (+ 10 (prompt0 (+ 2 (control0 k (+ 100 (k (k 3))))))))
  (newline)
  ; --> 117
  
  (display (prompt0 (prompt0 
                     (let ((x (control0 f (cons 'a (f '()))))) (control0 g x)))))
  (newline)
  ; ==> '()
  
  
  (display "shift0 tests") (newline)
  
  (display (+ 10 (prompt0 (+ 2 (shift0 k (+ 100 (k (k 3))))))))
  (newline)
  ; --> 117
  
  (display (prompt0 (cons 'a (prompt0 (shift0 f (shift0 g '()))))))
  (newline)
  ; ==> '()
  )