8aa05bebff
Adds the following: + dependent function Types + some existential object support when applying dependent functions + simplify linear arith support + add unsafe-require/typed/provide
61 lines
1.9 KiB
Racket
61 lines
1.9 KiB
Racket
#lang racket/base
|
|
|
|
(require racket/require-syntax
|
|
racket/match
|
|
racket/gui/dynamic
|
|
typed-racket/utils/utils
|
|
(for-syntax racket/base syntax/parse)
|
|
(types utils subtype)
|
|
(utils tc-utils)
|
|
(typecheck check-below)
|
|
(rep type-rep)
|
|
rackunit rackunit/text-ui)
|
|
|
|
(provide private typecheck (rename-out [infer r:infer])
|
|
utils env rep types base-env static-contracts
|
|
logic
|
|
(all-defined-out))
|
|
|
|
|
|
;; checks for equality, modulo #f for prop or obj in
|
|
;; the expected (those are assumed to not matter if
|
|
;; #f, and so they are made equal to the given actual)
|
|
(define (tc-results-compat/test? actual expected)
|
|
(define (below? res1 res2)
|
|
(parameterize ([delay-errors? #f])
|
|
(with-handlers ([exn:fail? (λ (_) #f)])
|
|
(check-below res1 res2)
|
|
#t)))
|
|
|
|
(define expected*
|
|
(match* (actual expected)
|
|
[((tc-any-results: p1) (tc-any-results: p2))
|
|
(-tc-any-results (or p2 p1))]
|
|
[((tc-results: tcrs1 _) (tc-results: tcrs2 drst2))
|
|
(-tc-results (for/list ([tcr1 (in-list tcrs1)]
|
|
[tcr2 (in-list tcrs2)])
|
|
(match* (tcr1 tcr2)
|
|
[((tc-result: _ ps1 o1)
|
|
(tc-result: t2 ps2 o2))
|
|
(-tc-result t2 (or ps2 ps1) (or o2 o1))]))
|
|
drst2)]
|
|
[(_ _) expected]))
|
|
|
|
(and (below? actual expected*)
|
|
(below? expected* actual)))
|
|
|
|
(define-syntax (check-type-equal? stx)
|
|
(syntax-case stx ()
|
|
[(_ nm a b)
|
|
(syntax/loc stx (test-check nm type-equal? a b))]))
|
|
|
|
(define-syntax gen-test-main
|
|
(syntax-parser
|
|
[(stx:id)
|
|
#`(begin
|
|
(module* main #f
|
|
(require rackunit/text-ui)
|
|
(void (run-tests #,(datum->syntax #'stx 'tests))))
|
|
(module* test #f
|
|
(require (submod ".." main))))]))
|