(require (for-syntax mzlib/private/unit-compiletime
                     mzlib/private/unit-syntax))
(require "test-harness.ss"
         ;unit
         scheme/unit)

(define-syntax (lookup-sig-mac stx)
  (parameterize ((error-syntax stx))
    (syntax-case stx ()
      ((_ id)
       #`#'#,(let ((s (lookup-signature #'id)))
               (list (map syntax-local-introduce (signature-vars s))
                     (map (lambda (def)
                            (cons (map syntax-local-introduce (car def))
                                  (syntax-local-introduce (cdr def))))
                          (signature-val-defs s))
                     (map (lambda (def)
                          (cons (map syntax-local-introduce (car def))
                                (syntax-local-introduce (cdr def))))
                          (signature-stx-defs s))))))))

(define-signature x-sig (x))
(define-signature x-sig2 (x))
(define-signature y-sig (y))
(define-signature z-sig (z))

(define-signature yz-sig (y z))
(define-signature xy-sig (x y))
(define-signature empty-sig ())
(define-signature b-sig (b))

(define-signature empty-sub extends empty-sig ())

(define-signature x-sub extends x-sig (xx))
(define-signature y-sub extends y-sig (yy))
(define-signature x-sub2 extends x-sig (x2))

 

;; Keyword errors
(test-syntax-error "misuse of import"
  import)
(test-syntax-error "misuse of export"
  export)
(test-syntax-error "misuse of init-depend"
  init-depend)
(test-syntax-error "misuse of link"
  link)
(test-syntax-error "misuse of only"
  only)
(test-syntax-error "misuse of except"
  except)
(test-syntax-error "misuse of prefix"
  prefix)
(test-syntax-error "misuse of rename"
  rename)
(test-syntax-error "misuse of tag"
  tag)

;; define-signature-forms syntax errors
(test-syntax-error "define-signature-form: missing arguments"
  (define-signature-form))
(test-syntax-error "define-signature-form: missing arguments"
  (define-signature-form (a b)))
(test-syntax-error "define-signature-form: too many arguments"
  (define-signature-form (a b c) 1 2))
(test-syntax-error "define-signature-form: dot"
  (define-signature-form (a b) . c))
(test-syntax-error "define-signature-form: set!"
  (let ()
    (define-signature-form (a b) b)
    (set! a 1)))

(test-syntax-error "define-signature-form: bad params"
  (define-signature-form 1 2))
(test-syntax-error "define-signature-form: bad params"
  (define-signature-form a 2))
(test-syntax-error "define-signature-form: name not id"
  (define-signature-form (1 a) 1))
(test-syntax-error "define-signature-form: param not id"
  (define-signature-form (a 1) 1))
(test-syntax-error "define-signature-form: param dot"
  (define-signature-form (a . b) 1))


;; define-signature syntax-errors
(test-syntax-error "define-signature: missing name"
  (define-signature))
(test-syntax-error "define-signature: missing sig"
  (define-signature x))
(test-syntax-error "define-signature: too many args"
  (define-signature x (a b) 1))
(test-syntax-error "define-signature: bad name"
  (define-signature 1 (a b)))
(test-syntax-error "define-signature: bad name"
  (define-signature x extends 1 (a b)))
(test-syntax-error "define-signature: not a signature"
  (define-signature x extends y12 (a b)))
(test-syntax-error "define-signature: not a signature"
  (let () (define-signature x extends x (a b))))
(test-syntax-error "define-signature: bad name"
  (define-signature (a . b) (a b)))
(test-syntax-error "define-signature: dot"
  (define-signature b . (a b)))
(test-syntax-error "define-signature: dot"
  (define-signature b (a b) . 2))
(test-syntax-error "define-signature: set!"
  (let ()
    (define-signature a (a))
    (set! a 1)))
(test-syntax-error "define-signature: bad sig"
  (define-signature x y))
(test-syntax-error "define-signature: bad sig"
  (define-signature x (1)))
(test-syntax-error "define-signature: bad sig"
  (define-signature x (a . b)))
(test-syntax-error "define-signature: bad signature form"
  (define-signature x ((a))))
(test-syntax-error "define-signature: bad signature form"
  (define-signature x ((define-signature))))
(test-syntax-error "define-values: malformed (in define-signature)"
  (define-signature x ((define-values 1 2))))
(test-syntax-error "define-signature: bad form (does not return list)"
  (let ()
    (define-signature-form (a b) 1)
    (define-signature x ((a 1)))))
