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.1")
+(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,12 +10,13 @@
                      "r6rs-lib"
                      "sandbox-lib"
                      "at-exp-lib"
-                     "scribble-lib"
+                     ("scribble-lib" #:version "1.16")
                      "pict-lib"
-                     "typed-racket-lib"
+                     ("typed-racket-lib" #:version "1.5")
                      "typed-racket-compatibility"
                      "typed-racket-more"
-                     "racket-doc"))
+                     "racket-doc"
+                     "draw-lib"))
 (define deps '("base"))
 (define update-implies '("typed-racket-lib"))
 
@@ -23,4 +24,4 @@
 
 (define pkg-authors '(samth stamourv))
 
-(define version "1.1")
+(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
@@ -34,11 +35,11 @@ This defines a new structure, named @racket[pt], with two fields,
 @racket[Real], which corresponds to the @rtech{real numbers}.
  The
 @racket[struct] form corresponds to its untyped counterpart from
-from @racketmodname[racket]---when porting a program from
+@racketmodname[racket]---when porting a program from
 @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))
@@ -49,7 +49,7 @@ typed/racket
                [#:struct pt ([x : Real] [y : Real])]
                [distance (-> pt pt Real)])
 
-(distance (pt 3 5) (p 7 0))
+(distance (pt 3 5) (pt 7 0))
 ]
 
 The @racket[require/typed] form has several kinds of clauses. The
@@ -100,17 +100,17 @@ 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)
 
-  (code:contract "increment : exact-integer? -> exact-integer?")
+  (code:contract increment : exact-integer? -> exact-integer?)
   (define (increment x) "this is broken"))
 ]
 
 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,8 +1,13 @@
 #lang scribble/manual
 
-@begin[(require "../utils.rkt")
+@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))
+@(define-syntax-rule (ex . args)
+   (examples #:eval the-top-eval . args))
+
+
 @title{Experimental Features}
 
 These features are currently experimental and subject to change.
@@ -15,3 +20,27 @@ predicate @racket[id], which must have been specified with
 @racket[declare-refinement].}
 
 @defform[(define-typed-struct/exec forms ...)]{Defines an executable structure.}
+
+@defform[(define-new-subtype name (constructor t))]{
+Defines a new type @racket[name] that is a subtype of @racket[t].
+The @racket[constructor] is defined as a function that takes a value of type
+@racket[t] and produces a value of the new type @racket[name].
+A @racket[define-new-subtype] definition is only allowed at the top level of a
+file or module.
+
+This is purely a type-level distinction, with no way to distinguish the new type
+from the base type at runtime. Predicates made by @racket[make-predicate]
+won't be able distinguish them properly, so they will return true for all values
+that the base type's predicate would return true for. This is usually not what
+you want, so you shouldn't use @racket[make-predicate] with these types.
+
+@ex[(module m typed/racket
+      (provide Radians radians f)
+      (define-new-subtype Radians (radians Real))
+      (: f : [Radians -> Real])
+      (define (f a)
+        (sin a)))
+    (require 'm)
+    (radians 0)
+    (f (radians 0))]
+}

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

@@ -4,14 +4,21 @@
        (require (for-label (only-meta-in 0 [except-in typed/racket for])
                            (only-in racket/base for)
                            racket/list srfi/14 net/url
-                           version/check))]
+                           version/check
+                           ;; Specific libraries wrapped for TR:
+                           file/gif
+                           net/http-client
+                           net/url-structs
+                           net/url
+                           openssl
+                           json))]
 
 
 @title{Libraries Provided With Typed Racket}
 
 The @racketmodname[typed/racket] language corresponds to the
 @racketmodname[racket] language---that is, any identifier provided
-by @racketmodname[racket], such as @racket[modulo] is available by default in
+by @racketmodname[racket], such as @racket[modulo], is available by default in
 @racketmodname[typed/racket].
 
 @racketmod[typed/racket
@@ -44,25 +51,66 @@ 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))
+
+@;; framework and mred left out until support for classes
+@;; is more complete
 @defmodule/incl[typed/file/gif]
+@deftype[GIF-Stream]{
+  Describe a GIF stream, as produced by @racket[gif-start]
+  and accepted by the other functions from @racketmodname[file/gif].
+}
+@deftype[GIF-Colormap]{
+  Type alias for a list of three-element (R,G,B) vectors representing an image.
+}
+
 @defmodule/incl[typed/file/md5]
 @defmodule/incl[typed/file/tar]
 @defmodule/incl[typed/framework]
 @defmodule/incl[typed/json]
+
+@deftype[JSExpr]{
+  Describes a @tech["jsexpr" #:doc '(lib "json/json.scrbl")].
+}
+
 @defmodule/incl[typed/mred/mred]
 @defmodule/incl[typed/net/base64]
 @defmodule/incl[typed/net/cgi]
 @defmodule/incl[typed/net/cookie]
+
+@deftype[Cookie]{
+  Describes an HTTP cookie as implemented by @racketmodname[net/cookie].
+}
+
 @defmodule/incl[typed/net/dns]
 @defmodule/incl[typed/net/ftp]
+
+@deftype[FTP-Connection]{
+  Describes an open FTP connection.
+}
+
 @defmodule/incl[typed/net/gifwrite]
 @defmodule/incl[typed/net/git-checkout]
 @defmodule/incl[typed/net/head]
 @defmodule/incl[typed/net/http-client]
+
+@deftype[HTTP-Connection]{
+  Describes an HTTP connection, corresponding to @racket[http-conn?].
+}
+
 @defmodule/incl[typed/net/imap]
+
+@deftype[IMAP-Connection]{
+  Describes an IMAP connection.
+}
+
 @defmodule/incl[typed/net/mime]
 @defmodule/incl[typed/net/nntp]
 @defmodule/incl[typed/net/pop3]
@@ -73,15 +121,61 @@ The following libraries are included with Typed Racket in the
 @defmodule/incl[typed/net/uri-codec]
 @defmodule/incl[typed/net/url-connect]
 @defmodule/incl[typed/net/url-structs]
+
+@deftype[Path/Param]{
+  Describes the @racket[path/param] struct from @racketmodname[net/url-structs].
+}
+@deftype[URL]{
+  Describes an @racket[url] struct from @racketmodname[net/url-structs].
+}
+
 @defmodule/incl[typed/net/url]
+In addition to defining the following types, this module also provides the
+@racket[HTTP-Connection] type defined by @racketmodname[typed/net/http-client],
+and the @racket[URL] and @racket[Path/Param] types from
+@racketmodname[typed/net/url-structs].
+
+@deftype[URL-Exception]{
+  Describes exceptions raised by URL-related functions; corresponds
+  to @racket[url-exception?].
+}
+@deftype[PortT]{
+  Describes the functions @racket[head-pure-port], @racket[delete-pure-port],
+  @racket[get-impure-port], @racket[head-impure-port], and
+  @racket[delete-impure-port].
+}
+@deftype[PortT/Bytes]{
+  Like @racket[PortT], but describes the functions that make POST and PUT
+  requests, which require an additional byte-string argument for POST or PUT
+  data.
+}
+
+@defmodule/incl[typed/openssl]
+
+@deftype[SSL-Protocol]{
+  Describes an SSL protocol, defined as
+  @racket[(U 'auto 'sslv2-or-v3 'sslv2 'sslv3 'tls 'tls11 'tls12)].
+}
+@deftogether[(@deftype[SSL-Server-Context]
+              @deftype[SSL-Client-Context])]{
+  Describes an OpenSSL server or client context.
+}
+@deftype[SSL-Context]{Supertype of OpenSSL server and client contexts.}
+@deftype[SSL-Listener]{
+  Describes an SSL listener, as produced by @racket[ssl-listen].
+}
+@deftype[SSL-Verify-Source]{
+  Describes a verification source usable by @racket[ssl-load-verify-source!]
+  and the @racket[ssl-default-verify-sources] parameter.
+}
+
 @defmodule/incl[typed/openssl/md5]
 @defmodule/incl[typed/openssl/sha1]
-@defmodule/incl[typed/openssl]
-@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]
@@ -90,8 +184,24 @@ The following libraries are included with Typed Racket in the
 @defmodule/incl[typed/rackunit/text-ui]
 @defmodule/incl[typed/rackunit]
 @defmodule/incl[typed/srfi/14]
+
+@deftype[Char-Set]{
+  Describes a character set usable by the @racketmodname[srfi/14] functions.
+}
+@deftype[Cursor]{
+  Describes a cursor for iterating over character sets.
+}
+
 @defmodule/incl[typed/srfi/19]
+
+@deftogether[(@defidform[#:kind "type" Time]
+              @defidform[#:kind "type" Date])]{
+  Describes an SRFI 19 time or date structure.
+}
+
 @defmodule/incl[typed/syntax/stx]
+@defmodule/incl[typed/web-server/configuration/responders]
+@defmodule/incl[typed/web-server/http]
 
 In some cases, these typed adapters may not contain all of exports of the
 original module, or their types may be more limited.
@@ -103,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)))]
 
@@ -229,12 +229,7 @@ variants.
 @defform[(for/hasheq type-ann-maybe (for-clause ...) expr ...+)]
 @defform[(for/hasheqv type-ann-maybe (for-clause ...) expr ...+)]
 @defform[(for/vector type-ann-maybe (for-clause ...) expr ...+)]
-@defform[(for/flvector type-ann-maybe (for-clause ...) expr ...+)]
-@defform[(for/extflvector type-ann-maybe (for-clause ...) expr ...+)]
-@defform[(for/and type-ann-maybe (for-clause ...) expr ...+)]
 @defform[(for/or   type-ann-maybe (for-clause ...) expr ...+)]
-@defform[(for/first type-ann-maybe (for-clause ...) expr ...+)]
-@defform[(for/last type-ann-maybe (for-clause ...) expr ...+)]
 @defform[(for/sum type-ann-maybe (for-clause ...) expr ...+)]
 @defform[(for/product type-ann-maybe (for-clause ...) expr ...+)]
 @defform[(for/set type-ann-maybe (for-clause ...) expr ...+)]
@@ -260,6 +255,16 @@ type @racket[u]. For example, a @racket[for/list] form would be
 annotated with a @racket[Listof] type. All annotations are optional.
 }
 
+@deftogether[[
+@defform[(for/flvector type-ann-maybe (for-clause ...) expr ...+)]
+@defform[(for/extflvector type-ann-maybe (for-clause ...) expr ...+)]
+@defform[(for/and type-ann-maybe (for-clause ...) expr ...+)]
+@defform[(for/first type-ann-maybe (for-clause ...) expr ...+)]
+@defform[(for/last type-ann-maybe (for-clause ...) expr ...+)]
+]]{
+Like the above, except they are not yet supported by the typechecker.
+}
+
 @deftogether[[
 @defform[(for/lists type-ann-maybe ([id : t] ...)
            (for-clause ...)
@@ -373,14 +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)]
- [options #:transparent #:mutable #:prefab])]{
- Defines a @rtech{structure} with the name @racket[name], where the
+ [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)
+          (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].
 
@@ -397,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)
@@ -461,27 +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))]
-}
-
-@section{Defining New Subtypes}
-
-@defform[(define-new-subtype name (constructor t))]{
-Defines a new type @racket[name] that is a subtype of @racket[t].
-The @racket[constructor] is defined as a function that takes a value of type
-@racket[t] and produces a value of the new type @racket[name].
-A @racket[define-new-subtype] definition is only allowed at the top level of a
-file or module.
-@ex[(module m typed/racket
-      (provide Radians radians f)
-      (define-new-subtype Radians (radians Real))
-      (: f : [Radians -> Real])
-      (define (f a)
-        (sin a)))
-    (require 'm)
-    (radians 0)
-    (f (radians 0))]
+@ex[(eval:error (define-type Foo Foo))
+    (eval:error (define-type Bar (U Bar False)))]
 }
 
 @section{Generating Predicates Automatically}
@@ -538,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)]]{
@@ -572,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] ...)]]
@@ -585,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
@@ -658,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.
@@ -703,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

