util.rkt (1003B)
1 #lang type-expander 2 3 (provide check-a-same-as-b 4 check-a-stronger-than-b 5 check-same-type) 6 7 (require phc-toolkit 8 (lib "phc-graph/invariants-phantom.hl.rkt") 9 (for-syntax phc-toolkit/untyped)) 10 11 (define-syntax (check-a-stronger-than-b stx) 12 (syntax-case stx () 13 [(_ stronger weaker) 14 (syntax/top-loc stx 15 (begin (check-ann (ann witness-value stronger) 16 weaker) 17 (check-not-tc 18 (ann (ann witness-value weaker) stronger))))])) 19 20 (define-syntax (check-a-same-as-b stx) 21 (syntax-case stx () 22 [(_ a b) 23 (syntax/top-loc stx 24 (begin 25 (check-ann (ann witness-value a) b) 26 (check-ann (ann witness-value b) a)))])) 27 28 (define-syntax (check-same-type stx) 29 (syntax-case stx () 30 [(_ a b) 31 (syntax/top-loc stx 32 (begin 33 (check-not-exn: 34 (λ () (λ ([x : a]) (check-ann x b)))) 35 (check-not-exn: 36 (λ () (λ ([x : b]) (check-ann x a))))))]))