;;; Corrected 1:30am 6 April 2008
;;;
;;; (The multiple-shadowing-in-rhs test specified an incorrect result.)

(module tests mzscheme
  
  (provide test-list)
  ;;;;;;;;;;;;;;;; tests ;;;;;;;;;;;;;;;;
  
  (define test-list
    '(
  
      ;; simple arithmetic
      (positive-const "11" 11)
      (negative-const "-33" -33)
      (simple-arith-1 "-(44,33)" 11)
  
      ;; nested arithmetic
      (nested-arith-left "-(-(44,33),22)" -11)
      (nested-arith-right "-(55, -(22,11))" 44)
  
      ;; simple variables
      (test-var-1 "x" 10)
      (test-var-2 "-(x,1)" 9)
      (test-var-3 "-(1,x)" -9)
      
      ;; simple unbound variables
      (test-unbound-var-1 "foo" error)
      (test-unbound-var-2 "-(x,foo)" error)
  
      ;; simple conditionals
      (if-true "if =(0,0) then 3 else 4" 3)
      (if-false "if =(0,1) then 3 else 4" 4)
      
      ;; test dynamic typechecking
      (no-bool-to-diff-1 "-(=(0,0),1)" error)
      (no-bool-to-diff-2 "-(1,=(0,0))" error)
      (no-int-to-if "if 1 then 2 else 3" error)

      ;; make sure that the test and both arms get evaluated
      ;; properly. 
      (if-eval-test-true "if =(0,-(11,11)) then 3 else 4" 3)
      (if-eval-test-false "if =(0,-(11, 12)) then 3 else 4" 4)
      
      ;; and make sure the other arm doesn't get evaluated.
      (if-eval-test-true-2 "if =(0,-(11, 11)) then 3 else foo" 3)
      (if-eval-test-false-2 "if =(0,-(11,12)) then foo else 4" 4)

      ;; translation of simple let
      (simple-let-1 "define f = proc (x) x
                    (f 3)"
         3)

      ;; make sure the bodies and operands get evaluated
      (eval-proc-body-1 "define f = proc (x) -(x,1)
                         (f 3)"
         2)

      (eval-proc-body-2 "define f = proc (x) -(x,1)
                         (f -(4,1))"
         2)

      ;; check shadowing
      (eval-proc-body-2 "define x = proc (x) -(x,1)
                         (x -(4,1))"
         2)

      ;; zero arguments
      (zero-arguments "define f = proc () 13
                       define g = proc () 14
                       *((f),(g))"
        182)

      ;; two or more arguments
      (two-arguments "define f = proc (x y) *(x,y)
                      define g = proc (a b) +(a,b)
                      (f (g 3 10) (g 7 7))"
        182)

      (fact-of-6  "define fact = proc (x) if =(0,x)
                                            then 1
                                            else *(x, (fact -(x,1)))
                   (fact 6)"
        720)

      (mutual-recursion
        "define even = proc (n) if =(0,n) then true else (odd -(n,1))
         define odd = proc (n) if =(0,n) then false else (even -(n,1))
         (odd 13)"
        #t)
      
      (higher-order
       "define search = proc (x f i j)
                          if >(i,j)
                             then -1
                             else if =(x,(f i))
                                     then i
                                     else (search x f +(i,1) j)
        define g = proc (square x a b c)
                     +(*(a,(square x)),+(*(b,x),c))
        define square = proc (x) *(x,x)
        define h = proc (x) (g square x 5 -13 7)
        (search 1231 h 0 25)"
       17)

      (prime
       "define prime = proc (i)
                         if <(i,2)
                            then +(i,2)
                            else (primesearch +(2,(prime -(i,1))))
        define primesearch = proc (n)
                               if (primetest n)
                                  then n
                                  else (primesearch +(n,2))
        define primetest = proc (n)
                             if (divides 2 n)
                                then false
                                else (primetests 3 n)
        define primetests = proc (d n)
                              if >(*(d,d),n)
                                 then true
                                 else if (divides d n)
                                         then false
                                         else (primetests +(d,2) n)
        define divides = proc (d n)
                           (dividesloop 1 d n)
        define dividesloop = proc (q d n)
                               if =(*(q,d),n)
                                  then true
                                  else if >(*(q,d),n)
                                          then false
                                          else (dividesloop +(q,1) d n)
        (prime 30)"
       127)
                           
      (product
       "define product = proc (f i j)
                           if <(i,j)
                              then *((f i),(product f +(i,1) j))
                              else 1
        define prime = proc (i)
                         if <(i,2)
                            then +(i,2)
                            else (primesearch +(2,(prime -(i,1))))
        define primesearch = proc (n)
                               if (primetest n)
                                  then n
                                  else (primesearch +(n,2))
        define primetest = proc (n)
                             if (divides 2 n)
                                then false
                                else (primetests 3 n)
        define primetests = proc (d n)
                              if >(*(d,d),n)
                                 then true
                                 else if (divides d n)
                                         then false
                                         else (primetests +(d,2) n)
        define divides = proc (d n)
                           (dividesloop 1 d n)
        define dividesloop = proc (q d n)
                               if =(*(q,d),n)
                                  then true
                                  else if >(*(q,d),n)
                                          then false
                                          else (dividesloop +(q,1) d n)
        (product prime 0 20)"
       557940830126698960967415390)
                           
      ;; simple let

      (simple-let-1 "let x = 3 in x" 3)

      ;; make sure the body and rhs get evaluated

      (eval-let-body "let x = 3 in -(x,1)" 2)
      (eval-let-rhs "let x = -(4,1) in -(x,1)" 2)

      ;; check nested let and shadowing

      (simple-nested-let "let x = 3 in let y = 4 in -(x,y)" -1)
      (check-shadowing-in-body "let x = 3 in let x = 4 in x" 4)
      (check-shadowing-in-rhs "let x = 3 in let x = -(x,1) in x" 2)

      ;; no binding

      (simple-let-0-1 "let in 13" 13)
      (simple-let-0-2 "let in let in let in +(3,4)" 7)

      ;; multiple bindings

      (multiple-let "let x = 3 y = 4 in -(x,y)" -1)
      (multiple-shadowing-in-body "let y = 15 x = 3 in let x = 4 in x" 4)
      (multiple-shadowing-in-rhs
       "let x = 4
            y = 1
        in
        let x = *(x,x)
            y = -(x,y)
        in y"
       3)

      (higher-order-return-0
       "define search = proc (x f i j)
                          if >(i,j)
                             then return -1
                             else if =(x,(f i))
                                     then return i
                                     else return (search x f +(i,1) j)
        define g = proc (square x a b c)
                     +(*(a,(square x)),+(*(b,x),c))
        define square = proc (x) *(x,x)
        define h = proc (x) (g square x 5 -13 7)
        (search 1231 h 0 25)"
       17)

      (higher-order-return-1
       "define search = proc (x f i j)
                          return
                            if >(i,j)
                               then -1
                               else if =(x,(f i))
                                       then i
                                       else (search x f +(i,1) j)
        define g = proc (square x a b c)
                     +(*(a,(square x)),+(*(b,x),c))
        define square = proc (x) *(x,x)
        define h = proc (x) (g square x 5 -13 7)
        (search 1231 h 0 25)"
       17)

      (return-from-nested-binops-0
       "define f = proc (x y)
                     +(x,*(y,(f -(x,1)
                                if <(y,0)
                                   then return -1
                                   else -(y,1))))
        (f 4 -6)"
       -1)

      (return-from-nested-binops-1
       "define f = proc (x y)
                     +(x,*(y,(f -(x,1)
                                if <(y,0)
                                   then return -1
                                   else -(y,1))))
        (f 4 3)"
       31)

      (return-error
       "define f = proc (x y) *(x,y)
        if >((f 1 2),0) then return 1 else 33"
       error)

      ))
  )