@@ -0,0 +1,75 @@
+#lang scribble/manual
+
+@(require scribble/example
+          (for-label (only-meta-in 0 [except-in typed/racket for])))
+
+@(define eval (make-base-eval))
+@(eval '(require typed/racket/base))
+
+@title{Unsafe Typed Racket operations}
+
+@defmodule[typed/racket/unsafe]
+
+@bold{Warning}: the operations documented in this section are @emph{unsafe},
+meaning that they can circumvent the invariants of the type system. Unless the
+@racket[#:no-optimize] language option is used, this may result in unpredictable
+behavior and may even crash Typed Racket.
+
+@defform[(unsafe-require/typed m rt-clause ...)]{
+  This form requires identifiers from the module @racket[m] with the same
+  import specifications as @racket[require/typed].
+
+  Unlike @racket[require/typed], this form is unsafe and will not generate
+  contracts that correspond to the specified types to check that the values
+  actually match their types.
+
+  @examples[#:eval eval
+    (require typed/racket/unsafe)
+    (code:comment "import with a bad type")
+    (unsafe-require/typed racket/base [values (-> String Integer)])
+    (code:comment "unchecked call, the result type is wrong")
+    (values "foo")
+  ]
+
+  @history[#:added "1.3"]
+}
+
+@defform[(unsafe-provide provide-spec ...)]{
+  This form declares exports from a module with the same syntax as
+  the @racket[provide] form.
+
+  Unlike @racket[provide], this form is unsafe and Typed Racket will not generate
+  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)
+      (: f (-> Integer Integer))
+      (define (f x) (add1 x))
+      (code:comment "unsafe export, does not install checks")
+      (unsafe-provide f))
+
+    (module u racket/base
+      (require 't)
+      (code:comment "bad call that's unchecked")
+      (f "foo"))
+
+    (eval:error (require 'u))
+  ]
+
+  @history[#:added "1.3"]
+}
+
+@close-eval[eval]

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-doc/typed-racket/scribblings/ts-reference.scrbl

@@ -35,6 +35,7 @@ For a friendly introduction, see the companion manual
 @include-section["reference/no-check.scrbl"]
 @include-section["reference/typed-regions.scrbl"]
 @include-section["reference/optimization.scrbl"]
+@include-section["reference/unsafe.scrbl"]
 @include-section["reference/legacy.scrbl"]
 @include-section["reference/compatibility-languages.scrbl"]
 @include-section["reference/experimental.scrbl"]

typed-racket-lib/info.rkt

@@ -2,7 +2,7 @@
 
 (define collection 'multi)
 
-(define deps '(("base" #:version "6.2.900.16")
+(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.1")
+(define version "1.5")

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

@@ -1,5 +1,24 @@
-(add1 6.2)
+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
+- Sealing contracts for row polymorphic types
+- `define-new-subtype`
+- More robust compound pair operations optimizations
+- Redesign of top-level support, using trampolining macros
+- Static contract caching more conservative, causes contract generation slowdowns
+- Experimental unit support
+- `typed/racket/unsafe`, with `unsafe-require/typed` and `unsafe-provide`
 6.2
 - Use submodules to avoid allocating contract wrappers when not needed.
 - Class types and contract generation are significantly improved, but still experimental.

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

@@ -17,7 +17,7 @@
   racket/logging
   racket/private/stx
   (only-in mzscheme make-namespace)
-  (only-in racket/match/runtime match:error matchable? match-equality-test))
+  (only-in racket/match/runtime match:error matchable? match-equality-test syntax-srclocs))
  "base-structs.rkt"
  racket/file
  (only-in racket/private/pre-base new-apply-proc)
@@ -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
@@ -632,15 +637,18 @@
 [memq (-poly (a) (-> Univ (-lst a) (-opt (-ne-lst a))))]
 [memv (-poly (a) (-> Univ (-lst a) (-opt (-ne-lst a))))]
 [memf (-poly (a) ((a . -> . Univ) (-lst a) . -> . (-opt (-ne-lst a))))]
-[member (-poly (a)
+[member (-poly (a b)
           (cl->* (Univ (-lst a) . -> . (-opt (-ne-lst a)))
-                 (Univ (-lst a) (-> a a Univ)
+                 (b (-lst a) (-> b a Univ)
                        . -> . (-opt (-ne-lst a)))))]
 [findf (-poly (a) ((a . -> . B) (-lst a) . -> . (-opt a)))]
 
 [assq  (-poly (a b) (Univ (-lst (-pair a b)) . -> . (-opt (-pair a b))))]
 [assv  (-poly (a b) (Univ (-lst (-pair a b)) . -> . (-opt (-pair a b))))]
-[assoc (-poly (a b) (Univ (-lst (-pair a b)) . -> . (-opt (-pair a b))))]
+[assoc (-poly (a b c)
+              (cl->* (Univ (-lst (-pair a b)) . -> . (-opt (-pair a b)))
+                     (c (-lst (-pair a b)) (-> c a Univ)
+                        . -> . (-opt (-pair a b)))))]
 [assf  (-poly (a b) ((a . -> . Univ) (-lst (-pair a b))
                      . -> . (-opt (-pair a b))))]
 
@@ -669,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))
@@ -709,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))]
@@ -727,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)))]
@@ -735,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)))]
@@ -750,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))))))]
 
@@ -768,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))]
@@ -837,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))
@@ -871,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)))]
@@ -879,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)
@@ -952,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)]
@@ -1011,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))
@@ -1041,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))]
@@ -1080,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)))]
@@ -1170,6 +1200,7 @@
 ;[match:error (Univ . -> . (Un))]
 [match-equality-test (-Param (Univ Univ . -> . Univ) (Univ Univ . -> . Univ))]
 [matchable? (make-pred-ty (Un -String -Bytes))]
+[syntax-srclocs (Univ . -> . Univ)]
 
 ;; Section 10.1
 [values (-polydots (a b) (cl->*
@@ -1272,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))]
 
@@ -1393,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)]
 
@@ -1404,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)]
@@ -1414,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))
@@ -1510,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))]
 
