diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss b/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss index 6eb25d5992..e4491bbc95 100644 --- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss +++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.ss @@ -91,7 +91,7 @@ (define-syntax (tc-e/t stx) (syntax-parse stx - [(_ e t) (syntax/loc stx (tc-e e #:ret (ret t (-FS (list) (list (make-Bot))))))])) + [(_ e t) (syntax/loc stx (tc-e e #:ret (ret t (-FS -top -bot))))])) ;; duplication of the mzscheme toplevel expander, necessary for expanding the rhs of defines ;; note that this ability is never used diff --git a/collects/typed-scheme/typecheck/tc-metafunctions.ss b/collects/typed-scheme/typecheck/tc-metafunctions.ss index 9be99d9b2e..5eef569111 100644 --- a/collects/typed-scheme/typecheck/tc-metafunctions.ss +++ b/collects/typed-scheme/typecheck/tc-metafunctions.ss @@ -10,12 +10,6 @@ unstable/debug (for-syntax scheme/base)) -;(provide (all-defined-out)) - -(define-syntax-rule (d/c/p (name . args) c . body) - (begin (d/c (name . args) c . body) - (p/c [name c]))) - ;; this implements the sequence invariant described on the first page relating to Bot (define (combine l1 l2) diff --git a/collects/typed-scheme/typecheck/tc-subst.ss b/collects/typed-scheme/typecheck/tc-subst.ss index a1ddb45b26..0613dda229 100644 --- a/collects/typed-scheme/typecheck/tc-subst.ss +++ b/collects/typed-scheme/typecheck/tc-subst.ss @@ -12,10 +12,6 @@ ;(provide (all-defined-out)) -(define-syntax-rule (d/c/p (name . args) c . body) - (begin (d/c (name . args) c . body) - (p/c [name c]))) - (d/c/p (open-Result r objs ts) (-> Result? (listof Object?) (listof Type/c) (values Type/c FilterSet? Object?)) (match r @@ -27,12 +23,13 @@ (subst-filter-set fs k o #t arg-ty) (subst-object old-obj k o #t)))])) -(d/c/p (subst-filter-set fs k o polarity t) - (-> FilterSet? name-ref/c Object? boolean? Type/c FilterSet?) +(d/c/p (subst-filter-set fs k o polarity [t #f]) + (->* (FilterSet? name-ref/c Object? boolean?) ((or/c #f Type/c)) FilterSet?) + (define extra-filter (if t (make-TypeFilter t null k) -top)) (match fs [(FilterSet: f+ f-) - (combine (subst-filter (-and (make-TypeFilter t null k) f+) k o polarity) - (subst-filter (-and (make-TypeFilter t null k) f-) k o polarity))])) + (combine (subst-filter (-and extra-filter f+) k o polarity) + (subst-filter (-and extra-filter f-) k o polarity))])) (d/c/p (subst-type t k o polarity) (-> Type/c name-ref/c Object? boolean? Type/c) diff --git a/collects/typed-scheme/types/abbrev.ss b/collects/typed-scheme/types/abbrev.ss index 10d77c7f52..06de85c364 100644 --- a/collects/typed-scheme/types/abbrev.ss +++ b/collects/typed-scheme/types/abbrev.ss @@ -14,7 +14,7 @@ (for-syntax scheme/base syntax/parse) (for-template scheme/base scheme/contract scheme/promise scheme/tcp scheme/flonum)) -(provide (all-defined-out) +(provide (except-out (all-defined-out) -FS) (rename-out [make-Listof -lst])) ;; convenient constructors @@ -120,7 +120,7 @@ (define -no-obj (make-Empty)) -(d/c (-FS + -) +(d/c/p (-FS + -) (c:-> Filter/c Filter/c FilterSet?) (match* (+ -) [((Bot:) _) (make-FilterSet -bot -top)] diff --git a/collects/typed-scheme/utils/utils.ss b/collects/typed-scheme/utils/utils.ss index 4b52d5ab52..376bc95498 100644 --- a/collects/typed-scheme/utils/utils.ss +++ b/collects/typed-scheme/utils/utils.ss @@ -162,7 +162,11 @@ at least theoretically. ;; turn contracts on and off - off by default for performance. (define-for-syntax enable-contracts? #t) -(provide (for-syntax enable-contracts?) p/c w/c cnt d-s/c d/c) +(provide (for-syntax enable-contracts?) p/c w/c cnt d-s/c d/c d/c/p) + +(define-syntax-rule (d/c/p (name . args) c . body) + (begin (d/c (name . args) c . body) + (p/c [name c]))) ;; these are versions of the contract forms conditionalized by `enable-contracts?' (define-syntax p/c