;;; $Id: ex08-recursion.tst,v 1.1 2004/02/24 17:59:23 leavens Exp leavens $

(load "ex08-recursion.scm")

   (deftype y-to-z (-> (symbol) symbol))
   (define y-to-z
     (lambda (s)
       (if (eq? s 'y) 'z s)))
   
   (deftype make-swapper (-> (symbol symbol) (-> (symbol) symbol)))
   (define make-swapper
     (lambda (a b)
       (lambda (s)
         (cond
          ((eq? s a) b)
          ((eq? s b) a)
          (else s)))))

   (deftype make-replacer (forall (S T) (-> (S T) (-> (S) T))))
   (define make-replacer
     (lambda (old new)
       (lambda (x)
         (if (eqv? x old) new x))))
   
   (deftype make-swapper (forall (T) (-> (T T) (-> (T) T))))
   (define make-swapper
     (lambda (a b)
       (lambda (x)
         (cond
          ((eqv? x a) b)
          ((eqv? x b) a)
          (else x)))))

(run-regression-tests-equal?
 `(

   ;; tests for sym-exp-map

  ( (sym-exp-map y-to-z (parse-sym-exp '())) 
             = (parse-sym-exp '()) )
  ( (sym-exp-map y-to-z (parse-sym-exp 'y))  
             = (parse-sym-exp 'z) )
  ( (sym-exp-map y-to-z (parse-sym-exp 'x))  
             = (parse-sym-exp 'x) )
  ( (sym-exp-map y-to-z (parse-sym-exp '(v w x y)))
             = (parse-sym-exp '(v w x z)) )
  ( (sym-exp-map y-to-z
		 (parse-sym-exp '(w () (((x))) (() y) () x (() (y) ((() v))))))
             = (parse-sym-exp '(w () (((x))) (() z) () x (() (z) ((() v))))) )
  ( (sym-exp-map (make-swapper 'x 'y) (parse-sym-exp '()))
             = (parse-sym-exp '()) )
  ( (sym-exp-map (make-swapper 'x 'y) (parse-sym-exp 'y))
             = (parse-sym-exp 'x) )
  ( (sym-exp-map (make-swapper 'x 'y) (parse-sym-exp 'x))
             = (parse-sym-exp 'y) )
  ( (sym-exp-map (make-swapper 'x 'y) (parse-sym-exp '(v () ((w x (y ()))))))
             = (parse-sym-exp '(v () ((w y (x ()))))) )
  ( (sym-exp-map (make-swapper 'x 'y)
		 (parse-sym-exp '(w () x (((y (()))) x ((y) v)))))
             = (parse-sym-exp '(w () y (((x (()))) y ((x) v)))) )
  ( (sym-exp-map (make-swapper 'x 'y)
		 (parse-sym-exp '((((x (((((y)) () x)))))))))
             = (parse-sym-exp '((((y (((((x)) () y)))))))) )

  ;; tests for atomic-exp-map

  ( (atomic-exp-map (make-replacer 'y 'z) (parse-atomic-exp symbol? '())) 
             = (parse-atomic-exp symbol? '()) )
  ( (atomic-exp-map (make-replacer 'y 'z) (parse-atomic-exp symbol? 'y))  
             = (parse-atomic-exp symbol? 'z) )
  ( (atomic-exp-map (make-replacer 333333333333333 4)
		    (parse-atomic-exp number? 333333333333333))  
             = (parse-atomic-exp number? 4) )
  ( (atomic-exp-map (make-replacer 333333333333333 4)
		    (parse-atomic-exp number? 342))  
             = (parse-atomic-exp number? 342) )
  ( (atomic-exp-map (make-replacer #t #f)
		    (parse-atomic-exp boolean? '(#t #f #t #t)))
             = (parse-atomic-exp boolean? '(#f #f #f #f)) )
  ( (atomic-exp-map (make-replacer 3 4)
		    (parse-atomic-exp number? '(72 () (((3))) (() 5) () 3
						   (() (3) ((() 541))))))
             = (parse-atomic-exp number? '(72 () (((4))) (() 5) () 4
					      (() (4) ((() 541))))) )
  ( (atomic-exp-map (make-swapper 'x 'y) (parse-atomic-exp symbol? '()))
             = (parse-atomic-exp symbol? '()) )
  ( (atomic-exp-map (make-swapper 'x 'y) (parse-atomic-exp symbol? 'y))
             = (parse-atomic-exp symbol? 'x) )
  ( (atomic-exp-map (make-swapper 'x 'y) (parse-atomic-exp symbol? 'x))
             = (parse-atomic-exp symbol? 'y) )
  ( (atomic-exp-map (make-swapper 3 4)
		    (parse-atomic-exp number? '(72 () ((43 3 (4 ()))))))
             = (parse-atomic-exp number? '(72 () ((43 4 (3 ()))))) )
  ( (atomic-exp-map (make-swapper 311 321)
		    (parse-atomic-exp
		     number?
		     '(217 () 311 ((321 (())) 311 ((321) 430)))))
             = (parse-atomic-exp number?
				 '(217 () 321 ((311 (())) 321 ((311) 430)))) )
  ( (atomic-exp-map (make-swapper #f #t)
		 (parse-atomic-exp boolean? '((((#t (((((#f)) () #t)))))))))
             = (parse-atomic-exp boolean? '((((#f (((((#t)) () #f)))))))) )

   )
 )