move d/c/p
fix tc-e/t
This commit is contained in:
parent
27b0c01cdd
commit
b5acbe3168
|
@ -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
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)
|
||||
|
|
|
@ -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)]
|
||||
|
|
|
@ -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
|
||||
|
|
Loading…
Reference in New Issue
Block a user