(module tests mzscheme
(require (file "delim-control.ss"))
(display "shift tests") (newline)
(display (+ 10 (reset (+ 2 (shift k (+ 100 (k (k 3))))))))
(newline)
(display (* 10 (reset (* 2 (shift g (reset
(* 5 (shift f (+ (f 1) 1)))))))))
(newline)
(display (let ((f (lambda (x) (shift k (k (k x))))))
(+ 1 (reset (+ 10 (f 100))))))
(newline)
(display (reset
(let ((x (shift f (cons 'a (f '())))))
(shift g x))))
(newline)
(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)
(newline)
(display "control tests") (newline)
(display "Ex 1") (newline)
(display
(let ((g (prompt (* 2 (control k k)))))
(* 3 (prompt (* 5 (abort (g 7)))))))
(newline)
(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)
(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)
(display (prompt (control f (cons 'a (f '())))))
(newline)
(display (prompt (let ((x (control f (cons 'a (f '()))))) (control g (g x)))))
(newline)
(prompt (display (let ((x 'abcde)) (eq? x (((lambda (f) (control* #f #t f))
(lambda (f) (control* #f #t f))) x)))))
(newline)
(display "control0 tests") (newline)
(display (+ 10 (prompt0 (+ 2 (control0 k (+ 100 (k (k 3))))))))
(newline)
(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)
(display (prompt0 (cons 'a (prompt0 (shift0 f (shift0 g '()))))))
(newline)
)