diff --git a/collects/tests/typed-scheme/unit-tests/subtype-tests.ss b/collects/tests/typed-scheme/unit-tests/subtype-tests.ss index 69b56012..3725582e 100644 --- a/collects/tests/typed-scheme/unit-tests/subtype-tests.ss +++ b/collects/tests/typed-scheme/unit-tests/subtype-tests.ss @@ -29,97 +29,97 @@ (subtyping-tests ;; trivial examples (Univ Univ) - (N Univ) - (B Univ) - (Sym Univ) + (-Number Univ) + (-Boolean Univ) + (-Symbol Univ) (-Void Univ) - [N N] + [-Number -Number] [(Un (-pair Univ (-lst Univ)) (-val '())) (-lst Univ)] - [(-pair N (-pair N (-pair (-val 'foo) (-val '())))) (-lst Univ)] - [(-pair N (-pair N (-pair (-val 'foo) (-val '())))) (-lst (Un N Sym))] - [(-pair (-val 6) (-val 6)) (-pair N N)] + [(-pair -Number (-pair -Number (-pair (-val 'foo) (-val '())))) (-lst Univ)] + [(-pair -Number (-pair -Number (-pair (-val 'foo) (-val '())))) (-lst (Un -Number -Symbol))] + [(-pair (-val 6) (-val 6)) (-pair -Number -Number)] [(-val 6) (-val 6)] ;; unions - [(Un N) N] - [(Un N N) N] - [(Un N Sym) (Un Sym N)] - [(Un (-val 6) (-val 7)) N] - [(Un (-val #f) (Un (-val 6) (-val 7))) (Un N (Un B Sym))] - [(Un (-val #f) (Un (-val 6) (-val 7))) (-mu x (Un N (Un B Sym)))] - [(Un N (-val #f) (-mu x (Un N Sym (make-Listof x)))) - (-mu x (Un N Sym B (make-Listof x)))] + [(Un -Number) -Number] + [(Un -Number -Number) -Number] + [(Un -Number -Symbol) (Un -Symbol -Number)] + [(Un (-val 6) (-val 7)) -Number] + [(Un (-val #f) (Un (-val 6) (-val 7))) (Un -Number (Un -Boolean -Symbol))] + [(Un (-val #f) (Un (-val 6) (-val 7))) (-mu x (Un -Number (Un -Boolean -Symbol)))] + [(Un -Number (-val #f) (-mu x (Un -Number -Symbol (make-Listof x)))) + (-mu x (Un -Number -Symbol -Boolean (make-Listof x)))] ;; sexps vs list*s of nums - [(-mu x (Un N Sym (make-Listof x))) (-mu x (Un N Sym B (make-Listof x)))] - [(-mu x (Un N (make-Listof x))) (-mu x (Un N Sym (make-Listof x)))] - [(-mu x (Un N (make-Listof x))) (-mu y (Un N Sym (make-Listof y)))] + [(-mu x (Un -Number -Symbol (make-Listof x))) (-mu x (Un -Number -Symbol -Boolean (make-Listof x)))] + [(-mu x (Un -Number (make-Listof x))) (-mu x (Un -Number -Symbol (make-Listof x)))] + [(-mu x (Un -Number (make-Listof x))) (-mu y (Un -Number -Symbol (make-Listof y)))] ;; a hard one - [(-mu x (*Un N (-pair x (-pair Sym (-pair x (-val null)))))) -Sexp] + [(-mu x (*Un -Number (-pair x (-pair -Symbol (-pair x (-val null)))))) -Sexp] ;; simple function types - ((Univ . -> . N) (N . -> . Univ)) - [(Univ Univ Univ . -> . N) (Univ Univ N . -> . N)] + ((Univ . -> . -Number) (-Number . -> . Univ)) + [(Univ Univ Univ . -> . -Number) (Univ Univ -Number . -> . -Number)] ;; simple list types - [(make-Listof N) (make-Listof Univ)] - [(make-Listof N) (make-Listof N)] - [FAIL (make-Listof N) (make-Listof Sym)] + [(make-Listof -Number) (make-Listof Univ)] + [(make-Listof -Number) (make-Listof -Number)] + [FAIL (make-Listof -Number) (make-Listof -Symbol)] [(-mu x (make-Listof x)) (-mu x* (make-Listof x*))] - [(-pair N N) (-pair Univ N)] - [(-pair N N) (-pair N N)] + [(-pair -Number -Number) (-pair Univ -Number)] + [(-pair -Number -Number) (-pair -Number -Number)] ;; from page 7 [(-mu t (-> t t)) (-mu s (-> s s))] - [(-mu s (-> N s)) (-mu t (-> N (-> N t)))] + [(-mu s (-> -Number s)) (-mu t (-> -Number (-> -Number t)))] ;; polymorphic types [(-poly (t) (-> t t)) (-poly (s) (-> s s))] - [FAIL (make-Listof N) (-poly (t) (make-Listof t))] - [(-poly (a) (make-Listof (-v a))) (make-Listof N)] ;; - [(-poly (a) N) N] + [FAIL (make-Listof -Number) (-poly (t) (make-Listof t))] + [(-poly (a) (make-Listof (-v a))) (make-Listof -Number)] ;; + [(-poly (a) -Number) -Number] - [(-val 6) N] - [(-val 'hello) Sym] - [((Un Sym N) . -> . N) (-> N N)] - [(-poly (t) (-> N t)) (-mu t (-> N t))] + [(-val 6) -Number] + [(-val 'hello) -Symbol] + [((Un -Symbol -Number) . -> . -Number) (-> -Number -Number)] + [(-poly (t) (-> -Number t)) (-mu t (-> -Number t))] ;; not subtypes - [FAIL (-val 'hello) N] - [FAIL (-val #f) Sym] - [FAIL (Univ Univ N N . -> . N) (Univ Univ Univ . -> . N)] - [FAIL (N . -> . N) (-> Univ Univ)] - [FAIL (Un N Sym) N] - [FAIL N (Un (-val 6) (-val 11))] - [FAIL Sym (-val 'Sym)] - [FAIL (Un Sym N) (-poly (a) N)] + [FAIL (-val 'hello) -Number] + [FAIL (-val #f) -Symbol] + [FAIL (Univ Univ -Number -Number . -> . -Number) (Univ Univ Univ . -> . -Number)] + [FAIL (-Number . -> . -Number) (-> Univ Univ)] + [FAIL (Un -Number -Symbol) -Number] + [FAIL -Number (Un (-val 6) (-val 11))] + [FAIL -Symbol (-val 'Sym)] + [FAIL (Un -Symbol -Number) (-poly (a) -Number)] ;; bugs found [(Un (-val 'foo) (-val 6)) (Un (-val 'foo) (-val 6))] - [(-poly (a) (make-Listof (-v a))) (make-Listof (-mu x (Un (make-Listof x) N)))] - [FAIL (make-Listof (-mu x (Un (make-Listof x) N))) (-poly (a) (make-Listof a))] + [(-poly (a) (make-Listof (-v a))) (make-Listof (-mu x (Un (make-Listof x) -Number)))] + [FAIL (make-Listof (-mu x (Un (make-Listof x) -Number))) (-poly (a) (make-Listof a))] ;; case-lambda - [(cl-> [(N) N] [(B) B]) (N . -> . N)] + [(cl-> [(-Number) -Number] [(-Boolean) -Boolean]) (-Number . -> . -Number)] ;; special case for unused variables - [N (-poly (a) N)] - [FAIL (cl-> [(N) B] [(B) N]) (N . -> . N)] + [-Number (-poly (a) -Number)] + [FAIL (cl-> [(-Number) -Boolean] [(-Boolean) -Number]) (-Number . -> . -Number)] ;; varargs - [(->* (list N) Univ B) (->* (list N) N B)] - [(->* (list Univ) N B) (->* (list N) N B)] - [(->* (list N) N B) (->* (list N) N B)] - [(->* (list N) N B) (->* (list N) N Univ)] - [(->* (list N) N N) (->* (list N N) N)] - [(->* (list N) N N) (->* (list N N N) N)] - [(->* (list N N) B N) (->* (list N N) N)] - [FAIL (->* (list N) N B) (->* (list N N N) N)] - [(->* (list N N) B N) (->* (list N N B B) N)] + [(->* (list -Number) Univ -Boolean) (->* (list -Number) -Number -Boolean)] + [(->* (list Univ) -Number -Boolean) (->* (list -Number) -Number -Boolean)] + [(->* (list -Number) -Number -Boolean) (->* (list -Number) -Number -Boolean)] + [(->* (list -Number) -Number -Boolean) (->* (list -Number) -Number Univ)] + [(->* (list -Number) -Number -Number) (->* (list -Number -Number) -Number)] + [(->* (list -Number) -Number -Number) (->* (list -Number -Number -Number) -Number)] + [(->* (list -Number -Number) -Boolean -Number) (->* (list -Number -Number) -Number)] + [FAIL (->* (list -Number) -Number -Boolean) (->* (list -Number -Number -Number) -Number)] + [(->* (list -Number -Number) -Boolean -Number) (->* (list -Number -Number -Boolean -Boolean) -Number)] [(-poly (a) (cl-> [() a] - [(N) a])) - (cl-> [() (-pair N (-v b))] - [(N) (-pair N (-v b))])] + [(-Number) a])) + (cl-> [() (-pair -Number (-v b))] + [(-Number) (-pair -Number (-v b))])] - [(-values (list N)) (-values (list Univ))] + [(-values (list -Number)) (-values (list Univ))] - [(-poly (a) ((Un (make-Base 'foo #'dummy) (-struct 'bar #f (list N a))) . -> . (-lst a))) - ((Un (make-Base 'foo #'dummy) (-struct 'bar #f (list N (-pair N (-v a))))) . -> . (-lst (-pair N (-v a))))] - [(-poly (a) ((-struct 'bar #f (list N a)) . -> . (-lst a))) - ((-struct 'bar #f (list N (-pair N (-v a)))) . -> . (-lst (-pair N (-v a))))] + [(-poly (a) ((Un (make-Base 'foo #'dummy) (-struct 'bar #f (list -Number a))) . -> . (-lst a))) + ((Un (make-Base 'foo #'dummy) (-struct 'bar #f (list -Number (-pair -Number (-v a))))) . -> . (-lst (-pair -Number (-v a))))] + [(-poly (a) ((-struct 'bar #f (list -Number a)) . -> . (-lst a))) + ((-struct 'bar #f (list -Number (-pair -Number (-v a)))) . -> . (-lst (-pair -Number (-v a))))] [(-poly (a) (a . -> . (make-Listof a))) ((-v b) . -> . (make-Listof (-v b)))] - [(-poly (a) (a . -> . (make-Listof a))) ((-pair N (-v b)) . -> . (make-Listof (-pair N (-v b))))] + [(-poly (a) (a . -> . (make-Listof a))) ((-pair -Number (-v b)) . -> . (make-Listof (-pair -Number (-v b))))] (FAIL (-poly (a b) (-> a a)) (-poly (a b) (-> a b)))