154 lines
7.0 KiB
Racket
154 lines
7.0 KiB
Racket
#lang s-exp "../fsub.rkt"
|
||
(require "rackunit-typechecking.rkt")
|
||
|
||
;; examples from tapl ch26, bounded quantification
|
||
;; (same tests from stlc+reco+sub.rkt, but last one should not typecheck)
|
||
(check-type (λ ([x : (× [a : Int])]) x) : (→ (× [a : Int]) (× [a : Int])))
|
||
|
||
(define ra (tup [a = 0]))
|
||
(check-type ((λ ([x : (× [a : Int])]) x) ra)
|
||
: (× [a : Int]) ⇒ (tup [a = 0]))
|
||
(define rab (tup [a = 0][b = #t]))
|
||
(check-type ((λ ([x : (× [a : Int])]) x) rab)
|
||
: (× [a : Int]) ⇒ (tup [a = 0][b = #t]))
|
||
|
||
(check-type (proj ((λ ([x : (× [a : Int])]) x) rab) a)
|
||
: Int ⇒ 0)
|
||
|
||
(check-type (Λ ([X <: Top]) (λ ([x : X]) x)) : (∀ ([X <: Top]) (→ X X)))
|
||
(check-type (inst (Λ ([X <: Top]) (λ ([x : X]) x)) (× [a : Int][b : Bool]))
|
||
: (→ (× [a : Int][b : Bool]) (× [a : Int][b : Bool])))
|
||
|
||
(check-type (proj ((inst (Λ ([X <: Top]) (λ ([x : X]) x))
|
||
(× [a : Int][b : Bool]))
|
||
rab) b)
|
||
: Bool ⇒ #t)
|
||
|
||
(define f2 (λ ([x : (× [a : Nat])]) (tup [orig = x] [asucc = (+ 1 (proj x a))])))
|
||
(check-type f2 : (→ (× [a : Nat]) (× [orig : (× [a : Nat])] [asucc : Nat])))
|
||
(check-type (f2 ra) : (× [orig : (× [a : Nat])][asucc : Nat]))
|
||
(check-type (f2 rab) : (× [orig : (× [a : Nat])][asucc : Nat]))
|
||
|
||
; check expose properly called for primops
|
||
(define fNat (Λ ([X <: Nat]) (λ ([x : X]) (+ x 1))))
|
||
(check-type fNat : (∀ ([X <: Nat]) (→ X Nat)))
|
||
|
||
;; check type constructors properly call expose
|
||
(define f2poly
|
||
(Λ ([X <: (× [a : Nat])])
|
||
(λ ([x : X])
|
||
(tup [orig = x][asucc = (+ (proj x a) 1)]))))
|
||
|
||
(check-type f2poly : (∀ ([X <: (× [a : Nat])]) (→ X (× [orig : X][asucc : Nat]))))
|
||
|
||
; inst f2poly with (× [a : Nat])
|
||
(check-type (inst f2poly (× [a : Nat]))
|
||
: (→ (× [a : Nat])
|
||
(× [orig : (× [a : Nat])][asucc : Nat])))
|
||
(check-type ((inst f2poly (× [a : Nat])) ra)
|
||
: (× [orig : (× [a : Nat])][asucc : Nat])
|
||
⇒ (tup [orig = ra][asucc = 1]))
|
||
|
||
(check-type ((inst f2poly (× [a : Nat])) rab)
|
||
: (× [orig : (× [a : Nat])][asucc : Nat])
|
||
⇒ (tup [orig = rab][asucc = 1]))
|
||
|
||
(typecheck-fail (proj (proj ((inst f2poly (× [a : Nat])) rab) orig) b))
|
||
|
||
;; inst f2poly with (× [a : Nat][b : Bool])
|
||
(check-type (inst f2poly (× [a : Nat][b : Bool]))
|
||
: (→ (× [a : Nat][b : Bool])
|
||
(× [orig : (× [a : Nat][b : Bool])][asucc : Nat])))
|
||
(typecheck-fail ((inst f2poly (× [a : Nat][b : Bool])) ra))
|
||
|
||
(check-type ((inst f2poly (× [a : Nat][b : Bool])) rab)
|
||
: (× [orig : (× [a : Nat][b : Bool])][asucc : Nat])
|
||
⇒ (tup [orig = rab][asucc = 1]))
|
||
|
||
(check-type (proj (proj ((inst f2poly (× [a : Nat][b : Bool])) rab) orig) b)
|
||
: Bool ⇒ #t)
|
||
|
||
;; make sure inst still checks args
|
||
(typecheck-fail (inst (Λ ([X <: Nat]) 1) Int))
|
||
|
||
; ch28
|
||
(define f (Λ ([X <: (→ Nat Nat)]) (λ ([y : X]) (y 5))))
|
||
(check-type f : (∀ ([X <: (→ Nat Nat)]) (→ X Nat)))
|
||
(check-type (inst f (→ Nat Nat)) : (→ (→ Nat Nat) Nat))
|
||
(check-type (inst f (→ Int Nat)) : (→ (→ Int Nat) Nat))
|
||
(typecheck-fail (inst f (→ Nat Int)))
|
||
(check-type ((inst f (→ Int Nat)) (λ ([z : Int]) 5)) : Nat)
|
||
(check-type ((inst f (→ Int Nat)) (λ ([z : Num]) 5)) : Nat)
|
||
(typecheck-fail ((inst f (→ Int Nat)) (λ ([z : Nat]) 5)))
|
||
|
||
|
||
;; old sysf tests -------------------------------------------------------------
|
||
;; old syntax no longer valid
|
||
;(check-type (Λ (X) (λ ([x : X]) x)) : (∀ (X) (→ X X)))
|
||
;
|
||
;(check-type (Λ (X) (λ ([t : X] [f : X]) t)) : (∀ (X) (→ X X X))) ; true
|
||
;(check-type (Λ (X) (λ ([t : X] [f : X]) f)) : (∀ (X) (→ X X X))) ; false
|
||
;(check-type (Λ (X) (λ ([t : X] [f : X]) f)) : (∀ (Y) (→ Y Y Y))) ; false, alpha equiv
|
||
;
|
||
;(check-type (Λ (t1) (Λ (t2) (λ ([x : t1]) (λ ([y : t2]) y))))
|
||
; : (∀ (t1) (∀ (t2) (→ t1 (→ t2 t2)))))
|
||
;
|
||
;(check-type (Λ (t1) (Λ (t2) (λ ([x : t1]) (λ ([y : t2]) y))))
|
||
; : (∀ (t3) (∀ (t4) (→ t3 (→ t4 t4)))))
|
||
;
|
||
;(check-not-type (Λ (t1) (Λ (t2) (λ ([x : t1]) (λ ([y : t2]) y))))
|
||
; : (∀ (t4) (∀ (t3) (→ t3 (→ t4 t4)))))
|
||
;
|
||
;(check-type (inst (Λ (t) (λ ([x : t]) x)) Int) : (→ Int Int))
|
||
;(check-type (inst (Λ (t) 1) (→ Int Int)) : Int)
|
||
;; first inst should be discarded
|
||
;(check-type (inst (inst (Λ (t) (Λ (t) (λ ([x : t]) x))) (→ Int Int)) Int) : (→ Int Int))
|
||
;; second inst is discarded
|
||
;(check-type (inst (inst (Λ (t1) (Λ (t2) (λ ([x : t1]) x))) Int) (→ Int Int)) : (→ Int Int))
|
||
;
|
||
;;;; polymorphic arguments
|
||
;(check-type (Λ (t) (λ ([x : t]) x)) : (∀ (t) (→ t t)))
|
||
;(check-type (Λ (t) (λ ([x : t]) x)) : (∀ (s) (→ s s)))
|
||
;(check-type (Λ (s) (Λ (t) (λ ([x : t]) x))) : (∀ (s) (∀ (t) (→ t t))))
|
||
;(check-type (Λ (s) (Λ (t) (λ ([x : t]) x))) : (∀ (r) (∀ (t) (→ t t))))
|
||
;(check-type (Λ (s) (Λ (t) (λ ([x : t]) x))) : (∀ (r) (∀ (s) (→ s s))))
|
||
;(check-type (Λ (s) (Λ (t) (λ ([x : t]) x))) : (∀ (r) (∀ (u) (→ u u))))
|
||
;(check-type (λ ([x : (∀ (t) (→ t t))]) x) : (→ (∀ (s) (→ s s)) (∀ (u) (→ u u))))
|
||
;(typecheck-fail ((λ ([x : (∀ (t) (→ t t))]) x) (λ ([x : Int]) x)))
|
||
;(typecheck-fail ((λ ([x : (∀ (t) (→ t t))]) x) 1))
|
||
;(check-type ((λ ([x : (∀ (t) (→ t t))]) x) (Λ (s) (λ ([y : s]) y))) : (∀ (u) (→ u u)))
|
||
;(check-type
|
||
; (inst ((λ ([x : (∀ (t) (→ t t))]) x) (Λ (s) (λ ([y : s]) y))) Int) : (→ Int Int))
|
||
;(check-type
|
||
; ((inst ((λ ([x : (∀ (t) (→ t t))]) x) (Λ (s) (λ ([y : s]) y))) Int) 10)
|
||
; : Int ⇒ 10)
|
||
;(check-type (λ ([x : (∀ (t) (→ t t))]) (inst x Int)) : (→ (∀ (t) (→ t t)) (→ Int Int)))
|
||
;(check-type (λ ([x : (∀ (t) (→ t t))]) ((inst x Int) 10)) : (→ (∀ (t) (→ t t)) Int))
|
||
;(check-type ((λ ([x : (∀ (t) (→ t t))]) ((inst x Int) 10))
|
||
; (Λ (s) (λ ([y : s]) y)))
|
||
; : Int ⇒ 10)
|
||
|
||
|
||
;;; previous tests -------------------------------------------------------------
|
||
(check-type 1 : Int)
|
||
(check-not-type 1 : (→ Int Int))
|
||
;; strings and boolean literals now ok
|
||
;(typecheck-fail "one") ; unsupported literal
|
||
;(typecheck-fail #f) ; unsupported literal
|
||
(check-type (λ ([x : Int] [y : Int]) x) : (→ Int Int Int))
|
||
(check-not-type (λ ([x : Int]) x) : Int)
|
||
(check-type (λ ([x : Int]) x) : (→ Int Int))
|
||
(check-type (λ ([f : (→ Int Int)]) 1) : (→ (→ Int Int) Int))
|
||
(check-type ((λ ([x : Int]) x) 1) : Int ⇒ 1)
|
||
(typecheck-fail ((λ ([x : Bool]) x) 1)) ; Bool is not valid type
|
||
;(typecheck-fail (λ ([x : Bool]) x)) ; Bool is not valid type
|
||
(typecheck-fail (λ ([f : Int]) (f 1 2))) ; applying f with non-fn type
|
||
(check-type (λ ([f : (→ Int Int Int)] [x : Int] [y : Int]) (f x y))
|
||
: (→ (→ Int Int Int) Int Int Int))
|
||
;; edited from sysf test to handle subtyping
|
||
(check-type ((λ ([f : (→ Nat Nat Nat)] [x : Nat] [y : Nat]) (f x y)) + 1 2) : Num ⇒ 3)
|
||
(typecheck-fail (+ 1 (λ ([x : Int]) x))) ; adding non-Int
|
||
(typecheck-fail (λ ([x : (→ Int Int)]) (+ x x))) ; x should be Int
|
||
(typecheck-fail ((λ ([x : Int] [y : Int]) y) 1)) ; wrong number of args
|
||
(check-type ((λ ([x : Nat]) (+ x x)) 10) : Num ⇒ 20)
|