diff --git a/collects/typed-scheme/typecheck/tc-metafunctions.rkt b/collects/typed-scheme/typecheck/tc-metafunctions.rkt index 88af47f4..a160f869 100644 --- a/collects/typed-scheme/typecheck/tc-metafunctions.rkt +++ b/collects/typed-scheme/typecheck/tc-metafunctions.rkt @@ -18,10 +18,10 @@ [((Bot:) _) (-FS -bot -top)] [(_ _) (-FS l1 l2)])) -(provide combine) +(provide combine abstract-results) -(d/c/p (abstract-results results arg-names) +(d/c (abstract-results results arg-names) (tc-results? (listof identifier?) . -> . (or/c Values? ValuesDots?)) (define keys (for/list ([(nm k) (in-indexed arg-names)]) k)) (match results diff --git a/collects/typed-scheme/typecheck/tc-subst.rkt b/collects/typed-scheme/typecheck/tc-subst.rkt index 22947883..1620eb9a 100644 --- a/collects/typed-scheme/typecheck/tc-subst.rkt +++ b/collects/typed-scheme/typecheck/tc-subst.rkt @@ -10,20 +10,20 @@ (for-syntax scheme/base) "tc-metafunctions.rkt") -;(provide (all-defined-out)) +(provide (all-defined-out)) -(d/c/p (open-Result r objs ts) - (-> Result? (listof Object?) (listof Type/c) (values Type/c FilterSet? Object?)) +(d/c (open-Result r objs [ts #f]) + (->* (Result? (listof Object?)) ((listof Type/c)) (values Type/c FilterSet? Object?)) (match r [(Result: t fs old-obj) (for/fold ([t t] [fs fs] [old-obj old-obj]) ([(o k) (in-indexed (in-list objs))] - [arg-ty (in-list ts)]) + [arg-ty (if ts (in-list ts) (in-cycle (in-value #f)))]) (values (subst-type t k o #t) (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 #f]) +(d/c (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 @@ -31,7 +31,7 @@ (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) +(d/c (subst-type t k o polarity) (-> Type/c name-ref/c Object? boolean? Type/c) (define (st t) (subst-type t k o polarity)) (d/c (sf fs) (FilterSet? . -> . FilterSet?) (subst-filter-set fs k o polarity)) @@ -51,7 +51,7 @@ (and drest (cons (st (car drest)) (cdr drest))) (map st kws)))])) -(d/c/p (subst-object t k o polarity) +(d/c (subst-object t k o polarity) (-> Object? name-ref/c Object? boolean? Object?) (match t [(NoObject:) t] @@ -66,7 +66,7 @@ t)])) ;; this is the substitution metafunction -(d/c/p (subst-filter f k o polarity) +(d/c (subst-filter f k o polarity) (-> Filter/c name-ref/c Object? boolean? Filter/c) (define (ap f) (subst-filter f k o polarity)) (define (tf-matcher t p i k o polarity maker) @@ -136,11 +136,13 @@ #f)) ;; (or/c Values? ValuesDots?) listof[identifier] -> tc-results? -(d/c/p (values->tc-results tc formals) +(d/c (values->tc-results tc formals) ((or/c Values? ValuesDots?) (listof identifier?) . -> . tc-results?) (match tc [(ValuesDots: (list rs ...) dty dbound) - (let-values ([(ts fs os) (for/lists (ts fs os) ([r (in-list rs)]) (open-Result r (map (lambda (i) (make-Path null i)) formals)))]) + (let-values ([(ts fs os) + (for/lists (ts fs os) ([r (in-list rs)]) + (open-Result r (map (lambda (i) (make-Path null i)) formals)))]) (ret ts fs os (for/fold ([dty dty]) ([(o k) (in-indexed (in-list formals))]) (subst-type dty k (make-Path null o) #t)) diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt index 7797a0fc..1330aa7f 100644 --- a/collects/typed-scheme/types/abbrev.rkt +++ b/collects/typed-scheme/types/abbrev.rkt @@ -14,7 +14,7 @@ (for-syntax scheme/base syntax/parse) (for-template scheme/base scheme/contract scheme/promise scheme/tcp scheme/flonum)) -(provide (except-out (all-defined-out) -FS) +(provide (all-defined-out) (rename-out [make-Listof -lst])) ;; convenient constructors @@ -120,9 +120,9 @@ (define -no-obj (make-Empty)) -(d/c/p (-FS + -) - (c:-> Filter/c Filter/c FilterSet?) - (match* (+ -) +(d/c (-FS + -) + (c:-> Filter/c Filter/c FilterSet?) + (match* (+ -) [((Bot:) _) (make-FilterSet -bot -top)] [(_ (Bot:)) (make-FilterSet -top -bot)] [(+ -) (make-FilterSet + -)]))