move d/c/p

fix tc-e/t
This commit is contained in:
Sam Tobin-Hochstadt 2010-04-27 19:29:10 -04:00
parent 27b0c01cdd
commit b5acbe3168
5 changed files with 13 additions and 18 deletions

View File

@ -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

View File

@ -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)

View File

@ -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)

View File

@ -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)]

View File

@ -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