Add types for combinations, in-combinations

The redirection for contracted identifiers used to do a
require lift on each use. Instead, only do the lift once
and reuse the identifier.

.travis.yml

@@ -20,12 +20,12 @@ install:
 - raco setup typed typed-racket typed-racket-test typed-scheme
 
 script:
-- racket -l typed-racket-test/run -- --unit
-- racket -l typed-racket-test/run -- --int
-- racket -l typed-racket-test/run -- --opt
-- racket -l typed-racket-test/run -- --missed-opt
+- racket -l typed-racket-test -- --unit
+- racket -l typed-racket-test -- --int
+- racket -l typed-racket-test -- --opt
+- racket -l typed-racket-test -- --missed-opt
 - raco setup -j 1 math
-- racket -l typed-racket-test/run -- --math
+- racket -l typed-racket-test -- --math
 - racket -l typed-racket-test/test-docs-complete
 - echo "done"
 

issue_template.md

@@ -0,0 +1,7 @@
+### What version of Racket are you using?
+
+### What program did you run?
+
+### What should have happened?
+
+### If you got an error message, please include it here.

typed-racket-compatibility/info.rkt

@@ -11,4 +11,4 @@
 
 (define pkg-authors '(samth stamourv))
 
-(define version "1.3")
+(define version "1.5")

typed-racket-compatibility/typed-scheme/lang/reader.rkt

@@ -6,14 +6,11 @@ typed-scheme
 #:read-syntax r:read-syntax
 #:info make-info
 
-(require (prefix-in r: typed-racket/typed-reader))
+(require (prefix-in r: typed-racket/typed-reader)
+         typed-racket/private/oc-button)
 
 (define (make-info key default use-default)
   (case key
     [(drscheme:toolbar-buttons)
-     ;; If Optimization Coach is installed, load it.
-     (with-handlers ([exn:fail:filesystem? (lambda _ '())]) ; not found
-       (collection-path "optimization-coach")
-       (list (dynamic-require 'optimization-coach/tool
-                              'optimization-coach-drracket-button)))]
+     (maybe-show-OC)]
     [else (use-default key default)]))

typed-racket-compatibility/typed/scheme/base/lang/reader.rkt

@@ -7,14 +7,12 @@ typed/scheme/base
 #:info make-info
 #:language-info make-language-info
 
+(require typed-racket/private/oc-button)
+
 (define (make-info key default use-default)
   (case key
     [(drscheme:toolbar-buttons)
-     ;; If Optimization Coach is installed, load it.
-     (with-handlers ([exn:fail:filesystem? (lambda _ '())]) ; not found
-       (collection-path "optimization-coach")
-       (list (dynamic-require 'optimization-coach/tool
-                              'optimization-coach-drracket-button)))]
+     (maybe-show-OC)]
     [else (use-default key default)]))
 
 (define make-language-info

typed-racket-compatibility/typed/scheme/lang/reader.rkt

@@ -7,14 +7,12 @@ typed/scheme
 #:info make-info
 #:language-info make-language-info
 
+(require typed-racket/private/oc-button)
+
 (define (make-info key default use-default)
   (case key
     [(drscheme:toolbar-buttons)
-     ;; If Optimization Coach is installed, load it.
-     (with-handlers ([exn:fail:filesystem? (lambda _ '())]) ; not found
-       (collection-path "optimization-coach")
-       (list (dynamic-require 'optimization-coach/tool
-                              'optimization-coach-drracket-button)))]
+     (maybe-show-OC)]
     [else (use-default key default)]))
 
 (define make-language-info

typed-racket-doc/info.rkt

@@ -10,9 +10,9 @@
                      "r6rs-lib"
                      "sandbox-lib"
                      "at-exp-lib"
-                     "scribble-lib"
+                     ("scribble-lib" #:version "1.16")
                      "pict-lib"
-                     ("typed-racket-lib" #:version "1.3")
+                     ("typed-racket-lib" #:version "1.5")
                      "typed-racket-compatibility"
                      "typed-racket-more"
                      "racket-doc"
@@ -24,4 +24,4 @@
 
 (define pkg-authors '(samth stamourv))
 
-(define version "1.3")
+(define version "1.5")

typed-racket-doc/typed-racket/scribblings/guide/begin.scrbl

@@ -1,6 +1,7 @@
 #lang scribble/manual
 
-@begin[(require (for-label (only-meta-in 0 typed/racket)) scribble/eval
+@begin[(require (for-label (only-meta-in 0 typed/racket))
+                scribble/example
                 "../utils.rkt" (only-in "quick.scrbl" typed-mod))]
 
 @(define the-eval (make-base-eval))
@@ -23,7 +24,7 @@ are provided as well; for example, the
 @racketmodname[typed/racket/base] language corresponds to
 @racketmodname[racket/base].
 
-@racketblock+eval[#:eval the-eval (struct pt ([x : Real] [y : Real]))]
+@examples[#:no-result #:eval the-eval (struct pt ([x : Real] [y : Real]))]
 
 @margin-note{Typed Racket provides modified versions of core Racket forms,
 which permit type annotations. Previous versions of Typed Racket provided
@@ -38,7 +39,7 @@ This defines a new structure, named @racket[pt], with two fields,
 @racketmodname[racket] to @racketmodname[typed/racket], simply add
 type annotations to existing field declarations.
 
-@racketblock+eval[#:eval the-eval (: distance (-> pt pt Real))]
+@examples[#:no-result #:eval the-eval (: distance (-> pt pt Real))]
 
 This declares that @racket[distance] has the type @racket[(-> pt pt Real)].
 @;{@racket[distance] must be defined at the top-level of the module containing
@@ -54,7 +55,7 @@ function type, in this case @racket[Real].
 If you are familiar with @rtech{contracts}, the notation for function
 types is similar to function contract combinators.
 
-@racketblock+eval[#:eval the-eval
+@examples[#:no-result #:eval the-eval
 (define (distance p1 p2)
   (sqrt (+ (sqr (- (pt-x p2) (pt-x p1)))
            (sqr (- (pt-y p2) (pt-y p1))))))
@@ -71,14 +72,14 @@ the program is accepted.
 In the Typed Racket @gtech{REPL}, calling @racket[distance] will
 show the result as usual and will also print the result's type:
 
-@interaction[#:eval the-eval (distance (pt 0 0) (pt 3.1415 2.7172))]
+@examples[#:label #f #:eval the-eval (distance (pt 0 0) (pt 3.1415 2.7172))]
 
 Just evaluating the function name will print the function value and its type,
 which can be useful for discovering the types that Typed Racket ascribes to
 Racket functions. Alternatively, the @racket[:print-type] command will just
 print the type:
 
-@interaction[#:eval the-eval distance string-length (:print-type string-ref)]
+@examples[#:label #f #:eval the-eval distance string-length (:print-type string-ref)]
 
 @section{Datatypes and Unions}
 
@@ -141,14 +142,14 @@ When Typed Racket detects a type error in the module, it raises an
 error before running the program.
 
 @examples[#:eval the-eval
-(add1 "not a number")
+(eval:error (add1 "not a number"))
 ]
 
 @;{
 Typed Racket also attempts to detect more than one error in the module.
 
 @examples[#:eval the-eval
-(string-append "a string" (add1 "not a number"))
+(eval:error (string-append "a string" (add1 "not a number")))
 ]
 }
 

typed-racket-doc/typed-racket/scribblings/guide/caveats.scrbl

@@ -1,7 +1,7 @@
 #lang scribble/manual
 
 @(require "../utils.rkt"
-          scribble/eval
+          scribble/example
           (for-label (only-meta-in 0 typed/racket)))
 
 @(define the-eval (make-base-eval))
@@ -38,19 +38,19 @@ on higher-order arguments that are themselves polymorphic.
 For example, the following program results in a type error
 that demonstrates this limitation:
 
-@interaction[#:eval the-eval
-  (map cons '(a b c d) '(1 2 3 4))
+@examples[#:label #f #:eval the-eval
+  (eval:error (map cons '(a b c d) '(1 2 3 4)))
 ]
 
 The issue is that the type of @racket[cons] is also polymorphic:
 
-@interaction[#:eval the-eval cons]
+@examples[#:label #f #:eval the-eval cons]
 
 To make this expression type-check, the @racket[inst] form can
 be used to instantiate the polymorphic argument (e.g., @racket[cons])
 at a specific type:
 
-@interaction[#:eval the-eval
+@examples[#:label #f #:eval the-eval
   (map (inst cons Symbol Integer) '(a b c d) '(1 2 3 4))
 ]
 
@@ -69,10 +69,11 @@ fixed in a future release.
 The following illustrates an example type that cannot be
 converted to a contract:
 
-@interaction[#:eval the-eval
-  (require/typed racket/base
-    [object-name (case-> (-> Struct-Type-Property Symbol)
-                         (-> Regexp (U String Bytes)))])
+@examples[#:label #f #:eval the-eval
+  (eval:error
+   (require/typed racket/base
+     [object-name (case-> (-> Struct-Type-Property Symbol)
+                          (-> Regexp (U String Bytes)))]))
 ]
 
 This function type by cases is a valid type, but a corresponding
@@ -83,7 +84,7 @@ supported with dependent contracts.
 A more approximate type will work for this case, but with a loss
 of type precision at use sites:
 
-@interaction[#:eval the-eval
+@examples[#:label #f #:eval the-eval
   (require/typed racket/base
     [object-name (-> (U Struct-Type-Property Regexp)
                      (U String Bytes Symbol))])
@@ -94,8 +95,8 @@ Use of @racket[define-predicate] also involves contract generation, and
 so some types cannot have predicates generated for them. The following
 illustrates a type for which a predicate can't be generated:
 
-@interaction[#:eval the-eval
-  (define-predicate p? (All (A) (Listof A)))]
+@examples[#:label #f #:eval the-eval
+  (eval:error (define-predicate p? (All (A) (Listof A))))]
 
 @section{Unsupported features}
 
@@ -109,7 +110,7 @@ To make programming with invariant type constructors (such as @racket[Boxof])
 easier, Typed Racket generalizes types that are used as arguments to invariant
 type constructors. For example:
 
-@interaction[#:eval the-eval
+@examples[#:label #f #:eval the-eval
   0
   (define b (box 0))
   b
@@ -123,7 +124,7 @@ initialize it with @racket[0]. Type generalization does exactly that.
 
 In some cases, however, type generalization can lead to unexpected results:
 
-@interaction[#:eval the-eval
+@examples[#:label #f #:eval the-eval
   (box (ann 1 Fixnum))
 ]
 
@@ -131,7 +132,7 @@ The intent of this code may be to create of box of @racket[Fixnum], but Typed
 Racket will generalize it anyway. To create a box of @racket[Fixnum], the box
 itself should have a type annotation:
 
-@interaction[#:eval the-eval
+@examples[#:label #f #:eval the-eval
   (ann (box 1) (Boxof Fixnum))
   ((inst box Fixnum) 1)
 ]
@@ -146,22 +147,24 @@ occur inside macros---are not checked.
 Concretely, this means that expressions inside, for example, a
 @racket[begin-for-syntax] block are not checked:
 
-@interaction[#:eval the-eval
-  (begin-for-syntax (+ 1 "foo"))
+@examples[#:label #f #:eval the-eval
+  (eval:error (begin-for-syntax (+ 1 "foo")))
 ]
 
 Similarly, expressions inside of macros defined in Typed Racket are
 not type-checked. On the other hand, the macro's expansion is always
 type-checked:
 
-@defs+int[#:eval the-eval
-  ((define-syntax (example-1 stx)
+@examples[#:label #f #:eval the-eval
+  (eval:no-prompt
+   (define-syntax (example-1 stx)
      (+ 1 "foo")
-     #'1)
+     #'1))
+  (eval:no-prompt
    (define-syntax (example-2 stx)
      #'(+ 1 "foo")))
-  (example-1)
-  (example-2)
+  (eval:error (example-1))
+  (eval:error (example-2))
 ]
 
 Note that functions defined in Typed Racket that are used at

typed-racket-doc/typed-racket/scribblings/guide/more.scrbl

@@ -1,7 +1,7 @@
 #lang scribble/manual
 
 @begin[(require "../utils.rkt"
-                scribble/core scribble/eval
+                scribble/core scribble/example
                 (for-label (only-meta-in 0 typed/racket)
                            (prefix-in base: racket)))]
 
@@ -127,8 +127,8 @@ This ensures that the expression, here @racket[(+ 7 1)], has the
 desired type, here @racket[Number].  Otherwise, the type checker
 signals an error.  For example:
 
-@interaction[#:eval the-eval
-(ann "not a number" Number)]
+@examples[#:label #f #:eval the-eval
+(eval:error (ann "not a number" Number))]
 
 @section{Type Inference}
 

typed-racket-doc/typed-racket/scribblings/guide/occurrence.scrbl

@@ -1,7 +1,7 @@
 #lang scribble/manual
 
 @begin[(require "../utils.rkt"
-		scribble/core scribble/eval
+		scribble/core scribble/example
 		(for-label (only-meta-in 0 typed/racket)))]
 
 @(define the-eval (make-base-eval))
@@ -18,7 +18,7 @@ fails.
 
 To illustrate, consider the following code:
 
-@racketblock+eval[#:eval the-eval
+@examples[#:no-result #:eval the-eval
   (: flexible-length (-> (U String (Listof Any)) Integer))
   (define (flexible-length str-or-lst)
     (if (string? str-or-lst)
@@ -51,7 +51,7 @@ have based on a predicate check in a conditional expression, it can
 narrow the type of the variable within the appropriate branch of the
 conditional.
 
-@section[#:tag "filters-and-predicates"]{Filters and Predicates}
+@section[#:tag "propositions-and-predicates"]{Propositions and Predicates}
 
 In the previous section, we demonstrated that a Typed Racket programmer
 can take advantage of occurrence typing to type-check functions
@@ -59,26 +59,30 @@ with union types and conditionals. This may raise the question: how
 does Typed Racket know how to narrow the type based on the predicate?
 
 The answer is that predicate types in Typed Racket are annotated
-with @deftech{filters} that tell the typechecker what additional
+with logical @deftech{propositions} that tell the typechecker what additional
 information is gained when a predicate check succeeds or fails.
 
 For example, consider the REPL's type printout for @racket[string?]:
 
-@interaction[#:eval the-eval string?]
+@examples[#:label #f #:eval the-eval string?]
 
 The type @racket[(-> Any Boolean : String)] has three parts. The first
 two are the same as any other function type and indicate that the
 predicate takes any value and returns a boolean. The third part, after
-the @racket[_:], is a @tech{filter} that tells the typechecker two
-things:
+the @racket[_:], represents the logical @tech{propositions}
+the typechecker learns from the result of applying the function:
 
 @itemlist[#:style 'ordered
-  @item{If the predicate check succeeds, the argument variable has type @racket[String]}
-  @item{If the predicate check fails, the argument variable @emph{does not} have type @racket[String]}
-]
 
-Predicates for all built-in types are annotated with similar filters
-that allow the type system to reason about predicate checks.
+  @item{If the predicate check succeeds (i.e. produces a
+  non-@racket[#f] value), the argument variable has type
+  @racket[String]}
+
+@item{If the predicate check fails (i.e. produces @racket[#f]), the
+  argument variable @emph{does not} have type @racket[String]} ]
+
+Predicates for all built-in types are annotated with similar propositions
+that allow the type system to reason logically about predicate checks.
 
 @section{Other conditionals and assertions}
 
@@ -93,7 +97,7 @@ control flow constructs that are present in Racket such as
 For example, the @racket[_flexible-length] function from earlier can
 be re-written to use @racket[cond] with no additional effort:
 
-@racketblock+eval[#:eval the-eval
+@examples[#:no-result #:eval the-eval
   (: flexible-length/cond (-> (U String (Listof Any)) Integer))
   (define (flexible-length/cond str-or-lst)
     (cond [(string? str-or-lst) (string-length str-or-lst)]
@@ -104,13 +108,13 @@ In some cases, the type system does not have enough information or is
 too conservative to typecheck an expression. For example, consider
 the following interaction:
 
-@interaction[#:eval the-eval
+@examples[#:label #f #:eval the-eval
 (: a Positive-Integer)
 (define a 15)
 (: b Positive-Integer)
 (define b 20)
 (: c Positive-Integer)
-(define c (- b a))
+(eval:error (define c (- b a)))
 ]
 
 In this case, the type system only knows that @racket[_a] and
@@ -119,13 +123,13 @@ difference will always be positive in defining @racket[_c].  In cases
 like this, occurrence typing can be used to make the code type-check
 using an @emph{assertion}. For example,
 
-@racketblock+eval[#:eval the-eval
+@examples[#:no-result #:eval the-eval
 (: d Positive-Integer)
 (define d (assert (- b a) positive?))
 ]
 
-Using the filter on @racket[positive?], Typed Racket can assign the
-type @racket[Positive-Integer] to the whole @racket[assert]
+Using the logical propositions on @racket[positive?], Typed Racket can
+assign the type @racket[Positive-Integer] to the whole @racket[assert]
 expression.  This type-checks, but note that the assertion may raise
 an exception at run-time if the predicate returns @racket[#f].
 
@@ -133,7 +137,7 @@ Note that @racket[assert] is a derived concept in Typed Racket and is
 a natural consequence of occurrence typing. The assertion above is
 essentially equivalent to the following:
 
-@racketblock+eval[#:eval the-eval
+@examples[#:no-result #:eval the-eval
 (: e Positive-Integer)
 (define e (let ([diff (- b a)])
             (if (positive? diff)
@@ -165,7 +169,7 @@ by let-expressions alias other values (e.g. when they alias non-mutated identifi
 This allows programs which explicitly rely on occurrence typing and aliasing to 
 typecheck:
 
-@racketblock+eval[#:eval the-eval
+@examples[#:no-result #:eval the-eval
 (: f (Any -> Number))
 (define (f x) 
   (let ([y x])
@@ -180,7 +184,7 @@ typecheck:
 It also allows the typechecker to check programs which use macros 
 that heavily rely on let-bindings internally (such as @racket[match]):
 
-@racketblock+eval[#:eval the-eval
+@examples[#:no-result #:eval the-eval
 (: g (Any -> Number))
 (define (g x) 
   (match x

typed-racket-doc/typed-racket/scribblings/guide/optimization.scrbl

@@ -1,7 +1,6 @@
 #lang scribble/manual
 
 @begin[(require (for-label (only-meta-in 0 typed/racket))
-                scribble/eval racket/sandbox
 		"../utils.rkt" (only-in "quick.scrbl" typed-mod))]
 
 @title[#:tag "optimization"]{Optimization in Typed Racket}
@@ -30,9 +29,9 @@ Racket idioms. However, it does a better job on some idioms than on
 others. By writing your programs using the right idioms, you can help
 the optimizer help you.
 
-To best take advantage of the Typed Racket optimizer, keep the following in
-mind. The @emph{Optimization Coach} package provides optimization coaching
-support to help you in this task.
+To best take advantage of the Typed Racket optimizer, consult
+@other-doc['(lib "optimization-coach/scribblings/optimization-coach.scrbl")
+#:indirect "Optimization Coach"]{}.
 
 
 @subsection{Numeric types}

typed-racket-doc/typed-racket/scribblings/guide/typed-untyped-interaction.scrbl

@@ -1,7 +1,7 @@
 #lang scribble/manual
 
 @(require "../utils.rkt"
-          scribble/eval
+          scribble/example
           (for-label (only-meta-in 0 typed/racket)))
 
 @(define the-eval (make-base-eval))
@@ -100,7 +100,7 @@ function:
 @margin-note{For general information on Racket's contract system
 , see @secref[#:doc '(lib "scribblings/guide/guide.scrbl")]{contracts}.}
 
-@interaction[#:eval the-eval
+@examples[#:label #f #:eval the-eval
 (module increment racket
   (provide increment)
 
@@ -110,7 +110,7 @@ function:
 
 and a typed module that uses it:
 
-@interaction[#:eval the-eval
+@examples[#:label #f #:eval the-eval
 (module client typed/racket
 
   (require/typed 'increment [increment (-> Integer Integer)])
@@ -127,7 +127,7 @@ strings.
 
 On the other hand, when the program is run:
 
-@interaction[#:eval the-eval (require 'client)]
+@examples[#:label #f #:eval the-eval (eval:error (require 'client))]
 
 we find that the contract system checks the assumption made by the typed
 module and correctly finds that the assumption failed because of the

typed-racket-doc/typed-racket/scribblings/guide/types.scrbl

@@ -1,7 +1,7 @@
 #lang scribble/manual
 
 @begin[(require "../utils.rkt"
-		scribble/core scribble/eval
+		scribble/core scribble/example
 		(for-label (only-meta-in 0 typed/racket)))]
 
 @(define the-eval (make-base-eval))
@@ -18,7 +18,7 @@ The most basic types in Typed Racket are those for primitive data,
 such as @racket[True] and @racket[False] for booleans, @racket[String]
 for strings, and @racket[Char] for characters.
 
-@interaction[#:eval the-eval
+@examples[#:label #f #:eval the-eval
 '"hello, world"
 #\f
 #t
@@ -27,14 +27,14 @@ for strings, and @racket[Char] for characters.
 Each symbol is given a unique type containing only that symbol.  The
 @racket[Symbol] type includes all symbols.
 
-@interaction[#:eval the-eval
+@examples[#:label #f #:eval the-eval
 'foo
 'bar]
 
 Typed Racket also provides a rich hierarchy for describing particular
 kinds of numbers.
 
-@interaction[#:eval the-eval
+@examples[#:label #f #:eval the-eval
 0
 -7
 14
@@ -43,7 +43,7 @@ kinds of numbers.
 
 Finally, any value is itself a type:
 
-@interaction[#:eval the-eval
+@examples[#:label #f #:eval the-eval
 (ann 23 23)]
 
 @section{Function Types}
@@ -65,7 +65,7 @@ one argument, and produces  @rtech{multiple values}, of types
 @racket[String] and @racket[Natural].  Here are example functions for
 each of these types.
 
-@interaction[#:eval the-eval
+@examples[#:label #f #:eval the-eval
 (lambda ([x : Number]) x)
 (lambda ([a : String] [b : String]) (equal? a b))
 (lambda ([c : Char]) (values (string c) (char->integer c)))]
@@ -106,7 +106,7 @@ The result is two values of type @racket[Number].
 Sometimes a value can be one of several types.  To specify this, we
 can use a union type, written with the type constructor @racket[U].
 
-@interaction[#:eval the-eval
+@examples[#:label #f #:eval the-eval
 (let ([a-number 37])
   (if (even? a-number)
       'yes
@@ -141,9 +141,9 @@ type defintion could also be written like this.
 Of course, types which directly refer to themselves are not
 permitted. For example, both of these definitions are illegal.
 
-@interaction[#:eval the-eval
-(define-type BinaryTree BinaryTree)
-(define-type BinaryTree (U Number BinaryTree))]
+@examples[#:label #f #:eval the-eval
+(eval:error (define-type BinaryTree BinaryTree))
+(eval:error (define-type BinaryTree (U Number BinaryTree)))]
 
 @section{Structure Types}
 

typed-racket-doc/typed-racket/scribblings/internals.txt

@@ -1,17 +1,17 @@
 Data Structures used in Typechecking.
 The main data structure used in typechecking is a tc-results/c.
 This currently has two variants
-(struct/c tc-results ((listof (struct/c tc-result (Type/c FilterSet? Object?)))
+(struct/c tc-results ((listof (struct/c tc-result (Type/c PropSet? Object?)))
                       (or/c #f (cons/c Type/c symbol?))))
-(struct/c tc-any-results (or/c Filter/c NoFilter?))
+(struct/c tc-any-results (or/c Prop? #f))
 
 The first represents a fixed number of values with optional dotted return values.
 The second represents an unknown number of values.
 
-A value has three main parts: a Type, a FilterSet, and an Object. For dotted values we do no store a 
-FilterSet or an Object because they would almost never be useful. They are thus implicitly -top-filter
+A value has three main parts: a Type, a PropSet, and an Object. For dotted values we do no store a 
+PropSet or an Object because they would almost never be useful. They are thus implicitly -tt-propset
 and -empty-obj. In the tc-any-results case since we don't know the number of values, we do not store
-the Type or the Object, but we do store a filter. This is useful in cases like
+the Type or the Object, but we do store a proposition. This is useful in cases like
 (let ((x (read)))
   (unless (number? x) (error 'bad-input))
   (do-stuff x))

typed-racket-doc/typed-racket/scribblings/reference/experimental.scrbl

@@ -1,6 +1,6 @@
 #lang scribble/manual
 
-@begin[(require "../utils.rkt" scribble/eval)
+@begin[(require "../utils.rkt" scribble/example)
        (require (for-label (only-meta-in 0 [except-in typed/racket for])))]
 
 @(define the-top-eval (make-base-eval #:lang 'typed/racket))

typed-racket-doc/typed-racket/scribblings/reference/exploring-types.scrbl

@@ -1,7 +1,7 @@
 #lang scribble/manual
 
 @begin[(require "../utils.rkt")
-       (require scribble/eval)
+       (require scribble/example)
        (require (for-label (only-meta-in 0 [except-in typed/racket for])))]
 
 @(define the-top-eval (make-base-eval))

typed-racket-doc/typed-racket/scribblings/reference/legacy.scrbl

@@ -1,7 +1,7 @@
 #lang scribble/manual
 
 @begin[(require "../utils.rkt")
-       (require scribble/eval
+       (require scribble/example
                 (for-label (only-meta-in 0 [except-in typed/racket for])))]
 
 @(define the-eval (make-base-eval))

typed-racket-doc/typed-racket/scribblings/reference/libraries.scrbl

@@ -51,8 +51,11 @@ Other libraries can be used with Typed Racket via
 The following libraries are included with Typed Racket in the
 @racketfont{typed} collection:
 
-@(define-syntax-rule @defmodule/incl[name]
-   @defmodule[name #:no-declare])
+@(define-syntax-rule @defmodule/incl[name rest ...]
+   (list
+      (section #:style '(hidden toc-hidden unnumbered)
+               (string-append "Typed for " (symbol->string 'name)))
+      @defmodule[name rest ...]))
 
 @(define-syntax-rule (deftype name . parts)
    (defidform #:kind "type" name . parts))
@@ -168,11 +171,11 @@ and the @racket[URL] and @racket[Path/Param] types from
 
 @defmodule/incl[typed/openssl/md5]
 @defmodule/incl[typed/openssl/sha1]
-@defmodule/incl[typed/pict]
-@defmodule[typed/racket/async-channel #:no-declare @history[#:added "1.1"]]
+@defmodule/incl[typed/racket/async-channel @history[#:added "1.1"]]
 @defmodule/incl[typed/racket/date]
 @defmodule/incl[typed/racket/draw]
 @defmodule/incl[typed/racket/gui]
+@defmodule/incl[typed/racket/random @history[#:added "1.5"]]
 @defmodule/incl[typed/racket/sandbox]
 @defmodule/incl[typed/racket/snip]
 @defmodule/incl[typed/racket/system]
@@ -210,7 +213,11 @@ written in Typed Racket or have adapter modules that are typed:
    @defmodule[name #:no-declare #:link-target? #f #:indirect])
 
 @defmodule/also[math]
-@defmodule/also[plot/typed]
+@defmodule/also[plot]
+@defmodule/incl[typed/pict]
+@defmodule/also[images/flomap]
+@defmodule/incl[typed/images/logos]
+@defmodule/incl[typed/images/icons]
 
 @section{Porting Untyped Modules to Typed Racket}
 

typed-racket-doc/typed-racket/scribblings/reference/special-forms.scrbl

@@ -1,6 +1,6 @@
 #lang scribble/manual
 
-@begin[(require "../utils.rkt" scribble/eval racket/sandbox)
+@begin[(require "../utils.rkt" scribble/example racket/sandbox)
        (require (for-label (only-meta-in 0 [except-in typed/racket])
                            (only-in racket/base)))]
 
@@ -378,16 +378,19 @@ those functions.
 
 
 @section{Structure Definitions}
-@defform/subs[
+@defform/subs[#:literals (:)
 (struct maybe-type-vars name-spec ([f : t] ...) options ...)
 ([maybe-type-vars code:blank (v ...)]
- [name-spec name (code:line name parent)]
+ [name-spec name-id (code:line name-id parent)]
  [options #:transparent #:mutable #:prefab
           (code:line #:constructor-name constructor-id)
-          (code:line #:extra-constructor-name constructor-id)])]{
- Defines a @rtech{structure} with the name @racket[name], where the
+          (code:line #:extra-constructor-name constructor-id)
+          (code:line #:type-name type-id)])]{
+ Defines a @rtech{structure} with the name @racket[name-id], where the
  fields @racket[f] have types @racket[t], similar to the behavior of @|struct-id|
- from @racketmodname[racket/base].
+ from @racketmodname[racket/base]. If @racket[type-id] is specified, then it will
+ be used for the name of the type associated with instances of the declared
+ structure, otherwise @racket[name-id] will be used for both.
   When @racket[parent] is present, the
 structure is a substructure of @racket[parent].
 
@@ -404,36 +407,47 @@ amount it needs.
 
 @ex[
   (struct (X Y) 2-tuple ([first : X] [second : Y]))
-  (struct (X Y Z) 3-tuple 2-tuple ([first : X] [second : Y] [third :  Z]))
+  (struct (X Y Z) 3-tuple 2-tuple ([third :  Z]))
 ]
 
 Options provided have the same meaning as for the @|struct-id| form
-from @racketmodname[racket/base].
+from @racketmodname[racket/base] (with the exception of @racket[#:type-name], as
+described above).
 
-A prefab structure type declaration will bind the given @racket[name] to a
-@racket[Prefab] type. Unlike in @racketmodname[racket/base], a non-prefab
-structure type cannot extend a prefab structure type.
+A prefab structure type declaration will bind the given @racket[name-id]
+or @racket[type-id] to a @racket[Prefab] type. Unlike the @|struct-id| form from
+@racketmodname[racket/base], a non-prefab structure type cannot extend
+a prefab structure type.
 
 @ex[
   (struct a-prefab ([x : String]) #:prefab)
   (:type a-prefab)
-  (struct not-allowed a-prefab ())
+  (eval:error (struct not-allowed a-prefab ()))
 ]
+
+@history[#:changed "1.4" @elem{Added the @racket[#:type-name] option.}]
 }
 
 
-@defform/subs[
+@defform/subs[#:literals (:)
 (define-struct maybe-type-vars name-spec ([f : t] ...) options ...)
 ([maybe-type-vars code:blank (v ...)]
- [name-spec name (name parent)]
- [options #:transparent #:mutable])]{Legacy version of @racket[struct],
-corresponding to @|define-struct-id| from @racketmodname[racket/base].}
+ [name-spec name-id (code:line name-id parent)]
+ [options #:transparent #:mutable
+          (code:line #:type-name type-id)])]{
+Legacy version of @racket[struct], corresponding to @|define-struct-id|
+from @racketmodname[racket/base].
+@history[#:changed "1.4" @elem{Added the @racket[#:type-name] option.}]}
 
-@defform/subs[
-(define-struct/exec name-spec ([f : t] ...) [e : proc-t])
-([name-spec name (name parent)])]{
+@defform/subs[#:literals (:)
+(define-struct/exec name-spec ([f : t] ...) [e : proc-t] maybe-type-name)
+([name-spec name-id (code:line name-id parent)]
+ [maybe-type-name (code:line)
+                  (code:line #:type-name type-id)])]{
  Like @racket[define-struct], but defines a procedural structure.
- The procdure @racket[e] is used as the value for @racket[prop:procedure], and must have type @racket[proc-t].}
+ The procedure @racket[e] is used as the value for @racket[prop:procedure],
+ and must have type @racket[proc-t].
+@history[#:changed "1.4" @elem{Added the @racket[#:type-name] option.}]}
 
 @section{Names for Types}
 @defform*[[(define-type name t maybe-omit-def)
@@ -468,8 +482,8 @@ back to itself.
 However, the recursive reference may not occur immediately inside
 the type:
 
-@ex[(define-type Foo Foo)
-    (define-type Bar (U Bar False))]
+@ex[(eval:error (define-type Foo Foo))
+    (eval:error (define-type Bar (U Bar False)))]
 }
 
 @section{Generating Predicates Automatically}
@@ -526,10 +540,19 @@ returned by @racket[e], protected by a contract ensuring that it has type
 @racket[t]. This is legal only in expression contexts.
 
 @ex[(cast 3 Integer)
-(cast 3 String)
-(cast (lambda: ([x : Any]) x) (String -> String))
+(eval:error (cast 3 String))
+(cast (lambda ([x : Any]) x) (String -> String))
+((cast (lambda ([x : Any]) x) (String -> String)) "hello")
 ]
-}
+
+The value is actually protected with two contracts. The second contract checks
+the new type, but the first contract is put there to enforce the old type, to
+protect higher-order uses of the value.
+
+@ex[
+((cast (lambda ([s : String]) s) (Any -> Any)) "hello")
+(eval:error ((cast (lambda ([s : String]) s) (Any -> Any)) 5))
+]}
 
 @defform*[[(inst e t ...)
            (inst e t ... t ooo bound)]]{
@@ -560,12 +583,12 @@ Here, @racket[_m] is a module spec, @racket[_pred] is an identifier
 naming a predicate, and @racket[_maybe-renamed] is an
 optionally-renamed identifier.
 
-@defform/subs[#:literals (struct)
+@defform/subs[#:literals (struct :)
 (require/typed m rt-clause ...)
 ([rt-clause [maybe-renamed t]
-            [#:struct name ([f : t] ...)
+            [#:struct name-id ([f : t] ...)
                  struct-option ...]
-            [#:struct (name parent) ([f : t] ...)
+            [#:struct (name-id parent) ([f : t] ...)
                  struct-option ...]
             [#:opaque t pred]
 	    [#:signature name ([id : t] ...)]]
@@ -573,21 +596,21 @@ optionally-renamed identifier.
                 (orig-id new-id)]
  [struct-option
    (code:line #:constructor-name constructor-id)
-   (code:line #:extra-constructor-name constructor-id)])]
+   (code:line #:extra-constructor-name constructor-id)
+   (code:line #:type-name type-id)])]
 This form requires identifiers from the module @racket[m], giving
 them the specified types.
 
-The first case requires @racket[_maybe-renamed], giving it type
-@racket[t].
+The first case requires @racket[_maybe-renamed], giving it type @racket[t].
 
-@index["struct"]{The second and third cases} require the struct with name @racket[name]
-with fields @racket[f ...], where each field has type @racket[t].  The
-third case allows a @racket[parent] structure type to be specified.
-The parent type must already be a structure type known to Typed
-Racket, either built-in or via @racket[require/typed].  The
-structure predicate has the appropriate Typed Racket filter type so
-that it may be used as a predicate in @racket[if] expressions in Typed
-Racket.
+@index["struct"]{The second and third cases} require the struct with name
+@racket[name-id] and creates a new type with the name @racket[type-id], or
+@racket[name-id] if no @racket[type-id] is provided, with fields @racket[f ...],
+where each field has type @racket[t]. The third case allows a @racket[parent]
+structure type to be specified. The parent type must already be a structure type
+known to Typed Racket, either built-in or via @racket[require/typed]. The
+structure predicate has the appropriate Typed Racket filter type so that it may
+be used as a predicate in @racket[if] expressions in Typed Racket.
 
 
 @ex[(module UNTYPED racket/base
@@ -646,7 +669,9 @@ a @racket[require/typed] form. Here is an example of using
                             Any])]))
 
 @racket[file-or-directory-modify-seconds] has some arguments which are optional,
-so we need to use @racket[case->].}
+so we need to use @racket[case->].
+
+@history[#:changed "1.4" @elem{Added the @racket[#:type-name] option.}]}
 
 @defform[(require/typed/provide m rt-clause ...)]{
 Similar to @racket[require/typed], but also provides the imported identifiers.
@@ -691,7 +716,7 @@ but provides additional annotations to assist the typechecker.
         (default-continuation-prompt-tag)
         (code:comment "the function cannot be passed an argument")
         (λ (f) (f 3))))
-    (require 'untyped)
+    (eval:error (require 'untyped))
   ]
 }
 

typed-racket-doc/typed-racket/scribblings/reference/typed-classes.scrbl

@@ -1,6 +1,6 @@
 #lang scribble/manual
 
-@begin[(require "../utils.rkt" scribble/eval racket/sandbox)
+@begin[(require "../utils.rkt" scribble/example racket/sandbox)
        (require (for-label (only-meta-in 0 [except-in typed/racket for])))]
 
 @(define the-eval (make-base-eval))
@@ -127,9 +127,10 @@ additional provides all other bindings from @racketmodname[racket/class].
   class form's clauses) are restricted.
 
   @ex[
-    (class object%
-      (code:comment "Note the missing `super-new`")
-      (init-field [x : Real 0] [y : Real 0]))
+    (eval:error
+     (class object%
+       (code:comment "Note the missing `super-new`")
+       (init-field [x : Real 0] [y : Real 0])))
   ]
 
   If any identifier with an optional type annotation is left without an

typed-racket-doc/typed-racket/scribblings/reference/typed-regions.scrbl

@@ -1,6 +1,6 @@
 #lang scribble/manual
 
-@begin[(require "../utils.rkt" scribble/eval racket/sandbox)
+@begin[(require "../utils.rkt" scribble/example racket/sandbox)
        (require (for-label (only-meta-in 0 [except-in typed/racket for])))]
 
 @(define the-eval (make-base-eval))
@@ -35,19 +35,21 @@ have the types ascribed to them; these types are converted to contracts and chec
 @examples[#:eval the-eval
 (with-type #:result Number 3)
 
-((with-type #:result (Number -> Number)
-   (lambda: ([x : Number]) (add1 x)))
- #f)
+(eval:error
+ ((with-type #:result (Number -> Number)
+    (lambda: ([x : Number]) (add1 x)))
+  #f))
 
 (let ([x "hello"])
   (with-type #:result String
     #:freevars ([x String])
     (string-append x ", world")))
 
-(let ([x 'hello])
-  (with-type #:result String
-    #:freevars ([x String])
-    (string-append x ", world")))
+(eval:error
+ (let ([x 'hello])
+   (with-type #:result String
+     #:freevars ([x String])
+     (string-append x ", world"))))
 
 (with-type ([fun (Number -> Number)]
             [val Number])

typed-racket-doc/typed-racket/scribblings/reference/typed-units.scrbl

@@ -1,6 +1,6 @@
 #lang scribble/manual
 
-@begin[(require "../utils.rkt" scribble/eval racket/sandbox)
+@begin[(require "../utils.rkt" scribble/example racket/sandbox)
        (require (for-label (only-meta-in 0 [except-in typed/racket for]))
        (for-label (only-in racket/unit tag unit/c)))]
 
@@ -290,11 +290,12 @@ not present in the signature environment.
   (define-signature a^ (a1))
   (define-signature a-sub^ extends a^ (a2)))
 
-(module TYPED-2 typed/racket
-  (require/typed 'UNTYPED-2
-                 [#:signature a-sub^
-		   ([a1 : Integer]
-		    [a2 : String])]))]
+(eval:error
+ (module TYPED-2 typed/racket
+   (require/typed 'UNTYPED-2
+                  [#:signature a-sub^
+                    ([a1 : Integer]
+                     [a2 : String])])))]
 
 
 Requiring a signature from an untyped module that contains variable definitions is an error
@@ -305,11 +306,12 @@ in Typed Racket.
   (provide bad^)
   (define-signature bad^ (bad (define-values (bad-ref) (car bad)))))
 
-(module TYPED typed/racket
-  (require/typed 'UNTYPED
-                 [#:signature bad^
-		   ([bad : (Pairof Integer Integer)]
-		    [bad-ref : Integer])]))]
+(eval:error
+ (module TYPED typed/racket
+   (require/typed 'UNTYPED
+                  [#:signature bad^
+                    ([bad : (Pairof Integer Integer)]
+                     [bad-ref : Integer])])))]
 
 
 
@@ -331,9 +333,10 @@ signature that contains definitions in a typed module will result in an error.
 @ex[(module UNTYPED racket
       (provide bad^)
       (define-signature bad^ ((define-values (bad) 13))))
-    (module TYPED typed/racket
-      (require/typed 'UNTYPED
-                     [#:signature bad^ ([bad : Integer])]))]
+    (eval:error
+     (module TYPED typed/racket
+       (require/typed 'UNTYPED
+                      [#:signature bad^ ([bad : Integer])])))]
 
 @subsection{Contracts and Unit Static Information}
 Unit values that flow between typed and untyped contexts are wrapped in
@@ -347,10 +350,11 @@ becoming inaccessible.
 (module UNTYPED racket
   (provide u@)
   (define-unit u@ (import) (export) "Hello!"))
-(module TYPED typed/racket
-  (require/typed 'UNTYPED
-                 [u@ (Unit (import) (export) String)])
-  (invoke-unit/infer u@))]
+(eval:error
+ (module TYPED typed/racket
+   (require/typed 'UNTYPED
+                  [u@ (Unit (import) (export) String)])
+   (invoke-unit/infer u@)))]
 
 When an identifier bound to static unit information flows from a typed module to
 an untyped module, however, the situation is worse. Because unit static
@@ -361,9 +365,10 @@ typed unit is disallowed in untyped contexts.
 (module TYPED typed/racket
   (provide u@)
   (define-unit u@ (import) (export) "Hello!"))
-(module UNTYPED racket
-  (require 'TYPED)
-  u@)]
+(eval:error
+ (module UNTYPED racket
+   (require 'TYPED)
+   u@))]
 
 @subsection{Signatures and Internal Definition Contexts}
 Typed Racket's @racket[define-signature] form is allowed in both top-level and
@@ -371,13 +376,14 @@ internal definition contexts. As the following example shows, defining
 signatures in internal definiition contexts can be problematic.
 
 @ex[
-(module TYPED typed/racket
-  (define-signature a^ ())
-  (define u@
-    (let ()
-      (define-signature a^ ())
-      (unit (import a^) (export) (init-depend a^) 5)))
-  (invoke-unit u@ (import a^)))]
+(eval:error
+ (module TYPED typed/racket
+   (define-signature a^ ())
+   (define u@
+     (let ()
+       (define-signature a^ ())
+       (unit (import a^) (export) (init-depend a^) 5)))
+   (invoke-unit u@ (import a^))))]
 
   Even though the unit imports a signature named @racket[a^], the @racket[a^]
 provided for the import refers to the top-level @racket[a^] signature and the

typed-racket-doc/typed-racket/scribblings/reference/types.scrbl

@@ -2,7 +2,7 @@
 
 @begin[(require "../utils.rkt"
                 "numeric-tower-pict.rkt"
-                scribble/eval
+                scribble/example
                 racket/sandbox)
        (require (for-label (only-meta-in 0 [except-in typed/racket for])
                            racket/async-channel))]
@@ -372,7 +372,10 @@ corresponding to @racket[trest], where @racket[bound]
 @defidform[FlVector]{An @rtech{flvector}.
   @ex[(flvector 1.0 2.0 3.0)]}
 @defidform[ExtFlVector]{An @rtech{extflvector}.
-  @ex[(extflvector 1.0t0 2.0t0 3.0t0)]}
+  @ex[(eval:alts (extflvector 1.0t0 2.0t0 3.0t0)
+                 (eval:result @racketresultfont{#<extflvector>}
+                              "- : ExtFlVector"
+                              ""))]}
 @defidform[FxVector]{An @rtech{fxvector}.
   @ex[(fxvector 1 2 3)]}
 
@@ -399,8 +402,11 @@ corresponding to @racket[trest], where @racket[bound]
 @ex[(lambda: ([x : Any]) (if (hash? x) x (error "not a hash table!")))]
 }
 
-@defform[(Setof t)]{is the type of a @rtech{set} of @racket[t].
+@defform[(Setof t)]{is the type of a @rtech{hash set} of
+@racket[t]. This includes custom hash sets, but not mutable hash set
+or sets that are implemented using @racket[gen:set].
 @ex[(set 0 1 2 3)]
+@ex[(seteq 0 1 2 3)]
 }
 
 @defform[(Channelof t)]{A @rtech{channel} on which only @racket[t]s can be sent.
@@ -562,29 +568,33 @@ functions and continuation mark functions.
 @section{Other Type Constructors}
 
 @defform*/subs[#:id -> #:literals (|@| * ... ! and or implies car cdr)
-               [(-> dom ... rng optional-filter)
+               [(-> dom ... rng opt-proposition)
                 (-> dom ... rest * rng)
                 (-> dom ... rest ooo bound rng)
 
-                (dom ... -> rng optional-filter)
+                (dom ... -> rng opt-proposition)
                 (dom ... rest * -> rng)
                 (dom ... rest ooo bound -> rng)]
                ([ooo #,(racket ...)]
                 [dom type
                      mandatory-kw
-                     optional-kw]
+                     opt-kw]
                 [mandatory-kw (code:line keyword type)]
-                [optional-kw [keyword type]]
-                [optional-filter (code:line)
+                [opt-kw [keyword type]]
+                [opt-proposition (code:line)
                                  (code:line : type)
-                                 (code:line : pos-filter neg-filter object)]
-                [pos-filter (code:line)
-                            (code:line #:+ proposition ...)]
-                [neg-filter (code:line)
-                            (code:line #:- proposition ...)]
+                                 (code:line : pos-proposition
+				              neg-proposition
+					      object)]
+                [pos-proposition (code:line)
+                                 (code:line #:+ proposition ...)]
+                [neg-proposition (code:line)
+                                 (code:line #:- proposition ...)]
                 [object (code:line)
                         (code:line #:object index)]
-                [proposition type
+                [proposition Top
+		             Bot
+			     type
                              (! type)
                              (type |@| path-elem ... index)
                              (! type |@| path-elem ... index)
@@ -598,15 +608,15 @@ functions and continuation mark functions.
   The type of functions from the (possibly-empty)
   sequence @racket[dom ....] to the @racket[rng] type.
 
-  @ex[(λ: ([x : Number]) x)
-      (λ: () 'hello)]
+  @ex[(λ ([x : Number]) x)
+      (λ () 'hello)]
 
   The second form specifies a uniform rest argument of type @racket[rest], and the
   third form specifies a non-uniform rest argument of type
   @racket[rest] with bound @racket[bound]. The bound refers to the type variable
   that is in scope within the rest argument type.
 
-  @ex[(λ: ([x : Number] . [y : String *]) (length y))
+  @ex[(λ ([x : Number] . [y : String *]) (length y))
       ormap]
 
   In the third form, the @racket[...] introduced by @racket[ooo] is literal,
@@ -623,20 +633,24 @@ functions and continuation mark functions.
       (is-zero? 2 #:equality =)
       (is-zero? 2 #:equality eq? #:zero 2.0)]
 
-  When @racket[optional-filter] is provided, it specifies the @emph{filter} for the
-  function type (for an introduction to filters, see @tr-guide-secref["filters-and-predicates"]).
-  For almost all use cases, only the simplest form of filters, with a single type after a
+  When @racket[opt-proposition] is provided, it specifies the
+  @emph{proposition} for the function type (for an introduction to
+  propositions in Typed Racket, see
+  @tr-guide-secref["propositions-and-predicates"]).  For almost all use
+  cases, only the simplest form of propositions, with a single type after a
   @racket[:], are necessary:
 
   @ex[string?]
 
-  The filter specifies that when @racket[(string? x)] evaluates to a true value for
-  a conditional branch, the variable @racket[x] in that branch can be assumed to have
-  type @racket[String]. Likewise, if the expression evaluates to @racket[#f] in a branch,
-  the variable @emph{does not} have type @racket[String].
+  The proposition specifies that when @racket[(string? x)] evaluates to a
+  true value for a conditional branch, the variable @racket[x] in that
+  branch can be assumed to have type @racket[String]. Likewise, if the
+  expression evaluates to @racket[#f] in a branch, the variable
+  @emph{does not} have type @racket[String].
 
-  In some cases, asymmetric type information is useful in filters. For example, the
-  @racket[filter] function's first argument is specified with only a positive filter:
+  In some cases, asymmetric type information is useful in the
+  propositions. For example, the @racket[filter] function's first
+  argument is specified with only a positive proposition:
 
   @ex[filter]
 
@@ -647,7 +661,7 @@ functions and continuation mark functions.
   Conversely, @racket[#:-] specifies that a function provides information for the
   false branch of a conditional.
 
-  The other filter proposition cases are rarely needed, but the grammar documents them
+  The other proposition cases are rarely needed, but the grammar documents them
   for completeness. They correspond to logical operations on the propositions.
 
   The type of functions can also be specified with an @emph{infix} @racket[->]
@@ -689,7 +703,7 @@ functions and continuation mark functions.
 
   @ex[(: +all (->* (Integer) #:rest Integer (Listof Integer)))
       (define (+all inc . rst)
-        (map (λ: ([x : Integer]) (+ x inc)) rst))
+        (map (λ ([x : Integer]) (+ x inc)) rst))
       (+all 20 1 2 3)]
 
   Both the mandatory and optional argument lists may contain keywords paired
@@ -704,9 +718,9 @@ functions and continuation mark functions.
 
 @deftogether[(
 @defidform[Top]
-@defidform[Bot])]{ These are filters that can be used with @racket[->].
-  @racket[Top] is the filter with no information.
-  @racket[Bot] is the filter which means the result cannot happen.
+@defidform[Bot])]{ These are propositions that can be used with @racket[->].
+  @racket[Top] is the propositions with no information.
+  @racket[Bot] is the propositions which means the result cannot happen.
 }
 
 
@@ -722,13 +736,17 @@ functions and continuation mark functions.
   @ex[
     (: my-list Procedure)
     (define my-list list)
-    (my-list "zwiebelkuchen" "socca")
+    (eval:error (my-list "zwiebelkuchen" "socca"))
   ]
 }
 
 
 @defform[(U t ...)]{is the union of the types @racket[t ...].
- @ex[(λ: ([x : Real])(if (> 0 x) "yes" 'no))]}
+ @ex[(λ ([x : Real]) (if (> 0 x) "yes" 'no))]}
+
+@defform[(∩ t ...)]{is the intersection of the types @racket[t ...].
+ @ex[((λ #:forall (A) ([x : (∩ Symbol A)]) x) 'foo)]}
+
 @defform[(case-> fun-ty ...)]{is a function that behaves like all of
   the @racket[fun-ty]s, considered in order from first to last.  The @racket[fun-ty]s must all be function
   types constructed with @racket[->].

typed-racket-doc/typed-racket/scribblings/reference/unsafe.scrbl

@@ -1,6 +1,6 @@
 #lang scribble/manual
 
-@(require scribble/eval
+@(require scribble/example
           (for-label (only-meta-in 0 [except-in typed/racket for])))
 
 @(define eval (make-base-eval))
@@ -42,6 +42,17 @@ behavior and may even crash Typed Racket.
   any contracts that correspond to the specified types. This means that uses of the
   exports in other modules may circumvent the type system's invariants.
 
+  Additionally, importing an identififer that is exported with
+  @racket[unsafe-provide] into another typed module, and then
+  re-exporting it with @racket[provide] will not cause contracts to be
+  generated.
+
+  Uses of the provided identifiers in other typed modules are not
+  affected by @racket[unsafe-provide]---in these situations it behaves
+  identically to @racket[provide]. Furthermore, other typed modules
+  that @emph{use} a binding that is in an @racket[unsafe-provide] will
+  still have contracts generated as usual.
+
   @examples[#:eval eval
     (module t typed/racket/base
       (require typed/racket/unsafe)
@@ -55,7 +66,7 @@ behavior and may even crash Typed Racket.
       (code:comment "bad call that's unchecked")
       (f "foo"))
 
-    (require 'u)
+    (eval:error (require 'u))
   ]
 
   @history[#:added "1.3"]

typed-racket-doc/typed-racket/scribblings/reference/utilities.scrbl

@@ -1,6 +1,6 @@
 #lang scribble/manual
 
-@begin[(require "../utils.rkt" scribble/eval racket/sandbox)
+@begin[(require "../utils.rkt" scribble/example racket/sandbox)
        (require (for-label (only-meta-in 0 [except-in typed/racket for])
                            typed/untyped-utils))]
 
@@ -30,7 +30,7 @@ x
 (define: y : (U String Symbol) "hello")
 y
 (assert y string?)
-(assert y boolean?)]
+(eval:error (assert y boolean?))]
 
 @defform*/subs[[(with-asserts ([id maybe-pred] ...) body ...+)]
               ([maybe-pred code:blank
@@ -64,10 +64,11 @@ the error message.
      #`(cond clause ... [else (typecheck-fail #,stx "incomplete coverage"
                                               #:covered-id x)])]))
 
-(define: (f [x  : (U String Integer)]) : Boolean
-  (cond* x
-         [(string? x) #t]
-         [(exact-nonnegative-integer? x) #f]))
+(eval:error
+ (define: (f [x  : (U String Integer)]) : Boolean
+   (cond* x
+          [(string? x) #t]
+          [(exact-nonnegative-integer? x) #f])))
 ]
 
 }

typed-racket-lib/info.rkt

@@ -2,7 +2,7 @@
 
 (define collection 'multi)
 
-(define deps '(("base" #:version "6.3.0.8")
+(define deps '(("base" #:version "6.4.0.5")
                "pconvert-lib"
                "source-syntax"
                "compatibility-lib" ;; to assign types
@@ -12,4 +12,4 @@
 
 (define pkg-authors '(samth stamourv))
 
-(define version "1.3")
+(define version "1.5")

typed-racket-lib/typed-racket/HISTORY.txt

@@ -1,3 +1,14 @@
+6.5
+- Added `simple-result->` to improve generated contract performance.
+- Improve error message printing.
+- Add `typed/racket/random`.
+- Internal: populate type table unconditionally, for use in tooltips.
+6.4
+- Contract performance improvements, including generating code that
+  the contract system can optimize
+- Make `any-wrap/c` more permissive on opaque structs.
+- Soundly check opaque predicates.
+- Add `#:type-name` option to `struct`.
 6.3
 - Startup time reduction
 - Tightening and cleanup of numeric types

typed-racket-lib/typed-racket/base-env/base-env-numeric.rkt

@@ -41,11 +41,11 @@
   ;; for fixnum-specific operations. if they return at all, we know
   ;; their args were fixnums. otherwise, an error would have been thrown
   ;; for the moment, this is only useful if the result is used as a test
-  ;; once we have a set of filters that are true/false based on reaching
+  ;; once we have a set of props that are true/false based on reaching
   ;; a certain point, this will be more useful
   (define (fx-from-cases . cases)
     (apply from-cases (map (lambda (x)
-                             (add-unconditional-filter-all-args
+                             (add-unconditional-prop-all-args
                               x -Fixnum))
                            (flatten cases))))
 
@@ -70,14 +70,14 @@
     (-> t1 t2 B))
   ;; simple case useful with equality predicates.
   ;; if the equality is true, we know that general arg is in fact of specific type.
-  (define (commutative-equality/filter general specific)
-    (list (-> general specific B : (-FS (-filter specific 0) -top))
-          (-> specific general B : (-FS (-filter specific 1) -top))))
+  (define (commutative-equality/prop general specific)
+    (list (-> general specific B : (-PS (-is-type 0 specific) -tt))
+          (-> specific general B : (-PS (-is-type 1 specific) -tt))))
 
   ;; if in addition if the equality is false, we know that general arg is not of the specific type.
-  (define (commutative-equality/strict-filter general specific)
-    (list (-> general specific B : (-FS (-filter specific 0) (-not-filter specific 0)))
-          (-> specific general B : (-FS (-filter specific 1) (-not-filter specific 1)))))
+  (define (commutative-equality/strict-prop general specific)
+    (list (-> general specific B : (-PS (-is-type 0 specific) (-not-type 0 specific)))
+          (-> specific general B : (-PS (-is-type 1 specific) (-not-type 1 specific)))))
 
 
   (define round-type ; also used for truncate
@@ -118,8 +118,8 @@
   (define fx+-type
     (lambda ()
       (fx-from-cases
-       (-> -Zero -Int -Fixnum : -true-filter : (-arg-path 1))
-       (-> -Int -Zero -Fixnum : -true-filter : (-arg-path 0))
+       (-> -Zero -Int -Fixnum : -true-propset : (-arg-path 1))
+       (-> -Int -Zero -Fixnum : -true-propset : (-arg-path 0))
        (commutative-binop -PosByte -Byte -PosIndex)
        (binop -Byte -Index)
        ;; in other cases, either we stay within fixnum range, or we error
@@ -132,7 +132,7 @@
   (define fx--type
     (lambda ()
       (fx-from-cases
-       (-> -Int -Zero -Fixnum : -true-filter : (-arg-path 0))
+       (-> -Int -Zero -Fixnum : -true-propset : (-arg-path 0))
        (-One -One . -> . -Zero)
        (-PosByte -One . -> . -Byte)
        (-PosIndex -One . -> . -Index)
@@ -147,8 +147,8 @@
   (define fx*-type
     (lambda ()
       (fx-from-cases
-       (-> -One -Int -Fixnum : -true-filter : (-arg-path 1))
-       (-> -Int -One -Fixnum : -true-filter : (-arg-path 0))
+       (-> -One -Int -Fixnum : -true-propset : (-arg-path 1))
+       (-> -Int -One -Fixnum : -true-propset : (-arg-path 0))
        (commutative-binop -Int -Zero)
        (-PosByte -PosByte . -> . -PosIndex)
        (-Byte -Byte . -> . -Index)
@@ -163,7 +163,7 @@
     (lambda ()
       (fx-from-cases
        (-Zero -Int . -> . -Zero)
-       (-> -Int -One -Fixnum : -true-filter : (-arg-path 0))
+       (-> -Int -One -Fixnum : -true-propset : (-arg-path 0))
        (-Byte -Nat . -> . -Byte)
        (-Index -Nat . -> . -Index)
        (-Nat -Nat . -> . -NonNegFixnum)
@@ -193,133 +193,133 @@
   (define fxabs-type
     (lambda ()
       (fx-from-cases
-       (-> -Nat -NonNegFixnum : -true-filter : (-arg-path 0))
+       (-> -Nat -NonNegFixnum : -true-propset : (-arg-path 0))
        ((Un -PosInt -NegInt) . -> . -PosFixnum)
        (-Int . -> . -NonNegFixnum))))
   (define fx=-type
     (lambda ()
       (fx-from-cases
        ;; we could rule out cases like (= Pos Neg), but we currently don't
-       (commutative-equality/strict-filter -Int -Zero)
-       (map (lambda (t) (commutative-equality/filter -Int t))
+       (commutative-equality/strict-prop -Int -Zero)
+       (map (lambda (t) (commutative-equality/prop -Int t))
             (list -One -PosByte -Byte -PosIndex -Index -PosFixnum -NonNegFixnum -NegFixnum -NonPosFixnum))
        (comp -Int))))
   (define fx<-type
     (lambda ()
       (fx-from-cases
-       (-> -Int -One B : (-FS (-filter -NonPosFixnum 0) (-filter -PosFixnum 0)))
-       (-> -Int -Zero B : (-FS (-filter -NegFixnum 0) (-filter -NonNegFixnum 0)))
-       (-> -Zero -Int B : (-FS (-filter -PosFixnum 1) (-filter -NonPosFixnum 1)))
+       (-> -Int -One B : (-PS (-is-type 0 -NonPosFixnum) (-is-type 0 -PosFixnum)))
+       (-> -Int -Zero B : (-PS (-is-type 0 -NegFixnum) (-is-type 0 -NonNegFixnum)))
+       (-> -Zero -Int B : (-PS (-is-type 1 -PosFixnum) (-is-type 1 -NonPosFixnum)))
 
-       (-> -Byte -PosByte B : (-FS -top (-filter -PosByte 0)))
-       (-> -Byte -Byte B : (-FS (-filter -PosByte 1) -top))
-       (-> -Pos -Byte B : (-FS (-and (-filter -PosByte 0) (-filter -PosByte 1)) -top))
-       (-> -Byte -Pos B : (-FS -top (-and (-filter -PosByte 0) (-filter -PosByte 1))))
-       (-> -Byte -Nat B : (-FS -top (-filter -Byte 1)))
-       (-> -Index -PosIndex B : (-FS -top (-filter -PosIndex 0)))
-       (-> -Index -Index B : (-FS (-filter -PosIndex 1) -top))
-       (-> -Pos -Index B : (-FS (-and (-filter -PosIndex 0) (-filter -PosIndex 1)) -top))
-       (-> -Index -Pos B : (-FS -top (-and (-filter -PosIndex 0) (-filter -PosIndex 1))))
-       (-> -Nat -Byte B : (-FS (-and (-filter -Byte 0) (-filter -PosByte 1)) -top))
-       (-> -Nat -Index B : (-FS (-and (-filter -Index 0) (-filter -PosIndex 1)) -top))
-       (-> -Index -Nat B : (-FS -top (-filter -Index 1)))
+       (-> -Byte -PosByte B : (-PS -tt (-is-type 0 -PosByte)))
+       (-> -Byte -Byte B : (-PS (-is-type 1 -PosByte) -tt))
+       (-> -Pos -Byte B : (-PS (-and (-is-type 0 -PosByte) (-is-type 1 -PosByte)) -tt))
+       (-> -Byte -Pos B : (-PS -tt (-and (-is-type 0 -PosByte) (-is-type 1 -PosByte))))
+       (-> -Byte -Nat B : (-PS -tt (-is-type 1 -Byte)))
+       (-> -Index -PosIndex B : (-PS -tt (-is-type 0 -PosIndex)))
+       (-> -Index -Index B : (-PS (-is-type 1 -PosIndex) -tt))
+       (-> -Pos -Index B : (-PS (-and (-is-type 0 -PosIndex) (-is-type 1 -PosIndex)) -tt))
+       (-> -Index -Pos B : (-PS -tt (-and (-is-type 0 -PosIndex) (-is-type 1 -PosIndex))))
+       (-> -Nat -Byte B : (-PS (-and (-is-type 0 -Byte) (-is-type 1 -PosByte)) -tt))
+       (-> -Nat -Index B : (-PS (-and (-is-type 0 -Index) (-is-type 1 -PosIndex)) -tt))
+       (-> -Index -Nat B : (-PS -tt (-is-type 1 -Index)))
        ;; general integer cases
-       (-> -Int -PosInt B : (-FS -top (-filter -PosFixnum 0)))
-       (-> -Int -Nat B : (-FS -top (-filter -NonNegFixnum 0)))
-       (-> -Nat -Int B : (-FS (-filter -PosFixnum 1) -top))
-       (-> -Int -NonPosInt B : (-FS (-filter -NegFixnum 0) -top))
-       (-> -NegInt -Int B : (-FS -top (-filter -NegFixnum 1)))
-       (-> -NonPosInt -Int B : (-FS -top (-filter -NonPosFixnum 1)))
+       (-> -Int -PosInt B : (-PS -tt (-is-type 0 -PosFixnum)))
+       (-> -Int -Nat B : (-PS -tt (-is-type 0 -NonNegFixnum)))
+       (-> -Nat -Int B : (-PS (-is-type 1 -PosFixnum) -tt))
+       (-> -Int -NonPosInt B : (-PS (-is-type 0 -NegFixnum) -tt))
+       (-> -NegInt -Int B : (-PS -tt (-is-type 1 -NegFixnum)))
+       (-> -NonPosInt -Int B : (-PS -tt (-is-type 1 -NonPosFixnum)))
        (comp -Int))))
   (define fx>-type
     (lambda ()
       (fx-from-cases
-       (-> -One -Int B : (-FS (-filter -NonPosFixnum 1) (-filter -PosFixnum 1)))
-       (-> -Zero -Int B : (-FS (-filter -NegFixnum 1) (-filter -NonNegFixnum 1)))
-       (-> -Int -Zero  B : (-FS (-filter -PosFixnum 0) (-filter -NonPosFixnum 0)))
+       (-> -One -Int B : (-PS (-is-type 1 -NonPosFixnum) (-is-type 1 -PosFixnum)))
+       (-> -Zero -Int B : (-PS (-is-type 1 -NegFixnum) (-is-type 1 -NonNegFixnum)))
+       (-> -Int -Zero  B : (-PS (-is-type 0 -PosFixnum) (-is-type 0 -NonPosFixnum)))
 
-       (-> -PosByte -Byte B : (-FS -top (-filter -PosByte 1)))
-       (-> -Byte -Byte B : (-FS (-filter -PosByte 0) -top))
-       (-> -Byte -Pos B : (-FS (-and (-filter -PosByte 0) (-filter -PosByte 1)) -top))
-       (-> -Pos -Byte B : (-FS -top (-and (-filter -PosByte 0) (-filter -PosByte 1))))
-       (-> -Byte -Nat B : (-FS (-and (-filter -PosByte 0) (-filter -Byte 1)) -top))
-       (-> -PosIndex -Index B : (-FS -top (-filter -PosIndex 1)))
-       (-> -Index -Index B : (-FS (-filter -PosIndex 0) -top))
-       (-> -Index -Pos B : (-FS (-and (-filter -PosIndex 0) (-filter -PosIndex 1)) -top))
-       (-> -Pos -Index B : (-FS -top (-and (-filter -PosIndex 0) (-filter -PosIndex 1))))
-       (-> -Index -Nat B : (-FS (-and (-filter -PosIndex 0) (-filter -Index 1)) -top))
-       (-> -Nat -Byte B : (-FS -top (-filter -Byte 0)))
-       (-> -Nat -Index B : (-FS -top (-filter -Index 0)))
+       (-> -PosByte -Byte B : (-PS -tt (-is-type 1 -PosByte)))
+       (-> -Byte -Byte B : (-PS (-is-type 0 -PosByte) -tt))
+       (-> -Byte -Pos B : (-PS (-and (-is-type 0 -PosByte) (-is-type 1 -PosByte)) -tt))
+       (-> -Pos -Byte B : (-PS -tt (-and (-is-type 0 -PosByte) (-is-type 1 -PosByte))))
+       (-> -Byte -Nat B : (-PS (-and (-is-type 0 -PosByte) (-is-type 1 -Byte)) -tt))
+       (-> -PosIndex -Index B : (-PS -tt (-is-type 1 -PosIndex)))
+       (-> -Index -Index B : (-PS (-is-type 0 -PosIndex) -tt))
+       (-> -Index -Pos B : (-PS (-and (-is-type 0 -PosIndex) (-is-type 1 -PosIndex)) -tt))
+       (-> -Pos -Index B : (-PS -tt (-and (-is-type 0 -PosIndex) (-is-type 1 -PosIndex))))
+       (-> -Index -Nat B : (-PS (-and (-is-type 0 -PosIndex) (-is-type 1 -Index)) -tt))
+       (-> -Nat -Byte B : (-PS -tt (-is-type 0 -Byte)))
+       (-> -Nat -Index B : (-PS -tt (-is-type 0 -Index)))
        ;; general integer cases
-       (-> -PosInt -Int B : (-FS -top (-filter -PosFixnum 1)))
-       (-> -Nat -Int B : (-FS -top (-filter -NonNegFixnum 1)))
-       (-> -Int -Nat B : (-FS (-filter -PosFixnum 0) -top))
-       (-> -NonPosInt -Int B : (-FS (-filter -NegFixnum 1) -top))
-       (-> -Int -NegInt B : (-FS -top (-filter -NegFixnum 0)))
-       (-> -Int -NonPosInt B : (-FS -top (-filter -NonPosFixnum 0)))
+       (-> -PosInt -Int B : (-PS -tt (-is-type 1 -PosFixnum)))
+       (-> -Nat -Int B : (-PS -tt (-is-type 1 -NonNegFixnum)))
+       (-> -Int -Nat B : (-PS (-is-type 0 -PosFixnum) -tt))
+       (-> -NonPosInt -Int B : (-PS (-is-type 1 -NegFixnum) -tt))
+       (-> -Int -NegInt B : (-PS -tt (-is-type 0 -NegFixnum)))
+       (-> -Int -NonPosInt B : (-PS -tt (-is-type 0 -NonPosFixnum)))
        (comp -Int))))
   (define fx<=-type
     (lambda ()
       (fx-from-cases
-       (-> -Int -One B : (-FS (-filter (Un -NonPosFixnum -One) 0) (-filter -PosFixnum 0)))
-       (-> -One -Int B : (-FS (-filter -PosFixnum 1) (-filter -NonPosFixnum 1)))
-       (-> -Int -Zero B : (-FS (-filter -NonPosFixnum 0) (-filter -PosFixnum 0)))
-       (-> -Zero -Int B : (-FS (-filter -NonNegFixnum 1) (-filter -NegFixnum 1)))
+       (-> -Int -One B : (-PS (-is-type 0 (Un -NonPosFixnum -One)) (-is-type 0 -PosFixnum)))
+       (-> -One -Int B : (-PS (-is-type 1 -PosFixnum) (-is-type 1 -NonPosFixnum)))
+       (-> -Int -Zero B : (-PS (-is-type 0 -NonPosFixnum) (-is-type 0 -PosFixnum)))
+       (-> -Zero -Int B : (-PS (-is-type 1 -NonNegFixnum) (-is-type 1 -NegFixnum)))
 
-       (-> -PosByte -Byte B : (-FS (-filter -PosByte 1) -top))
-       (-> -Byte -Byte B : (-FS -top (-filter -PosByte 0)))
-       (-> -Pos -Byte B : (-FS (-and (-filter -PosByte 0) (-filter -PosByte 1)) -top))
-       (-> -Byte -Pos B : (-FS -top (-and (-filter -PosByte 0) (-filter -PosByte 1))))
-       (-> -Byte -Nat B : (-FS -top (-and (-filter -PosByte 0) (-filter -Byte 1))))
-       (-> -PosIndex -Index B : (-FS (-filter -PosIndex 1) -top))
-       (-> -Index -Index B : (-FS -top (-filter -PosIndex 0)))
-       (-> -Pos -Index B : (-FS (-and (-filter -PosIndex 0) (-filter -PosIndex 1)) -top))
-       (-> -Index -Pos B : (-FS -top (-and (-filter -PosIndex 0) (-filter -PosIndex 1))))
-       (-> -Nat -Byte B : (-FS (-filter -Byte 0) -top))
-       (-> -Nat -Index B : (-FS (-filter -Index 0) -top))
-       (-> -Index -Nat B : (-FS -top (-and (-filter -PosIndex 0) (-filter -Index 1))))
+       (-> -PosByte -Byte B : (-PS (-is-type 1 -PosByte) -tt))
+       (-> -Byte -Byte B : (-PS -tt (-is-type 0 -PosByte)))
+       (-> -Pos -Byte B : (-PS (-and (-is-type 0 -PosByte) (-is-type 1 -PosByte)) -tt))
+       (-> -Byte -Pos B : (-PS -tt (-and (-is-type 0 -PosByte) (-is-type 1 -PosByte))))
+       (-> -Byte -Nat B : (-PS -tt (-and (-is-type 0 -PosByte) (-is-type 1 -Byte))))
+       (-> -PosIndex -Index B : (-PS (-is-type 1 -PosIndex) -tt))
+       (-> -Index -Index B : (-PS -tt (-is-type 0 -PosIndex)))
+       (-> -Pos -Index B : (-PS (-and (-is-type 0 -PosIndex) (-is-type 1 -PosIndex)) -tt))
+       (-> -Index -Pos B : (-PS -tt (-and (-is-type 0 -PosIndex) (-is-type 1 -PosIndex))))
+       (-> -Nat -Byte B : (-PS (-is-type 0 -Byte) -tt))
+       (-> -Nat -Index B : (-PS (-is-type 0 -Index) -tt))
+       (-> -Index -Nat B : (-PS -tt (-and (-is-type 0 -PosIndex) (-is-type 1 -Index))))
        ;; general integer cases
-       (-> -PosInt -Int B : (-FS (-filter -PosFixnum 1) -top))
-       (-> -Int -Nat B : (-FS -top (-filter -PosFixnum 0)))
-       (-> -Nat -Int B : (-FS (-filter -NonNegFixnum 1) -top))
-       (-> -Int -NegInt B : (-FS (-filter -NegFixnum 0) -top))
-       (-> -Int -NonPosInt B : (-FS (-filter -NonPosFixnum 0) -top))
-       (-> -NonPosInt -Int B : (-FS -top (-filter -NegFixnum 1)))
+       (-> -PosInt -Int B : (-PS (-is-type 1 -PosFixnum) -tt))
+       (-> -Int -Nat B : (-PS -tt (-is-type 0 -PosFixnum)))
+       (-> -Nat -Int B : (-PS (-is-type 1 -NonNegFixnum) -tt))
+       (-> -Int -NegInt B : (-PS (-is-type 0 -NegFixnum) -tt))
+       (-> -Int -NonPosInt B : (-PS (-is-type 0 -NonPosFixnum) -tt))
+       (-> -NonPosInt -Int B : (-PS -tt (-is-type 1 -NegFixnum)))
        (comp -Int))))
   (define fx>=-type
     (lambda ()
       (fx-from-cases
-       (-> -One -Int B : (-FS (-filter (Un -One -NonPosInt) 1) (-filter -PosFixnum 1)))
-       (-> -Int -One B : (-FS (-filter -PosFixnum 0) (-filter -NonPosFixnum 0)))
-       (-> -Zero -Int B : (-FS (-filter -NonPosFixnum 1) (-filter -PosFixnum 1)))
-       (-> -Int -Zero B : (-FS (-filter -NonNegFixnum 0) (-filter -NegFixnum 0)))
+       (-> -One -Int B : (-PS (-is-type 1 (Un -One -NonPosInt)) (-is-type 1 -PosFixnum)))
+       (-> -Int -One B : (-PS (-is-type 0 -PosFixnum) (-is-type 0 -NonPosFixnum)))
+       (-> -Zero -Int B : (-PS (-is-type 1 -NonPosFixnum) (-is-type 1 -PosFixnum)))
+       (-> -Int -Zero B : (-PS (-is-type 0 -NonNegFixnum) (-is-type 0 -NegFixnum)))
 
-       (-> -Byte -PosByte B : (-FS (-filter -PosByte 0) -top))
-       (-> -Byte -Byte B : (-FS -top (-filter -PosByte 1)))
-       (-> -Byte -Pos B : (-FS (-and (-filter -PosByte 1) (-filter -PosByte 0)) -top))
-       (-> -Pos -Byte B : (-FS -top (-and (-filter -PosByte 1) (-filter -PosByte 0))))
-       (-> -Byte -Nat B : (-FS (-filter -Byte 1) -top))
-       (-> -Zero -Index B : (-FS (-filter -Zero 1) (-filter -PosIndex 1)))
-       (-> -Index -PosIndex B : (-FS (-filter -PosIndex 0) -top))
-       (-> -Index -Index B : (-FS -top (-filter -PosIndex 1)))
-       (-> -Index -Pos B : (-FS (-and (-filter -PosIndex 0) (-filter -PosIndex 1)) -top))
-       (-> -Pos -Index B : (-FS -top (-and (-filter -PosIndex 0) (-filter -PosIndex 1))))
-       (-> -Index -Nat B : (-FS (-filter -Index 1) -top))
-       (-> -Nat -Byte B : (-FS -top (-and (-filter -Byte 0) (-filter -PosByte 1))))
-       (-> -Nat -Index B : (-FS -top (-and (-filter -Index 0) (-filter -PosIndex 1))))
+       (-> -Byte -PosByte B : (-PS (-is-type 0 -PosByte) -tt))
+       (-> -Byte -Byte B : (-PS -tt (-is-type 1 -PosByte)))
+       (-> -Byte -Pos B : (-PS (-and (-is-type 1 -PosByte) (-is-type 0 -PosByte)) -tt))
+       (-> -Pos -Byte B : (-PS -tt (-and (-is-type 1 -PosByte) (-is-type 0 -PosByte))))
+       (-> -Byte -Nat B : (-PS (-is-type 1 -Byte) -tt))
+       (-> -Zero -Index B : (-PS (-is-type 1 -Zero) (-is-type 1 -PosIndex)))
+       (-> -Index -PosIndex B : (-PS (-is-type 0 -PosIndex) -tt))
+       (-> -Index -Index B : (-PS -tt (-is-type 1 -PosIndex)))
+       (-> -Index -Pos B : (-PS (-and (-is-type 0 -PosIndex) (-is-type 1 -PosIndex)) -tt))
+       (-> -Pos -Index B : (-PS -tt (-and (-is-type 0 -PosIndex) (-is-type 1 -PosIndex))))
+       (-> -Index -Nat B : (-PS (-is-type 1 -Index) -tt))
+       (-> -Nat -Byte B : (-PS -tt (-and (-is-type 0 -Byte) (-is-type 1 -PosByte))))
+       (-> -Nat -Index B : (-PS -tt (-and (-is-type 0 -Index) (-is-type 1 -PosIndex))))
        ;; general integer cases
-       (-> -Int -PosInt B : (-FS (-filter -PosFixnum 0) -top))
-       (-> -Nat -Int B : (-FS -top (-filter -PosFixnum 1)))
-       (-> -Int -Nat B : (-FS (-filter -NonNegFixnum 0) -top))
-       (-> -NegInt -Int B : (-FS (-filter -NegFixnum 1) -top))
-       (-> -NonPosInt -Int B : (-FS (-filter -NonPosFixnum 1) -top))
-       (-> -Int -NonPosInt B : (-FS -top (-filter -NegFixnum 0)))
+       (-> -Int -PosInt B : (-PS (-is-type 0 -PosFixnum) -tt))
+       (-> -Nat -Int B : (-PS -tt (-is-type 1 -PosFixnum)))
+       (-> -Int -Nat B : (-PS (-is-type 0 -NonNegFixnum) -tt))
+       (-> -NegInt -Int B : (-PS (-is-type 1 -NegFixnum) -tt))
+       (-> -NonPosInt -Int B : (-PS (-is-type 1 -NonPosFixnum) -tt))
+       (-> -Int -NonPosInt B : (-PS -tt (-is-type 0 -NegFixnum)))
        (comp -Int))))
   (define fxmin-type
     (lambda ()
       (fx-from-cases
-       (-> -Nat -NonPosInt -NonPosFixnum : -true-filter : (-arg-path 1))
-       (-> -NonPosInt -Nat -NonPosFixnum : -true-filter : (-arg-path 0))
+       (-> -Nat -NonPosInt -NonPosFixnum : -true-propset : (-arg-path 1))
+       (-> -NonPosInt -Nat -NonPosFixnum : -true-propset : (-arg-path 0))
        (-> -Zero -Int -NonPosFixnum)
        (-> -Int -Zero -NonPosFixnum)
 
@@ -335,8 +335,8 @@
   (define fxmax-type
     (lambda ()
       (fx-from-cases
-       (-> -NonPosInt -Nat -NonNegFixnum : -true-filter : (-arg-path 1))
-       (-> -Nat -NonPosInt -NonNegFixnum : -true-filter : (-arg-path 0))
+       (-> -NonPosInt -Nat -NonNegFixnum : -true-propset : (-arg-path 1))
+       (-> -Nat -NonPosInt -NonNegFixnum : -true-propset : (-arg-path 0))
        (-> -Zero -Int -NonNegFixnum)
        (-> -Int -Zero -NonNegFixnum)
 
@@ -360,8 +360,8 @@
   (define fxior-type
     (lambda ()
       (fx-from-cases
-       (-> -Zero -Int -Fixnum : -true-filter : (-arg-path 1))
-       (-> -Int -Zero -Fixnum : -true-filter : (-arg-path 0))
+       (-> -Zero -Int -Fixnum : -true-propset : (-arg-path 1))
+       (-> -Int -Zero -Fixnum : -true-propset : (-arg-path 0))
 
        (commutative-binop -PosByte -Byte -PosByte)
        (binop -Byte)
@@ -374,8 +374,8 @@
   (define fxxor-type
     (lambda ()
       (fx-from-cases
-       (-> -Zero -Int -Fixnum : -true-filter : (-arg-path 1))
-       (-> -Int -Zero -Fixnum : -true-filter : (-arg-path 0))
+       (-> -Zero -Int -Fixnum : -true-propset : (-arg-path 1))
+       (-> -Int -Zero -Fixnum : -true-propset : (-arg-path 0))
 
        (binop -One -Zero)
        (binop -Byte)
@@ -394,7 +394,7 @@
   (define fxlshift-type
     (lambda ()
       (fx-from-cases
-       (-> -Int -Zero -Fixnum : -true-filter : (-arg-path 0))
+       (-> -Int -Zero -Fixnum : -true-propset : (-arg-path 0))
        (-> -PosInt -Int -PosFixnum) ; negative 2nd arg errors, so we can't reach 0
        (-> -Nat -Int -NonNegFixnum)
        (-> -NegInt -Int -NegFixnum)
@@ -403,7 +403,7 @@
   (define fxrshift-type
     (lambda ()
       (fx-from-cases
-       (-> -Int -Zero -Fixnum : -true-filter : (-arg-path 0))
+       (-> -Int -Zero -Fixnum : -true-propset : (-arg-path 0))
        (-> -Nat -Int -NonNegFixnum) ; can reach 0
        (-> -NegInt -Int -NegFixnum) ; can't reach 0
        (-> -NonPosInt -Int -NonPosFixnum)
@@ -495,8 +495,8 @@
                   (binop -Fl))))
   (define fl=-type
     (fl-type-lambda
-      (from-cases (commutative-equality/strict-filter -Fl (Un -FlPosZero -FlNegZero))
-                  (map (lambda (t) (commutative-equality/filter -Fl t))
+      (from-cases (commutative-equality/strict-prop -Fl (Un -FlPosZero -FlNegZero))
+                  (map (lambda (t) (commutative-equality/prop -Fl t))
                        (list -FlZero -PosFl -NonNegFl
                              -NegFl -NonPosFl))
                   (comp -Fl))))
@@ -504,30 +504,30 @@
     (fl-type-lambda
       (from-cases
        ;; false case, we know nothing, lhs may be NaN. same for all comparison that can involve floats
-       (-> -NonNegFl -Fl B : (-FS (-filter -PosFl 1) -top))
-       (-> -Fl -NonPosFl B : (-FS (-filter -NegFl 0) -top))
+       (-> -NonNegFl -Fl B : (-PS (-is-type 1 -PosFl) -tt))
+       (-> -Fl -NonPosFl B : (-PS (-is-type 0 -NegFl) -tt))
        (comp -Fl))))
   (define fl>-type
     (fl-type-lambda
       (from-cases
-       (-> -NonPosFl -Fl B : (-FS (-filter -NegFl 1) -top))
-       (-> -Fl -NonNegFl B : (-FS (-filter -PosFl 0) -top))
+       (-> -NonPosFl -Fl B : (-PS (-is-type 1 -NegFl) -tt))
+       (-> -Fl -NonNegFl B : (-PS (-is-type 0 -PosFl) -tt))
        (comp -Fl))))
   (define fl<=-type
     (fl-type-lambda
       (from-cases
-       (-> -PosFl -Fl B : (-FS (-filter -PosFl 1) -top))
-       (-> -NonNegFl -Fl B : (-FS (-filter -NonNegFl 1) -top))
-       (-> -Fl -NegFl B : (-FS (-filter -NegFl 0) -top))
-       (-> -Fl -NonPosFl B : (-FS (-filter -NonPosFl 0) -top))
+       (-> -PosFl -Fl B : (-PS (-is-type 1 -PosFl) -tt))
+       (-> -NonNegFl -Fl B : (-PS (-is-type 1 -NonNegFl) -tt))
+       (-> -Fl -NegFl B : (-PS (-is-type 0 -NegFl) -tt))
+       (-> -Fl -NonPosFl B : (-PS (-is-type 0 -NonPosFl) -tt))
        (comp -Fl))))
   (define fl>=-type
     (fl-type-lambda
       (from-cases
-       (-> -Fl -PosFl B : (-FS (-filter -PosFl 0) -top))
-       (-> -Fl -NonNegFl B : (-FS (-filter -NonNegFl 0) -top))
-       (-> -NegFl -Fl B : (-FS (-filter -NegFl 1) -top))
-       (-> -NonPosFl -Fl B : (-FS (-filter -NonPosFl 1) -top))
+       (-> -Fl -PosFl B : (-PS (-is-type 0 -PosFl) -tt))
+       (-> -Fl -NonNegFl B : (-PS (-is-type 0 -NonNegFl) -tt))
+       (-> -NegFl -Fl B : (-PS (-is-type 1 -NegFl) -tt))
+       (-> -NonPosFl -Fl B : (-PS (-is-type 1 -NonPosFl) -tt))
        (comp -Fl))))
   (define flmin-type
     (fl-type-lambda
@@ -595,44 +595,44 @@
   (define flrandom-type (lambda () (-Pseudo-Random-Generator . -> . -Flonum)))
 
   ;; There's a repetitive pattern in the types of each comparison operator.
-  ;; As explained below, this is because filters don't do intersections.
+  ;; As explained below, this is because props don't do intersections.
   (define (<-type-pattern base pos non-neg neg non-pos [zero -RealZero])
-    (list (-> base zero B : (-FS (-filter neg 0) (-filter non-neg 0)))
-          (-> zero base B : (-FS (-filter pos 1) (-filter non-pos 1)))
-          (-> base -PosReal B : (-FS -top (-filter pos 0)))
-          (-> base -NonNegReal B : (-FS -top (-filter non-neg 0)))
-          (-> -NonNegReal base B : (-FS (-filter pos 1) -top))
-          (-> base -NonPosReal B : (-FS (-filter neg 0) -top))
-          (-> -NegReal base B : (-FS -top (-filter neg 1)))
-          (-> -NonPosReal base B : (-FS -top (-filter non-pos 1)))))
+    (list (-> base zero B : (-PS (-is-type 0 neg) (-is-type 0 non-neg)))
+          (-> zero base B : (-PS (-is-type 1 pos) (-is-type 1 non-pos)))
+          (-> base -PosReal B : (-PS -tt (-is-type 0 pos)))
+          (-> base -NonNegReal B : (-PS -tt (-is-type 0 non-neg)))
+          (-> -NonNegReal base B : (-PS (-is-type 1 pos) -tt))
+          (-> base -NonPosReal B : (-PS (-is-type 0 neg) -tt))
+          (-> -NegReal base B : (-PS -tt (-is-type 1 neg)))
+          (-> -NonPosReal base B : (-PS -tt (-is-type 1 non-pos)))))
   (define (>-type-pattern base pos non-neg neg non-pos [zero -RealZero])
-    (list (-> base zero B : (-FS (-filter pos 0) (-filter non-pos 0)))
-          (-> zero base B : (-FS (-filter neg 1) (-filter non-neg 1)))
-          (-> base -NonNegReal B : (-FS (-filter pos 0) -top))
-          (-> -PosReal base B : (-FS -top (-filter pos 1)))
-          (-> -NonNegReal base B : (-FS -top (-filter non-neg 1)))
-          (-> -NonPosReal base B : (-FS (-filter neg 1) -top))
-          (-> base -NegReal B : (-FS -top (-filter neg 0)))
-          (-> base -NonPosReal B : (-FS -top (-filter non-pos 0)))))
-  ;; this is > with flipped filters
+    (list (-> base zero B : (-PS (-is-type 0 pos) (-is-type 0 non-pos)))
+          (-> zero base B : (-PS (-is-type 1 neg) (-is-type 1 non-neg)))
+          (-> base -NonNegReal B : (-PS (-is-type 0 pos) -tt))
+          (-> -PosReal base B : (-PS -tt (-is-type 1 pos)))
+          (-> -NonNegReal base B : (-PS -tt (-is-type 1 non-neg)))
+          (-> -NonPosReal base B : (-PS (-is-type 1 neg) -tt))
+          (-> base -NegReal B : (-PS -tt (-is-type 0 neg)))
+          (-> base -NonPosReal B : (-PS -tt (-is-type 0 non-pos)))))
+  ;; this is > with flipped props
   (define (<=-type-pattern base pos non-neg neg non-pos [zero -RealZero])
-    (list (-> base zero B : (-FS (-filter non-pos 0) (-filter pos 0)))
-          (-> zero base B : (-FS (-filter non-neg 1) (-filter neg 1)))
-          (-> base -NonNegReal B : (-FS -top (-filter pos 0)))
-          (-> -PosReal base B : (-FS (-filter pos 1) -top))
-          (-> -NonNegReal base B : (-FS (-filter non-neg 1) -top))
-          (-> -NonPosReal base B : (-FS -top (-filter neg 1)))
-          (-> base -NegReal B : (-FS (-filter neg 0) -top))
-          (-> base -NonPosReal B : (-FS (-filter non-pos 0) -top))))
+    (list (-> base zero B : (-PS (-is-type 0 non-pos) (-is-type 0 pos)))
+          (-> zero base B : (-PS (-is-type 1 non-neg) (-is-type 1 neg)))
+          (-> base -NonNegReal B : (-PS -tt (-is-type 0 pos)))
+          (-> -PosReal base B : (-PS (-is-type 1 pos) -tt))
+          (-> -NonNegReal base B : (-PS (-is-type 1 non-neg) -tt))
+          (-> -NonPosReal base B : (-PS -tt (-is-type 1 neg)))
+          (-> base -NegReal B : (-PS (-is-type 0 neg) -tt))
+          (-> base -NonPosReal B : (-PS (-is-type 0 non-pos) -tt))))
   (define (>=-type-pattern base pos non-neg neg non-pos [zero -RealZero])
-    (list (-> base zero B : (-FS (-filter non-neg 0) (-filter neg 0)))
-          (-> zero base B : (-FS (-filter non-pos 1) (-filter pos 1)))
-          (-> base -PosReal B : (-FS (-filter pos 0) -top))
-          (-> base -NonNegReal B : (-FS (-filter non-neg 0) -top))
-          (-> -NonNegReal base B : (-FS -top (-filter pos 1)))
-          (-> base -NonPosReal B : (-FS -top (-filter neg 0)))
-          (-> -NegReal base B : (-FS (-filter neg 1) -top))
-          (-> -NonPosReal base B : (-FS (-filter non-pos 1) -top))))
+    (list (-> base zero B : (-PS (-is-type 0 non-neg) (-is-type 0 neg)))
+          (-> zero base B : (-PS (-is-type 1 non-pos) (-is-type 1 pos)))
+          (-> base -PosReal B : (-PS (-is-type 0 pos) -tt))
+          (-> base -NonNegReal B : (-PS (-is-type 0 non-neg) -tt))
+          (-> -NonNegReal base B : (-PS -tt (-is-type 1 pos)))
+          (-> base -NonPosReal B : (-PS -tt (-is-type 0 neg)))
+          (-> -NegReal base B : (-PS (-is-type 1 neg) -tt))
+          (-> -NonPosReal base B : (-PS (-is-type 1 non-pos) -tt))))
 
   (define (negation-pattern pos neg non-neg non-pos)
     (list (-> pos neg)
@@ -654,7 +654,7 @@
   (define abs-cases ; used both for abs and magnitude
     (list
      ;; abs is not the identity on negative zeros.
-     ((Un -Zero -PosReal) . -> . (Un -Zero -PosReal) : -true-filter : (-arg-path 0))
+     ((Un -Zero -PosReal) . -> . (Un -Zero -PosReal) : -true-propset : (-arg-path 0))
      ;; but we know that we at least get *some* zero, and that it preserves exactness
      (map unop (list -FlonumZero -SingleFlonumZero -RealZero))
      ;; abs may not be closed on fixnums. (abs min-fixnum) is not a fixnum
@@ -713,12 +713,12 @@
 ;; There are 25 values that answer true to zero?. They are either reals, or inexact complexes.
 ;; Note -RealZero contains NaN and zero? returns #f on it
 [zero?
-  (-> N B : (-FS (-filter (Un -RealZeroNoNan -InexactComplex -InexactImaginary) 0)
-                 (-not-filter -RealZeroNoNan 0)))]
+  (-> N B : (-PS (-is-type 0 (Un -RealZeroNoNan -InexactComplex -InexactImaginary))
+                 (-not-type 0 -RealZeroNoNan)))]
 
 [number? (make-pred-ty N)]
-[integer? (asym-pred Univ B (-FS (-filter (Un -Int -Flonum -SingleFlonum) 0) ; inexact-integers exist...
-                                 (-not-filter -Int 0)))]
+[integer? (asym-pred Univ B (-PS (-is-type 0 (Un -Int -Flonum -SingleFlonum)) ; inexact-integers exist...
+                                 (-not-type 0 -Int)))]
 [exact-integer? (make-pred-ty -Int)]
 [real? (make-pred-ty -Real)]
 [flonum? (make-pred-ty -Flonum)]
@@ -727,78 +727,78 @@
 [inexact-real? (make-pred-ty -InexactReal)]
 [complex? (make-pred-ty N)]
 ;; `rational?' includes all Reals, except infinities and NaN.
-[rational? (asym-pred Univ B (-FS (-filter -Real 0) (-not-filter -Rat 0)))]
+[rational? (asym-pred Univ B (-PS (-is-type 0 -Real) (-not-type 0 -Rat)))]
 [exact? (make-pred-ty -ExactNumber)]
 [inexact? (make-pred-ty (Un -InexactReal -InexactImaginary -InexactComplex))]
 [fixnum? (make-pred-ty -Fixnum)]
 [index? (make-pred-ty -Index)]
-[positive? (-> -Real B : (-FS (-filter -PosReal 0) (-filter -NonPosReal 0)))]
-[negative? (-> -Real B : (-FS (-filter -NegReal 0) (-filter -NonNegReal 0)))]
+[positive? (-> -Real B : (-PS (-is-type 0 -PosReal) (-is-type 0 -NonPosReal)))]
+[negative? (-> -Real B : (-PS (-is-type 0 -NegReal) (-is-type 0 -NonNegReal)))]
 [exact-positive-integer? (make-pred-ty -Pos)]
 [exact-nonnegative-integer? (make-pred-ty -Nat)]
 
-[odd? (-> -Int B : (-FS (-not-filter -Zero 0) (-not-filter -One 0)))]
-[even? (-> -Int B : (-FS (-not-filter -One 0) (-not-filter -Zero 0)))]
+[odd? (-> -Int B : (-PS (-not-type 0 -Zero) (-not-type 0 -One)))]
+[even? (-> -Int B : (-PS (-not-type 0 -One) (-not-type 0 -Zero)))]
 
 [=
  (from-cases
-   (-> -Real -RealZero B : (-FS (-filter -RealZeroNoNan 0) (-not-filter -RealZeroNoNan 0)))
-   (-> -RealZero -Real B : (-FS (-filter -RealZeroNoNan 1) (-not-filter -RealZeroNoNan 1)))
-  (map (lambda (t) (commutative-equality/filter -ExactNumber t))
+   (-> -Real -RealZero B : (-PS (-is-type 0 -RealZeroNoNan) (-not-type 0 -RealZeroNoNan)))
+   (-> -RealZero -Real B : (-PS (-is-type 1 -RealZeroNoNan) (-not-type 1 -RealZeroNoNan)))
+  (map (lambda (t) (commutative-equality/prop -ExactNumber t))
        (list -One -PosByte -Byte -PosIndex -Index
              -PosFixnum -NonNegFixnum -NegFixnum -NonPosFixnum -Fixnum
              -PosInt -Nat -NegInt -NonPosInt -Int
              -PosRat -NonNegRat -NegRat -NonPosRat -Rat
              -ExactNumber))
-  ;; For all real types: the filters give sign information, and the exactness information is preserved
+  ;; For all real types: the props give sign information, and the exactness information is preserved
   ;; from the original types.
-  (map (lambda (t) (commutative-equality/filter -Real t))
+  (map (lambda (t) (commutative-equality/prop -Real t))
        (list -RealZero -PosReal -NonNegReal -NegReal -NonPosReal -Real))
   (->* (list N N) N B))]
 
 [<  (from-cases
-     (-> -Int -One B : (-FS (-filter -NonPosInt 0) (-filter -PosInt 0)))
-     (-> -Real -Zero B : (-FS (-filter -NegReal 0) (-filter -NonNegReal 0)))
-     (-> -Zero -Real B : (-FS (-filter -PosReal 1) (-filter -NonPosReal 1)))
-     (-> -Real -RealZero B : (-FS (-filter -NegReal 0) -top)) ;; False says nothing because of NaN
-     (-> -RealZero -Real B : (-FS (-filter -PosReal 1) -top)) ;; False says nothing because of NaN
-     (-> -Byte -PosByte B : (-FS -top (-filter -PosByte 0)))
-     (-> -Byte -Byte B : (-FS (-filter -PosByte 1) -top))
-     (-> -PosInt -Byte B : (-FS (-and (-filter -PosByte 0) (-filter -PosByte 1)) -top))
-     (-> -PosReal -Byte B : (-FS (-filter -PosByte 1) -top)) ; -PosReal is ok here, no filter for #f
-     (-> -Byte -PosInt B : (-FS -top (-and (-filter -PosByte 0) (-filter -PosByte 1))))
-     (-> -Byte -PosRat B : (-FS -top (-filter -PosByte 0))) ; can't be -PosReal, which includes NaN
-     (-> -Nat -Byte B : (-FS (-and (-filter -Byte 0) (-filter -PosByte 1)) -top))
-     (-> -NonNegReal -Byte B : (-FS (-filter -PosByte 1) -top))
-     (-> -Byte -Nat B : (-FS -top (-filter -Byte 1)))
-     (-> -Index -PosIndex B : (-FS -top (-filter -PosIndex 0)))
-     (-> -Index -Index B : (-FS (-filter -PosIndex 1) -top))
-     (-> -PosInt -Index B : (-FS (-and (-filter -PosIndex 0) (-filter -PosIndex 1)) -top))
-     (-> -PosReal -Index B : (-FS (-filter -PosIndex 1) -top))
-     (-> -Index -PosInt B : (-FS -top (-and (-filter -PosIndex 0) (-filter -PosIndex 1))))
-     (-> -Index -PosRat B : (-FS -top (-filter -PosIndex 0))) ; can't be -PosReal, which includes NaN
-     (-> -Nat -Index B : (-FS (-and (-filter -Index 0) (-filter -PosIndex 1)) -top))
-     (-> -NonNegReal -Index B : (-FS (-filter -PosIndex 1) -top))
-     (-> -Index -Nat B : (-FS -top (-filter -Index 1)))
-     (-> -Fixnum -PosInt B : (-FS -top (-and (-filter -PosFixnum 0) (-filter -PosFixnum 1))))
-     (-> -Fixnum -PosRat B : (-FS -top (-filter -PosFixnum 0)))
-     (-> -Fixnum -Nat B : (-FS -top (-and (-filter -NonNegFixnum 0) (-filter -NonNegFixnum 1))))
-     (-> -Fixnum -NonNegRat B : (-FS -top (-filter -NonNegFixnum 0)))
-     (-> -Nat -Fixnum B : (-FS (-and (-filter -PosFixnum 1) (-filter -NonNegFixnum 0)) -top))
-     (-> -NonNegReal -Fixnum B : (-FS (-filter -PosFixnum 1) -top))
-     (-> -Fixnum -NonPosInt B : (-FS (-and (-filter -NegFixnum 0) (-filter -NonPosFixnum 1)) -top))
-     (-> -Fixnum -NonPosReal B : (-FS (-filter -NegFixnum 0) -top))
-     (-> -NegInt -Fixnum B : (-FS -top (-and (-filter -NegFixnum 0) (-filter -NegFixnum 1))))
-     (-> -NegRat -Fixnum B : (-FS -top (-filter -NegFixnum 1)))
-     (-> -NonPosInt -Fixnum B : (-FS -top (-and (-filter -NonPosFixnum 0) (-filter -NonPosFixnum 1))))
-     (-> -NonPosRat -Fixnum B : (-FS -top (-filter -NonPosFixnum 1)))
-     (-> -Real -PosInfinity B : (-FS (-not-filter (Un -InexactRealNan -PosInfinity) 0)
-                                     (-filter (Un -InexactRealNan -PosInfinity) 0)))
-     (-> -NegInfinity -Real B : (-FS (-not-filter (Un -InexactRealNan -NegInfinity) 1)
-                                     (-filter (Un -InexactRealNan -NegInfinity) 1)))
-     (-> -PosInfinity -Real B : -false-filter)
-     (-> -Real -NegInfinity B : -false-filter)
-     ;; If applying filters resulted in the interesection of the filter and the
+     (-> -Int -One B : (-PS (-is-type 0 -NonPosInt) (-is-type 0 -PosInt)))
+     (-> -Real -Zero B : (-PS (-is-type 0 -NegReal) (-is-type 0 -NonNegReal)))
+     (-> -Zero -Real B : (-PS (-is-type 1 -PosReal) (-is-type 1 -NonPosReal)))
+     (-> -Real -RealZero B : (-PS (-is-type 0 -NegReal) -tt)) ;; False says nothing because of NaN
+     (-> -RealZero -Real B : (-PS (-is-type 1 -PosReal) -tt)) ;; False says nothing because of NaN
+     (-> -Byte -PosByte B : (-PS -tt (-is-type 0 -PosByte)))
+     (-> -Byte -Byte B : (-PS (-is-type 1 -PosByte) -tt))
+     (-> -PosInt -Byte B : (-PS (-and (-is-type 0 -PosByte) (-is-type 1 -PosByte)) -tt))
+     (-> -PosReal -Byte B : (-PS (-is-type 1 -PosByte) -tt)) ; -PosReal is ok here, no prop for #f
+     (-> -Byte -PosInt B : (-PS -tt (-and (-is-type 0 -PosByte) (-is-type 1 -PosByte))))
+     (-> -Byte -PosRat B : (-PS -tt (-is-type 0 -PosByte))) ; can't be -PosReal, which includes NaN
+     (-> -Nat -Byte B : (-PS (-and (-is-type 0 -Byte) (-is-type 1 -PosByte)) -tt))
+     (-> -NonNegReal -Byte B : (-PS (-is-type 1 -PosByte) -tt))
+     (-> -Byte -Nat B : (-PS -tt (-is-type 1 -Byte)))
+     (-> -Index -PosIndex B : (-PS -tt (-is-type 0 -PosIndex)))
+     (-> -Index -Index B : (-PS (-is-type 1 -PosIndex) -tt))
+     (-> -PosInt -Index B : (-PS (-and (-is-type 0 -PosIndex) (-is-type 1 -PosIndex)) -tt))
+     (-> -PosReal -Index B : (-PS (-is-type 1 -PosIndex) -tt))
+     (-> -Index -PosInt B : (-PS -tt (-and (-is-type 0 -PosIndex) (-is-type 1 -PosIndex))))
+     (-> -Index -PosRat B : (-PS -tt (-is-type 0 -PosIndex))) ; can't be -PosReal, which includes NaN
+     (-> -Nat -Index B : (-PS (-and (-is-type 0 -Index) (-is-type 1 -PosIndex)) -tt))
+     (-> -NonNegReal -Index B : (-PS (-is-type 1 -PosIndex) -tt))
+     (-> -Index -Nat B : (-PS -tt (-is-type 1 -Index)))
+     (-> -Fixnum -PosInt B : (-PS -tt (-and (-is-type 0 -PosFixnum) (-is-type 1 -PosFixnum))))
+     (-> -Fixnum -PosRat B : (-PS -tt (-is-type 0 -PosFixnum)))
+     (-> -Fixnum -Nat B : (-PS -tt (-and (-is-type 0 -NonNegFixnum) (-is-type 1 -NonNegFixnum))))
+     (-> -Fixnum -NonNegRat B : (-PS -tt (-is-type 0 -NonNegFixnum)))
+     (-> -Nat -Fixnum B : (-PS (-and (-is-type 1 -PosFixnum) (-is-type 0 -NonNegFixnum)) -tt))
+     (-> -NonNegReal -Fixnum B : (-PS (-is-type 1 -PosFixnum) -tt))
+     (-> -Fixnum -NonPosInt B : (-PS (-and (-is-type 0 -NegFixnum) (-is-type 1 -NonPosFixnum)) -tt))
+     (-> -Fixnum -NonPosReal B : (-PS (-is-type 0 -NegFixnum) -tt))
+     (-> -NegInt -Fixnum B : (-PS -tt (-and (-is-type 0 -NegFixnum) (-is-type 1 -NegFixnum))))
+     (-> -NegRat -Fixnum B : (-PS -tt (-is-type 1 -NegFixnum)))
+     (-> -NonPosInt -Fixnum B : (-PS -tt (-and (-is-type 0 -NonPosFixnum) (-is-type 1 -NonPosFixnum))))
+     (-> -NonPosRat -Fixnum B : (-PS -tt (-is-type 1 -NonPosFixnum)))
+     (-> -Real -PosInfinity B : (-PS (-not-type 0 (Un -InexactRealNan -PosInfinity))
+                                     (-is-type 0 (Un -InexactRealNan -PosInfinity))))
+     (-> -NegInfinity -Real B : (-PS (-not-type 1 (Un -InexactRealNan -NegInfinity))
+                                     (-is-type 1 (Un -InexactRealNan -NegInfinity))))
+     (-> -PosInfinity -Real B : -false-propset)
+     (-> -Real -NegInfinity B : -false-propset)
+     ;; If applying props resulted in the interesection of the prop and the
      ;; original type, we'd only need the cases for Fixnums and those for Reals.
      ;; Cases for Integers and co would fall out naturally from the Real cases,
      ;; since we'd keep track of the representation knowledge we'd already have,
@@ -812,47 +812,47 @@
      (<-type-pattern -Real -PosReal -NonNegReal -NegReal -NonPosReal)
      (->* (list R R) R B))]
 [>  (from-cases
-     (-> -One -Int B : (-FS (-filter -NonPosInt 1) (-filter -PosInt 1)))
-     (-> -Real -Zero B : (-FS (-filter -PosReal 0) (-filter -NonPosReal 0)))
-     (-> -Zero -Real B : (-FS (-filter -NegReal 1) (-filter -NonNegReal 1)))
-     (-> -Real -RealZero B : (-FS (-filter -PosReal 0) -top)) ;; False says nothing because of NaN
-     (-> -RealZero -Real B : (-FS (-filter -NegReal 1) -top)) ;; False says nothing because of NaN
-     (-> -PosByte -Byte B : (-FS -top (-filter -PosByte 1)))
-     (-> -Byte -Byte B : (-FS (-filter -PosByte 0) -top))
-     (-> -Byte -PosInt B : (-FS (-and (-filter -PosByte 0) (-filter -PosByte 1)) -top))
-     (-> -Byte -PosReal B : (-FS (-filter -PosByte 0) -top))
-     (-> -PosInt -Byte B : (-FS -top (-and (-filter -PosByte 0) (-filter -PosByte 1))))
-     (-> -PosRat -Byte B : (-FS -top (-filter -PosByte 1)))
-     (-> -Byte -Nat B : (-FS (-and (-filter -PosByte 0) (-filter -Byte 1)) -top))
-     (-> -Byte -NonNegReal B : (-FS (-filter -PosByte 0) -top))
-     (-> -Nat -Byte B : (-FS -top (-filter -Byte 0)))
-     (-> -PosIndex -Index B : (-FS -top (-filter -PosIndex 1)))
-     (-> -Index -Index B : (-FS (-filter -PosIndex 0) -top))
-     (-> -Index -PosInt B : (-FS (-and (-filter -PosIndex 0) (-filter -PosIndex 1)) -top))
-     (-> -Index -PosReal B : (-FS (-filter -PosIndex 0) -top))
-     (-> -PosInt -Index B : (-FS -top (-and (-filter -PosIndex 0) (-filter -PosIndex 1))))
-     (-> -PosRat -Index B : (-FS -top (-filter -PosIndex 1)))
-     (-> -Index -Nat B : (-FS (-and (-filter -PosIndex 0) (-filter -Index 1)) -top))
-     (-> -Index -NonNegReal B : (-FS (-filter -PosIndex 0) -top))
-     (-> -Nat -Index B : (-FS -top (-filter -Index 0)))
-     (-> -PosInt -Fixnum B : (-FS -top (-and (-filter -PosFixnum 0) (-filter -PosFixnum 1))))
-     (-> -PosRat -Fixnum B : (-FS -top (-filter -PosFixnum 1)))
-     (-> -Nat -Fixnum B : (-FS -top (-and (-filter -NonNegFixnum 0) (-filter -NonNegFixnum 1))))
-     (-> -NonNegRat -Fixnum B : (-FS -top (-filter -NonNegFixnum 1)))
-     (-> -Fixnum -Nat B : (-FS (-and (-filter -PosFixnum 0) (-filter -NonNegFixnum 1)) -top))
-     (-> -Fixnum -NonNegReal B : (-FS (-filter -PosFixnum 0) -top))
-     (-> -NonPosInt -Fixnum B : (-FS (-and (-filter -NonPosFixnum 0) (-filter -NegFixnum 1)) -top))
-     (-> -NonPosReal -Fixnum B : (-FS (-filter -NegFixnum 1) -top))
-     (-> -Fixnum -NegInt B : (-FS -top (-and (-filter -NegFixnum 0) (-filter -NegFixnum 1))))
-     (-> -Fixnum -NegRat B : (-FS -top (-filter -NegFixnum 0)))
-     (-> -Fixnum -NonPosInt B : (-FS -top (-and (-filter -NonPosFixnum 0) (-filter -NonPosFixnum 1))))
-     (-> -Fixnum -NonPosRat B : (-FS -top (-filter -NonPosFixnum 0)))
-     (-> -PosInfinity -Real B : (-FS (-not-filter (Un -InexactRealNan -PosInfinity) 1)
-                                     (-filter (Un -InexactRealNan -PosInfinity) 1)))
-     (-> -Real -NegInfinity B : (-FS (-not-filter (Un -InexactRealNan -NegInfinity) 0)
-                                     (-filter (Un -InexactRealNan -NegInfinity) 0)))
-     (-> -Real -PosInfinity B : -false-filter)
-     (-> -NegInfinity -Real B : -false-filter)
+     (-> -One -Int B : (-PS (-is-type 1 -NonPosInt) (-is-type 1 -PosInt)))
+     (-> -Real -Zero B : (-PS (-is-type 0 -PosReal) (-is-type 0 -NonPosReal)))
+     (-> -Zero -Real B : (-PS (-is-type 1 -NegReal) (-is-type 1 -NonNegReal)))
+     (-> -Real -RealZero B : (-PS (-is-type 0 -PosReal) -tt)) ;; False says nothing because of NaN
+     (-> -RealZero -Real B : (-PS (-is-type 1 -NegReal) -tt)) ;; False says nothing because of NaN
+     (-> -PosByte -Byte B : (-PS -tt (-is-type 1 -PosByte)))
+     (-> -Byte -Byte B : (-PS (-is-type 0 -PosByte) -tt))
+     (-> -Byte -PosInt B : (-PS (-and (-is-type 0 -PosByte) (-is-type 1 -PosByte)) -tt))
+     (-> -Byte -PosReal B : (-PS (-is-type 0 -PosByte) -tt))
+     (-> -PosInt -Byte B : (-PS -tt (-and (-is-type 0 -PosByte) (-is-type 1 -PosByte))))
+     (-> -PosRat -Byte B : (-PS -tt (-is-type 1 -PosByte)))
+     (-> -Byte -Nat B : (-PS (-and (-is-type 0 -PosByte) (-is-type 1 -Byte)) -tt))
+     (-> -Byte -NonNegReal B : (-PS (-is-type 0 -PosByte) -tt))
+     (-> -Nat -Byte B : (-PS -tt (-is-type 0 -Byte)))
+     (-> -PosIndex -Index B : (-PS -tt (-is-type 1 -PosIndex)))
+     (-> -Index -Index B : (-PS (-is-type 0 -PosIndex) -tt))
+     (-> -Index -PosInt B : (-PS (-and (-is-type 0 -PosIndex) (-is-type 1 -PosIndex)) -tt))
+     (-> -Index -PosReal B : (-PS (-is-type 0 -PosIndex) -tt))
+     (-> -PosInt -Index B : (-PS -tt (-and (-is-type 0 -PosIndex) (-is-type 1 -PosIndex))))
+     (-> -PosRat -Index B : (-PS -tt (-is-type 1 -PosIndex)))
+     (-> -Index -Nat B : (-PS (-and (-is-type 0 -PosIndex) (-is-type 1 -Index)) -tt))
+     (-> -Index -NonNegReal B : (-PS (-is-type 0 -PosIndex) -tt))
+     (-> -Nat -Index B : (-PS -tt (-is-type 0 -Index)))
+     (-> -PosInt -Fixnum B : (-PS -tt (-and (-is-type 0 -PosFixnum) (-is-type 1 -PosFixnum))))
+     (-> -PosRat -Fixnum B : (-PS -tt (-is-type 1 -PosFixnum)))
+     (-> -Nat -Fixnum B : (-PS -tt (-and (-is-type 0 -NonNegFixnum) (-is-type 1 -NonNegFixnum))))
+     (-> -NonNegRat -Fixnum B : (-PS -tt (-is-type 1 -NonNegFixnum)))
+     (-> -Fixnum -Nat B : (-PS (-and (-is-type 0 -PosFixnum) (-is-type 1 -NonNegFixnum)) -tt))
+     (-> -Fixnum -NonNegReal B : (-PS (-is-type 0 -PosFixnum) -tt))
+     (-> -NonPosInt -Fixnum B : (-PS (-and (-is-type 0 -NonPosFixnum) (-is-type 1 -NegFixnum)) -tt))
+     (-> -NonPosReal -Fixnum B : (-PS (-is-type 1 -NegFixnum) -tt))
+     (-> -Fixnum -NegInt B : (-PS -tt (-and (-is-type 0 -NegFixnum) (-is-type 1 -NegFixnum))))
+     (-> -Fixnum -NegRat B : (-PS -tt (-is-type 0 -NegFixnum)))
+     (-> -Fixnum -NonPosInt B : (-PS -tt (-and (-is-type 0 -NonPosFixnum) (-is-type 1 -NonPosFixnum))))
+     (-> -Fixnum -NonPosRat B : (-PS -tt (-is-type 0 -NonPosFixnum)))
+     (-> -PosInfinity -Real B : (-PS (-not-type 1 (Un -InexactRealNan -PosInfinity))
+                                     (-is-type 1 (Un -InexactRealNan -PosInfinity))))
+     (-> -Real -NegInfinity B : (-PS (-not-type 0 (Un -InexactRealNan -NegInfinity))
+                                     (-is-type 0 (Un -InexactRealNan -NegInfinity))))
+     (-> -Real -PosInfinity B : -false-propset)
+     (-> -NegInfinity -Real B : -false-propset)
      (>-type-pattern -Int -PosInt -Nat -NegInt -NonPosInt -Zero)
      (>-type-pattern -Rat -PosRat -NonNegRat -NegRat -NonPosRat -Zero)
      (>-type-pattern -Flonum -PosFlonum -NonNegFlonum -NegFlonum -NonPosFlonum)
@@ -861,46 +861,46 @@
      (>-type-pattern -Real -PosReal -NonNegReal -NegReal -NonPosReal)
      (->* (list R R) R B))]
 [<= (from-cases
-     (-> -Int -One B : (-FS (-filter (Un -NonPosInt -One) 0) (-filter -PosInt 0)))
-     (-> -One -Int B : (-FS (-filter -PosInt 1) (-filter -NonPosInt 1)))
-     (-> -Real -Zero B : (-FS (-filter -NonPosReal 0) (-filter -PosReal 0)))
-     (-> -Zero -Real B : (-FS (-filter -NonNegReal 1) (-filter -NegReal 1)))
-     (-> -Real -RealZero B : (-FS (-filter -NonPosReal 0) -top)) ;; False says nothing because of NaN
-     (-> -RealZero -Real B : (-FS (-filter -NonNegReal 0) -top)) ;; False says nothing because of NaN
-     (-> -PosByte -Byte B : (-FS (-filter -PosByte 1) -top))
-     (-> -Byte -Byte B : (-FS -top (-filter -PosByte 0)))
-     (-> -PosInt -Byte B : (-FS (-and (-filter -PosByte 0) (-filter -PosByte 1)) -top))
-     (-> -PosReal -Byte B : (-FS (-filter -PosByte 1) -top))
-     (-> -Byte -PosInt B : (-FS -top (-and (-filter -PosByte 0) (-filter -PosByte 1))))
-     (-> -Byte -PosRat B : (-FS -top (-filter -PosByte 0)))
-     (-> -Nat -Byte B : (-FS (-filter -Byte 0) -top))
-     (-> -Byte -Nat B : (-FS -top (-and (-filter -PosByte 0) (-filter -Byte 1))))
-     (-> -Byte -NonNegRat B : (-FS -top (-filter -PosByte 0)))
-     (-> -PosIndex -Index B : (-FS (-filter -PosIndex 1) -top))
-     (-> -Index -Index B : (-FS -top (-filter -PosIndex 0)))
-     (-> -Pos -Index B : (-FS (-and (-filter -PosIndex 0) (-filter -PosIndex 1)) -top))
-     (-> -PosReal -Index B : (-FS (-filter -PosIndex 1) -top))
-     (-> -Index -Pos B : (-FS -top (-and (-filter -PosIndex 0) (-filter -PosIndex 1))))
-     (-> -Index -PosRat B : (-FS -top (-filter -PosIndex 0)))
-     (-> -Nat -Index B : (-FS (-filter -Index 0) -top))
-     (-> -Index -Nat B : (-FS -top (-and (-filter -PosIndex 0) (-filter -Index 1))))
-     (-> -Index -NonNegRat B : (-FS -top (-filter -PosIndex 0)))
-     (-> -PosInt -Fixnum B : (-FS (-and (-filter -PosFixnum 0) (-filter -PosFixnum 1)) -top))
-     (-> -PosReal -Fixnum B : (-FS (-filter -PosFixnum 1) -top))
-     (-> -Nat -Fixnum B : (-FS (-and (-filter -NonNegFixnum 0) (-filter -NonNegFixnum 1)) -top))
-     (-> -NonNegReal -Fixnum B : (-FS (-filter -NonNegFixnum 1) -top))
-     (-> -Fixnum -Nat B : (-FS -top (-and (-filter -PosFixnum 0) (-filter -NonNegFixnum 1))))
-     (-> -Fixnum -NonNegRat B : (-FS -top (-filter -PosFixnum 0)))
-     (-> -NonPosInt -Fixnum B : (-FS -top (-and (-filter -NonPosFixnum 0) (-filter -NegFixnum 1))))
-     (-> -NonPosRat -Fixnum B : (-FS -top (-filter -NegFixnum 1)))
-     (-> -Fixnum -NegInt B : (-FS (-and (-filter -NegFixnum 0) (-filter -NegFixnum 1)) -top))
-     (-> -Fixnum -NegReal B : (-FS (-filter -NegFixnum 0) -top))
-     (-> -Fixnum -NonPosInt B : (-FS (-and (-filter -NonPosFixnum 0) (-filter -NonPosFixnum 1)) -top))
-     (-> -Fixnum -NonPosReal B : (-FS (-filter -NonPosFixnum 0) -top))
-     (-> -Real -PosInfinity B : (-FS (-not-filter -InexactRealNan 0) (-filter -InexactRealNan 0)))
-     (-> -NegInfinity -Real B : (-FS (-not-filter -InexactRealNan 1) (-filter -InexactRealNan 1)))
-     (-> -PosInfinity -Real B : (-FS (-filter -PosInfinity 1) (-not-filter -PosInfinity 1)))
-     (-> -Real -NegInfinity B : (-FS (-filter -NegInfinity 0) (-not-filter -NegInfinity 0)))
+     (-> -Int -One B : (-PS (-is-type 0 (Un -NonPosInt -One)) (-is-type 0 -PosInt)))
+     (-> -One -Int B : (-PS (-is-type 1 -PosInt) (-is-type 1 -NonPosInt)))
+     (-> -Real -Zero B : (-PS (-is-type 0 -NonPosReal) (-is-type 0 -PosReal)))
+     (-> -Zero -Real B : (-PS (-is-type 1 -NonNegReal) (-is-type 1 -NegReal)))
+     (-> -Real -RealZero B : (-PS (-is-type 0 -NonPosReal) -tt)) ;; False says nothing because of NaN
+     (-> -RealZero -Real B : (-PS (-is-type 0 -NonNegReal) -tt)) ;; False says nothing because of NaN
+     (-> -PosByte -Byte B : (-PS (-is-type 1 -PosByte) -tt))
+     (-> -Byte -Byte B : (-PS -tt (-is-type 0 -PosByte)))
+     (-> -PosInt -Byte B : (-PS (-and (-is-type 0 -PosByte) (-is-type 1 -PosByte)) -tt))
+     (-> -PosReal -Byte B : (-PS (-is-type 1 -PosByte) -tt))
+     (-> -Byte -PosInt B : (-PS -tt (-and (-is-type 0 -PosByte) (-is-type 1 -PosByte))))
+     (-> -Byte -PosRat B : (-PS -tt (-is-type 0 -PosByte)))
+     (-> -Nat -Byte B : (-PS (-is-type 0 -Byte) -tt))
+     (-> -Byte -Nat B : (-PS -tt (-and (-is-type 0 -PosByte) (-is-type 1 -Byte))))
+     (-> -Byte -NonNegRat B : (-PS -tt (-is-type 0 -PosByte)))
+     (-> -PosIndex -Index B : (-PS (-is-type 1 -PosIndex) -tt))
+     (-> -Index -Index B : (-PS -tt (-is-type 0 -PosIndex)))
+     (-> -Pos -Index B : (-PS (-and (-is-type 0 -PosIndex) (-is-type 1 -PosIndex)) -tt))
+     (-> -PosReal -Index B : (-PS (-is-type 1 -PosIndex) -tt))
+     (-> -Index -Pos B : (-PS -tt (-and (-is-type 0 -PosIndex) (-is-type 1 -PosIndex))))
+     (-> -Index -PosRat B : (-PS -tt (-is-type 0 -PosIndex)))
+     (-> -Nat -Index B : (-PS (-is-type 0 -Index) -tt))
+     (-> -Index -Nat B : (-PS -tt (-and (-is-type 0 -PosIndex) (-is-type 1 -Index))))
+     (-> -Index -NonNegRat B : (-PS -tt (-is-type 0 -PosIndex)))
+     (-> -PosInt -Fixnum B : (-PS (-and (-is-type 0 -PosFixnum) (-is-type 1 -PosFixnum)) -tt))
+     (-> -PosReal -Fixnum B : (-PS (-is-type 1 -PosFixnum) -tt))
+     (-> -Nat -Fixnum B : (-PS (-and (-is-type 0 -NonNegFixnum) (-is-type 1 -NonNegFixnum)) -tt))
+     (-> -NonNegReal -Fixnum B : (-PS (-is-type 1 -NonNegFixnum) -tt))
+     (-> -Fixnum -Nat B : (-PS -tt (-and (-is-type 0 -PosFixnum) (-is-type 1 -NonNegFixnum))))
+     (-> -Fixnum -NonNegRat B : (-PS -tt (-is-type 0 -PosFixnum)))
+     (-> -NonPosInt -Fixnum B : (-PS -tt (-and (-is-type 0 -NonPosFixnum) (-is-type 1 -NegFixnum))))
+     (-> -NonPosRat -Fixnum B : (-PS -tt (-is-type 1 -NegFixnum)))
+     (-> -Fixnum -NegInt B : (-PS (-and (-is-type 0 -NegFixnum) (-is-type 1 -NegFixnum)) -tt))
+     (-> -Fixnum -NegReal B : (-PS (-is-type 0 -NegFixnum) -tt))
+     (-> -Fixnum -NonPosInt B : (-PS (-and (-is-type 0 -NonPosFixnum) (-is-type 1 -NonPosFixnum)) -tt))
+     (-> -Fixnum -NonPosReal B : (-PS (-is-type 0 -NonPosFixnum) -tt))
+     (-> -Real -PosInfinity B : (-PS (-not-type 0 -InexactRealNan) (-is-type 0 -InexactRealNan)))
+     (-> -NegInfinity -Real B : (-PS (-not-type 1 -InexactRealNan) (-is-type 1 -InexactRealNan)))
+     (-> -PosInfinity -Real B : (-PS (-is-type 1 -PosInfinity) (-not-type 1 -PosInfinity)))
+     (-> -Real -NegInfinity B : (-PS (-is-type 0 -NegInfinity) (-not-type 0 -NegInfinity)))
      (<=-type-pattern -Int -PosInt -Nat -NegInt -NonPosInt -Zero)
      (<=-type-pattern -Rat -PosRat -NonNegRat -NegRat -NonPosRat -Zero)
      (<=-type-pattern -Flonum -PosFlonum -NonNegFlonum -NegFlonum -NonPosFlonum)
@@ -909,46 +909,46 @@
      (<=-type-pattern -Real -PosReal -NonNegReal -NegReal -NonPosReal)
      (->* (list R R) R B))]
 [>= (from-cases
-     (-> -One -Int B : (-FS (-filter (Un -One -NonPosInt) 1) (-filter -PosInt 1)))
-     (-> -Int -One B : (-FS (-filter -PosInt 0) (-filter -NonPosInt 0)))
-     (-> -Real -Zero B : (-FS (-filter -NonNegReal 0) (-filter -NegReal 0)))
-     (-> -Zero -Real B : (-FS (-filter -NonPosReal 1) (-filter -PosReal 1)))
-     (-> -Real -RealZero B : (-FS (-filter -NonNegReal 0) -top)) ;; False says nothing because of NaN
-     (-> -RealZero -Real B : (-FS (-filter -NonPosReal 0) -top)) ;; False says nothing because of NaN
-     (-> -Byte -PosByte B : (-FS (-filter -PosByte 0) -top))
-     (-> -Byte -Byte B : (-FS -top (-filter -PosByte 1)))
-     (-> -Byte -PosInt B : (-FS (-and (-filter -PosByte 0) (-filter -PosByte 1)) -top))
-     (-> -Byte -PosReal B : (-FS (-filter -PosByte 0) -top))
-     (-> -PosInt -Byte B : (-FS -top (-and (-filter -PosByte 0) (-filter -PosByte 1))))
-     (-> -PosRat -Byte B : (-FS -top (-filter -PosByte 1)))
-     (-> -Byte -Nat B : (-FS (-filter -Byte 1) -top))
-     (-> -Nat -Byte B : (-FS -top (-and (-filter -Byte 0) (-filter -PosByte 1))))
-     (-> -NonNegRat -Byte B : (-FS -top (-filter -PosByte 1)))
-     (-> -Index -PosIndex B : (-FS (-filter -PosIndex 0) -top))
-     (-> -Index -Index B : (-FS -top (-filter -PosIndex 1)))
-     (-> -Index -Pos B : (-FS (-and (-filter -PosIndex 0) (-filter -PosIndex 1)) -top))
-     (-> -Index -PosReal B : (-FS (-filter -PosIndex 0) -top))
-     (-> -Pos -Index B : (-FS -top (-and (-filter -PosIndex 0) (-filter -PosIndex 1))))
-     (-> -PosRat -Index B : (-FS -top (-filter -PosIndex 1)))
-     (-> -Index -Nat B : (-FS (-filter -Index 1) -top))
-     (-> -Nat -Index B : (-FS -top (-and (-filter -Index 0) (-filter -PosIndex 1))))
-     (-> -NonNegRat -Index B : (-FS -top (-filter -PosIndex 1)))
-     (-> -Fixnum -PosInt B : (-FS (-and (-filter -PosFixnum 0) (-filter -PosFixnum 1)) -top))
-     (-> -Fixnum -PosReal B : (-FS (-filter -PosFixnum 0) -top))
-     (-> -Fixnum -Nat B : (-FS (-and (-filter -NonNegFixnum 0) (-filter -NonNegFixnum 1)) -top))
-     (-> -Fixnum -NonNegReal B : (-FS (-filter -NonNegFixnum 0) -top))
-     (-> -Nat -Fixnum B : (-FS -top (-and (-filter -NonNegFixnum 0) (-filter -PosFixnum 1))))
-     (-> -NonNegRat -Fixnum B : (-FS -top (-filter -PosFixnum 1)))
-     (-> -Fixnum -NonPosInt B : (-FS -top (-and (-filter -NegFixnum 0) (-filter -NonPosFixnum 1))))
-     (-> -Fixnum -NonPosRat B : (-FS -top (-filter -NegFixnum 0)))
-     (-> -NegInt -Fixnum B : (-FS (-and (-filter -NegFixnum 0) (-filter -NegFixnum 1)) -top))
-     (-> -NegReal -Fixnum B : (-FS (-filter -NegFixnum 1) -top))
-     (-> -NonPosInt -Fixnum B : (-FS (-and (-filter -NonPosFixnum 0) (-filter -NonPosFixnum 1)) -top))
-     (-> -NonPosReal -Fixnum B : (-FS (-filter -NonPosFixnum 1) -top))
-     (-> -PosInfinity -Real B : (-FS (-not-filter -InexactRealNan 1) (-filter -InexactRealNan 1)))
-     (-> -Real -NegInfinity B : (-FS (-not-filter -InexactRealNan 0) (-filter -InexactRealNan 0)))
-     (-> -Real -PosInfinity B : (-FS (-filter -PosInfinity 0) (-not-filter -PosInfinity 0)))
-     (-> -NegInfinity -Real B : (-FS (-filter -NegInfinity 1) (-not-filter -NegInfinity 1)))
+     (-> -One -Int B : (-PS (-is-type 1 (Un -One -NonPosInt)) (-is-type 1 -PosInt)))
+     (-> -Int -One B : (-PS (-is-type 0 -PosInt) (-is-type 0 -NonPosInt)))
+     (-> -Real -Zero B : (-PS (-is-type 0 -NonNegReal) (-is-type 0 -NegReal)))
+     (-> -Zero -Real B : (-PS (-is-type 1 -NonPosReal) (-is-type 1 -PosReal)))
+     (-> -Real -RealZero B : (-PS (-is-type 0 -NonNegReal) -tt)) ;; False says nothing because of NaN
+     (-> -RealZero -Real B : (-PS (-is-type 0 -NonPosReal) -tt)) ;; False says nothing because of NaN
+     (-> -Byte -PosByte B : (-PS (-is-type 0 -PosByte) -tt))
+     (-> -Byte -Byte B : (-PS -tt (-is-type 1 -PosByte)))
+     (-> -Byte -PosInt B : (-PS (-and (-is-type 0 -PosByte) (-is-type 1 -PosByte)) -tt))
+     (-> -Byte -PosReal B : (-PS (-is-type 0 -PosByte) -tt))
+     (-> -PosInt -Byte B : (-PS -tt (-and (-is-type 0 -PosByte) (-is-type 1 -PosByte))))
+     (-> -PosRat -Byte B : (-PS -tt (-is-type 1 -PosByte)))
+     (-> -Byte -Nat B : (-PS (-is-type 1 -Byte) -tt))
+     (-> -Nat -Byte B : (-PS -tt (-and (-is-type 0 -Byte) (-is-type 1 -PosByte))))
+     (-> -NonNegRat -Byte B : (-PS -tt (-is-type 1 -PosByte)))
+     (-> -Index -PosIndex B : (-PS (-is-type 0 -PosIndex) -tt))
+     (-> -Index -Index B : (-PS -tt (-is-type 1 -PosIndex)))
+     (-> -Index -Pos B : (-PS (-and (-is-type 0 -PosIndex) (-is-type 1 -PosIndex)) -tt))
+     (-> -Index -PosReal B : (-PS (-is-type 0 -PosIndex) -tt))
+     (-> -Pos -Index B : (-PS -tt (-and (-is-type 0 -PosIndex) (-is-type 1 -PosIndex))))
+     (-> -PosRat -Index B : (-PS -tt (-is-type 1 -PosIndex)))
+     (-> -Index -Nat B : (-PS (-is-type 1 -Index) -tt))
+     (-> -Nat -Index B : (-PS -tt (-and (-is-type 0 -Index) (-is-type 1 -PosIndex))))
+     (-> -NonNegRat -Index B : (-PS -tt (-is-type 1 -PosIndex)))
+     (-> -Fixnum -PosInt B : (-PS (-and (-is-type 0 -PosFixnum) (-is-type 1 -PosFixnum)) -tt))
+     (-> -Fixnum -PosReal B : (-PS (-is-type 0 -PosFixnum) -tt))
+     (-> -Fixnum -Nat B : (-PS (-and (-is-type 0 -NonNegFixnum) (-is-type 1 -NonNegFixnum)) -tt))
+     (-> -Fixnum -NonNegReal B : (-PS (-is-type 0 -NonNegFixnum) -tt))
+     (-> -Nat -Fixnum B : (-PS -tt (-and (-is-type 0 -NonNegFixnum) (-is-type 1 -PosFixnum))))
+     (-> -NonNegRat -Fixnum B : (-PS -tt (-is-type 1 -PosFixnum)))
+     (-> -Fixnum -NonPosInt B : (-PS -tt (-and (-is-type 0 -NegFixnum) (-is-type 1 -NonPosFixnum))))
+     (-> -Fixnum -NonPosRat B : (-PS -tt (-is-type 0 -NegFixnum)))
+     (-> -NegInt -Fixnum B : (-PS (-and (-is-type 0 -NegFixnum) (-is-type 1 -NegFixnum)) -tt))
+     (-> -NegReal -Fixnum B : (-PS (-is-type 1 -NegFixnum) -tt))
+     (-> -NonPosInt -Fixnum B : (-PS (-and (-is-type 0 -NonPosFixnum) (-is-type 1 -NonPosFixnum)) -tt))
+     (-> -NonPosReal -Fixnum B : (-PS (-is-type 1 -NonPosFixnum) -tt))
+     (-> -PosInfinity -Real B : (-PS (-not-type 1 -InexactRealNan) (-is-type 1 -InexactRealNan)))
+     (-> -Real -NegInfinity B : (-PS (-not-type 0 -InexactRealNan) (-is-type 0 -InexactRealNan)))
+     (-> -Real -PosInfinity B : (-PS (-is-type 0 -PosInfinity) (-not-type 0 -PosInfinity)))
+     (-> -NegInfinity -Real B : (-PS (-is-type 1 -NegInfinity) (-not-type 1 -NegInfinity)))
      (>=-type-pattern -Int -PosInt -Nat -NegInt -NonPosInt -Zero)
      (>=-type-pattern -Rat -PosRat -NonNegRat -NegRat -NonPosRat -Zero)
      (>=-type-pattern -Flonum -PosFlonum -NonNegFlonum -NegFlonum -NonPosFlonum)
@@ -959,10 +959,10 @@
 
 [* (from-cases
     (-> -One)
-    (-> N N : -true-filter : (-arg-path 0))
+    (-> N N : -true-propset : (-arg-path 0))
     (commutative-case -Zero N -Zero)
-    (-> N -One N : -true-filter : (-arg-path 0))
-    (-> -One N N : -true-filter : (-arg-path 1))
+    (-> N -One N : -true-propset : (-arg-path 0))
+    (-> -One N N : -true-propset : (-arg-path 1))
     (-> -PosByte -PosByte -PosIndex)
     (-> -Byte -Byte -Index)
     (-> -PosByte -PosByte -PosByte -PosFixnum)
@@ -1022,10 +1022,10 @@
     (varop N))]
 [+ (from-cases
     (-> -Zero)
-    (-> N N : -true-filter : (-arg-path 0))
+    (-> N N : -true-propset : (-arg-path 0))
     (binop -Zero)
-    (-> N -Zero N : -true-filter : (-arg-path 0))
-    (-> -Zero N N : -true-filter : (-arg-path 1))
+    (-> N -Zero N : -true-propset : (-arg-path 0))
+    (-> -Zero N N : -true-propset : (-arg-path 1))
     (-> -PosByte -PosByte -PosIndex)
     (-> -Byte -Byte -Index)
     (-> -PosByte -PosByte -PosByte -PosIndex)
@@ -1091,7 +1091,7 @@
     (negation-pattern -PosInexactReal -NegInexactReal -NonNegInexactReal -NonPosInexactReal)
     (negation-pattern -PosReal -NegReal -NonNegReal -NonPosReal)
 
-    (-> N -Zero N : -true-filter : (-arg-path 0))
+    (-> N -Zero N : -true-propset : (-arg-path 0))
     (-> -One -One -Zero)
     (-> -PosByte -One -Byte)
     (-> -PosIndex -One -Index)
@@ -1128,7 +1128,7 @@
 [/ (from-cases ; very similar to multiplication, without closure properties for integers
     (commutative-case -Zero N -Zero)
     (unop -One)
-    (-> N -One N : -true-filter : (-arg-path 0))
+    (-> N -One N : -true-propset : (-arg-path 0))
     (varop-1+ -PosRat)
     (varop-1+ -NonNegRat)
     (-> -NegRat -NegRat)
@@ -1225,6 +1225,10 @@
              (map varop (list -PosByte -Byte -PosIndex -Index -PosFixnum -NonNegFixnum))
              (commutative-case -NegFixnum -Fixnum)
              (commutative-case -NonPosFixnum -Fixnum)
+             (commutative-case -PosByte -PosInt)
+             (commutative-case -Byte -Nat)
+             (commutative-case -PosFixnum -PosInt)
+             (commutative-case -NonNegFixnum -Nat)
              (map varop (list -NegFixnum -NonPosFixnum -Fixnum -PosInt -Nat))
              (commutative-case -NegInt -Int)
              (commutative-case -NonPosInt -Int)
@@ -1650,7 +1654,7 @@
   (N . -> . N))]
 [integer-sqrt
  (from-cases
-  (-> (Un -RealZero -One) (Un -RealZero -One) : -true-filter : (-arg-path 0))
+  (-> (Un -RealZero -One) (Un -RealZero -One) : -true-propset : (-arg-path 0))
   (unop -Byte)
   (-NonNegFixnum . -> . -Index)
   (-NonNegRat . -> . -Nat)
@@ -1660,8 +1664,8 @@
   (-Real . -> . N))] ; defined on inexact integers too, but not complex
 [integer-sqrt/remainder
  (from-cases
-  (-RealZero . -> . (make-Values (list (-result -RealZero -true-filter (-arg-path 0))
-                                       (-result -RealZero -true-filter (-arg-path 0)))))
+  (-RealZero . -> . (make-Values (list (-result -RealZero -true-propset (-arg-path 0))
+                                       (-result -RealZero -true-propset (-arg-path 0)))))
   (-One . -> . (-values (list -One -Zero)))
   (-Byte . -> . (-values (list -Byte -Byte)))
   (-Index . -> . (-values (list -Index -Index)))

typed-racket-lib/typed-racket/base-env/base-env.rkt

@@ -66,8 +66,8 @@
 
 ;; Section 4.2.2.7 (Random Numbers)
 [random
-  (cl->* (->opt -PosFixnum [-Pseudo-Random-Generator] -NonNegFixnum)
-         (->opt -Int [-Pseudo-Random-Generator] -Nat)
+  (cl->* (->opt -Int -Int [-Pseudo-Random-Generator] -NonNegFixnum)
+         (->opt -Int [-Pseudo-Random-Generator] -NonNegFixnum)
          (->opt [-Pseudo-Random-Generator] -Flonum))]
 
 [random-seed (-> -PosInt -Void)]
@@ -177,6 +177,11 @@
            #:repeat? Univ #f
            -String)]
 
+[non-empty-string? (make-pred-ty -String)]
+[string-contains? (-> -String -String -Boolean)]
+[string-prefix? (-> -String -String -Boolean)]
+[string-suffix? (-> -String -String -Boolean)]
+
 ;; Section 4.3.6 (racket/format)
 [~a (->optkey []
               #:rest Univ
@@ -672,7 +677,7 @@
                      [((a b c . -> . c) c (-lst a) (-lst b)) c]
                      [((a b c d . -> . d) d (-lst a) (-lst b) (-lst c)) d]))]
 [filter (-poly (a b) (cl->*
-                      ((asym-pred a Univ (-FS (-filter b 0) -top))
+                      ((asym-pred a Univ (-PS (-is-type 0 b) -tt))
                        (-lst a)
                        . -> .
                        (-lst b))
@@ -712,7 +717,7 @@
                    -Index))]
 [partition
  (-poly (a b) (cl->*
-               (-> (asym-pred b Univ (-FS (-filter a 0) -top)) (-lst b) (-values (list (-lst a) (-lst b))))
+               (-> (asym-pred b Univ (-PS (-is-type 0 a) -tt)) (-lst b) (-values (list (-lst a) (-lst b))))
                (-> (-> a Univ) (-lst a) (-values (list (-lst a) (-lst a))))))]
 
 [last   (-poly (a) ((-lst a) . -> . a))]
@@ -730,7 +735,7 @@
  (-poly (a b)
    (cl->*
     (-> (-lst a)
-        (asym-pred a Univ (-FS (-filter b 0) -top))
+        (asym-pred a Univ (-PS (-is-type 0 b) -tt))
         (-lst b))
     (-> (-lst a) (-> a Univ) (-lst a))))]
 [dropf (-poly (a) (-> (-lst a) (-> a Univ) (-lst a)))]
@@ -738,14 +743,14 @@
  (-poly (a b)
    (cl->*
     (-> (-lst a)
-        (asym-pred a Univ (-FS (-filter b 0) -top))
+        (asym-pred a Univ (-PS (-is-type 0 b) -tt))
         (-values (list (-lst b) (-lst a))))
     (-> (-lst a) (-> a Univ) (-values (list (-lst a) (-lst a))))))]
 [takef-right
  (-poly (a b)
    (cl->*
     (-> (-lst a)
-        (asym-pred a Univ (-FS (-filter b 0) -top))
+        (asym-pred a Univ (-PS (-is-type 0 b) -tt))
         (-lst b))
     (-> (-lst a) (-> a Univ) (-lst a))))]
 [dropf-right (-poly (a) (-> (-lst a) (-> a Univ) (-lst a)))]
@@ -753,7 +758,7 @@
  (-poly (a b)
    (cl->*
     (-> (-lst a)
-        (asym-pred a Univ (-FS (-filter b 0) -top))
+        (asym-pred a Univ (-PS (-is-type 0 b) -tt))
         (-values (list (-lst a) (-lst b))))
     (-> (-lst a) (-> a Univ) (-values (list (-lst a) (-lst a))))))]
 
@@ -771,6 +776,14 @@
                      ((-lst b) b) . ->... .(-lst c)))]
 [append*
  (-poly (a) ((-lst (-lst a)) . -> . (-lst a)))]
+[flatten
+ (Univ . -> . (-lst Univ))]
+[combinations (-poly (a) (cl->*
+                          (-> (-lst a) (-lst (-lst a)))
+                          (-> (-lst a) -Nat (-lst (-lst a)))))]
+[in-combinations (-poly (a) (cl->*
+                             (-> (-lst a) (-seq (-lst a)))
+                             (-> (-lst a) -Nat (-seq (-lst a)))))]
 [permutations (-poly (a) (-> (-lst a) (-lst (-lst a))))]
 [in-permutations (-poly (a) (-> (-lst a) (-seq (-lst a))))]
 [argmin (-poly (a) ((a . -> . -Real) (-lst a) . -> . a))]
@@ -840,7 +853,7 @@
                           . ->... .
                           -Index))]
 [vector-filter (-poly (a b) (cl->*
-                              ((asym-pred a Univ (-FS (-filter b 0) -top))
+                              ((asym-pred a Univ (-PS (-is-type 0 b) -tt))
                                (-vec a)
                                . -> .
                                (-vec b))
@@ -874,6 +887,7 @@
                    ((-box a) . -> . a)
                    ((make-BoxTop) . -> . Univ)))]
 [set-box! (-poly (a) ((-box a) a . -> . -Void))]
+[box-cas! (-poly (a) ((-box a) a a . -> . -Boolean))]
 [unsafe-unbox (-poly (a) (cl->*
                           ((-box a) . -> . a)
                           ((make-BoxTop) . -> . Univ)))]
@@ -882,6 +896,7 @@
                            ((-box a) . -> . a)
                            ((make-BoxTop) . -> . Univ)))]
 [unsafe-set-box*! (-poly (a) ((-box a) a . -> . -Void))]
+[unsafe-box*-cas! (-poly (a) ((-box a) a a . -> . -Boolean))]
 [box? (make-pred-ty (make-BoxTop))]
 
 ;; Section 4.13 (Hash Tables)
@@ -955,13 +970,25 @@
 [equal-hash-code (-> Univ -Fixnum)]
 [equal-secondary-hash-code (-> Univ -Fixnum)]
 [hash-iterate-first (-poly (a b)
-                           ((-HT a b) . -> . (Un (-val #f) -Integer)))]
+                           (cl->*
+                            ((-HT a b) . -> . (Un (-val #f) -Integer))
+                            (-> -HashTop (Un (-val #f) -Integer))))]
 [hash-iterate-next (-poly (a b)
-                           ((-HT a b) -Integer . -> . (Un (-val #f) -Integer)))]
+                           (cl->*
+                            ((-HT a b) -Integer . -> . (Un (-val #f) -Integer))
+                            (-> -HashTop -Integer (Un (-val #f) -Integer))))]
 [hash-iterate-key (-poly (a b)
-                           ((-HT a b) -Integer . -> . a))]
+                           (cl->* ((-HT a b) -Integer . -> . a)
+                                  (-> -HashTop -Integer Univ)))]
 [hash-iterate-value (-poly (a b)
-                           ((-HT a b) -Integer . -> . b))]
+                           (cl->* ((-HT a b) -Integer . -> . b)
+                                  (-> -HashTop -Integer Univ)))]
+[hash-iterate-pair (-poly (a b)
+                           (cl->* ((-HT a b) -Integer . -> . (-pair a b))
+                                  (-> -HashTop -Integer Univ)))]
+[hash-iterate-key+value (-poly (a b)
+                           (cl->* ((-HT a b) -Integer . -> . (-values (list a b)))
+                                  (-> -HashTop -Integer (-values (list Univ Univ)))))]
 
 [make-custom-hash (->opt (-> Univ Univ Univ) (-> Univ -Nat) [(-> Univ -Nat)] Univ)]
 [make-immutable-custom-hash (->opt (-> Univ Univ Univ) (-> Univ -Nat) [(-> Univ -Nat)] Univ)]
@@ -1014,7 +1041,7 @@
 [sequence-fold (-poly (a b) ((b a . -> . b) b (-seq a) . -> . b))]
 [sequence-count (-poly (a) ((a . -> . Univ) (-seq a) . -> . -Nat))]
 [sequence-filter (-poly (a b) (cl->*
-                                ((asym-pred a Univ (-FS (-filter b 0) -top))
+                                ((asym-pred a Univ (-PS (-is-type 0 b) -tt))
                                  (-seq a)
                                  . -> .
                                  (-seq b))
@@ -1044,7 +1071,7 @@
 [proper-subset? (-poly (e) (-> (-set e) (-set e) B))]
 [set-map (-poly (e b) (-> (-set e) (-> e b) (-lst b)))]
 [set-for-each (-poly (e b) (-> (-set e) (-> e b) -Void))]
-[generic-set? (asym-pred Univ B (-FS -top (-not-filter (-set Univ) 0)))]
+[generic-set? (asym-pred Univ B (-PS -tt (-not-type 0 (-set Univ))))]
 [set? (make-pred-ty (-set Univ))]
 [set-equal? (-poly (e) (-> (-set e) B))]
 [set-eqv? (-poly (e) (-> (-set e) B))]
@@ -1083,14 +1110,14 @@
 [identity (-poly (a) (->acc (list a) a null))]
 [const (-poly (a) (-> a (->* '() Univ a)))]
 [negate (-polydots (a b c d)
-          (cl->* (-> (-> c Univ : (-FS (-filter a 0) (-not-filter b 0)))
-                     (-> c -Boolean : (-FS (-not-filter b 0) (-filter a 0))))
-                 (-> (-> c Univ : (-FS (-filter a 0) (-filter b 0)))
-                     (-> c -Boolean : (-FS (-filter b 0) (-filter a 0))))
-                 (-> (-> c Univ : (-FS (-not-filter a 0) (-filter b 0)))
-                     (-> c -Boolean : (-FS (-filter b 0) (-not-filter a 0))))
-                 (-> (-> c Univ : (-FS (-not-filter a 0) (-not-filter b 0)))
-                     (-> c -Boolean : (-FS (-not-filter b 0) (-not-filter a 0))))
+          (cl->* (-> (-> c Univ : (-PS (-is-type 0 a) (-not-type 0 b)))
+                     (-> c -Boolean : (-PS (-not-type 0 b) (-is-type 0 a))))
+                 (-> (-> c Univ : (-PS (-is-type 0 a) (-is-type 0 b)))
+                     (-> c -Boolean : (-PS (-is-type 0 b) (-is-type 0 a))))
+                 (-> (-> c Univ : (-PS (-not-type 0 a) (-is-type 0 b)))
+                     (-> c -Boolean : (-PS (-is-type 0 b) (-not-type 0 a))))
+                 (-> (-> c Univ : (-PS (-not-type 0 a) (-not-type 0 b)))
+                     (-> c -Boolean : (-PS (-not-type 0 b) (-not-type 0 a))))
                  (-> ((list) [d d] . ->... . Univ)
                      ((list) [d d] . ->... . -Boolean))))]
 [conjoin (-polydots (a) (->* '() (->... '() (a a) Univ) (->... '() (a a) Univ)))]
@@ -1276,7 +1303,7 @@
 [call-with-continuation-barrier (-poly (a) (-> (-> a) a))]
 [continuation-prompt-available? (-> (make-Prompt-TagTop) B)]
 [continuation?
- (asym-pred Univ B (-FS (-filter top-func 0) -top))]
+ (asym-pred Univ B (-PS (-is-type 0 top-func) -tt))]
 [continuation-prompt-tag? (make-pred-ty (make-Prompt-TagTop))]
 [dynamic-wind (-poly (a) (-> (-> ManyUniv) (-> a) (-> ManyUniv) a))]
 
@@ -1397,7 +1424,7 @@
 [never-evt (-evt (Un))]
 [system-idle-evt (-> (-evt -Void))]
 [alarm-evt (-> -Real (-mu x (-evt x)))]
-[handle-evt? (asym-pred Univ B (-FS (-filter (-evt Univ) 0) -top))]
+[handle-evt? (asym-pred Univ B (-PS (-is-type 0 (-evt Univ)) -tt))]
 [current-evt-pseudo-random-generator
  (-Param -Pseudo-Random-Generator -Pseudo-Random-Generator)]
 
@@ -1408,7 +1435,7 @@
 [channel-try-get (-poly (a) ((-channel a) . -> . (Un a (-val #f))))]
 [channel-put (-poly (a) ((-channel a) a . -> . -Void))]
 [channel-put-evt (-poly (a) (-> (-channel a) a (-mu x (-evt x))))]
-[channel-put-evt? (asym-pred Univ B (-FS (-filter (-mu x (-evt x)) 0) -top))]
+[channel-put-evt? (asym-pred Univ B (-PS (-is-type 0 (-mu x (-evt x))) -tt))]
 
 ;; Section 11.2.3 (Semaphores)
 [semaphore? (make-pred-ty -Semaphore)]
@@ -1418,7 +1445,7 @@
 [semaphore-try-wait? (-> -Semaphore B)]
 [semaphore-wait/enable-break (-> -Semaphore -Void)]
 [semaphore-peek-evt (-> -Semaphore (-mu x (-evt x)))]
-[semaphore-peek-evt? (asym-pred Univ B (-FS (-filter (-mu x (-evt x)) 0) -top))]
+[semaphore-peek-evt? (asym-pred Univ B (-PS (-is-type 0 (-mu x (-evt x))) -tt))]
 [call-with-semaphore
  (-polydots (b a)
    (cl->* (->... (list -Semaphore (->... '() [a a] b))
@@ -1514,7 +1541,10 @@
 [syntax-original? (-poly (a) (-> (-Syntax a) B))]
 [syntax-source-module (->opt (-Syntax Univ) [Univ] (Un (-val #f) -Path Sym -Module-Path-Index))]
 [syntax-e (-poly (a) (->acc (list (-Syntax a)) a (list -syntax-e)))]
-[syntax->list (-poly (a) (-> (-Syntax (-lst a)) (-lst a)))]
+[syntax->list (-poly (a)
+                (cl->* (-> (-Syntax (-lst a)) (-lst a))
+                       (-> (-Syntax Univ)
+                           (Un (-val #f) (-lst (-Syntax Univ))))))]
 [syntax->datum (cl->* (-> Any-Syntax -Sexp)
                       (-> (-Syntax Univ) Univ))]
 
@@ -1760,7 +1790,7 @@
 [file-stream-buffer-mode (cl-> [(-Port) (one-of/c 'none 'line 'block #f)]
                                [(-Port (one-of/c 'none 'line 'block)) -Void])]
 [file-position (cl-> [(-Port) -Nat]
-                     [(-Port -Integer) -Void])]
+                     [(-Port (Un -Integer (-val eof))) -Void])]
 [file-position* (-> -Port (Un -Nat (-val #f)))]
 
 ;; Section 13.1.4
@@ -1819,8 +1849,8 @@
 [port-file-identity (-> (Un -Input-Port -Output-Port) -PosInt)]
 
 ;; Section 13.1.6
-[open-input-string (-> -String -Input-Port)]
-[open-input-bytes (-> -Bytes -Input-Port)]
+[open-input-string (->opt -String [Univ] -Input-Port)]
+[open-input-bytes (->opt -Bytes [Univ] -Input-Port)]
 [open-output-string
  ([Univ] . ->opt . -Output-Port)]
 [open-output-bytes
@@ -1833,7 +1863,7 @@
 
 ;; Section 13.1.7
 [make-pipe
- (cl->* [->opt [N] (-values (list -Input-Port -Output-Port))])]
+ (cl->* [->opt [N Univ Univ] (-values (list -Input-Port -Output-Port))])]
 [pipe-content-length (-> (Un -Input-Port -Output-Port) -Nat)]
 
 ;; Section 13.1.8
@@ -1935,8 +1965,10 @@
 [make-pipe-with-specials (->opt [-Nat Univ Univ] (-values (list -Input-Port -Output-Port)))]
 
 [merge-input (->opt -Input-Port -Input-Port [(-opt -Nat)] -Input-Port)]
-[open-output-nowhere (-> -Output-Port)]
-[peeking-input-port (->opt -Input-Port [Univ -Nat] -Input-Port)]
+[open-output-nowhere (->opt [Univ Univ] -Output-Port)]
+[peeking-input-port (->optkey -Input-Port [Univ -Nat]
+                              #:init-position -Nat #f
+                              -Input-Port)]
 
 [reencode-input-port
  (->opt -Input-Port -String (-opt -Bytes) [Univ Univ Univ (-> -String -Input-Port ManyUniv)] -Input-Port)]
@@ -1944,7 +1976,7 @@
  (->opt -Output-Port -String (-opt -Bytes) [Univ Univ (-opt -Bytes) (-> -String -Output-Port ManyUniv)] -Output-Port)]
 
 [dup-input-port (-Input-Port (B) . ->opt . -Input-Port)]
-[dup-output-port (-Output-Port (B) . ->opt . -Input-Port)]
+[dup-output-port (-Output-Port (B) . ->opt . -Output-Port)]
 
 [relocate-input-port (->opt -Input-Port (-opt -PosInt) (-opt -Nat) -PosInt [Univ] -Input-Port)]
 [relocate-output-port (->opt -Output-Port (-opt -PosInt) (-opt -Nat) -PosInt [Univ] -Output-Port)]
@@ -2284,7 +2316,7 @@
 [resolved-module-path? (make-pred-ty -Resolved-Module-Path)]
 [make-resolved-module-path (-> (Un -Symbol -Path) -Resolved-Module-Path)]
 [resolved-module-path-name (-> -Resolved-Module-Path (Un -Path -Symbol))]
-[module-path? (asym-pred Univ B (-FS (-filter -Module-Path 0) -top))]
+[module-path? (asym-pred Univ B (-PS (-is-type 0 -Module-Path) -tt))]
 
 [current-module-name-resolver (-Param (cl->* (-Resolved-Module-Path Univ . -> . Univ)
                                              ((Un -Module-Path -Path)
@@ -2468,8 +2500,8 @@
 ;; Section 15.1 (Path Manipulation)
 [path? (make-pred-ty -Path)]
 [path-string? (asym-pred Univ B
-                         (-FS (-filter (Un -Path -String) 0)
-                              (-not-filter -Path 0)))]
+                         (-PS (-is-type 0 (Un -Path -String))
+                              (-not-type 0 -Path)))]
 [path-for-some-system? (make-pred-ty -SomeSystemPath)]
 
 [string->path (-> -String -Path)]
@@ -2534,6 +2566,16 @@
                 (Un -SomeSystemPath (one-of/c 'up 'same))
                 B))))]
 
+[path-replace-extension
+ (cl->*
+  (-> -Pathlike (Un -String -Bytes) -Path)
+  (-> -SomeSystemPathlike (Un -String -Bytes) -SomeSystemPath))]
+
+[path-add-extension
+ (cl->*
+  (-> -Pathlike (Un -String -Bytes) -Path)
+  (-> -SomeSystemPathlike (Un -String -Bytes) -SomeSystemPath))]
+
 [path-replace-suffix
  (cl->*
   (-> -Pathlike (Un -String -Bytes) -Path)
@@ -2608,8 +2650,14 @@
                              -Void)]
 [delete-directory/files (->key -Pathlike #:must-exist? Univ #f -Void)]
 
-[find-files (->optkey (-> -Path Univ) [(-opt -Pathlike)] #:follow-links? Univ #f (-lst -Path))]
-[pathlist-closure (->key (-lst -Pathlike) #:follow-links? Univ #f (-lst -Path))]
+[find-files (->optkey (-> -Path Univ) [(-opt -Pathlike)]
+                      #:skip-filtered-directories? Univ #f
+                      #:follow-links? Univ #f
+                      (-lst -Path))]
+[pathlist-closure (->key (-lst -Pathlike)
+                         #:path-filter (Un (-val #f) (-Path . -> . Univ)) #f
+                         #:follow-links? Univ #f
+                         (-lst -Path))]
 
 [fold-files
  (-poly
@@ -2653,10 +2701,10 @@
 
 [tcp-abandon-port (-Port . -> . -Void)]
 [tcp-addresses (cl->*
-                (-Port [(-val #f)] . ->opt . (-values (list -String -String)))
-                (-Port (-val #t) . -> . (-values (list -String -Index -String -Index))))]
+                ((Un -TCP-Listener -Port) [(-val #f)] . ->opt . (-values (list -String -String)))
+                ((Un -TCP-Listener -Port) (-val #t) . -> . (-values (list -String -Index -String -Index))))]
 
-[tcp-port? (asym-pred Univ B (-FS (-filter (Un -Input-Port -Output-Port) 0) -top))]
+[tcp-port? (asym-pred Univ B (-PS (-is-type 0 (Un -Input-Port -Output-Port)) -tt))]
 
 ;; Section 15.3.2 (racket/udp)
 [udp-open-socket (->opt [(-opt -String) (-opt -String)] -UDP-Socket)]
@@ -3015,7 +3063,7 @@
 [assert (-poly (a b) (cl->*
                       (Univ (make-pred-ty (list a) Univ b) . -> . b)
                       (-> (Un a (-val #f)) a)))]
-[defined? (->* (list Univ) -Boolean : (-FS (-not-filter -Undefined 0) (-filter -Undefined 0)))]
+[defined? (->* (list Univ) -Boolean : (-PS (-not-type 0 -Undefined) (-is-type 0 -Undefined)))]
 
 ;; Syntax Manual
 ;; Section 2.1 (syntax/stx)

typed-racket-lib/typed-racket/base-env/base-special-env.rkt

@@ -116,25 +116,75 @@
   [(make-template-identifier 'in-bytes 'racket/private/for)
    (->opt -Bytes [-Int (-opt -Int) -Int] (-seq -Byte))]
   ;; in-hash and friends
-  [(make-template-identifier 'in-hash 'racket/private/for)
+  [(make-template-identifier 'default-in-hash 'racket/private/for)
    (-poly (a b)
           (cl-> [((-HT a b)) (-seq a b)]
                 [(-HashTop) (-seq Univ Univ)]))]
-  [(make-template-identifier 'in-hash-keys 'racket/private/for)
+  [(make-template-identifier 'default-in-hash-keys 'racket/private/for)
    (-poly (a b)
           (cl-> [((-HT a b)) (-seq a)]
                 [(-HashTop) (-seq Univ)]))]
-  [(make-template-identifier 'in-hash-values 'racket/private/for)
+  [(make-template-identifier 'default-in-hash-values 'racket/private/for)
    (-poly (a b)
           (cl-> [((-HT a b)) (-seq b)]
                 [(-HashTop) (-seq Univ)]))]
-  [(make-template-identifier 'in-hash-pairs 'racket/private/for)
+  [(make-template-identifier 'default-in-hash-pairs 'racket/private/for)
+   (-poly (a b)
+          (cl-> [((-HT a b)) (-seq (-pair a b))]
+                [(-HashTop) (-seq (-pair Univ Univ))]))]
+  [(make-template-identifier 'default-in-immutable-hash 'racket/private/for)
+   (-poly (a b)
+          (cl-> [((-HT a b)) (-seq a b)]
+                [(-HashTop) (-seq Univ Univ)]))]
+  [(make-template-identifier 'default-in-immutable-hash-keys 'racket/private/for)
+   (-poly (a b)
+          (cl-> [((-HT a b)) (-seq a)]
+                [(-HashTop) (-seq Univ)]))]
+  [(make-template-identifier 'default-in-immutable-hash-values 'racket/private/for)
+   (-poly (a b)
+          (cl-> [((-HT a b)) (-seq b)]
+                [(-HashTop) (-seq Univ)]))]
+  [(make-template-identifier 'default-in-immutable-hash-pairs 'racket/private/for)
+   (-poly (a b)
+          (cl-> [((-HT a b)) (-seq (-pair a b))]
+                [(-HashTop) (-seq (-pair Univ Univ))]))]
+  [(make-template-identifier 'default-in-mutable-hash 'racket/private/for)
+   (-poly (a b)
+          (cl-> [((-HT a b)) (-seq a b)]
+                [(-HashTop) (-seq Univ Univ)]))]
+  [(make-template-identifier 'default-in-mutable-hash-keys 'racket/private/for)
+   (-poly (a b)
+          (cl-> [((-HT a b)) (-seq a)]
+                [(-HashTop) (-seq Univ)]))]
+  [(make-template-identifier 'default-in-mutable-hash-values 'racket/private/for)
+   (-poly (a b)
+          (cl-> [((-HT a b)) (-seq b)]
+                [(-HashTop) (-seq Univ)]))]
+  [(make-template-identifier 'default-in-mutable-hash-pairs 'racket/private/for)
+   (-poly (a b)
+          (cl-> [((-HT a b)) (-seq (-pair a b))]
+                [(-HashTop) (-seq (-pair Univ Univ))]))]
+  [(make-template-identifier 'default-in-weak-hash 'racket/private/for)
+   (-poly (a b)
+          (cl-> [((-HT a b)) (-seq a b)]
+                [(-HashTop) (-seq Univ Univ)]))]
+  [(make-template-identifier 'default-in-weak-hash-keys 'racket/private/for)
+   (-poly (a b)
+          (cl-> [((-HT a b)) (-seq a)]
+                [(-HashTop) (-seq Univ)]))]
+  [(make-template-identifier 'default-in-weak-hash-values 'racket/private/for)
+   (-poly (a b)
+          (cl-> [((-HT a b)) (-seq b)]
+                [(-HashTop) (-seq Univ)]))]
+  [(make-template-identifier 'default-in-weak-hash-pairs 'racket/private/for)
    (-poly (a b)
           (cl-> [((-HT a b)) (-seq (-pair a b))]
                 [(-HashTop) (-seq (-pair Univ Univ))]))]
   ;; in-port
   [(make-template-identifier 'in-port 'racket/private/for)
-   (->opt [(-> -Input-Port Univ) -Input-Port] (-seq Univ))]
+   (-poly (a)
+          (cl->* (-> (-seq Univ))
+                 (->opt (-> -Input-Port (Un a (-val eof))) [-Input-Port] (-seq a))))]
   ;; in-input-port-bytes
   [(make-template-identifier 'in-input-port-bytes 'racket/private/for)
    (-> -Input-Port (-seq -Byte))]

typed-racket-lib/typed-racket/base-env/base-structs.rkt

@@ -70,7 +70,10 @@
     ([message : -String] [continuation-marks : -Cont-Mark-Set])
 
     (define-hierarchy exn:break (#:kernel-maker k:exn:break)
-     ([continuation : top-func]))
+     ([continuation : top-func])
+
+     (define-hierarchy exn:break:hang-up (#:kernel-maker k:exn:break:hang-up) ())
+     (define-hierarchy exn:break:terminate (#:kernel-maker k:exn:break:terminate) ()))
 
     (define-hierarchy exn:fail (#:kernel-maker k:exn:fail) ()
 
@@ -81,7 +84,10 @@
         (define-hierarchy exn:fail:contract:continuation (#:kernel-maker k:exn:fail:contract:continuation) ())
         (define-hierarchy exn:fail:contract:variable (#:kernel-maker k:exn:fail:contract:variable) ()))
 
-      (define-hierarchy exn:fail:syntax (#:kernel-maker k:exn:fail:syntax) ([exprs : (-lst Any-Syntax)]))
+      (define-hierarchy exn:fail:syntax (#:kernel-maker k:exn:fail:syntax) ([exprs : (-lst Any-Syntax)])
+        (define-hierarchy exn:fail:syntax:unbound (#:kernel-maker k:exn:fail:syntax:unbound) ())
+        (define-hierarchy exn:fail:syntax:missing-module (#:kernel-maker k:exn:fail:syntax:missing-module)
+          ([path : -Module-Path])))
 
       (define-hierarchy exn:fail:read (#:kernel-maker k:exn:fail:read)
         ([srclocs : (-lst Univ)]) ;; cce: Univ here should be srcloc
@@ -90,9 +96,15 @@
 
       (define-hierarchy exn:fail:filesystem (#:kernel-maker k:exn:fail:filesystem) ()
         (define-hierarchy exn:fail:filesystem:exists (#:kernel-maker k:exn:fail:filesystem:exists) ())
-        (define-hierarchy exn:fail:filesystem:version (#:kernel-maker k:exn:fail:filesystem:version) ()))
+        (define-hierarchy exn:fail:filesystem:version (#:kernel-maker k:exn:fail:filesystem:version) ())
+        (define-hierarchy exn:fail:filesystem:errno (#:kernel-maker k:exn:fail:filesystem:errno)
+          ([errno : (-pair -Integer (one-of/c 'posix 'windows 'gai))]))
+        (define-hierarchy exn:fail:filesystem:missing-module (#:kernel-maker k:exn:fail:filesystem:missing-module)
+          ([path : -Module-Path])))
 
-      (define-hierarchy exn:fail:network (#:kernel-maker k:exn:fail:network) ())
+      (define-hierarchy exn:fail:network (#:kernel-maker k:exn:fail:network) ()
+        (define-hierarchy exn:fail:network:errno (#:kernel-maker k:exn:fail:network:errno)
+          ([errno : (-pair -Integer (one-of/c 'posix 'windows 'gai))])))
 
       (define-hierarchy exn:fail:out-of-memory (#:kernel-maker k:exn:fail:out-of-memory) ())
 

typed-racket-lib/typed-racket/base-env/base-types-extra.rkt

@@ -7,7 +7,12 @@
     [(_ nm ...)
      #'(begin (define-syntax nm
                 (lambda (stx)
-                  (raise-syntax-error 'type-check "type name used out of context"
+                  (raise-syntax-error 'type-check
+                                      (format "type name used out of context\n  type: ~a\n  in: ~a"
+                                              (syntax->datum (if (stx-pair? stx)
+                                                                 (stx-car stx)
+                                                                 stx))
+                                              (syntax->datum stx))
                                       stx
                                       (and (stx-pair? stx) (stx-car stx)))))
               ...
@@ -17,7 +22,8 @@
 (define-other-types
   -> ->* case-> U Rec All Opaque Vector
   Parameterof List List* Class Object Unit Values AnyValues Instance Refinement
-  pred Struct Struct-Type Prefab Top Bot Distinction)
+  pred Struct Struct-Type Prefab Top Bot Distinction Sequenceof
+  ∩)
 
 (provide (rename-out [All ∀]
                      [U Un]
@@ -26,4 +32,3 @@
                      [List Tuple]
                      [Rec mu]
                      [Parameterof Parameter]))
-

typed-racket-lib/typed-racket/base-env/base-types.rkt

@@ -187,7 +187,6 @@
 [Pairof (-poly (a b) (-pair a b))]
 [MPairof (-poly (a b) (-mpair a b))]
 [MListof (-poly (a) (-mlst a))]
-[Sequenceof (-poly (a) (-seq a))]
 [Thread-Cellof (-poly (a) (-thread-cell a))]
 [Custodian-Boxof (-poly (a) (make-CustodianBox a))]
 

typed-racket-lib/typed-racket/base-env/class-prims.rkt

@@ -282,7 +282,7 @@
       [_ #f]))
 
   ;; clauses->names : (-> Clause Boolean) Listof<Clause> -> Listof<Id>
-  ;; filter clauses by some property and spit out the names in those clauses
+  ;; prop clauses by some property and spit out the names in those clauses
   (define (clauses->names prop clauses [keep-pair? #f])
     (apply append
            (for/list ([clause (in-list clauses)]

typed-racket-lib/typed-racket/base-env/env-lang.rkt

@@ -5,7 +5,7 @@
 (require (for-syntax racket/base syntax/parse)
          (utils tc-utils)
          (env init-envs)
-         (types abbrev numeric-tower union filter-ops))
+         (types abbrev numeric-tower union prop-ops))
 
 (define-syntax (-#%module-begin stx)
   (define-syntax-class clause
@@ -29,4 +29,4 @@
          require
          (except-out (all-from-out racket/base) #%module-begin)
          types rep private utils
-         (types-out abbrev numeric-tower union filter-ops))
+         (types-out abbrev numeric-tower union prop-ops))

typed-racket-lib/typed-racket/base-env/extra-env-lang.rkt

@@ -11,7 +11,7 @@
          (for-syntax racket/base
                      syntax/parse
                      syntax/stx)
-         (for-syntax (types abbrev numeric-tower union filter-ops)))
+         (for-syntax (types abbrev numeric-tower union prop-ops)))
 
 (provide type-environment
          (rename-out [-#%module-begin #%module-begin])
@@ -20,7 +20,7 @@
          (except-out (all-from-out racket/base) #%module-begin)
          (for-syntax (except-out (all-from-out racket/base) #%module-begin))
          types rep private utils
-         (for-syntax (types-out abbrev numeric-tower union filter-ops)))
+         (for-syntax (types-out abbrev numeric-tower union prop-ops)))
 
 ;; syntax classes for type clauses in the type-environment macro
 (begin-for-syntax
@@ -52,7 +52,11 @@
                                    ;;        lift out to utility module maybe
                                    (define-syntax (type stx)
                                      (raise-syntax-error 'type-check
-                                                         "type name used out of context"
+                                                         (format "type name used out of context\n  type: ~a\n  in: ~a"
+                                                                 (syntax->datum (if (stx-pair? stx)
+                                                                                    (stx-car stx)
+                                                                                    stx))
+                                                                 (syntax->datum stx))
                                                          stx
                                                          (and (stx-pair? stx) (stx-car stx))))
                                    (provide type pred))))

typed-racket-lib/typed-racket/base-env/prims-contract.rkt

@@ -19,7 +19,7 @@
 
 (provide require/opaque-type require-typed-struct-legacy require-typed-struct
          require/typed-legacy require/typed require/typed/provide
-         require-typed-struct/provide cast make-predicate define-predicate
+         require-typed-struct/provide core-cast make-predicate define-predicate
          require-typed-signature)
 
 (module forms racket/base
@@ -31,7 +31,7 @@
                     require-typed-struct-legacy
                     require-typed-struct
                     require/typed-legacy require/typed require/typed/provide
-                    require-typed-struct/provide cast make-predicate define-predicate)]))
+                    require-typed-struct/provide core-cast make-predicate define-predicate)]))
   (define-syntax (def stx)
     (syntax-case stx ()
       [(_ id ...)
@@ -43,7 +43,16 @@
         require-typed-struct-legacy
         require-typed-struct
         require/typed-legacy require/typed require/typed/provide
-        require-typed-struct/provide cast make-predicate define-predicate))
+        require-typed-struct/provide make-predicate define-predicate)
+
+  ;; Expand `cast` to a `core-cast` with an extra `#%expression` in order
+  ;; to prevent the contract generation pass from executing too early
+  ;; (i.e., before the `cast` typechecks)
+  (define-syntax (-core-cast stx) (core-cast stx))
+  (define-syntax (cast stx)
+    (syntax-case stx ()
+      [(_ e ty) (quasisyntax/loc stx (#%expression #,(syntax/loc stx (-core-cast e ty))))]))
+  (provide cast))
 
 ;; unsafe operations go in this submodule
 (module* unsafe #f
@@ -75,6 +84,7 @@
          (for-template "../utils/any-wrap.rkt")
          "../utils/tc-utils.rkt"
          "../private/syntax-properties.rkt"
+         "../private/cast-table.rkt"
          "../typecheck/internal-forms.rkt"
          ;; struct-extraction is actually used at both of these phases
          "../utils/struct-extraction.rkt"
@@ -115,23 +125,24 @@
     #:attributes (nm ty)
     (pattern [nm:opt-rename ty]))
 
-  (define-splicing-syntax-class (opt-constructor legacy struct-name)
-   #:attributes (value)
-   (pattern (~seq)
-            #:attr value (if legacy
-                             #`(#:extra-constructor-name
-                                #,(format-id struct-name "make-~a" struct-name))
-                             #'()))
-   (pattern (~seq (~and key (~or #:extra-constructor-name #:constructor-name)) name:id)
-            #:attr value #'(key name)))
+  (define-splicing-syntax-class (struct-opts legacy struct-name)
+     #:attributes (ctor-value type)
+     (pattern (~seq (~optional (~seq (~and key (~or #:extra-constructor-name #:constructor-name))
+                                     name:id))
+                    (~optional (~seq #:type-name type:id) #:defaults ([type struct-name])))
+              #:attr ctor-value (if (attribute key) #'(key name)
+                                    (if legacy
+                                        #`(#:extra-constructor-name
+                                           #,(format-id struct-name "make-~a" struct-name))
+                                        #'()))))
 
   (define-syntax-class (struct-clause legacy)
-    ;#:literals (struct)
-    #:attributes (nm (body 1) (constructor-parts 1))
+    #:attributes (nm type (body 1) (constructor-parts 1))
     (pattern [(~or (~datum struct) #:struct)
               nm:opt-parent (body ...)
-              (~var constructor (opt-constructor legacy #'nm.nm))]
-             #:with (constructor-parts ...) #'constructor.value))
+              (~var opts (struct-opts legacy #'nm.nm))]
+             #:with (constructor-parts ...) #'opts.ctor-value
+             #:attr type #'opts.type))
 
   (define-syntax-class signature-clause
     #:literals (:)
@@ -152,6 +163,7 @@
      #`(require/opaque-type oc.ty oc.pred #,lib . oc.opt))
    (pattern (~var strc (struct-clause legacy)) #:attr spec
      #`(require-typed-struct strc.nm (strc.body ...) strc.constructor-parts ...
+                             #:type-name strc.type
                              #,@(if unsafe? #'(unsafe-kw) #'())
                              #,lib))
    (pattern sig:signature-clause #:attr spec
@@ -248,9 +260,28 @@
 ;;  make-predicate
 ;;  cast
 
-;; Helper to construct syntax for contract definitions
+;; Helpers to construct syntax for contract definitions
+;; make-contract-def-rhs : Type-Stx Boolean Boolean -> Syntax
 (define (make-contract-def-rhs type flat? maker?)
-  (contract-def-property #'#f `#s(contract-def ,type ,flat? ,maker? untyped)))
+  (define contract-def `#s(contract-def ,type ,flat? ,maker? untyped))
+  (contract-def-property #'#f (λ () contract-def)))
+
+;; make-contract-def-rhs/from-typed : Id Boolean Boolean -> Syntax
+(define (make-contract-def-rhs/from-typed id flat? maker?)
+  (contract-def-property
+   #'#f
+   ;; This function should only be called after the type-checking pass has finished.
+   ;; By then `tc/#%expression` will have recognized the `casted-expr` property and
+   ;; will have added the casted expression's original type to the cast-table, so
+   ;; that `(cast-table-ref id)` can get that type here.
+   (λ ()
+     (define type-stx
+       (or (cast-table-ref id)
+           (int-err (string-append
+                     "contract-def-property: thunk called too early\n"
+                     "  This should only be called after the type-checking pass has finished."))))
+     `#s(contract-def ,type-stx ,flat? ,maker? typed))))
+
 
 (define (define-predicate stx)
   (syntax-parse stx
@@ -282,21 +313,21 @@
      #`(#,(external-check-property #'#%expression check-valid-type)
         #,(ignore-some/expr #`(flat-contract-predicate #,name) #'(Any -> Boolean : ty)))]))
 
-
-(define (cast stx)
+;; wrapped above in the `forms` submodule
+(define (core-cast stx)
   (syntax-parse stx
     [(_ v:expr ty:expr)
-     (define (apply-contract ctc-expr)
+     (define (apply-contract v ctc-expr pos neg)
        #`(#%expression
           #,(ignore-some/expr
-             #`(let-values (((val) #,(with-type* #'v #'Any)))
+             #`(let-values (((val) #,(with-type* v #'Any)))
                  #,(syntax-property
                     (quasisyntax/loc stx
                       (contract
                        #,ctc-expr
                        val
-                       'cast
-                       'typed-world
+                       '#,pos
+                       '#,neg
                        val
                        (quote-srcloc #,stx)))
                     'feature-profile:TR-dynamic-check #t))
@@ -305,8 +336,13 @@
      (cond [(not (unbox typed-context?)) ; no-check, don't check
             #'v]
            [else
-            (define ctc (syntax-local-lift-expression
-                         (make-contract-def-rhs #'ty #f #f)))
+            (define new-ty-ctc (syntax-local-lift-expression
+                                (make-contract-def-rhs #'ty #f #f)))
+            (define existing-ty-id new-ty-ctc)
+            (define existing-ty-ctc (syntax-local-lift-expression
+                                     (make-contract-def-rhs/from-typed existing-ty-id #f #f)))
+            (define (store-existing-type existing-type)
+              (cast-table-set! existing-ty-id existing-type))
             (define (check-valid-type _)
               (define type (parse-type #'ty))
               (define vars (fv type))
@@ -316,7 +352,12 @@
                  "Type ~a could not be converted to a contract because it contains free variables."
                  type)))
             #`(#,(external-check-property #'#%expression check-valid-type)
-               #,(apply-contract ctc))])]))
+               #,(apply-contract
+                  (apply-contract
+                   #`(#,(casted-expr-property #'#%expression store-existing-type)
+                      v)
+                   existing-ty-ctc 'typed-world 'cast)
+                  new-ty-ctc 'cast 'typed-world))])]))
 
 
 
@@ -324,20 +365,25 @@
   (define-syntax-class name-exists-kw
     (pattern #:name-exists))
   (syntax-parse stx
+    [_ #:when (eq? 'module-begin (syntax-local-context))
+       ;; it would be inconvenient to find the correct #%module-begin here, so we rely on splicing
+       #`(begin #,stx (begin))]
     [(_ ty:id pred:id lib (~optional ne:name-exists-kw) ...)
      (with-syntax ([hidden (generate-temporary #'pred)])
+       (define pred-cnt
+         (syntax-local-lift-expression
+          (make-contract-def-rhs #'(-> Any Boolean) #f #f)))
        (quasisyntax/loc stx
          (begin
            ;; register the identifier for the top-level (see require/typed)
            #,@(if (eq? (syntax-local-context) 'top-level)
                   (list #'(define-syntaxes (hidden) (values)))
                   null)
-           #,(ignore #'(define pred-cnt (any/c . c-> . boolean?)))
            #,(internal #'(require/typed-internal hidden (Any -> Boolean : (Opaque pred))))
            #,(if (attribute ne)
                  (internal (syntax/loc stx (define-type-alias-internal ty (Opaque pred))))
                  (syntax/loc stx (define-type-alias ty (Opaque pred))))
-           #,(ignore #'(require/contract pred hidden pred-cnt lib)))))]))
+           #,(ignore #`(require/contract pred hidden #,pred-cnt lib)))))]))
 
 
 
@@ -391,6 +437,7 @@
       [(_ name:opt-parent
           ([fld : ty] ...)
           (~var input-maker (constructor-term legacy #'name.nm))
+          (~optional (~seq #:type-name type:id) #:defaults ([type #'name.nm]))
           unsafe:unsafe-clause
           lib)
        (with-syntax* ([nm #'name.nm]
@@ -468,24 +515,38 @@
                                   (make-struct-info-self-ctor #'internal-maker si)
                                   si))
 
-                         (dtsi* () spec ([fld : ty] ...) #:maker maker-name #:type-only)
+                         (dtsi* () spec type ([fld : ty] ...) #:maker maker-name #:type-only)
                          #,(ignore #'(require/contract pred hidden (or/c struct-predicate-procedure?/c (c-> any-wrap/c boolean?)) lib))
-                         #,(internal #'(require/typed-internal hidden (Any -> Boolean : nm)))
-                         (require/typed #:internal (maker-name real-maker) nm lib
+                         #,(internal #'(require/typed-internal hidden (Any -> Boolean : type)))
+                         (require/typed #:internal (maker-name real-maker) type lib
                                         #:struct-maker parent
                                         #,@(if (attribute unsafe.unsafe?) #'(unsafe-kw) #'()))
 
                          ;This needs to be a different identifier to meet the specifications
                          ;of struct (the id constructor shouldn't expand to it)
                          #,(if (syntax-e #'extra-maker)
-                               #`(require/typed #:internal (maker-name extra-maker) nm lib
+                               #`(require/typed #:internal (maker-name extra-maker) type lib
                                                 #:struct-maker parent
                                                 #,@(if (attribute unsafe.unsafe?) #'(unsafe-kw) #'()))
                                #'(begin))
 
+                         #,(if (not (free-identifier=? #'nm #'type))
+                               #'(define-syntax type
+                                   (lambda (stx)
+                                     (raise-syntax-error
+                                      'type-check
+                                      (format "type name ~a used out of context in ~a"
+                                              (syntax->datum (if (stx-pair? stx)
+                                                                 (stx-car stx)
+                                                                 stx))
+                                              (syntax->datum stx))
+                                      stx
+                                      (and (stx-pair? stx) (stx-car stx)))))
+                               #'(begin))
+
                          #,@(if (attribute unsafe.unsafe?)
-                                #'((require/typed #:internal sel (nm -> ty) lib unsafe-kw) ...)
-                                #'((require/typed lib [sel (nm -> ty)]) ...)))))]))
+                                #'((require/typed #:internal sel (type -> ty) lib unsafe-kw) ...)
+                                #'((require/typed lib [sel (type -> ty)]) ...)))))]))
 
   (values (rts #t) (rts #f))))
 

typed-racket-lib/typed-racket/base-env/prims-struct.rkt

@@ -46,7 +46,7 @@
              (format "field `~a' requires a type annotation"
                      (syntax-e #'fld))
              #:with form 'dummy))
-
+  
   (define-syntax-class struct-name
     #:description "struct name (with optional super-struct name)"
     #:attributes (name super)
@@ -72,7 +72,7 @@
 
   (define-splicing-syntax-class struct-options
     #:description "typed structure type options"
-    #:attributes (guard mutable? transparent? prefab? cname ecname
+    #:attributes (guard mutable? transparent? prefab? cname ecname type untyped
                   [prop 1] [prop-val 1])
     (pattern (~seq (~or (~optional (~seq (~and #:mutable mutable?)))
                         (~optional (~seq (~and #:transparent transparent?)))
@@ -81,12 +81,22 @@
                                               (~bind [ecname #f]))
                                         (~and (~seq #:extra-constructor-name ecname)
                                               (~bind [cname #f]))))
+                        (~optional (~seq #:type-name type:id))
                         ;; FIXME: unsound, but relied on in core libraries
                         ;; #:guard ought to be supportable with some work
                         ;; #:property is harder
                         (~optional (~seq #:guard guard:expr))
                         (~seq #:property prop:expr prop-val:expr))
-                   ...)))
+                   ...)
+             #:attr untyped #`(#,@(if (attribute mutable?) #'(#:mutable) #'())
+                               #,@(if (attribute transparent?) #'(#:transparent) #'())
+                               #,@(if (attribute prefab?) #'(#:prefab) #'())
+                               #,@(if (attribute cname) #'(#:constructor-name cname) #'())
+                               #,@(if (attribute ecname) #'(#:extra-constructor-name ecname) #'())
+                               #,@(if (attribute guard) #'(#:guard guard) #'())
+                               #,@(append* (for/list ([prop (in-list (attribute prop))]
+                                                      [prop-val (in-list (attribute prop-val))])
+                                             (list #'#:property prop prop-val))))))
 
   (define-syntax-class dtsi-struct-name
     #:description "struct name (with optional super-struct name)"
@@ -99,13 +109,27 @@
 
 (define-syntax (define-typed-struct/exec stx)
   (syntax-parse stx #:literals (:)
-    [(_ nm ((~describe "field specification" [fld:optionally-annotated-name]) ...) [proc : proc-ty])
+    [(_ nm:struct-name ((~describe "field specification" [fld:optionally-annotated-name]) ...)
+        [proc : proc-ty] (~optional (~seq #:type-name type:id)))
      (with-syntax*
-      ([proc* (with-type* #'proc #'proc-ty)]
+      ([type (or (attribute type) #'nm.name)]
+       [proc* (with-type* #'proc #'proc-ty)]
        [d-s (ignore-some (syntax/loc stx (define-struct nm (fld.name ...)
                                       #:property prop:procedure proc*)))]
-       [dtsi (quasisyntax/loc stx (dtsi/exec* () nm (fld ...) proc-ty))])
-      #'(begin d-s dtsi))]))
+       [stx-err-fun (if (not (free-identifier=? #'nm.name #'type))
+                        (syntax/loc stx
+                          (define-syntax type
+                            (lambda (stx)
+                              (raise-syntax-error
+                               'type-check
+                               (format "type name ~a used out of context in ~a"
+                                       (syntax->datum (if (stx-pair? stx) (stx-car stx) stx))
+                                       (syntax->datum stx))
+                               stx
+                               (and (stx-pair? stx) (stx-car stx))))))
+                        #'(begin))]
+       [dtsi (quasisyntax/loc stx (dtsi/exec* () nm type (fld ...) proc-ty))])
+      #'(begin d-s stx-err-fun dtsi))]))
 
 (define-syntaxes (dtsi* dtsi/exec*)
   (let ()
@@ -157,18 +181,32 @@
            [extra-maker (if (attribute opts.ecname)
                             #`(#:extra-maker #,(attribute opts.ecname))
                             #'())])
-       (with-syntax ([d-s (ignore (quasisyntax/loc stx
-                                    (struct #,@(attribute nm.new-spec) (fs.fld ...)
-                                            . opts)))]
-                     [dtsi (quasisyntax/loc stx
-                             (dtsi* (vars.vars ...)
-                                    nm.old-spec (fs.form ...)
-                                    #,@mutable?
-                                    #,@prefab?
-                                    #,@maker
-                                    #,@extra-maker))])
-         #'(begin d-s dtsi)))]))
-
+       (with-syntax* ([type (or (attribute opts.type) #'nm.name)]
+                      [d-s (ignore (quasisyntax/loc stx
+                                     (struct #,@(attribute nm.new-spec) (fs.fld ...)
+                                       . opts.untyped)))]
+                      [stx-err-fun (if (not (free-identifier=? #'nm.name #'type))
+                                       (syntax/loc stx
+                                         (define-syntax type
+                                           (lambda (stx)
+                                             (raise-syntax-error
+                                              'type-check
+                                              (format "type name ~a used out of context in ~a"
+                                                      (syntax->datum (if (stx-pair? stx)
+                                                                         (stx-car stx)
+                                                                         stx))
+                                                      (syntax->datum stx))
+                                              stx
+                                              (and (stx-pair? stx) (stx-car stx))))))
+                                       #'(begin))]
+                      [dtsi (quasisyntax/loc stx
+                              (dtsi* (vars.vars ...)
+                                     nm.old-spec type (fs.form ...)
+                                     #,@mutable?
+                                     #,@prefab?
+                                     #,@maker
+                                     #,@extra-maker))])
+         #'(begin d-s stx-err-fun dtsi)))]))
 
 ;; this has to live here because it's used below
 (define-syntax (define-type-alias stx)
@@ -197,7 +235,9 @@
        #'(lambda (stx)
            (raise-syntax-error
             'type-check
-            "type name used out of context"
+            (format "type name used out of context\n  type: ~a\n in: ~a"
+                    (syntax->datum (if (stx-pair? stx) (stx-car stx) stx))
+                    (syntax->datum stx))
             stx
             (and (stx-pair? stx) (stx-car stx)))))
      #`(begin

typed-racket-lib/typed-racket/base-env/prims.rkt

@@ -145,9 +145,12 @@ the typed racket language.
   (provide (all-from-out "base-contracted.rkt")))
 
 (begin-for-syntax 
+  (require racket/runtime-path
+           (for-syntax racket/base))
+  (define-runtime-module-path-index contract-defs-submod
+    '(submod "." #%contract-defs))
   (require racket/base "../utils/redirect-contract.rkt")
-  (define varref (#%variable-reference))
-  (define mk (make-make-redirect-to-contract varref)))
+  (define mk (make-make-redirect-to-contract contract-defs-submod)))
 
 (define-syntax-rule (def-redirect id ...)
   (begin (define-syntax id (mk (quote-syntax id))) ... (provide id ...)))

typed-racket-lib/typed-racket/base-env/top-interaction.rkt

@@ -43,7 +43,7 @@
     "../tc-setup.rkt"
     (private parse-type syntax-properties)
     (types utils abbrev printer)
-    (typecheck tc-app-helper typechecker)
+    (typecheck possible-domains typechecker)
     (rep type-rep)
     (utils tc-utils)
     (for-syntax racket/base syntax/parse)

typed-racket-lib/typed-racket/base-env/type-env-lang.rkt

@@ -9,7 +9,10 @@
         (begin
           (define-syntax (nm stx)
             (raise-syntax-error
-             'type-check "type name used out of context"
+             'type-check
+             (format "type name used out of context\n  type: ~a\n  in: ~a"
+                     (syntax->datum (if (stx-pair? stx) (stx-car stx) stx))
+                     (syntax->datum stx))
              stx
              (and (stx-pair? stx) (stx-car stx))))
           ...

typed-racket-lib/typed-racket/env/init-envs.rkt

@@ -10,10 +10,10 @@
          "mvar-env.rkt"
          "signature-env.rkt"
          (rename-in racket/private/sort [sort raw-sort])
-         (rep type-rep object-rep filter-rep rep-utils free-variance)
+         (rep type-rep object-rep prop-rep rep-utils free-variance)
          (for-syntax syntax/parse racket/base)
          (types abbrev union)
-         racket/dict racket/list racket/promise
+         racket/dict racket/list racket/set racket/promise
          mzlib/pconvert racket/match)
 
 (provide ;; convenience form for defining an initial environment
@@ -64,22 +64,28 @@
     [(? Rep? (app (lambda (v) (hash-ref predefined-type-table (Rep-seq v) #f)) (? values id))) id]
     [(Listof: elem-ty)
      `(-lst ,(sub elem-ty))]
-    [(Function: (list (arr: dom (Values: (list (Result: t (FilterSet: (Top:) (Top:)) (Empty:)))) #f #f '())))
+    [(Function: (list (arr: dom (Values: (list (Result: t
+                                                        (PropSet: (TrueProp:)
+                                                                  (TrueProp:))
+                                                        (Empty:))))
+                            #f #f '())))
      `(simple-> (list ,@(map sub dom)) ,(sub t))]
-    [(Function: (list (arr: dom (Values: (list (Result: t (FilterSet: (TypeFilter: ft pth)
-                                                                      (NotTypeFilter: ft pth))
+    [(Function: (list (arr: dom (Values: (list (Result: t (PropSet: (TypeProp: pth ft)
+                                                                     (NotTypeProp: pth ft))
                                                         (Empty:))))
                             #f #f '())))
      `(make-pred-ty (list ,@(map sub dom)) ,(sub t) ,(sub ft) ,(sub pth))]
-    [(Function: (list (arr: dom (Values: (list (Result: t (FilterSet: (NotTypeFilter: (== -False)
-                                                                                      (Path: pth (list 0 0)))
-                                                                      (TypeFilter: (== -False)
-                                                                                   (Path: pth (list 0 0))))
+    [(Function: (list (arr: dom (Values: (list (Result: t (PropSet: (NotTypeProp: (Path: pth (list 0 0))
+                                                                                  (== -False))
+                                                                      (TypeProp: (Path: pth (list 0 0))
+                                                                                 (== -False)))
                                                         (Path: pth (list 0 0)))))
                             #f #f '())))
      `(->acc (list ,@(map sub dom)) ,(sub t) ,(sub pth))]
-    [(Result: t (FilterSet: (Top:) (Top:)) (Empty:)) `(-result ,(sub t))]
+    [(Result: t (PropSet: (TrueProp:) (TrueProp:)) (Empty:)) `(-result ,(sub t))]
     [(Union: elems) (split-union elems)]
+    [(Intersection: elems) `(make-Intersection (set ,@(for/list ([elem (in-immutable-set elems)])
+                                                        (sub elem))))]
     [(Base: n cnt pred _) (int-err "Base type ~a not in predefined-type-table" n)]
     [(Name: stx args struct?)
      `(make-Name (quote-syntax ,stx) ,args ,struct?)]
@@ -133,10 +139,10 @@
                       (list ,@(serialize-mapping mapping)))]
     [(arr: dom rng rest drest kws)
      `(make-arr ,(sub dom) ,(sub rng) ,(sub rest) ,(sub drest) ,(sub kws))]
-    [(TypeFilter: t p)
-     `(make-TypeFilter ,(sub t) ,(sub p))]
-    [(NotTypeFilter: t p)
-     `(make-NotTypeFilter ,(sub t) ,(sub p))]
+    [(TypeProp: o t)
+     `(make-TypeProp ,(sub o) ,(sub t))]
+    [(NotTypeProp: o t)
+     `(make-NotTypeProp ,(sub o) ,(sub t))]
     [(Path: p i)
      `(make-Path ,(sub p) ,(if (identifier? i)
                                `(quote-syntax ,i)

typed-racket-lib/typed-racket/env/signature-env.rkt

@@ -6,6 +6,7 @@
 (provide register-signature!
          finalize-signatures!
          lookup-signature
+         lookup-signature/check
          signature-env-map
          with-signature-env/extend)
 
@@ -66,5 +67,15 @@
 (define (lookup-signature id)
   (free-id-table-ref (signature-env) id #f))
 
+;; lookup-signature/check : identifier? -> Signature?
+;; lookup the identifier in the signature environment
+;; errors if there is no such typed signature
+(define (lookup-signature/check id)
+  (or (lookup-signature id)
+      (tc-error/fields "use of untyped signature in typed code"
+                       #:more "consider using `require/typed' to import it"
+                       "signature" (syntax-e id)
+                       #:stx id)))
+
 (define (signature-env-map f)
   (sorted-dict-map (signature-env) f id<))

typed-racket-lib/typed-racket/env/type-env-structs.rkt

@@ -6,12 +6,12 @@
          (contract-req)
          (rep object-rep))
 
-(require-for-cond-contract (rep type-rep filter-rep))
+(require-for-cond-contract (rep type-rep prop-rep))
 
 ;; types is a free-id-table of identifiers to types
 ;; props is a list of known propositions
 (define-struct/cond-contract env ([types immutable-free-id-table?] 
-                                  [props (listof Filter/c)]
+                                  [props (listof Prop?)]
                                   [aliases immutable-free-id-table?])
   #:transparent
   #:property prop:custom-write
@@ -23,8 +23,8 @@
   [extend (env? identifier? Type/c . -> . env?)]
   [extend/values (env? (listof identifier?) (listof Type/c) . -> . env?)]
   [lookup (env? identifier? (identifier? . -> . any) . -> . any)]
-  [env-props (env? . -> . (listof Filter/c))]
-  [replace-props (env? (listof Filter/c) . -> . env?)]
+  [env-props (env? . -> . (listof Prop?))]
+  [replace-props (env? (listof Prop?) . -> . env?)]
   [empty-prop-env env?]
   [extend+alias/values (env? (listof identifier?) (listof Type/c) (listof Object?) . -> . env?)]
   [lookup-alias (env? identifier? (identifier? . -> . (or/c #f Object?)) . -> . (or/c #f Object?))])

typed-racket-lib/typed-racket/infer/constraints.rkt

@@ -7,7 +7,7 @@
          racket/match
          racket/list)
 
-(import restrict^ dmap^)
+(import intersect^ dmap^)
 (export constraints^)
 
 ;; Widest constraint possible
@@ -34,7 +34,7 @@
 ;; intersect the given types. produces a lower bound on both, but
 ;; perhaps not the GLB
 (define (meet S T)
-  (let ([s* (restrict S T)])
+  (let ([s* (intersect S T)])
     (if (and (subtype s* S)
              (subtype s* T))
         s*

typed-racket-lib/typed-racket/infer/fail.rkt

@@ -14,7 +14,7 @@
              #'((early-return rhs ...))))
  (syntax-parse stx
   [(_ e [c . r:rhs] ...)
-   #'(match* e [c . r.r] ...)]))
+   (syntax/loc stx (match* e [c . r.r] ...))]))
 
 (begin-for-syntax
   (define-splicing-syntax-class arg

typed-racket-lib/typed-racket/infer/infer-unit.rkt

@@ -11,7 +11,7 @@
          (except-in
           (combine-in
            (utils tc-utils)
-           (rep free-variance type-rep filter-rep object-rep rep-utils)
+           (rep free-variance type-rep prop-rep object-rep rep-utils)
            (types utils abbrev numeric-tower union subtype resolve
                   substitute generalize prefab)
            (env index-env tvar-env))
@@ -19,7 +19,7 @@
          "constraint-structs.rkt"
          "signatures.rkt" "fail.rkt"
          "promote-demote.rkt"
-         racket/match
+         racket/match racket/set
          mzlib/etc
          (contract-req)
          (for-syntax
@@ -224,23 +224,23 @@
       (substitute (make-F var) v ty*))))
 
 
-(define/cond-contract (cgen/filter context s t)
-  (context? Filter? Filter? . -> . (or/c #f cset?))
+(define/cond-contract (cgen/prop context s t)
+  (context? Prop? Prop? . -> . (or/c #f cset?))
   (match* (s t)
     [(e e) (empty-cset/context context)]
-    [(e (Top:)) (empty-cset/context context)]
+    [(e (TrueProp:)) (empty-cset/context context)]
     ;; FIXME - is there something to be said about the logical ones?
-    [((TypeFilter: s p) (TypeFilter: t p)) (cgen/inv context s t)]
-    [((NotTypeFilter: s p) (NotTypeFilter: t p)) (cgen/inv context s t)]
+    [((TypeProp: o s) (TypeProp: o t)) (cgen/inv context s t)]
+    [((NotTypeProp: o s) (NotTypeProp: o t)) (cgen/inv context s t)]
     [(_ _) #f]))
 
-;; s and t must be *latent* filter sets
-(define/cond-contract (cgen/filter-set context s t)
-  (context? FilterSet? FilterSet? . -> . (or/c #f cset?))
+;; s and t must be *latent* prop sets
+(define/cond-contract (cgen/prop-set context s t)
+  (context? PropSet? PropSet? . -> . (or/c #f cset?))
   (match* (s t)
     [(e e) (empty-cset/context context)]
-    [((FilterSet: s+ s-) (FilterSet: t+ t-))
-     (% cset-meet (cgen/filter context s+ t+) (cgen/filter context s- t-))]
+    [((PropSet: p+ p-) (PropSet: q+ q-))
+     (% cset-meet (cgen/prop context p+ q+) (cgen/prop context p- q-))]
     [(_ _) #f]))
 
 (define/cond-contract (cgen/object context s t)
@@ -320,7 +320,7 @@
           (% move-dotted-rest-to-dmap (cgen (context-add-var context dbound) s-dty t-dty) dbound dbound*)))]
     [((seq ss (dotted-end s-dty dbound))
       (seq ts (dotted-end t-dty dbound*)))
-     #:when (inferable-index? context dbound*)
+     #:return-unless (inferable-index? context dbound*) #f
      #:return-unless (= (length ss) (length ts)) #f
      (% cset-meet
         (cgen/list context ss ts)
@@ -439,26 +439,26 @@
           ;; CG-Top
           [(_ (Univ:)) empty]
           ;; AnyValues
-          [((AnyValues: s-f) (AnyValues: t-f))
-           (cgen/filter context s-f t-f)]
+          [((AnyValues: p) (AnyValues: q))
+           (cgen/prop context p q)]
 
-          [((or (Values: (list (Result: _ fs _) ...))
-                (ValuesDots: (list (Result: _ fs _) ...) _ _))
-            (AnyValues: t-f))
+          [((or (Values: (list (Result: _ psets _) ...))
+                (ValuesDots: (list (Result: _ psets _) ...) _ _))
+            (AnyValues: q))
            (cset-join
              (filter identity
-               (for/list ([f (in-list fs)])
-                 (match f
-                   [(FilterSet: f+ f-)
-                    (% cset-meet (cgen/filter context f+ t-f) (cgen/filter context f- t-f))]))))]
+               (for/list ([pset (in-list psets)])
+                 (match pset
+                   [(PropSet: p+ p-)
+                    (% cset-meet (cgen/prop context p+ q) (cgen/prop context p- q))]))))]
 
           ;; check all non Type/c first so that calling subtype is safe
 
           ;; check each element
-          [((Result: s f-s o-s)
-            (Result: t f-t o-t))
+          [((Result: s pset-s o-s)
+            (Result: t pset-t o-t))
            (% cset-meet (cg s t)
-                        (cgen/filter-set context f-s f-t)
+                        (cgen/prop-set context pset-s pset-t)
                         (cgen/object context o-s o-t))]
 
           ;; Values just delegate to cgen/seq, except special handling for -Bottom.
@@ -525,6 +525,19 @@
           [((? Mu? s) t) (cg (unfold s) t)]
           [(s (? Mu? t)) (cg s (unfold t))]
 
+          ;; find *an* element of elems which can be made a subtype of T
+          [((Intersection: ts) T)
+           (cset-join
+            (for*/list ([t (in-immutable-set ts)]
+                        [v (in-value (cg t T))]
+                        #:when v)
+              v))]
+          
+          ;; constrain S to be below *each* element of elems, and then combine the constraints
+          [(S (Intersection: ts))
+           (define cs (for/list/fail ([ts (in-immutable-set ts)]) (cg S ts)))
+           (and cs (cset-meet* (cons empty cs)))]
+          
           ;; constrain *each* element of es to be below T, and then combine the constraints
           [((Union: es) T)
            (define cs (for/list/fail ([e (in-list es)]) (cg e T)))

typed-racket-lib/typed-racket/infer/infer.rkt

@@ -1,11 +1,11 @@
 #lang racket/base
 
 (require "infer-unit.rkt" "constraints.rkt" "dmap.rkt" "signatures.rkt"
-         "restrict.rkt"
+         "intersect.rkt"
          (only-in racket/unit provide-signature-elements
                   define-values/invoke-unit/infer link))
 
-(provide-signature-elements restrict^ infer^)
+(provide-signature-elements intersect^ infer^)
 
 (define-values/invoke-unit/infer
-  (link infer@ constraints@ dmap@ restrict@))
+  (link infer@ constraints@ dmap@ intersect@))

typed-racket-lib/typed-racket/infer/intersect.rkt

@@ -0,0 +1,71 @@
+#lang racket/unit
+
+(require "../utils/utils.rkt")
+(require (rep type-rep)
+         (types abbrev base-abbrev union subtype resolve)
+         "signatures.rkt"
+         racket/match
+         racket/set)
+
+(import infer^)
+(export intersect^)
+
+
+;; compute the intersection of two types
+;; (note: previously called restrict)
+(define (intersect t1 t2)
+  ;; build-type: build a type while propogating bottom
+  (define (build-type constructor . args)
+    (if (memf Bottom? args) -Bottom (apply constructor args)))
+  ;; resolved is a set tracking previously seen intersect cases
+  ;; (i.e. pairs of t1 t2) to prevent infinite unfolding.
+  ;; subtyping performs a similar check for the same
+  ;; reason
+  (let intersect
+    ([t1 t1] [t2 t2] [resolved (set)])
+    (match*/no-order
+     (t1 t2)
+      ;; already a subtype
+      [(t1 t2) #:no-order #:when (subtype t1 t2) t1]
+      
+      ;; polymorphic intersect
+      [(t1 (Poly: vars t))
+       #:no-order
+       #:when (infer vars null (list t1) (list t) #f)
+       t1]
+      
+      ;; structural recursion on types
+      [((Pair: a1 d1) (Pair: a2 d2)) 
+       (build-type -pair 
+                   (intersect a1 a2 resolved) 
+                   (intersect d1 d2 resolved))]
+      ;; FIXME: support structural updating for structs when structs are updated to
+      ;; contain not only *if* they are polymorphic, but *which* fields are too  
+      ;;[((Struct: _ _ _ _ _ _)
+      ;; (Struct: _ _ _ _ _ _))]
+      [((Syntax: t1*) (Syntax: t2*))
+       (build-type -Syntax (intersect t1* t2* resolved))]
+      [((Promise: t1*) (Promise: t2*))
+       (build-type -Promise (intersect t1* t2* resolved))]
+      
+      ;; unions
+      [((Union: t1s) t2)
+       #:no-order
+       (apply Un (map (λ (t1) (intersect t1 t2 resolved)) t1s))]
+
+      ;; intersections
+      [((Intersection: t1s) t2)
+       #:no-order
+       (apply -unsafe-intersect (for/list ([t1 (in-immutable-set t1s)])
+                                  (intersect t1 t2 resolved)))]
+      
+      ;; resolve resolvable types if we haven't already done so
+      [((? needs-resolving? t1) t2)
+       #:no-order
+       #:when (not (or (set-member? resolved (cons t1 t2))
+                       (set-member? resolved (cons t2 t1))))
+       (intersect (resolve t1) t2 (set-add resolved (cons t1 t2)))]
+     
+      ;; t2 and t1 have a complex relationship, so we build an intersection
+      ;; (note: intersection checks for overlap)
+      [(t1 t2) (-unsafe-intersect t1 t2)])))

typed-racket-lib/typed-racket/infer/promote-demote.rkt

@@ -15,13 +15,13 @@
   (for/or ([e (in-list (append* (map fv ts)))])
     (memq e V)))
 
-;; get-filters : SomeValues -> FilterSet
-;; extract filters out of the range of a function type
-(define (get-filters rng)
+;; get-propset : SomeValues -> PropSet
+;; extract prop sets out of the range of a function type
+(define (get-propsets rng)
   (match rng
-    [(AnyValues: f) (list (-FS f f))]
-    [(Values: (list (Result: _ lf _) ...)) lf]
-    [(ValuesDots: (list (Result: _ lf _) ...) _ _) lf]))
+    [(AnyValues: p) (list (-PS p p))]
+    [(Values: (list (Result: _ propsets _) ...)) propsets]
+    [(ValuesDots: (list (Result: _ propsets _) ...) _ _) propsets]))
 
 
 (begin-encourage-inline
@@ -43,7 +43,7 @@
       (match arr
         [(arr: dom rng rest drest kws)
          (cond
-           [(apply V-in? V (get-filters rng))
+           [(apply V-in? V (get-propsets rng))
             #f]
            [(and drest (memq (cdr drest) V))
             (make-arr (map contra dom)
@@ -63,7 +63,7 @@
       [(Function: arrs)
        (make-Function (filter-map arr-change arrs))]
       [(? structural?) (structural-map T structural-recur)]
-      [(? Filter?) ((sub-f co) T)]
+      [(? Prop?) ((sub-f co) T)]
       [(? Object?) ((sub-o co) T)]
       [(? Type?) ((sub-t co) T)]))
   (define (var-promote T V)

typed-racket-lib/typed-racket/infer/restrict.rkt

@@ -1,68 +0,0 @@
-#lang racket/unit
-
-(require "../utils/utils.rkt")
-(require (rep type-rep)
-         (types abbrev base-abbrev union subtype remove-intersect resolve)
-         "signatures.rkt"
-         racket/match
-         racket/set)
-
-(import infer^)
-(export restrict^)
-
-
-;; restrict t1 to be a subtype of t2
-;; if `pref' is 'new, use t2 when giving up, otherwise use t1
-(define (restrict t1 t2 [pref 'new])
-  ;; build-type: build a type while propogating bottom
-  (define (build-type constructor . args)
-    (if (memf Bottom? args) -Bottom (apply constructor args)))
-  ;; resolved is a set tracking previously seen restrict cases
-  ;; (i.e. pairs of t1 t2) to prevent infinite unfolding.
-  ;; subtyping performs a similar check for the same
-  ;; reason
-  (define (restrict* t1 t2 pref resolved)
-    (match* (t1 t2)
-      ;; already a subtype
-      [(_ _) #:when (subtype t1 t2) 
-             t1]
-      
-      ;; polymorphic restrict
-      [(_ (Poly: vars t)) #:when (infer vars null (list t1) (list t) #f)
-                          t1]
-      
-      ;; structural recursion on types
-      [((Pair: a1 d1) (Pair: a2 d2)) 
-       (build-type -pair 
-                   (restrict* a1 a2 pref resolved) 
-                   (restrict* d1 d2 pref resolved))]
-      ;; FIXME: support structural updating for structs when structs are updated to
-      ;; contain not only *if* they are polymorphic, but *which* fields are too  
-      ;;[((Struct: _ _ _ _ _ _)
-      ;; (Struct: _ _ _ _ _ _))]
-      [((Syntax: t1*) (Syntax: t2*))
-       (build-type -Syntax (restrict* t1* t2* pref resolved))]
-      [((Promise: t1*) (Promise: t2*))
-       (build-type -Promise (restrict* t1* t2* pref resolved))]
-      
-      ;; unions
-      [((Union: t1s) _) (apply Un (map (λ (t1*) (restrict* t1* t2 pref resolved)) t1s))]
-      [(_ (Union: t2s)) (apply Un (map (λ (t2*) (restrict* t1 t2* pref resolved)) t2s))]
-      
-      ;; resolve resolvable types if we haven't already done so
-      [((? needs-resolving?) _) #:when (not (set-member? resolved (cons t1 t2)))
-                                (restrict* (resolve t1) t2 pref (set-add resolved (cons t1 t2)))]
-      [(_ (? needs-resolving?)) #:when (not (set-member? resolved (cons t1 t2)))
-                                (restrict* t1 (resolve t2) pref (set-add resolved (cons t1 t2)))]
-      
-      ;; we don't actually want this - want something that's a part of t1
-      [(_ _) #:when (subtype t2 t1)
-             t2]
-      
-      ;; there's no overlap, so the restriction is empty
-      [(_ _) #:when (not (overlap t1 t2)) 
-             (Un)]
-      
-      ;; t2 and t1 have a complex relationship, so we punt
-      [(_ _) (if (eq? pref 'new) t2 t1)]))
-  (restrict* t1 t2 pref (set)))

typed-racket-lib/typed-racket/infer/signatures.rkt

@@ -20,8 +20,8 @@
    [cond-contracted cset-join ((listof cset?) . -> . cset?)]
    [cond-contracted c-meet ((c? c?) (symbol?) . ->* . (or/c #f c?))]))
 
-(define-signature restrict^
-  ([cond-contracted restrict ((Type/c Type/c) ((or/c 'new 'orig)) . ->* . Type/c)]))
+(define-signature intersect^
+  ([cond-contracted intersect (Type/c Type/c . -> . Type/c)]))
 
 (define-signature infer^
   ([cond-contracted infer ((;; variables from the forall

typed-racket-lib/typed-racket/optimizer/hidden-costs.rkt

@@ -45,18 +45,6 @@
     #:do [(log-optimization-info "hidden parameter (random)" #'op)]
     #:with opt (syntax/loc this-syntax (op args.opt ...)))
 
-  ;; Log calls to struct constructors, so that OC can report those used in
-  ;; hot loops.
-  ;; Note: Sometimes constructors are wrapped in `#%expression', need to watch
-  ;;  for that too.
-  (pattern (#%plain-app (~and op-part (~or op:id (#%expression op:id)))
-                        args:opt-expr ...)
-    #:when (let ([constructor-for (syntax-property #'op 'constructor-for)])
-             (or (and constructor-for (struct-constructor? constructor-for))
-                 (struct-constructor? #'op)))
-    #:do [(log-optimization-info "struct constructor" #'op)]
-    #:with opt (syntax/loc this-syntax (op-part args.opt ...)))
-
   ;; regexp-match (or other regexp operation) with non-regexp pattern argument
   ;; (i.e. string or bytes)
   (pattern (#%plain-app op:regexp-function pattern-arg:opt-expr

typed-racket-lib/typed-racket/private/cast-table.rkt

@@ -0,0 +1,25 @@
+#lang racket/base
+
+(provide cast-table-ref
+         cast-table-set!)
+
+(require syntax/id-table)
+
+;; A module that helps store information about the original types of casted
+;; expressions.
+;;
+;; Casts in Typed Racket must generate two contracts. One from typed to untyped,
+;; and another from untyped to typed. The contract from typed to untyped is
+;; generated based on the existing type of the expression, which must be stored
+;; in this table so that it can be looked up later in the contract-generation
+;; pass.
+
+(define cast-table (make-free-id-table))
+
+;; cast-table-set! : Id Type-Stx -> Void
+(define (cast-table-set! id type-stx)
+  (free-id-table-set! cast-table id type-stx))
+
+;; cast-table-ref : Id -> (U False Type-Stx)
+(define (cast-table-ref id)
+  (free-id-table-ref cast-table id #f))

typed-racket-lib/typed-racket/private/oc-button.rkt

@@ -0,0 +1,16 @@
+#lang racket/base
+
+;; Control whether the OC button show up for TR files in DrR.
+
+(provide maybe-show-OC)
+
+(define (maybe-show-OC)
+  ;; If Optimization Coach is installed, load it.
+  (with-handlers ([exn:fail:filesystem? (lambda _ '())]) ; not found
+    (collection-path "optimization-coach")
+    (if (dynamic-require 'optimization-coach/tool
+                         'optimization-coach-loaded?)
+        ;; OC is loaded, show button
+        (list (dynamic-require 'optimization-coach/tool
+                               'optimization-coach-drracket-button))
+        '())))

typed-racket-lib/typed-racket/private/parse-type.rkt

@@ -2,11 +2,12 @@
 
 ;; This module provides functions for parsing types written by the user
 
-(require "../utils/utils.rkt"
+(require (rename-in "../utils/utils.rkt" [infer infer-in])
          (except-in (rep type-rep object-rep) make-arr)
-         (rename-in (types abbrev union utils filter-ops resolve
+         (rename-in (types abbrev union utils prop-ops resolve
                            classes prefab signatures)
                     [make-arr* make-arr])
+         (only-in (infer-in infer) intersect)
          (utils tc-utils stxclass-util literal-syntax-class)
          syntax/stx (prefix-in c: (contract-req))
          syntax/parse racket/sequence
@@ -108,6 +109,8 @@
 (define-literal-syntax-class #:for-label Top)
 (define-literal-syntax-class #:for-label Bot)
 (define-literal-syntax-class #:for-label Distinction)
+(define-literal-syntax-class #:for-label Sequenceof)
+(define-literal-syntax-class #:for-label ∩)
 
 ;; (Syntax -> Type) -> Syntax Any -> Syntax
 ;; See `parse-type/id`. This is a curried generalization.
@@ -226,7 +229,7 @@
   #:attributes (type)
   (pattern (~optional (~seq #:rest type:non-keyword-ty))))
 
-;; syntax classes for filters, objects, and related things
+;; syntax classes for props, objects, and related things
 (define-syntax-class path-elem
   #:description "path element"
   (pattern :car^
@@ -243,8 +246,8 @@
   #:description "!"
   (pattern (~datum !)))
 
-(define-splicing-syntax-class simple-latent-filter
-  #:description "latent filter"
+(define-splicing-syntax-class simple-latent-prop
+  #:description "latent prop"
   (pattern (~seq t:expr :@ pe:path-elem ...)
            #:attr type (parse-type #'t)
            #:attr path (attribute pe.pe))
@@ -253,54 +256,54 @@
            #:attr path '()))
 
 (define-syntax-class (prop doms)
-  #:description "filter proposition"
+  #:description "proposition"
   #:attributes (prop)
-  (pattern :Top^ #:attr prop -top)
-  (pattern :Bot^ #:attr prop -bot)
+  (pattern :Top^ #:attr prop -tt)
+  (pattern :Bot^ #:attr prop -ff)
   ;; Here is wrong check
-  (pattern (t:expr :@ ~! pe:path-elem ... (~var o (filter-object doms)))
-           #:attr prop (-filter (parse-type #'t) (-acc-path (attribute pe.pe) (attribute o.obj))))
+  (pattern (t:expr :@ ~! pe:path-elem ... (~var o (prop-object doms)))
+           #:attr prop (-is-type (-acc-path (attribute pe.pe) (attribute o.obj)) (parse-type #'t)))
   ;; Here is wrong check
-  (pattern (:! t:expr :@ ~! pe:path-elem ... (~var o (filter-object doms)))
-           #:attr prop (-not-filter (parse-type #'t) (-acc-path (attribute pe.pe) (attribute o.obj))))
+  (pattern (:! t:expr :@ ~! pe:path-elem ... (~var o (prop-object doms)))
+           #:attr prop (-not-type (-acc-path (attribute pe.pe) (attribute o.obj)) (parse-type #'t)))
   (pattern (:! t:expr)
-           #:attr prop (-not-filter (parse-type #'t) 0))
+           #:attr prop (-not-type 0 (parse-type #'t)))
   (pattern ((~datum and) (~var p (prop doms)) ...)
            #:attr prop (apply -and (attribute p.prop)))
   (pattern ((~datum or) (~var p (prop doms)) ...)
            #:attr prop (apply -or (attribute p.prop)))
   (pattern ((~literal implies) (~var p1 (prop doms)) (~var p2 (prop doms)))
-           #:attr prop (-imp (attribute p1.prop) (attribute p2.prop)))
+           #:attr prop (-or (negate-prop (attribute p1.prop)) (attribute p2.prop)))
   (pattern t:expr
-           #:attr prop (-filter (parse-type #'t) 0)))
+           #:attr prop (-is-type 0 (parse-type #'t))))
 
-(define-splicing-syntax-class (filter-object doms)
-  #:description "filter object"
+(define-splicing-syntax-class (prop-object doms)
+  #:description "prop object"
   #:attributes (obj)
   (pattern i:id
            #:fail-unless (identifier-binding #'i)
-           "Filters for predicates may not reference identifiers that are unbound"
+           "Propositions for predicates may not reference identifiers that are unbound"
            #:fail-when (is-var-mutated? #'i)
-           "Filters for predicates may not reference identifiers that are mutated"
+           "Propositions for predicates may not reference identifiers that are mutated"
            #:attr obj (-id-path #'i))
   (pattern idx:nat
            #:do [(define arg (syntax-e #'idx))]
            #:fail-unless (< arg (length doms))
-           (format "Filter proposition's object index ~a is larger than argument length ~a"
+           (format "Proposition's object index ~a is larger than argument length ~a"
                    arg (length doms))
            #:attr obj (-arg-path arg 0))
   (pattern (~seq depth-idx:nat idx:nat)
            #:do [(define arg (syntax-e #'idx))
                  (define depth (syntax-e #'depth-idx))]
            #:fail-unless (<= depth (length (current-arities)))
-           (format "Index ~a used in a filter, but the use is only within ~a enclosing functions"
+           (format "Index ~a used in a proposition, but the use is only within ~a enclosing functions"
                    depth (length (current-arities)))
            #:do [(define actual-arg
                    (if (zero? depth)
                        (length doms)
                        (list-ref (current-arities) (sub1 depth))))]
            #:fail-unless (< arg actual-arg)
-           (format "Filter proposition's object index ~a is larger than argument length ~a"
+           (format "Proposition's object index ~a is larger than argument length ~a"
                    depth actual-arg)
            #:attr obj (-arg-path arg (syntax-e #'depth-idx))))
 
@@ -465,6 +468,10 @@
                  t*))))]
       [(:U^ ts ...)
        (apply Un (parse-types #'(ts ...)))]
+      [(:∩^ ts ...)
+       (for/fold ([ty Univ])
+                 ([t (in-list (parse-types #'(ts ...)))])
+         (intersect ty t))]
       [(:quote^ t)
        (parse-quoted-type #'t)]
       [(:All^ . rest)
@@ -483,6 +490,8 @@
         #:stx stx
         (~a (syntax-e #'p) " expects one or two type arguments, given "
             (sub1 (length (syntax->list #'(args ...))))))]
+      [(:Sequenceof^ t ...)
+       (apply -seq (parse-types #'(t ...)))]
       ;; curried function notation
       [((~and dom:non-keyword-ty (~not :->^)) ...
         :->^
@@ -495,9 +504,9 @@
             (list (make-arr
                    doms
                    (parse-type (syntax/loc stx (rest-dom ...))))))))]
-      [(~or (:->^ dom rng :colon^ latent:simple-latent-filter)
-            (dom :->^ rng :colon^ latent:simple-latent-filter))
-       ;; use parse-type instead of parse-values-type because we need to add the filters from the pred-ty
+      [(~or (:->^ dom rng :colon^ latent:simple-latent-prop)
+            (dom :->^ rng :colon^ latent:simple-latent-prop))
+       ;; use parse-type instead of parse-values-type because we need to add the props from the pred-ty
        (with-arity 1
          (make-pred-ty (list (parse-type #'dom)) (parse-type #'rng) (attribute latent.type)
                        (-acc-path (attribute latent.path) (-arg-path 0))))]
@@ -557,11 +566,11 @@
              :colon^ (~var latent (full-latent (syntax->list #'(dom ...)))))
             (dom:non-keyword-ty ... :->^ rng:expr
              ~! :colon^ (~var latent (full-latent (syntax->list #'(dom ...))))))
-       ;; use parse-type instead of parse-values-type because we need to add the filters from the pred-ty
+       ;; use parse-type instead of parse-values-type because we need to add the props from the pred-ty
        (with-arity (length (syntax->list #'(dom ...)))
          (->* (parse-types #'(dom ...))
               (parse-type #'rng)
-              : (-FS (attribute latent.positive) (attribute latent.negative))
+              : (-PS (attribute latent.positive) (attribute latent.negative))
               : (attribute latent.object)))]
       [(:->*^ (~var mand (->*-args #t))
               (~optional (~var opt (->*-args #f))
@@ -921,11 +930,12 @@
 (define (parse-tc-results stx)
   (syntax-parse stx
     [((~or :Values^ :values^) t ...)
+     (define empties (stx-map (λ (x) #f) #'(t ...)))
      (ret (parse-types #'(t ...))
-          (stx-map (lambda (x) -no-filter) #'(t ...))
-          (stx-map (lambda (x) -no-obj) #'(t ...)))]
-    [:AnyValues^ (tc-any-results -no-filter)]
-    [t (ret (parse-type #'t) -no-filter -no-obj)]))
+          empties
+          empties)]
+    [:AnyValues^ (tc-any-results #f)]
+    [t (ret (parse-type #'t) #f #f)]))
 
 (define parse-type/id (parse/id parse-type))
 

typed-racket-lib/typed-racket/private/syntax-properties.rkt

@@ -50,9 +50,10 @@
   (ignore typechecker:ignore #:mark)
   (ignore-some typechecker:ignore-some #:mark)
   (ignore-some-expr typechecker:ignore-some)
-  (contract-def typechecker:contract-def)
+  (contract-def typechecker:contract-def) ; -> Contract-Def (struct in type-contract.rkt)
   (contract-def/provide typechecker:contract-def/provide)
   (external-check typechecker:external-check)
+  (casted-expr typechecker:casted-expr) ; Type -> Void, takes the original type of the casted expr
   (with-type typechecker:with-type #:mark)
   (type-ascription type-ascription)
   (type-inst type-inst)

typed-racket-lib/typed-racket/private/type-contract.rkt

@@ -5,19 +5,19 @@
 (require
  "../utils/utils.rkt"
  syntax/parse
- (rep type-rep filter-rep object-rep)
+ (rep type-rep prop-rep object-rep)
  (utils tc-utils)
  (env type-name-env row-constraint-env)
  (rep rep-utils)
  (types resolve union utils printer)
- (prefix-in t: (types abbrev numeric-tower))
+ (prefix-in t: (types abbrev numeric-tower subtype))
  (private parse-type syntax-properties)
  racket/match racket/syntax racket/list
  racket/format
- racket/dict
+ racket/dict racket/set
  syntax/flatten-begin
  (only-in (types abbrev) -Bottom -Boolean)
- (static-contracts instantiate optimize structures combinators)
+ (static-contracts instantiate optimize structures combinators constraints)
  ;; TODO make this from contract-req
  (prefix-in c: racket/contract)
  (contract-req)
@@ -39,14 +39,26 @@
 ;; submod for testing
 (module* test-exports #f (provide type->contract))
 
+;; has-contrat-def-property? : Syntax -> Boolean
+(define (has-contract-def-property? stx)
+  (syntax-parse stx
+    #:literal-sets (kernel-literals)
+    [(define-values (_) e)
+     (and (contract-def-property #'e)
+          #t)]
+    [_ #f]))
+
 (struct contract-def (type flat? maker? typed-side) #:prefab)
 
+;; get-contract-def-property : Syntax -> (U False Contract-Def)
 ;; Checks if the given syntax needs to be fixed up for contract generation
 ;; and if yes it returns the information stored in the property
 (define (get-contract-def-property stx)
   (syntax-parse stx
     #:literal-sets (kernel-literals)
-    [(define-values (_) e) (contract-def-property #'e)]
+    [(define-values (_) e)
+     (and (contract-def-property #'e)
+          ((contract-def-property #'e)))]
     [_ #f]))
 
 ;; type->contract-fail : Syntax Type #:ctc-str String
@@ -123,7 +135,7 @@
            [else
             (match-define (list defs ctc) result)
             (define maybe-inline-val
-              (should-inline-contract? ctc cache))
+              (should-inline-contract?/cache ctc cache))
             #`(begin #,@defs
                      #,@(if maybe-inline-val
                             null
@@ -141,15 +153,11 @@
 ;; Syntax (Dict Static-Contract (Cons Id Syntax)) -> (Option Syntax)
 ;; A helper for generate-contract-def/provide that helps inline contract
 ;; expressions when needed to cooperate with the contract system's optimizations
-(define (should-inline-contract? ctc-stx cache)
+(define (should-inline-contract?/cache ctc-stx cache)
   (and (identifier? ctc-stx)
        (let ([match? (assoc ctc-stx (hash-values cache) free-identifier=?)])
          (and match?
-              ;; ->* are handled specially by the contract system
-              (let ([sexp (syntax-e (cdr match?))])
-                (and (pair? sexp)
-                     (or (free-identifier=? (car sexp) #'->)
-                         (free-identifier=? (car sexp) #'->*))))
+              (should-inline-contract? (cdr match?))
               (cdr match?)))))
 
 ;; The below requires are needed since they provide identifiers that
@@ -167,6 +175,7 @@
       typed-racket/utils/evt-contract
       typed-racket/utils/sealing-contract
       typed-racket/utils/promise-not-name-contract
+      typed-racket/utils/simple-result-arrow
       racket/sequence
       racket/contract/parametric))
 
@@ -181,7 +190,7 @@
   (define sc-cache (make-hash))
   (with-new-name-tables
    (for/list ((e (in-list forms)))
-     (if (not (get-contract-def-property e))
+     (if (not (has-contract-def-property? e))
          e
          (begin (set-box! include-extra-requires? #t)
                 (generate-contract-def e ctc-cache sc-cache))))))
@@ -207,6 +216,15 @@
                                      ctc-cache sc-cache)))]
        [_ form]))))
 
+;; get-max-contract-kind
+;; static-contract -> (or/c 'flat 'chaperone 'impersonator)
+;; recurse into a contract finding the max
+;; kind (e.g. flat < chaperone < impersonator)
+(define (get-max-contract-kind sc)
+    (define (get-restriction sc)
+      (sc->constraints sc get-restriction))
+    (kind-max-max (contract-restrict-value (get-restriction sc))))
+
 ;; To avoid misspellings
 (define impersonator-sym 'impersonator)
 (define chaperone-sym 'chaperone)
@@ -381,9 +399,24 @@
          (if numeric-sc
              (apply or/sc numeric-sc (map t->sc non-numeric))
              (apply or/sc (map t->sc elems)))]
+        [(Intersection: ts)
+         (define-values (chaperones/impersonators others)
+           (for/fold ([cs/is null] [others null])
+                     ([elem (in-immutable-set ts)])
+             (define c (t->sc elem))
+             (if (equal? flat-sym (get-max-contract-kind c))
+                 (values cs/is (cons c others))
+                 (values (cons c cs/is) others))))
+         (cond
+           [(> (length chaperones/impersonators) 1)
+            (fail #:reason (~a "Intersection type contract contains"
+                               " more than 1 non-flat contract: "
+                               type))]
+           [else
+            (apply and/sc (append others chaperones/impersonators))])]
         [(and t (Function: arrs))
          #:when (any->bool? arrs)
-         ;; Avoid putting (-> any boolean) contracts on struct predicates
+         ;; Avoid putting (-> any T) contracts on struct predicates (where Boolean <: T)
          ;; Optimization: if the value is typed, we can assume it's not wrapped
          ;;  in a type-unsafe chaperone/impersonator and use the unsafe contract
          (let* ([unsafe-spp/sc (flat/sc #'struct-predicate-procedure?)]
@@ -586,7 +619,14 @@
         [(Syntax: t)
          (syntax/sc (t->sc t))]
         [(Value: v)
-         (flat/sc #`(flat-named-contract '#,v (lambda (x) (equal? x '#,v))) v)]
+         (if (and (c:flat-contract? v)
+                  ;; numbers used as contracts compare with =, but TR
+                  ;; requires an equal? check
+                  (not (number? v))
+                  ;; regexps don't match themselves when used as contracts
+                  (not (regexp? v)))
+             (flat/sc #`(quote #,v))
+             (flat/sc #`(flat-named-contract '#,v (lambda (x) (equal? x '#,v))) v))]
         [(Param: in out) 
          (parameter/sc (t->sc in) (t->sc out))]
         [(Hashtable: k v)
@@ -609,17 +649,21 @@
   ;; and call the given thunk or raise an error
   (define (handle-range arr convert-arr)
     (match arr
-      ;; functions with no filters or objects
-      [(arr: dom (Values: (list (Result: rngs (FilterSet: (Top:) (Top:)) (Empty:)) ...)) rst drst kws)
+      ;; functions with no props or objects
+      [(arr: dom (Values: (list (Result: rngs
+                                         (PropSet: (TrueProp:)
+                                                   (TrueProp:))
+                                         (Empty:)) ...))
+             rst drst kws)
        (convert-arr)]
       ;; Functions that don't return
       [(arr: dom (Values: (list (Result: (== -Bottom) _ _) ...)) rst drst kws)
        (convert-arr)]
-      ;; functions with filters or objects
+      ;; functions with props or objects
       [(arr: dom (Values: (list (Result: rngs _ _) ...)) rst drst kws)
        (if (from-untyped? typed-side)
            (fail #:reason (~a "cannot generate contract for function type"
-                              " with filters or objects."))
+                              " with props or objects."))
            (convert-arr))]
       [(arr: dom (? ValuesDots?) rst drst kws)
        (fail #:reason (~a "cannot generate contract for function type"
@@ -661,7 +705,7 @@
                      (map conv opt-kws))))
          (define range (map t->sc rngs))
          (define rest (and rst (listof/sc (t->sc/neg rst))))
-         (function/sc (process-dom mand-args) opt-args mand-kws opt-kws rest range))
+         (function/sc (from-typed? typed-side) (process-dom mand-args) opt-args mand-kws opt-kws rest range))
        (handle-range first-arr convert-arr)]
       [else
        (define ((f case->) a)
@@ -678,6 +722,7 @@
                           (and rst (listof/sc (t->sc/neg rst)))
                           (map t->sc rngs))
                   (function/sc
+                    (from-typed? typed-side)
                     (process-dom (map t->sc/neg dom))
                     null
                     (map conv mand-kws)
@@ -792,7 +837,7 @@
   (let/ec escape
     (let loop ([type type])
       (type-case
-       (#:Type loop #:Filter (sub-f loop) #:Object (sub-o loop))
+       (#:Type loop #:Prop (sub-f loop) #:Object (sub-o loop))
        type
        [#:App arg _ _
         (match arg
@@ -804,9 +849,9 @@
 (define (any->bool? arrs)
   (match arrs
     [(list (arr: (list (Univ:))
-                 (Values: (list (Result: (== -Boolean) _ _)))
+                 (Values: (list (Result: t _ _)))
                  #f #f '()))
-     #t]
+     (t:subtype -Boolean t)]
     [_ #f]))
 
 (module predicates racket/base

typed-racket-lib/typed-racket/private/with-types.rkt

@@ -154,10 +154,11 @@
 (define (type-stxs->ids+defs type-stxs typed-side)
   (for/lists (_1 _2) ([t (in-list type-stxs)])
     (define ctc-id (generate-temporary))
+    (define contract-def `#s(contract-def ,t #f #f ,typed-side))
     (values ctc-id
             #`(define-values (#,ctc-id)
                 #,(contract-def-property
-                   #'#f `#s(contract-def ,t #f #f ,typed-side))))))
+                   #'#f (λ () contract-def))))))
 
 (define (wt-core stx)
   (define-syntax-class typed-id

typed-racket-lib/typed-racket/rep/filter-rep.rkt

@@ -1,70 +1,4 @@
 #lang racket/base
 
-(require "../utils/utils.rkt" "rep-utils.rkt" "free-variance.rkt")
-
-(provide hash-name filter-equal?)
-
-(begin-for-cond-contract
-  (require racket/contract/base racket/lazy-require)
-  (lazy-require ["type-rep.rkt" (Type/c Univ? Bottom?)]
-                ["object-rep.rkt" (Path?)]))
-
-(provide-for-cond-contract Filter/c FilterSet/c name-ref/c)
-
-(define-for-cond-contract (Filter/c-predicate? e)
-  (and (Filter? e) (not (NoFilter? e)) (not (FilterSet? e))))
-(define-for-cond-contract Filter/c
-  (flat-named-contract 'Filter Filter/c-predicate?))
-
-(define-for-cond-contract FilterSet/c
-  (flat-named-contract
-   'FilterSet
-   (λ (e) (or (FilterSet? e) (NoFilter? e)))))
-
-;; A Name-Ref is any value that represents an object.
-;; As an identifier, it represents a free variable in the environment
-;; As a list, it represents a De Bruijn indexed bound variable
-(define-for-cond-contract name-ref/c
-  (or/c identifier? (list/c integer? integer?)))
-(define (hash-name v) (if (identifier? v) (hash-id v) (list v)))
-
-(define-for-cond-contract ((length>=/c len) l)
-  (and (list? l)
-       (>= (length l) len)))
-
-(def-filter Bot () [#:fold-rhs #:base])
-(def-filter Top () [#:fold-rhs #:base])
-
-(def-filter TypeFilter ([t (and/c Type/c (not/c Univ?) (not/c Bottom?))] [p Path?])
-  [#:intern (list (Rep-seq t) (Rep-seq p))]
-  [#:frees (λ (f) (combine-frees (map f (list t p))))]
-  [#:fold-rhs (*TypeFilter (type-rec-id t) (object-rec-id p))])
-
-(def-filter NotTypeFilter ([t (and/c Type/c (not/c Univ?) (not/c Bottom?))] [p Path?])
-  [#:intern (list (Rep-seq t) (Rep-seq p))]
-  [#:frees (λ (f) (combine-frees (map f (list t p))))]
-  [#:fold-rhs (*NotTypeFilter (type-rec-id t) (object-rec-id p))])
-
-;; implication
-(def-filter ImpFilter ([a Filter/c] [c Filter/c]))
-
-(def-filter OrFilter ([fs (and/c (length>=/c 2)
-                                 (listof (or/c TypeFilter? NotTypeFilter? ImpFilter?)))])
-  [#:intern (map Rep-seq fs)]
-  [#:fold-rhs (*OrFilter (map filter-rec-id fs))]
-  [#:frees (λ (f) (combine-frees (map f fs)))])
-
-(def-filter AndFilter ([fs (and/c (length>=/c 2)
-                                  (listof (or/c OrFilter? TypeFilter? NotTypeFilter? ImpFilter?)))])
-  [#:intern (map Rep-seq fs)]
-  [#:fold-rhs (*AndFilter (map filter-rec-id fs))]
-  [#:frees (λ (f) (combine-frees (map f fs)))])
-
-(def-filter FilterSet ([thn Filter/c] [els Filter/c])
-  [#:fold-rhs (*FilterSet (filter-rec-id thn) (filter-rec-id els))])
-
-;; represents no info about the filters of this expression
-;; should only be used for parsing type annotations and expected types
-(def-filter NoFilter () [#:fold-rhs #:base])
-
-(define (filter-equal? a b) (= (Rep-seq a) (Rep-seq b)))
+(require "prop-rep.rkt")
+(provide (all-from-out "prop-rep.rkt"))

typed-racket-lib/typed-racket/rep/object-rep.rkt

@@ -5,7 +5,7 @@
 ;;
 ;; See "Logical Types for Untyped Languages" pg.3
 
-(require "rep-utils.rkt" "free-variance.rkt" "filter-rep.rkt" "../utils/utils.rkt" (contract-req))
+(require "rep-utils.rkt" "free-variance.rkt" "prop-rep.rkt" "../utils/utils.rkt" (contract-req))
 (provide object-equal?)
 
 (def-pathelem CarPE () [#:fold-rhs #:base])
@@ -25,16 +25,4 @@
   [#:frees (λ (f) (combine-frees (map f p)))]
   [#:fold-rhs (*Path (map pathelem-rec-id p) v)])
 
-;; represents no info about the object of this expression
-;; should only be used for parsing type annotations and expected types
-(def-object NoObject () [#:fold-rhs #:base])
-
 (define (object-equal? o1 o2) (= (Rep-seq o1) (Rep-seq o2)))
-
-#|
-(dlo LEmpty () [#:fold-rhs #:base])
-
-(dlo LPath ([p (listof PathElem?)] [idx index/c])
-  [#:frees (λ (f) (combine-frees (map f p)))]
-  [#:fold-rhs (*LPath (map pathelem-rec-id p) idx)])
-|#

typed-racket-lib/typed-racket/rep/prop-rep.rkt

@@ -0,0 +1,56 @@
+#lang racket/base
+
+(require "../utils/utils.rkt" "rep-utils.rkt" "free-variance.rkt")
+
+(provide hash-name prop-equal?)
+
+(begin-for-cond-contract
+  (require racket/contract/base racket/lazy-require)
+  (lazy-require ["type-rep.rkt" (Type/c Univ? Bottom?)]
+                ["object-rep.rkt" (Path?)]))
+
+(provide-for-cond-contract name-ref/c)
+
+
+;; A Name-Ref is any value that represents an object.
+;; As an identifier, it represents a free variable in the environment
+;; As a list, it represents a De Bruijn indexed bound variable
+(define-for-cond-contract name-ref/c
+  (or/c identifier? (list/c integer? integer?)))
+(define (hash-name v) (if (identifier? v) (hash-id v) (list v)))
+
+(define-for-cond-contract ((length>=/c len) l)
+  (and (list? l)
+       (>= (length l) len)))
+
+;; the trivially "true" proposition
+(def-prop TrueProp () [#:fold-rhs #:base])
+;; the absurd, "false" proposition
+(def-prop FalseProp () [#:fold-rhs #:base])
+
+(def-prop TypeProp ([p Path?] [t (and/c Type/c (not/c Univ?) (not/c Bottom?))])
+  [#:intern (list (Rep-seq t) (Rep-seq p))]
+  [#:frees (λ (f) (combine-frees (map f (list t p))))]
+  [#:fold-rhs (*TypeProp (object-rec-id p) (type-rec-id t))])
+
+(def-prop NotTypeProp ([p Path?] [t (and/c Type/c (not/c Univ?) (not/c Bottom?))])
+  [#:intern (list (Rep-seq t) (Rep-seq p))]
+  [#:frees (λ (f) (combine-frees (map f (list t p))))]
+  [#:fold-rhs (*NotTypeProp (object-rec-id p) (type-rec-id t))])
+
+(def-prop OrProp ([fs (and/c (length>=/c 2)
+                           (listof (or/c TypeProp? NotTypeProp?)))])
+  [#:intern (map Rep-seq fs)]
+  [#:fold-rhs (*OrProp (map prop-rec-id fs))]
+  [#:frees (λ (f) (combine-frees (map f fs)))])
+
+(def-prop AndProp ([fs (and/c (length>=/c 2)
+                          (listof (or/c OrProp? TypeProp? NotTypeProp?)))])
+  [#:intern (map Rep-seq fs)]
+  [#:fold-rhs (*AndProp (map prop-rec-id fs))]
+  [#:frees (λ (f) (combine-frees (map f fs)))])
+
+(def-prop PropSet ([thn Prop?] [els Prop?])
+  [#:fold-rhs (*PropSet (prop-rec-id thn) (prop-rec-id els))])
+
+(define (prop-equal? a b) (= (Rep-seq a) (Rep-seq b)))

typed-racket-lib/typed-racket/rep/rep-utils.rkt

@@ -20,7 +20,7 @@
 
 
 (lazy-require
-  ["../types/printer.rkt" (print-type print-filter print-object print-pathelem)])
+  ["../types/printer.rkt" (print-type print-prop print-object print-pathelem)])
 
 
 (provide == defintern hash-id (for-syntax fold-target))
@@ -135,7 +135,7 @@
                           #:defaults
                           ([frees.f1 (combiner #'Rep-free-vars #'flds.fields)]
                            [frees.f2 (combiner #'Rep-free-idxs #'flds.fields)]))
-               ;; This tricky beast is for defining the type/filter/etc.'s
+               ;; This tricky beast is for defining the type/prop/etc.'s
                ;; part of the fold. The make-prim-type's given
                ;; rec-ids are bound in this expression's context.
                (~optional [#:fold-rhs (~var fold-rhs (fold-pat #'name.fold))]
@@ -204,7 +204,7 @@
             provides))])))
 
 ;; rec-ids are identifiers that are of the folded type, so we recur on them.
-;; kws is e.g. '(#:Type #:Filter #:Object #:PathElem)
+;; kws is e.g. '(#:Type #:Prop #:Object #:PathElem)
 (define-for-syntax (mk-fold hashtable rec-ids kws)
   (lambda (stx)
     (define new-hashtable (make-hasheq))
@@ -217,7 +217,7 @@
                         (syntax/loc this-syntax (pats ...))
                         (lambda () #'e)
                         this-syntax))
-      ;; Match on a type (or filter etc) case with keyword k
+      ;; Match on a type (or prop etc) case with keyword k
       ;; pats are the unignored patterns (say for rator rand)
       ;; and e is the expression that will run as fold-rhs.
       (pattern
@@ -351,18 +351,18 @@
                            ;; [unsyntax (*1)]
                            (mk-fold ht
                                     rec-ids
-                                    ;; '(#:Type #:Filter #:Object #:PathElem)
+                                    ;; '(#:Type #:Prop #:Object #:PathElem)
                                     '(i.kw ...)))
                          (list i.hashtable ...))))))]))
 
 (make-prim-type [Type def-type #:Type type-case print-type type-name-ht type-rec-id #:key]
-                [Filter def-filter #:Filter filter-case print-filter filter-name-ht filter-rec-id]
+                [Prop def-prop #:Prop prop-case print-prop prop-name-ht prop-rec-id]
                 [Object def-object #:Object object-case print-object object-name-ht object-rec-id]
                 [PathElem def-pathelem #:PathElem pathelem-case print-pathelem pathelem-name-ht pathelem-rec-id])
 
 (define (Rep-values rep)
   (match rep
-    [(? (lambda (e) (or (Filter? e)
+    [(? (lambda (e) (or (Prop? e)
                         (Object? e)
                         (PathElem? e)))
         (app (lambda (v) (vector->list (struct->vector v))) (list-rest tag seq fv fi stx vals)))
@@ -386,7 +386,7 @@
 (provide/cond-contract
   [rename rep-equal? type-equal? (Type? Type? . -> . boolean?)]
   [rename rep<? type<? (Type? Type? . -> . boolean?)]
-  [rename rep<? filter<? (Filter? Filter? . -> . boolean?)]
+  [rename rep<? prop<? (Prop? Prop? . -> . boolean?)]
   [struct Rep ([seq exact-nonnegative-integer?]
                [free-vars (hash/c symbol? variance?)]
                [free-idxs (hash/c symbol? variance?)]

typed-racket-lib/typed-racket/rep/type-rep.rkt

@@ -7,8 +7,8 @@
 
 ;; TODO use contract-req
 (require (utils tc-utils)
-         "rep-utils.rkt" "object-rep.rkt" "filter-rep.rkt" "free-variance.rkt"
-         racket/match racket/list
+         "rep-utils.rkt" "object-rep.rkt" "prop-rep.rkt" "free-variance.rkt"
+         racket/match racket/list racket/set
          racket/contract
          racket/lazy-require
          racket/promise
@@ -19,10 +19,11 @@
          PolyDots-names:
          PolyRow-names: PolyRow-fresh:
          Type-seq
+         -unsafe-intersect
          Mu-unsafe: Poly-unsafe:
          PolyDots-unsafe:
          Mu? Poly? PolyDots? PolyRow?
-         Filter? Object?
+         Prop? Object?
          Type/c Type/c?
          Values/c SomeValues/c
          Bottom?
@@ -53,8 +54,9 @@
 
 ;; Ugly hack - should use units
 (lazy-require
-  ("../types/union.rkt" (Un))
-  ("../types/resolve.rkt" (resolve-app)))
+ ("../types/union.rkt" (Un))
+ ("../types/overlap.rkt" (overlap?))
+ ("../types/resolve.rkt" (resolve-app)))
 
 (define name-table (make-weak-hasheq))
 
@@ -274,9 +276,9 @@
   [#:frees (λ (f) (f ty))]
   [#:fold-rhs (*Keyword kw (type-rec-id ty) required?)])
 
-(def-type Result ([t Type/c] [f FilterSet?] [o Object?])
+(def-type Result ([t Type/c] [f PropSet?] [o Object?])
   [#:frees (λ (frees) (combine-frees (map frees (list t f o))))]
-  [#:fold-rhs (*Result (type-rec-id t) (filter-rec-id f) (object-rec-id o))])
+  [#:fold-rhs (*Result (type-rec-id t) (prop-rec-id f) (object-rec-id o))])
 
 (def-type Values ([rs (listof Result?)])
   [#:intern (map Rep-seq rs)]
@@ -284,7 +286,7 @@
   [#:fold-rhs (*Values (map type-rec-id rs))])
 
 
-(def-type AnyValues ([f Filter/c])
+(def-type AnyValues ([f Prop?])
   [#:fold-rhs #:base])
 
 (def-type ValuesDots ([rs (listof Result?)] [dty Type/c] [dbound (or/c symbol? natural-number/c)])
@@ -449,6 +451,55 @@
      (define d* (remove-duplicates d))
      (if (and (pair? d*) (null? (cdr d*))) (car d*) d*))])
 
+
+;; Intersection
+(def-type Intersection ([elems (and/c (set/c Type/c)
+                                      (λ (s) (>= (set-count s) 2)))])
+  [#:intern (for/set ([e (in-immutable-set elems)])
+              (Rep-seq e))]
+  [#:frees (λ (f) (combine-frees (for/list ([elem (in-immutable-set elems)])
+                                   (f elem))))]
+  [#:fold-rhs (let ([elems (for/list ([elem (in-immutable-set elems)])
+                             (type-rec-id elem))])
+                (apply -unsafe-intersect elems))]
+  [#:key (let ()
+           (define d
+             (let loop ([ts (set->list elems)] [res null])
+               (cond [(null? ts) res]
+                     [else
+                      (define k (Type-key (car ts)))
+                      (cond [(not k) (list #f)]
+                            [(pair? k) (loop (cdr ts) (append k res))]
+                            [else (loop (cdr ts) (cons k res))])])))
+           (define d* (remove-duplicates d))
+           (if (and (pair? d*) (null? (cdr d*))) (car d*) d*))])
+
+;;  constructor for intersections
+;; in general, intersections should be built
+;; using the 'intersect' operator, which worries
+;; about actual subtyping, etc...
+(define (-unsafe-intersect . ts)
+  (let loop ([elems (set)]
+             [ts ts])
+    (match ts
+      [(list)
+       (cond
+         [(set-empty? elems) (Univ)]
+         ;; size = 1 ?
+         [(= 1 (set-count elems)) (set-first elems)]
+         ;; size > 1, build an intersection
+         [else (*Intersection elems)])]
+      [(cons t ts)
+       (match t
+         [(? Bottom?) t]
+         [(Univ:) (loop elems ts)]
+         [(Intersection: ts*) (loop (set-union elems ts*) ts)]
+         [t (cond
+              [(for/or ([elem (in-immutable-set elems)]) (not (overlap? elem t)))
+               (*Union (list))]
+              [else (loop (set-add elems t) ts)])])])))
+
+
 (def-type Univ () [#:frees #f] [#:fold-rhs #:base])
 
 ;; in : Type
@@ -617,10 +668,10 @@
 
 
 (define ((sub-f st) e)
-  (filter-case (#:Type st
-                #:Filter (sub-f st)
-                #:PathElem (sub-pe st))
-               e))
+  (prop-case (#:Type st
+              #:Prop (sub-f st)
+              #:PathElem (sub-pe st))
+             e))
 
 
 (define ((sub-o st) e)
@@ -636,7 +687,7 @@
 
 (define ((sub-t st) e)
   (type-case (#:Type st
-              #:Filter (sub-f st))
+              #:Prop (sub-f st))
               e))
 
 
@@ -657,7 +708,7 @@
                     (f (+ (cdr pr) outer)))]
               [else default]))
       (type-case
-        (#:Type sb #:Filter (sub-f sb) #:Object (sub-o sb))
+        (#:Type sb #:Prop (sub-f sb) #:Object (sub-o sb))
        ty
        [#:F name* (transform name* *B ty)]
        ;; necessary to avoid infinite loops
@@ -711,7 +762,7 @@
       (define (sb t) (loop outer t))
       (define sf (sub-f sb))
       (type-case
-       (#:Type sb #:Filter sf #:Object (sub-o sb))
+       (#:Type sb #:Prop sf #:Object (sub-o sb))
        ty
        [#:B idx (transform idx values ty)]
        ;; necessary to avoid infinite loops

typed-racket-lib/typed-racket/static-contracts/combinators/any.rkt

@@ -28,7 +28,8 @@
           [(define (sc-map v f) v)
            (define (sc-traverse v f) (void))
            (define (sc->contract v f) #'any/c)
-           (define (sc->constraints v f) (simple-contract-restrict 'flat))]
+           (define (sc->constraints v f) (simple-contract-restrict 'flat))
+           (define (sc-terminal-kind v) 'flat)]
         #:methods gen:custom-write [(define write-proc any-write-proc)])
 
 (define-match-expander any/sc:

typed-racket-lib/typed-racket/static-contracts/combinators/function.rkt

@@ -6,12 +6,13 @@
 (require "../structures.rkt" "../constraints.rkt"
          racket/list racket/match
          racket/contract
-         (for-template racket/base racket/contract/base)
+         (for-template racket/base racket/contract/base "../../utils/simple-result-arrow.rkt")
          (for-syntax racket/base syntax/parse))
 
 (provide
   (contract-out
-    [function/sc (-> (listof static-contract?)
+    [function/sc (-> boolean?
+                     (listof static-contract?)
                      (listof static-contract?)
                      (listof (list/c keyword? static-contract?))
                      (listof (list/c keyword? static-contract?))
@@ -21,7 +22,7 @@
   ->/sc:)
 
 
-(struct function-combinator combinator (indices mand-kws opt-kws)
+(struct function-combinator combinator (indices mand-kws opt-kws typed-side?)
         #:property prop:combinator-name "->/sc"
         #:methods gen:equal+hash [(define (equal-proc a b recur) (function-sc-equal? a b recur))
                                   (define (hash-proc v recur) (function-sc-hash v recur))
@@ -30,6 +31,7 @@
           [(define (sc->contract v f) (function-sc->contract v f))
            (define (sc-map v f) (function-sc-map v f))
            (define (sc-traverse v f) (function-sc-map v f) (void))
+           (define (sc-terminal-kind v) (function-sc-terminal-kind v))
            (define (sc->constraints v f) (function-sc-constraints v f))])
 
 (define (split-function-args ctcs mand-args-end opt-args-end
@@ -44,7 +46,10 @@
     (and range-end (drop (take ctcs range-end) rest-end))))
 
 (define (function-sc->contract sc recur)
-  (match-define (function-combinator args indices mand-kws opt-kws) sc) 
+  (match-define (function-combinator args indices mand-kws opt-kws typed-side?) sc)
+
+  (define-values (mand-scs opt-scs mand-kw-scs opt-kw-scs rest-sc range-scs)
+    (apply split-function-args args indices))
 
   (define-values (mand-ctcs opt-ctcs mand-kw-ctcs opt-kw-ctcs rest-ctc range-ctcs)
     (apply split-function-args (map recur args) indices))
@@ -61,14 +66,24 @@
       #`(values #,@range-ctcs)
       #'any))
 
-
-  #`((#,@mand-ctcs #,@mand-kws-stx)
-     (#,@opt-ctcs #,@opt-kws-stx) 
-     #,@rest-ctc-stx
-     . ->* . #,range-ctc))
+  (cond
+   [(and (null? mand-kws) (null? opt-kws)
+         (null? opt-ctcs)
+         (not rest-ctc)
+         ;; currently simple-result-> only handles up to arity 3
+         (member (length mand-ctcs) '(0 1 2 3))
+         (and range-ctcs (= 1 (length range-ctcs)))
+         (for/and ([a args]) (eq? 'flat (sc-terminal-kind a)))
+         (not typed-side?))
+    #`(simple-result-> #,@range-ctcs #,(length mand-ctcs))]
+   [else
+    #`((#,@mand-ctcs #,@mand-kws-stx)
+       (#,@opt-ctcs #,@opt-kws-stx)
+       #,@rest-ctc-stx
+       . ->* . #,range-ctc)]))
 
 
-(define (function/sc mand-args opt-args mand-kw-args opt-kw-args rest range)
+(define (function/sc typed-side? mand-args opt-args mand-kw-args opt-kw-args rest range)
   (define mand-args-end (length mand-args))
   (define opt-args-end (+ mand-args-end (length opt-args)))
   (define mand-kw-args-end (+ opt-args-end (length mand-kw-args)))
@@ -90,14 +105,15 @@
       (or range null))
     end-indices
     mand-kws
-    opt-kws))
+    opt-kws
+    typed-side?))
 
 (define-match-expander ->/sc:
   (syntax-parser
     [(_ mand-args opt-args mand-kw-args opt-kw-args rest range)
      #'(and (? function-combinator?)
             (app (match-lambda
-                   [(function-combinator args indices mand-kws opt-kws)
+                   [(function-combinator args indices mand-kws opt-kws typed-side?)
                     (define-values (mand-args* opt-args* mand-kw-args* opt-kw-args* rest* range*)
                       (apply split-function-args args indices))
                     (list
@@ -109,13 +125,13 @@
                  (list mand-args opt-args mand-kw-args opt-kw-args rest range)))]))
 
 (define (function-sc-map v f)
-  (match-define (function-combinator args indices mand-kws opt-kws) v) 
+  (match-define (function-combinator args indices mand-kws opt-kws typed-side?) v)
 
   (define-values (mand-args opt-args mand-kw-args opt-kw-args rest-arg range-args)
     (apply split-function-args args indices))
 
   (define new-args
-    (append 
+    (append
       (map (lambda (arg) (f arg 'contravariant))
            (append mand-args opt-args mand-kw-args opt-kw-args (if rest-arg (list rest-arg) null)))
       (if range-args
@@ -124,26 +140,49 @@
           empty)))
 
 
-  (function-combinator new-args indices mand-kws opt-kws))
+  (function-combinator new-args indices mand-kws opt-kws typed-side?))
+
+(define (function-sc-terminal-kind v)
+  (match-define (function-combinator args indices mand-kws opt-kws typed-side?) v)
+  (define-values (mand-args opt-args mand-kw-args opt-kw-args rest-arg range-args)
+    (apply split-function-args args indices))
+  (if (and (not rest-arg)
+           (null? (append mand-kw-args mand-args opt-kw-args opt-args))
+           typed-side?)
+      ;; currently we only handle this trivial case
+      ;; we could probably look at the actual kind of `range-args` as well
+      (if (not range-args) 'flat #f)
+      #f))
+
 
 (define (function-sc-constraints v f)
-  (match-define (function-combinator args indices mand-kws opt-kws) v) 
-  (merge-restricts* 'chaperone (map f args)))
+  (match-define (function-combinator args indices mand-kws opt-kws typed-side?) v)
+  (define-values (mand-args opt-args mand-kw-args opt-kw-args rest-arg range-args)
+    (apply split-function-args args indices))
+  (if (and (not rest-arg)
+           (null? (append mand-kw-args mand-args opt-kw-args opt-args))
+           typed-side?)
+      ;; arity-0 functions end up being flat contracts when they're
+      ;; from the typed side and the result is flat
+      (if range-args
+          (merge-restricts* 'flat (map f range-args))
+          (merge-restricts* 'flat null))
+      (merge-restricts* 'chaperone (map f args))))
 
 (define (function-sc-equal? a b recur)
-  (match-define (function-combinator a-args a-indices a-mand-kws a-opt-kws) a) 
-  (match-define (function-combinator b-args b-indices b-mand-kws b-opt-kws) b) 
+  (match-define (function-combinator a-args a-indices a-mand-kws a-opt-kws a-typed-side?) a)
+  (match-define (function-combinator b-args b-indices b-mand-kws b-opt-kws b-typed-side?) b)
   (and
+    (equal? a-typed-side? b-typed-side?)
     (recur a-indices b-indices)
     (recur a-mand-kws b-mand-kws)
     (recur a-opt-kws b-opt-kws)
     (recur a-args b-args)))
 
 (define (function-sc-hash v recur)
-  (match-define (function-combinator v-args v-indices v-mand-kws v-opt-kws) v) 
+  (match-define (function-combinator v-args v-indices v-mand-kws v-opt-kws typed-side?) v)
   (+ (recur v-indices) (recur v-mand-kws) (recur v-opt-kws) (recur v-args)))
 
 (define (function-sc-hash2 v recur)
-  (match-define (function-combinator v-args v-indices v-mand-kws v-opt-kws) v) 
+  (match-define (function-combinator v-args v-indices v-mand-kws v-opt-kws typed-side?) v)
   (+ (recur v-indices) (recur v-mand-kws) (recur v-opt-kws) (recur v-args)))
-

typed-racket-lib/typed-racket/static-contracts/combinators/simple.rkt

@@ -33,6 +33,25 @@
 
 (struct simple-contract static-contract (syntax kind name)
         #:transparent
+        #:methods gen:equal+hash
+         [(define (equal-proc s1 s2 recur)
+            (and ;; only check s-expression equality because it's
+                 ;; unlikely that TR will compile contracts that are
+                 ;; s-exp equal but aren't actually the same contract
+                 (recur (syntax->datum (simple-contract-syntax s1))
+                        (syntax->datum (simple-contract-syntax s2)))
+                 (recur (simple-contract-kind s1)
+                        (simple-contract-kind s2))
+                 (recur (simple-contract-name s1)
+                        (simple-contract-name s2))))
+          (define (hash-proc sc hash-code)
+            (hash-code (list (syntax->datum (simple-contract-syntax sc))
+                             (simple-contract-kind sc)
+                             (simple-contract-name sc))))
+          (define (hash2-proc sc hash-code)
+            (hash-code (list (syntax->datum (simple-contract-syntax sc))
+                             (simple-contract-kind sc)
+                             (simple-contract-name sc))))]
         #:methods gen:sc
          [(define (sc-map v f) v)
           (define (sc-traverse v f) (void))

typed-racket-lib/typed-racket/static-contracts/constraints.rkt

@@ -61,7 +61,8 @@
   contract-restrict-recursive-values
 
   contract-restrict?
-  )
+  contract-restrict-value
+  kind-max-max)
 
 (module structs racket/base
   (require racket/contract

typed-racket-lib/typed-racket/static-contracts/instantiate.rkt

@@ -23,7 +23,8 @@
     [instantiate
       (parametric->/c (a) ((static-contract? (-> #:reason (or/c #f string?) a))
                            (contract-kind? #:cache hash?)
-                           . ->* . (or/c a (list/c (listof syntax?) syntax?))))]))
+                           . ->* . (or/c a (list/c (listof syntax?) syntax?))))]
+    [should-inline-contract? (-> syntax? boolean?)]))
 
 ;; Providing these so that tests can work directly with them.
 (module* internals #f
@@ -129,7 +130,9 @@
   (define bound-names (make-parameter null))
   ;; sc-queue : records the order in which to return syntax objects
   (define sc-queue null)
-  (define (recur sc)
+  ;; top-level? is #t only for the first call and not for recursive
+  ;; calls, which helps for inlining
+  (define (recur sc [top-level? #f])
     (cond [(and cache (hash-ref cache sc #f)) => car]
           [(arr/sc? sc) (make-contract sc)]
           [(or (parametric->/sc? sc) (sealing->/sc? sc))
@@ -144,7 +147,14 @@
            (make-contract sc)]
           [else
            (define ctc (make-contract sc))
-           (cond [cache
+           (cond [(and ;; when a contract benefits from inlining
+                       ;; (e.g., ->) and this contract appears
+                       ;; directly in a define-module-boundary-contract
+                       ;; position (i.e, top-level? is #t) then
+                       ;; don't generate a new identifier for it
+                       (or (not (should-inline-contract? ctc))
+                           (not top-level?))
+                       cache)
                   (define fresh-id (generate-temporary))
                   (hash-set! cache sc (cons fresh-id ctc))
                   (set! sc-queue (cons sc sc-queue))
@@ -170,7 +180,7 @@
                (recur body)))]
       [(? sc? sc)
        (sc->contract sc recur)]))
-  (define ctc (recur sc))
+  (define ctc (recur sc #t))
   (define name-defs (compute-defs sc))
   ;; These are extra contract definitions for the name static contracts
   ;; that are used for this type. Since these are shared across multiple
@@ -196,6 +206,17 @@
                   #`(define #,id #,ctc)))
         ctc))
 
+;; Determine whether the given contract syntax should be inlined or not.
+(define (should-inline-contract? stx)
+  (or
+   ;; no need to generate an extra def for things that are already identifiers
+   (identifier? stx)
+   ;; ->* are handled specially by the contract system
+   (let ([sexp (syntax-e stx)])
+     (and (pair? sexp)
+          (or (free-identifier=? (car sexp) #'->)
+              (free-identifier=? (car sexp) #'->*))))))
+
 ;; determine if a given name is free in the sc
 (define (name-free-in? name sc)
   (let/ec escape

typed-racket-lib/typed-racket/static-contracts/optimize.rkt

@@ -93,6 +93,7 @@
           (fail))
         ;; All the checks passed
         (function/sc
+          #t
           (take longest-args (length shortest-args))
           (drop longest-args (length shortest-args))
           empty
@@ -110,7 +111,7 @@
 (define (trusted-side-reduce sc)
   (match sc
     [(->/sc: mand-args opt-args mand-kw-args opt-kw-args rest-arg (list (any/sc:) ...))
-     (function/sc mand-args opt-args mand-kw-args opt-kw-args rest-arg #f)]
+     (function/sc #t mand-args opt-args mand-kw-args opt-kw-args rest-arg #f)]
     [(arr/sc: args rest (list (any/sc:) ...))
      (arr/sc args rest #f)]
     [(none/sc:) any/sc]

typed-racket-lib/typed-racket/typecheck/check-below.rkt

@@ -3,9 +3,9 @@
 (require "../utils/utils.rkt"
          racket/match (prefix-in - (contract-req))
          racket/format
-         (types utils union subtype filter-ops abbrev)
+         (types utils union subtype prop-ops abbrev)
          (utils tc-utils)
-         (rep type-rep object-rep filter-rep)
+         (rep type-rep object-rep prop-rep)
          (typecheck error-message))
 
 (provide/cond-contract
@@ -21,7 +21,7 @@
 
 (define (print-object o)
   (match o
-    [(or (NoObject:) (Empty:)) "no object"]
+    [(or #f (Empty:)) "no object"]
     [_ (format "object ~a" o)]))
 
 ;; If expected is #f, then just return tr1
@@ -45,37 +45,36 @@
     (value-string expected) (value-string actual)
     "mismatch in number of values"))
 
-;; fix-filter: FilterSet [FilterSet] -> FilterSet
-;; Turns NoFilter into the actual filter; leaves other filters alone.
-(define (fix-filter f [f2 -top-filter])
-  (match f
-    [(NoFilter:) f2]
-    [else f]))
+;; fix-props:
+;;  PropSet [PropSet] -> PropSet
+;;    or
+;;  Prop [Prop]       -> Prop
+;; Turns #f prop/propset into the actual prop; leaves other props alone.
+(define (fix-props p1 [p2 -tt-propset])
+  (or p1 p2))
 
 ;; fix-object: Object [Object] -> Object
-;; Turns NoObject into the actual object; leaves other objects alone.
-(define (fix-object o [o2 -empty-obj])
-  (match o
-    [(NoObject:) o2]
-    [else o]))
+;; Turns #f into the actual object; leaves other objects alone.
+(define (fix-object o1 [o2 -empty-obj])
+  (or o1 o2))
 
 ;; fix-results: tc-results -> tc-results
-;; Turns NoObject/NoFilter into the Empty/TopFilter
+;; Turns #f Prop or Obj into the Empty/Trivial
 (define (fix-results r)
   (match r
-    [(tc-any-results: f) (tc-any-results (fix-filter f -top))]
-    [(tc-results: ts fs os)
-     (ret ts (map fix-filter fs) (map fix-object os))]
-    [(tc-results: ts fs os dty dbound)
-     (ret ts (map fix-filter fs) (map fix-object os) dty dbound)]))
+    [(tc-any-results: f) (tc-any-results (fix-props f -tt))]
+    [(tc-results: ts ps os)
+     (ret ts (map fix-props ps) (map fix-object os))]
+    [(tc-results: ts ps os dty dbound)
+     (ret ts (map fix-props ps) (map fix-object os) dty dbound)]))
 
 (define (fix-results/bottom r)
   (match r
-    [(tc-any-results: f) (tc-any-results (fix-filter f -bot))]
-    [(tc-results: ts fs os)
-     (ret ts (for/list ([f fs]) (fix-filter f -bot-filter)) (map fix-object os))]
-    [(tc-results: ts fs os dty dbound)
-     (ret ts (for/list ([f fs]) (fix-filter f -bot-filter)) (map fix-object os) dty dbound)]))
+    [(tc-any-results: f) (tc-any-results (fix-props f -ff))]
+    [(tc-results: ts ps os)
+     (ret ts (for/list ([p ps]) (fix-props p -ff-propset)) (map fix-object os))]
+    [(tc-results: ts ps os dty dbound)
+     (ret ts (for/list ([p ps]) (fix-props p -ff-propset)) (map fix-object os) dty dbound)]))
 
 
 
@@ -84,74 +83,74 @@
 ;;                   (Type Results -> Type)
 ;;                   (Type Type -> Type))
 (define (check-below tr1 expected)
-  (define (filter-set-better? f1 f2)
-    (match* (f1 f2)
-      [(f f) #t]
-      [(f (NoFilter:)) #t]
-      [((FilterSet: f1+ f1-) (FilterSet: f2+ f2-))
-       (and (implied-atomic? f2+ f1+)
-            (implied-atomic? f2- f1-))]
+  (define (prop-set-better? p1 p2)
+    (match* (p1 p2)
+      [(p p) #t]
+      [(p #f) #t]
+      [((PropSet: p1+ p1-) (PropSet: p2+ p2-))
+       (and (implies-atomic? p1+ p2+)
+            (implies-atomic? p1- p2-))]
       [(_ _) #f]))
   (define (object-better? o1 o2)
     (match* (o1 o2)
       [(o o) #t]
-      [(o (or (NoObject:) (Empty:))) #t]
+      [(o (or #f (Empty:))) #t]
       [(_ _) #f]))
-  (define (filter-better? f1 f2)
-    (or (NoFilter? f2)
-        (implied-atomic? f2 f1)))
+  (define (prop-better? p1 p2)
+    (or (not p2)
+        (implies-atomic? p1 p2)))
 
   (match* (tr1 expected)
     ;; This case has to be first so that bottom (exceptions, etc.) can be allowed in cases
     ;; where multiple values are expected.
-    ;; We can ignore the filters and objects in the actual value because they would never be about a value
+    ;; We can ignore the props and objects in the actual value because they would never be about a value
     [((tc-result1: (? (lambda (t) (type-equal? t (Un))))) _)
      (fix-results/bottom expected)]
 
-    [((tc-any-results: f1) (tc-any-results: f2))
-     (unless (filter-better? f1 f2)
-       (type-mismatch f2 f1 "mismatch in filter"))
-     (tc-any-results (fix-filter f2 f1))]
+    [((tc-any-results: p1) (tc-any-results: p2))
+     (unless (prop-better? p1 p2)
+       (type-mismatch p2 p1 "mismatch in proposition"))
+     (tc-any-results (fix-props p2 p1))]
 
-    [((or (tc-results: _ (list (FilterSet: fs+ fs-) ...) _)
-          (tc-results: _ (list (FilterSet: fs+ fs-) ...) _ _ _))
-      (tc-any-results: f2))
-     (define merged-filter (apply -and (map -or fs+ fs-)))
-     (unless (filter-better? merged-filter f2)
-       (type-mismatch f2 merged-filter "mismatch in filter"))
-     (tc-any-results (fix-filter f2 merged-filter))]
+    [((or (tc-results: _ (list (PropSet: fs+ fs-) ...) _)
+          (tc-results: _ (list (PropSet: fs+ fs-) ...) _ _ _))
+      (tc-any-results: p2))
+     (define merged-prop (apply -and (map -or fs+ fs-)))
+     (unless (prop-better? merged-prop p2)
+       (type-mismatch p2 merged-prop "mismatch in proposition"))
+     (tc-any-results (fix-props p2 merged-prop))]
 
 
-    [((tc-result1: t1 f1 o1) (tc-result1: t2 f2 o2))
+    [((tc-result1: t1 p1 o1) (tc-result1: t2 p2 o2))
      (cond
        [(not (subtype t1 t2))
         (expected-but-got t2 t1)]
-       [(and (not (filter-set-better? f1 f2))
+       [(and (not (prop-set-better? p1 p2))
              (object-better? o1 o2))
-        (type-mismatch f2 f1 "mismatch in filter")]
-       [(and (filter-set-better? f1 f2)
+        (type-mismatch p2 p1 "mismatch in proposition")]
+       [(and (prop-set-better? p1 p2)
              (not (object-better? o1 o2)))
         (type-mismatch (print-object o2) (print-object o1) "mismatch in object")]
-       [(and (not (filter-set-better? f1 f2))
+       [(and (not (prop-set-better? p1 p2))
              (not (object-better? o1 o2)))
-        (type-mismatch (format "`~a' and `~a'" f2 (print-object o2))
-                       (format "`~a' and `~a'" f1 (print-object o1))
-                       "mismatch in filter and object")])
-     (ret t2 (fix-filter f2 f1) (fix-object o2 o1))]
+        (type-mismatch (format "`~a' and `~a'" p2 (print-object o2))
+                       (format "`~a' and `~a'" p1 (print-object o1))
+                       "mismatch in proposition and object")])
+     (ret t2 (fix-props p2 p1) (fix-object o2 o1))]
 
     ;; case where expected is like (Values a ... a) but got something else
-    [((tc-results: t1 f1 o1) (tc-results: t2 f2 o2 dty dbound))
+    [((tc-results: t1 p1 o1) (tc-results: t2 p2 o2 dty dbound))
      (value-mismatch expected tr1)
      (fix-results expected)]
 
     ;; case where you have (Values a ... a) but expected something else
-    [((tc-results: t1 f1 o1 dty dbound) (tc-results: t2 f2 o2))
+    [((tc-results: t1 p1 o1 dty dbound) (tc-results: t2 p2 o2))
      (value-mismatch expected tr1)
      (fix-results expected)]
 
-    [((tc-results: t1 f1 o1 dty1 dbound)
-      (tc-results: t2 (list (or (NoFilter:) (FilterSet: (Top:) (Top:))) ...)
-                      (list (or (NoObject:) (Empty:)) ...) dty2 dbound))
+    [((tc-results: t1 p1 o1 dty1 dbound)
+      (tc-results: t2 (list (or #f (PropSet: (TrueProp:) (TrueProp:))) ...)
+                      (list (or #f (Empty:)) ...) dty2 dbound))
      (cond
        [(= (length t1) (length t2))
         (unless (andmap subtype t1 t2)
@@ -162,7 +161,7 @@
          (value-mismatch expected tr1)])
      (fix-results expected)]
 
-    [((tc-results: t1 f1 o1 dty1 dbound) (tc-results: t2 f2 o2 dty2 dbound))
+    [((tc-results: t1 p1 o1 dty1 dbound) (tc-results: t2 p2 o2 dty2 dbound))
      (cond
        [(= (length t1) (length t2))
         (unless (andmap subtype t1 t2)
@@ -173,9 +172,9 @@
          (value-mismatch expected tr1)])
      (fix-results expected)]
 
-    [((tc-results: t1 f1 o1)
-      (tc-results: t2 (list (or (NoFilter:) (FilterSet: (Top:) (Top:))) ...)
-                      (list (or (NoObject:) (Empty:)) ...)))
+    [((tc-results: t1 p1 o1)
+      (tc-results: t2 (list (or #f (PropSet: (TrueProp:) (TrueProp:))) ...)
+                      (list (or #f (Empty:)) ...)))
      (unless (= (length t1) (length t2))
        (value-mismatch expected tr1))
      (unless (for/and ([t (in-list t1)] [s (in-list t2)]) (subtype t s))
@@ -189,7 +188,7 @@
        (expected-but-got (stringify t2) (stringify t1)))
      (fix-results expected)]
 
-    [((tc-results: t1 f1 o1) (tc-results: t2 f2 o2)) (=> continue)
+    [((tc-results: t1 p1 o1) (tc-results: t2 p2 o2)) (=> continue)
      (if (= (length t1) (length t2))
          (continue)
          (value-mismatch expected tr1))
@@ -204,5 +203,5 @@
        (expected-but-got t2 t1))
      expected]
     [((tc-results: ts fs os dty dbound) (tc-results: ts* fs* os* dty* dbound*))
-     (int-err "dotted types with different bounds/filters/objects in check-below nyi: ~a ~a" tr1 expected)]
+     (int-err "dotted types with different bounds/propositions/objects in check-below nyi: ~a ~a" tr1 expected)]
     [(a b) (int-err "unexpected input for check-below: ~a ~a" a b)]))

typed-racket-lib/typed-racket/typecheck/check-class-unit.rkt

@@ -461,7 +461,7 @@
   (define-values (alias-names alias-map) (get-type-alias-info type-aliases))
   (register-all-type-aliases alias-names alias-map)
 
-  ;; Filter top level expressions into several groups, each processed
+  ;; Prop top level expressions into several groups, each processed
   ;; into appropriate data structures
   ;;
   ;; Augment annotations go in their own table, because they're
@@ -983,7 +983,7 @@
            (do-timestamp (format "finished method ~a" external-name))
            (cons (list external-name pre-method-type) checked)]
           ;; Only try to type-check if these names are in the
-          ;; filter when it's provided. This allows us to, say, only
+          ;; prop when it's provided. This allows us to, say, only
           ;; type-check pubments/augments.
           [(set-member? names-to-check external-name)
            (do-timestamp (format "started checking method ~a" external-name))
@@ -1597,7 +1597,7 @@
      (make-PolyRow ns constraints (method->function type))]
     [_ (tc-error/expr #:return -Bottom "expected a function type for method")]))
 
-;; process-method-syntax : Syntax (Option Type) -> Syntax
+;; process-method-syntax : Syntax Type (Option Type) -> Syntax
 ;; Register types for identifiers in a method that don't come with types and
 ;; propagate syntax properties as needed
 (define (process-method-syntax stx self-type method-type)

typed-racket-lib/typed-racket/typecheck/check-subforms-unit.rkt

@@ -11,7 +11,7 @@
          (utils tc-utils)
          (for-syntax racket/base syntax/parse)
          (for-template racket/base)
-         (rep type-rep filter-rep object-rep))
+         (rep type-rep prop-rep object-rep))
 
 (import tc-if^ tc-lambda^ tc-app^ tc-let^ tc-expr^)
 (export check-subforms^)
@@ -42,14 +42,14 @@
 
   ;; syntax tc-result1 type -> tc-results
   ;; The result of applying the function to a single argument of the type of its first argument
-  (define (get-range-result stx t filter-type)
+  (define (get-range-result stx t prop-type)
     (let loop ((t t))
       (match t
         [(Function: (list _ ... (arr: (list arg1) _ _ #f (list (Keyword: _ _ #f) ...)) _ ...))
-         #:when (subtype filter-type arg1)
+         #:when (subtype prop-type arg1)
          (tc/funapp #'here #'(here) t (list (ret arg1)) #f)]
         [(Function: (list _ ... (arr: '() _ (? values rest) #f (list (Keyword: _ _ #f) ...)) _ ...))
-         #:when (subtype filter-type rest)
+         #:when (subtype prop-type rest)
          (tc/funapp #'here #'(here) t (list (ret rest)) #f)]
         [(? needs-resolving? t)
          (loop (resolve t))]
@@ -58,17 +58,17 @@
         ;; This clause should raise an error via the check-below test
         [_
          (cond [;; a redundant test, but it ensures an error message below
-                (not (subtype t (-> filter-type Univ)))
+                (not (subtype t (-> prop-type Univ)))
                 (parameterize ([current-orig-stx stx])
-                  (check-below t (-> filter-type Univ)))]
-               [else (int-err "get-range-result: should not happen. type ~a filter ~a"
-                              t filter-type)])
+                  (check-below t (-> prop-type Univ)))]
+               [else (int-err "get-range-result: should not happen. type ~a prop ~a"
+                              t prop-type)])
          (ret (Un))])))
 
   ;; Syntax Type -> (Option Type)
-  ;; Extract the type for the filter in a predicate type, or #f if
+  ;; Extract the type for the prop in a predicate type, or #f if
   ;; the type is an invalid predicate type.
-  (define (get-filter-type stx pred-type)
+  (define (get-prop-type stx pred-type)
     (cond [;; make sure the predicate has an appropriate type
            (subtype pred-type (-> Univ Univ))
            (define fun-type
@@ -78,10 +78,10 @@
            (match fun-type
              ;; FIXME: Almost all predicates fall into this case, but it may
              ;;        be worth being more precise here for some rare code.
-             [(PredicateFilter: fs)
-              (match fs
-                [(FilterSet: (TypeFilter: ft (Path: '() '(0 0))) _) ft]
-                [(Bot:) (Un)]
+             [(PredicateProp: ps)
+              (match ps
+                [(PropSet: (TypeProp: (Path: '() '(0 0)) ft) _) ft]
+                [(FalseProp:) (Un)]
                 [_ Univ])]
              [_ Univ])]
           [else
@@ -98,12 +98,12 @@
         (hash-ref predicate-map key))
       (match-define (list handler-stx handler-type)
         (hash-ref handler-map key))
-      (define filter-type
-        (get-filter-type predicate-stx predicate-type))
+      (define prop-type
+        (get-prop-type predicate-stx predicate-type))
       ;; if the predicate doesn't check, then don't bother
       ;; with the RHS and return no result
-      (if filter-type
-          (get-range-result handler-stx handler-type filter-type)
+      (if prop-type
+          (get-range-result handler-stx handler-type prop-type)
           (ret (Un)))))
 
   (find-syntax form

typed-racket-lib/typed-racket/typecheck/check-unit-unit.rkt

@@ -70,7 +70,7 @@
          (private parse-type syntax-properties type-annotation)
          (only-in (base-env base-special-env) make-template-identifier)
          (env lexical-env tvar-env global-env 
-              signature-env signature-helper)
+              signature-env)
          (types utils abbrev union subtype resolve generalize signatures)
          (typecheck check-below internal-forms)
          (utils tc-utils)
@@ -170,7 +170,7 @@
   (values (for/list ([sig-id  (in-list import-sigs)]
                      [sig-internal-ids (in-list import-internal-ids)])
             (sig-info sig-id
-                      (map car (Signature-mapping (lookup-signature sig-id)))
+                      (map car (Signature-mapping (lookup-signature/check sig-id)))
                       sig-internal-ids))
           ;; export-temp-ids is a flat list which must be processed
           ;; sequentially to map them to the correct internal/external identifiers
@@ -179,7 +179,7 @@
                                    [sig-infos '()])
                                   ([sig (in-list export-sigs)])
                           (define external-ids
-                            (map car (Signature-mapping (lookup-signature sig))))
+                            (map car (Signature-mapping (lookup-signature/check sig))))
                           (define len (length external-ids))
                           (values (drop temp-ids len)
                                   (cons (sig-info sig
@@ -391,7 +391,7 @@
 ;; Returns a mapping of link-ids to sig-ids, a list of imported sig ids
 ;; a list of exported link-ids
 (define (parse-compound-unit stx)
-  (define (list->sigs l) (map lookup-signature l))
+  (define (list->sigs l) (map lookup-signature/check l))
   (syntax-parse stx
     [cu:compound-unit-expansion
      (define link-binding-info (tr:unit:compound-property stx))
@@ -407,7 +407,7 @@
        (let ()
          (define link-syms (append cu-import-syms (flatten unit-export-syms)))
          (define sig-ids (append compound-imports (flatten unit-exports)))
-         (map cons link-syms (map lookup-signature sig-ids))))
+         (map cons link-syms (map lookup-signature/check sig-ids))))
      (define cu-exprs
        (for/list ([unit-expr (in-list unit-exprs)]
                   [import-sigs (in-list unit-imports)]
@@ -428,7 +428,7 @@
 ;; GIVEN: signature information
 ;; RETURNS: a mapping from internal names to types
 (define (make-local-type-mapping si)
-  (define sig (lookup-signature (sig-info-name si)))
+  (define sig (lookup-signature/check (sig-info-name si)))
   (define internal-names (sig-info-internals si))
   (define sig-types 
     (map cdr (Signature-mapping sig)))
@@ -475,7 +475,7 @@
 (define (parse-and-check-unit-from-context form expected-type)
   (syntax-parse form
     [u:unit-expansion
-     (define export-sigs (map lookup-signature (attribute u.export-sigs)))
+     (define export-sigs (map lookup-signature/check (attribute u.export-sigs)))
      (define body-stx (attribute u.body-stx))
      (for ([sig (in-list export-sigs)])
        (define ids (extract-definitions body-stx))
@@ -558,8 +558,8 @@
   (syntax-parse form
     [cu:compound-unit-expansion
      (define unit-exprs (attribute cu.unit-exprs))
-     (define compound-imports (map lookup-signature (attribute cu.compound-imports)))
-     (define compound-exports (map lookup-signature (attribute cu.compound-exports)))
+     (define compound-imports (map lookup-signature/check (attribute cu.compound-imports)))
+     (define compound-exports (map lookup-signature/check (attribute cu.compound-exports)))
      (define import-vector (apply vector compound-imports))
      (define import-length (vector-length import-vector))
      (unless (and (list? init-depend-refs)
@@ -579,7 +579,7 @@
     [iu:invoke-unit-expansion
      (define infer? (eq? 'infer (tr:unit:invoke-property form)))
      (define invoked-unit (attribute iu.expr))
-     (define import-sigs (map lookup-signature (attribute iu.imports)))
+     (define import-sigs (map lookup-signature/check (attribute iu.imports)))
      (define linking-units (attribute iu.units))
      (define unit-expr-type (tc-expr/t invoked-unit))
      ;; TODO: Better error message/handling when the folling check-below "fails"
@@ -630,9 +630,9 @@
                             init-depend-tags))
 
      ;; Get Signatures to build Unit type
-     (define import-signatures (map lookup-signature (map sig-info-name imports-info)))
-     (define export-signatures (map lookup-signature (map sig-info-name exports-info)))
-     (define init-depend-signatures (map lookup-signature init-depends))
+     (define import-signatures (map lookup-signature/check (map sig-info-name imports-info)))
+     (define export-signatures (map lookup-signature/check (map sig-info-name exports-info)))
+     (define init-depend-signatures (map lookup-signature/check init-depends))
 
      (unless (distinct-signatures? import-signatures)
        (tc-error/expr "unit expressions must import distinct signatures"))

typed-racket-lib/typed-racket/typecheck/error-message.rkt

@@ -18,8 +18,8 @@
                              (-or/c Type/c string?)
                              -any)]
                        [type-mismatch
-                        (-->* ((-or/c Type/c Filter? string?)
-                               (-or/c Type/c Filter? string?))
+                        (-->* ((-or/c Type/c Prop? string?)
+                               (-or/c Type/c Prop? string?))
                               ((-or/c string? #f))
                               -any)])
 

typed-racket-lib/typed-racket/typecheck/internal-forms.rkt

@@ -89,10 +89,10 @@
 
 
 (define-syntax-class define-typed-struct-body
-  #:attributes (name mutable prefab type-only maker extra-maker nm
+  #:attributes (name type-name mutable prefab type-only maker extra-maker nm
                 (tvars 1) (fields 1) (types 1))
   (pattern ((~optional (tvars:id ...) #:defaults (((tvars 1) null)))
-            nm:struct-name ([fields:id : types:expr] ...) options:dtsi-fields)
+            nm:struct-name type-name:id ([fields:id : types:expr] ...) options:dtsi-fields)
            #:attr name #'nm.nm
            #:attr mutable (attribute options.mutable)
            #:attr prefab (attribute options.prefab)
@@ -151,7 +151,7 @@
   [typed-struct
     (define-typed-struct-internal . :define-typed-struct-body)]
   [typed-struct/exec
-    (define-typed-struct/exec-internal nm ([fields:id : types] ...) proc-type)]
+    (define-typed-struct/exec-internal nm type-name ([fields:id : types] ...) proc-type)]
   [typed-require
     (require/typed-internal name type)]
   [typed-require/struct

typed-racket-lib/typed-racket/typecheck/possible-domains.rkt

@@ -0,0 +1,167 @@
+#lang racket/base
+
+(require "../utils/utils.rkt"
+         (contract-req)
+         racket/list
+         racket/match
+         (rep type-rep prop-rep)
+         (except-in (types abbrev subtype tc-result)
+                    -> ->* one-of/c))
+
+(provide possible-domains)
+
+(provide/cond-contract
+  [cleanup-type ((Type/c) ((or/c #f Type/c) any/c) . ->* . Type/c)])
+
+;; to avoid long and confusing error messages, in the case of functions with
+;; multiple similar domains (<, >, +, -, etc.), we show only the domains that
+;; are relevant to this specific error
+;; this is done in several ways:
+;; - if a case-lambda case is subsumed by another, we don't need to show it
+;;   (subsumed cases may be useful for their prop information, but this is
+;;   unrelated to error reporting)
+;; - if we have an expected type, we don't need to show the domains for which
+;;   the result type is not a subtype of the expected type
+;; - we can disregard domains that are more restricted than required to get
+;;   the expected type (or all but the most liberal domain when no type is
+;;   expected)
+;;   ex: if we have the 2 following possible domains for an operator:
+;;       Fixnum -> Fixnum
+;;       Integer -> Integer
+;;     and an expected type of Integer for the result of the application,
+;;     we can disregard the Fixnum domain since it imposes a restriction that
+;;     is not necessary to get the expected type
+;; This function can be used in permissive or restrictive mode.
+;; in permissive mode, domains that are not consistent with the expected type
+;; may still be considered possible. This is useful for error messages, where
+;; we want to collapse domains always, regardless of expected type. In
+;; restrictive mode, only domains that are consistent with the expected type can
+;; be considered possible. This is useful when computing the possibly empty set
+;; of domains that would *satisfy* the expected type, e.g. for the :query-type
+;; forms.
+;; TODO separating pruning and collapsing into separate functions may be nicer
+(define (possible-domains doms rests drests rngs expected [permissive? #t])
+
+  ;; is fun-ty subsumed by a function type in others?
+  (define (is-subsumed-in? fun-ty others)
+    ;; a case subsumes another if the first one is a subtype of the other
+    (ormap (lambda (x) (subtype x fun-ty))
+           others))
+
+  ;; currently does not take advantage of multi-valued or arbitrary-valued expected types,
+  (define expected-ty
+    (and expected
+         (match expected
+           [(tc-result1: t) t]
+           [(tc-any-results: (or #f (TrueProp:))) #t] ; anything is a subtype of expected
+           [_ #f]))) ; don't know what it is, don't do any pruning
+  (define (returns-subtype-of-expected? fun-ty)
+    (or (not expected) ; no expected type, anything is fine
+        (eq? expected-ty #t) ; expected is tc-anyresults, anything is fine
+        (and expected-ty ; not some unknown expected tc-result
+             (match fun-ty
+               [(Function: (list (arr: _ rng _ _ _)))
+                (let ([rng (match rng
+                             [(Values: (list (Result: t _ _)))
+                              t]
+                             [(ValuesDots: (list (Result: t _ _)) _ _)
+                              t]
+                             [_ #f])])
+                  (and rng (subtype rng expected-ty)))]))))
+
+  (define orig (map list doms rngs rests drests))
+
+  (define cases
+    (map (compose make-Function list make-arr)
+         doms
+         (map (match-lambda ; strip props
+               [(AnyValues: f) (-AnyValues -tt)]
+               [(Values: (list (Result: t _ _) ...))
+                (-values t)]
+               [(ValuesDots: (list (Result: t _ _) ...) _ _)
+                (-values t)])
+              rngs)
+         rests drests (make-list (length doms) null)))
+
+  ;; iterate in lock step over the function types we analyze and the parts
+  ;; that we will need to print the error message, to make sure we throw
+  ;; away cases consistently
+  (define-values (candidates* parts-acc*)
+    (for/fold ([candidates '()] ; from cases
+               [parts-acc '()]) ; from orig
+        ([c (in-list cases)]
+         ;; the parts we'll need to print the error message
+         [p (in-list orig)])
+      (if (returns-subtype-of-expected? c)
+          (values (cons c candidates) ; we keep this one
+                  (cons p parts-acc))
+          ;; we discard this one
+          (values candidates parts-acc))))
+
+  ;; if none of the cases return a subtype of the expected type, still do some
+  ;; merging, but do it on the entire type
+  ;; only do this if we're in permissive mode
+  (define-values (candidates parts-acc)
+    (if (and permissive? (null? candidates*))
+        (values cases orig)
+        (values candidates* parts-acc*)))
+
+  ;; among the domains that fit with the expected type, we only need to
+  ;; keep the most liberal
+  ;; since we only care about permissiveness of domains, we reconstruct
+  ;; function types with a return type of any then test for subtyping
+  (define fun-tys-ret-any
+    (map (match-lambda
+          [(Function: (list (arr: dom _ rest drest _)))
+           (make-Function (list (make-arr dom
+                                          (-values (list Univ))
+                                          rest drest null)))])
+         candidates))
+
+  ;; Heuristic: often, the last case in the definition (first at this
+  ;; point, we've reversed the list) is the most general of all, subsuming
+  ;; all the others. If that's the case, just go with it. Otherwise, go
+  ;; the slow way.
+  (cond [(and (not (null? fun-tys-ret-any))
+              (andmap (lambda (c) (subtype (car fun-tys-ret-any) c))
+                      fun-tys-ret-any))
+         ;; Yep. Return early.
+         (map list (car parts-acc))]
+        
+        [else
+         ;; No luck, do it the slow way
+         (define parts-res
+           ;; final pass, we only need the parts to print the error message
+           (for/fold ([parts-res '()])
+               ([c (in-list fun-tys-ret-any)]
+                [p (in-list parts-acc)]
+                ;; if a case is a supertype of another, we discard it
+                #:unless (is-subsumed-in? c (remove c fun-tys-ret-any)))
+
+             (cons p parts-res)))
+
+         (call-with-values
+           (λ ()
+             (for/lists (_1 _2 _3 _4) ([xs (in-list (reverse parts-res))])
+               (values (car xs) (cadr xs) (caddr xs) (cadddr xs))))
+           list)]))
+
+;; Wrapper over possible-domains that works on types.
+(define (cleanup-type t [expected #f] [permissive? #t])
+  (match t
+    ;; function type, prune if possible.
+    [(Function/arrs: doms rngs rests drests kws)
+     (match-let ([(list pdoms rngs rests drests)
+                  (possible-domains doms rests drests rngs
+                                    (and expected (ret expected))
+                                    permissive?)])
+       (if (= (length pdoms) (length doms))
+           ;; pruning didn't improve things, return the original
+           ;; (Note: pruning may have reordered clauses, so may not be `equal?' to
+           ;;  the original, which may confuse `:print-type''s pruning detection)
+           t
+           ;; pruning helped, return pruned type
+           (make-Function (map make-arr
+                               pdoms rngs rests drests (make-list (length pdoms) null)))))]
+    ;; not a function type. keep as is.
+    [_ t]))

typed-racket-lib/typed-racket/typecheck/tc-app-helper.rkt

@@ -4,10 +4,10 @@
          racket/match racket/sequence racket/set racket/list
          (only-in racket/list make-list)
          (contract-req)
-         (typecheck check-below tc-subst tc-metafunctions)
+         (typecheck check-below tc-subst tc-metafunctions possible-domains)
          (utils tc-utils)
-         (rep type-rep filter-rep)
-         (except-in (types utils abbrev subtype)
+         (rep type-rep prop-rep)
+         (except-in (types utils abbrev subtype type-table)
                     -> ->* one-of/c))
 (require-for-cond-contract
   syntax/stx)
@@ -18,6 +18,8 @@
      (#:check boolean?)
      . ->* . full-tc-results/c)])
 (define (tc/funapp1 f-stx args-stx ftype0 argtys expected #:check [check? #t])
+  ;; update tooltip-table with inferred function type
+  (add-typeof-expr f-stx (ret (make-Function (list ftype0))))
   (match* (ftype0 argtys)
     ;; we check that all kw args are optional
     [((arr: dom rng rest #f (and kws (list (Keyword: _ _ #f) ...)))
@@ -73,9 +75,11 @@
 (define (make-printable t)
   (match t
     [(tc-result1: t) (cleanup-type t)]
-    [(tc-results: ts) (-values (map cleanup-type ts))]
-    [(tc-any-results: f) (-AnyValues -top)]
-    [_ (cleanup-type t)]))
+    [(or (tc-results: ts)
+         (tc-results: ts _ _ _ _))
+     (-values (map cleanup-type ts))]
+    [(tc-any-results: f) (-AnyValues -tt)]
+    [_ t]))
 
 (define (stringify-domain dom rst drst [rng #f])
   (let ([doms-string (if (null? dom) "" (string-append (stringify (map make-printable dom)) " "))]
@@ -176,13 +180,12 @@
                 return]
                [else
                 ;; if not, print the message as usual
-                (define pdoms* (map make-printable pdoms))
                 (define err-doms
                   (string-append
                    label
                    (stringify (if expected
-                                  (map stringify-domain pdoms* rests drests rngs)
-                                  (map stringify-domain pdoms* rests drests))
+                                  (map stringify-domain pdoms rests drests rngs)
+                                  (map stringify-domain pdoms rests drests))
                               nl+spc)
                    "\nArguments: "
                    arguments-str
@@ -195,161 +198,6 @@
                  (msg-thunk err-doms))])))])) ; generate message
 
 
-;; to avoid long and confusing error messages, in the case of functions with
-;; multiple similar domains (<, >, +, -, etc.), we show only the domains that
-;; are relevant to this specific error
-;; this is done in several ways:
-;; - if a case-lambda case is subsumed by another, we don't need to show it
-;;   (subsumed cases may be useful for their filter information, but this is
-;;   unrelated to error reporting)
-;; - if we have an expected type, we don't need to show the domains for which
-;;   the result type is not a subtype of the expected type
-;; - we can disregard domains that are more restricted than required to get
-;;   the expected type (or all but the most liberal domain when no type is
-;;   expected)
-;;   ex: if we have the 2 following possible domains for an operator:
-;;       Fixnum -> Fixnum
-;;       Integer -> Integer
-;;     and an expected type of Integer for the result of the application,
-;;     we can disregard the Fixnum domain since it imposes a restriction that
-;;     is not necessary to get the expected type
-;; This function can be used in permissive or restrictive mode.
-;; in permissive mode, domains that are not consistent with the expected type
-;; may still be considered possible. This is useful for error messages, where
-;; we want to collapse domains always, regardless of expected type. In
-;; restrictive mode, only domains that are consistent with the expected type can
-;; be considered possible. This is useful when computing the possibly empty set
-;; of domains that would *satisfy* the expected type, e.g. for the :query-type
-;; forms.
-;; TODO separating pruning and collapsing into separate functions may be nicer
-(define (possible-domains doms rests drests rngs expected [permissive? #t])
-
-  ;; is fun-ty subsumed by a function type in others?
-  (define (is-subsumed-in? fun-ty others)
-    ;; a case subsumes another if the first one is a subtype of the other
-    (ormap (lambda (x) (subtype x fun-ty))
-           others))
-
-  ;; currently does not take advantage of multi-valued or arbitrary-valued expected types,
-  (define expected-ty
-    (and expected
-         (match expected
-           [(tc-result1: t) t]
-           [(tc-any-results: (or (Top:) (NoFilter:))) #t] ; anything is a subtype of expected
-           [_ #f]))) ; don't know what it is, don't do any pruning
-  (define (returns-subtype-of-expected? fun-ty)
-    (or (not expected) ; no expected type, anything is fine
-        (eq? expected-ty #t) ; expected is tc-anyresults, anything is fine
-        (and expected-ty ; not some unknown expected tc-result
-             (match fun-ty
-               [(Function: (list (arr: _ rng _ _ _)))
-                (let ([rng (match rng
-                             [(Values: (list (Result: t _ _)))
-                              t]
-                             [(ValuesDots: (list (Result: t _ _)) _ _)
-                              t]
-                             [_ #f])])
-                  (and rng (subtype rng expected-ty)))]))))
-
-  (define orig (map list doms rngs rests drests))
-
-  (define cases
-    (map (compose make-Function list make-arr)
-         doms
-         (map (match-lambda ; strip filters
-               [(AnyValues: f) (-AnyValues -top)]
-               [(Values: (list (Result: t _ _) ...))
-                (-values t)]
-               [(ValuesDots: (list (Result: t _ _) ...) _ _)
-                (-values t)])
-              rngs)
-         rests drests (make-list (length doms) null)))
-
-  ;; iterate in lock step over the function types we analyze and the parts
-  ;; that we will need to print the error message, to make sure we throw
-  ;; away cases consistently
-  (define-values (candidates* parts-acc*)
-    (for/fold ([candidates '()] ; from cases
-               [parts-acc '()]) ; from orig
-        ([c (in-list cases)]
-         ;; the parts we'll need to print the error message
-         [p (in-list orig)])
-      (if (returns-subtype-of-expected? c)
-          (values (cons c candidates) ; we keep this one
-                  (cons p parts-acc))
-          ;; we discard this one
-          (values candidates parts-acc))))
-
-  ;; if none of the cases return a subtype of the expected type, still do some
-  ;; merging, but do it on the entire type
-  ;; only do this if we're in permissive mode
-  (define-values (candidates parts-acc)
-    (if (and permissive? (null? candidates*))
-        (values cases orig)
-        (values candidates* parts-acc*)))
-
-  ;; among the domains that fit with the expected type, we only need to
-  ;; keep the most liberal
-  ;; since we only care about permissiveness of domains, we reconstruct
-  ;; function types with a return type of any then test for subtyping
-  (define fun-tys-ret-any
-    (map (match-lambda
-          [(Function: (list (arr: dom _ rest drest _)))
-           (make-Function (list (make-arr dom
-                                          (-values (list Univ))
-                                          rest drest null)))])
-         candidates))
-
-  ;; Heuristic: often, the last case in the definition (first at this
-  ;; point, we've reversed the list) is the most general of all, subsuming
-  ;; all the others. If that's the case, just go with it. Otherwise, go
-  ;; the slow way.
-  (cond [(and (not (null? fun-tys-ret-any))
-              (andmap (lambda (c) (subtype (car fun-tys-ret-any) c))
-                      fun-tys-ret-any))
-         ;; Yep. Return early.
-         (map list (car parts-acc))]
-        
-        [else
-         ;; No luck, do it the slow way
-         (define parts-res
-           ;; final pass, we only need the parts to print the error message
-           (for/fold ([parts-res '()])
-               ([c (in-list fun-tys-ret-any)]
-                [p (in-list parts-acc)]
-                ;; if a case is a supertype of another, we discard it
-                #:unless (is-subsumed-in? c (remove c fun-tys-ret-any)))
-
-             (cons p parts-res)))
-
-         (call-with-values
-           (λ ()
-             (for/lists (_1 _2 _3 _4) ([xs (in-list (reverse parts-res))])
-               (values (car xs) (cadr xs) (caddr xs) (cadddr xs))))
-           list)]))
-
-;; Wrapper over possible-domains that works on types.
-(provide/cond-contract
-  [cleanup-type ((Type/c) ((or/c #f Type/c) any/c) . ->* . Type/c)])
-(define (cleanup-type t [expected #f] [permissive? #t])
-  (match t
-    ;; function type, prune if possible.
-    [(Function/arrs: doms rngs rests drests kws)
-     (match-let ([(list pdoms rngs rests drests)
-                  (possible-domains doms rests drests rngs
-                                    (and expected (ret expected))
-                                    permissive?)])
-       (if (= (length pdoms) (length doms))
-           ;; pruning didn't improve things, return the original
-           ;; (Note: pruning may have reordered clauses, so may not be `equal?' to
-           ;;  the original, which may confuse `:print-type''s pruning detection)
-           t
-           ;; pruning helped, return pruned type
-           (make-Function (map make-arr
-                               pdoms rngs rests drests (make-list (length pdoms) null)))))]
-    ;; not a function type. keep as is.
-    [_ t]))
-
 (provide/cond-contract
   [poly-fail ((syntax? syntax? Type/c (listof tc-results?))
               (#:name (or/c #f syntax?)

typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-eq.rkt

@@ -5,7 +5,7 @@
          "utils.rkt"
          syntax/parse syntax/stx racket/match
          (typecheck signatures tc-funapp)
-         (types abbrev filter-ops union utils)
+         (types abbrev prop-ops union utils)
          (rep type-rep object-rep)
 
          (for-label racket/base racket/bool))
@@ -55,14 +55,14 @@
   (match* ((single-value v1) (single-value v2))
     [((tc-result1: (Value: (? ok? val1)) _ o1)
       (tc-result1: (Value: (? ok? val2)) _ o2))
-     (ret -Boolean (-FS (-and (-filter (-val val2) o1)
-                              (-filter (-val val1) o2))
-                        (-and (-not-filter (-val val2) o1)
-                              (-not-filter (-val val1) o2))))]
+     (ret -Boolean (-PS (-and (-is-type o1 (-val val2))
+                              (-is-type o2 (-val val1)))
+                        (-and (-not-type o1 (-val val2))
+                              (-not-type o2 (-val val1)))))]
     [((tc-result1: t _ o) (tc-result1: (Value: (? ok? val))))
-     (ret -Boolean (-FS (-filter (-val val) o) (-not-filter (-val val) o)))]
+     (ret -Boolean (-PS (-is-type o (-val val)) (-not-type o (-val val))))]
     [((tc-result1: (Value: (? ok? val))) (tc-result1: t _ o))
-     (ret -Boolean (-FS (-filter (-val val) o) (-not-filter (-val val) o)))]
+     (ret -Boolean (-PS (-is-type o (-val val)) (-not-type o (-val val))))]
     [((tc-result1: t _ o)
       (or (and (? (lambda _ (id=? #'member comparator)))
                (tc-result1: (List: (list (and ts (Value: _)) ...))))
@@ -72,8 +72,8 @@
                (tc-result1: (List: (list (and ts (Value: (? eq?-able))) ...))))))
      (let ([ty (apply Un ts)])
        (ret (Un (-val #f) t)
-            (-FS (-filter ty o)
-                 (-not-filter ty o))))]
+            (-PS (-is-type o ty)
+                 (-not-type o ty))))]
     [(_ _) (ret -Boolean)]))
 
 

typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-hetero.rkt

@@ -117,7 +117,7 @@
               (for/list ([e (in-syntax #'(args ...))]
                          [t (in-list ts)])
                 (tc-expr/check/t e (ret t))))
-            -true-filter)]
+            -true-propset)]
          [else
           (tc-error/expr
             "expected vector with ~a elements, but got ~a"

typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-main.rkt

@@ -7,7 +7,7 @@
          syntax/parse/experimental/reflect
          "../signatures.rkt" "../tc-funapp.rkt"
          (types utils)
-         (rep type-rep filter-rep object-rep))
+         (rep type-rep prop-rep object-rep))
 
 (import tc-expr^ tc-app-keywords^
         tc-app-hetero^ tc-app-list^ tc-app-apply^ tc-app-values^
@@ -46,11 +46,13 @@
 
 
 
-;; TODO: handle drest, and filters/objects
+;; TODO: handle drest, and props/objects
 (define (arr-matches? arr args)
   (match arr
     [(arr: domain
-           (Values: (list (Result: v (FilterSet: (Top:) (Top:)) (Empty:)) ...))
+           (Values: (list (Result: v
+                                   (PropSet: (TrueProp:) (TrueProp:))
+                                   (Empty:)) ...))
            rest #f (list (Keyword: _ _ #f) ...))
      (cond
        [(< (length domain) (length args)) rest]
@@ -58,9 +60,11 @@
        [else #f])]
     [_ #f]))
 
-(define (has-filter? arr)
+(define (has-props? arr)
   (match arr
-    [(arr: _ (Values: (list (Result: v (FilterSet: (Top:) (Top:)) (Empty:)) ...))
+    [(arr: _ (Values: (list (Result: v
+                                     (PropSet: (TrueProp:) (TrueProp:))
+                                     (Empty:)) ...))
            _ _ (list (Keyword: _ _ #f) ...)) #f]
     [else #t]))
 
@@ -72,13 +76,13 @@
             [args* (syntax->list #'args)])
        (define (matching-arities arrs)
          (for/list ([arr (in-list arrs)] #:when (arr-matches? arr args*)) arr))
-       (define (has-drest/filter? arrs)
+       (define (has-drest/props? arrs)
          (for/or ([arr (in-list arrs)])
-           (or (has-filter? arr) (arr-drest arr))))
+           (or (has-props? arr) (arr-drest arr))))
 
        (define arg-tys
          (match f-ty
-           [(Function: (? has-drest/filter?))
+           [(Function: (? has-drest/props?))
             (map single-value args*)]
            [(Function:
               (app matching-arities

typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-special.rkt

@@ -9,7 +9,7 @@
          (typecheck signatures tc-funapp)
          (types abbrev type-table utils)
          (private type-annotation)
-         (rep type-rep filter-rep)
+         (rep type-rep prop-rep)
          (utils tc-utils)
 
          (for-label racket/base racket/bool '#%paramz))
@@ -50,11 +50,11 @@
                                                      Univ))
                     (list (ret Univ) (single-value #'arg))
                     expected)]))
-  ;; special-case for not - flip the filters
+  ;; special-case for not - flip the props
   (pattern ((~or false? not) arg)
     (match (single-value #'arg)
-      [(tc-result1: t (FilterSet: f+ f-) _)
-       (ret -Boolean (make-FilterSet f- f+))]))
+      [(tc-result1: t (PropSet: p+ p-) _)
+       (ret -Boolean (make-PropSet p- p+))]))
   ;; special case for (current-contract-region)'s default expansion
   ;; just let it through without any typechecking, since module-name-fixup
   ;; is a private function from syntax/location, so this must have been

typed-racket-lib/typed-racket/typecheck/tc-app/tc-app-values.rkt

@@ -5,7 +5,7 @@
          "utils.rkt"
          syntax/parse racket/match racket/sequence
          (typecheck signatures tc-funapp)
-         (types utils)
+         (types base-abbrev utils)
 
          (for-label racket/base))
 
@@ -34,29 +34,24 @@
      [(tc-result1: tp)
       (single-value #'arg expected)]
      [(tc-results: ts)
-      (single-value #'arg) ;Type check the argument, to find other errors
-      (tc-error/expr
-        "wrong number of values: expected ~a but got one"
-         (length ts))]
+      (single-value #'arg)] ;Type check the argument, to find other errors
      ;; match polydots case and error
      [(tc-results: ts _ _ dty dbound)
-      (single-value #'arg)
-      (tc-error/expr
-        "Expected ~a ..., but got only one value" dty)]))
+      (single-value #'arg)]))
   ;; handle `values' specially
   (pattern (values . args)
     (match expected
       [(tc-results: ets efs eos)
        (match-let ([(list (tc-result1: ts fs os) ...)
-                    (for/list ([arg (in-syntax #'args)]
-                               [et (in-list ets)]
-                               [ef (in-list efs)]
-                               [eo (in-list eos)])
-                      (single-value arg (ret et ef eo)))])
-         (if (= (length ts) (length ets) (syntax-length #'args))
-             (ret ts fs os)
-             (tc-error/expr "wrong number of values: expected ~a but got ~a"
-                            (length ets) (syntax-length #'args))))]
+                    (for/list
+                      ([arg (in-syntax #'args)]
+                       [et (in-sequences (in-list ets) (in-cycle (in-value #f)))]
+                       [ef (in-sequences (in-list efs) (in-cycle (in-value #f)))]
+                       [eo (in-sequences (in-list eos) (in-cycle (in-value #f)))])
+                      (if et
+                          (single-value arg (ret et ef eo))
+                          (single-value arg)))])
+         (ret ts fs os))]
       [_ (match-let ([(list (tc-result1: ts fs os) ...)
                       (for/list ([arg (in-syntax #'args)])
                         (single-value arg))])

typed-racket-lib/typed-racket/typecheck/tc-apply.rkt

@@ -16,7 +16,7 @@
     [(Values: (list (Result: ts _ _) ...)) (ret ts)]
     [(ValuesDots: (list (Result: ts _ _) ...) dty dbound)
      (ret ts
-          (for/list ([t (in-list ts)]) -top-filter)
+          (for/list ([t (in-list ts)]) -tt-propset)
           (for/list ([t (in-list ts)]) -empty-obj)
           dty dbound)]
     [_ (int-err "do-ret fails: ~a" t)]))

typed-racket-lib/typed-racket/typecheck/tc-envops.rkt

@@ -1,13 +1,12 @@
 #lang racket/base
 
-(require (rename-in "../utils/utils.rkt" [infer infer-in]))
-(require racket/match racket/list
+(require "../utils/utils.rkt"
+         racket/match racket/list
          (for-syntax racket/base syntax/parse)
          (contract-req)
-         (infer-in infer)
-         (rep type-rep filter-rep object-rep rep-utils)
+         (rep type-rep prop-rep object-rep rep-utils)
          (utils tc-utils)
-         (types tc-result resolve subtype remove-intersect union filter-ops)
+         (types tc-result resolve subtype remove update union prop-ops)
          (env type-env-structs lexical-env)
          (rename-in (types abbrev)
                     [-> -->]
@@ -17,82 +16,18 @@
 
 (provide with-lexical-env/extend-props)
 
-
-(define/cond-contract (update t ft pos? lo)
-  (Type/c Type/c boolean? (listof PathElem?) . -> . Type/c)
-  ;; build-type: build a type while propogating bottom
-  (define (build-type constructor . args)
-    (if (memf Bottom? args) -Bottom (apply constructor args)))
-  (match* ((resolve t) lo)
-    ;; pair ops
-    [((Pair: t s) (list rst ... (CarPE:)))
-     (build-type -pair (update t ft pos? rst) s)]
-    [((Pair: t s) (list rst ... (CdrPE:)))
-     (build-type -pair t (update s ft pos? rst))]
-
-    ;; syntax ops
-    [((Syntax: t) (list rst ... (SyntaxPE:)))
-     (build-type -Syntax (update t ft pos? rst))]
-
-    ;; promise op
-    [((Promise: t) (list rst ... (ForcePE:)))
-     (build-type -Promise (update t ft pos? rst))]
-
-    ;; struct ops
-    [((Struct: nm par flds proc poly pred)
-      (list rst ... (StructPE: (? (lambda (s) (subtype t s)) s) idx)))
-     ;; note: this updates fields regardless of whether or not they are
-     ;; a polymorphic field. Because subtyping is nominal and accessor 
-     ;; functions do not reflect this, this behavior is unobservable
-     ;; except when an a variable aliases the field in a let binding
-     (let*-values ([(lhs rhs) (split-at flds idx)]
-                   [(ty* acc-id) (match rhs
-                                   [(cons (fld: ty acc-id #f) _)
-                                    (values (update ty ft pos? rst) acc-id)]
-                                   [_ (int-err "update on mutable struct field")])]) 
-       (cond 
-        [(Bottom? ty*) ty*]
-        [else (let ([flds* (append lhs (cons (make-fld ty* acc-id #f) (cdr rhs)))])
-                (make-Struct nm par flds* proc poly pred))]))]
-
-    ;; class field ops
-    ;;
-    ;; A refinement of a private field in a class is really a refinement of the
-    ;; return type of the accessor function for that field (rather than a variable).
-    ;; We cannot just refine the type of the argument to the accessor, since that
-    ;; is an object type that doesn't mention private fields. Thus we use the
-    ;; FieldPE path element as a marker to refine the result of the accessor
-    ;; function.
-    [((Function: (list (arr: doms (Values: (list (Result: rng _ _))) _ _ _)))
-      (list rst ... (FieldPE:)))
-     (make-Function
-      (list (make-arr* doms (update rng ft pos? rst))))]
-
-    ;; otherwise
-    [(t '())
-     (if pos?
-         (restrict t ft)
-         (remove t ft))]
-    [((Union: ts) lo)
-     (apply Un (map (λ (t) (update t ft pos? lo)) ts))]
-    [(t* lo)
-     ;; This likely comes up with (-lst t) and we need to improve the system to make sure this case
-     ;; dosen't happen
-     ;;(int-err "update along ill-typed path: ~a ~a ~a" t t* lo)
-     t]))
-
 ;; Returns #f if anything becomes (U)
-(define (env+ env fs)
+(define (env+ env ps)
   (let/ec exit*
     (define (exit) (exit* #f empty))
-    (define-values (props atoms) (combine-props fs (env-props env) exit))
+    (define-values (props atoms) (combine-props ps (env-props env) exit))
     (values
-      (for/fold ([Γ (replace-props env props)]) ([f (in-list atoms)])
-        (match f
-          [(or (TypeFilter: ft (Path: lo x)) (NotTypeFilter: ft (Path: lo x)))
+      (for/fold ([Γ (replace-props env props)]) ([p (in-list atoms)])
+        (match p
+          [(or (TypeProp: (Path: lo x) pt) (NotTypeProp: (Path: lo x) pt))
            (update-type/lexical
              (lambda (x t)
-               (define new-t (update t ft (TypeFilter? f) lo))
+               (define new-t (update t pt (TypeProp? p) lo))
                (when (type-equal? new-t -Bottom)
                  (exit))
                new-t)
@@ -102,7 +37,7 @@
 
 ;; run code in an extended env and with replaced props. Requires the body to return a tc-results.
 ;; TODO make this only add the new prop instead of the entire environment once tc-id is fixed to
-;; include the interesting props in its filter.
+;; include the interesting props in its prop.
 ;; WARNING: this may bail out when code is unreachable
 (define-syntax (with-lexical-env/extend-props stx)
   (define-splicing-syntax-class unreachable?

typed-racket-lib/typed-racket/typecheck/tc-expr-unit.rkt

@@ -6,10 +6,10 @@
          "signatures.rkt"
          "check-below.rkt" "../types/kw-types.rkt"
          (types utils abbrev union subtype type-table path-type
-                filter-ops remove-intersect resolve generalize)
+                prop-ops overlap resolve generalize)
          (private-in syntax-properties)
-         (rep type-rep filter-rep object-rep)
-         (only-in (infer infer) restrict)
+         (rep type-rep prop-rep object-rep)
+         (only-in (infer infer) intersect)
          (utils tc-utils)
          (env lexical-env)
          racket/list
@@ -54,9 +54,9 @@
   (define ty (path-type alias-path (lookup-type/lexical alias-id)))
   
   (ret ty
-       (if (overlap ty (-val #f))
-           (-FS (-not-filter (-val #f) obj) (-filter (-val #f) obj))
-           -true-filter)
+       (if (overlap? ty (-val #f))
+           (-PS (-not-type obj (-val #f)) (-is-type obj (-val #f)))
+           -true-propset)
        obj))
 
 ;; typecheck an expression, but throw away the effect
@@ -140,21 +140,21 @@
       [t:typecheck-failure
        (explicit-fail #'t.stx #'t.message #'t.var)]
       ;; data
-      [(quote #f) (ret (-val #f) -false-filter)]
-      [(quote #t) (ret (-val #t) -true-filter)]
+      [(quote #f) (ret (-val #f) -false-propset)]
+      [(quote #t) (ret (-val #t) -true-propset)]
       [(quote val)
        (match expected
          [(tc-result1: t)
-          (ret (tc-literal #'val t) -true-filter)]
+          (ret (tc-literal #'val t) -true-propset)]
          [_
-          (ret (tc-literal #'val) -true-filter)])]
+          (ret (tc-literal #'val) -true-propset)])]
       ;; syntax
       [(quote-syntax datum . _)
        (define expected-type
          (match expected
            [(tc-result1: t) t]
            [_ #f]))
-       (ret (find-stx-type #'datum expected-type) -true-filter)]
+       (ret (find-stx-type #'datum expected-type) -true-propset)]
       ;; mutation!
       [(set! id val)
        (match-let* ([(tc-result1: id-t) (single-value #'id)]
@@ -200,7 +200,7 @@
       [(begin0 e . es)
        (begin0
          (tc-expr/check #'e expected)
-         (tc-body/check #'es (tc-any-results -top)))]
+         (tc-body/check #'es (tc-any-results -tt)))]
       ;; if
       [(if tst thn els) (tc/if-twoarm #'tst #'thn #'els expected)]
       ;; lambda
@@ -236,7 +236,7 @@
           (define actual-kws (attribute kw.value))
           (check-kw-arity actual-kws f)
           (tc-expr/check/type #'fun (kw-convert f actual-kws #:split #t))
-          (ret f -true-filter)]
+          (ret f -true-propset)]
          [(or (tc-results: _) (tc-any-results: _))
           (tc-expr/check form #f)])]
       ;; opt function def
@@ -344,14 +344,14 @@
              [else
               ;; Typecheck the first form.
               (define e (first es))
-              (define results (tc-expr/check e (tc-any-results -no-filter)))
+              (define results (tc-expr/check e (tc-any-results #f)))
               (define props
                 (match results
                   [(tc-any-results: f) (list f)]
-                  [(tc-results: _ (list (FilterSet: f+ f-) ...) _)
-                   (map -or f+ f-)]
-                  [(tc-results: _ (list (FilterSet: f+ f-) ...) _ _ _)
-                   (map -or f+ f-)]))
+                  [(tc-results: _ (list (PropSet: p+ p-) ...) _)
+                   (map -or p+ p-)]
+                  [(tc-results: _ (list (PropSet: p+ p-) ...) _ _ _)
+                   (map -or p+ p-)]))
               (with-lexical-env/extend-props
                props
                ;; If `e` bails out, mark the rest as ignored.
@@ -366,18 +366,18 @@
 (define (find-stx-type datum-stx [expected #f])
   (match datum-stx
     [(? syntax? (app syntax-e stx-e))
-     (match (and expected (resolve (restrict expected (-Syntax Univ) 'orig)))
+     (match (and expected (resolve (intersect expected (-Syntax Univ))))
        [(Syntax: t) (-Syntax (find-stx-type stx-e t))]
        [_ (-Syntax (find-stx-type stx-e))])]
     [(or (? symbol?) (? null?) (? number?) (? extflonum?) (? boolean?) (? string?) (? char?)
          (? bytes?) (? regexp?) (? byte-regexp?) (? keyword?))
      (tc-literal #`#,datum-stx expected)]
     [(cons car cdr)
-     (match (and expected (resolve (restrict expected (-pair Univ Univ) 'orig)))
+     (match (and expected (resolve (intersect expected (-pair Univ Univ))))
        [(Pair: car-t cdr-t) (-pair (find-stx-type car car-t) (find-stx-type cdr cdr-t))]
        [_ (-pair (find-stx-type car) (find-stx-type cdr))])]
     [(vector xs ...)
-     (match (and expected (resolve (restrict expected -VectorTop 'orig)))
+     (match (and expected (resolve (intersect expected -VectorTop)))
        [(Vector: t)
         (make-Vector
          (check-below
@@ -393,11 +393,11 @@
        [_ (make-HeterogeneousVector (for/list ([x (in-list xs)])
                                       (generalize (find-stx-type x #f))))])]
     [(box x)
-     (match (and expected (resolve (restrict expected -BoxTop 'orig)))
+     (match (and expected (resolve (intersect expected -BoxTop)))
        [(Box: t) (-box (check-below (find-stx-type x t) t))]
        [_ (-box (generalize (find-stx-type x)))])]
     [(? hash? h)
-     (match (and expected (resolve (restrict expected -HashTop 'orig)))
+     (match (and expected (resolve (intersect expected -HashTop)))
        [(Hashtable: kt vt)
         (define kts (hash-map h (lambda (x y) (find-stx-type x kt))))
         (define vts (hash-map h (lambda (x y) (find-stx-type y vt))))

typed-racket-lib/typed-racket/typecheck/tc-expression.rkt

@@ -2,7 +2,7 @@
 
 (require
   "../utils/utils.rkt"
-  (typecheck signatures tc-app-helper check-below)
+  (typecheck signatures possible-domains check-below)
   (types utils abbrev classes type-table)
   (rep type-rep)
   (utils tc-utils)
@@ -18,7 +18,7 @@
 (export tc-expression^)
 
 ;; Typecheck an (#%expression e) form
-(define (tc/#%expression form expected)
+(define (tc/#%expression form [expected #f])
   (syntax-parse form
     [(exp:type-inst^ e)
      (do-inst (tc-expr #'e) (attribute exp.value))]
@@ -34,6 +34,14 @@
      (if expected
         (tc-expr/check #'e expected)
         (tc-expr #'e))]
+    [(exp:casted-expr^ e)
+     (define result (tc-expr #'e))
+     (match result
+       [(tc-result1: ty)
+        ((attribute exp.value) ty)
+        result]
+       [_
+        (tc-error/expr "Cannot cast expression that produces multiple values")])]
     [(_ e)
      (if expected
          (tc-expr/check #'e expected)

typed-racket-lib/typed-racket/typecheck/tc-funapp.rkt

@@ -48,7 +48,7 @@
                   #:when (subtypes/varargs argtys dom rest))
         ;; then typecheck here
         ;; we call the separate function so that we get the appropriate
-        ;; filters/objects
+        ;; props/objects
         (tc/funapp1 f-stx args-stx a args-res expected #:check #f))
       ;; if nothing matched, error
       (domain-mismatches
@@ -70,7 +70,7 @@
                           (eq? dotted-var (cdr drest)))]
               [else (= (length dom) (length argtys))]))
       ;; Only try to infer the free vars of the rng (which includes the vars
-      ;; in filters/objects).
+      ;; in props/objects).
       (λ (dom rng rest drest a)
         (extend-tvars fixed-vars
           (cond
@@ -95,7 +95,7 @@
       (λ (dom _ rest kw? a) 
         (and (andmap not kw?) ((if rest <= =) (length dom) (length argtys))))
       ;; Only try to infer the free vars of the rng (which includes the vars
-      ;; in filters/objects).
+      ;; in props/objects).
       (λ (dom rng rest kw? a)
         (extend-tvars vars
                       (infer/vararg vars null argtys dom rest rng
@@ -145,9 +145,9 @@
       [(list) (ret out)]
       [(list t)
        (if (subtype t in)
-           (ret -Void -true-filter)
+           (ret -Void -true-propset)
            (tc-error/expr
-            #:return (ret -Void -true-filter)
+            #:return (ret -Void -true-propset)
             "Wrong argument to parameter - expected ~a and got ~a"
             in t))]
       [_ (tc-error/expr

typed-racket-lib/typed-racket/typecheck/tc-if.rkt

@@ -1,7 +1,7 @@
 #lang racket/unit
 (require "../utils/utils.rkt"
-         (rep filter-rep)
-         (types utils filter-ops)
+         (rep prop-rep)
+         (types utils prop-ops)
          (utils tc-utils)
          (typecheck signatures tc-envops tc-metafunctions)
          (types type-table)
@@ -13,8 +13,8 @@
 
 (define (tc/if-twoarm tst thn els [expected #f])
   (match (single-value tst)
-    [(tc-result1: _ (FilterSet: fs+ fs-) _)
-     (define expected* (and expected (erase-filter expected)))
+    [(tc-result1: _ (PropSet: fs+ fs-) _)
+     (define expected* (and expected (erase-props expected)))
      (define results-t
        (with-lexical-env/extend-props (list fs+)
          #:unreachable (warn-unreachable thn)

typed-racket-lib/typed-racket/typecheck/tc-lambda-unit.rkt

@@ -531,8 +531,8 @@
           (match expected
             [(tc-result1: (app resolve t)) (or (Poly? t) (PolyDots? t) (PolyRow? t))]
             [_ #f]))
-      (ret (tc/plambda form (get-poly-tvarss form) formals bodies expected) -true-filter)
-      (ret (tc/mono-lambda/type formals bodies expected) -true-filter)))
+      (ret (tc/plambda form (get-poly-tvarss form) formals bodies expected) -true-propset)
+      (ret (tc/mono-lambda/type formals bodies expected) -true-propset)))
 
 ;; formals : the formal arguments to the loop
 ;; body : a block containing the body of the loop

typed-racket-lib/typed-racket/typecheck/tc-let-unit.rkt

@@ -1,14 +1,14 @@
 #lang racket/unit
 
 (require "../utils/utils.rkt"
-         (except-in (types utils abbrev filter-ops remove-intersect type-table)
+         (except-in (types utils abbrev prop-ops overlap type-table)
                     -> ->* one-of/c)
          (only-in (types abbrev) (-> t:->) [->* t:->*])
          (private type-annotation parse-type syntax-properties)
          (env lexical-env type-alias-helper mvar-env
               global-env scoped-tvar-env 
               signature-env signature-helper)
-         (rep filter-rep object-rep type-rep)
+         (rep prop-rep object-rep type-rep)
          syntax/free-vars
          (typecheck signatures tc-metafunctions tc-subst internal-forms tc-envops)
          (utils tarjan)
@@ -49,13 +49,13 @@
    tc-results/c)
   (with-cond-contract t/p ([expected-types (listof (listof Type/c))]
                            [objs           (listof (listof Object?))]
-                           [props          (listof (listof Filter?))])
+                           [props          (listof (listof Prop?))])
     (define-values (expected-types objs props)
       (for/lists (e o p)
         ([e-r   (in-list expected-results)]
          [names (in-list namess)])
         (match e-r
-          [(list (tc-result: e-ts (FilterSet: fs+ fs-) os) ...)
+          [(list (tc-result: e-ts (PropSet: fs+ fs-) os) ...)
            (values e-ts
                    (map (λ (o n t) (if (or (is-var-mutated? n) (F? t)) -empty-obj o)) os names e-ts)
                    (apply append
@@ -65,7 +65,7 @@
                                      [f- (in-list fs-)]
                                      [o (in-list os)])
                             (cond
-                              [(not (overlap t (-val #f)))
+                              [(not (overlap? t (-val #f)))
                                (list f+)]
                               [(is-var-mutated? n)
                                (list)]
@@ -75,10 +75,10 @@
                               [(and (Path? o) (not (F? t))) (list)]
                               ;; n is being bound to an expression w/o an object (or whose
                               ;; type is a type variable) so create props about n
-                              [else (list (-or (-and (-not-filter (-val #f) n) f+)
-                                               (-and (-filter (-val #f) n) f-)))]))))]
+                              [else (list (-or (-and (-not-type n (-val #f)) f+)
+                                               (-and (-is-type n (-val #f)) f-)))]))))]
           ;; amk: does this case ever occur?
-          [(list (tc-result: e-ts (NoFilter:) _) ...)
+          [(list (tc-result: e-ts #f _) ...)
            (values e-ts (make-list (length e-ts) -empty-obj) null)]))))
   ;; extend the lexical environment for checking the body
   ;; with types and potential aliases
@@ -102,7 +102,7 @@
         ;; in the context of the letrec body
         (check-thunk)
         ;; typecheck the body
-        (tc-body/check body (and expected (erase-filter expected)))))))
+        (tc-body/check body (and expected (erase-props expected)))))))
 
 (define (tc-expr/maybe-expected/t e names)
   (syntax-parse names
@@ -182,7 +182,7 @@
          ;; after everything, check the body expressions
          [(null? remaining-names)
           (check-thunk)
-          (tc-body/check body (and expected (erase-filter expected)))]
+          (tc-body/check body (and expected (erase-props expected)))]
          [else
           (define flat-names (apply append remaining-names))
           (do-check tc-expr/check

typed-racket-lib/typed-racket/typecheck/tc-literal.rkt

@@ -6,7 +6,7 @@
          (types abbrev numeric-tower resolve subtype union generalize
                 prefab)
          (rep type-rep)
-         (only-in (infer infer) restrict)
+         (only-in (infer infer) intersect)
          (utils stxclass-util)
          syntax/parse
          racket/function
@@ -89,7 +89,7 @@
     [i:regexp  -Regexp]
     [() -Null]
     [(i . r)
-     (match (and expected (resolve (restrict expected (-pair Univ Univ) 'orig)))
+     (match (and expected (resolve (intersect expected (-pair Univ Univ))))
        [(Pair: a-ty d-ty)
         (-pair
          (tc-literal #'i a-ty)
@@ -97,7 +97,7 @@
        [t 
         (-pair (tc-literal #'i) (tc-literal #'r))])]
     [(~var i (3d vector?))
-     (match (and expected (resolve (restrict expected -VectorTop 'orig)))
+     (match (and expected (resolve (intersect expected -VectorTop)))
        [(Vector: t)
         (make-Vector
           (check-below
@@ -113,7 +113,7 @@
        [_ (make-HeterogeneousVector (for/list ([l (in-vector (syntax-e #'i))])
                                       (generalize (tc-literal l #f))))])]
     [(~var i (3d hash?))
-     (match (and expected (resolve (restrict expected -HashTop 'orig)))
+     (match (and expected (resolve (intersect expected -HashTop)))
        [(Hashtable: k v)
         (let* ([h (syntax-e #'i)]
                [ks (hash-map h (lambda (x y) (tc-literal x k)))]

typed-racket-lib/typed-racket/typecheck/tc-metafunctions.rkt

@@ -2,9 +2,9 @@
 
 (require "../utils/utils.rkt"
          racket/match racket/list
-         (except-in (types abbrev union utils filter-ops tc-result)
+         (except-in (types abbrev union utils prop-ops tc-result)
                     -> ->* one-of/c)
-         (rep type-rep filter-rep object-rep rep-utils)
+         (rep type-rep prop-rep object-rep rep-utils)
          (typecheck tc-subst check-below)
          (contract-req))
 
@@ -36,20 +36,20 @@
      (make-ValuesDots (map -result ts fs os) dty dbound)]))
 
 (define/cond-contract (resolve atoms prop)
-  ((listof Filter/c)
-   Filter/c
+  ((listof Prop?)
+   Prop?
    . -> .
-   Filter/c)
+   Prop?)
   (for/fold ([prop prop])
     ([a (in-list atoms)])
     (match prop
-      [(AndFilter: ps)
+      [(AndProp: ps)
        (let loop ([ps ps] [result null])
          (if (null? ps)
              (apply -and result)
              (let ([p (car ps)])
-               (cond [(contradictory? a p) -bot]
-                     [(implied-atomic? p a) (loop (cdr ps) result)]
+               (cond [(contradictory? a p) -ff]
+                     [(implies-atomic? a p) (loop (cdr ps) result)]
                      [else (loop (cdr ps) (cons p result))]))))]
       [_ prop])))
 
@@ -57,14 +57,14 @@
   (let loop ([ps ps])
     (match ps
       [(list) null]
-      [(cons (AndFilter: ps*) ps) (loop (append ps* ps))]
+      [(cons (AndProp: ps*) ps) (loop (append ps* ps))]
       [(cons p ps) (cons p (loop ps))])))
 
 (define/cond-contract (combine-props new-props old-props exit)
-  ((listof Filter/c) (listof Filter/c) (-> none/c)
+  ((listof Prop?) (listof Prop?) (-> none/c)
    . -> .
-   (values (listof (or/c ImpFilter? OrFilter?)) (listof (or/c TypeFilter? NotTypeFilter?))))
-  (define (atomic-prop? p) (or (TypeFilter? p) (NotTypeFilter? p)))
+   (values (listof OrProp?) (listof (or/c TypeProp? NotTypeProp?))))
+  (define (atomic-prop? p) (or (TypeProp? p) (NotTypeProp? p)))
   (define-values (new-atoms new-formulas) (partition atomic-prop? (flatten-props new-props)))
   (let loop ([derived-formulas null]
              [derived-atoms new-atoms]
@@ -74,12 +74,7 @@
         (let* ([p (car worklist)]
                [p (resolve derived-atoms p)])
           (match p
-            [(ImpFilter: a c)
-             (if (for/or ([p (in-list (append derived-formulas derived-atoms))])
-                   (implied-atomic? a p))
-                 (loop derived-formulas derived-atoms (cons c (cdr worklist)))
-                 (loop (cons p derived-formulas) derived-atoms (cdr worklist)))]
-            [(OrFilter: ps)
+            [(OrProp: ps)
              (let ([new-or
                     (let or-loop ([ps ps] [result null])
                       (cond
@@ -88,32 +83,32 @@
                            (contradictory? (car ps) other-p))
                          (or-loop (cdr ps) result)]
                         [(for/or ([other-p (in-list derived-atoms)])
-                           (implied-atomic? (car ps) other-p))
-                         -top]
+                           (implies-atomic? other-p (car ps)))
+                         -tt]
                         [else (or-loop (cdr ps) (cons (car ps) result))]))])
-               (if (OrFilter? new-or)
+               (if (OrProp? new-or)
                    (loop (cons new-or derived-formulas) derived-atoms (cdr worklist))
                    (loop derived-formulas derived-atoms (cons new-or (cdr worklist)))))]
-            [(or (? TypeFilter?) (? NotTypeFilter?)) (loop derived-formulas (cons p derived-atoms) (cdr worklist))]
+            [(or (? TypeProp?) (? NotTypeProp?)) (loop derived-formulas (cons p derived-atoms) (cdr worklist))]
 
-            [(AndFilter: ps) (loop derived-formulas derived-atoms (append ps (cdr worklist)))]
-            [(Top:) (loop derived-formulas derived-atoms (cdr worklist))]
-            [(Bot:) (exit)])))))
+            [(AndProp: ps) (loop derived-formulas derived-atoms (append ps (cdr worklist)))]
+            [(TrueProp:) (loop derived-formulas derived-atoms (cdr worklist))]
+            [(FalseProp:) (exit)])))))
 
 
 (define (unconditional-prop res)
   (match res
-    [(tc-any-results: f) f]
-    [(tc-results (list (tc-result: _ (FilterSet: f+ f-) _) ...) _)
-     (apply -and (map -or f+ f-))]))
+    [(tc-any-results: pset) pset]
+    [(tc-results (list (tc-result: _ (PropSet: p+ p-) _) ...) _)
+     (apply -and (map -or p+ p-))]))
 
 (define (merge-tc-results results)
   (define/match (merge-tc-result r1 r2)
-    [((tc-result: t1 (FilterSet: f1+ f1-) o1)
-      (tc-result: t2 (FilterSet: f2+ f2-) o2))
+    [((tc-result: t1 (PropSet: p1+ p1-) o1)
+      (tc-result: t2 (PropSet: p2+ p2-) o2))
      (tc-result
        (Un t1 t2)
-       (-FS (-or f1+ f2+) (-or f1- f2-))
+       (-PS (-or p1+ p2+) (-or p1- p2-))
        (if (equal? o1 o2) o1 -empty-obj))])
 
   (define/match (same-dty? r1 r2)

typed-racket-lib/typed-racket/typecheck/tc-structs.rkt

@@ -6,10 +6,10 @@
          (prefix-in c: (contract-req))
          (rep type-rep object-rep free-variance)
          (private parse-type syntax-properties)
-         (types abbrev utils resolve substitute struct-table prefab)
+         (types abbrev subtype utils resolve substitute struct-table prefab)
          (env global-env type-name-env type-alias-env tvar-env)
          (utils tc-utils)
-         (typecheck def-binding internal-forms)
+         (typecheck def-binding internal-forms error-message)
          (for-syntax syntax/parse racket/base))
 
 (require-for-cond-contract racket/struct-info)
@@ -32,17 +32,27 @@
 ;; type-only : Boolean
 (struct parsed-struct (sty names desc struct-info type-only) #:transparent)
 
-;; type-name : Id
-;; struct-type : Id
+;; struct-name : Id  (the identifier for the static struct info,
+;;                    usually the same as the type-name)
+;; type-name : Id    (the identifier for the type name)
+;; struct-type : Id  (the identifier for the struct type binding)
 ;; constructor : Id
 ;; extra-constructor : (Option Id)
 ;; predicate : Id
 ;; getters : Listof[Id]
 ;; setters : Listof[Id] or #f
-(struct struct-names (type-name struct-type constructor extra-constructor predicate getters setters) #:transparent)
+(struct struct-names (struct-name type-name struct-type constructor extra-constructor predicate getters setters) #:transparent)
 
-;;struct-fields: holds all the relevant information about a struct type's types
-(struct struct-desc (parent-fields self-fields tvars mutable proc-ty) #:transparent)
+;; struct-desc holds all the relevant information about a struct type's types
+;; parent-fields : (Listof Type)
+;; self-fields : (Listof Type)
+;; tvars : (Listof Symbol)
+;; mutable: Any
+;; parent-mutable: Any
+;; proc-ty: (Option Type)
+(struct struct-desc (parent-fields self-fields tvars
+                     mutable parent-mutable proc-ty)
+        #:transparent)
 
 (define (struct-desc-all-fields fields)
   (append (struct-desc-parent-fields fields) (struct-desc-self-fields fields)))
@@ -52,8 +62,7 @@
 (define (name-of-struct stx)
   (syntax-parse stx
     [(~or t:typed-struct t:typed-struct/exec)
-     #:with nm/par:parent #'t.nm
-     #'nm/par.name]))
+     #'t.type-name]))
 
 
 ;; parse name field of struct, determining whether a parent struct was specified
@@ -81,7 +90,7 @@
 ;; and optional constructor name
 ;; all have syntax loc of name
 ;; identifier listof[identifier] Option[identifier] -> struct-names
-(define (get-struct-names nm flds maker* extra-maker)
+(define (get-struct-names type-name nm flds maker* extra-maker)
   (define (split l)
     (let loop ([l l] [getters '()] [setters '()])
       (if (null? l)
@@ -90,7 +99,7 @@
   (match (build-struct-names nm flds #f #f nm #:constructor-name maker*)
     [(list sty maker pred getters/setters ...)
      (let-values ([(getters setters) (split getters/setters)])
-       (struct-names nm sty maker extra-maker pred getters setters))]))
+       (struct-names nm type-name sty maker extra-maker pred getters setters))]))
 
 ;; gets the fields of the parent type, if they exist
 ;; Option[Struct-Ty] -> Listof[Type]
@@ -110,7 +119,7 @@
                                [g (in-list (struct-names-getters names))])
                        (make-fld t g (struct-desc-mutable desc)))]
          [flds (append (get-flds parent) this-flds)])
-    (make-Struct (struct-names-type-name names)
+    (make-Struct (struct-names-struct-name names)
                  parent flds (struct-desc-proc-ty desc)
                  (not (null? (struct-desc-tvars desc)))
                  (struct-names-predicate names))))
@@ -141,8 +150,10 @@
 
   (define tvars (struct-desc-tvars desc))
   (define all-fields (struct-desc-all-fields desc))
+  (define parent-fields (struct-desc-parent-fields desc))
   (define self-fields (struct-desc-self-fields desc))
   (define mutable (struct-desc-mutable desc))
+  (define parent-mutable (struct-desc-parent-mutable desc))
   (define parent-count (struct-desc-parent-count desc))
 
 
@@ -155,12 +166,15 @@
         (make-App name-type (map make-F tvars) #f)))
 
   ;; is this structure covariant in *all* arguments?
-  (define covariant?
+  (define (covariant-for? fields mutable)
     (for*/and ([var (in-list tvars)]
-               [t (in-list all-fields)])
+               [t (in-list fields)])
       (let ([variance (hash-ref (free-vars-hash (free-vars* t)) var Constant)])
         (or (eq? variance Constant)
             (and (not mutable) (eq? variance Covariant))))))
+  (define covariant?
+    (and (covariant-for? self-fields mutable)
+         (covariant-for? parent-fields parent-mutable)))
 
   (define (poly-wrapper t) (make-Poly tvars t))
   (define bindings
@@ -194,10 +208,6 @@
 
   (define extra-constructor (struct-names-extra-constructor names))
 
-  (add-struct-constructor! (struct-names-constructor names))
-  (when extra-constructor
-    (add-struct-constructor! extra-constructor))
-
   (define constructor-binding
     (make-def-binding (struct-names-constructor names)
                       (poly-wrapper (->* all-fields poly-base))))
@@ -246,7 +256,7 @@
 ;; tc/struct : Listof[identifier] (U identifier (list identifier identifier))
 ;;             Listof[identifier] Listof[syntax]
 ;;             -> void
-(define (tc/struct vars nm/par fld-names tys
+(define (tc/struct vars nm/par type-name fld-names tys
                    #:proc-ty [proc-ty #f]
                    #:maker [maker #f]
                    #:extra-maker [extra-maker #f]
@@ -262,7 +272,7 @@
   (define types
     ;; add the type parameters of this structure to the tvar env
     (extend-tvars tvars
-      (parameterize ([current-poly-struct `#s(poly ,nm ,new-tvars)])
+      (parameterize ([current-poly-struct `#s(poly ,type-name ,new-tvars)])
         ;; parse the field types
         (map parse-type tys))))
   ;; instantiate the parent if necessary, with new-tvars
@@ -277,7 +287,7 @@
   ;; create the actual structure type, and the types of the fields
   ;; that the outside world will see
   ;; then register it
-  (define names (get-struct-names nm fld-names maker extra-maker))
+  (define names (get-struct-names type-name nm fld-names maker extra-maker))
 
   (cond [prefab?
          (define-values (parent-key parent-fields)
@@ -294,18 +304,42 @@
          (define key
            (normalize-prefab-key (append key-prefix parent-key)
                                  (+ (length fld-names) (length parent-fields))))
-         (define desc (struct-desc parent-fields types tvars mutable #f))
+         (define parent-mutable
+           (match parent-key
+             [(list-rest _ num-fields _ mutable _)
+              (= num-fields (vector-length mutable))]
+             ;; no parent, so trivially true
+             ['() #t]))
+         (define desc
+           (struct-desc parent-fields types tvars mutable parent-mutable #f))
          (parsed-struct (make-Prefab key (append parent-fields types))
                         names desc (struct-info-property nm/par) #f)]
         [else
+         (define maybe-proc-ty
+           (let ([maybe-parsed-proc-ty (and proc-ty (parse-type proc-ty))])
+             (and maybe-parsed-proc-ty
+                  (cond
+                    ;; ensure that the prop:procedure argument is really a procedure
+                    [(subtype maybe-parsed-proc-ty top-func)
+                     maybe-parsed-proc-ty]
+                    [else (expected-but-got top-func maybe-parsed-proc-ty)
+                          #f]))))
+         
+         (define parent-mutable
+           ;; Only valid as long as typed structs must be
+           ;; either fully mutable or fully immutable
+           (or (not parent)
+               (andmap fld-mutable? (get-flds concrete-parent))))
+         
          (define desc (struct-desc
-                        (map fld-t (get-flds concrete-parent))
-                        types
-                        tvars
-                        mutable
-                        (and proc-ty (parse-type proc-ty))))
+                       (map fld-t (get-flds concrete-parent))
+                       types
+                       tvars
+                       mutable
+                       parent-mutable
+                       maybe-proc-ty))
          (define sty (mk/inner-struct-type names desc concrete-parent))
-
+         
          (parsed-struct sty names desc (struct-info-property nm/par) type-only)]))
 
 ;; register a struct type
@@ -322,8 +356,9 @@
     (and parent (resolve-name (make-Name parent 0 #t))))
   (define parent-tys (map fld-t (get-flds parent-type)))
 
-  (define names (get-struct-names nm fld-names #f #f))
-  (define desc (struct-desc parent-tys tys null #t #f))
+  (define names (get-struct-names nm nm fld-names #f #f))
+  ;; built-in structs are assumed to be immutable with immutable parents
+  (define desc (struct-desc parent-tys tys null #f #f #f))
   (define sty (mk/inner-struct-type names desc parent-type))
 
   (register-sty! sty names desc)

typed-racket-lib/typed-racket/typecheck/tc-subst.rkt

@@ -6,10 +6,10 @@
 (require "../utils/utils.rkt"
          racket/match racket/list
          (contract-req)
-         (except-in (types abbrev utils filter-ops path-type)
+         (except-in (types abbrev utils prop-ops path-type)
                     -> ->* one-of/c)
-         (only-in (infer infer) restrict)
-         (rep type-rep object-rep filter-rep rep-utils))
+         (only-in (infer infer) intersect)
+         (rep type-rep object-rep prop-rep rep-utils))
 
 (provide add-scope)
 
@@ -49,12 +49,12 @@
 ;; This is a combination of all of thes substitions from the paper over the different parts of the
 ;; results.
 ;; t is the type of the object that we are substituting in. This allows for restriction/simplification
-;; of some filters if they conflict with the argument type.
+;; of some props if they conflict with the argument type.
 (define/cond-contract (subst-tc-results res k o polarity t)
   (-> full-tc-results/c name-ref/c Object? boolean? Type? full-tc-results/c)
   (define (st ty) (subst-type ty k o polarity t))
   (define (sr ty fs ob) (subst-tc-result ty fs ob k o polarity t))
-  (define (sf f) (subst-filter f k o polarity t))
+  (define (sf f) (subst-prop f k o polarity t))
   (match res
     [(tc-any-results: f) (tc-any-results (sf f))]
     [(tc-results: ts fs os)
@@ -76,36 +76,36 @@
   (tc-result
     (if (equal? argument-side Err)
         (subst-type r-t k o polarity t)
-        (restrict argument-side
-                  (subst-type r-t k o polarity t)))
-    (subst-filter-set r-fs k o polarity t)
+        (intersect argument-side
+                   (subst-type r-t k o polarity t)))
+    (subst-prop-set r-fs k o polarity t)
     (subst-object r-o k o polarity)))
 
-;; Substitution of objects into a filter set
+;; Substitution of objects into a prop set
 ;; This is essentially ψ+|ψ- [o/x] from the paper
-(define/cond-contract (subst-filter-set fs k o polarity t)
-  (-> (or/c FilterSet? NoFilter?) name-ref/c Object? boolean? Type/c FilterSet?)
-  (define extra-filter (-filter t k))
-  (define (add-extra-filter f)
-    (define f* (-and f extra-filter))
+(define/cond-contract (subst-prop-set pset k o polarity t)
+  (-> (or/c #f PropSet?) name-ref/c Object? boolean? Type/c PropSet?)
+  (define extra-prop (-is-type k t))
+  (define (add-extra-prop p)
+    (define p* (-and p extra-prop))
     (cond
-      [(filter-equal? f* extra-filter) -top]
-      [(Bot? f*) -bot]
-      [else f]))
-  (match fs
-    [(FilterSet: f+ f-)
-     (-FS (subst-filter (add-extra-filter f+) k o polarity t)
-          (subst-filter (add-extra-filter f-) k o polarity t))]
-    [_ -top-filter]))
+      [(prop-equal? p* extra-prop) -tt]
+      [(FalseProp? p*) -ff]
+      [else p]))
+  (match pset
+    [(PropSet: p+ p-)
+     (-PS (subst-prop (add-extra-prop p+) k o polarity t)
+          (subst-prop (add-extra-prop p-) k o polarity t))]
+    [_ -tt-propset]))
 
 ;; Substitution of objects into a type
 ;; This is essentially t [o/x] from the paper
 (define/cond-contract (subst-type t k o polarity ty)
   (-> Type? name-ref/c Object? boolean? Type/c Type?)
   (define (st t) (subst-type t k o polarity ty))
-  (define/cond-contract (sf fs) (FilterSet? . -> . FilterSet?) (subst-filter-set fs k o polarity ty))
+  (define/cond-contract (sf fs) (PropSet? . -> . PropSet?) (subst-prop-set fs k o polarity ty))
   (type-case (#:Type st
-              #:Filter sf
+              #:Prop sf
               #:Object (lambda (f) (subst-object f k o polarity)))
               t
               [#:arr dom rng rest drest kws
@@ -135,80 +135,48 @@
 (define/cond-contract (subst-object t k o polarity)
   (-> Object? name-ref/c Object? boolean? Object?)
   (match t
-    [(NoObject:) t]
+    [#f t]
     [(Empty:) t]
     [(Path: p i)
      (if (name-ref=? i k)
          (match o
            [(Empty:) -empty-obj]
            ;; the result is not from an annotation, so it isn't a NoObject
-           [(NoObject:) -empty-obj]
+           [#f -empty-obj]
            [(Path: p* i*) (make-Path (append p p*) i*)])
          t)]))
 
-;; Substitution of objects into a filter in a filter set
-;; This is ψ+ [o/x] and ψ- [o/x] with the addition that filters are restricted to
+;; Substitution of objects into a prop in a prop set
+;; This is ψ+ [o/x] and ψ- [o/x] with the addition that props are restricted to
 ;; only those values which are a subtype of the actual argument type (ty).
-(define/cond-contract (subst-filter f k o polarity ty)
-  (-> Filter/c name-ref/c Object? boolean? Type/c Filter/c)
-  (define (ap f) (subst-filter f k o polarity ty))
-  (define (tf-matcher t p i maker)
+(define/cond-contract (subst-prop p k o polarity ty)
+  (-> Prop? name-ref/c Object? boolean? Type/c Prop?)
+  (define (ap q) (subst-prop q k o polarity ty))
+  (define (tprop-matcher pes i t maker)
     (cond
       [(name-ref=? i k)
        (match o
          [(Empty:)
-          (if polarity -top -bot)]
+          (if polarity -tt -ff)]
          [_
           ;; `ty` alone doesn't account for the path, so
           ;; first traverse it with the path to match `t`
-          (define ty/path (path-type p ty))
+          (define ty/path (path-type pes ty))
           (maker
-            ;; don't restrict if the path doesn't match the type
-            (if (equal? ty/path Err)
-                (subst-type t k o polarity ty)
-                (restrict ty/path
-                          (subst-type t k o polarity ty)))
-            (-acc-path p o))])]
-      [(index-free-in? k t) (if polarity -top -bot)]
-      [else f]))
+           (-acc-path pes o)
+           ;; don't intersect if the path doesn't match the type
+           (if (equal? ty/path Err)
+               (subst-type t k o polarity ty)
+               (intersect ty/path
+                          (subst-type t k o polarity ty))))])]
+      [else p]))
 
-  (match f
-    [(ImpFilter: ant consq)
-     (-imp (subst-filter ant k o (not polarity) ty) (ap consq))]
-    [(AndFilter: fs) (apply -and (map ap fs))]
-    [(OrFilter: fs) (apply -or (map ap fs))]
-    [(Bot:) -bot]
-    [(Top:) -top]
-    [(TypeFilter: t (Path: p i))
-     (tf-matcher t p i -filter)]
-    [(NotTypeFilter: t (Path: p i))
-     (tf-matcher t p i -not-filter)]))
-
-;; Determine if the object k occurs free in the given type
-(define (index-free-in? k type)
-  (let/ec
-   return
-   (define (for-object o)
-     (object-case (#:Type for-type)
-                  o
-                  [#:Path p i
-                          (if (name-ref=? i k)
-                              (return #t)
-                              o)]))
-   (define (for-type t)
-     (type-case (#:Type for-type
-                 #:Object for-object)
-                t
-                [#:arr dom rng rest drest kws
-                       (let* ([st* (if (pair? k)
-                                       (lambda (t) (index-free-in? (add-scope k) t))
-                                       for-type)])
-                         (for-each for-type dom)
-                         (st* rng)
-                         (and rest (for-type rest))
-                         (and drest (for-type (car drest)))
-                         (for-each for-type kws)
-                         ;; dummy return value
-                         (make-arr* null Univ))]))
-   (for-type type)
-    #f))
+  (match p
+    [(AndProp: ps) (apply -and (map ap ps))]
+    [(OrProp: ps) (apply -or (map ap ps))]
+    [(FalseProp:) -ff]
+    [(TrueProp:) -tt]
+    [(TypeProp: (Path: pes i) t)
+     (tprop-matcher pes i t -is-type)]
+    [(NotTypeProp: (Path: pes i) t)
+     (tprop-matcher pes i t -not-type)]))

typed-racket-lib/typed-racket/typecheck/tc-toplevel.rkt

@@ -36,14 +36,16 @@
   (parameterize ([current-orig-stx form])
     (syntax-parse form
       [t:typed-struct
-       (tc/struct (attribute t.tvars) #'t.nm (syntax->list #'(t.fields ...)) (syntax->list #'(t.types ...))
+       (tc/struct (attribute t.tvars) #'t.nm #'t.type-name
+                  (syntax->list #'(t.fields ...)) (syntax->list #'(t.types ...))
                   #:mutable (attribute t.mutable)
                   #:maker (attribute t.maker)
                   #:extra-maker (attribute t.extra-maker)
                   #:type-only (attribute t.type-only)
                   #:prefab? (attribute t.prefab))]
       [t:typed-struct/exec
-       (tc/struct null #'t.nm (syntax->list #'(t.fields ...)) (syntax->list #'(t.types ...))
+       (tc/struct null #'t.nm #'t.type-name
+                  (syntax->list #'(t.fields ...)) (syntax->list #'(t.types ...))
                   #:proc-ty #'t.proc-type)])))
 
 (define (type-vars-of-struct form)
@@ -211,7 +213,7 @@
 ;; typecheck the expressions of a module-top-level form
 ;; no side-effects
 ;; syntax? -> (or/c 'no-type tc-results/c)
-(define (tc-toplevel/pass2 form [expected (tc-any-results -top)])
+(define (tc-toplevel/pass2 form [expected (tc-any-results -tt)])
   
   (do-time (format "pass2 ~a line ~a"
                    (if #t

typed-racket-lib/typed-racket/typecheck/toplevel-trampoline.rkt

@@ -41,7 +41,7 @@
                        (rep type-rep)
                        (optimizer optimizer)
                        (types utils abbrev printer generalize)
-                       (typecheck tc-toplevel tc-app-helper)
+                       (typecheck tc-toplevel possible-domains)
                        (private type-contract syntax-properties)
                        (env mvar-env)
                        (utils disarm lift utils timing tc-utils arm mutated-vars)))
@@ -66,22 +66,23 @@
           (local-expand/capture* #'e 'top-level (kernel-form-identifier-list))))
        (syntax-parse head-expanded
          #:literal-sets (kernel-literals)
-         [(begin (define-values (n) _) ...
-                 (~and (~or _:ignore^ _:ignore-some^)
-                       (~not (~or _:tr:class^
-                                  _:tr:unit^
-                                  _:tr:unit:invoke^
-                                  _:tr:unit:compound^
-                                  _:tr:unit:from-context^))))
-          head-expanded]
-         ;; keep trampolining on begins
-         [(begin (define-values (n) e-rhs) ... (begin e ... e-last))
-          #`(begin (tc-toplevel-trampoline orig-stx (define-values (n) e-rhs))
-                   ...
-                   (tc-toplevel-trampoline orig-stx e) ...
-                   #,(if report?
-                         #'(tc-toplevel-trampoline/report orig-stx e-last)
-                         #'(tc-toplevel-trampoline orig-stx e-last)))]
+         ;; keep trampolining on begins, transfer syntax properties so that ignore
+         ;; properties are retained in the begin subforms
+         [(begin (define-values (n) e-rhs) ...
+                 (~and the-begin (begin e ... e-last)))
+          (define e*s
+            (for/list ([e (in-list (syntax->list #'(e ...)))])
+              (syntax-track-origin e #'the-begin #'begin)))
+          (define e-last*
+            (syntax-track-origin #'e-last #'the-begin #'begin))
+          (with-syntax ([(e ...) e*s]
+                        [e-last e-last*])
+            #`(begin (tc-toplevel-trampoline orig-stx (define-values (n) e-rhs))
+                     ...
+                     (tc-toplevel-trampoline orig-stx e) ...
+                     #,(if report?
+                           #'(tc-toplevel-trampoline/report orig-stx e-last)
+                           #'(tc-toplevel-trampoline orig-stx e-last))))]
          [_
           (define fully-expanded
             ;; a non-begin form can still cause lifts, so still have to catch them

typed-racket-lib/typed-racket/types/abbrev.rkt

@@ -12,7 +12,7 @@
          racket/function
 
          (prefix-in c: (contract-req))
-         (rename-in (rep type-rep filter-rep object-rep)
+         (rename-in (rep type-rep prop-rep object-rep)
                     [make-Base make-Base*])
          (types union numeric-tower prefab)
          ;; Using this form so all-from-out works
@@ -213,7 +213,7 @@
   (make-Base 'Special-Comment #'special-comment? special-comment?))
 (define/decl -Custodian (make-Base 'Custodian #'custodian? custodian?))
 (define/decl -Parameterization (make-Base 'Parameterization #'parameterization? parameterization?))
-(define/decl -Inspector (make-Base 'Inspector #'inspector inspector?))
+(define/decl -Inspector (make-Base 'Inspector #'inspector? inspector?))
 (define/decl -Namespace-Anchor (make-Base 'Namespace-Anchor #'namespace-anchor? namespace-anchor?))
 (define/decl -Variable-Reference (make-Base 'Variable-Reference #'variable-reference? variable-reference?))
 (define/decl -Internal-Definition-Context
@@ -262,23 +262,23 @@
 ;; Function type constructors
 (define/decl top-func (make-Function (list)))
 
-(define (asym-pred dom rng filter)
-  (make-Function (list (make-arr* (list dom) rng #:filters filter))))
+(define (asym-pred dom rng prop)
+  (make-Function (list (make-arr* (list dom) rng #:props prop))))
 
 (define/cond-contract make-pred-ty
   (c:case-> (c:-> Type/c Type/c)
             (c:-> (c:listof Type/c) Type/c Type/c Type/c)
             (c:-> (c:listof Type/c) Type/c Type/c Object? Type/c))
   (case-lambda
-    [(in out t p)
-     (->* in out : (-FS (-filter t p) (-not-filter t p)))]
+    [(in out t o)
+     (->* in out : (-PS (-is-type o t) (-not-type o t)))]
     [(in out t)
      (make-pred-ty in out t (make-Path null (list 0 0)))]
     [(t)
      (make-pred-ty (list Univ) -Boolean t (make-Path null (list 0 0)))]))
 
-(define/decl -true-filter (-FS -top -bot))
-(define/decl -false-filter (-FS -bot -top))
+(define/decl -true-propset (-PS -tt -ff))
+(define/decl -false-propset (-PS -ff -tt))
 
 (define (opt-fn args opt-args result #:rest [rest #f] #:kws [kws null])
   (apply cl->* (for/list ([i (in-range (add1 (length opt-args)))])

typed-racket-lib/typed-racket/types/base-abbrev.rkt

@@ -6,7 +6,7 @@
 ;; extends it with more types and type abbreviations.
 
 (require "../utils/utils.rkt"
-         (rep type-rep filter-rep object-rep rep-utils)
+         (rep type-rep prop-rep object-rep rep-utils)
          (env mvar-env)
          racket/match racket/list (prefix-in c: (contract-req))
          (for-syntax racket/base syntax/parse racket/list)
@@ -102,21 +102,19 @@
        (make-Mu 'var ty))]))
 
 ;; Results
-(define/cond-contract (-result t [f -top-filter] [o -empty-obj])
-  (c:->* (Type/c) (FilterSet? Object?) Result?)
+(define/cond-contract (-result t [pset -tt-propset] [o -empty-obj])
+  (c:->* (Type/c) (PropSet? Object?) Result?)
   (cond
-    [(or (equal? t -Bottom) (equal? f -bot-filter))
-     (make-Result -Bottom -bot-filter o)]
+    [(or (equal? t -Bottom) (equal? pset -ff-propset))
+     (make-Result -Bottom -ff-propset o)]
     [else
-     (make-Result t f o)]))
+     (make-Result t pset o)]))
 
-;; Filters
-(define/decl -top (make-Top))
-(define/decl -bot (make-Bot))
-(define/decl -no-filter (make-NoFilter))
-(define/decl -top-filter (make-FilterSet -top -top))
-(define/decl -bot-filter (make-FilterSet -bot -bot))
-(define/decl -no-obj (make-NoObject))
+;; Propositions
+(define/decl -tt (make-TrueProp))
+(define/decl -ff (make-FalseProp))
+(define/decl -tt-propset (make-PropSet -tt -tt))
+(define/decl -ff-propset (make-PropSet -ff -ff))
 (define/decl -empty-obj (make-Empty))
 (define (-id-path id)
   (cond
@@ -133,15 +131,15 @@
     [(Empty:) -empty-obj]
     [(Path: p o) (make-Path (append path-elems p) o)]))
 
-(define/cond-contract (-FS + -)
-  (c:-> Filter/c Filter/c FilterSet?)
-  (make-FilterSet + -))
+(define/cond-contract (-PS + -)
+  (c:-> Prop? Prop? PropSet?)
+  (make-PropSet + -))
 
-;; Abbreviation for filters
+;; Abbreviation for props
 ;; `i` can be an integer or name-ref/c for backwards compatibility
 ;; FIXME: Make all callers pass in an object and remove backwards compatibility
-(define/cond-contract (-filter t i)
-  (c:-> Type/c (c:or/c integer? name-ref/c Object?) Filter/c)
+(define/cond-contract (-is-type i t)
+  (c:-> (c:or/c integer? name-ref/c Object?) Type/c Prop?)
   (define o
     (cond
       [(Object? i) i]
@@ -149,17 +147,17 @@
       [(list? i) (make-Path null i)]
       [else (-id-path i)]))
   (cond
-    [(Empty? o) -top]
-    [(equal? Univ t) -top]
-    [(equal? -Bottom t) -bot]
-    [else (make-TypeFilter t o)]))
+    [(Empty? o) -tt]
+    [(equal? Univ t) -tt]
+    [(equal? -Bottom t) -ff]
+    [else (make-TypeProp o t)]))
 
 
-;; Abbreviation for not filters
+;; Abbreviation for not props
 ;; `i` can be an integer or name-ref/c for backwards compatibility
 ;; FIXME: Make all callers pass in an object and remove backwards compatibility
-(define/cond-contract (-not-filter t i)
-  (c:-> Type/c (c:or/c integer? name-ref/c Object?) Filter/c)
+(define/cond-contract (-not-type i t)
+  (c:-> (c:or/c integer? name-ref/c Object?) Type/c Prop?)
   (define o
     (cond
       [(Object? i) i]
@@ -167,30 +165,30 @@
       [(list? i) (make-Path null i)]
       [else (-id-path i)]))
   (cond
-    [(Empty? o) -top]
-    [(equal? -Bottom t) -top]
-    [(equal? Univ t) -bot]
-    [else (make-NotTypeFilter t o)]))
+    [(Empty? o) -tt]
+    [(equal? -Bottom t) -tt]
+    [(equal? Univ t) -ff]
+    [else (make-NotTypeProp o t)]))
 
 
 ;; 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))
+(define/decl ManyUniv (make-AnyValues -tt))
 
 ;; Function types
 (define/cond-contract (make-arr* dom rng
                                  #:rest [rest #f] #:drest [drest #f] #:kws [kws null]
-                                 #:filters [filters -top-filter] #:object [obj -empty-obj])
+                                 #:props [props -tt-propset] #:object [obj -empty-obj])
   (c:->* ((c:listof Type/c) (c:or/c SomeValues/c Type/c))
          (#:rest (c:or/c #f Type/c)
           #:drest (c:or/c #f (c:cons/c Type/c symbol?))
           #:kws (c:listof Keyword?)
-          #:filters FilterSet?
+          #:props PropSet?
           #:object Object?)
          arr?)
   (make-arr dom (if (Type/c? rng)
-                    (make-Values (list (-result rng filters obj)))
+                    (make-Values (list (-result rng props obj)))
                     rng)
             rest drest (sort #:key Keyword-kw kws keyword<?)))
 
@@ -202,23 +200,23 @@
      #'(make-Function (list (make-arr* dom rng)))]
     [(_ dom rst rng)
      #'(make-Function (list (make-arr* dom rng #:rest rst)))]
-    [(_ dom rng :c filters)
-     #'(make-Function (list (make-arr* dom rng #:filters filters)))]
-    [(_ dom rng _:c filters _:c object)
-     #'(make-Function (list (make-arr* dom rng #:filters filters #:object object)))]
-    [(_ dom rst rng _:c filters)
-     #'(make-Function (list (make-arr* dom rng #:rest rst #:filters filters)))]
-    [(_ dom rst rng _:c filters : object)
-     #'(make-Function (list (make-arr* dom rng #:rest rst #:filters filters #:object object)))]))
+    [(_ dom rng :c props)
+     #'(make-Function (list (make-arr* dom rng #:props props)))]
+    [(_ dom rng _:c props _:c object)
+     #'(make-Function (list (make-arr* dom rng #:props props #:object object)))]
+    [(_ dom rst rng _:c props)
+     #'(make-Function (list (make-arr* dom rng #:rest rst #:props props)))]
+    [(_ dom rst rng _:c props : object)
+     #'(make-Function (list (make-arr* dom rng #:rest rst #:props props #:object object)))]))
 
 (define-syntax (-> stx)
   (define-syntax-class c
     (pattern x:id #:fail-unless (eq? ': (syntax-e #'x)) #f))
   (syntax-parse stx
-    [(_ dom ... rng _:c filters _:c objects)
-     #'(->* (list dom ...) rng : filters : objects)]
-    [(_ dom ... rng :c filters)
-     #'(->* (list dom ...) rng : filters)]
+    [(_ dom ... rng _:c props _:c objects)
+     #'(->* (list dom ...) rng : props : objects)]
+    [(_ dom ... rng :c props)
+     #'(->* (list dom ...) rng : props)]
     [(_ dom ... rng)
      #'(->* (list dom ...) rng)]))
 
@@ -228,10 +226,10 @@
      (->* dom rng)]
     [(_ dom (dty dbound) rng)
      (make-Function (list (make-arr* dom rng #:drest (cons dty 'dbound))))]
-    [(_ dom rng : filters)
-     (->* dom rng : filters)]
-    [(_ dom (dty dbound) rng : filters)
-     (make-Function (list (make-arr* dom rng #:drest (cons dty 'dbound) #:filters filters)))]))
+    [(_ dom rng : props)
+     (->* dom rng : props)]
+    [(_ dom (dty dbound) rng : props)
+     (make-Function (list (make-arr* dom rng #:drest (cons dty 'dbound) #:props props)))]))
 
 (define (simple-> doms rng)
   (->* doms rng))
@@ -240,8 +238,8 @@
   (define obj (-acc-path path (-id-path var)))
   (make-Function
    (list (make-arr* dom rng
-                    #:filters (-FS (-not-filter (-val #f) obj)
-                                   (-filter (-val #f) obj))
+                    #:props (-PS (-not-type obj (-val #f))
+                                 (-is-type obj (-val #f)))
                     #:object obj))))
 
 (define (cl->* . args)