@@ -1756,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
@@ -1815,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
@@ -1829,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
@@ -1931,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)]
@@ -1940,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)]
@@ -2280,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)
@@ -2464,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)]
@@ -2530,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)
@@ -2604,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
@@ -2649,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)]
@@ -2918,6 +2970,7 @@
 ;; Section 15.8
 [system-type
  (cl->*
+  (-> (Un (-val 'unix) (-val 'windows) (-val 'macosx)))
   (-> (-val 'os) (Un (-val 'unix) (-val 'windows) (-val 'macosx)))
   (-> (-val 'gc) (Un (-val 'cgc) (-val '3m)))
   (-> (-val 'link) (Un (-val 'static) (-val 'shared) (-val 'dll) (-val 'framework)))
@@ -2967,7 +3020,9 @@
 [will-try-execute (-> -Will-Executor ManyUniv)]
 
 ;; Section 16.4
-[collect-garbage (-> -Void)]
+[collect-garbage (cl->*
+                  (-> -Void)
+                  (-> (Un (-val 'minor) (-val 'major) (-val 'incremental)) -Void))]
 [current-memory-use (-> -Nat)]
 [dump-memory-stats (-> Univ)]
 
@@ -3008,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

@@ -46,6 +46,10 @@
          (cl->*
           (-> (-lst a) -Null (-lst a))
           (-> (-lst a) (-lst b) (-lst (Un a b)))))]
+  ;; normalise-inputs
+  [(make-template-identifier 'normalise-inputs 'racket/private/for)
+   (-poly (a)
+          (-> -Symbol -String (-> a -Boolean) (-> a -Nat) a -Nat (Un (-val #f) -Nat) -Nat (-values (list a -Index -Index -Index))))]
   ;; make-sequence
   [(make-template-identifier 'make-sequence 'racket/private/for)
    (-poly (a b)
@@ -112,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,25 @@
         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
+  ;; turned into a macro on the requiring side
+  (provide -unsafe-require/typed))
+
+;; used for private unsafe functionality in require macros
+;; *do not export*
+(define-syntax unsafe-kw (syntax-rules ()))
 
 (require (for-template (submod "." forms) "../utils/require-contract.rkt"
                        (submod "../typecheck/internal-forms.rkt" forms)
@@ -63,8 +81,10 @@
          racket/struct-info
          syntax/struct
          syntax/location
+         (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"
@@ -74,11 +94,9 @@
 
 ;; Lazily loaded b/c they're only used sometimes, so we save a lot
 ;; of loading by not having them when they are unneeded
-(lazy-require ["../rep/type-rep.rkt" (make-Opaque Error?)]
+(lazy-require ["../rep/type-rep.rkt" (Error?)]
               ["../types/utils.rkt" (fv)]
-              [syntax/define (normalize-definition)]
-              [typed-racket/private/parse-type (parse-type)]
-              [typed-racket/env/type-alias-env (register-resolved-type-alias)])
+              [typed-racket/private/parse-type (parse-type)])
 
 (define (with-type* expr ty)
   (with-type #`(ann #,expr #,ty)))
@@ -92,11 +110,12 @@
   (pattern (nm:id parent:id)))
 
 
-(define-values (require/typed-legacy require/typed)
+(define-values (require/typed-legacy require/typed -unsafe-require/typed)
  (let ()
   (define-syntax-class opt-rename
-    #:attributes (nm spec)
+    #:attributes (nm orig-nm spec)
     (pattern nm:id
+             #:with orig-nm #'nm
              #:with spec #'nm)
     (pattern (orig-nm:id internal-nm:id)
              #:with spec #'(orig-nm internal-nm)
@@ -106,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 (:)
@@ -137,44 +157,63 @@
     (pattern [(~or (~datum opaque) #:opaque) opaque ty:id pred:id #:name-exists]
              #:with opt #'(#:name-exists)))
 
-  (define-syntax-class (clause legacy lib)
+  (define-syntax-class (clause legacy unsafe? lib)
    #:attributes (spec)
    (pattern oc:opaque-clause #:attr spec
      #`(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 ... #,lib))
+     #`(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
      #`(require-typed-signature sig.sig-name (sig.var ...) (sig.type ...) #,lib))
    (pattern sc:simple-clause #:attr spec
-     #`(require/typed #:internal sc.nm sc.ty #,lib)))
+     #`(require/typed #:internal sc.nm sc.ty #,lib
+                      #,@(if unsafe? #'(unsafe-kw) #'()))))
 
 
-  (define ((r/t-maker legacy) stx)
+  (define ((r/t-maker legacy unsafe?) stx)
     (unless (or (unbox typed-context?) (eq? (syntax-local-context) 'module-begin))
       (raise-syntax-error #f "only allowed in a typed module" stx))
     (syntax-parse stx
-      [(_ lib:expr (~var c (clause legacy #'lib)) ...)
+      [(_ lib:expr (~var c (clause legacy unsafe? #'lib)) ...)
        (when (zero? (syntax-length #'(c ...)))
          (raise-syntax-error #f "at least one specification is required" stx))
        #`(begin c.spec ...)]
-      [(_ #:internal nm:opt-rename ty lib (~optional [~seq #:struct-maker parent]) ...)
+      [(_ #:internal nm:opt-rename ty lib
+          (~optional [~seq #:struct-maker parent])
+          (~optional (~and (~seq (~literal unsafe-kw))
+                           (~bind [unsafe? #t]))
+                     #:defaults ([unsafe? #f])))
        (define/with-syntax hidden (generate-temporary #'nm.nm))
        (define/with-syntax sm (if (attribute parent)
                                   #'(#:struct-maker parent)
                                   #'()))
-       ;; define `cnt*` to be fixed up later by the module type-checking
-       (define cnt*
-         (syntax-local-lift-expression
-          (make-contract-def-rhs #'ty #f (attribute parent))))
-       (quasisyntax/loc stx
-         (begin
-           ;; register the identifier so that it has a binding (for top-level)
-           #,@(if (eq? (syntax-local-context) 'top-level)
-                  (list #'(define-syntaxes (hidden) (values)))
-                  null)
-           #,(internal #'(require/typed-internal hidden ty . sm))
-           #,(ignore #`(require/contract nm.spec hidden #,cnt* lib))))]))
-  (values (r/t-maker #t) (r/t-maker #f))))
+       (cond [(not (attribute unsafe?))
+              ;; define `cnt*` to be fixed up later by the module type-checking
+              (define cnt*
+                (syntax-local-lift-expression
+                 (make-contract-def-rhs #'ty #f (attribute parent))))
+              (quasisyntax/loc stx
+                (begin
+                  ;; register the identifier so that it has a binding (for top-level)
+                  #,@(if (eq? (syntax-local-context) 'top-level)
+                         (list #'(define-syntaxes (hidden) (values)))
+                         null)
+                  #,(internal #'(require/typed-internal hidden ty . sm))
+                  #,(ignore #`(require/contract nm.spec hidden #,cnt* lib))))]
+             [else
+              (define/with-syntax hidden2 (generate-temporary #'nm.nm))
+              (quasisyntax/loc stx
+                (begin
+                  (require (only-in lib [nm.orig-nm hidden]))
+                  ;; need this indirection since `hidden` may expand
+                  ;; to a different identifier that TR doesn't know about
+                  #,(ignore #'(define hidden2 hidden))
+                  (rename-without-provide nm.nm hidden2)
+                  #,(internal #'(require/typed-internal hidden2 ty . sm))))])]))
+  (values (r/t-maker #t #f) (r/t-maker #f #f) (r/t-maker #f #t))))
 
 
 (define (require/typed/provide stx)
@@ -221,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
@@ -255,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))
@@ -278,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))
@@ -289,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))])]))
 
 
 
@@ -297,21 +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) ...)
-     ;; This line appears redundant with the use of `define-type-alias` below, but
-     ;; it's actually necessary for top-level uses because this opaque type may appear
-     ;; in subsequent `require/typed` clauses, which needs to parse the types at
-     ;; expansion-time, not at typechecking time when aliases are installed.
-     (register-resolved-type-alias #'ty (make-Opaque #'pred))
      (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
-           #,(ignore #'(define pred-cnt (any/c . c-> . boolean?)))
+           ;; register the identifier for the top-level (see require/typed)
+           #,@(if (eq? (syntax-local-context) 'top-level)
+                  (list #'(define-syntaxes (hidden) (values)))
+                  null)
            #,(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)))))]))
 
 
 
@@ -356,10 +428,18 @@
    (pattern (~seq #:constructor-name name:id) #:attr extra #f)
    (pattern (~seq #:extra-constructor-name name:id) #:attr extra #t))
 
+  (define-splicing-syntax-class unsafe-clause
+   (pattern (~seq) #:attr unsafe? #f)
+   (pattern (~seq (~literal unsafe-kw)) #:attr unsafe? #t))
 
   (define ((rts legacy) stx)
     (syntax-parse stx #:literals (:)
-      [(_ name:opt-parent ([fld : ty] ...) (~var input-maker (constructor-term legacy #'name.nm)) lib)
+      [(_ 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]
                       [parent #'name.parent]
                       [hidden (generate-temporary #'name.nm)]
@@ -435,21 +515,38 @@
                                   (make-struct-info-self-ctor #'internal-maker si)
                                   si))
 
-                         (dtsi* () spec ([fld : ty] ...) #:maker maker-name #:type-only)
-                         #,(ignore #'(require/contract pred hidden (any/c . c-> . boolean?) lib))
-                         #,(internal #'(require/typed-internal hidden (Any -> Boolean : nm)))
-                         (require/typed #:internal (maker-name real-maker) nm lib
-                                        #:struct-maker parent)
+                         (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 : 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
-                                                #:struct-maker parent)
+                               #`(require/typed #:internal (maker-name extra-maker) type lib
+                                                #:struct-maker parent
+                                                #,@(if (attribute unsafe.unsafe?) #'(unsafe-kw) #'()))
                                #'(begin))
 
-                         (require/typed lib
-                           [sel (nm -> ty)]) ...)))]))
+                         #,(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 (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,16 +72,31 @@
 
   (define-splicing-syntax-class struct-options
     #:description "typed structure type options"
-    #:attributes (guard mutable? transparent? prefab? [prop 1] [prop-val 1])
+    #: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?)))
                         (~optional (~seq (~and #:prefab prefab?)))
+                        (~optional (~or (~and (~seq #:constructor-name cname)
+                                              (~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)"
@@ -94,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 ()
@@ -121,39 +150,63 @@
 
 
 ;; User-facing macros for defining typed structure types
-(define-syntaxes (define-typed-struct -struct)
-  (values
-   (lambda (stx)
-     (syntax-parse stx
-       [(_ vars:maybe-type-vars nm:struct-name (fs:fld-spec ...)
-           opts:struct-options)
-        (let ([mutable? (if (attribute opts.mutable?) #'(#:mutable) #'())]
-              [cname (second (build-struct-names #'nm.name null #t #t))]
-              [prefab? (if (attribute opts.prefab?) #'(#:prefab) #'())])
-          (with-syntax ([d-s (ignore-some
-                               (syntax/loc stx (define-struct nm (fs.fld ...) . opts)))]
-                        [dtsi (quasisyntax/loc stx
-                                (dtsi* (vars.vars ...) nm (fs.form ...)
-                                       #:maker #,cname
-                                       #,@mutable?
-                                       #,@prefab?))])
-            #'(begin d-s dtsi)))]))
-   (lambda (stx)
-     (syntax-parse stx
-       [(_ vars:maybe-type-vars nm:struct-name/new (fs:fld-spec ...)
-           opts:struct-options)
-        (let ([mutable? (if (attribute opts.mutable?) #'(#:mutable) #'())]
-              [prefab? (if (attribute opts.prefab?) #'(#:prefab) #'())])
-          (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?))])
-            #'(begin d-s dtsi)))]))))
+(define-syntax (define-typed-struct stx)
+  (syntax-parse stx
+    [(_ vars:maybe-type-vars nm:struct-name (fs:fld-spec ...) opts:struct-options)
+     (quasisyntax/loc stx
+       (-struct #,@#'vars
+                #,@(if (stx-pair? #'nm)
+                       #'nm
+                       (list #'nm))
+                (fs ...)
+                ;; If there's already a (extra) constructor name supplied,
+                ;; then Racket's `define-struct` doesn't define a `make-`
+                ;; constructor either so don't pass anything extra.
+                #,@(if (or (attribute opts.cname)
+                           (attribute opts.ecname))
+                       null
+                       (list #'#:extra-constructor-name
+                             (second (build-struct-names #'nm.name null #t #t))))
+                . opts))]))
 
+(define-syntax (-struct stx)
+  (syntax-parse stx
+    [(_ vars:maybe-type-vars nm:struct-name/new (fs:fld-spec ...)
+        opts:struct-options)
+     (let ([mutable? (if (attribute opts.mutable?) #'(#:mutable) #'())]
+           [prefab? (if (attribute opts.prefab?) #'(#:prefab) #'())]
+           [maker (if (attribute opts.cname)
+                      #`(#:maker #,(attribute opts.cname))
+                      #'())]
+           [extra-maker (if (attribute opts.ecname)
+                            #`(#:extra-maker #,(attribute opts.ecname))
+                            #'())])
+       (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)
@@ -182,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 ...)))
@@ -157,11 +160,7 @@ the typed racket language.
 ;; Lazily loaded b/c they're only used sometimes, so we save a lot
 ;; of loading by not having them when they are unneeded
 (begin-for-syntax 
-  (lazy-require ["../rep/type-rep.rkt" (make-Opaque Error?)]
-                ["../types/utils.rkt" (fv)]
-                [syntax/define (normalize-definition)]
-                [typed-racket/private/parse-type (parse-type)]
-                [typed-racket/env/type-alias-env (register-resolved-type-alias)]))
+  (lazy-require [syntax/define (normalize-definition)]))
 
 (define-for-syntax (with-type* expr ty)
   (with-type #`(ann #,expr #,ty)))
@@ -812,7 +811,13 @@ the typed racket language.
                    (define i 0)
                    (for (clauses ...)
                      (define v body-expr)
-                     (cond [(unsafe-fx= i 0)  (define new-vs (ann (make-vector n v) T))
+                     ;; can't use `unsafe-fx=` here
+                     ;; if `n` is larger than a fixnum, this is unsafe, and we
+                     ;; don't know whether that's the case until we try creating
+                     ;; the vector
+                     ;; other unsafe ops are after vector allocation, and so are
+                     ;; fine
+                     (cond [(= i 0)  (define new-vs (ann (make-vector n v) T))
                                               (set! vs new-vs)]
                            [else  (unsafe-vector-set! vs i v)])
                      (set! i (unsafe-fx+ i 1))

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/env-utils.rkt

@@ -0,0 +1,14 @@
+#lang racket/base
+
+(require racket/dict racket/sequence)
+(provide id< sorted-dict-map in-sorted-dict)
+
+(define (id< a b) (symbol<? (syntax-e a) (syntax-e b)))
+
+(define (sorted-dict-map dict f <)
+  (define sorted (sort #:key car (dict-map dict cons) <))
+  (map (lambda (a) (f (car a) (cdr a))) sorted))
+
+(define (in-sorted-dict dict <)
+  (define sorted (sort #:key car (dict-map dict cons) <))
+  (in-dict sorted))

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

@@ -5,6 +5,7 @@
 
 (require "../types/tc-error.rkt"
          "../utils/tc-utils.rkt"
+         "env-utils.rkt"
          syntax/parse
          syntax/id-table
          racket/lazy-require) 
@@ -102,4 +103,4 @@
 ;; map over the-mapping, producing a list
 ;; (id type -> T) -> listof[T]
 (define (type-env-map f)
-  (free-id-table-map the-mapping f))
+  (sorted-dict-map the-mapping f id<))

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?)]
@@ -127,15 +133,16 @@
               (define ty (force (cdr id/ty)))
               `(cons (quote-syntax ,id) ,(sub ty)))
             m))
+     (define serialized-extends (and extends `(quote-syntax ,extends)))
      `(make-Signature (quote-syntax ,name)
-                      (quote-syntax ,extends)
+                      ,serialized-extends
                       (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)
 
@@ -13,6 +14,7 @@
          racket/match
          racket/promise
          (for-syntax syntax/parse racket/base)
+         "env-utils.rkt"
          "../utils/utils.rkt"
          (utils tc-utils)
          (rep type-rep))
@@ -65,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)
-  (free-id-table-map (signature-env) f))
+  (sorted-dict-map (signature-env) f id<))

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

@@ -1,6 +1,7 @@
 #lang racket/base
 
 (require "../utils/utils.rkt"
+         "env-utils.rkt"
          syntax/id-table racket/dict
          (utils tc-utils)
          (typecheck renamer)
@@ -61,6 +62,6 @@
 ;; map over the-mapping, producing a list
 ;; (id type -> T) -> listof[T]
 (define (type-alias-env-map f)  
-  (for/list ([(id t) (in-dict the-mapping)]
+  (for/list ([(id t) (in-sorted-dict the-mapping id<)]
              #:when (resolved? t))
     (f id (resolved-ty t))))

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/env/type-name-env.rkt

@@ -2,7 +2,8 @@
 
 ;; Environment for type names
 
-(require "../utils/utils.rkt")
+(require "../utils/utils.rkt"
+         "env-utils.rkt")
 
 (require syntax/id-table
          (contract-req)
@@ -58,7 +59,7 @@
 ;; map over the-mapping, producing a list
 ;; (id type -> T) -> listof[T]
 (define (type-name-env-map f)
-  (free-id-table-map the-mapping f))
+  (sorted-dict-map the-mapping f id<))
 
 (define (add-alias from to)
   (when (lookup-type-name to (lambda () #f))
@@ -83,7 +84,7 @@
 ;; map over the-mapping, producing a list
 ;; (id variance -> T) -> listof[T]
 (define (type-variance-env-map f)
-  (free-id-table-map variance-mapping f))
+  (sorted-dict-map variance-mapping f id<))
 
 ;; Refines the variance of a type in the name environment
 (define (refine-variance! names types tvarss)

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
@@ -212,7 +212,7 @@
       [(_ seq) #'(app List->seq (? values seq))])))
 
 
-;; generate-dbound-prefix: Symbol Type/c Natural Symbol -> (Values (Listof Symbol) (Listof Type/c))
+;; generate-dbound-prefix: Symbol Type/c Natural (U Symbol #f) -> (Values (Listof Symbol) (Listof Type/c))
 ;; Substitutes n fresh new variables, replaces dotted occurences of v in t with the variables (and
 ;; maybe new-end), and then for each variable substitutes it in for regular occurences of v.
 (define (generate-dbound-prefix v ty n new-end)
@@ -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)))
@@ -868,21 +881,22 @@
   (early-return
    (define short-S (take S (length T)))
    (define rest-S (drop S (length T)))
-   (define ctx (context null X (list dotted-var)))
-   (define expected-cset (if expected
-                             (cgen ctx R expected)
-                             (empty-cset '() '())))
-   #:return-unless expected-cset #f
-   (define cs-short (cgen/list ctx short-S T #:expected-cset expected-cset))
-   #:return-unless cs-short #f
+   ;; Generate a new type corresponding to T-dotted for every extra arg.
    (define-values (new-vars new-Ts)
      (generate-dbound-prefix dotted-var T-dotted (length rest-S) #f))
-   (define cs-dotted (cgen/list (context-add-vars ctx new-vars) rest-S new-Ts
-                                #:expected-cset expected-cset))
-   #:return-unless cs-dotted #f
-   (define cs-dotted* (move-vars-to-dmap cs-dotted dotted-var new-vars))
-   #:return-unless cs-dotted* #f
-   (define cs (cset-meet cs-short cs-dotted*))
+   (define (subst t)
+     (substitute-dots (map make-F new-vars) #f dotted-var t))
+   (define ctx (context null (append new-vars X) (list dotted-var)))
+
+   (define expected-cset (if expected
+                             (cgen ctx (subst R) expected)
+                             (empty-cset '() '())))
+   #:return-unless expected-cset #f
+   (define cs (% move-vars-to-dmap
+                 (% cset-meet
+                    (cgen/list ctx short-S (map subst T) #:expected-cset expected-cset)
+                    (cgen/list ctx rest-S new-Ts #:expected-cset expected-cset))
+                 dotted-var new-vars))
    #:return-unless cs #f
    (define m (cset-meet cs expected-cset))
    #:return-unless m #f

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/float-complex.rkt

@@ -1,11 +1,12 @@
 #lang racket/base
 
-(require syntax/parse syntax/stx racket/promise
+(require syntax/parse syntax/stx syntax/id-table racket/promise
          racket/syntax racket/match syntax/parse/experimental/specialize
          "../utils/utils.rkt" racket/unsafe/ops racket/sequence
          (for-template racket/base racket/math racket/flonum racket/unsafe/ops)
          (types numeric-tower subtype type-table utils)
-         (optimizer utils numeric-utils logging float unboxed-tables))
+         (optimizer utils numeric-utils logging float unboxed-tables)
+         (utils tc-utils))
 
 (provide float-complex-opt-expr
          float-complex-expr
@@ -50,14 +51,56 @@
       "The optimizer could optimize it better if it had type Float-Complex.")
     this-syntax))
 
-;; If a part is 0.0?
-(define (0.0? stx)
-  (equal? (syntax->datum stx) 0.0))
+;; keep track of operands that were reals (and thus had exact 0 as imaginary part)
+(define real-id-table (make-free-id-table))
+(define (was-real? stx)
+  (free-id-table-ref real-id-table stx #f))
+(define (mark-as-real stx)
+  (free-id-table-set! real-id-table stx #t)
+  stx)
+;; keep track of operands that were not floats (i.e. rationals and single floats)
+;; to avoid prematurely converting to floats, which may change results
+(define non-float-table (make-hash))
+(define (as-non-float stx)
+  (hash-ref non-float-table stx #f))
+(define (mark-as-non-float stx [orig stx])
+  (hash-set! non-float-table stx orig)
+  stx)
 
+(define (n-ary->binary/non-floats op unsafe this-syntax cs)
+  (let loop ([o (stx-car cs)] [cs (stx-cdr cs)])
+    ;; we're guaranteed to hit non-"non-float" operands before
+    ;; we hit the end of the list. otherwise we wouldn't be doing
+    ;; float-complex optimizations
+    (define c1 (stx-car cs))
+    (define o-nf (as-non-float o))
+    (define c1-nf (as-non-float c1))
+    (if (or o-nf c1-nf)
+        ;; can't convert those to floats just yet, or may change
+        ;; the result
+        (let ([new-o (mark-as-non-float
+                      (quasisyntax/loc this-syntax
+                        (#,op #,(or o-nf o) #,(or c1-nf c1))))])
+          (if (stx-null? (stx-cdr cs))
+              new-o
+              (loop new-o
+                    (stx-cdr cs))))
+        ;; we've hit floats, can start coercing
+        (n-ary->binary this-syntax unsafe (cons #`(real->double-flonum #,(or o-nf o)) cs)))))
 
 ;; a+bi / c+di, names for real and imag parts of result -> one let-values binding clause
 (define (unbox-one-complex-/ a b c d res-real res-imag)
-  (define both-real? (and (0.0? b) (0.0? d)))
+  (define first-arg-real? (was-real? b))
+  (define second-arg-real? (was-real? d))
+  ;; if both are real, we can short-circuit a lot
+  (define both-real? (and first-arg-real? second-arg-real?))
+  (define first-non-float (as-non-float a))
+  (define second-non-float (as-non-float c))
+
+  (when (and first-non-float (not second-non-float))
+    ;; we're going from non-float to float operands, so need to coerce the first
+    (set! a #`(real->double-flonum #,a)))
+
   ;; we have the same cases as the Racket `/' primitive (except for the non-float ones)
   (define d=0-case
     #`(values (unsafe-fl+ (unsafe-fl/ #,a #,c)
@@ -85,10 +128,42 @@
                         (unsafe-fl/ (unsafe-fl- (unsafe-fl* b r) a) den))])
         (values (unsafe-fl/ (unsafe-fl+ b (unsafe-fl* a r)) den)
                 i)))
-  (cond [both-real?
-         #`[(#,res-real #,res-imag)
+
+  (cond [(and first-non-float second-non-float both-real?)
+         ;; we haven't hit float operands, so we shouldn't coerce to float yet
+         #`[(#,(mark-as-non-float res-real)
+             #,(mark-as-real res-imag)) ; this case implies real
+            (values (/ #,first-non-float #,second-non-float)
+                    0.0)]]
+        [second-non-float
+         ;; may be dividing by exact 0, be conservative to preserve error
+         ;; (res-real can't be non-float, since we've hit a float, so we either
+         ;; error or coerce)
+         #`[(#,res-real #,(if both-real?
+                              (mark-as-real res-imag)
+                              res-imag))
+            (let-values ([(res-div)
+                          (/ #,(if first-arg-real?
+                                   a
+                                   #`(make-rectangular #,a #,b))
+                             #,(if second-arg-real?
+                                   second-non-float
+                                   #`(make-rectangular #,second-non-float
+                                                       #,d)))])
+              #,(if both-real?
+                    #'(values res-div 0.0)
+                    #'(values (real-part res-div)
+                              (imag-part res-div))))]]
+        [both-real?
+         #`[(#,res-real #,(mark-as-real res-imag))
             (values (unsafe-fl/ #,a #,c)
                     0.0)]] ; currently not propagated
+        [second-arg-real?
+         #`[(#,res-real #,res-imag)
+            (values (unsafe-fl/ #,a #,c)
+                    (unsafe-fl/ #,b #,c))]]
+        [first-arg-real?
+         (unbox-one-float-complex-/ a c d res-real res-imag)]
         [else
          #`[(#,res-real #,res-imag)
             (cond [(unsafe-fl= #,d 0.0) #,d=0-case]
@@ -112,7 +187,7 @@
     #`(let* ([cm    (unsafe-flabs #,c)]
              [dm    (unsafe-flabs #,d)]
              [swap? (unsafe-fl< cm dm)]
-             [a     #,a]
+             [a     #,a] ; don't swap with `b` (`0`) here, but handle below
              [c     (if swap? #,d #,c)]
              [d     (if swap? #,c #,d)]
              [r     (unsafe-fl/ c d)]
@@ -145,15 +220,25 @@
     #:with (bindings ...)
       #`(cs.bindings ... ...
          #,@(let ()
-               (define (fl-sum cs) (n-ary->binary this-syntax #'unsafe-fl+ cs))
+              (define (fl-sum cs)
+                (n-ary->binary/non-floats #'+ #'unsafe-fl+ this-syntax cs))
+              (define non-0-imags
+                ;; to preserve result sign, ignore exact 0s
+                ;; o/w, can have (+ -0.0 (->fl 0)) => 0.0, but would be -0.0
+                ;; without the coercion
+                (for/list ([i (syntax->list #'(cs.imag-binding ...))]
+                           #:unless (was-real? i))
+                  i))
                (list
                 #`((real-binding) #,(fl-sum #'(cs.real-binding ...)))
-                #`((imag-binding) #,(fl-sum #'(cs.imag-binding ...)))))))
+                #`((imag-binding)
+                   #,(if (null? (cdr non-0-imags)) ; only one actual imag part
+                         (car non-0-imags)
+                         (fl-sum non-0-imags)))))))
   (pattern (#%plain-app op:+^ :unboxed-float-complex-opt-expr)
     #:when (subtypeof? this-syntax -FloatComplex)
     #:do [(log-unboxing-opt "unboxed unary float complex")])
 
-
   (pattern (#%plain-app op:-^ (~between cs:unboxed-float-complex-opt-expr 2 +inf.0) ...)
     #:when (subtypeof? this-syntax -FloatComplex)
     #:with (real-binding imag-binding) (binding-names)
@@ -161,10 +246,21 @@
     #:with (bindings ...)
       #`(cs.bindings ... ...
          #,@(let ()
-              (define (fl-subtract cs) (n-ary->binary this-syntax #'unsafe-fl- cs))
+              (define (fl-subtract cs)
+                (n-ary->binary/non-floats #'- #'unsafe-fl- this-syntax cs))
               (list
                #`((real-binding) #,(fl-subtract #'(cs.real-binding ...)))
-               #`((imag-binding) #,(fl-subtract #'(cs.imag-binding ...)))))))
+               #`((imag-binding)
+                  ;; can't ignore exact 0 imag parts from real numbers, as with
+                  ;; addition, because the first value is special
+                  ;; so just conservatively use generic subtraction
+                  #,(if (ormap was-real? (syntax->list #'(cs.imag-binding ...)))
+                        (n-ary->binary
+                         this-syntax
+                         #'-
+                         (for/list ([i (syntax->list #'(cs.imag-binding ...))])
+                           (if (was-real? i) #'0 i)))
+                        (fl-subtract #'(cs.imag-binding ...))))))))
   (pattern (#%plain-app op:-^ c1:unboxed-float-complex-opt-expr) ; unary -
     #:when (subtypeof? this-syntax -FloatComplex)
     #:with (real-binding imag-binding) (binding-names)
@@ -198,27 +294,45 @@
                                               #'(cs.imag-binding ...))
                                      (list #'imag-binding))]
                          [res '()])
-                (if (null? e1)
-                    (reverse res)
-                    (loop (car rs) (car is) (cdr e1) (cdr e2) (cdr rs) (cdr is)
-                          ;; complex multiplication, imag part, then real part (reverse)
-                          ;; we eliminate operations on the imaginary parts of reals
-                          (let ((o-real? (0.0? o2))
-                                (e-real? (0.0? (car e2))))
-                            (list* #`((#,(car is))
-                                      #,(cond ((and o-real? e-real?) #'0.0)
-                                              (o-real? #`(unsafe-fl* #,o1 #,(car e2)))
-                                              (e-real? #`(unsafe-fl* #,o2 #,(car e1)))
-                                              (else
-                                               #`(unsafe-fl+ (unsafe-fl* #,o2 #,(car e1))
-                                                             (unsafe-fl* #,o1 #,(car e2))))))
-                                   #`((#,(car rs))
-                                      #,(cond ((or o-real? e-real?)
-                                               #`(unsafe-fl* #,o1 #,(car e1)))
-                                              (else
-                                               #`(unsafe-fl- (unsafe-fl* #,o1 #,(car e1))
-                                                             (unsafe-fl* #,o2 #,(car e2))))))
-                                 res))))))))
+                (cond
+                 [(null? e1)
+                  (reverse res)]
+                 [else
+                  (define o-real? (was-real? o2))
+                  (define e-real? (was-real? (car e2)))
+                  (define both-real? (and o-real? e-real?))
+                  (define o-nf (as-non-float o1))
+                  (define e-nf (as-non-float (car e1)))
+                  (define new-imag-id (if both-real?
+                                          (mark-as-real (car is))
+                                          (car is)))
+                  (loop (car rs) new-imag-id (cdr e1) (cdr e2) (cdr rs) (cdr is)
+                        ;; complex multiplication, imag part, then real part (reverse)
+                        ;; we eliminate operations on the imaginary parts of reals
+                        (list* #`((#,new-imag-id)
+                                  #,(cond ((and o-real? e-real?) #'0.0)
+                                          (o-real? #`(unsafe-fl* #,o1 #,(car e2)))
+                                          (e-real? #`(unsafe-fl* #,o2 #,(car e1)))
+                                          (else
+                                           #`(unsafe-fl+ (unsafe-fl* #,o2 #,(car e1))
+                                                         (unsafe-fl* #,o1 #,(car e2))))))
+                               #`((#,(car rs))
+                                  #,(cond [(and o-nf e-nf both-real?)
+                                           ;; we haven't seen float operands yet, so
+                                           ;; shouldn't prematurely convert to floats
+                                           (mark-as-non-float (car rs))
+                                           #`(* #,o-nf #,e-nf)]
+                                          [(or o-real? e-real?)
+                                           #`(unsafe-fl*
+                                              #,(if (as-non-float o1)
+                                                    ;; we hit floats, need to coerce
+                                                    #`(real->double-flonum #,o1)
+                                                    o1)
+                                              #,(car e1))]
+                                          [else
+                                           #`(unsafe-fl- (unsafe-fl* #,o1 #,(car e1))
+                                                         (unsafe-fl* #,o2 #,(car e2)))]))
+                               res))])))))
   (pattern (#%plain-app op:*^ :unboxed-float-complex-opt-expr)
     #:when (subtypeof? this-syntax -FloatComplex)
     #:do [(log-unboxing-opt "unboxed unary float complex")])
@@ -332,10 +446,21 @@
          ((real-binding) (unsafe-flreal-part e*))
          ((imag-binding) (unsafe-flimag-part e*))))
 
-  ;; The following optimization is incorrect and causes bugs because it turns exact numbers into inexact
   (pattern e:number-expr
     #:with e* (generate-temporary)
-    #:with (real-binding imag-binding) (binding-names)
+    #:with (real-binding* imag-binding*) (binding-names)
+    #:with real-binding (if (and (subtypeof? #'e -Real)
+                                 (not (subtypeof? #'e -Flonum)))
+                            ;; values that were originally non-floats (e.g.
+                            ;; rationals or single floats) may need to be
+                            ;; handled specially
+                            (mark-as-non-float #'real-binding* #'e*)
+                            #'real-binding*)
+    #:with imag-binding (if (subtypeof? #'e -Real)
+                            ;; values that were originally reals may need to be
+                            ;; handled specially
+                            (mark-as-real #'imag-binding*)
+                            #'imag-binding*)
     #:do [(log-unboxing-opt
             (if (subtypeof? #'e -Flonum)
                 "float in complex ops"
@@ -443,9 +568,13 @@
           [(#%plain-app op:magnitude^ c:unboxed-float-complex-opt-expr)
            (log-unboxing-opt "unboxed unary float complex")
            #`(let*-values (c.bindings ...)
-               (unsafe-flsqrt
-                 (unsafe-fl+ (unsafe-fl* c.real-binding c.real-binding)
-                             (unsafe-fl* c.imag-binding c.imag-binding))))])))
+               ;; reuses the algorithm used by the Racket runtime
+               (let*-values ([(r) (unsafe-flabs c.real-binding)]
+                             [(i) (unsafe-flabs c.imag-binding)]
+                             [(q) (unsafe-fl/ r i)])
+                 (unsafe-fl* i
+                             (unsafe-flsqrt (unsafe-fl+ 1.0
+                                                        (unsafe-fl* q q))))))])))
 
 
   (pattern (#%plain-app op:float-complex-op e:expr ...)

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

@@ -4,7 +4,7 @@
          (for-template racket/base)
          "../utils/utils.rkt"
          (optimizer utils logging)
-         (types abbrev struct-table))
+         (types abbrev numeric-tower struct-table))
 
 (provide hidden-cost-log-expr)
 
@@ -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
@@ -64,4 +52,12 @@
     #:when (not (or (subtypeof? #'pattern-arg -Regexp)
                     (subtypeof? #'pattern-arg -Byte-Regexp)))
     #:do [(log-optimization-info "non-regexp pattern" #'pattern-arg)]
-    #:with opt (syntax/loc this-syntax (op pattern-arg.opt args.opt ...))))
+    #:with opt (syntax/loc this-syntax (op pattern-arg.opt args.opt ...)))
+
+  ;; vectors of floats can be replaced with flvectors in most cases
+  ;; need to deconstruct to not infinite loop
+  (pattern (#%plain-app es ...)
+    #:when (subtypeof? this-syntax (-vec -Flonum))
+    #:with (es*:opt-expr ...) #'(es ...)
+    #:do [(log-optimization-info "vector of floats" this-syntax)]
+    #:with opt (syntax/loc this-syntax (es*.opt ...))))

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

@@ -24,9 +24,9 @@
   (pattern opt:ignore-table^)
 
   ;; Can't optimize the body of this code because it isn't typechecked
-  (pattern (~and _:kw-lambda^
-             ((~and op let-values)
-              ([(i:id) e-rhs:opt-expr]) e-body:expr ...))
+  (pattern (~and (~or _:kw-lambda^ _:opt-lambda^)
+                 ((~and op let-values)
+                  ([(i:id) e-rhs:opt-expr]) e-body:expr ...))
            #:with opt (quasisyntax/loc/origin this-syntax #'op
                         (op ([(i) e-rhs.opt]) e-body ...)))
 

typed-racket-lib/typed-racket/optimizer/pair.rkt

@@ -138,7 +138,7 @@
                      [res #'e.arg])
               ([accessor (in-list (reverse (syntax->list #'e.alt)))])
             (cond
-             [(subtype t (-pair Univ Univ)) ; safe to optimize this one layer
+             [(and t (subtype t (-pair Univ Univ))) ; safe to optimize this one layer
               (syntax-parse accessor
                 [op:pair-op
                  (log-pair-opt)

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)
@@ -478,6 +485,13 @@
          (-Param ty ty))]
       [(:Parameter^ t1 t2)
        (-Param (parse-type #'t1) (parse-type #'t2))]
+      [((~and p :Parameter^) args ...)
+       (parse-error
+        #: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 :->^)) ...
         :->^
@@ -490,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))))]
@@ -552,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))
@@ -592,7 +606,8 @@
             (when (current-referenced-aliases)
               (define alias-box (current-referenced-aliases))
               (set-box! alias-box (cons #'id (unbox alias-box))))
-            (add-disappeared-use (syntax-local-introduce #'id))
+            (and (syntax-transforming?)
+                 (add-disappeared-use (syntax-local-introduce #'id)))
             t)]
          [else
           (parse-error #:delayed? #t (~a "type name `" (syntax-e #'id) "' is unbound"))
@@ -915,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)
@@ -79,5 +80,5 @@
   (tr:unit:invoke tr:unit:invoke)
   (tr:unit:invoke:expr tr:unit:invoke:expr)
   (tr:unit:compound tr:unit:compound)
-  (tr:unit:from-context tr:unit:from-context #:mark))
-
+  (tr:unit:from-context tr:unit:from-context #:mark)
+  (unsafe-provide unsafe-provide #:mark))

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)
- (static-contracts instantiate optimize structures combinators)
+ (only-in (types abbrev) -Bottom -Boolean)
+ (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
@@ -111,7 +123,7 @@
                     (λ (#:reason [reason #f]) (set! failure-reason reason))))
   (syntax-parse stx
     #:literal-sets (kernel-literals)
-    [(define-values ctc-id _)
+    [(define-values (ctc-id) _)
      ;; no need for ignore, the optimizer doesn't run on this code
      (cond [failure-reason
             #`(define-syntax (#,untyped-id stx)
@@ -122,10 +134,15 @@
                                  "type" #,(pretty-format-type type #:indent 8)))]
            [else
             (match-define (list defs ctc) result)
+            (define maybe-inline-val
+              (should-inline-contract?/cache ctc cache))
             #`(begin #,@defs
-                     (define ctc-id #,ctc)
+                     #,@(if maybe-inline-val
+                            null
+                            (list #`(define-values (ctc-id) #,ctc)))
                      (define-module-boundary-contract #,untyped-id
-                       #,orig-id ctc-id
+                       #,orig-id
+                       #,(or maybe-inline-val #'ctc-id)
                        #:pos-source #,blame-id
                        #:srcloc (vector (quote #,(syntax-source orig-id))
                                         #,(syntax-line orig-id)
@@ -133,6 +150,16 @@
                                         #,(syntax-position orig-id)
                                         #,(syntax-span orig-id))))])]))
 
+;; 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?/cache ctc-stx cache)
+  (and (identifier? ctc-stx)
+       (let ([match? (assoc ctc-stx (hash-values cache) free-identifier=?)])
+         (and match?
+              (should-inline-contract? (cdr match?))
+              (cdr match?)))))
+
 ;; The below requires are needed since they provide identifiers that
 ;; may appear in the residual program.
 
@@ -147,6 +174,8 @@
       typed-racket/utils/opaque-object
       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))
 
@@ -161,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))))))
@@ -187,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)
@@ -361,6 +399,32 @@
          (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 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?)]
+                [safe-spp/sc (flat/sc #'struct-predicate-procedure?/c)]
+                [optimized/sc (if (from-typed? typed-side)
+                                  unsafe-spp/sc
+                                  safe-spp/sc)])
+           (or/sc optimized/sc (t->sc/fun t)))]
         [(and t (Function: _)) (t->sc/fun t)]
         [(Set: t) (set/sc (t->sc t))]
         [(Sequence: ts) (apply sequence/sc (map t->sc ts))]
@@ -555,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)
@@ -578,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"
@@ -630,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)
@@ -647,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)
@@ -761,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
@@ -769,6 +845,15 @@
           [_ type])]))
     #f))
 
+;; True if the arities `arrs` are what we'd expect from a struct predicate
+(define (any->bool? arrs)
+  (match arrs
+    [(list (arr: (list (Univ:))
+                 (Values: (list (Result: t _ _)))
+                 #f #f '()))
+     (t:subtype -Boolean t)]
+    [_ #f]))
+
 (module predicates racket/base
   (require racket/extflonum)
   (provide nonnegative? nonpositive?

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,67 +1,4 @@
 #lang racket/base
 
-;;TODO use contract-req
-(require "rep-utils.rkt" "free-variance.rkt" racket/contract/base
-         racket/lazy-require)
-
-;; TODO use something other than lazy-require.
-(lazy-require ["type-rep.rkt" (Type/c Univ? Bottom?)]
-              ["object-rep.rkt" (Path?)])
-
-(provide Filter/c FilterSet/c name-ref/c hash-name filter-equal?)
-
-(define (Filter/c-predicate? e)
-  (and (Filter? e) (not (NoFilter? e)) (not (FilterSet? e))))
-(define Filter/c (flat-named-contract 'Filter Filter/c-predicate?))
-
-(define 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 name-ref/c (or/c identifier? (list/c integer? integer?)))
-(define (hash-name v) (if (identifier? v) (hash-id v) (list v)))
-
-(define ((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

@@ -7,7 +7,6 @@
          "interning.rkt"
          racket/lazy-require
          racket/stxparam
-         racket/unsafe/ops
          (for-syntax
           racket/match
           (except-in syntax/parse id identifier keyword)
@@ -21,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))
@@ -33,9 +32,9 @@
 (define-struct Rep (seq free-vars free-idxs stx) #:transparent
                #:methods gen:equal+hash
                [(define (equal-proc x y recur)
-                  (eq? (unsafe-Rep-seq x) (unsafe-Rep-seq y)))
-                (define (hash-proc x recur) (unsafe-Rep-seq x))
-                (define (hash2-proc x recur) (unsafe-Rep-seq x))])
+                  (eq? (Rep-seq x) (Rep-seq y)))
+                (define (hash-proc x recur) (Rep-seq x))
+                (define (hash2-proc x recur) (Rep-seq x))])
 
 ;; evil tricks for hygienic yet unhygienic-looking reference
 ;; in say def-type for type-ref-id
@@ -136,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))]
@@ -205,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))
@@ -218,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
@@ -352,23 +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])
 
-;; NOTE: change these if the definitions above change, or everything will segfault
-(define-syntax-rule (unsafe-Rep-seq v) (unsafe-struct*-ref v 0))
-(define-syntax-rule (unsafe-Type-key v) (unsafe-struct*-ref v 4))
-(provide unsafe-Rep-seq unsafe-Type-key)
-
 (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)))
@@ -392,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,15 +54,15 @@
 
 ;; 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))
 
 (define Type/c?
    (λ (e)
      (and (Type? e)
-          (not (Scope? e))
           (not (arr? e))
           (not (fld? e))
           (not (Values? e))
@@ -75,7 +76,6 @@
 (define Values/c?
    (λ (e)
      (and (Type? e)
-          (not (Scope? e))
           (not (arr? e))
           (not (fld? e))
           (not (ValuesDots? e))
@@ -93,19 +93,6 @@
 
 ;; Type is defined in rep-utils.rkt
 
-;; t must be a Type
-(def-type Scope ([t (or/c Type/c Scope?)]) [#:key (Type-key t)])
-
-(define (scope-depth k)
-  (flat-named-contract
-   (format "Scope of depth ~a" k)
-   (lambda (sc)
-     (define (f k sc)
-       (cond [(= 0 k) (Type/c? sc)]
-             [(not (Scope? sc)) #f]
-             [else (f (sub1 k) (Scope-t sc))]))
-     (f k sc))))
-
 ;; this is ONLY used when a type error ocurrs
 (def-type Error () [#:frees #f] [#:fold-rhs #:base])
 
@@ -239,48 +226,43 @@
                [(Keyword) 'keyword]
                [else #f]))])
 
-;; body is a Scope
-(def-type Mu ([body (scope-depth 1)]) #:no-provide [#:frees (λ (f) (f body))]
-  [#:fold-rhs (*Mu (*Scope (type-rec-id (Scope-t body))))]
+(def-type Mu ([body Type/c]) #:no-provide [#:frees (λ (f) (f body))]
+  [#:fold-rhs (*Mu (type-rec-id body))]
   [#:key (Type-key body)])
 
 ;; n is how many variables are bound here
-;; body is a Scope
+;; body is a type
 (def-type Poly (n body) #:no-provide
-  [#:contract (->i ([n natural-number/c]
-                    [body (n) (scope-depth n)])
+   [#:contract (->i ([n natural-number/c]
+                    [body Type/c])
                    (#:syntax [stx (or/c #f syntax?)])
                    [result Poly?])]
   [#:frees (λ (f) (f body))]
-  [#:fold-rhs (let ([body* (remove-scopes n body)])
-                (*Poly n (add-scopes n (type-rec-id body*))))]
+  [#:fold-rhs (*Poly n (type-rec-id body))]
   [#:key (Type-key body)])
 
 ;; n is how many variables are bound here
 ;; there are n-1 'normal' vars and 1 ... var
-;; body is a Scope
 (def-type PolyDots (n body) #:no-provide
   [#:contract (->i ([n natural-number/c]
-                    [body (n) (scope-depth n)])
+                    [body Type/c])
                    (#:syntax [stx (or/c #f syntax?)])
                    [result PolyDots?])]
   [#:key (Type-key body)]
   [#:frees (λ (f) (f body))]
-  [#:fold-rhs (let ([body* (remove-scopes n body)])
-                (*PolyDots n (add-scopes n (type-rec-id body*))))])
+  [#:fold-rhs (*PolyDots n (type-rec-id body))])
 
 ;; interp. A row polymorphic function type
 ;; constraints are row absence constraints, represented
 ;; as a set for each of init, field, methods
 (def-type PolyRow (constraints body) #:no-provide
   [#:contract (->i ([constraints (list/c list? list? list? list?)]
-                    [body (scope-depth 1)])
+                    [body Type/c])
                    (#:syntax [stx (or/c #f syntax?)])
                    [result PolyRow?])]
   [#:frees (λ (f) (f body))]
-  [#:fold-rhs (let ([body* (remove-scopes 1 body)])
-                (*PolyRow constraints
-                          (add-scopes 1 (type-rec-id body*))))]
+  [#:fold-rhs (*PolyRow constraints
+                        (type-rec-id body))]
   [#:key (Type-key body)])
 
 ;; pred : identifier
@@ -294,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)]
@@ -304,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)])
@@ -469,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
@@ -636,24 +667,11 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 
-;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
-(define (add-scopes n t)
-  (if (zero? n) t
-      (add-scopes (sub1 n) (*Scope t))))
-
-(define (remove-scopes n sc)
-  (if (zero? n)
-      sc
-      (match sc
-        [(Scope: sc*) (remove-scopes (sub1 n) sc*)]
-        [_ (int-err "Tried to remove too many scopes: ~a" sc)])))
-
-
 (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)
@@ -669,11 +687,11 @@
 
 (define ((sub-t st) e)
   (type-case (#:Type st
-              #:Filter (sub-f st))
+              #:Prop (sub-f st))
               e))
 
 
-;; abstract-many : Names Type -> Scope^n
+;; abstract-many : Names Type -> Type
 ;; where n is the length of names
 (define (abstract-many names ty)
   ;; mapping : dict[Type -> Natural]
@@ -690,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
@@ -713,27 +731,23 @@
        [#:ListDots dty dbound
                    (*ListDots (sb dty)
                               (transform dbound values dbound))]
-       [#:Mu (Scope: body) (*Mu (*Scope (loop (add1 outer) body)))]
-       [#:PolyRow constraints body*
-                  (let ([body (remove-scopes 1 body*)])
-                    (*PolyRow constraints
-                              (add-scopes 1 (loop (+ 1 outer) body))))]
-       [#:PolyDots n body*
-                   (let ([body (remove-scopes n body*)])
-                     (*PolyDots n (add-scopes n (loop (+ n outer) body))))]
-       [#:Poly n body*
-               (let ([body (remove-scopes n body*)])
-                 (*Poly n (add-scopes n (loop (+ n outer) body))))])))
+       [#:Mu body (*Mu (loop (add1 outer) body))]
+       [#:PolyRow constraints body
+                  (*PolyRow constraints (loop (+ 1 outer) body))]
+       [#:PolyDots n body
+                   (*PolyDots n (loop (+ n outer) body))]
+       [#:Poly n body
+               (*Poly n (loop (+ n outer) body))])))
   (define n (length names))
   (define mapping (for/list ([nm (in-list names)]
                              [i (in-range n 0 -1)])
                     (cons nm (sub1 i))))
-  (add-scopes n (nameTo mapping ty)))
+  (nameTo mapping ty))
 
-;; instantiate-many : List[Type] Scope^n -> Type
+;; instantiate-many : List[Type] Type -> Type
 ;; where n is the length of types
 ;; all of the types MUST be Fs
-(define (instantiate-many images sc)
+(define (instantiate-many images ty)
   ;; mapping : dict[Natural -> Type]
   (define (replace mapping type)
     (let loop ([outer 0] [ty type])
@@ -748,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
@@ -770,21 +784,18 @@
        [#:ListDots dty dbound
                    (*ListDots (sb dty)
                               (transform dbound F-n dbound))]
-       [#:Mu (Scope: body) (*Mu (*Scope (loop (add1 outer) body)))]
-       [#:PolyRow constraints body*
-                  (let ([body (remove-scopes 1 body*)])
-                    (*PolyRow constraints (add-scopes 1 (loop (+ 1 outer) body))))]
-       [#:PolyDots n body*
-                   (let ([body (remove-scopes n body*)])
-                     (*PolyDots n (add-scopes n (loop (+ n outer) body))))]
-       [#:Poly n body*
-               (let ([body (remove-scopes n body*)])
-                 (*Poly n (add-scopes n (loop (+ n outer) body))))])))
+       [#:Mu body (*Mu (loop (add1 outer) body))]
+       [#:PolyRow constraints body
+                  (*PolyRow constraints (loop (+ 1 outer) body))]
+       [#:PolyDots n body
+                   (*PolyDots n (loop (+ n outer) body))]
+       [#:Poly n body
+               (*Poly n (loop (+ n outer) body))])))
   (define n (length images))
   (define mapping (for/list ([img (in-list images)]
                              [i (in-range n 0 -1)])
                     (cons (sub1 i) img)))
-  (replace mapping (remove-scopes n sc)))
+  (replace mapping ty))
 
 (define (abstract name ty)
   (abstract-many (list name) ty))
@@ -801,8 +812,8 @@
 ;; the 'smart' destructor
 (define (Mu-body* name t)
   (match t
-    [(Mu: scope)
-     (instantiate (*F name) scope)]))
+    [(Mu: body)
+     (instantiate (*F name) body)]))
 
 ;; the 'smart' constructor
 ;;
@@ -825,10 +836,10 @@
 ;; the 'smart' destructor
 (define (Poly-body* names t)
   (match t
-    [(Poly: n scope)
+    [(Poly: n body)
      (unless (= (length names) n)
        (int-err "Wrong number of names: expected ~a got ~a" n (length names)))
-     (instantiate-many (map *F names) scope)]))
+     (instantiate-many (map *F names) body)]))
 
 ;; the 'smart' constructor
 (define (PolyDots* names body)
@@ -840,10 +851,10 @@
 ;; the 'smart' destructor
 (define (PolyDots-body* names t)
   (match t
-    [(PolyDots: n scope)
+    [(PolyDots: n body)
      (unless (= (length names) n)
        (int-err "Wrong number of names: expected ~a got ~a" n (length names)))
-     (instantiate-many (map *F names) scope)]))
+     (instantiate-many (map *F names) body)]))
 
 ;; Constructor and destructor for row polymorphism
 ;;
@@ -858,15 +869,15 @@
 
 (define (PolyRow-body* names t)
   (match t
-    [(PolyRow: constraints scope)
-     (instantiate-many (map *F names) scope)]))
+    [(PolyRow: constraints body)
+     (instantiate-many (map *F names) body)]))
 
 (print-struct #t)
 
 (define-match-expander Mu-unsafe:
   (lambda (stx)
     (syntax-case stx ()
-      [(_ bp) #'(? Mu? (app (lambda (t) (Scope-t (Mu-body t))) bp))])))
+      [(_ bp) #'(? Mu? (app (lambda (t) (Mu-body t)) bp))])))
 
 (define-match-expander Poly-unsafe:
   (lambda (stx)

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/combinators/structural.rkt

@@ -15,7 +15,8 @@
                        racket/async-channel
                        racket/sequence
                        racket/promise
-                       "../../utils/evt-contract.rkt")
+                       "../../utils/evt-contract.rkt"
+                       "../../utils/promise-not-name-contract.rkt")
          racket/contract
          racket/async-channel)
 
@@ -153,7 +154,7 @@
   ((set/sc (#:covariant #:chaperone)) set/c #:flat)
   ((vector/sc . (#:invariant)) vector/c #:chaperone)
   ((vectorof/sc (#:invariant)) vectorof #:chaperone)
-  ((promise/sc (#:covariant)) (λ (x) (and/c (promise/c x) (not/c promise/name?))) #:chaperone)
+  ((promise/sc (#:covariant)) promise-not-name/c #:chaperone)
   ((syntax/sc (#:covariant #:flat)) syntax/c #:flat)
   ((hash/sc (#:invariant #:flat) (#:invariant)) hash/c #:chaperone)
   ((box/sc (#:invariant)) box/c #:chaperone)

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
@@ -47,9 +48,42 @@
             (contract-restrict-recursive-values (compute-constraints sc kind)))
           cache))))
 
+;; computes the definitions that are in / used by `sc`
+;; `(get-all-name-defs)` is not what we want directly, since it also includes
+;; definitions that were optimized away
+;; we restrict it to only variables bound in `sc`
+(define (compute-defs sc)
+  (define all-name-defs (get-all-name-defs))
+  ;; all-name-defs maps lists of ids to defs
+  ;; we want to match if any id in the list matches
+  (define (ref b) (for/first ([(k v) (in-dict all-name-defs)]
+                              #:when (for/or ([k* (in-list k)])
+                                       (free-identifier=? b k*)))
+                    (cons k v)))
+  (define bound '())
+  ;; ignores its second argument (variance, passed by sc-traverse)
+  (let loop ([sc sc] [_ #f])
+    (match sc
+      [(name/sc: name*)
+       (unless (member name* bound free-identifier=?)
+         (set! bound (cons name* bound))
+         ;; traverse what `name` refers to
+         (define r (ref name*))
+         ;; ref returns a rib, get the one definition we want
+         (define target (for/first ([k (car r)]
+                                    [v (cdr r)]
+                                    #:when (free-identifier=? name* k))
+                          v))
+         (loop target #f))]
+      [else (sc-traverse sc loop)]))
+  (for*/hash ([b (in-list bound)]
+              [v (in-value (ref b))]
+              #:when v)
+    (values (car v) (cdr v))))
+
 (define (compute-constraints sc max-kind)
   (define memo-table (make-hash))
-  (define name-defs (get-all-name-defs))
+  (define name-defs (compute-defs sc))
   (define (recur sc)
     (cond [(hash-ref memo-table sc #f)]
           [else
@@ -96,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))
@@ -111,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))
@@ -137,8 +180,8 @@
                (recur body)))]
       [(? sc? sc)
        (sc->contract sc recur)]))
-  (define ctc (recur sc))
-  (define name-defs (get-all-name-defs))
+  (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
   ;; contracts from a single contract fixup pass, we use the name-defined
@@ -163,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/tc-setup.rkt

@@ -76,9 +76,8 @@
   (tc-setup orig-stx stx 'top-level
             local-expand/capture* (kernel-form-identifier-list)
             (λ (head-expanded-stx)
-              (parameterize ([orig-module-stx (or (orig-module-stx) orig-stx)])
-                (do-time "Trampoline the top-level checker")
-                (tc-toplevel-start head-expanded-stx)))))
+              (do-time "Trampoline the top-level checker")
+              (tc-toplevel-start (or (orig-module-stx) orig-stx) head-expanded-stx))))
 
 (define (tc-module/full orig-stx stx k)
   (tc-setup orig-stx stx 'module-begin local-expand (list #'module*)

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
@@ -550,21 +550,10 @@
         #:when (set-member? (hash-ref parse-info 'private-fields) name))
     (hash-set! private-field-types name (list type)))
 
-  ;; Hash<Syntax -> Listof<Listof<Syntax>, Listof<Type>>>
-  ;; Maps the outermost `let-values` expressions introduced by the expansion of
-  ;;  `define-values` within the class body to a list of identifier syntaxes
-  ;;  that represent variables and a list of corresponding types.
-  ;;  The variables temporarily hold the values of the initializer expression;
-  ;;  a field mutator is called on each one in the body of the `let-values`.
-  ;;  Typechecking of these calls is done in `check-field-set!s` and requires
-  ;;  the types of the initial values.
-  (define inits-temporaries-types (make-hasheq))
-
   (define synthesized-init-val-stxs
     (synthesize-private-field-types private-field-stxs
                                     local-private-field-table
-                                    private-field-types
-                                    inits-temporaries-types))
+                                    private-field-types))
 
   ;; Detect mutation of private fields for occurrence typing
   (for ([stx (in-sequences
@@ -609,8 +598,7 @@
   (with-lexical-env/extend-types lexical-names/top-level lexical-types/top-level
     (check-field-set!s (hash-ref parse-info 'initializer-body)
                        synthesized-init-val-stxs
-                       inits
-                       inits-temporaries-types))
+                       inits))
   (do-timestamp "checked field initializers")
   (define checked-method-types
     (with-lexical-env/extend-types lexical-names lexical-types
@@ -995,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))
@@ -1035,11 +1023,11 @@
            (tc-expr/t xformed-stx)])))
 
 ;; check-field-set!s : Syntax Listof<Syntax> Dict<Symbol, Type>
-;;                     Dict<Syntax, List<Listof<Syntax>, Listof<Type>> -> Void
+;;                     -> Void
 ;; Check that fields are initialized to the correct type
 ;; FIXME: use syntax classes for matching and clearly separate the handling
 ;;        of field initialization and set! uses
-(define (check-field-set!s stx synthed-stxs inits inits-temporaries-types)
+(define (check-field-set!s stx synthed-stxs inits)
   (for ([form (syntax->list stx)])
     (syntax-parse form
       #:literal-sets (kernel-literals)
@@ -1106,12 +1094,21 @@
          (tc-expr/check processed (ret type)))]
       ;; multiple private fields
       [(let-values ([(names:id ...) val-expr]) begins ... (#%plain-app _))
-       (match-define (list t-names t-types)
-         (hash-ref inits-temporaries-types form (list empty empty)))
+       ;; This seems like it's duplicating work since the synthesis pass
+       ;; earlier had to do this, but it needs to be re-checked in this context
+       ;; so that it has the right environment. An earlier approach did
+       ;; check this only in the synthesis stage, but caused some regressions.
+       (define temp-names (syntax->list #'(names ...)))
+       (define init-types
+         (match (tc-expr #'val-expr)
+           [(tc-results: xs ) xs]))
+       (unless (= (length temp-names) (length init-types))
+         (tc-error/expr "wrong number of values: expected ~a but got ~a"
+                        (length temp-names) (length init-types)))
        ;; Extend lexical type env with temporaries introduced in the
        ;; expansion of the field initialization or setter
-       (with-lexical-env/extend-types t-names t-types
-         (check-field-set!s #'(begins ...) synthed-stxs inits inits-temporaries-types))]
+       (with-lexical-env/extend-types temp-names init-types
+         (check-field-set!s #'(begins ...) synthed-stxs inits))]
       [_ (void)])))
 
 ;; setter->type : Id -> Type
@@ -1144,11 +1141,11 @@
           [else
            (tc-expr/check init-val (ret init-type))])))
 
-;; synthesize-private-field-types : Listof<Syntax> Dict Hash Hash -> Listof<Syntax>
+;; synthesize-private-field-types : Listof<Syntax> Dict Hash -> Listof<Syntax>
 ;; Given top-level expressions in the class, synthesize types from
 ;; the initialization expressions for private fields. Returns the initial
 ;; value expressions that were type synthesized.
-(define (synthesize-private-field-types stxs locals types inits-temporaries-types)
+(define (synthesize-private-field-types stxs locals types)
   (for/fold ([synthed-stxs null])
             ([stx (in-list stxs)])
     (syntax-parse stx
@@ -1186,23 +1183,18 @@
        (define field-names (map syntax-e (syntax-e (tr:class:def-property stx))))
        (define temporary-stxs (syntax-e #'(initial-value-name ...)))
        (define init-types
-         (match (tc-expr/check #'initial-values #f)
-           [(tc-results: xs ) xs]))
-       (unless (= (length field-names) (length init-types))
-         (tc-error/expr "wrong number of values: expected ~a but got ~a"
-                        (length field-names) (length init-types)))
-       (define temporaries-types
-         (for/list
-              ([name (in-list field-names)]
-               [temp-stx (in-list temporary-stxs)]
-               [type (in-list init-types)])
-           (define type-table-val (generalize type))
-           (unless (hash-has-key? types name)
-             (hash-set! types name (list type-table-val)))
-           (cons temp-stx type-table-val)))
-       (hash-set! inits-temporaries-types stx
-                  (list (map car temporaries-types)
-                        (map cdr temporaries-types)))
+         ;; this gets re-checked later, so don't throw any errors yet
+         (match (tc-expr/check? #'initial-values #f)
+           [(tc-results: xs ) xs]
+           ;; We have to return something here so use the most conservative type
+           [#f (make-list (length field-names) Univ)]))
+       (for ([name (in-list field-names)]
+             [temp-stx (in-list temporary-stxs)]
+             [type (in-list init-types)])
+         (define type-table-val (generalize type))
+         (unless (hash-has-key? types name)
+           (hash-set! types name (list type-table-val)))
+         (cons temp-stx type-table-val))
        (cons #'initial-values synthed-stxs)])))
 
 ;; Syntax -> Dict<Symbol, Id> Dict<Symbol, Id>
@@ -1605,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

@@ -74,12 +74,13 @@
 ;;; Helpers
 
 (define-splicing-syntax-class dtsi-fields
- #:attributes (mutable prefab type-only maker)
+ #:attributes (mutable prefab type-only maker extra-maker)
  (pattern
   (~seq
     (~or (~optional (~and #:mutable (~bind (mutable #t))))
          (~optional (~and #:prefab (~bind (prefab #t))))
          (~optional (~and #:type-only (~bind (type-only #t))))
+         (~optional (~seq #:extra-maker extra-maker))
          (~optional (~seq #:maker maker))) ...)))
 
 (define-syntax-class struct-name
@@ -88,14 +89,16 @@
 
 
 (define-syntax-class define-typed-struct-body
-  #:attributes (name mutable prefab type-only maker nm (tvars 1) (fields 1) (types 1))
+  #: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)
            #:attr type-only (attribute options.type-only)
-           #:attr maker (or (attribute options.maker) #'nm.nm)))
+           #:attr maker (or (attribute options.maker) #'nm.nm)
+           #:attr extra-maker (attribute options.extra-maker)))
 
 (define-syntax-class dviu-import/export
   (pattern (sig-id:id member-id:id ...)
@@ -148,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/provide-handling.rkt

@@ -8,15 +8,19 @@
          (private syntax-properties)
          (typecheck renamer def-binding)
          (utils tc-utils)
+         (env env-utils)
          (for-syntax racket/base)
          (for-template racket/base))
 
 (provide remove-provides provide? generate-prov)
 
+;; Returns #t for safe provides. Returns #f for non-provide forms
+;; and unsafe provides for which contracts will not be generated.
 (define (provide? form)
   (syntax-parse form
     #:literal-sets (kernel-literals)
-    [(#%provide . rest) form]
+    [(~and (#%provide . rest) (~not _:unsafe-provide^))
+     form]
     [_ #f]))
 
 (define (remove-provides forms)
@@ -183,9 +187,10 @@
        new-id
        null)))
 
-
   ;; Build the final provide with auxilliary definitions
-  (for/lists (defs export-defs provides aliases) ([(internal-id external-ids) (in-dict provs)])
+  (for/lists (defs export-defs provides aliases)
+    ;; sort provs to generate deterministic output
+    ([(internal-id external-ids) (in-sorted-dict provs id<)])
     (define-values (defs export-def id alias) (mk internal-id))
     (define provide-forms
       (for/list ([external-id (in-list external-ids)])

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,8 +5,8 @@
          "utils.rkt"
          syntax/parse syntax/stx racket/match
          (typecheck signatures tc-funapp)
-         (types abbrev union utils)
-         (rep type-rep)
+         (types abbrev prop-ops union utils)
+         (rep type-rep object-rep)
 
          (for-label racket/base racket/bool))
 
@@ -53,10 +53,16 @@
         (alt eqv? eqv?-able)
         (alt equal? equal?-able)))
   (match* ((single-value v1) (single-value v2))
+    [((tc-result1: (Value: (? ok? val1)) _ o1)
+      (tc-result1: (Value: (? ok? val2)) _ 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: _)) ...))))
@@ -66,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-keywords.rkt

@@ -6,7 +6,7 @@
          "utils.rkt"
          syntax/parse syntax/stx racket/match racket/set
          (typecheck signatures tc-app-helper tc-funapp tc-metafunctions)
-         (types abbrev utils substitute subtype)
+         (types abbrev utils substitute subtype type-table)
          (rep type-rep)
          (utils tc-utils)
          (r:infer infer)
@@ -35,6 +35,7 @@
     ;; If #t, then the contract system has inserted an extra argument which we
     ;; need to ignore
     #:attr boundary-ctc? (contract-neg-party-property #'fn)
+    #:do [(for-each register-ignored! (syntax->list #'form))] ; no type info, so can't optimize
     #:with pos-args (if (attribute boundary-ctc?)
                         (stx-cdr #'*pos-args)
                         #'*pos-args)

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-objects.rkt

@@ -7,7 +7,7 @@
          racket/format
          racket/list
          (typecheck signatures)
-         (types base-abbrev resolve subtype union utils)
+         (types base-abbrev resolve subtype type-table union utils)
          (rep type-rep)
          (utils tc-utils)
 
@@ -25,10 +25,21 @@
 (define-tc/app-syntax-class (tc/app-objects expected)
   #:literal-sets (kernel-literals object-literals)
   (pattern (dmo b cl
-            (#%plain-app list . pos-args)
-            (#%plain-app list (#%plain-app cons (quote names) named-args) ...))
+            (~and pos-arg-list (#%plain-app list . pos-args))
+            (~and named-arg-list (#%plain-app list (#%plain-app cons (quote names) named-args) ...)))
      #:declare dmo (id-from 'do-make-object 'racket/private/class-internal)
-     (check-do-make-object #'cl #'pos-args #'(names ...) #'(named-args ...)))
+     (begin0
+       (check-do-make-object #'cl #'pos-args #'(names ...) #'(named-args ...))
+       ;; synthesize a type for #'pos-arg-list, for the optimizer
+       (add-typeof-expr #'pos-arg-list
+                        (ret (for/fold ([res (-val '())])
+                                 ([a (in-list (reverse (syntax->list #'pos-args)))])
+                               (-pair (match (type-of a) [(tc-result1: t) t])
+                                      res))))
+       ;; making the optimizer ignore named args is conservative, but safe
+       ;; if we could give #'named-arg-list a type, then we'd be able to
+       ;; optimize it
+       (register-ignored! #'named-arg-list)))
   (pattern (dmo . args)
      #:declare dmo (id-from 'do-make-object 'racket/private/class-internal)
      (int-err "unexpected arguments to do-make-object"))

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

@@ -7,9 +7,9 @@
          syntax/stx
          racket/sequence
          (typecheck signatures tc-funapp)
-         (types abbrev utils)
+         (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))
@@ -26,6 +26,7 @@
   ;; parameterize
   (pattern (extend-parameterization pmz (~seq params args) ...)
     (begin
+      (register-ignored! #'pmz)
       (for ([param (in-syntax #'(params ...))]
             [arg (in-syntax #'(args ...))])
         (match (single-value param)
@@ -49,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
@@ -21,6 +21,7 @@
          racket/extflonum
          ;; Needed for current implementation of typechecking letrec-syntax+values
          (for-template (only-in racket/base letrec-values)
+                       (only-in racket/base list)
                        ;; see tc-app-contracts.rkt
                        racket/contract/private/provide)
 
@@ -53,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
@@ -139,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)]
@@ -199,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
@@ -235,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
@@ -273,8 +274,40 @@
        (ret (opt-unconvert (tc-expr/t #'fun)
                            (syntax->list #'(formals ...))))]
       ;; let
-      [(let-values ([(name ...) expr] ...) . body)
-       (tc/let-values #'((name ...) ...) #'(expr ...) #'body expected)]
+      [(let-values bindings . body)
+       (define bindings*
+         (syntax-parse #'body
+           #:literal-sets (kernel-literals)
+           ;; special case: let-values that originates from an application of a
+           ;; kw function. we may need to ignore contract-related arguments
+           [((kw-app1 (kw-app2 cpce s-kp fn kpe kws num) ; see tc-app/tc-app-keywords.rkt
+                      kw-list
+                      (kw-app3 list . kw-arg-list)
+                      . *pos-args))
+            #:declare cpce (id-from 'checked-procedure-check-and-extract 'racket/private/kw)
+            #:declare s-kp (id-from 'struct:keyword-procedure 'racket/private/kw)
+            #:declare kpe  (id-from 'keyword-procedure-extract 'racket/private/kw)
+            #:declare kw-app1  (id-from '#%app 'racket/private/kw)
+            #:declare kw-app2  (id-from '#%app 'racket/private/kw)
+            #:declare kw-app3  (id-from '#%app 'racket/private/kw)
+            #:declare list (id-from 'list 'racket/private/kw)
+            #:when (contract-neg-party-property #'fn) ; contracted
+            ;; ignore the rhs which refers to a contract-lifted definition
+            ;; this code may compute the negative blame party, which may involve
+            ;; things that are not typecheckable
+            (syntax-parse #'bindings
+              [(c1 [(contract-lhs) contract-rhs] cs ...)
+               ;; give up on optimizing the whole let, part of it is missing type info
+               ;; (not that this expansion could be optimized anyway)
+               (register-ignored! form)
+               #'(c1 cs ...)]
+              [_
+               (int-err "malformed kw arg let-values ~a" #'bindings)])]
+           [_ ; not the special case, leave bindings as is
+            #'bindings]))
+       (syntax-parse bindings*
+         [([(name ...) expr] ...)
+          (tc/let-values #'((name ...) ...) #'(expr ...) #'body expected)])]
       [(letrec-values ([(name ...) expr] ...) . body)
        (tc/letrec-values #'((name ...) ...) #'(expr ...) #'body expected)]
       ;; other
@@ -311,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.
@@ -333,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
@@ -360,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))))