(module test-suite mzscheme

  (provide tests-for-run tests-for-check tests-for-parse)

  (define the-test-suite
    '(
      ;; tests from run-tests:
  
;;       ;; simple arithmetic
;;       (positive-const "11" int 11)
;;       (negative-const "-33" int -33)
;;       (simple-arith-1 "-(44,33)" int 11)
  
;;       ;; nested arithmetic
;;       (nested-arith-left "-(-(44,33),22)" int -11)
;;       (nested-arith-right "-(55, -(22,11))" int 44)
  
;;       ;; simple variables
;;       (test-var-1 "x" error)
;;       (test-var-2 "-(x,1)" error)
;;       (test-var-3 "-(1,x)" error)

;;       (zero-test-1 "zero?(-(3,2))" bool #f)
;;       (zero-test-2 "-(2,zero?(0))" error)
      
;;       ;; simple unbound variables
;;       (test-unbound-var-1 "foo" error)
;;       (test-unbound-var-2 "-(x,foo)" error)
  
;;       ;; simple conditionals
;;       (if-true "if zero?(0) then 3 else 4" int 3)
;;       (if-false "if zero?(1) then 3 else 4" int 4)

;;       ;; make sure that the test and both arms get evaluated
;;       ;; properly. 
;;       (if-eval-test-true "if zero?(-(11,11)) then 3 else 4" int 3)
;;       (if-eval-test-false "if zero?(-(11,12)) then 3 else 4" int 4)
;;       (if-eval-then "if zero?(0) then -(22,1) else -(22,2)" int 21)
;;       (if-eval-else "if zero?(1) then -(22,1) else -(22,2)" int 20)
      
;;       ;; make sure types of arms agree (new for lang5-1)
      
;;       (if-compare-arms "if zero?(0) then 1 else zero?(1)" error)
;;       (if-check-test-is-boolean "if 1 then 11 else 12" error)

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

;;       ;; make sure the body and rhs get evaluated
;;       (eval-let-body "let x = 3 in -(x,1)" int 2)
;;       (eval-let-rhs "let x = -(4,1) in -(x,1)" int 2)

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

      ;; simple applications
      (apply-proc-in-rator-pos "(proc(x : int) -(x,1)  30)" int 29)
      (checker-doesnt-ignore-type-info-in-proc-but-interp-does 
        "(proc(x : (int -> int)) -(x,1)  30)"
        error 29) 
      (apply-simple-proc "let f = proc (x : int) -(x,1) in (f 30)" int 29)
      (let-to-proc-1
        "(proc( f : (int -> int))(f 30)  proc(x : int)-(x,1))" int 29)

      (nested-procs "((proc (x : int) proc (y : int) -(x,y)  5) 6)" int -1)
      (nested-procs2
        "let f = proc (x : int) proc (y : int) -(x,y) in ((f -(10,5)) 3)"
        int 2)
      
      ;; simple letrecs
      (simple-letrec-1 "letrec int f(x : int) = -(x,1) in (f 33)" int 32)
      (simple-letrec-2
        "letrec int double(x : int) = if zero?(x) then 0 else -((double -(x,1)), -2) in (double 4)"
        int 8)

      (simple-letrec-3
        "let m = -5 
 in letrec int f(x : int) = if zero?(x) then 0 else -((f -(x,1)), m) in (f 4)"
        int 20)

      (double-it "
letrec int double (n : int) = if zero?(n) then 0 
                                  else -( (double -(n,1)), -2)
in (double 3)"
        int 6)

      ;; tests of expressions that produce procedures

      (build-a-proc-typed "proc (x : int) -(x,1)" (int -> int))

      (build-a-proc-typed-2 "proc (x : int) zero?(-(x,1))" (int -> bool))
      
      (bind-a-proc-typed
        "let f = proc (x : int) -(x,1) in (f 4)"
        int 3) 

      (bind-a-proc-return-proc
        "let f = proc (x : int) -(x,1) in f"
        (int -> int))

      (type-a-ho-proc-1
        "proc(f : (int -> bool)) (f 3)"
        ((int  -> bool) -> bool))

      (type-a-ho-proc-2
        "proc(f : (bool -> bool)) (f 3)"
        error)

      (apply-a-ho-proc
        "proc (x : int) proc ( f : (int -> bool)) (f x)"
        (int -> ((int -> bool) -> bool)))

      (apply-a-ho-proc-2
        "proc (x : int) proc ( f : (int -> (int -> bool))) (f x)"
        (int -> ((int -> (int -> bool)) -> (int -> bool)))
        )

      (apply-a-ho-proc-3
        "proc (x : int) proc ( f : (int -> (int -> bool))) (f zero?(x))"
	error)

      (apply-curried-proc
        "((proc(x : int) proc (y : int)-(x,y)  4) 3)"
        int 1)

      (apply-a-proc-2-typed
        "(proc (x : int) -(x,1) 4)" 
        int 3)

      (apply-a-letrec "
letrec int f(x : int) = -(x,1)
in (f 40)"
        int 39)

      (letrec-non-shadowing
        "(proc (x : int)
      letrec bool loop(x : bool) =(loop x)
       in x
     1)"
        int 1)


      (letrec-return-fact "
let times = proc (x : int) proc (y : int) -(x,y)    % not really times
in letrec 
     int fact(x : int) = if zero?(x) then 1 else ((times x) (fact -(x,1)))
   in fact"
        (int -> int))

      (letrec-apply-the-fcn "
let f = proc (x : int) proc (y : int) -(x,y)   
in letrec 
     int loop(x : int) = if zero?(x) then 1 else ((f x) (loop -(x,1)))
   in (loop 4)"
        int 3)

       (modules-declare-and-ignore "
module m
 interface 
  [u : int]
 body 
  [u = 3]

33"
        int 33)

       (modules-take-one-value "
module m
 interface 
  [u : int]
 body 
  [u = 3]

from m take u"
        int 3)

       (modules-take-one-value-no-import
        "module m 
          interface 
           [u : int] 
          body 
           [u = 3]
         from m take u"
        int 3)

       (modules-take-from-parameterized-module "
module m
 interface 
  ((m1 : []) => [u : int])
 body 
  module-proc (m1 : []) [u = 3]

from m take u
"
        error error)

       (modules-check-iface-subtyping-1 "
module m 
 interface 
  [u : int]
 body 
  [u = 3 v = 4]
from m take u"
        int 3)


       ;; if the interpreter always called the typechecker, or put
       ;; only declared variables in the module, this would raise an
       ;; error.  Exercise: make this modification.

       (modules-take-one-value-but-interface-bad "
         module m interface []  body [u = 3]
         from m take u"
; this version for permissive interp
        error 3
; this version for strict interp
;         error error
        )

       (modules-take-bad-value
        "module m interface []  body [u = 3]
         from m take x"
        error error)       

        (modules-two-vals "
module m
 interface 
  [u : int 
   v : int] 
 body
  [u = 44
   v = 33]

  -(from m take u, from m take v)"
        int 11)


        (modules-two-vals-bad-interface-1
        "module m interface [u : int v : bool]  
                  body [u = 44 v = 33]
         -(from m take u, from m take v)"
        error 11)

        (modules-extra-vals-are-ok-1 "
          module m interface [x : int] body [x = 3 y = 4]
          from m take x"
          int 3)

        (module-extra-vals-are-ok-2 "
          module m interface [y : int] body [x = 3 y = 4]
          from m take y"
          int)
          
        (module-extra-types-are-ok-11 
          "module m interface [y : int] body [x = 3 type t = int y = 4]
         from m take y"
          int 4)

        (module-extra-types-are-ok-12
          "module m interface [opaque t y : int] 
                    body [type u = bool x = 3 type t = int y = 4]
          from m take y"
          int)

        (module-extra-types-are-ok-13
          "module m interface [transparent t = int y : int] 
                    body [type u = bool x = 3 type t = int y = 4]
          from m take y"
          int 4)


       (modules-two-vals-bad-interface-14
        "module m interface 
            [v : int 
             u : bool]
          body 
           [v = zero?(0) u = 33]
         -(from m take u, from m take v)"
        error)


        (modules-check-let*-1
        "module m interface      [u : int v : int]
                  body [u = 44  v = -(u,11)]
         -(from m take u, from m take v)"
        int 11)

      (modules-check-let*-2.0
        "module m1 interface [u : int] body [u = 44]
         module m2 interface [v : int] 
          body 
           [v = -(from m1 take u,11)]
         -(from m1 take u, from m2 take v)"
        int 11)

      (modules-check-let*-2.05
        "module m1 interface [u : int] body [u = 44]
         module m2 interface [v : int] body [v = -(from m1 take u,11)]
         33"
        int 33)                       ; doesn't actually import anything

      (modules-check-let*-2.1
        "module m1 interface [u : int] body [u = 44]
         module m2   
          interface [v : int] 
          body [v = -(from m1 take u,11)]
         -(from m1 take u, from m2 take v)"
        int 11)

     (modules-check-let*-2.2
        "module m2
          interface [v : int] 
          body 
           [v = -(from m1 take u,11)]
         module m1 interface [u : int] body [u = 44]
         -(from m1 take u, from m2 take v)"
        error)

      (modules-check-parameterized-1 "
        module m1 
            interface ((m : [v : int]) => [w : int])
            body 
             module-proc (m : [v : int]) [w = -(from m take v, 1)]
        module m2 
         interface [v : int] 
         body [v = 33]
        module m3  
         interface [w : int] 
         body 
          (m1 m2)
        from m3 take w"
        int 32)

      (modules-check-parameterized-bad-argument "
        module m1 
            interface ((m : [v : int]) =>  [w : int])
            body 
             module-proc (m : [v : int]) [w = from m take v]
        module m2 interface [u : int] body [u = 33]
        module m3 
         interface [w : int] 
         body
           (m1 m2)
        from m3 take w"
        error)
        
      (modules-check-parameterized-bad-interface-1 "
        module m1 
            interface ((m : [v : int])  => [w : int])
            body module-proc (m : [v : int]) [w = from m take v]
        module m2 interface [v : int] body [x = 33]  % bad
        module m3 interface [w : int] body  (m1 m2)
        from m3 take w"
        error)

      (modules-check-parameterized-2 "
        module m1
         interface 
          ((m : [v : int]) => [u : int])
         body
          module-proc (m : [v : int]) [w = from m take v]
        module m2 
         interface [v : int] 
         body [v = 33]
        module m3   interface [w : int] body 
         (m1 m2)
        from m3 take w"
        error)

      (modules-export-abs-type-1
        "module m1 interface [opaque t] body [type t = int]
         33"
        int 33)

      (modules-take-from-ints-0.1
        "module m1
          interface [opaque t  
             zero : t] 
          body [type t = int
             zero = 0]
         33"
        int 33)

      (modules-take-from-ints-0.1a
        "module m1
          interface [opaque t  
             zero : t] 
          body [type t = int
             zero = 0]
         from m1 take zero"
        (from m1 take t) 0)

       (modules-take-from-ints-0.1.91
        "module m1
            interface [opaque t
               zero : t]
            body [type t = int
               zero = 0
               foo = 3]
         let check = proc (x : from m1 take t) zero?(0)
         in (check  from m1 take zero)"
        bool #t)

       (modules-take-from-ints-0.1.91a
        "module m1
            interface [opaque t
               zero : t]
            body [type t = int
               zero = 0
               foo = 3]
         let check = proc (x : from m1 take t  ) zero?(0)
         in check"
        ((from m1 take t) -> bool))

       (modules-take-from-ints-0.2
        "module m1
          interface [opaque t
             zero : t
             check : (t -> bool)] 
          body [type t = int
             zero = 0
             check = proc(x : t) zero?(x)]
         (from m1 take check  from m1 take zero)"
        bool #t)

       (modules-mybool-1
        "module mybool 
          interface [opaque t
             true : t
             false : t
             and : (t -> (t -> t))
             not : (t -> t)
             to-bool : (t -> bool)]
          body [type t = int
             true = 0
             false = 1
             and = proc (x : t) proc (y : t)
                        if zero?(x) then y else false
             not = proc (x : t) if zero?(x) then false else true
             to-bool = proc (x : t) 
                            if zero?(x) then zero?(0) else zero?(1)
             ]
          (from mybool take to-bool  
           from mybool take false)
          "
         bool #f)

       (modules-mybool-1a
        "module mybool 
          interface [opaque t
             true : t
             false : t
             and : (t -> (t -> t))
             not : (t -> t)
             to-bool : (t -> bool)]
          body [type t = int
             true = 0
             false = 1
             and = proc (x : t) proc (y : t)
                        if zero?(x) then y else false
             not = proc (x : t) if zero?(x) then false else true
             to-bool = proc (x : t) 
                            if zero?(x) then zero?(0) else zero?(1)
             ]
          from mybool take to-bool"
        ((from mybool take t) -> bool))

       (modules-mybool-1b
        "module mybool 
          interface [opaque t
             true : t
             false : t
             and : (t -> (t -> t))
             not : (t -> t)
             to-bool : (t -> bool)]
          body [type t = int
             true = 0
             false = 1
             and = proc (x : t) proc (y : t)
                        if zero?(x) then y else false
             not = proc (x : t) if zero?(x) then false else true
             to-bool = proc (x : t) 
                            if zero?(x) then zero?(0) else zero?(1)
             ]
           from mybool take false
          "
         (from mybool take t) )

      (modules-take-from-ints-1
        "module ints-1
          interface [opaque t
             zero : t
             succ : (t -> t)
             pred : (t -> t) 
             check : (t -> bool)]
          body [type t = int
             zero = 0
             succ = proc(x : t) -(x,-1)
             pred = proc(x : t) -(x,1)
             check = proc(x : t) zero?(0)]
         let z = from ints-1 take zero
         in let s = from ints-1 take succ
         in let p = from ints-1 take pred
         in let check = from ints-1 take check
         in (check (s (s (p (s z)))))"
        bool #t)

      (modules-take-from-ints-1a
        "module ints-1
          interface [opaque t
             zero : t
             succ : (t -> t)
             pred : (t -> t) 
             check : (t -> bool)]
          body [type t = int
             zero = 0
             succ = proc(x : t) -(x,-1)
             pred = proc(x : t) -(x,1)
             check = proc(x : t) zero?(0)]
         let z = from ints-1 take zero
         in let s = from ints-1 take succ
         in let p = from ints-1 take pred
         in let check = from ints-1 take check
         in s"
        ((from ints-1 take t) -> (from ints-1 take t)))


      (modules-take-from-ints-1b
        "module ints-1
          interface [opaque t
             zero : t
             succ : (t -> t)
             pred : (t -> t) 
             check : (t -> bool)]
          body [type t = int
             zero = 0
             succ = proc(x : t) -(x,-1)
             pred = proc(x : t) -(x,1)
             check = proc(x : t) zero?(0)]
         let z = from ints-1 take zero
         in let s = from ints-1 take succ
         in let p = from ints-1 take pred
         in let check = from ints-1 take check
         in check"
        ((from ints-1 take t) -> bool))


   (modules-take-from-ints-2
        "module ints-1
          interface [opaque t
             zero : t
             succ : (t -> t)
             pred : (t -> t)
             is-zero : (t -> bool)] 
          body [type t = int
             zero = 0
             succ = proc(x : t) -(x,-1)
             pred = proc(x : t) -(x,1)
             is-zero = proc (x : t) zero?(x)]
         let z = from ints-1 take zero
         in let s = from ints-1 take succ
         in let p = from ints-1 take pred
         in let z? = from ints-1 take is-zero
         in if (z? (s z)) then 22 else 33"
        int 33)

   
   (modules-take-from-ints-2-bad-1
        "module ints-1
          interface [opaque t
             zero : t
             succ : (t -> t)
             pred : (t -> t)
             is-zero : (t -> bool)] 
          body [zero = proc (x : t) x
             succ = proc(x : t) -(x,-1)
             pred = proc(x : t) -(x,1)
             is-zero = proc (x : t) zero?(x)
             ]
         let z = from ints-1 take zero
         in let s = from ints-1 take succ
         in let p = from ints-1 take pred
         in let z? = from ints-1 take is-zero
         in if (z? (s z)) then 22 else 33"
        error)

   (modules-take-from-ints-3
        "module ints-1
          interface [opaque t
             zero : t
             succ : (t -> t)
             pred : (t -> t)
             is-zero : (t -> int)] 
          body [zero = 0
             succ = proc(x : t) -(x,-1)
             pred = proc(x : t) -(x,1)
             is-zero = proc (x : t) zero?(x)]
         let z = from ints-1 take zero
         in let s = from ints-1 take succ
         in let p = from ints-1 take pred
         in let z? = from ints-1 take is-zero
         in if (z? (s z)) then 22 else 33"
        error)

   (modules-check-polymorphism-1 "
     module m interface [opaque t
                 f : (t -> t)]
              body [type t = int
                 f = proc (x : t) x]
     from m take f"
     ((from m take t) -> (from m take t)))


   (modules-check-polymorphism-1a "
     module m interface [opaque t
                 f : (t -> t)]
              body [type t = int
                 f = proc (x : t) x]
     from m take f"
     ((from m take t) -> (from m take t)))

    (modules-check-polymorphism-1b "
     module m interface [opaque t
                 f : (t -> t)]
              body [type t = int
                 f = proc (x : t) -(x,1)]
     from m take f"
     ((from m take t) -> (from m take t)))

    (modules-check-shadowing-1 "
      module ints-1
       interface 
        [opaque t
          zero : t
          succ : (t -> t)
          is-zero : (t -> bool)] 
       body 
        [type t = int
         zero = 0
         succ = proc(x : t) -(x,-1)
         pred = proc(x : t) -(x,1)
         is-zero = proc (x : t) zero?(x)]
      module ints-2 
       interface 
        [zero : from ints-1 take t
         succ : (from ints-1 take t -> from ints-1 take t)
         is-zero : (from ints-1 take t -> bool)]
       body
        [zero = from ints-1 take zero
         succ = from ints-1 take succ
         is-zero = from ints-1 take is-zero]
      let s = from ints-2 take succ
      in let z? = from ints-2 take is-zero
      in let z = from ints-2 take zero
      in (z? (s z))"
     bool #f)


  (modules-check-shadowing-1.8 "
      module ints-1 
       interface 
        [opaque t  
         zero : t] 
       body 
        [type t = int 
         zero = 0]
      module ints-2 
       interface     
        [foo : from ints-1 take t]
       body 
        [foo = from ints-1 take zero]
      let v = from ints-2 take foo
      in 33
     " int 33)

   (modules-check-shadowing-1.8a
     "module ints-1 
       interface [opaque t  zero : t] 
       body [type t = int zero = 0]
      module ints-2 
       interface [ foo : from ints-1 take t]
       body 
        [foo = from ints-1 take zero]
      from ints-2 take foo
     " 
     (from ints-1 take t))

   ;; this test is bogus, because duplicate module names are not
   ;; allowed.  

;;    (modules-check-shadowing-1.9.1 
;;      "module ints-1 interface [opaque t  zero : t] 
;;                   body [type t = int zero = 0]
;;       module ints-1 interface [foo : from ints-1 take t]
;;                   body import ints-1
;;                    [foo = from ints-1 take zero]
;;       let v = from ints-1 take foo
;;       in 33
;;      " int)

   ;; Once exercise 8.1 (reject duplicated module names) is done, the
   ;; test should be:

;;    (modules-check-shadowing-1.9.2 
;;      "module ints-1 interface [opaque t  zero : t] 
;;                   body [type t = int zero = 0]
;;       module ints-1 interface [foo : from ints-1 take t]
;;                   body import ints-1
;;                    [foo = from ints-1 take zero]
;;       let v = from ints-1 take foo
;;       in 33
;;      " error)    ; <<<---- changed outcome.


   ;; This is bogus in yet another way.  In the following example, v
   ;; has the type of from ints-1 take foo, which is from ints-1 take
   ;; t.  But at the point where v is used, ints-1 has been rebound,
   ;; and doesn't even have a type component t.

;;    (modules-check-shadowing-1.9.2 
;;      "module ints-1 interface [opaque t  zero : t] 
;;                   body [type t = int zero = 0]
;;       module ints-1 interface [foo : from ints-1 take t]
;;                   body import ints-1
;;                    [foo = from ints-1 take zero]
;;       let v = from ints-1 take foo
;;       in v
;;      " (from ints-1 take t))


   ;; We can take advantage of this confusion to generate an unsound
   ;; program that type-checks:

;;    (modules-check-shadowing-1.9.3 "
;; module ints-1 
;;  interface [opaque t zero : t]
;;  body [type t = int zero = 0]
;; module ints-1
;;  interface [zero : from ints-1 take t
;;             opaque t
;;             f : (t -> int)]
;;  body [zero = from ints-1 take zero
;;        type t = bool
;;        f = proc (b : t) if b then 33 else 44]
;;  (from ints-1 take f
;;   from ints-1 take zero)"
;;      int)

   ;; this code allows the application of ints-1.f because its type is
   ;; (ints-1.t -> int), and zero has type ints-1.t .  But those are
   ;; two different modules both named ints-1.

   ;; In general, the solution is to rename the inner ints-1 to avoid
   ;; the conflict.  Exercise: do this. When you do this,
   ;; modules-check-shadowing-1.9.3 should give back "error".
     
   ;; Aren't you sorry you asked?

   (modules-apply-param-module-0.1
       "module copy-module
         interface 
          ((m : [opaque t zero : t]) => 
           [opaque t 
            zero : t])
         body 
          module-proc (n : [opaque t zero : t]) 
           [type t = from n take t
            zero = from n take zero]
        33"
       int 33)

  (modules-apply-param-module-1
       "module makeints
         interface 
          ((m : [opaque t 
             zero : t
             succ : (t -> t)
             pred : (t -> t)
             is-zero : (t -> bool)])
            => [opaque t 
                zero : t
                succ : (t -> t)
                pred : (t -> t)
                is-zero : (t -> bool)])
         body 
          module-proc (m : [opaque t 
                            zero : t
                            succ : (t -> t)
                            pred : (t -> t)
                            is-zero : (t -> bool)])
           [type t = from m take t
            zero = from m take zero
            succ = proc (x : t) 
                        (from m take succ (from m take succ x))
            pred = proc (x : t) 
                        (from m take pred (from m take pred x))
            is-zero = proc (x : t) (from m take is-zero x)]

        module ints-1
         interface 
           [opaque t 
            zero : t
            succ : (t -> t)
            pred : (t -> t)
            is-zero : (t -> bool)]  
         body 
           [type t = int
            zero = 0
            succ = proc(x : t) -(x,2)
            pred = proc(x : t) -(x,-2)
            is-zero = proc (x : t) zero?(x)]
 
       module ints-2 
         interface 
           [opaque t 
            zero : t
            succ : (t -> t)
            pred : (t -> t)
            is-zero : (t -> bool)]  
         body
          (makeints ints-1)

        let check = proc (x : from ints-2 take t) zero?(0)
        in (check 
             (from ints-2 take succ 
               (from ints-2 take succ from ints-2 take zero)))"
       bool #t)

   (transparent-0
     "module m1 interface [transparent t = int
                   zero : t]
                body [type t = int
                   zero = 0]
      -(from m1 take zero,1)"
     int)

   (transparent-1 
     "module m1 
       interface [opaque t zero : t]
       body [type t = int zero = 0]
      module m2 
       interface [transparent t = from m1 take t   % don't know
                                           % what's in m1!
          one : t]
       body [type t = int
          one = 1]
     -(from m2 take one, from m1 take zero)
     "
     error)

  (transparent-2
    "module m1 
      interface 
       [transparent t = int
        zero : t]
      body 
       [type t = int
        zero = 0]

     module m2 
      interface 
       [transparent t = from m1 take t   % now known to be int.
        one : t]
      body 
        [type t = int
         one = 1]
      -(from m2 take one, from m1 take zero)
     "
     int 1)

     (modules-add-double-1
       "module add-double 
         interface 
          ((m : [opaque t 
             zero : t 
             succ : (t -> t)
             pred : (t -> t)
             is-zero : (t -> bool)])
           => [double : (from m take t -> from m take t)])
         body 
          module-proc (m : [opaque t 
                            zero : t 
                            succ : (t -> t)
                            pred : (t -> t)
                            is-zero : (t -> bool)])
          [double 
            = letrec 
               from m take t double (x : from m take t) 
                = if (from m take is-zero x)
                  then from m take zero
                  else (from m take succ
                        (from m take succ x))
              in double]

        module ints-1
         interface 
           [opaque t 
            zero : t
            succ : (t -> t)
            pred : (t -> t)
            is-zero : (t -> bool)]  
         body 
           [type t = int
            zero = 0
            succ = proc(x : t) -(x,2)
            pred = proc(x : t) -(x,-2)
            is-zero = proc (x : t) zero?(x)
            ]  

        module ints-2  
         interface [double : (from ints-1 take t -> from ints-1 take t)]
         body
           (add-double ints-1)

        (from ints-1 take is-zero
          (from ints-2 take double
            (from ints-1 take succ
              from ints-1 take zero)))"
       bool
       #f
       )

  ;; this example shows the need for substitution in types in a module
  ;; application.   This also means you need to have the bound
  ;; variable in the type of a parameterized module.

  (diamond-1 "
     module maker1 
      interface 
       ((m : [opaque t 
              succ : (t -> t)])
        => [transparent t = from m take t 
            double : (t -> t)])
      body 
       module-proc (m : [opaque t succ : (t -> t)])
        [type t = from m take t
         double = let s = from m take succ
                  in proc (x : t) (s (s x))]

     module m0 
      interface 
       [opaque t 
        succ : (t -> t)
        zero : t]
      body 
       [type t = int
        succ = proc(x : t)-(x,-1)
        zero = 0]

     module m2 
      interface 
       [transparent t = from m0 take t
        double : (t -> t)]
      body
       (maker1 m0)

     let check = proc (x : from m0 take t) zero?(0)
     in (check
          (from m2 take double
           from m0 take zero))
     "
     bool #t)

  (pass-around-ho-module-1 "
       module m1
        interface
         ((m : [v : int]) =>  [u : int])
        body 
         module-proc (m : [v : int])
          [u = from m take v]

       module m2 
        interface [v : int] 
        body [v = 33]

       module m1a 
        interface ((m : [v : int]) => [u : int])
        body
         m1

       module m2a
         interface [v : int]
         body 
          m2

        module m3  
         interface [u : int] 
         body
          (m1a m2a)

        from m3 take u"
    int 33)

   (modules-myints-0.1 "
        module ints-1
         interface [opaque t
            zero : t
            succ : (t -> t)
            pred : (t -> t)
            is-zero : (t -> bool)]  
         body [type t = int
            zero = 0
            succ = proc(x : t) -(x,-2)
            pred = proc(x : t) -(x,2)
            is-zero = proc (x : t) zero?(x)
            ]
         let zero = from ints-1 take zero
         in let succ = from ints-1 take succ
         in let is-zero = from ints-1 take is-zero
         in (succ (succ zero))"
     (from ints-1 take t)
     4)

   (modules-myints-0.20 "
        module ints-1
         interface [opaque t
            zero : t
            succ : (t -> t)
            pred : (t -> t)
            is-zero : (t -> bool)]  
         body [zero = 0
            succ = proc(x : t) -(x,2)
            pred = proc(x : t) -(x,-2)
            is-zero = proc (x : t) zero?(x)
            ]
         let zero = from ints-1 take zero
         in let succ = from ints-1 take succ
         in let is-zero = from ints-1 take is-zero
         in (succ (succ zero))"
     error
     -4)


   (modules-myints-0.2a "
        module ints-1
         interface [opaque t
            zero : t
            succ : (t -> t)
            pred : (t -> t)
            is-zero : (t -> bool)]  
         body [type t = int
            zero = 0
            succ = proc(x : t) -(x,2)
            pred = proc(x : t) -(x,-2)
            is-zero = proc (x : t) zero?(x)
            ]
         let zero = from ints-1 take zero
         in let succ = from ints-1 take succ
         in let is-zero = from ints-1 take is-zero
         in (succ (succ zero))"
     (from ints-1 take t) -4)

    (modules-apply-param-module-1 "
        module makeints 
         interface
         ((m: [opaque t
                            zero : t
                            succ : (t -> t)
                            pred : (t -> t)
                            is-zero : (t -> bool)]) 
          => [opaque t
            zero : t
            succ : (t -> t)
            pred : (t -> t)
            is-zero : (t -> bool)])
         body 
          module-proc (m: [opaque t
                            zero : t
                            succ : (t -> t)
                            pred : (t -> t)
                            is-zero : (t -> bool)])
           [type t = from m take t
            zero = from m take zero
            succ = proc (x : t) 
                        (from m take succ (from m take succ x))
            pred = proc (x : t) 
                        (from m take pred (from m take pred x))
            is-zero = proc (x : t) (from m take is-zero x)
           ]

        module ints-1
         interface 
           [opaque t
            zero : t
            succ : (t -> t)
            pred : (t -> t)
            is-zero : (t -> bool)]  
         body 
           [type t = int
            zero = 0
            succ = proc(x : t) -(x,2)
            pred = proc(x : t) -(x,-2)
            is-zero = proc (x : t) zero?(x)]
 
       module ints-2
         interface 
           [opaque t
            zero : t
            succ : (t -> t)
            pred : (t -> t)
            is-zero : (t -> bool)]  
         body
          (makeints ints-1)


        (from ints-2 take succ 
         (from ints-2 take succ  
          from ints-2 take zero)) "
       (from  ints-2 take t)
       -8)


     (modules-apply-param-module-3
       "module makeints 
         interface
          ((n : [opaque t
                 zero : t
                 succ : (t -> t)
                 pred : (t -> t)
                 is-zero : (t -> bool)])
           => [opaque t
               zero : t
               succ : (t -> t)
               pred : (t -> t)
              is-zero : (t -> bool)])
         body
          module-proc (m : [opaque t
                            zero : t
                            succ : (t -> t)
                            pred : (t -> t)
                            is-zero : (t -> bool)])
           [type t = from m take t
            zero = from m take zero
            succ = proc (x : t) 
                    (from m take succ (from m take succ x))
            pred = proc (x : t) 
                    (from m take pred (from m take pred x))
            is-zero = proc (x : t) (from m take is-zero x)
           ]

        module ints-1 
         interface
          [opaque t
           zero : t
           succ : (t -> t)
           pred : (t -> t)
           is-zero : (t -> bool)]  
         body
          [type t = int 
           zero = 0
           succ = proc(x : t) -(x,2)
           pred = proc(x : t) -(x,-2)
           is-zero = proc (x : t) zero?(x)]
        module ints-2
         interface 
          [opaque t
           zero : t
           succ : (t -> t)
           pred : (t -> t)
           is-zero : (t -> bool)]  
         body
          (makeints ints-1)

        let zero = from ints-2 take zero
        in let succ = from ints-2 take succ
        in let pred = from ints-2 take pred
        in let is-zero = from ints-2 take is-zero
        in letrec int to-int (n : from ints-2 take t)
                           = if (is-zero n)
                              then 0
                              else -( (to-int (pred n)), -1)
        in (to-int (succ (succ zero)))
         "
        int
        2)


    (modules-apply-param-module-4 "
        module makeints 
         interface
          ((m : [opaque t
                 zero : t
                 succ : (t -> t)
                 pred : (t -> t)
                 is-zero : (t -> bool)])
           => [opaque t
               zero : t
               succ : (t -> t)
               pred : (t -> t)
               is-zero : (t -> bool)])
         body
          module-proc (m : [opaque t
                            zero : t
                            succ : (t -> t)
                            pred : (t -> t)
                            is-zero : (t -> bool)]) 
           [type t = from m take t
            zero = from m take zero
            succ = proc (x : t) 
                    (from m take succ (from m take succ x))
            pred = proc (x : t) 
                    (from m take pred (from m take pred x))
            is-zero = proc (x : t) (from m take is-zero x)
           ]

        module ints-1
         interface 
          [opaque t
           zero : t
           succ : (t -> t)
           pred : (t -> t)
           is-zero : (t -> bool)]  
         body 
          [type t = int
           zero = 0
           succ = proc(x : t) -(x,2)
           pred = proc(x : t) -(x,-2)
           is-zero = proc (x : t) zero?(x)]

        module ints-2
         interface 
          [opaque t
           zero : t
           succ : (t -> t)
           pred : (t -> t)
           is-zero : (t -> bool)]  
         body
          (makeints ints-1)

        module int3
         interface 
          [opaque t
           zero : t
           succ : (t -> t)
           pred : (t -> t)
           is-zero : (t -> bool)]  
         body
          (makeints ints-2)

        (from int3 take succ 
         (from int3 take succ  from int3 take zero)) "
       (from  int3 take t)
       -16)

    (lift-type-from-scope-0.01 "
       module m1 
        interface 
         [transparent u = int
          transparent t = int]
        body 
         [type u = int
          type t = u]
      module m2 
       interface 
        [transparent u = int
         x : from m1 take t]
       body
        [type u = int
         x = 3]

       33"
      int
      33)

    (lift-type-from-scope-0.1 "
       module m1 
        interface 
         [transparent u = int
          transparent t = u]
        body 
         [type u = int
          type t = u]
       module m2 
        interface 
         [transparent u = int
          x : from m1 take t]
        body
         [type u = int
          x = 3]

       33"
      int
      33)

    (lift-type-from-scope-1 "
       module m1 
        interface 
         [opaque u
          transparent t = u]
        body 
         [type u = bool
          type t = u]
       module m2 
        interface 
         [transparent u = int
          x : from m1 take t]
        body
         [type u = int
          x = 3]

       33"
      error                             
      33)

    (lift-type-from-scope-2 "
       module m1 
        interface 
         [opaque t1
          f : (t1 -> t1)]
        body 
         [type t1 = bool
          f = proc (x : t1) x]

       from m1 take f"
      ((from m1 take t1) -> (from m1 take t1))
      )                                 

    (lift-type-from-scope-3 "
       module m1 
        interface 
         [opaque t2
          f : (t1 -> t1)]
        body 
         [type t1 = bool
          f = proc (x : t1) x]

       from m1 take f"
      error                             ; this should die because t1
                                        ; is unbound.
      )

      (modules-14.1 "
      module m1 interface 
                 [transparent t = int
                  z : t]
                body
                  [type t = int
                   z = 0]

      module m2 
       interface
        [foo : (from m1 take t -> int)]
       body
        [foo = proc (x : from m1 take t) x]

      (from m2 take foo  33)"
      int)

      (modules-14 "
      module m1 
       interface
        [transparent t = int
         z : t]
       body
        [type t = int
         z = 0]
      module m2 
       interface
        [foo : (from m1 take t -> int)]
       body
        [foo = proc (x : from m1 take t) x]

      from m2 take foo"
        (int -> int))


      (modules-14b "
module m1 interface [transparent t1 = int] body [type t1 = int]
module m2 interface [foo : from m1 take t1] body [foo = 3]
from m2 take foo"
        int)

      (modules-test-curry1 "
      module maker1
       interface
        ((m1 : [opaque t
                s : (t -> t)])
         => [transparent t = from m1 take t
             d : (t -> t)])
       body
        module-proc
         (m1 : [opaque t
                s : (t -> t)])
         [type t = from m1 take t
          d = proc (x : t) (from m1 take s (from m1 take s x))]

       module m0
        interface
         [opaque t
          s : (t -> t)]
        body
         [type t = int
          s = proc (u : t) -(u, -1)]

        module m1
         interface
          [opaque t
           d : (t -> t)]
         body
          (maker1 m0)

        33" int 33)

      (modules-test-curry2 "
      module maker1
       interface
        ((m1 : [opaque t
                s : (t -> t)])
         => ((m2 : [transparent t = from m1 take t])
              => [transparent t = from m1 take t
                  d : (t -> t)]))
       body
        module-proc
         (p1 : [opaque t
                s : (t -> t)])
         module-proc
          (p2 : [transparent t = from p1 take t])
          [type t = from p1 take t
           d = proc (x : t) (from p1 take s (from p1 take s x))]

       module m0
        interface
         [opaque t
          s : (t -> t)]
        body
         [type t = int
          s = proc (u : t) -(u, -1)]

       module m1
        interface
         ((m2 : % [opaque t]
            [transparent t = from m0 take t])
          => [transparent t = from m2 take t
              d : (t -> t)])
        body
         (maker1 m0)

         module m2
          interface
           [opaque t
            d : (t -> t)]
          body
           (m1 m0)

        33" int 33)

;; I think these require smarter treatment of sharing-- see Leroy POPL 94.

;;       (modules-curried-application-0 "
;;       module curried-functor
;;        interface
;;         ((m1 : [opaque t])
;;          => ((m2 : [transparent t = from m1 take t])
;;              => [transparent t = from m1 take t]))
;;         body
;;          module-proc
;;           (m1 : [opaque t]) 
;;           module-proc
;;            (m2 : [transparent t = from m1 take t])
;;            [type t = from m1 take t]

;;        module intx
;;         interface
;;          [opaque t
;;           z : t]
;;         body
;;          [type t = bool
;;           z = zero?(1)]

;;        module app1
;;         interface
;;          ((m2 : [opaque t])
;;           => [transparent t = from m1 take t])
;;         body
;;          (curried-functor intx)

;;        33"
;;         int 33)


;;     (modules-curried-application-1 "
;;       module curried-merge
;;        interface
;;         ((m1 : [opaque t 
;;                 z : t 
;;                 s : (t -> t)])
;;          => ((m2 : [transparent t = from m1 take t 
;;                     d : (t -> t)])
;;              => [transparent t = from m1 take t
;;                  z : t
;;                  s : (t -> t)
;;                  d : (t -> t)]))
;;         body
;;          module-proc
;;           (m1 : [opaque t 
;;                  z : t 
;;                  s : (t -> t)]) 
;;           module-proc
;;            (m2 : [transparent t = from m1 take t 
;;                   d : (t -> t)])
;;           [type t = from m1 take t
;;            z = from m1 take z
;;            s = from m1 take s
;;            d = from m2 take d]

;;       module ints-1
;;        interface 
;;         [opaque t 
;;          z : t 
;;          s : (t -> t)]
;;        body
;;         [type t = int
;;          z = 3
;;          s = proc (x : int) -(x, -1)]

;;       module double1
;;        interface
;;         [transparent t = from ints-1 take t
;;          d : (t -> t)]
;;        body
;;         [type t = from ints-1 take t
;;          d = proc (x : t) (from ints-1 take s (from ints-1 take s x))]

;;       module curry1
;;        interface
;;         ((m2 : [opaque t
;;                     d : (t -> t)])
;;              => [transparent t = from m2 take t
;;                  z : t
;;                  s : (t -> t)
;;                  d : (t -> t)])
;;        body
;;         (curried-merge ints-1)

;;       module curry2
;;        interface
;;         [opaque t
;;                  z : t
;;                  s : (t -> t)
;;                  d : (t -> t)]
;;        body
;;         (curry1 double1)

;;        (from curry2 take d
;;         from curry2 take z)
;; "
;;         (from ints-1 take t) 5)

      

;; Here are some possible tests for named interfaces (Ex. 8.27)

;;       (modules-named-interfaces-1 "
;;         interface i1 = [u : int v: bool]
;;         module m1
;;          interface i1
;;          body [u = 3 v = zero?(0)]
;;         import m1
;;         from m1 take u"
;;         int)

;;       (modules-named-interfaces-2 "
;;         interface i1 = [u : int v: bool]
;;         module m1
;;          interface i1
;;          body [u = 3 v = zero?(0)]
;;         module m2
;;          interface ((m3 : i1) => [u : int])
;;          body 
;;           module-proc (m4 : i1) [u = from m4 take u]
;;         module builder
;;          interface [u:int]
;;          body
;;          import m1
;;          import m2
;;          (m2 m1)

;;         import builder
;;         from builder take u"
;;         int)

;;       (modules-named-interfaces-3 "
;;         interface i1 = [u : int v: bool]
;;         interface i2 = ((m3 : i1) => [u : int])
;;         module m1
;;          interface i1
;;          body [u = 3 v = zero?(0)]
;;         module m2
;;          interface i2
;;          body 
;;           module-proc (m4 : i1) [u = from m4 take u]
;;         module builder
;;          interface [u:int]
;;          body
;;          import m1
;;          import m2
;;          (m2 m1)

;;         import builder
;;         from builder take u"
;;         int)

    ))

  (define tests-for-run
    (let loop ((lst the-test-suite))
      (cond
        ((null? lst) '())
        ((= (length (car lst)) 4)
         ;; (printf "creating item: ~s~%" (caar lst))
         (cons
           (list
             (list-ref (car lst) 0)
             (list-ref (car lst) 1)
             (list-ref (car lst) 3))
           (loop (cdr lst))))
        (else (loop (cdr lst))))))

  (define tests-for-parse
    (let loop ((lst the-test-suite))
      (cond
        ((null? lst) '())
        (else
         ;; (printf "creating item: ~s~%" (caar lst))
         (cons
           (list
             (list-ref (car lst) 0)
             (list-ref (car lst) 1)
             #t)
           (loop (cdr lst)))))))

  ;; ok to have extra members in a test-item.
  (define tests-for-check the-test-suite)


  )