141 lines
4.2 KiB
Racket
141 lines
4.2 KiB
Racket
#lang type-expander
|
|
|
|
(require (lib "phc-graph/invariants-phantom.hl.rkt")
|
|
"util.rkt"
|
|
phc-graph/dot-lang
|
|
phc-toolkit)
|
|
|
|
(check-same-type
|
|
(Π (λdot a aa) ((λdot b c))* (λdot d e))
|
|
(Rec
|
|
R
|
|
(U (Pairof Any R)
|
|
(Pairof
|
|
(Pairof 'a AnyType)
|
|
(Pairof
|
|
(Pairof 'aa AnyType)
|
|
(Rec
|
|
R
|
|
(U (Pairof
|
|
(Pairof 'b AnyType)
|
|
(Pairof (Pairof 'c AnyType) R))
|
|
(List (Pairof 'd AnyType) (Pairof 'e AnyType)))))))))
|
|
(struct a ()); the field.
|
|
(check-same-type
|
|
(Π (dot :a aa) ((λdot b c))* (λdot d e))
|
|
(Rec
|
|
R
|
|
(U (Pairof Any R)
|
|
(Pairof
|
|
(Pairof AnyField a)
|
|
(Pairof
|
|
(Pairof 'aa AnyType)
|
|
(Rec
|
|
R
|
|
(U (List (Pairof 'd AnyType) (Pairof 'e AnyType))
|
|
(Pairof (Pairof 'b AnyType) (Pairof (Pairof 'c AnyType) R)))))))))
|
|
(check-same-type
|
|
(Π (dot :a) ((λdot b c))* (λdot d e))
|
|
(Rec
|
|
R
|
|
(U (Pairof Any R)
|
|
(Pairof
|
|
(Pairof AnyField a)
|
|
(Rec
|
|
R
|
|
(U (List (Pairof 'd AnyType) (Pairof 'e AnyType))
|
|
(Pairof (Pairof 'b AnyType) (Pairof (Pairof 'c AnyType) R))))))))
|
|
|
|
(check-same-type
|
|
(Π (dot :a) ((λdot b c) ((λdot w)) * (λdot x y))* (λdot d e))
|
|
(Rec
|
|
R
|
|
(U (Pairof Any R)
|
|
(Pairof
|
|
(Pairof AnyField a)
|
|
(U (List (Pairof 'd AnyType) (Pairof 'e AnyType))
|
|
(Pairof
|
|
(Pairof 'b AnyType)
|
|
(Pairof
|
|
(Pairof 'c AnyType)
|
|
(Rec
|
|
R
|
|
(U (Pairof (Pairof 'w AnyType) R)
|
|
(Pairof
|
|
(Pairof 'x AnyType)
|
|
(Pairof (Pairof 'y AnyType) R)))))))))))
|
|
|
|
;; TODO: test with deeper nesting of ()*
|
|
|
|
(check-same-type
|
|
(Invariant (dot :a) ((λdot b c) ((λdot w)) * (λdot x y))* (λdot d e)
|
|
≡
|
|
(dot :a) ((λdot b c))* (λdot d e))
|
|
(inv≡
|
|
(U (Rec
|
|
R
|
|
(U (Pairof Any R)
|
|
(Pairof
|
|
(Pairof AnyField a)
|
|
(Rec
|
|
R
|
|
(U (List (Pairof 'd AnyType) (Pairof 'e AnyType))
|
|
(Pairof (Pairof 'b AnyType) (Pairof (Pairof 'c AnyType) R)))))))
|
|
(Rec
|
|
R
|
|
(U (Pairof Any R)
|
|
(Pairof
|
|
(Pairof AnyField a)
|
|
(U (List (Pairof 'd AnyType) (Pairof 'e AnyType))
|
|
(Pairof
|
|
(Pairof 'b AnyType)
|
|
(Pairof
|
|
(Pairof 'c AnyType)
|
|
(Rec
|
|
R
|
|
(U (Pairof (Pairof 'w AnyType) R)
|
|
(Pairof
|
|
(Pairof 'x AnyType)
|
|
(Pairof (Pairof 'y AnyType) R)))))))))))))
|
|
|
|
(check-same-type
|
|
(Invariant (dot :a) ((λdot b c) ((λdot w)) * (λdot x y))* (λdot d e)
|
|
∈
|
|
(dot :a) ((λdot b c))* (λdot d e))
|
|
(Invariant (dot :a) ((λdot b c))* (λdot d e)
|
|
∋
|
|
(dot :a) ((λdot b c) ((λdot w)) * (λdot x y))* (λdot d e)))
|
|
|
|
|
|
(check-ann witness-value (Invariants)) ;; No invariants
|
|
(check-ann witness-value (Invariants (≡x (_ a) (_ a b c))))
|
|
|
|
(check-a-stronger-than-b (Invariants (≡x (_ a) (_ a b c)))
|
|
(Invariants))
|
|
|
|
(check-a-same-as-b (Invariants (≡x (_ a) (_ a b c)))
|
|
(Invariants (≡x (_ a b c) (_ a))))
|
|
|
|
(check-a-stronger-than-b (Invariants (≡x (_) (_ b c))
|
|
(≡x (_) (_ b d)))
|
|
(Invariants (≡x (_) (_ b c))))
|
|
(check-a-stronger-than-b (Invariants (≡x (_) (_ b d))
|
|
(≡x (_) (_ b c)))
|
|
(Invariants (≡x (_) (_ b c))))
|
|
|
|
;; ∀ .b.d(.a.b.>d)* of length ≥ 5
|
|
;; is stronger than
|
|
;; ∀ .b.d(.a.b.>d)* of length ≥ 8
|
|
;; as the elements of the latter are included in the former, but
|
|
;; the first element (length = 5) is missing in the latter, so the
|
|
;; former constrains more paths.
|
|
(check-a-stronger-than-b (Invariants (≡x (_)
|
|
(_ b d ↙ a b (d))))
|
|
(Invariants (≡x (_)
|
|
(_ b d a b d ↙ a b (d)))))
|
|
|
|
(check-a-stronger-than-b (Invariants (≡x (_)
|
|
(_ a b c ↙ d (e))))
|
|
(Invariants (≡x (_)
|
|
(_ a b c d e))))
|