diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/infer-unit.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/infer-unit.rkt index 0c2dc2b8..548325ad 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/infer-unit.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/infer-unit.rkt @@ -400,7 +400,19 @@ [(a b) #:when (type-equal? a b) empty] ;; CG-Top [(_ (Univ:)) empty] - [(_ (AnyValues:)) empty] + ;; AnyValues + [((AnyValues: s-f) (AnyValues: t-f)) + (cgen/filter V X Y s-f t-f)] + + [((or (Values: (list (Result: _ fs _) ...)) + (ValuesDots: (list (Result: _ fs _) ...) _ _)) + (AnyValues: t-f)) + (cset-join + (filter identity + (for/list ([f (in-list fs)]) + (match f + [(FilterSet: f+ f-) + (% cset-meet (cgen/filter V X Y f+ t-f) (cgen/filter V X Y f- t-f))]))))] ;; check all non Type/c first so that calling subtype is safe diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/promote-demote.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/promote-demote.rkt index 2f828b26..5b407603 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/promote-demote.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/infer/promote-demote.rkt @@ -19,7 +19,7 @@ ;; extract filters out of the range of a function type (define (get-filters rng) (match rng - [(AnyValues:) null] + [(AnyValues: f) (list (-FS f f))] [(Values: (list (Result: _ lf _) ...)) lf] [(ValuesDots: (list (Result: _ lf _) ...) _ _) lf])) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/rep/type-rep.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/rep/type-rep.rkt index bfae170d..70e9f182 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/rep/type-rep.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/rep/type-rep.rkt @@ -292,7 +292,7 @@ [#:fold-rhs (*Values (map type-rec-id rs))]) -(def-type AnyValues () +(def-type AnyValues ([f Filter/c]) [#:fold-rhs #:base]) (def-type ValuesDots ([rs (listof Result?)] [dty Type/c] [dbound (or/c symbol? natural-number/c)]) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt index 2d348db5..447eaca3 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt @@ -50,7 +50,8 @@ [ta (in-sequence-forever (in-list t-a) #f)]) (values oa ta))]) (match rng - [(AnyValues:) tc-any-results] + ;; TODO add filters to tc-any-results + [(AnyValues: f) tc-any-results] [(Values: results) (define-values (t-r f-r o-r) (for/lists (t-r f-r o-r) @@ -248,7 +249,7 @@ (map (compose make-Function list make-arr) doms (map (match-lambda ; strip filters - [(AnyValues:) ManyUniv] + [(AnyValues: f) (-AnyValues f)] [(Values: (list (Result: t _ _) ...)) (-values t)] [(ValuesDots: (list (Result: t _ _) ...) _ _) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-metafunctions.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-metafunctions.rkt index 8920f33e..f8e8a1c6 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-metafunctions.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-metafunctions.rkt @@ -73,7 +73,7 @@ (tc-results/c (listof identifier?) . -> . SomeValues/c) (define keys (for/list ([(nm k) (in-indexed arg-names)]) (list 0 k))) (match results - [(tc-any-results:) (make-AnyValues)] + [(tc-any-results:) ManyUniv] [(tc-results: ts fs os dty dbound) (make-ValuesDots (for/list ([t (in-list ts)] [f (in-list fs)] [o (in-list os)]) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-subst.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-subst.rkt index 79edd3f9..bf743184 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-subst.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/typecheck/tc-subst.rkt @@ -165,7 +165,8 @@ (define/cond-contract (values->tc-results tc formals) (SomeValues/c (or/c #f (listof identifier?)) . -> . tc-results/c) (match tc - [(AnyValues:) tc-any-results] + ;; TODO make tc-any-results have a filter + [(AnyValues: f) tc-any-results] [(ValuesDots: (list (and rs (Result: ts fs os)) ...) dty dbound) (if formals (let-values ([(ts fs os) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/base-abbrev.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/base-abbrev.rkt index 036c8b43..339ea368 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/base-abbrev.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/base-abbrev.rkt @@ -40,10 +40,6 @@ (define/decl -False (make-Value #f)) (define/decl -True (make-Value #t)) -;; A Type that corresponds to the any contract for the -;; return type of functions -(define/decl ManyUniv (make-AnyValues)) - (define -val make-Value) ;; Char type and List type (needed because of how sequences are checked in subtype) @@ -160,6 +156,11 @@ [(Path: p i) (-not-filter t i p)] [_ -top])) +;; A Type that corresponds to the any contract for the +;; return type of functions +(define (-AnyValues f) (make-AnyValues f)) +(define/decl ManyUniv (make-AnyValues -top)) + ;; Function types (define/cond-contract (make-arr* dom rng #:rest [rest #f] #:drest [drest #f] #:kws [kws null] diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/kw-types.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/kw-types.rkt index 3c03b316..a7b1bfd9 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/kw-types.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/kw-types.rkt @@ -76,7 +76,7 @@ ;; keyword conversion. (define (erase-filter/Values values) (match values - [(AnyValues:) values] + [(AnyValues: _) ManyUniv] [(Results: ts fs os) (-values ts)] [(Results: ts fs os dty dbound) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt index 8df5c43e..18228d0a 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/printer.rkt @@ -239,7 +239,8 @@ (cdr drest))) null) (match rng - [(AnyValues:) '(AnyValues)] + [(AnyValues: (Top:)) '(AnyValues)] + [(AnyValues: f) `(AnyValues : ,(type->sexp f))] [(Values: (list (Result: t (FilterSet: (Top:) (Top:)) (Empty:)))) (list (type->sexp t))] [(Values: (list (Result: t @@ -478,7 +479,8 @@ `(List ,(t->s dty) ,@dbound*)] [(F: nm) nm] ;; FIXME (Values are not types and shouldn't need to be considered here - [(AnyValues:) 'AnyValues] + [(AnyValues: (Top:)) 'AnyValues] + [(AnyValues: f) `(AnyValues : ,(filter->sexp f))] [(Values: (list v)) v] [(Values: (list v ...)) (cons 'values (map t->s v))] [(ValuesDots: v dty dbound) diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/structural.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/structural.rkt index 9c5550b7..0b51cd3f 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/structural.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/structural.rkt @@ -72,7 +72,7 @@ ;; Non Types [Result (#:co #:co #:co)] [Values ((#:listof #:co))] - [AnyValues ()])) + [AnyValues (#:co)])) (begin-for-syntax (define-syntax-class type-name diff --git a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt index d368a908..23b3ece1 100644 --- a/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt +++ b/pkgs/typed-racket-pkgs/typed-racket-lib/typed-racket/types/subtype.rkt @@ -256,7 +256,6 @@ ;; these cases are above as special cases ;; [((Union: (list)) _) A0] ;; this is extremely common, so it goes first ;; [(_ (Univ:)) A0] - [((or (ValuesDots: _ _ _) (Values: _) (AnyValues:)) (AnyValues:)) A0] ;; error is top and bot [(_ (Error:)) A0] [((Error:) _) A0] @@ -556,6 +555,15 @@ (subtype-seq A0 (subtypes* s-rs t-rs) (subtype* s-dty t-dty))] + [((AnyValues: s-f) (AnyValues: t-f)) + (filter-subtype* A0 s-f t-f)] + [((or (Values: (list (Result: _ fs _) ...)) + (ValuesDots: (list (Result: _ fs _) ...) _ _)) + (AnyValues: t-f)) + (for/or ([f (in-list fs)]) + (match f + [(FilterSet: f+ f-) + (and (filter-subtype* A0 f+ t-f) (filter-subtype* A0 f+ t-f) A0)]))] [((Result: t (FilterSet: ft ff) o) (Result: t* (FilterSet: ft* ff*) o)) (subtype-seq A0 (subtype* t t*)