(test-syntax-error "define-signature: unknown form"
  (let ()
    (define-signature-form (a b) (list #'(c d)))
    (define-signature x ((a 1)))
    1))
(test-syntax-error "define-signature: duplicate name"
  (define-signature x (a a)))
(test-syntax-error "define-signature: duplicate values"
  (define-signature x (a (define-values (a) 1))))
(test-syntax-error "define-signature: duplicate values"
  (define-signature x (a (define-values (b b) 1))))
(test-syntax-error "define-signature: duplicate values"
  (define-signature x (a (define-values (b) 1) (define-syntaxes (b) 1))))
(test-syntax-error "define-signature: duplicate values"
  (let ()
    (define-signature test (y))
    (define-signature x extends test ((define-values (y) 1)))))

;; define-signature
(test stx-bound-id=? #'((a b) () ())
      (let ()
        (define-signature x (a b))
        (lookup-sig-mac x)))
(let ()
  (define s7 (void))
  (define h (void))
  (define-signature super (s1 (define-values (s2 s3) s4) (define-syntaxes (s5 s6) (values #'s7 #'s7))))
  (test stx-bound-id=? #'((s1 a b f) (((s2 s3) . s4) ((c d) . e) ((i) . j)) (((s5 s6) . (values #'s7 #'s7)) ((g) . #'h)))
        (let ()
          (define-signature x extends super (a b (define-values (c d) e) f
                                               (define-syntaxes (g) #'h)
                                               (define-values (i) j)))
          (lookup-sig-mac x))))
(let ()
  (define s7 (void))
  (define h (void))
  (define-signature super (s1 (define-values (s2 s3) s4) (define-syntaxes (s5 s6) (values #'s7 #'s7))))
  (let ((a 1) (g 2) (j 3) (s1 4) (s2 5))
    (test stx-bound-id=? #'(((#f . s1) a b f) ((((#f . s2) s3) . s4) ((c d) . e) ((i) . j)) (((s5 s6) . (values #'s7 #'s7)) ((g) . #'h)))
          (let ()
            (define-signature x extends super (a b (define-values (c d) e) f
                                                 (define-syntaxes (g) #'h)
                                                 (define-values (i) j)))
            (lookup-sig-mac x)))))
(let ()
  (define s7 (void))
  (define h (void))
  (define-signature super (s1 (define-values (s2 s3) s4) (define-syntaxes (s5 s6) (values #'s7 #'s7))))
  (test stx-bound-id=? #'((s1 a b f) (((s2 s3) . s4) ((c d) . e) ((i) . j)) (((s5 s6) . (values #'s7 #'s7)) ((g) . #'h)))
        (let ()
          (define-signature x extends super (a b (define-values (c d) e) f
                                               (define-syntaxes (g) #'h)
                                               (define-values (i) j)))
          (let ((a 1) (g 2) (j 3))
            (lookup-sig-mac x)))))
(test stx-bound-id=? #'(((#f . a) b f) (((c d) . e) ((i) . (#f . j))) ((((#f . g)) . #'h)))
      (let ((a 1) (g 2) (j 3))
        (define-signature x (a b (define-values (c d) e) f
                               (define-syntaxes (g) #'h)
                               (define-values (i) j)))
        (lookup-sig-mac x)))
(let ()
  (define-signature-form (x y)
                         (list (cdr (syntax-e y))))
  (test stx-bound-id=? #'((a)
                          ()
                          ())
        (let ()
          (define-signature z ((x . a)))
          (lookup-sig-mac z))))


;; unit syntax errors (without sub-signatures)
(test-syntax-error "unit: bad sig import"
  (unit (import 1) (export)))
(test-syntax-error "unit: bad sig export"
  (unit (import) (export 1)))
(test-syntax-error "unit: unknown sig import"
  (unit (import a) (export)))
(test-syntax-error "unit: unknown sig export"
  (unit (import) (export a)))
(test-syntax-error "unit: bad tag (not identifier)"
  (unit (import (tag 1 empty-sig)) (export)))
(test-syntax-error "unit: bad tag (not identifier)"
  (unit (import) (export (tag 'a empty-sig))))
(test-syntax-error "define-values: bad syntax (in unit)"
  (unit (import) (export) (define-values)))
(test-syntax-error "unit: multiple definition"
  (unit (import) (export) (define-values (x x) (values 1 2))))
(test-syntax-error "unit: multiple definition"
  (unit (import) (export) (define-syntaxes (x x) (values 1 2))))
(test-syntax-error "unit: multiple definition"
  (unit (import) (export) (define x 1) (define x 2)))
(test-syntax-error "unit: multiple definition"
  (unit (import) (export) (define-syntax x 1) (define-syntax x 2)))
(test-syntax-error "unit: multiple definition"
  (unit (import) (export) (define x 1) (define-syntax x 2)))
(test-syntax-error "unit: re-export"
  (unit (import x-sig) (export x-sig) (define x 1)))
(test-syntax-error "unit: redefine import"
  (unit (import x-sig) (export) (define x 1)))
(test-syntax-error "unit: set! import"
  (unit (import x-sig) (export) (set! x 1)))
(test-syntax-error "unit: set! export"
  (unit (import) (export x-sig) (define x 1) (set! x 1)))
(test-syntax-error "unit: undefined export"
  (unit (import) (export x-sig)))
(test-syntax-error "unit: undefined export"
  (unit (import) (export (prefix x: x-sig)) (define x 1)))
(test-syntax-error "unit: syntax export"
  (unit (import) (export x-sig) (define-syntax x 1)))
(test-syntax-error "unit: duplicate import"
  (unit (import x-sig x-sig2) (export)))
(test-syntax-error "unit: duplicate export"
  (unit (import) (export x-sig x-sig2) (define x 12)))
(test-syntax-error "unit: duplicate import signature"
  (unit (import x-sig (prefix a x-sig)) (export)))
(test-syntax-error "unit: duplicate export signature"
  (unit (import) (export x-sig (prefix a x-sig))
        (define x 1) (define ax 2)))
(test-syntax-error "unit: duplicate import signature"
  (unit (import (tag t x-sig) (tag t (prefix a x-sig))) (export)))
(test-syntax-error "unit: duplicate export signature"
  (unit (import) (export (tag t x-sig) (tag t (prefix a x-sig)))
        (define x 1) (define ax 2)))
(test-syntax-error "unit: duplicate export signature"
  (unit (import) (export x-sig x-sig)
        (define x 1)))


;; compound-unit syntax errors (without sub-signatures)
(test-syntax-error "compound-unit: bad import clause"
  (compound-unit (import (a empty-sig)) (export) (link)))
(test-syntax-error "compound-unit: import clause bad link id"
  (compound-unit (import (1 : empty-sig)) (export) (link)))
(test-syntax-error "compound-unit: import clause unknown sig"
  (compound-unit (import (a : empty-si)) (export) (link)))
(test-syntax-error "compound-unit: export bad link id"
  (compound-unit (import) (export a 1 b) (link)))
(test-syntax-error "compound-unit: link line bad link id"
  (compound-unit (import) (export) (link (((a : empty-sig)) b 1))))
(test-syntax-error "compound-unit: import clause bad sig id"
  (compound-unit (import (a : ())) (export) (link)))
(test-syntax-error "compound-unit: link line clause bad sig id"
  (compound-unit (import) (export) (link (((a : "")) b))))
(test-syntax-error "compound-unit: link line clause bad"
  (compound-unit (import) (export) (link (((a empty-sig)) b))))
(test-syntax-error "compound-unit: link line clause unknown"
  (compound-unit (import) (export) (link (((a : b)) b))))
(test-syntax-error "compound-unit: duplicate link ids"
  (compound-unit (import (x : x-sig) (x : y-sig)) (export) (link)))
(test-syntax-error "compound-unit: duplicate link ids"
  (compound-unit (import) (export) (link (((x : x-sig) (x : y-sig)) u))))
(test-syntax-error "compound-unit: duplicate link ids"
  (compound-unit (import (x : x-sig)) (export) (link (((x : x-sig)) u))))
(test-syntax-error "export: unbound link id"
  (compound-unit (import) (export a) (link)))
(test-syntax-error "link link: unbound link id"
  (compound-unit (import) (export) (link (() u a))))
(test-syntax-error "compound-unit: re-export"
  (compound-unit (import (S : x-sig)) (export S) (link)))
(test-syntax-error "compound-unit: re-export"
  (compound-unit (import (tag s (S : x-sig)))  (export (tag t S)) (link)))
(test-syntax-error "compound-unit: duplicate export signature"
  (compound-unit (import) (export X1 X2)
                 (link (((X1 : x-sig)) (unit (import) (export x-sig) (define x 1)))
                       (((X2 : x-sig)) (unit (import) (export x-sig) (define x 1))))))
(test-syntax-error "compound-unit: duplicate export signature"
  (compound-unit (import) (export (tag t X1) (tag t X2))
                 (link (((X1 : x-sig)) (unit (import) (export x-sig) (define x 1)))
                       (((X2 : x-sig)) (unit (import) (export x-sig) (define x 1))))))

;; define-values/invoke-unit syntax errors
(test-syntax-error "define-values/invoke-unit: no unit"
  (define-values/invoke-unit))
(test-syntax-error "define-values/invoke-unit: dot"
  (define-values/invoke-unit x y . x))
(test-syntax-error "define-values/invoke-unit: bad sig"
  (define-values/invoke-unit 1 1))
(test-syntax-error "define-values/invoke-unit: duplicate exports"
  (define-values/invoke-unit (unit (import) (export (prefix x: x-sig) x-sig2)
                               (define x 1)
                               (define x:x 2))
    x-sig x-sig2))


;; simple units, compound-units, and invoke-units (no subtypes, no tags, no prefix/rename/etc, no fancy signatures)
(test 12
  (invoke-unit (unit (import) (export) 12)))

(test 3
 (invoke-unit
  (compound-unit (import) (export)
                 (link (((X : x-sig) (Y : y-sig)) (unit (import empty-sig z-sig)
                                                        (export y-sig x-sig)
                                                        (define x 1)
                                                        (define y 2))
                                                  Z E)
                       (((Z : z-sig) (E : empty-sig)) (unit (import x-sig y-sig)
                                                            (export empty-sig z-sig)
                                                            (define z 3)
                                                            3) X Y)))))
                                                                   

;; Test compound export with signatures containing overlapping names
(test (list 10 11 12)
  (let ((un (compound-unit (import) (export S U)
              (link (((S : x-sig)) (unit (import) (export x-sig) (define x 10)))
                    (((U : xy-sig)) (unit (import) (export xy-sig) (define x 11) (define y 12)))))))
    (invoke-unit
     (compound-unit (import) (export)
                    (link (((S : x-sig) (U : xy-sig)) un)
                          (((B : b-sig)) (unit (import x-sig) (export b-sig) (define b x)) S)
                          (() (unit (import b-sig xy-sig) (export) (list b x y)) B U))))))

(define-signature even-sig (even))
(define-signature odd-sig (odd))

(define even-unit
  (unit (import odd-sig)
        (export even-sig)
    (define (even x)
      (or (= 0 x) (odd (sub1 x))))))

(define odd-unit
  (unit (import even-sig)
        (export odd-sig)
    (define (odd x)
      (and (> x 0) (even (sub1 x))))
    (define x (odd 11))
    x))

(define run-unit
  (compound-unit (import)
                 (export)
    (link (((EVEN : even-sig)) even-unit ODD)
          (((ODD : odd-sig)) odd-unit EVEN))))

(test #t (invoke-unit run-unit))

(define-signature is-3x-sig (is-3x))
(define-signature is-3x+1-sig (is-3x+1))
(define-signature is-3x+2-sig (is-3x+2))

(define is-3x-unit
  (unit (import is-3x+2-sig)
        (export is-3x-sig)
    (define (is-3x x)
      (or (= 0 x) (is-3x+2 (sub1 x))))))

(define is-3x+2-unit
  (unit (import is-3x+1-sig)
        (export is-3x+2-sig)
    (define (is-3x+2 x)
      (and (> x 0) (is-3x+1 (sub1 x))))))

(define is-3x+1-unit
  (unit (import is-3x-sig)
        (export is-3x+1-sig)
    (define (is-3x+1 x)
      (and (> x 0) (is-3x (sub1 x))))))

(define 3x-compound1
  (compound-unit (import (IS-3X : is-3x-sig))
                 (export IS-3X+1 IS-3X+2)
    (link (((IS-3X+1 : is-3x+1-sig)) is-3x+1-unit IS-3X)
          (((IS-3X+2 : is-3x+2-sig)) is-3x+2-unit IS-3X+1))))

(define 3x-compound2
  (compound-unit (import)
                 (export IS-3X)
    (link (((IS-3X : is-3x-sig)) is-3x-unit IS-3X+2)
          (((IS-3X+1 : is-3x+1-sig)
            (IS-3X+2 : is-3x+2-sig)) 3x-compound1 IS-3X))))

(define 3x-run-unit
  (unit (import is-3x-sig is-3x+1-sig is-3x+2-sig)
        (export)
    (list (is-3x 1)
          (is-3x 3)
          (is-3x+1 5)
          (is-3x+1 7)
          (is-3x+2 4)
          (is-3x+2 8))))

(define 3x-compound3
  (compound-unit (import)
                 (export IS-3X IS-3X+1 IS-3X+2)
    (link (((IS-3X : is-3x-sig)) 3x-compound2)
          (((IS-3X+1 : is-3x+1-sig)
            (IS-3X+2 : is-3x+2-sig)) 3x-compound1 IS-3X)
          (() 3x-run-unit IS-3X IS-3X+1 IS-3X+2))))

(test (list #f #t #f #t #f #t)
  (invoke-unit 3x-compound3))

(test (list #t #t #t)
  (let ()
    (define-values/invoke-unit 3x-compound3 (import) (export is-3x-sig is-3x+1-sig is-3x+2-sig))
    (list (is-3x+2 8)
          (is-3x+1 7)
          (is-3x 6))))
(test (list #t #t #t)
  (let ()
    (define-values/invoke-unit 3x-compound3 (import) (export (only is-3x-sig is-3x) (except is-3x+1-sig) (prefix x: is-3x+2-sig)))
    (list (x:is-3x+2 8)
          (is-3x+1 7)
          (is-3x 6))))
(test (list #t #t #t)
  (let ()
    (define-values/invoke-unit 3x-compound3 (import) (export is-3x-sig is-3x+1-sig (rename is-3x+2-sig (y is-3x+2))))
    (list (y 8)
          (is-3x+1 7)
          (is-3x 6))))

;; Tags
(let ()
  (define u
    (unit (import x-sig (tag t (prefix t: x-sig)) (tag u (prefix u: x-sig)))
          (export)
          (list x t:x u:x)))
  (define v
    (unit (import)
          (export x-sig (tag t (prefix t: x-sig)) (tag u (prefix u: x-sig)))
          (define x 1)
          (define t:x 2)
          (define u:x 3)))
  (test '(3 1 2)
    (invoke-unit
     (compound-unit (import) (export)
                    (link (((X1 : x-sig) (X2 : (tag u x-sig)) (X3 : (tag t x-sig))) v)
                          (() u (tag t X1) X2 (tag u X3))))))
  (test '(3 1 2)
    (invoke-unit
     (compound-unit (import) (export)
       (link (((L1 : (tag a x-sig)) (L2 : (tag b x-sig)) (L3 : (tag c x-sig)))
              (compound-unit (import) (export (tag a X1) (tag b X2) (tag c X3))
                (link (((X1 : x-sig) (X2 : (tag u x-sig)) (X3 : (tag t x-sig))) v))))
             (()
              (compound-unit (import (X1 : x-sig) (X2 : (tag u x-sig)) (X3 : (tag t x-sig))) (export)
                (link (() u (tag t X1) X2 (tag u X3))))
              L1 (tag u L2) (tag t L3)))))))

(let ()
  (define-values/invoke-unit (unit (import) (export (tag t x-sig)) (define x 1)) (import) (export (tag t x-sig)))
  (test 1 x))

;; simple runtime errors (no subtyping, no deps)
(test-runtime-error exn:fail:contract? "compound-unit: not a unit"
  (compound-unit (import) (export) (link (() 1))))
(test-runtime-error exn:fail:contract? "compound-unit: missing import"
  (compound-unit (import) (export)
                 (link (() (unit (import x-sig) (export))))))
(test-runtime-error exn:fail:contract? "compound-unit: missing import"
  (compound-unit (import (X : x-sig)) (export)
                 (link (() (unit (import x-sig) (export))
                           (tag u X)))))
(test-runtime-error exn:fail:contract? "compound-unit: missing import"
  (compound-unit (import (X : x-sig)) (export)
                 (link (() (unit (import (tag u x-sig)) (export))
                           X))))
(test-runtime-error exn:fail:contract? "compound-unit: missing export"
  (compound-unit (import) (export)
                 (link (((X : x-sig)) (unit (import) (export))))))
(test-runtime-error exn:fail:contract? "compound-unit: missing export"
  (compound-unit (import) (export)
                 (link (((X : (tag u x-sig))) (unit (import) (export x-sig) (define x 1))))))
(test-runtime-error exn:fail:contract? "compound-unit: missing export"
  (compound-unit (import) (export)
                 (link (((X : x-sig)) (unit (import (tag u x-sig)) (export))))))

(test-runtime-error exn:fail:contract? "invoke-unit: not a unit"
  (invoke-unit 1))
(test-runtime-error exn:fail:contract? "invoke-unit: unit has imports"
  (invoke-unit (unit (import x-sig) (export) x)))

(test-runtime-error exn:fail:contract? "define-values/invoke-unit: not a unit"
  (define-values/invoke-unit 1 (import) (export)))
(test-runtime-error exn:fail:contract? "define-values/invoke-unit: has imports"
  (define-values/invoke-unit (unit (import x-sig) (export) x) (import) (export)))
(test-runtime-error exn:fail:contract? "define-values/invoke-unit: signature mismatch"
  (define-values/invoke-unit (unit (import) (export)) (import) (export x-sig)))

;; unit creation w/o signatures (including macros and prefixes/renames).

;; free vars
(let ((y 1)
      (z 10))
  (define u (unit (import) (export yz-sig)
                  (define y 2)
                  (define z 3)))
  (define u1 (unit (import) (export)
                   y))
  (define u2 (unit (import (only yz-sig z)) (export)
                   y))
  (define u3 (unit (import (except yz-sig y)) (export)
                   y))
  (define u4 (unit (import (prefix s: yz-sig)) (export)
                   y))
  (define u5 (unit (import (rename yz-sig (r y))) (export)
                   y))
  (define u6 (unit (import yz-sig) (export)
                   y))
  (define (l x)
    (invoke-unit
     (compound-unit (import) (export)
                    (link (((YZ : yz-sig)) u)
                          (() x YZ)))))
  (test 1 (invoke-unit u1))
  (test 1 (l u2))
  (test 1 (l u3))
  (test 1 (l u4))
  (test 1 (l u5))
  (test 2 (l u6))
  (test (letrec ((x x)) x)
    (let ()
      (define-values/invoke-unit (unit-from-context yz-sig) (import) (export yz-sig))
      y))
  (test 1
    (let ()
      (let ((u (unit-from-context yz-sig)))
        (define-values/invoke-unit u (import) (export (prefix x: yz-sig)))
        x:y)))
  ;; Exporting and prefix don't work right because the shadower doesn't see the shadowed
  ;; bindings, I think.
  #;(test 1
      (let ((x:y 12)
            (x:z 10))
        (let ((u (unit-from-context (prefix x: yz-sig))))
          (define-values/invoke-unit u yz-sig)
          y)))
  #;(test 1
    (let ((x:y 12)
          (x:z 10))
      (define-signature t (y z))
      (let ((u (unit-from-context (prefix x: t))))
        (define-values/invoke-unit u t)
        y)))
  (test 12
    (let ((x:y 12)
          (x:z 10))
      (define-values/invoke-unit (unit-from-context (rename yz-sig (x:y y) (x:z z)))
        (import) (export yz-sig))
      y))
  (test 12
    (let ((x:y 12)
          (x:z 10))
      (define-signature t (y z))
      (let ()
        (define-values/invoke-unit (unit-from-context (rename t (x:y y) (x:z z))) (import) (export t))
        y))))

;; Test that a define-values can define both internal and exported vars
(test '(1 2)
  (invoke-unit
   (compound-unit (import) (export)
                  (link (((T : yz-sig)) (unit (import x-sig) (export yz-sig)
                                              (define-values (y a) (values 1 2))
                                              (define-values (b z) (values y a)))
                                        S)
                        (((S : x-sig)) (unit (import yz-sig) (export x-sig) (define x 3) (list y z)) T)))))


;; Test that internal macros can define exports
(test 1
  (invoke-unit
   (unit (import) (export x-sig)
         (define-syntax (y stx)
           (syntax-case stx ()
             ((_ x) #'(define x 1))))
         (y x)
         x)))
  
(define-signature fact-sig (fact n))

;; Test renaming, self-recursion, only, and except
(test 24
  (invoke-unit
   (compound-unit (import) (export)
     (link (((F : fact-sig)) (unit (import (except (rename fact-sig (f-in fact)) n))
                                   (export (rename fact-sig (f-out fact)))
                               (define n 1)
                               (define (f-out x) (if (= 0 x)
                                                     1
                                                     (* x (f-in (sub1 x))))))
                             F)
           (() (unit (import (only fact-sig fact)) (export)
                 (define n 2)
                 (fact 4))
               F)))))


;; Test import prefix
(test 1
  (invoke-unit
   (compound-unit (import) (export)
     (link (((S : x-sig)) (unit (import) (export x-sig) (define x 1)))
           (() (unit (import (prefix s: x-sig)) (export) s:x) S)))))

(define-signature sx (x))
(define-signature sy (y))
(define-signature sz (z))

;; Test separate signatures with overlapping bindings, and export renaming and prefix
(test '(1 2 3)
  (invoke-unit
   (compound-unit (import) (export)
     (link (((S : x-sig) (T : yz-sig) (U : xy-sig)) (unit (import) (export (rename x-sig (s:x x))
                                                                           (rename yz-sig (t:y y) (t:z z))
                                                                           (prefix u: xy-sig))
                                                      (define x 1) (define y 2) (define z 3)
                                                      (define s:x x) (define t:y y) (define t:z z) (define u:x x) (define u:y y)))
           (((SX : sx)) (unit (import (prefix s: x-sig)) (export sx) (define x s:x)) S)
           (((SY : sy)) (unit (import (prefix u: xy-sig)) (export sy) (define y u:y)) U)
           (((SZ : sz)) (unit (import (prefix t: yz-sig)) (export sz) (define z t:z)) T)
           (() (unit (import sx sy sz) (export) (list x y z)) SX SY SZ)))))


;; Test units importing and exporting b, where lexical definition of b shadows
;; the b identifier in the signature
(test 2
  (let ((b 1))
    (define u1 (unit (import) (export b-sig) (define b 2)))
    (define u2 (unit (import b-sig) (export) b))
    (invoke-unit (compound-unit (import) (export)
                                (link (((B : b-sig)) u1)
                                      (() u2 B))))))
(test 1
  (let ((b 1))
    (define u1 (unit-from-context b-sig))
    (let ((b 2))
      (define-values/invoke-unit u1 (import) (export b-sig))
      b)))
  


(let ((x 1)
      (v 2))
  (let-syntax ((s (syntax-rules () ((_) (list x v)))))
    (define-signature t (x (define-syntaxes (s)
                                                (syntax-rules ()
                                                  ((_) (list x v))))
                           (define-values (v) (add1 x))))
    (define-signature t2 (x (define-syntaxes (s)
                                                (syntax-rules ()
                                                  ((_) (list x v))))
                           (define-values (v) (add1 x))))
    (define u3 (unit (import) (export t)
                     (define x 3)))
    (define u4 (unit (import) (export t2)
                     (define x 4)))
    (define (i u)
      (invoke-unit
       (compound-unit (import) (export)
                      (link (((T3 : t)) u3)
                            (((T4 : t2)) u4)
                            (() u T3 T4)))))
    ;; prefix
    (let ((x 5)
          (v 6))
      (let-syntax ((s (syntax-rules () ((_) (list x v)))))
        (test '(7 8 (7 8) 3 4 (3 4) 4 5 (4 5))
          (i (unit (import (prefix p: t) (prefix q: t2)) (export)
                   (define x 7)
                   (define v 8)
                   (define-syntax s (syntax-rules () ((_) (list x v))))
                   (list x v (s) p:x p:v (p:s) q:x q:v (q:s)))))
        (test '(5 6 (5 6) 3 4 (3 4) 4 5 (4 5))
          (i (unit (import (prefix p: t) (prefix q: t2)) (export)
                   (list x v (s) p:x p:v (p:s) q:x q:v (q:s)))))))
    (test '(7 8 (7 8) 3 4 (3 4) 4 5 (4 5))
      (i (unit (import (prefix p: t) (prefix q: t2)) (export)
               (define x 7)
               (define v 8)
               (define-syntax s (syntax-rules () ((_) (list x v))))
               (list x v (s) p:x p:v (p:s) q:x q:v (q:s)))))
    (test '(1 2 (1 2) 3 4 (3 4) 4 5 (4 5))
      (i (unit (import (prefix p: t) (prefix q: t2)) (export)
               (list x v (s) p:x p:v (p:s) q:x q:v (q:s)))))
    ;; only
    (let ((x 5)
          (v 6))
      (let-syntax ((s (syntax-rules () ((_) (list x v)))))
        (test '(7 8 (7 8) (3 4) (4 5))
          (i (unit (import (prefix p: (only t s)) (only (prefix q: t2) q:s)) (export)
                   (define x 7)
                   (define v 8)
                   (define-syntax s (syntax-rules () ((_) (list x v))))
                   (list x v (s) (p:s) (q:s)))))
        (test '(5 6 (5 6) (3 4) (4 5))
          (i (unit (import (prefix p: (only t s)) (prefix q: (only t2 s))) (export)
                   (list x v (s) (p:s) (q:s)))))))
    (test '(7 8 (7 8) (3 4) (4 5))
      (i (unit (import (only (prefix p: t) p:s) (only (prefix q: t2) q:s)) (export)
               (define x 7)
               (define v 8)
               (define-syntax s (syntax-rules () ((_) (list x v))))
               (list x v (s) (p:s) (q:s)))))
    (test '(1 2 (1 2) (3 4) (4 5))
      (i (unit (import (prefix p: (only t s)) (prefix q: (only t2 s))) (export)
               (list x v (s) (p:s) (q:s)))))
    ;;rename
    (let ((x 5)
          (v 6))
      (let-syntax ((s (syntax-rules () ((_) (list x v)))))
        (test '(7 8 (7 8) 3 4 (3 4) 4 5 (4 5))
          (i (unit (import (rename t (p:x x) (p:v v) (p:s s))
                           (rename t2 (q:x x) (q:v v) (q:s s)))
                   (export)
                   (define x 7)
                   (define v 8)
                   (define-syntax s (syntax-rules () ((_) (list x v))))
                   (list x v (s) p:x p:v (p:s) q:x q:v (q:s)))))
        (test '(5 6 (5 6) 3 4 (3 4) 4 5 (4 5))
          (i (unit (import (rename t (p:x x) (p:v v) (p:s s))
                           (rename t2 (q:x x) (q:v v) (q:s s)))
                   (export)
                   (list x v (s) p:x p:v (p:s) q:x q:v (q:s)))))))
    (test '(7 8 (7 8) 3 4 (3 4) 4 5 (4 5))
      (i (unit (import (rename t (p:x x) (p:v v) (p:s s))
                       (rename t2 (q:x x) (q:v v) (q:s s)))
               (export)
               (define x 7)
               (define v 8)
               (define-syntax s (syntax-rules () ((_) (list x v))))
               (list x v (s) p:x p:v (p:s) q:x q:v (q:s)))))
    (test '(1 2 (1 2) 3 4 (3 4) 4 5 (4 5))
      (i (unit (import (rename t (p:x x) (p:v v) (p:s s))
                       (rename t2 (q:x x) (q:v v) (q:s s)))
               (export)
               (list x v (s) p:x p:v (p:s) q:x q:v (q:s))))))
  )

(let ()
  (define-signature x ((define-syntaxes (m)
                         (syntax-rules ()
                           ((_ x) (define-syntax x
                                    (syntax-rules ()
                                      ((_ y) y))))))
                       (define-values (v)
                         (let ()
                           (m a)
                           (a 1)))))
  (test 1
    (invoke-unit
      (compound-unit (import) (export)
                     (link (((X : x)) (unit (import) (export x)))
                           (() (unit (import x) (export) v) X))))))
(let ()
  (define-signature x ((define-syntaxes (m)
                         (syntax-rules ()
                           ((_ x) (define-syntax x #'1))))
                       (define-syntaxes (m2)
                         (lambda (stx)
                           (syntax-case stx ()
                             ((_ x) (syntax-local-value #'x)))))
                       (define-values (v)
                         (let ()
                           (m a)
                           (m2 a)))))
  (test 1
    (invoke-unit
      (compound-unit (import) (export)
                     (link (((X : x)) (unit (import) (export x)))
                           (() (unit (import x) (export) v) X))))))

(let ()
  (define-signature x ((define-syntaxes (m) #'1)
                       (define-syntaxes (m2)
                         (lambda (stx)
                           (syntax-case stx ()
                             ((_ x) (syntax-local-value #'x)))))
                       (define-values (v)
                         (let ()
                           (m2 m)))))
  (test 1
    (invoke-unit
      (compound-unit (import) (export)
                     (link (((X : x)) (unit (import) (export x)))
                           (() (unit (import x) (export) v) X))))))


(let ()
  (define-signature s1 (a (define-values (x y) (values 1 2))))
  (define-signature s2 extends s1 ((define-values (z) (list a x))))
  (define u1 (unit (import s2) (export) (cons y z)))
  (define u2 (unit (import) (export s2) (define a 123)))
  (test (list 2 123 1) (invoke-unit (compound-unit (import) (export)
                                      (link (((a : s2)) u2)
                                            (() u1 a))))))
(let ()
  (define-signature s1 (a (define-values (x y) (values 1 2))))
  (let ((x 12))
    (define-signature s2 extends s1 ((define-values (z) (list a x))))
    (define u1 (unit (import s2) (export) (cons y z)))
    (define u2 (unit (import) (export s2) (define a 123)))
    (test (list 2 123 12) (invoke-unit (compound-unit (import) (export)
                                                      (link (((a : s2)) u2)
                                                            (() u1 a)))))))

(let ()
  (define-signature s1 (a (define-values (x y) (values c 2))))
  (define-signature s2 extends s1 (c (define-values (z) (list a x))))
  (define u1 (unit (import s2) (export) (cons y z)))
  (define u2 (unit (import) (export s2) (define a 123) (define c 43)))
  (test (list 2 123 43) (invoke-unit (compound-unit (import) (export)
                                                    (link (((a : s2)) u2)
                                                          (() u1 a))))))

;; Test define-syntaxes and define-values, without except, only, prefix and rename
;; Check the scoping
(let ((a 'abad)
      (b 'bbad)
      (c 'cbad)
      (v1 'v1bad)
      (v2 'v2bad)
      (s1 's1bad)
      (s2 's2bad)
      (strange-fact 'sfbad)
      (z 'zbad))
  (define z 1)
  (define a 'abad2)
  (define c 'cbad2)
  (define strange-fact 'sfbad4)
  (define-signature macro (a b c
                             (define-values (v1) (list a b c z 2))
                             (define-values (v2) (s2 a b c))
                             (define-values (strange-fact)
                                                (lambda (x)
                                                  (if (= x 0) (list z a b c) (cons x (strange-fact (sub1 x))))))
                             (define-syntaxes (s1 s2)
                                                  (values
                                                   (syntax-rules ()
                                                     ((_ a1 b1 c1) (list a b c v1 a1 b1 c1 z)))
                                                   (syntax-rules ()
                                                     ((_ a1 b1 c1) (s1 a1 b1 c1)))))))
  (let ((b 'bbad2)
        (c 'cbad3))
    (define z 3)
    (define u1
      (unit (import macro) (export)
        (define z 4)
        (list a b c v1 v2 (strange-fact 5) (s1 6 7 8) (s2 9 10 11))))
    (define u2
      (unit (import) (export macro)
         (define a 12)
         (define b 13)
         (define c 14)))
    (test '(12 13 14
               (12 13 14 1 2)
               (12 13 14 (12 13 14 1 2) 12 13 14 1)
               (5 4 3 2 1 1 12 13 14)
               (12 13 14 (12 13 14 1 2) 6 7 8 1)
               (12 13 14 (12 13 14 1 2) 9 10 11 1))
      (invoke-unit
       (compound-unit (import) (export)
         (link (((U2 : macro)) u2)
               (() u1 U2)))))))
  

;; We can re-define imported values
(let ()
  (define-signature s ((define-values (y) 1)))
  (define-signature t (z))
    (test 3
      (invoke-unit
       (compound-unit (import) (export)
                      (link (((T : t)) (unit (import s) (export t) (define y 3) (define z y)) S)
                            (((S : s)) (unit (import) (export s) (define y 1)))
                            (() (unit (import t) (export) z) T))))))

;; Can't use imports as pattern variables
#;(let ()
  (define-signature s (y (define-syntaxes (m) (syntax-rules (y) ((_ y) 1)))))
  (unit (import s) (export)
        (m y)))


(test '(2 3)
  (let ()
    (define-signature sig (y (define-values (v) (add1 y))))
    (let ()
      (define-values/invoke-unit
       (unit (import) (export sig) (define y 2))
       (import)
       (export sig))
      (list y v))))


;; I'm not sure that this should work.
#;(test '(2 3)
  (let ()
    (define-signature sig (y (define-values (v) (add1 y))))
    (define-values/invoke-unit
     (unit (import) (export sig) (define y 2))
     sig)
    (list y v)))
  
  

;; subtyping

(let ()
  (define u1 (unit (import x-sig) (export y-sub) (define y (add1 x)) (define yy 2) (list x y yy)))
  (define u2 (unit (import y-sig) (export x-sub) (define x 3) (define xx 44)))
  (define u3 (compound-unit (import (S1 : x-sig)) (export S4)
                            (link (((S4 : y-sub)) u1 S1))))
  (define u4 (compound-unit (import (S3 : y-sig)) (export S2)
                            (link (((S2 : x-sub)) u2 S3))))
  (define u5 (compound-unit (import (S2 : y-sub)) (export S1)
                            (link (((S1 : x-sig)) u2 S2))))
  (test '(3 4 2)
        (invoke-unit
         (compound-unit (import) (export)
                        (link (((S1 : x-sig)) u2 S2)
                              (((S2 : y-sig)) u1 S1)))))
  (test '(3 4 2)
        (invoke-unit
         (compound-unit (import) (export)
                        (link (((S1 : x-sub)) u2 S2)
                              (((S2 : y-sub)) u1 S1)))))
  
  
  (test '(3 4 2)
        (invoke-unit
         (compound-unit (import) (export)
                        (link (((S1 : x-sub)) u4 S4)
                              (((S4 : y-sub)) u3 S1)))))
  (test '(3 4 2)
        (invoke-unit
         (compound-unit (import) (export)
                        (link (((S1 : x-sig)) u4 S4)
                              (((S4 : y-sig)) u3 S1)))))
  
  
  (test '(3 4 2)
        (invoke-unit
         (compound-unit (import) (export)
                        (link (((S1 : x-sig)) u5 S2)
                              (((S2 : y-sub)) u1 S1))))))
(let ()  
  (define u1 (unit (import) (export x-sig) (define x 1)))
  (define u2 (unit (import x-sub) (export)))
  
  (test-runtime-error exn:fail:contract? "compound-unit: not a subtype"
                      (compound-unit (import) (export)
                                     (link (((S : x-sub)) u1))))
  
  (test-runtime-error exn:fail:contract? "compound-unit: not a subtype"
                      (compound-unit (import) (export)
                                     (link (((S : x-sig)) u1)
                                           (() u2 S))))
  
  (test-runtime-error exn:fail:contract? "compound-unit: not a subtype"
                      (compound-unit (import (S : x-sig)) (export)
                                     (link (() u2 S)))))

(let ()
  (define u1 (unit (import) (export x-sub y-sub) (define x 1) (define xx 2) (define y 3) (define yy 4)))
  (define-values/invoke-unit u1 (import) (export x-sig))
  (test 1 x)
  (test-runtime-error exn? "unbound identifier" xx)
  (test-runtime-error exn? "unbound identifier" y)
  (test-runtime-error exn? "unbound identifier" yy))

(let ()
  (define u1 (unit (import) (export x-sig) (define x 1)))
  (test-runtime-error exn:fail:contract? "define-values/invoke-unit: not a subtype"
                      (define-values/invoke-unit u1 (import) (export x-sub))))

;; export-subtyping
(test-syntax-error "duplicate exports (subtypes)"
                   (unit (import) (export x-sig x-sub)
                         (define x 1)
                         (define xx 1)))
(test-syntax-error "duplicate exports (subtypes)"
                   (unit (import) (export x-sub x-sig)
                         (define x 1)
                         (define xx 1)))
(let ()
  (define u (unit (import) (export x-sub) (define x 1) (define xx 1)))
  (test-syntax-error "duplicate exports (subtypes)"
                     (compound-unit (import) (export l1 l2)
                                    (link (((l1 : s1)) u)
                                          (((l2 : s2)) u)))))
(let ()
  (define u (unit (import) (export x-sub (prefix x: x-sub2))
                  (define x 1)
                  (define xx 2)
                  (define x:x 3)
                  (define x:x2 4)))
  (define u2 (unit (import x-sig) (export)))
  (define v (unit (import x-sub) (export)
                  (+ x xx)))
  (define w (unit (import x-sub2) (export)
                  (+ x x2)))
  (define u3 (unit (import x-sub (prefix m: x-sub2)) (export)
                   (+ x xx m:x m:x2)))
  (test 3
        (invoke-unit
         (compound-unit (import) (export)
                        (link (((S2 : x-sub)) u)
                              (() v S2)))))
  (test 7
        (invoke-unit
         (compound-unit (import) (export)
                        (link (((S3 : x-sub2)) u)
                              (() w S3)))))
  (test 10
        (invoke-unit
         (compound-unit (import) (export)
                        (link (((S3 : x-sub2) (S2 : x-sub)) u)
                              (() u3 S3 S2)))))
  (test-runtime-error exn:fail:contract? "ambiguous export"
                      (compound-unit (import) (export)
                                     (link (((S1 : x-sig)) u)))))
  (test-runtime-error exn:fail:contract? "ambiguous import"
                      (compound-unit (import (S1 : x-sub) (S2 : x-sub2)) (export)
                                     (link (() u2 S1 S2))))

(test-syntax-error "duplicate links (subtype)"
                    (compound-unit (import) (export)
                                     (link (((S1 : x-sig)) u3)
                                           (() u1 S2 S1)
                                           (((S2 : x-sig)) u3))))
;; tags
(let ()
  (define-signature s1 (a))
  (define-signature s2 extends s1 (b))
  (define-signature s3 extends s2 ())
  (define-signature s4 extends s3 ())
  (define u1
    (unit (import (prefix s1: s1) 
                  (tag t (prefix s2: s2))
                  (prefix bs1: s2) 
                  (prefix bs2: s3))
          (export)
          (list s1:a s2:a s2:b bs1:a bs2:b)))
  (define u2
    (unit (import) (export s3)
          (define a 1) (define b 2)))
  (define u3
    (unit (import) (export s2)
          (define a 3) (define b 4)))
  (test '(1 3 4 1 2)
        (invoke-unit
         (compound-unit (import) (export)
                        (link (((S2a : s3)) u2)
                              (((S2b : s2)) u3)
                              (() u1 S2a (tag t S2b))))))
  (test-runtime-error exn:fail:contract? "compound-unit: signature mismatch"
        (invoke-unit
         (compound-unit (import) (export)
                        (link (((S1 : s1)) u2)
                              (((S2 : s2)) u3)
                              (() u1 (tag t S1) S2))))))
(let ()
  (define u1
    (unit (import) (export (prefix a: x-sig) (tag t (prefix c: x-sig)))
          (define a:x 1)
          (define c:x 4)))
  (define u2
    (unit (import x-sig) (export)
          x))
  (define u3
    (unit (import x-sub) (export)
          (list x xx)))

  (test 4
        (invoke-unit
         (compound-unit (import) (export)
                        (link (((S1 : (tag t x-sig)) (S2 : x-sig)) u1)
                              (() u2 S1)))))
  (test-runtime-error exn:fail:contract? "compound-unit: signature mismatch"
                      (invoke-unit
                       (compound-unit (import) (export)
                                      (link (((S1 : (tag t x-sub)) (S2 : x-sub)) u1)
                                            (() u2 S1)))))
  )

(let ()
  (define u1 (unit (import) (export (tag t1 x-sig) (prefix : x-sig))
                   (define x 10)
                   (define :x 11)))
  (define-values/invoke-unit u1 (import) (export x-sig (tag t1 (prefix m x-sig))))
  (test '(11 10)
        (list x mx)))


(define-signature s1 (x))
(define-signature s2 (a x z))


(test-syntax-error "unit-from-context: no sigs"
  (unit-from-context))
(test-syntax-error "unit-from-context: too many sigs"
  (unit-from-context s1 s2))
(test-syntax-error "unit-from-context: too many sigs"
  (unit-from-context s1 . s2))
(test-syntax-error "unit-from-context: bad sig"
  (unit-from-context 1))

(test-syntax-error "unit-from-context: no name"
  (define-unit-from-context))
(test-syntax-error "unit-from-context: no sigs"
  (define-unit-from-context s1))
(test-syntax-error "unit-from-context: no sigs"
  (define-unit-from-context n))
(test-syntax-error "unit-from-context: too many sigs"
  (define-unit-from-context n s1 s2))
(test-syntax-error "unit-from-context: too many sigs"
  (define-unit-from-context n s1 . s2))
(test-syntax-error "unit-from-context: bad sig"
  (define-unit-from-context n 1))



;; Test the struct form
(test-syntax-error "struct: missing name and fields"
  (define-signature x ((struct))))
(test-syntax-error "struct: missing name"
  (define-signature x ((struct n))))
(test-syntax-error "struct: bad name"
  (define-signature x ((struct 1 ()))))
(test-syntax-error "struct: bad fields (dot)"
  (define-signature x ((struct n (x . y)))))
(test-syntax-error "struct: bad fields"
  (define-signature x ((struct n 1))))
(test-syntax-error "struct: bad omission"
  (define-signature x ((struct n () t))))
(test-syntax-error "struct: bad omission (dot)"
  (define-signature x ((struct n () . -selectors))))
(test-syntax-error "struct: bad omission"
  (define-signature x ((struct n () x))))

(let ()
  (define-signature sig ((struct s (x y))))
  (test 3
    (invoke-unit
     (compound-unit (import) (export)
                    (link (((S : sig)) (unit (import) (export sig)
                                             (define-struct s (x y))))
                          (() (unit (import sig) (export)
                                    (match (make-s 1 2)
                                      ((struct s (a b)) (+ a b))))
                              S)))))
  (let ()
    (define-values/invoke-unit (unit (import) (export sig) (define-struct s (x y)))
      (import)
      (export sig))
    (test 3
      (match (make-s 1 2)
        ((struct s (a b)) (+ a b)))))
  (let ()
    (define u
      (unit (import) (export (rename sig (make-s/defaults make-s)))
            (define-struct s (x y))
            (define (make-s/defaults x)
              (make-s x 'default))))
    (define-values/invoke-unit u (import) (export sig))
    (test #t (s? (make-s 1))))

  (let ((set-s-x! 1))
    (define-signature sig ((struct s (x y))))
    (test 1
      (invoke-unit
       (compound-unit (import) (export)
                      (link (((S : sig)) (unit (import) (export sig) (define-struct s (x y))))
                            (() (unit (import sig) (export)
                                      set-s-x!) S))))))
  (let ((make-s 1))
    (define-signature sig ((struct s (x y) #:omit-constructor)))
    (test 1
      (invoke-unit
       (compound-unit (import) (export)
                      (link (((S : sig)) (unit (import) (export sig) (define-struct s (x y))))
                            (() (unit (import sig) (export)
                                      make-s) S)))))))

;; Dependencies

(define-signature s1 (a))
(define-signature s2 extends s1 ())

(define u1 (unit (import s1) (export) (init-depend s1)
                 a))
(define u2 (unit (import) (export s1)
                 (define a 12)))
(define u3 (unit (import (tag t s1)) (export) (init-depend (tag t s1))
                 a))

(define u4 (compound-unit (import (L : s2)) (export)
                          (link (() u1 L))))
(define u5 (unit (import) (export s2)
                 (define a 12)))
(test-syntax-error "unit: bad dependency"
                   (unit (import (tag t s1)) (export) (init-depend s1)))
(test-syntax-error "unit: bad dependency"
                   (unit (import s1) (export) (init-depend (tag t s1))))

(test 12 (invoke-unit (compound-unit (import) (export)
                                     (link (((S1 : s1)) u2)
                                           (() u1 S1)))))

(test-runtime-error exn:fail:contract? "Dependency violation"
                    (compound-unit (import) (export)
                                     (link (() u1 S1)
                                           (((S1 : s1)) u2))))

(test-runtime-error exn:fail:contract? "Dependency violation"
                    (compound-unit (import) (export)
                                     (link (() u3 (tag t S1))
                                           (((S1 : s1)) u2))))



(test-runtime-error exn:fail:contract? "Dependency violation"
                    (compound-unit (import) (export)
                                     (link (() u4 S2)
                                           (((S2 : s2)) u5))))
;; Inference


(define u (unit (import x-sig) (export y-sig) (define y 0) x))
(define v (unit (import) (export x-sig y-sig) (define x 9) (define y 10)))

(test 9
      (let ()
        (define-unit-binding u2 u (import x-sig y-sig) (export))
        (invoke-unit
         (compound-unit (import) (export)
                        (link (((A : x-sig) (B : y-sig)) v)
                              (() u A B))))))

(test-runtime-error exn:fail:contract? "not subunit"
                    (let () (define-unit-binding u2 u (import x-sig) (export x-sig)) 1))
(test-runtime-error exn:fail:contract? "not subunit"
                    (let () (define-unit-binding u2 u (import) (export)) 1))
(test-runtime-error exn:fail:contract? "not a unit"
                    (let () (define-unit-binding u2 1 (import) (export)) 1))

(test-syntax-error "define-unit-binding: duplicate import"
                   (define-unit-binding u 1 (import x-sig x-sig) (export)))
(test-syntax-error "define-unit-binding: export subtypes"
                   (define-unit-binding u 1 (import) (export x-sig x-sub)))
(test-syntax-error "define-unit-binding: export subtypes"
                   (define-unit-binding u 1 (import) (export x-sub x-sig)))
(test-syntax-error "define-unit-binding: bad dependency"
                   (define-unit-binding u 1 (import x-sig) (export) (init-depend x-sub)))
(test-syntax-error "define-unit-binding: bad dependency"
                   (define-unit-binding u 1 (import x-sub) (export) (init-depend x-sig)))


(test-syntax-error "define-unit: missing name, import, export"
  (define-unit))
(test-syntax-error "define-unit: missing import, export"
  (define-unit a))
(test-syntax-error "define-unit: missing export"
  (define-unit a (import)))
(test-syntax-error "define-unit: missing name"
  (define-unit (import) (export)))
(test-syntax-error "define-unit: bad name"
  (define-unit "x" (import) (export)))
(test-syntax-error "define-unit: bad syntax"
  (define-unit x (unit (import) (export))))
(test-runtime-error exn:fail:contract? "define-unit: bad set!"
  (let ()
    (define-signature s ())
    (define-unit x (import) (export) 1)
    (set! x (unit (import s) (export) 1))))
(test-runtime-error exn:fail:contract? "define-unit: bad set!"
  (let ()
    (define-signature s ())
    (define-unit x (import) (export s) 1)
    (set! x (unit (import) (export) 1))))


(test-syntax-error "define-compound-unit: missing import"
  (define-compound-unit x))
(test-syntax-error "define-compound-unit: missing name"
  (define-compound-unit))
(test-syntax-error "define-compound-unit: missing name"
  (define-compound-unit (import) (link) (export)))
(test-syntax-error "define-compound-unit: bad name"
  (define-compound-unit 1 (import) (link) (export)))

(test-syntax-error "invoke-unit/infer : no unit"
  (invoke-unit/infer))
(test-syntax-error "invoke-unit/infer : not a unit"
  (invoke-unit/infer 1))
(test-syntax-error "invoke-unit/infer : not a unit"
  (let ([x 1]) (invoke-unit/infer x)))
(test-syntax-error "invoke-unit/infer : not a unit"
  (let-syntax ([x 1]) (invoke-unit/infer x)))
(test-syntax-error "invoke-unit/infer: too much"
  (invoke-unit/infer x y))

(define-unit u (import x-sig) (export))
(define-unit v (import) (export x-sig) (define x 3))

(test-syntax-error "invoke-unit/infer : no unit"
  (invoke-unit/infer (link)))
(test-syntax-error "invoke-unit/infer : not a unit"
  (invoke-unit/infer (link 1 u)))
(test-syntax-error "invoke-unit/infer : not a unit"
  (let ([x 1]) (invoke-unit/infer (link u x))))
(test-syntax-error "invoke-unit/infer : not a unit"
  (let-syntax ([x 1]) (invoke-unit/infer (link x u))))
(invoke-unit/infer (link u v))

(test-syntax-error "define-values/invoke-unit/infer: no unit"
  (define-values/invoke-unit/infer))
(test-syntax-error "define-values/invoke-unit/infer: not a unit"
  (define-values/invoke-unit/infer 1))
(test-syntax-error "define-values/invoke-unit/infer: not a unit"
  (let ((x 1))
    (define-values/invoke-unit/infer x)))
(test-syntax-error "define-values/invoke-unit/infer: not a unit"
  (let-syntax ((x 1))
    (define-values/invoke-unit/infer x)))
(test-syntax-error "define-values/invoke-unit/infer: too much"
  (define-values/invoke-unit/infer x y))

(define-unit u (import x-sig) (export) x)
(define-unit v (import) (export x-sig) (define x 3))

(test-syntax-error "define-values/invoke-unit/infer: no unit"
  (define-values/invoke-unit/infer (link)))
(test-syntax-error "define-values/invoke-unit/infer: not a unit"
  (define-values/invoke-unit/infer (link 1 u)))
(test-syntax-error "define-values/invoke-unit/infer: not a unit"
  (let ([x 1])
    (define-values/invoke-unit/infer (link u x))))
(test-syntax-error "define-values/invoke-unit/infer: not a unit"
  (let-syntax ([x 1])
    (define-values/invoke-unit/infer (link u x))))
(let ()
  (define-values/invoke-unit/infer (link u v))
  x)


(let ()
  (define-values/invoke-unit/infer (export x-sig) (link u v))
  x)
(let ()
  (define-values/invoke-unit/infer (export x-sig) v)
  x)
(test-syntax-error "define-values/invoke-unit/infer: doesn't export y"
  (define-values/invoke-unit/infer (export y-sig) (link u v)))

(test-runtime-error exn? "define-values/invoke-unit/infer: unbound variable: x"
  (let ()
    (define-values/invoke-unit/infer (export) (link u v))
    x))
(test-syntax-error "define-values/invoke-unit/infer: doesn't export y"
  (define-values/invoke-unit/infer (export y-sig) v))
(test-runtime-error exn? "define-values/invoke-unit/infer: unbound variable: x"
   (let ()
     (define-values/invoke-unit/infer (export) v)
     x))

(let ()
  (define-signature s^ (a))
  (define-signature t^ (b))
  (define-unit u@
    (import s^)
    (export t^)
    (init-depend s^)
    (define b a))
  (define-unit v@
    (import)
    (export s^)
    (define a 2))
  (define-values/invoke-unit/infer (export) (link v@ u@))
  (test-runtime-error exn? "define-values/invoke-unit/infer: init-depend broken"
    (define-values/invoke-unit/infer (export) (link u@ v@))))


(define-unit u (import x-sig) (export) x)
(test-syntax-error "define-values/invoke-unit/infer: bad imports"
  (define-values/invoke-unit/infer u))
(define-unit u (import x-sig y-sig) (export))
(test-syntax-error "define-values/invoke-unit/infer: bad imports"
  (define-values/invoke-unit/infer u))
(define-unit u (import) (export x-sig y-sig)
  (define x 10)
  (define y 20))
(test 30
  (let ()
    (define-values/invoke-unit/infer u)
    (+ y x)))


(test 1
  (let ()
    (define-unit x (import) (export) 1)
    (invoke-unit x)))
(test 1
  (let ()
    (define-unit x (import) (export) 1)
    (let ((u 1))
      (invoke-unit x))))
(test 2
  (let ()
    (define-unit x (import) (export) 1)
    (set! x (unit (import) (export) 2))
    (invoke-unit x)))



(let ()
  (define-signature s1 (a))
  (define-signature s2 extends s1 (b))
  (define-signature s3 (c))
  (define-signature s4 extends s3 (d))
  (define-unit u (import s2) (export s3) (define c (+ a b)))
  (define-unit v (import) (export s2) (define a 1) (define b 3))
  (set! u (unit (import s1) (export s4) (define c (add1 a)) (define d 12)))
  (let ()
    (define-values/invoke-unit (compound-unit/infer (import) (export s2 s3) (link v u)) 
      (import) (export s2 s3))
    (test '(1 3 2) (list a b c))))


(test-syntax-error "compound-unit/infer: missing export"
  (compound-unit/infer (link) (import)))
(test-syntax-error "compound-unit/infer: bad unit"
  (compound-unit/infer (import) (export) (link 1)))
(test-syntax-error "compound-unit/infer: bad import"
  (compound-unit/infer (import (a : b)) (export) (link)))
(test-syntax-error "compound-unit/infer: bad link"
  (compound-unit/infer (import) (export) (link (((A : b)) c))))
(test-syntax-error "compound-unit/infer: unknown sig"
  (compound-unit/infer (import ??) (export) (link)))
(test-syntax-error "compound-unit/infer: unknown sig"
  (compound-unit/infer (import) (export ??) (link)))
(test-syntax-error "compound-unit/infer: unknown sig"
  (compound-unit/infer (import) (export) (link (() u ??))))


(define-unit x
  (import x-sig)
  (export y-sig)
  (define y x)
  y)

(define-unit y
  (import y-sig)
  (export (rename x-sig (x x)))
  (define x y)
  x)

(define-unit z
  (import (prefix : x-sig) y-sig)
  (export)
  (+ :x y))

(define-unit a
  (import)
  (export x-sig y-sig z-sig)
  (define x 1)
  (define y 2)
  (define z 3))

(define-unit b
  (import x-sig y-sig z-sig)
  (export)
  (+ x y z))

(test-syntax-error "compound-unit/infer: re-export"
  (compound-unit/infer (import (l : x-sig)) (export x-sig) (link)))
(test-syntax-error "compound-unit/infer: duplicate def and import"
  (compound-unit/infer (import y-sig x-sig) (export) (link x y)))
(test-syntax-error "compound-unit/infer: unprovided sig"
  (compound-unit/infer (import) (export) (link x)))
(test-syntax-error "compound-unit/infer: unprovided sig"
  (compound-unit/infer (import) (export x-sig) (link)))

(test (letrec ((x x)) x)
  (invoke-unit 
   (compound-unit/infer (import) (export)
                        (link x y))))

(test 3
  (let ()
    (define-signature s (x y))
    (let ((x 1)
          (y 2))
      (define-unit-from-context u1 s)
      (define-unit u2 (import (prefix : s)) (export)
        (+ :x :y))
      (invoke-unit
       (compound-unit/infer (import) (export)
                            (link u1 u2))))))
(test 6
      (invoke-unit
       (compound-unit/infer (import) (export)
                            (link (((L1 : y-sig)) a)
                                  x
                                  (() b L1)))))

(let ()
  (define-unit u1 (import (tag t x-sig)) (export)
    (add1 x))
  (define-unit u2 (import) (export x-sig)
    (define x 2))
  (test 3
        (invoke-unit
         (compound-unit/infer (import) (export)
                              (link u2 u1)))))
(let ()
  (define-unit u1 (import x-sig) (export)
    (add1 x))
  (define-unit u2 (import) (export (tag u x-sig))
    (define x 2))
  (test 3
        (invoke-unit
         (compound-unit/infer (import) (export)
                              (link u2 u1)))))

(let ()
  (define-unit x2 (import) (export x-sig) (define x 44))
  (define-unit x3 (import) (export x-sig) (define x 4400))
  (define-unit z (import x-sig) (export z-sig) (define z (+ 100 x)))
  (define-compound-unit/infer u (import (L : x-sig)) (export L2 y-sig)
    (link x3 (((L2 : z-sig)) z L) (() a L)))
  (test 190
        (invoke-unit
         (compound-unit/infer (import) (export)
                              (link x2 u b)))))

(let ()
  (define-unit u (import x-sig) (export))
  (define-unit v (import) (export x-sub) (define x 12) (define xx 13))
  (define-compound-unit/infer c (import) (export x-sig) (link v u))
  (define-values/invoke-unit/infer c)
  (test 12 x))


(let ()
  (define-unit u (import) (export x-sig)
    (define x 12))
  (define-unit u2 (import) (export x-sig)
    (define x 13))
  (define-unit v (import) (export y-sig)
    (define y 11))
  (define-unit v2 (import) (export y-sig)
    (define y 1))
  (define-unit u3 (import y-sig x-sig) (export)
    (+ y x))
  (test 24
        (invoke-unit
         (compound-unit/infer (import) (export)
                              (link (((l : x-sig)) u)
                                    (((l2 : x-sig)) u2)
                                    (((l3 : y-sig)) v)
                                    (((l4 : y-sig)) v2)
                                    (() u3 l2 l3))))))

;; unit/new-import-export

(test-runtime-error exn:fail:contract? "unit/new-import-export: not a unit"
  (unit/new-import-export (import) (export)
                          (() 1)))

(test-runtime-error exn:fail:contract? "unit/new-import-export: not a subtype"
  (unit/new-import-export (import) (export)
                          ((x-sig) (unit (import) (export)))))


(test-runtime-error exn:fail:contract? "unit/new-import-export: not a subtype"
  (unit/new-import-export (import) (export)
                          (() (unit (import x-sig) (export)))))

(define-unit u (import x-sig) (export y-sig)
  (define y x))

(test-syntax-error "unit/new-import-export: not enough imports"
  (unit/new-import-export (import) (export x-sig)
                          ((y-sig) u x-sig)))

(test-syntax-error "unit/new-import-export: too many exports"
  (unit/new-import-export (import x-sig) (export y-sig z-sig)
                          ((y-sig) u x-sig)))

(let ()
  (define-unit u 
    (import xy-sig) (export z-sig)
    (define z (+ x y)))
  (define-unit v
    (import) (export x-sig y-sig)
    (define x 4)
    (define y 8))
  (define-unit w (import z-sig) (export)
    z)
  (define-unit/new-import-export u2 (import x-sig y-sig) (export z-sig)
    ((z-sig) u xy-sig))
  (test 12
        (invoke-unit (compound-unit/infer (import) (export)
                                          (link v u2 w)))))
      
(let ()
  (define-unit u 
    (import x-sig y-sig) (export z-sig)
    (define z (+ x y)))
  (define-unit v
    (import) (export xy-sig)
    (define x 4)
    (define y 8))
  (define-unit w (import z-sig) (export)
    z)
  (define-unit/new-import-export u2 (import xy-sig) (export z-sig)
    ((z-sig) u y-sig x-sig))
  (test 12
        (invoke-unit (compound-unit/infer (import) (export)
                                          (link v u2 w)))))
      
(let ()
  (define-unit u 
    (import xy-sig) (export z-sig)
    (define z (+ x y)))
  (define-unit v
    (import) (export x-sig y-sig)
    (define x 4)
    (define y 8))
  (define-unit w (import z-sig) (export)
    z)
  (define-unit/new-import-export v2 (import) (export xy-sig)
    ((x-sig y-sig) v))
  (test 12
        (invoke-unit (compound-unit/infer (import) (export)
                                          (link v2 u w)))))
      
(let ()
  (define-unit u 
    (import x-sig y-sig) (export z-sig)
    (define z (+ x y)))
  (define-unit v
    (import) (export xy-sig)
    (define x 4)
    (define y 8))
  (define-unit w (import z-sig) (export)
    z)
  (define-unit/new-import-export v2 (import) (export y-sig x-sig)
    ((xy-sig) v))
  (test 12
        (invoke-unit (compound-unit/infer (import) (export)
                                          (link v2 u w)))))




;; open
(let ()
  (define-signature xzy
    ((open x-sig) (open y-sig) (open z-sig)))
  
  (define-unit u (import xzy) (export)
    (+ x z y))
  
  (define-unit v (import) (export xzy)
    (define x 10)
    (define y 20)
    (define z 30))
  
  (test 60
        (invoke-unit (compound-unit/infer (import) (export) (link v u)))))

(let ([x 1]
      [y 2]
      [z 3])  
  (define-signature xzy
    ((open x-sig) (open y-sig) (open z-sig)))
  
  (define-unit u (import xzy) (export)
    (+ x z y))
  
  (define-unit v (import) (export xzy)
    (define x 10)
    (define y 20)
    (define z 30))
  
  (test 60
        (invoke-unit (compound-unit/infer (import) (export) (link v u)))))

(define-signature s
  (x (define-values (y) (add1 x))))

(let ([x 1]
      [y 10]
      [s:x 100]
      [s:y 1000])
  (define-signature s2
    ((open (prefix s: s)) x (define-values (y) (sub1 x))))
  (define-unit u1 (import s2) (export)
    (list s:x s:y x y))
  (define-unit u2 (import) (export s2)
    (define s:x 3)
    (define x 19))
  (test '(3 4 19 18)
        (invoke-unit (compound-unit/infer (import) (export) (link u2 u1)))))


(define-signature sig^ (u-a))

(define-unit unit@
  (import)
  (export sig^)
  
  (define u-a 'zero))

(test 'zero
      (let ([q:u-a 5])
        (define-values/invoke-unit unit@ (import) (export (prefix q: sig^)))
        q:u-a))

(define-syntax (use-unit stx)
  (syntax-case stx ()
    [(_)
     #'(let ()
         (define-values/invoke-unit unit@ (import) (export sig^))
         u-a)]))

(define-syntax (use-unit2 stx)
  (syntax-case stx ()
    [(_)
     #'(let ()
         (define-values/invoke-unit/infer unit@)
         u-a)]))

(define-syntax (use-unit-badly1 stx)
  (syntax-case stx ()
    [(_ u-a)
     #'(let ()
         (define-values/invoke-unit unit@ (import) (export sig^))
         u-a)]))

(define-syntax (use-unit-badly2 stx)
  (syntax-case stx ()
    [(_ sig^)
     #'(let ()
         (define-values/invoke-unit unit@ (import) (export sig^))
         u-a)]))

(test 'zero (use-unit))
(test 'zero (use-unit2))
(test-runtime-error exn:fail:contract:variable? "context mismatch; no u-a"
  (use-unit-badly1 u-a))
(test-runtime-error exn:fail:contract:variable? "context mismatch; no u-a"
  (use-unit-badly2 sig^))

(test 12
      (let ()
        (define-signature s^ (x))
        (define-unit u@
          (import)
          (export s^)
          (define x 12))
        (define-values/invoke-unit u@ (import) (export s^))
        x))