From 11304827253eb2b88bbf99b1f54f85cf89f2ab96 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 16 Jul 2010 15:24:23 -0400
Subject: [PATCH 001/198] Documented the optimizer. (cherry picked from commit
 8d6230956dc8c207c097a389fa1f0c7273bb55b7)

original commit: 536551ce5ec30081a4823a21512e8ecbfc448bbf
---
 .../scribblings/optimization.scrbl            | 21 +++++++++++++++++++
 .../typed-scheme/scribblings/ts-guide.scrbl   |  1 +
 .../scribblings/ts-reference.scrbl            | 13 ++++++++++++
 3 files changed, 35 insertions(+)
 create mode 100644 collects/typed-scheme/scribblings/optimization.scrbl

diff --git a/collects/typed-scheme/scribblings/optimization.scrbl b/collects/typed-scheme/scribblings/optimization.scrbl
new file mode 100644
index 00000000..e7d70054
--- /dev/null
+++ b/collects/typed-scheme/scribblings/optimization.scrbl
@@ -0,0 +1,21 @@
+#lang scribble/manual
+
+@begin[(require (for-label (only-meta-in 0 typed/racket)) scribble/eval
+		"utils.rkt" (only-in "quick.scrbl" typed-mod))]
+
+@(define the-eval (make-base-eval))
+@(the-eval '(require typed/racket))
+
+@title[#:tag "optimization"]{Optimization in Typed Racket}
+
+Typed Racket provides a type-driven optimizer that rewrites well-typed
+programs to potentially make them faster. It should in no way make
+your programs slower or unsafe.
+
+@section{Using the optimizer}
+
+Typed Racket's optimizer is not currently turned on by default. If you
+want to activate it, you must add the @racket[#:optimize] keyword when
+specifying the language of your program:
+
+@racketmod[typed/racket #:optimize]
diff --git a/collects/typed-scheme/scribblings/ts-guide.scrbl b/collects/typed-scheme/scribblings/ts-guide.scrbl
index 1c58c25c..948f7dbe 100644
--- a/collects/typed-scheme/scribblings/ts-guide.scrbl
+++ b/collects/typed-scheme/scribblings/ts-guide.scrbl
@@ -19,6 +19,7 @@ with Racket.  For an introduction to Racket, see the @(other-manual '(lib "scrib
 @include-section["begin.scrbl"]
 @include-section["more.scrbl"]
 @include-section["types.scrbl"]
+@include-section["optimization.scrbl"]
 
 @;@section{How the Type System Works}
 
diff --git a/collects/typed-scheme/scribblings/ts-reference.scrbl b/collects/typed-scheme/scribblings/ts-reference.scrbl
index 4e063ef2..4b546d66 100644
--- a/collects/typed-scheme/scribblings/ts-reference.scrbl
+++ b/collects/typed-scheme/scribblings/ts-reference.scrbl
@@ -603,4 +603,17 @@ have the types ascribed to them; these types are converted to contracts and chec
   (define val 17))
 
 (fun val)]
+
+@section{Optimization in Typed Racket}
+
+Typed Racket provides a type-driven optimizer that rewrites well-typed
+programs to potentially make them faster. It should in no way make
+your programs slower or unsafe.
+
+Typed Racket's optimizer is not currently turned on by default. If you
+want to activate it, you must add the @racket[#:optimize] keyword when
+specifying the language of your program:
+
+@racketmod[typed/racket #:optimize]
+
 }

From 0161cda2d40715f3a4c156c209a2f119d8f6f778 Mon Sep 17 00:00:00 2001
From: Stevie Strickland <sstrickl@racket-lang.org>
Date: Fri, 16 Jul 2010 16:57:29 -0400
Subject: [PATCH 002/198] Two fixes in overlap checking.

 - Names were not being resolved, so a superstruct name and substruct name
   could be seen as non-overlapping.
 - Struct parents were not checked in the overlapping algorithm.
(cherry picked from commit 654b7df1decd52763ffedcdc507a4bf367b1cecf)

original commit: 3884d5661022ef970a77f127e7a58d052760d635
---
 .../typed-scheme/types/remove-intersect.rkt   | 19 ++++++++++++-------
 1 file changed, 12 insertions(+), 7 deletions(-)

diff --git a/collects/typed-scheme/types/remove-intersect.rkt b/collects/typed-scheme/types/remove-intersect.rkt
index a646a54c..074af5da 100644
--- a/collects/typed-scheme/types/remove-intersect.rkt
+++ b/collects/typed-scheme/types/remove-intersect.rkt
@@ -23,7 +23,8 @@
          [(list _ (Univ:)) #t]
          [(list (F: _) _) #t]
          [(list _ (F: _)) #t]
-         [(list (Name: n) (Name: n*)) (free-identifier=? n n*)]
+         [(list (Name: n) (Name: n*)) 
+          (overlap (resolve-once t1) (resolve-once t2))]
          [(list (? Mu?) _) (overlap (unfold t1) t2)]
          [(list _ (? Mu?)) (overlap t1 (unfold t2))]
          [(list (Union: e) t)
@@ -68,12 +69,16 @@
          [(list (Struct: n #f flds _ _ _ _ _)
                 (StructTop: (Struct: n* #f flds* _ _ _ _ _)))
           #f]
-         [(list (Struct: n p flds _ _ _ _ _)
-                (Struct: n* p* flds* _ _ _ _ _))
-          (and (= (length flds) (length flds*)) 
-               (for/and ([f flds] [f* flds*]) 
-                 (match* (f f*)
-                   [((fld: t _ _) (fld: t* _ _)) (overlap t t*)])))]
+         [(list (and t1 (Struct: n p flds _ _ _ _ _))
+                (and t2 (Struct: n* p* flds* _ _ _ _ _)))
+          (let ([p1 (if (Name? p) (resolve-name p) p)]
+                [p2 (if (Name? p*) (resolve-name p*) p*)])
+            (or (overlap t1 p2)
+                (overlap t2 p1)
+                (and (= (length flds) (length flds*)) 
+                     (for/and ([f flds] [f* flds*]) 
+                       (match* (f f*)
+                               [((fld: t _ _) (fld: t* _ _)) (overlap t t*)])))))]
          [(list (== (-val eof))
                 (Function: _))
           #f]

From b71fbae36a7d6c51d7814d545d60e476a8c7efec Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 16 Jul 2010 18:16:51 -0400
Subject: [PATCH 003/198] Further fixes in overlap checking.

Rhss of code dispatching on overlapping structs are no longer
considered dead, and as such, are now typechecked.

Had to fix a test that passed only because some not-really-dead code
was not being typechecked.
(cherry picked from commit 4d5b50dee9e04aee167a7e04fbbe23526131fcad)

original commit: e0614cfed24dfc9e7f89b9a8c77e7930695b0269
---
 .../typed-scheme/fail/dead-substruct.rkt      |  16 +++
 .../optimizer/generic/dead-substructs.rkt     |  17 +++
 .../typed-scheme/succeed/priority-queue.scm   |  18 ++--
 .../typed-scheme/xfail/priority-queue.scm     | 101 ++++++++++++++++++
 .../typed-scheme/types/remove-intersect.rkt   |   7 +-
 5 files changed, 147 insertions(+), 12 deletions(-)
 create mode 100644 collects/tests/typed-scheme/fail/dead-substruct.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/dead-substructs.rkt
 create mode 100644 collects/tests/typed-scheme/xfail/priority-queue.scm

diff --git a/collects/tests/typed-scheme/fail/dead-substruct.rkt b/collects/tests/typed-scheme/fail/dead-substruct.rkt
new file mode 100644
index 00000000..eed75288
--- /dev/null
+++ b/collects/tests/typed-scheme/fail/dead-substruct.rkt
@@ -0,0 +1,16 @@
+#;
+(exn-pred 1)
+#lang typed/scheme
+
+(define-struct: parent ((x : Integer)))
+(define-struct: (child1 parent) ((y : Integer)))
+(define-struct: (child2 parent) ((y : Float)))
+
+(: f (parent -> Integer))
+(define (f x)
+  (cond [(child1? x) (+ "a" "b")] ; rhs was considered dead code
+        [(child2? x) 2]
+        [else (error "eh?")]))
+
+(f (make-child1 1 2))
+(f (make-child2 1 2.0))
diff --git a/collects/tests/typed-scheme/optimizer/generic/dead-substructs.rkt b/collects/tests/typed-scheme/optimizer/generic/dead-substructs.rkt
new file mode 100644
index 00000000..a01a5e5b
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/dead-substructs.rkt
@@ -0,0 +1,17 @@
+#lang typed/scheme #:optimize
+
+;; originally from nucleic3
+;; cond on substructs, branches were considered dead
+
+(define-struct: parent ((x : Integer)))
+(define-struct: (child1 parent) ((y : Integer)))
+(define-struct: (child2 parent) ((y : Float)))
+
+(: f (parent -> Integer))
+(define (f x)
+  (cond [(child1? x) 1]
+        [(child2? x) 2]
+        [else (error "eh?")]))
+
+(f (make-child1 1 2))
+(f (make-child2 1 2.0))
diff --git a/collects/tests/typed-scheme/succeed/priority-queue.scm b/collects/tests/typed-scheme/succeed/priority-queue.scm
index 091a284d..9454a314 100644
--- a/collects/tests/typed-scheme/succeed/priority-queue.scm
+++ b/collects/tests/typed-scheme/succeed/priority-queue.scm
@@ -65,15 +65,15 @@
 ;; "bug" found - handling of empty heaps
 (pdefine: (a) (find-min [pq : (priority-queue a)]) : a 
 	  (let ([h (heap pq)])
-	    (if (heap:heap-node? h)
-		(elm (heap:find-min h))
-		(error "priority queue empty"))))
+            (if (heap:empty? h)
+                (error "priority queue empty")
+                (elm (heap:find-min h)))))
 
 (pdefine: (a) (find-min-priority [pq : (priority-queue a)]) : number
 	  (let ([h (heap pq)])
-	    (if (heap:heap-node? h)
-		(pri (heap:find-min h))
-		(error "priority queue empty"))))
+	    (if (heap:empty? h)
+		(error "priority queue empty")
+                (pri (heap:find-min h)))))
 
 (pdefine: (a) (insert [x : a] [p : number] [pq : (priority-queue a)]) : (priority-queue a)
 	  (make (heap:insert (cons p x) (heap pq))))
@@ -84,9 +84,9 @@
 
 (pdefine: (a) (delete-min [pq : (priority-queue a)]) : (priority-queue a)
 	  (let ([h (heap pq)])
-	    (if (heap:heap-node? h)
-		(make (heap:delete-min h))
-		(error "priority queue empty"))))
+	    (if (heap:empty? h)
+                (error "priority queue empty")
+		(make (heap:delete-min h)))))
 
 
 (pdefine: (a) (size [pq : (priority-queue a)]) : number
diff --git a/collects/tests/typed-scheme/xfail/priority-queue.scm b/collects/tests/typed-scheme/xfail/priority-queue.scm
new file mode 100644
index 00000000..091a284d
--- /dev/null
+++ b/collects/tests/typed-scheme/xfail/priority-queue.scm
@@ -0,0 +1,101 @@
+#lang typed-scheme
+;;; priority-queue.scm  --  Jens Axel Søgaard
+;;; PURPOSE
+
+; This file implements priority queues on top of
+; a heap library.
+(define-type-alias number Number)
+(define-type-alias boolean Boolean)
+(define-type-alias symbol Symbol)
+(define-type-alias top Any)
+(define-type-alias list-of Listof)
+(require (prefix-in heap: "leftist-heap.ss")
+	 (except-in (lib "67.ss" "srfi") number-compare current-compare =? <?)
+	 (only-in "leftist-heap.ss" comparator))
+(require/typed number-compare (number number -> number) (lib "67.ss" "srfi"))
+(require/typed current-compare (-> (top top -> number)) (lib "67.ss" "srfi"))
+(require/typed =? ((top top -> number) top top -> boolean) (lib "67.ss" "srfi"))
+(require/typed <? ((top top -> number) top top -> boolean) (lib "67.ss" "srfi"))
+
+; a priority-queue is a heap of  (cons <priority> <element>)
+
+(define-type-alias (elem a) (cons number a))
+
+(define-typed-struct (a) priority-queue ([heap : (heap:Heap (elem a))]))
+
+(define-type-alias (pqh a) (heap:Heap (elem a)))
+
+; conveniences
+(pdefine: (a) (heap [pq : (priority-queue a)]) : (pqh a) (priority-queue-heap pq))
+(pdefine: (a) (pri [p : (elem a)]) : number (car p))
+(pdefine: (a) (elm [p : (elem a)]) : a  (cdr p))
+(pdefine: (a) (make [h : (pqh a)]) : (priority-queue a)  (make-priority-queue h))
+
+; sort after priority
+; TODO: and then element?
+(pdefine: (a) (compare [p1 : (elem a)] [p2 : (elem a)]) : number
+	  (number-compare (pri p1) (pri p2)))
+
+;;; OPERATIONS
+
+(define: (num-elems [h : (heap:Heap (cons number number))]) : (list-of (cons number number))
+  (heap:elements h))
+
+(pdefine: (a) (elements [pq : (priority-queue a)]) : (list-of a)
+          (map #{elm :: ((elem a) -> a)} (heap:elements (heap pq))))
+
+(pdefine: (a) (elements+priorities [pq : (priority-queue a)]) : (values (list-of a) (list-of number))
+	  (let: ([eps : (list-of (elem a)) (heap:elements (heap pq))])
+		(values (map #{elm :: ((elem a) -> a)} eps)
+			(map #{pri :: ((elem a) -> number)} eps))))
+
+(pdefine: (a) (empty? [pq : (priority-queue a)]) : boolean
+	  (heap:empty? (heap pq)))
+
+(define: empty : (All (a) (case-lambda (-> (priority-queue a)) (comparator -> (priority-queue a))))
+  (pcase-lambda: (a)
+		 [()    (#{empty @ a} (current-compare))]
+		 [([cmp : comparator]) (make (#{heap:empty :: (case-lambda (-> (pqh a))
+									   (comparator -> (pqh a)))} cmp))]))
+
+(pdefine: (e r) (fold [f : ((cons number e) r -> r)] [b : r] [a : (priority-queue e)]) : r
+	  (heap:fold f b (#{heap :: ((priority-queue e) -> (pqh e))} a)))
+
+
+;; "bug" found - handling of empty heaps
+(pdefine: (a) (find-min [pq : (priority-queue a)]) : a 
+	  (let ([h (heap pq)])
+	    (if (heap:heap-node? h)
+		(elm (heap:find-min h))
+		(error "priority queue empty"))))
+
+(pdefine: (a) (find-min-priority [pq : (priority-queue a)]) : number
+	  (let ([h (heap pq)])
+	    (if (heap:heap-node? h)
+		(pri (heap:find-min h))
+		(error "priority queue empty"))))
+
+(pdefine: (a) (insert [x : a] [p : number] [pq : (priority-queue a)]) : (priority-queue a)
+	  (make (heap:insert (cons p x) (heap pq))))
+
+;; FIXME -- too many annotations needed on cons
+(pdefine: (a) (insert* [xs : (list-of a)] [ps : (list-of number)] [pq : (priority-queue a)]) : (priority-queue a)
+          (make (heap:insert* (map #{cons @ number a} ps xs) (heap pq))))
+
+(pdefine: (a) (delete-min [pq : (priority-queue a)]) : (priority-queue a)
+	  (let ([h (heap pq)])
+	    (if (heap:heap-node? h)
+		(make (heap:delete-min h))
+		(error "priority queue empty"))))
+
+
+(pdefine: (a) (size [pq : (priority-queue a)]) : number
+	  (heap:size (heap pq)))
+
+(pdefine: (a) (union [pq1 : (priority-queue a)] [pq2 : (priority-queue a)]) : (priority-queue a)
+	  (make (heap:union (heap pq1) (heap pq2))))
+
+
+#;(require "signatures/priority-queue-signature.scm")
+#;(provide-priority-queue)
+
diff --git a/collects/typed-scheme/types/remove-intersect.rkt b/collects/typed-scheme/types/remove-intersect.rkt
index 074af5da..64d55e8f 100644
--- a/collects/typed-scheme/types/remove-intersect.rkt
+++ b/collects/typed-scheme/types/remove-intersect.rkt
@@ -24,7 +24,8 @@
          [(list (F: _) _) #t]
          [(list _ (F: _)) #t]
          [(list (Name: n) (Name: n*)) 
-          (overlap (resolve-once t1) (resolve-once t2))]
+          (or (free-identifier=? n n*)
+              (overlap (resolve-once t1) (resolve-once t2)))]
          [(list (? Mu?) _) (overlap (unfold t1) t2)]
          [(list _ (? Mu?)) (overlap t1 (unfold t2))]
          [(list (Union: e) t)
@@ -73,8 +74,8 @@
                 (and t2 (Struct: n* p* flds* _ _ _ _ _)))
           (let ([p1 (if (Name? p) (resolve-name p) p)]
                 [p2 (if (Name? p*) (resolve-name p*) p*)])
-            (or (overlap t1 p2)
-                (overlap t2 p1)
+            (or (and p2 (overlap t1 p2))
+                (and p1 (overlap t2 p1))
                 (and (= (length flds) (length flds*)) 
                      (for/and ([f flds] [f* flds*]) 
                        (match* (f f*)

From 9fea49db55500f9baff0aaffdc155e7cdbf8425b Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 16 Jul 2010 19:46:33 -0400
Subject: [PATCH 004/198] Added optimization for zero?.

original commit: 47195410cbbe7d19ac6e33175fd57bfce6e6c4b3
---
 collects/tests/typed-scheme/optimizer/generic/zero.rkt | 4 ++++
 collects/typed-scheme/optimizer/fixnum.rkt             | 7 ++++++-
 collects/typed-scheme/optimizer/float.rkt              | 7 ++++++-
 3 files changed, 16 insertions(+), 2 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/zero.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/zero.rkt b/collects/tests/typed-scheme/optimizer/generic/zero.rkt
new file mode 100644
index 00000000..dc78943c
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/zero.rkt
@@ -0,0 +1,4 @@
+#lang typed/scheme #:optimize
+(require racket/unsafe/ops)
+(zero? 1)
+(zero? (sqrt 3.0))
diff --git a/collects/typed-scheme/optimizer/fixnum.rkt b/collects/typed-scheme/optimizer/fixnum.rkt
index 8959261e..17044a15 100644
--- a/collects/typed-scheme/optimizer/fixnum.rkt
+++ b/collects/typed-scheme/optimizer/fixnum.rkt
@@ -74,4 +74,9 @@
   (pattern (#%plain-app (~and op (~literal exact->inexact)) n:fixnum-expr)
            #:with opt
            (begin (log-optimization "fixnum to float" #'op)
-                  #'(unsafe-fx->fl n.opt))))
+                  #'(unsafe-fx->fl n.opt)))
+
+  (pattern (#%plain-app (~and op (~literal zero?)) n:fixnum-expr)
+           #:with opt
+           (begin (log-optimization "fixnum zero?" #'op)
+                  #'(unsafe-fx= n.opt 0))))
diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-scheme/optimizer/float.rkt
index 549cc493..9890d7b3 100644
--- a/collects/typed-scheme/optimizer/float.rkt
+++ b/collects/typed-scheme/optimizer/float.rkt
@@ -85,4 +85,9 @@
   (pattern (#%plain-app (~and op (~literal exact->inexact)) f:float-expr)
            #:with opt
            (begin (log-optimization "float to float" #'op)
-                  #'f.opt)))
+                  #'f.opt))
+
+  (pattern (#%plain-app (~and op (~literal zero?)) f:float-expr)
+           #:with opt
+           (begin (log-optimization "float zero?" #'op)
+                  #'(unsafe-fl= f.opt 0.0))))

From 545a02dfe6ba050b45d474e1a282e1794fa77bdb Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 16 Jul 2010 19:55:14 -0400
Subject: [PATCH 005/198] Changed the interface to typed racket's test harness.

original commit: b13075a1c0679ecf20cc6c84224131c45f455399
---
 collects/tests/typed-scheme/run.rkt | 23 ++++++++++++++++-------
 1 file changed, 16 insertions(+), 7 deletions(-)

diff --git a/collects/tests/typed-scheme/run.rkt b/collects/tests/typed-scheme/run.rkt
index 7f40679c..b848d7ae 100644
--- a/collects/tests/typed-scheme/run.rkt
+++ b/collects/tests/typed-scheme/run.rkt
@@ -4,30 +4,39 @@
 (require "main.ss")
 
 (define exec (make-parameter go/text))
-(define the-tests (make-parameter tests))
-(define skip-all? #f)
+(define the-tests (make-parameter #f))
 (define nightly? (make-parameter #f))
+(define unit? (make-parameter #f))
+(define int? (make-parameter #f))
 (define opt? (make-parameter #f))
 (define bench? (make-parameter #f))
 (current-namespace (make-base-namespace))
 (command-line
  #:once-each
- ["--unit" "run just the unit tests" (the-tests unit-tests)]
- ["--int" "run just the integration tests" (the-tests int-tests)]
- ["--nightly" "for the nightly builds" (nightly? #t)]
+ ["--unit" "run the unit tests" (unit? #t)]
+ ["--int" "run the integration tests" (int? #t)]
+ ["--nightly" "for the nightly builds" (begin (nightly? #t) (unit? #t) (int? #t))]
  ["--just" path "run only this test" (the-tests (just-one path))]
  ["--opt" "run the optimizer tests" (opt? #t)]
  ["--benchmarks" "compile the typed benchmarks" (bench? #t)]
+ ["--all" "run all tests" (begin (unit? #t) (int? #t) (opt? #t) (bench? #t))]
  ["--gui" "run using the gui" 
           (if (gui-available?)
               (begin (exec go))
               (error "GUI not available"))]
  )
 
+(the-tests
+ (cond [(and (unit?) (int?)) tests]
+       [(unit?)              unit-tests]
+       [(int?)               int-tests]
+       [else                 #f]))
+
 (cond [(and (nightly?) (eq? 'cgc (system-type 'gc)))
        (printf "Skipping Typed Racket tests.\n")]
-      [(unless (= 0 ((exec) (the-tests)))
-         (eprintf "Typed Racket Tests did not pass."))
+      [(when (the-tests)
+         (unless (= 0 ((exec) (the-tests)))
+           (eprintf "Typed Racket Tests did not pass.")))
        (when (opt?)
          (parameterize ([current-command-line-arguments #()])
            (dynamic-require '(file "optimizer/run.rkt") #f))

From 53f7550b51315dcad8dc29ca727355fa861fb01a Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 19 Jul 2010 11:50:39 -0400
Subject: [PATCH 006/198] Added type signatures for operations on inexact
 complexes and floats.

original commit: a31d7b60c8e6911f7b77c3a6f96af2c37da36b9e
---
 collects/typed-scheme/private/base-env-numeric.rkt | 12 ++++++++----
 1 file changed, 8 insertions(+), 4 deletions(-)

diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt
index b709fbb7..af0a873f 100644
--- a/collects/typed-scheme/private/base-env-numeric.rkt
+++ b/collects/typed-scheme/private/base-env-numeric.rkt
@@ -240,6 +240,8 @@
                   (list (->* (list -Pos) -Flonum -Flonum))
                   (list (->* (list -Flonum) -Pos -Flonum))
                   (list (->* (list) -Real -Real))
+                  (list (->* (list -Flonum) -InexactComplex -InexactComplex))
+                  (list (->* (list -InexactComplex) -Flonum -InexactComplex))
                   (list (->* (list) -InexactComplex -InexactComplex))
                   (list (->* (list) N N))))]
 [+ (apply cl->*
@@ -253,8 +255,8 @@
                   (list (->* (list -Flonum) -Real -Flonum))
                   (list (->* (list -Real -Flonum) -Real -Flonum))
                   (list (->* (list) -Real -Real))
-                  (list (->* (list -Real) -InexactComplex -InexactComplex))
-                  (list (->* (list -InexactComplex) -Real -InexactComplex))
+                  (list (->* (list N) -InexactComplex -InexactComplex))
+                  (list (->* (list -InexactComplex) N -InexactComplex))
                   (list (->* (list) -InexactComplex -InexactComplex))
                   (list (->* (list) N N))))]
 
@@ -264,8 +266,8 @@
                   (list (->* (list -Flonum) -Real -Flonum))
                   (list (->* (list -Real -Flonum) -Real -Flonum))
                   (list (->* (list -Real) -Real -Real))
-                  (list (->* (list -Real) -InexactComplex -InexactComplex))
-                  (list (->* (list -InexactComplex) -Real -InexactComplex))
+                  (list (->* (list N) -InexactComplex -InexactComplex))
+                  (list (->* (list -InexactComplex) N -InexactComplex))
                   (list (->* (list -InexactComplex) -InexactComplex -InexactComplex))
                   (list (->* (list N) N N))))]
 [/ (apply cl->*
@@ -275,6 +277,8 @@
                   ;; only exact 0 as first argument can cause the result of a division involving inexacts to be exact
                   (list (->* (list -Flonum) -Real -Flonum))
                   (list (->* (list -Real) -Real -Real))
+                  (list (->* (list -Flonum) -InexactComplex -InexactComplex))
+                  (list (->* (list -InexactComplex) -Flonum -InexactComplex))
                   (list (->* (list -InexactComplex) -InexactComplex -InexactComplex))
                   (list (->* (list N) N N))))]
 

From 43683352c56a1d07e72cf74ae481a277fb392f50 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 19 Jul 2010 12:26:53 -0400
Subject: [PATCH 007/198] Improved behavior of coercions with n-ary arithmeric
 operations.

original commit: d078305a59368156e0c977798af4cb805bc3b679
---
 .../typed-scheme/private/base-env-numeric.rkt | 26 +++++++------------
 1 file changed, 10 insertions(+), 16 deletions(-)

diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt
index af0a873f..184e8a68 100644
--- a/collects/typed-scheme/private/base-env-numeric.rkt
+++ b/collects/typed-scheme/private/base-env-numeric.rkt
@@ -235,29 +235,24 @@
 
 [* (apply cl->*
           (append (for/list ([t (list -Pos -Nat -Integer -ExactRational -NonnegativeFlonum -Flonum)]) (->* (list) t t))
-                  (list (->* (list -Pos) -NonnegativeFlonum -NonnegativeFlonum))
-                  (list (->* (list -NonnegativeFlonum) -Pos -NonnegativeFlonum))
-                  (list (->* (list -Pos) -Flonum -Flonum))
-                  (list (->* (list -Flonum) -Pos -Flonum))
+                  (list (->* (list) (Un -Pos -NonnegativeFlonum) -NonnegativeFlonum))
+                  (list (->* (list) (Un -Pos -Flonum) -Flonum))
                   (list (->* (list) -Real -Real))
-                  (list (->* (list -Flonum) -InexactComplex -InexactComplex))
-                  (list (->* (list -InexactComplex) -Flonum -InexactComplex))
-                  (list (->* (list) -InexactComplex -InexactComplex))
+                  (list (->* (list) (Un -InexactComplex -Flonum) -InexactComplex))
                   (list (->* (list) N N))))]
 [+ (apply cl->*
           (append (list (->* (list -Pos) -Nat -Pos))
-                  (list (->* (list -Nat) -Pos -Pos))
+                  (list (->* (list -Nat -Pos) -Nat -Pos))
                   (for/list ([t (list -Nat -Integer -ExactRational -NonnegativeFlonum -Flonum)]) (->* (list) t t))
-                  (list (->* (list -Nat) -NonnegativeFlonum -NonnegativeFlonum))
-                  (list (->* (list -NonnegativeFlonum) -Nat -NonnegativeFlonum))
                   ;; special cases for promotion to inexact, not exhaustive
                   ;; valid for + and -, but not for * and /, since (* <float> 0) is exact 0 (i.e. not a float)
+                  (list (->* (list) (Un -Nat -NonnegativeFlonum) -NonnegativeFlonum))
                   (list (->* (list -Flonum) -Real -Flonum))
                   (list (->* (list -Real -Flonum) -Real -Flonum))
                   (list (->* (list) -Real -Real))
-                  (list (->* (list N) -InexactComplex -InexactComplex))
+                  (list (->* (list) (Un -Real -InexactComplex) -InexactComplex))
                   (list (->* (list -InexactComplex) N -InexactComplex))
-                  (list (->* (list) -InexactComplex -InexactComplex))
+                  (list (->* (list N -InexactComplex) N -InexactComplex))
                   (list (->* (list) N N))))]
 
 [- (apply cl->*
@@ -266,9 +261,9 @@
                   (list (->* (list -Flonum) -Real -Flonum))
                   (list (->* (list -Real -Flonum) -Real -Flonum))
                   (list (->* (list -Real) -Real -Real))
-                  (list (->* (list N) -InexactComplex -InexactComplex))
+                  (list (->* (list) (Un -Real -InexactComplex) -InexactComplex))
                   (list (->* (list -InexactComplex) N -InexactComplex))
-                  (list (->* (list -InexactComplex) -InexactComplex -InexactComplex))
+                  (list (->* (list N -InexactComplex) N -InexactComplex))
                   (list (->* (list N) N N))))]
 [/ (apply cl->*
           (append (list (->* (list -Integer) -Integer -ExactRational))
@@ -277,8 +272,7 @@
                   ;; only exact 0 as first argument can cause the result of a division involving inexacts to be exact
                   (list (->* (list -Flonum) -Real -Flonum))
                   (list (->* (list -Real) -Real -Real))
-                  (list (->* (list -Flonum) -InexactComplex -InexactComplex))
-                  (list (->* (list -InexactComplex) -Flonum -InexactComplex))
+                  (list (->* (list (Un -Flonum -InexactComplex)) (Un -Real -InexactComplex) -InexactComplex))
                   (list (->* (list -InexactComplex) -InexactComplex -InexactComplex))
                   (list (->* (list N) N N))))]
 

From 3aae29501e23c0614fecf9b18066f12ed60ab36f Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 19 Jul 2010 15:32:12 -0400
Subject: [PATCH 008/198] Bytes are fixnums.

original commit: c4ae44123f74de07933d1c6edfb25be4609af6dd
---
 collects/typed-scheme/types/abbrev.rkt | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt
index a8203f4e..5ce0ce8a 100644
--- a/collects/typed-scheme/types/abbrev.rkt
+++ b/collects/typed-scheme/types/abbrev.rkt
@@ -176,7 +176,7 @@
 (define -ExactNonnegativeInteger (*Un -ExactPositiveInteger -Zero))
 (define -Nat -ExactNonnegativeInteger)
 
-(define -Byte -Integer)
+(define -Byte -NonnegativeFixnum)
 
 
 

From 245f1e311ca212e58447e2a1c1392cbc360debd6 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 19 Jul 2010 16:09:01 -0400
Subject: [PATCH 009/198] Improved closure properties of bitwise-and.

original commit: 234e8c363cfd90499566ae24b3cb548785a93ff8
---
 collects/typed-scheme/private/base-env-numeric.rkt | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt
index 184e8a68..7805bd08 100644
--- a/collects/typed-scheme/private/base-env-numeric.rkt
+++ b/collects/typed-scheme/private/base-env-numeric.rkt
@@ -338,7 +338,9 @@
                          (-Nat -Nat . -> . -Nat)
                          (-Integer -Integer . -> . -Integer))]
 [bitwise-and (cl->* (null -NonnegativeFixnum . ->* . -NonnegativeFixnum)
+                    ((list -Integer) -NonnegativeFixnum . ->* . -NonnegativeFixnum)
                     (null -Fixnum . ->* . -Fixnum)
+                    ((list -Integer) -Fixnum . ->* . -Fixnum)
                     (null -Nat . ->* . -Nat)
                     (null -Integer . ->* . -Integer))]
 [bitwise-ior (cl->* (null -NonnegativeFixnum . ->* . -NonnegativeFixnum)

From 19f4d785698949b6bf9e4505c83945f06005cafe Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 19 Jul 2010 16:52:30 -0400
Subject: [PATCH 010/198] Added box optimizations.

original commit: d6ce6e664f0bd361207725fb3ea9b2a265f39374
---
 .../typed-scheme/optimizer/generic/box.rkt    |  9 ++++++
 collects/typed-scheme/optimizer/box.rkt       | 29 +++++++++++++++++++
 collects/typed-scheme/optimizer/optimizer.rkt |  3 +-
 collects/typed-scheme/private/base-env.rkt    | 10 ++++++-
 4 files changed, 49 insertions(+), 2 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/box.rkt
 create mode 100644 collects/typed-scheme/optimizer/box.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/box.rkt b/collects/tests/typed-scheme/optimizer/generic/box.rkt
new file mode 100644
index 00000000..aa6695de
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/box.rkt
@@ -0,0 +1,9 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+(: x (Boxof Integer))
+(define x (box 1))
+(unbox x)
+(set-box! x 2)
+(unbox x)
diff --git a/collects/typed-scheme/optimizer/box.rkt b/collects/typed-scheme/optimizer/box.rkt
new file mode 100644
index 00000000..99efba91
--- /dev/null
+++ b/collects/typed-scheme/optimizer/box.rkt
@@ -0,0 +1,29 @@
+#lang scheme/base
+
+(require syntax/parse
+         unstable/match scheme/match
+         "../utils/utils.rkt"
+         (for-template scheme/base scheme/fixnum scheme/unsafe/ops)
+         (rep type-rep)
+         (types abbrev type-table utils subtype)
+         (optimizer utils))
+
+(provide box-opt-expr)
+
+(define-syntax-class box-expr
+  (pattern e:expr
+           #:when (match (type-of #'e)
+                    [(tc-result1: (Box: _)) #t]
+                    [_ #f])
+           #:with opt ((optimize) #'e)))
+
+(define-syntax-class box-op
+  ;; we need the * versions of these unsafe operations to be chaperone-safe
+  (pattern (~literal unbox)    #:with unsafe #'unsafe-unbox*)
+  (pattern (~literal set-box!) #:with unsafe #'unsafe-set-box*!))
+
+(define-syntax-class box-opt-expr
+  (pattern (#%plain-app op:box-op b:box-expr new:expr ...)
+           #:with opt
+           (begin (log-optimization "box" #'op)
+                  #`(op.unsafe b.opt #,@(map (optimize) (syntax->list #'(new ...)))))))
diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt
index 730d6680..d9ad4ab6 100644
--- a/collects/typed-scheme/optimizer/optimizer.rkt
+++ b/collects/typed-scheme/optimizer/optimizer.rkt
@@ -5,7 +5,7 @@
          (for-template scheme/base scheme/flonum scheme/fixnum scheme/unsafe/ops racket/private/for)
          "../utils/utils.rkt"
          (types abbrev type-table utils subtype)
-         (optimizer utils fixnum float inexact-complex vector pair sequence struct dead-code))
+         (optimizer utils fixnum float inexact-complex vector pair sequence box struct dead-code))
 
 (provide optimize-top)
 
@@ -24,6 +24,7 @@
   (pattern e:vector-opt-expr          #:with opt #'e.opt)
   (pattern e:pair-opt-expr            #:with opt #'e.opt)
   (pattern e:sequence-opt-expr        #:with opt #'e.opt)
+  (pattern e:box-opt-expr             #:with opt #'e.opt)
   (pattern e:struct-opt-expr          #:with opt #'e.opt)
   (pattern e:dead-code-opt-expr       #:with opt #'e.opt)
   
diff --git a/collects/typed-scheme/private/base-env.rkt b/collects/typed-scheme/private/base-env.rkt
index 7f865c7a..0ce98a90 100644
--- a/collects/typed-scheme/private/base-env.rkt
+++ b/collects/typed-scheme/private/base-env.rkt
@@ -200,10 +200,18 @@
 [newline (->opt [-Output-Port] -Void)]
 [not (-> Univ B)]
 [box (-poly (a) (a . -> . (-box a)))]
-[unbox (-poly (a) (cl->*                   
+[unbox (-poly (a) (cl->*
                    ((-box a) . -> . a)
                    ((make-BoxTop) . -> . Univ)))]
 [set-box! (-poly (a) ((-box a) a . -> . -Void))]
+[unsafe-unbox (-poly (a) (cl->*
+                          ((-box a) . -> . a)
+                          ((make-BoxTop) . -> . Univ)))]
+[unsafe-set-box! (-poly (a) ((-box a) a . -> . -Void))]
+[unsafe-unbox* (-poly (a) (cl->*
+                           ((-box a) . -> . a)
+                           ((make-BoxTop) . -> . Univ)))]
+[unsafe-set-box*! (-poly (a) ((-box a) a . -> . -Void))]
 [box? (make-pred-ty (make-BoxTop))]
 [cons? (make-pred-ty (-pair Univ Univ))]
 [pair? (make-pred-ty (-pair Univ Univ))]

From 6c0c6b3f65c0e14102537d19218e32f952d41aae Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 19 Jul 2010 17:58:38 -0400
Subject: [PATCH 011/198] Added optimization for string-length and
 bytes-length.

original commit: 4e944f73abc138b7d283020bf5c577fe6ecf6e95
---
 .../optimizer/generic/string-length.rkt       |  6 ++++
 collects/typed-scheme/optimizer/optimizer.rkt |  8 ++++--
 collects/typed-scheme/optimizer/sequence.rkt  | 11 +-------
 collects/typed-scheme/optimizer/string.rkt    | 28 +++++++++++++++++++
 4 files changed, 41 insertions(+), 12 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/string-length.rkt
 create mode 100644 collects/typed-scheme/optimizer/string.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/string-length.rkt b/collects/tests/typed-scheme/optimizer/generic/string-length.rkt
new file mode 100644
index 00000000..30210100
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/string-length.rkt
@@ -0,0 +1,6 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+(string-length "eh")
+(bytes-length #"eh")
diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt
index d9ad4ab6..eae6d01e 100644
--- a/collects/typed-scheme/optimizer/optimizer.rkt
+++ b/collects/typed-scheme/optimizer/optimizer.rkt
@@ -2,10 +2,13 @@
 
 (require syntax/parse 
          syntax/id-table racket/dict
-         (for-template scheme/base scheme/flonum scheme/fixnum scheme/unsafe/ops racket/private/for)
+         (for-template scheme/base
+                       scheme/flonum scheme/fixnum scheme/unsafe/ops
+                       racket/private/for)
          "../utils/utils.rkt"
          (types abbrev type-table utils subtype)
-         (optimizer utils fixnum float inexact-complex vector pair sequence box struct dead-code))
+         (optimizer utils fixnum float inexact-complex vector string
+                    pair sequence box struct dead-code))
 
 (provide optimize-top)
 
@@ -22,6 +25,7 @@
   (pattern e:float-opt-expr           #:with opt #'e.opt)
   (pattern e:inexact-complex-opt-expr #:with opt #'e.opt)
   (pattern e:vector-opt-expr          #:with opt #'e.opt)
+  (pattern e:string-opt-expr          #:with opt #'e.opt)
   (pattern e:pair-opt-expr            #:with opt #'e.opt)
   (pattern e:sequence-opt-expr        #:with opt #'e.opt)
   (pattern e:box-opt-expr             #:with opt #'e.opt)
diff --git a/collects/typed-scheme/optimizer/sequence.rkt b/collects/typed-scheme/optimizer/sequence.rkt
index c1713099..3821e886 100644
--- a/collects/typed-scheme/optimizer/sequence.rkt
+++ b/collects/typed-scheme/optimizer/sequence.rkt
@@ -7,7 +7,7 @@
          "../utils/utils.rkt" "../utils/tc-utils.rkt"
          (rep type-rep)
          (types abbrev type-table utils subtype)
-         (optimizer utils))
+         (optimizer utils string))
 
 (provide sequence-opt-expr)
 
@@ -29,15 +29,6 @@
                     [_ #f])
            #:with opt ((optimize) #'e)))
 
-(define-syntax-class string-expr
-  (pattern e:expr
-           #:when (isoftype? #'e -String)
-           #:with opt ((optimize) #'e)))
-(define-syntax-class bytes-expr
-  (pattern e:expr
-           #:when (isoftype? #'e -Bytes)
-           #:with opt ((optimize) #'e)))
-
 (define-syntax-class sequence-opt-expr
   ;; if we're iterating (with the for macros) over something we know is a list,
   ;; we can generate code that would be similar to if in-list had been used
diff --git a/collects/typed-scheme/optimizer/string.rkt b/collects/typed-scheme/optimizer/string.rkt
new file mode 100644
index 00000000..8f9f019e
--- /dev/null
+++ b/collects/typed-scheme/optimizer/string.rkt
@@ -0,0 +1,28 @@
+#lang scheme/base
+
+(require syntax/parse
+         (for-template scheme/base scheme/flonum scheme/unsafe/ops)
+         "../utils/utils.rkt"
+         (types abbrev type-table utils subtype)
+         (optimizer utils))
+
+(provide string-opt-expr string-expr bytes-expr)
+
+(define-syntax-class string-expr
+  (pattern e:expr
+           #:when (isoftype? #'e -String)
+           #:with opt ((optimize) #'e)))
+(define-syntax-class bytes-expr
+  (pattern e:expr
+           #:when (isoftype? #'e -Bytes)
+           #:with opt ((optimize) #'e)))
+
+(define-syntax-class string-opt-expr
+  (pattern (#%plain-app (~literal string-length) s:string-expr)
+           #:with opt
+           (begin (log-optimization "string" #'op)
+                  #'(unsafe-string-length s.opt)))
+  (pattern (#%plain-app (~literal bytes-length) s:bytes-expr)
+           #:with opt
+           (begin (log-optimization "bytes" #'op)
+                  #'(unsafe-bytes-length s.opt))))

From 9bef09798750adff9f9a0eb77be471c53f3eb6fe Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 20 Jul 2010 18:28:54 -0400
Subject: [PATCH 012/198] Optimizations on one-argument cases of arithmetic
 operations.

original commit: 0ee0886cab6989843a9bef1eb3797657e0f1d0c2
---
 .../optimizer/generic/one-arg-arith.rkt       | 20 +++++++++++++++++++
 collects/typed-scheme/optimizer/fixnum.rkt    |  6 ++++++
 collects/typed-scheme/optimizer/float.rkt     | 17 ++++++++++++----
 collects/typed-scheme/optimizer/number.rkt    | 16 +++++++++++++++
 collects/typed-scheme/optimizer/optimizer.rkt |  3 ++-
 5 files changed, 57 insertions(+), 5 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/one-arg-arith.rkt
 create mode 100644 collects/typed-scheme/optimizer/number.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/one-arg-arith.rkt b/collects/tests/typed-scheme/optimizer/generic/one-arg-arith.rkt
new file mode 100644
index 00000000..990036e4
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/one-arg-arith.rkt
@@ -0,0 +1,20 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+(- 12)
+(- 12.0)
+(/ 4.2)
+
+(+ 1)
+(+ 1.0)
+(+ (expt 2 100))
+(* 1)
+(* 1.0)
+(* (expt 2 100))
+(min 1)
+(min 1.0)
+(min (expt 2 100))
+(max 1)
+(max 1.0)
+(max (expt 2 100))
diff --git a/collects/typed-scheme/optimizer/fixnum.rkt b/collects/typed-scheme/optimizer/fixnum.rkt
index 17044a15..fbe684c1 100644
--- a/collects/typed-scheme/optimizer/fixnum.rkt
+++ b/collects/typed-scheme/optimizer/fixnum.rkt
@@ -71,6 +71,12 @@
            #:with opt
            (begin (log-optimization "binary nonzero fixnum" #'op)
                   #'(op.unsafe n1.opt n2.opt)))
+
+  (pattern (#%plain-app (~and op (~literal -)) f:fixnum-expr)
+           #:with opt
+           (begin (log-optimization "unary fixnum" #'op)
+                  #'(unsafe-fx- 0 f.opt)))
+
   (pattern (#%plain-app (~and op (~literal exact->inexact)) n:fixnum-expr)
            #:with opt
            (begin (log-optimization "fixnum to float" #'op)
diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-scheme/optimizer/float.rkt
index 9890d7b3..b7970212 100644
--- a/collects/typed-scheme/optimizer/float.rkt
+++ b/collects/typed-scheme/optimizer/float.rkt
@@ -68,13 +68,22 @@
            #:with opt
            (begin (log-optimization "binary float" #'op)
                   (n-ary->binary #'op.unsafe #'f1.opt #'f2.opt #'(fs.opt ...))))
-  (pattern (~and res (#%plain-app (~var op (float-op binary-float-comps))
-                                  f1:float-expr
-                                  f2:float-expr
-                                  fs:float-expr ...))
+  (pattern (#%plain-app (~var op (float-op binary-float-comps))
+                        f1:float-expr
+                        f2:float-expr
+                        fs:float-expr ...)
            #:with opt
            (begin (log-optimization "binary float comp" #'op)
                   (n-ary->binary #'op.unsafe #'f1.opt #'f2.opt #'(fs.opt ...))))
+
+  (pattern (#%plain-app (~and op (~literal -)) f:float-expr)
+           #:with opt
+           (begin (log-optimization "unary float" #'op)
+                  #'(unsafe-fl- 0.0 f.opt)))
+  (pattern (#%plain-app (~and op (~literal /)) f:float-expr)
+           #:with opt
+           (begin (log-optimization "unary float" #'op)
+                  #'(unsafe-fl/ 1.0 f.opt)))
   
   ;; we can optimize exact->inexact if we know we're giving it an Integer
   (pattern (#%plain-app (~and op (~literal exact->inexact)) n:int-expr)
diff --git a/collects/typed-scheme/optimizer/number.rkt b/collects/typed-scheme/optimizer/number.rkt
new file mode 100644
index 00000000..81acd094
--- /dev/null
+++ b/collects/typed-scheme/optimizer/number.rkt
@@ -0,0 +1,16 @@
+#lang scheme/base
+
+(require syntax/parse
+         (for-template scheme/base scheme/flonum scheme/unsafe/ops)
+         "../utils/utils.rkt"
+         (optimizer utils))
+
+(provide number-opt-expr)
+
+(define-syntax-class number-opt-expr
+  ;; these cases are all identity
+  (pattern (#%plain-app (~and op (~or (~literal +) (~literal *) (~literal min) (~literal max)))
+                        f:expr)
+           #:with opt
+           (begin (log-optimization "unary number" #'op)
+                  ((optimize) #'f))))
diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt
index eae6d01e..a3a93ea8 100644
--- a/collects/typed-scheme/optimizer/optimizer.rkt
+++ b/collects/typed-scheme/optimizer/optimizer.rkt
@@ -7,7 +7,7 @@
                        racket/private/for)
          "../utils/utils.rkt"
          (types abbrev type-table utils subtype)
-         (optimizer utils fixnum float inexact-complex vector string
+         (optimizer utils number fixnum float inexact-complex vector string
                     pair sequence box struct dead-code))
 
 (provide optimize-top)
@@ -21,6 +21,7 @@
   #:literal-sets (kernel-literals)
 
   ;; interesting cases, where something is optimized
+  (pattern e:number-opt-expr          #:with opt #'e.opt)
   (pattern e:fixnum-opt-expr          #:with opt #'e.opt)
   (pattern e:float-opt-expr           #:with opt #'e.opt)
   (pattern e:inexact-complex-opt-expr #:with opt #'e.opt)

From 69476bba2451d6a18846c3e71eab241b8d95249c Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Fri, 23 Jul 2010 14:10:17 -0400
Subject: [PATCH 013/198] Optimize (apply + (map f l)) to avoid the
 intermediate list.

original commit: 5bb730f72c91f52166009d1e5fbe52a346c91edf
---
 .../optimizer/generic/apply-plus.rkt          |  4 +++
 collects/typed-scheme/optimizer/apply.rkt     | 32 +++++++++++++++++++
 collects/typed-scheme/optimizer/optimizer.rkt | 22 ++++++-------
 collects/typed-scheme/optimizer/utils.rkt     |  4 +--
 4 files changed, 48 insertions(+), 14 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/apply-plus.rkt
 create mode 100644 collects/typed-scheme/optimizer/apply.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/apply-plus.rkt b/collects/tests/typed-scheme/optimizer/generic/apply-plus.rkt
new file mode 100644
index 00000000..800f688e
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/apply-plus.rkt
@@ -0,0 +1,4 @@
+#lang typed/racket #:optimize
+(require racket/unsafe/ops)
+(apply + (map add1 (list 1 2 3)))
+(apply * (map add1 (list 1 2 3)))
diff --git a/collects/typed-scheme/optimizer/apply.rkt b/collects/typed-scheme/optimizer/apply.rkt
new file mode 100644
index 00000000..4fa67d97
--- /dev/null
+++ b/collects/typed-scheme/optimizer/apply.rkt
@@ -0,0 +1,32 @@
+#lang scheme/base
+(require syntax/parse
+         syntax/id-table racket/dict
+         unstable/match scheme/match
+         (for-template scheme/unsafe/ops racket/base (prefix-in k: '#%kernel))
+         (for-syntax racket/base)
+         "../utils/utils.rkt"
+         (rep type-rep)
+         (types abbrev type-table utils subtype)
+         (optimizer utils))
+
+(provide apply-opt-expr)
+
+(define-syntax-class apply-op
+  #:literals (+ *)
+  (pattern + #:with identity #'0)
+  (pattern * #:with identity #'1))
+
+(define-syntax-class apply-opt-expr
+		     #:literals (k:apply map #%plain-app #%app)
+  (pattern (#%plain-app k:apply op:apply-op (#%plain-app map f l))
+           #:with opt
+           (begin (reset-unboxed-gensym)
+           (with-syntax ([(f* lp v lst) (map unboxed-gensym '(f* loop v lst))]
+			 [l ((optimize) #'l)]
+			 [f ((optimize) #'f)])
+	     (log-optimization "apply-map" #'op)
+	     #'(let ([f* f])
+                 (let lp ([v op.identity] [lst l])
+                   (if (null? lst)
+                       v
+                       (lp (op v (f* (unsafe-car lst))) (unsafe-cdr lst)))))))))
diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt
index a3a93ea8..c0f3c08b 100644
--- a/collects/typed-scheme/optimizer/optimizer.rkt
+++ b/collects/typed-scheme/optimizer/optimizer.rkt
@@ -8,7 +8,7 @@
          "../utils/utils.rkt"
          (types abbrev type-table utils subtype)
          (optimizer utils number fixnum float inexact-complex vector string
-                    pair sequence box struct dead-code))
+                    pair sequence box struct dead-code apply))
 
 (provide optimize-top)
 
@@ -21,6 +21,7 @@
   #:literal-sets (kernel-literals)
 
   ;; interesting cases, where something is optimized
+  (pattern e:apply-opt-expr           #:with opt #'e.opt)
   (pattern e:number-opt-expr          #:with opt #'e.opt)
   (pattern e:fixnum-opt-expr          #:with opt #'e.opt)
   (pattern e:float-opt-expr           #:with opt #'e.opt)
@@ -47,9 +48,10 @@
   (pattern (letrec-syntaxes+values stx-bindings ([(ids ...) e-rhs:opt-expr] ...) e-body:opt-expr ...)
            #:with opt #'(letrec-syntaxes+values stx-bindings ([(ids ...) e-rhs.opt] ...) e-body.opt ...))
   (pattern (kw:identifier expr ...)
-           #:when (ormap (lambda (k) (free-identifier=? k #'kw))
-                         (list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app #'#%expression
-                               #'#%variable-reference #'with-continuation-mark))
+           #:when 
+	   (for/or ([k (list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app #'#%expression
+			     #'#%variable-reference #'with-continuation-mark)])
+	     (free-identifier=? k #'kw))
            ;; we don't want to optimize in the cases that don't match the #:when clause
            #:with (expr*:opt-expr ...) #'(expr ...)
            #:with opt #'(kw expr*.opt ...))
@@ -64,12 +66,8 @@
                   (current-output-port))))
     (begin0
       (parameterize ([current-output-port port]
-                     [optimize (lambda (stx)
-                                 (syntax-parse stx #:literal-sets (kernel-literals)
-                                               [e:opt-expr
-                                                (syntax/loc stx e.opt)]))])
+                     [optimize (syntax-parser [e:opt-expr #'e.opt])])
         ((optimize) stx))
-      (if (and *log-optimizations?*
-               *log-optimizatons-to-log-file?*)
-          (close-output-port port)
-          #t))))
+      (when (and *log-optimizations?*
+                 *log-optimizatons-to-log-file?*)
+        (close-output-port port)))))
diff --git a/collects/typed-scheme/optimizer/utils.rkt b/collects/typed-scheme/optimizer/utils.rkt
index 912b0184..088f0fd0 100644
--- a/collects/typed-scheme/optimizer/utils.rkt
+++ b/collects/typed-scheme/optimizer/utils.rkt
@@ -52,9 +52,9 @@
 ;; necessary to have predictable symbols to add in the hand-optimized versions
 ;; of the optimizer tests (which check for equality of expanded code)
 (define *unboxed-gensym-counter* 0)
-(define (unboxed-gensym)
+(define (unboxed-gensym [name 'unboxed-gensym-])
   (set! *unboxed-gensym-counter* (add1 *unboxed-gensym-counter*))
-  (format-unique-id #'here "unboxed-gensym-~a" *unboxed-gensym-counter*))
+  (format-unique-id #'here "~a~a" name *unboxed-gensym-counter*))
 (define (reset-unboxed-gensym)
   (set! *unboxed-gensym-counter* 0))
 

From 2ef2641a4d741c856a4be885f42e83642eb0a3f7 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 22 Jul 2010 17:48:44 -0400
Subject: [PATCH 014/198] Refactoring of the optimizer.

original commit: 0493e6f7623361a289989654d25deac19e552de6
---
 collects/typed-scheme/optimizer/optimizer.rkt | 7 +++----
 1 file changed, 3 insertions(+), 4 deletions(-)

diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt
index c0f3c08b..5f6f6c49 100644
--- a/collects/typed-scheme/optimizer/optimizer.rkt
+++ b/collects/typed-scheme/optimizer/optimizer.rkt
@@ -35,10 +35,9 @@
   (pattern e:dead-code-opt-expr       #:with opt #'e.opt)
   
   ;; boring cases, just recur down
-  (pattern (#%plain-lambda formals e:opt-expr ...)
-           #:with opt #'(#%plain-lambda formals e.opt ...))
-  (pattern (define-values formals e:opt-expr ...)
-           #:with opt #'(define-values formals e.opt ...))
+  (pattern ((~and op (~or (~literal #%plain-lambda) (~literal define-values)))
+            formals e:opt-expr ...)
+           #:with opt #'(op formals e.opt ...))
   (pattern (case-lambda [formals e:opt-expr ...] ...)
            #:with opt #'(case-lambda [formals e.opt ...] ...))
   (pattern (let-values ([ids e-rhs:opt-expr] ...) e-body:opt-expr ...)

From fe68e29caad4b868cf4ab244a48c9009c32e37d0 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 22 Jul 2010 19:23:03 -0400
Subject: [PATCH 015/198] Optimized extracting parts of inexact complexes.

original commit: 063b87697a333b2b8f53e6d2b8a43e8f500e2762
---
 .../optimizer/inexact-complex.rkt             | 137 +++++++++++++-----
 1 file changed, 98 insertions(+), 39 deletions(-)

diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt
index 99ec1c38..2de39867 100644
--- a/collects/typed-scheme/optimizer/inexact-complex.rkt
+++ b/collects/typed-scheme/optimizer/inexact-complex.rkt
@@ -14,6 +14,7 @@
 ;; we keep the real and imaginary parts unboxed as long as we stay within
 ;; complex operations
 (define-syntax-class unboxed-inexact-complex-opt-expr
+  
   (pattern (#%plain-app (~and op (~literal +))
                         c1:unboxed-inexact-complex-opt-expr
                         c2:unboxed-inexact-complex-opt-expr
@@ -23,20 +24,21 @@
            #:with (bindings ...)
            (begin (log-optimization "unboxed binary inexact complex" #'op)
                   #`(#,@(append (syntax->list #'(c1.bindings ... c2.bindings ... cs.bindings ... ...))
-                                (list #`(real-part #,(for/fold ((o #'c1.real-part))
-                                                         ((e (syntax->list #'(c2.real-part cs.real-part ...))))
-                                                       #`(unsafe-fl+ #,o #,e)))
-                                      ;; we can skip the imaginary parts of reals (#f)
-                                      #`(imag-part
-                                         #,(let ((l (filter syntax->datum
-                                                            (syntax->list #'(c1.imag-part c2.imag-part cs.imag-part ...)))))
-                                             (case (length l)
-                                               ((0) #'0.0)
-                                               ((1) (car l))
-                                               (else
-                                                (for/fold ((o (car l)))
-                                                    ((e (cdr l)))
-                                                  #`(unsafe-fl+ #,o #,e)))))))))))
+                                (let ()
+                                   ;; we can skip the real parts of imaginaries (#f) and vice versa
+                                   (define (skip-0s l)
+                                     (let ((l (filter syntax->datum (syntax->list l))))
+                                       (case (length l)
+                                         ((0) #'0.0)
+                                         ((1) (car l))
+                                         (else
+                                          (for/fold ((o (car l)))
+                                              ((e (cdr l)))
+                                            #`(unsafe-fl+ #,o #,e))))))
+                                   (list
+                                    #`(real-part #,(skip-0s #'(c1.real-part c2.real-part cs.real-part ...)))
+                                    #`(imag-part #,(skip-0s #'(c1.imag-part c2.imag-part cs.imag-part ...)))))))))
+  
   (pattern (#%plain-app (~and op (~literal -))
                         c1:unboxed-inexact-complex-opt-expr
                         c2:unboxed-inexact-complex-opt-expr
@@ -46,22 +48,24 @@
            #:with (bindings ...)
            (begin (log-optimization "unboxed binary inexact complex" #'op)
                   #`(#,@(append (syntax->list #'(c1.bindings ... c2.bindings ... cs.bindings ... ...))
-                                (list #`(real-part #,(for/fold ((o #'c1.real-part))
-                                                         ((e (syntax->list #'(c2.real-part cs.real-part ...))))
-                                                       #`(unsafe-fl- #,o #,e)))
-                                      ;; unlike addition, we simply can't skip imaginary parts of reals
-                                      #`(imag-part
-                                         #,(let* ((l1 (map (lambda (x) (if (syntax->datum x) x #'0.0))
-                                                           (syntax->list #'(c1.imag-part c2.imag-part cs.imag-part ...))))
-                                                  ;; but we can skip all but the first 0
-                                                  (l2 (filter (lambda (x) (not (equal? (syntax->datum x) 0.0)))
-                                                              (cdr l1))))
-                                             (case (length l2)
-                                               ((0) (car l1))
-                                               (else
-                                                (for/fold ((o (car l1)))
-                                                    ((e l2))
-                                                  #`(unsafe-fl- #,o #,e)))))))))))
+                                (let ()
+                                  ;; unlike addition, we simply can't skip real parts of imaginaries
+                                  (define (skip-0s l)
+                                    (let* ((l1 (map (lambda (x) (if (syntax->datum x) x #'0.0))
+                                                    (syntax->list l)))
+                                           ;; but we can skip all but the first 0
+                                           (l2 (filter (lambda (x) (not (equal? (syntax->datum x) 0.0)))
+                                                       (cdr l1))))
+                                      (case (length l2)
+                                        ((0) (car l1))
+                                        (else
+                                         (for/fold ((o (car l1)))
+                                             ((e l2))
+                                           #`(unsafe-fl- #,o #,e))))))
+                                  (list
+                                   #`(real-part #,(skip-0s #'(c1.real-part c2.real-part cs.real-part ...)))
+                                   #`(imag-part #,(skip-0s #'(c1.imag-part c2.imag-part cs.imag-part ...)))))))))
+  
   (pattern (#%plain-app (~and op (~literal *))
                         c1:unboxed-inexact-complex-opt-expr
                         c2:unboxed-inexact-complex-opt-expr
@@ -73,12 +77,14 @@
                   #`(c1.bindings ... c2.bindings ... cs.bindings ... ...
                      ;; we want to bind the intermediate results to reuse them
                      ;; the final results are bound to real-part and imag-part
-                     #,@(let ((l (map (lambda (x) (if (syntax->datum x) x #'0.0))
-                                      (syntax->list #'(c1.imag-part c2.imag-part cs.imag-part ...)))))
-                          (let loop ([o1 #'c1.real-part]
-                                     [o2 (car l)]
-                                     [e1 (syntax->list #'(c2.real-part cs.real-part ...))]
-                                     [e2 (cdr l)]
+                     #,@(let ((lr (map (lambda (x) (if (syntax->datum x) x #'0.0))
+                                       (syntax->list #'(c1.real-part c2.real-part cs.real-part ...))))
+                              (li (map (lambda (x) (if (syntax->datum x) x #'0.0))
+                                       (syntax->list #'(c1.imag-part c2.imag-part cs.imag-part ...)))))
+                          (let loop ([o1 (car lr)]
+                                     [o2 (car li)]
+                                     [e1 (cdr lr)]
+                                     [e2 (cdr li)]
                                      [rs (append (map (lambda (x) (unboxed-gensym))
                                                       (syntax->list #'(cs.real-part ...)))
                                                  (list #'real-part))]
@@ -107,13 +113,15 @@
                                                            #`(unsafe-fl- (unsafe-fl* #,o1 #,(car e1))
                                                                          (unsafe-fl* #,o2 #,(car e2))))))
                                              res)))))))))
+  
   (pattern (#%plain-app (~and op (~literal /))
                         c1:unboxed-inexact-complex-opt-expr
                         c2:unboxed-inexact-complex-opt-expr
                         cs:unboxed-inexact-complex-opt-expr ...)
            #:with real-part (unboxed-gensym)
            #:with imag-part (unboxed-gensym)
-           #:with reals (syntax->list #'(c1.real-part c2.real-part cs.real-part ...))
+           #:with reals (map (lambda (x) (if (syntax->datum x) x #'0.0))
+                             (syntax->list #'(c1.real-part c2.real-part cs.real-part ...)))
            #:with imags (map (lambda (x) (if (syntax->datum x) x #'0.0))
                              (syntax->list #'(c1.imag-part c2.imag-part cs.imag-part ...)))
            #:with (bindings ...)
@@ -175,6 +183,7 @@
                                                  (unsafe-fl+ (unsafe-fl* #,(car e1) #,(car e1))
                                                              (unsafe-fl* #,(car e2) #,(car e2))))
                                               res)]))))))))
+
   (pattern (#%plain-app (~and op (~literal conjugate)) c:unboxed-inexact-complex-opt-expr)
            #:with real-part #'c.real-part
            #:with imag-part (unboxed-gensym)
@@ -182,6 +191,32 @@
            (begin (log-optimization "unboxed unary inexact complex" #'op)
                   #`(#,@(append (syntax->list #'(c.bindings ...))
                                 (list #'(imag-part (unsafe-fl- 0.0 c.imag-part)))))))
+
+  (pattern (#%plain-app (~and op (~or (~literal real-part) (~literal unsafe-flreal-part)))
+                        c:unboxed-inexact-complex-opt-expr)
+           #:with real-part #'c.real-part
+           #:with imag-part #f
+           #:with (bindings ...)
+           (begin (log-optimization "unboxed unary inexact complex" #'op)
+                  #'(c.bindings ...)))
+  (pattern (#%plain-app (~and op (~or (~literal imag-part) (~literal unsafe-flimag-part)))
+                        c:unboxed-inexact-complex-opt-expr)
+           #:with real-part #'c.imag-part
+           #:with imag-part #f
+           #:with (bindings ...)
+           (begin (log-optimization "unboxed unary inexact complex" #'op)
+                  #'(c.bindings ...)))
+
+  ;; if we see a variable that's already unboxed, use the unboxed bindings
+  (pattern v:id
+           #:with unboxed-real-part (syntax-property #'v 'unboxed-real-part)
+           #:with unboxed-imag-part (syntax-property #'v 'unboxed-imag-part)
+           #:when (and (syntax-e #'unboxed-real-part) (syntax-e #'unboxed-imag-part))
+           #:with real-part #'unboxed-real-part
+           #:with imag-part #'unboxed-imag-part
+           #:with (bindings ...) #'())
+  
+  ;; else, do the unboxing here  
   (pattern e:expr
            #:when (isoftype? #'e -InexactComplex)
            #:with e* (unboxed-gensym)
@@ -223,7 +258,7 @@
   (pattern (~or (~literal real-part) (~literal flreal-part)) #:with unsafe #'unsafe-flreal-part)
   (pattern (~or (~literal imag-part) (~literal flimag-part)) #:with unsafe #'unsafe-flimag-part))
 
-(define-syntax-class inexact-complex-binary-op
+(define-syntax-class inexact-complex-op
   (pattern (~or (~literal +) (~literal -) (~literal *) (~literal /) (~literal conjugate))))
 
 (define-syntax-class inexact-complex-expr
@@ -232,13 +267,37 @@
            #:with opt ((optimize) #'e)))
 
 (define-syntax-class inexact-complex-opt-expr
+
+  ;; we can optimize taking the real of imag part of an unboxed complex
+  ;; hopefully, the compiler can eliminate unused bindings for the other part if it's not used
+  (pattern (#%plain-app (~and op (~or (~literal real-part) (~literal unsafe-flreal-part)
+                                      (~literal imag-part) (~literal unsafe-flimag-part)))
+                        c:inexact-complex-expr)
+           #:with c*:inexact-complex-arith-opt-expr #'c
+           #:with opt
+           (begin (log-optimization "unboxed inexact complex" #'op)
+                  (reset-unboxed-gensym)
+                  #`(let* (c*.bindings ...)
+                      #,(if (or (free-identifier=? #'op #'real-part)
+                                (free-identifier=? #'op #'unsafe-flreal-part))
+                            #'c*.real-part
+                            #'c*.imag-part))))
+  
   (pattern (#%plain-app op:inexact-complex-unary-op n:inexact-complex-expr)
            #:with opt
            (begin (log-optimization "unary inexact complex" #'op)
                   #'(op.unsafe n.opt)))
-  (pattern (~and exp (#%plain-app op:inexact-complex-binary-op e:expr ...))
+  (pattern e:inexact-complex-arith-opt-expr
+           #:with opt
+           #'e.opt))
+
+(define-syntax-class inexact-complex-arith-opt-expr
+  (pattern (~and exp (#%plain-app op:inexact-complex-op e:expr ...))
            #:when (isoftype? #'exp -InexactComplex)
            #:with exp*:unboxed-inexact-complex-opt-expr #'exp
+           #:with real-part #'exp*.real-part
+           #:with imag-part #'exp*.imag-part
+           #:with (bindings ...) #'(exp*.bindings ...)
            #:with opt
            (begin (log-optimization "unboxed inexact complex" #'exp)
                   (reset-unboxed-gensym)

From eb60ac080abc9c25126dcacb9ec087927f8ebc12 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 23 Jul 2010 16:35:25 -0400
Subject: [PATCH 016/198] let bindings of inexact-complex numbers can be
 replaced by bindings for each of their components.

This allows unboxing of intermediate results that are bound and only
ever used in positions where they would be unboxed.

original commit: 83987fffac7719ab0c35d3df49ea0a7adf4bc9b6
---
 .../optimizer/generic/invalid-unboxed-let.rkt |  12 +++
 .../generic/invalid-unboxed-let2.rkt          |   7 ++
 .../optimizer/generic/unboxed-let.rkt         |   8 ++
 .../optimizer/inexact-complex.rkt             |  18 ++--
 collects/typed-scheme/optimizer/optimizer.rkt |  18 ++--
 .../typed-scheme/optimizer/unboxed-let.rkt    | 100 ++++++++++++++++++
 6 files changed, 149 insertions(+), 14 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let2.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/unboxed-let.rkt
 create mode 100644 collects/typed-scheme/optimizer/unboxed-let.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let.rkt
new file mode 100644
index 00000000..4039f652
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let.rkt
@@ -0,0 +1,12 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+(let ((t1 (+ 1.0+2.0i 2.0+4.0i)) ; can be unboxed
+      (t2 (+ 3.0+6.0i 4.0+8.0i)) ; can't be unboxed
+      (t3 1.0+2.0i) ; can't be unboxed
+      (t4 1))
+  (display (+ t1 t1))
+  (display t2)
+  (display t3)
+  (display t4))
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let2.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let2.rkt
new file mode 100644
index 00000000..f41ef094
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let2.rkt
@@ -0,0 +1,7 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+;; unboxing of let bindings does not currently work with multiple values
+(let-values (((t1 t2) (values (+ 1.0+2.0i 2.0+4.0i) (+ 3.0+6.0i 4.0+8.0i))))
+  (+ t1 t2))
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let.rkt
new file mode 100644
index 00000000..bbdf3f63
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let.rkt
@@ -0,0 +1,8 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+(let* ((t1 (+ 1.0+2.0i 2.0+4.0i))
+       (t2 (- t1 3.0+6.0i))
+       (t3 (- t1 4.0+8.0i)))
+  (+ t2 t3))
diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt
index 2de39867..09586da6 100644
--- a/collects/typed-scheme/optimizer/inexact-complex.rkt
+++ b/collects/typed-scheme/optimizer/inexact-complex.rkt
@@ -1,14 +1,19 @@
 #lang scheme/base
 
-(require syntax/parse
+(require syntax/parse syntax/id-table scheme/dict
          "../utils/utils.rkt"
          (for-template scheme/base scheme/math scheme/flonum scheme/unsafe/ops)
          (types abbrev type-table utils subtype)
          (optimizer utils float fixnum))
 
-(provide inexact-complex-opt-expr)
+(provide inexact-complex-opt-expr inexact-complex-arith-opt-expr
+         unboxed-inexact-complex-opt-expr unboxed-vars-table)
 
 
+;; contains the bindings which actually exist as separate bindings for each component
+;; associates identifiers to lists (real-part imag-part)
+(define unboxed-vars-table (make-free-id-table))
+
 ;; it's faster to take apart a complex number and use unsafe operations on
 ;; its parts than it is to use generic operations
 ;; we keep the real and imaginary parts unboxed as long as we stay within
@@ -209,11 +214,10 @@
 
   ;; if we see a variable that's already unboxed, use the unboxed bindings
   (pattern v:id
-           #:with unboxed-real-part (syntax-property #'v 'unboxed-real-part)
-           #:with unboxed-imag-part (syntax-property #'v 'unboxed-imag-part)
-           #:when (and (syntax-e #'unboxed-real-part) (syntax-e #'unboxed-imag-part))
-           #:with real-part #'unboxed-real-part
-           #:with imag-part #'unboxed-imag-part
+           #:with unboxed-info (dict-ref unboxed-vars-table #'v #f)
+           #:when (syntax->datum #'unboxed-info)
+           #:with real-part (car  (syntax->list #'unboxed-info))
+           #:with imag-part (cadr (syntax->list #'unboxed-info))
            #:with (bindings ...) #'())
   
   ;; else, do the unboxing here  
diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt
index 5f6f6c49..d7ea4dff 100644
--- a/collects/typed-scheme/optimizer/optimizer.rkt
+++ b/collects/typed-scheme/optimizer/optimizer.rkt
@@ -8,7 +8,7 @@
          "../utils/utils.rkt"
          (types abbrev type-table utils subtype)
          (optimizer utils number fixnum float inexact-complex vector string
-                    pair sequence box struct dead-code apply))
+                    pair sequence box struct dead-code apply unboxed-let))
 
 (provide optimize-top)
 
@@ -33,6 +33,7 @@
   (pattern e:box-opt-expr             #:with opt #'e.opt)
   (pattern e:struct-opt-expr          #:with opt #'e.opt)
   (pattern e:dead-code-opt-expr       #:with opt #'e.opt)
+  (pattern e:unboxed-let-opt-expr     #:with opt #'e.opt)
   
   ;; boring cases, just recur down
   (pattern ((~and op (~or (~literal #%plain-lambda) (~literal define-values)))
@@ -40,12 +41,15 @@
            #:with opt #'(op formals e.opt ...))
   (pattern (case-lambda [formals e:opt-expr ...] ...)
            #:with opt #'(case-lambda [formals e.opt ...] ...))
-  (pattern (let-values ([ids e-rhs:opt-expr] ...) e-body:opt-expr ...)
-           #:with opt #'(let-values ([ids e-rhs.opt] ...) e-body.opt ...))
-  (pattern (letrec-values ([ids e-rhs:opt-expr] ...) e-body:opt-expr ...)
-           #:with opt #'(letrec-values ([ids e-rhs.opt] ...) e-body.opt ...))
-  (pattern (letrec-syntaxes+values stx-bindings ([(ids ...) e-rhs:opt-expr] ...) e-body:opt-expr ...)
-           #:with opt #'(letrec-syntaxes+values stx-bindings ([(ids ...) e-rhs.opt] ...) e-body.opt ...))
+  (pattern ((~and op (~or (~literal let-values) (~literal letrec-values)))
+            ([ids e-rhs:opt-expr] ...) e-body:opt-expr ...)
+           #:with opt #'(op ([ids e-rhs.opt] ...) e-body.opt ...))
+  (pattern (letrec-syntaxes+values stx-bindings
+                                   ([(ids ...) e-rhs:opt-expr] ...)
+                                   e-body:opt-expr ...)
+           #:with opt #'(letrec-syntaxes+values stx-bindings
+                                                ([(ids ...) e-rhs.opt] ...)
+                                                e-body.opt ...))
   (pattern (kw:identifier expr ...)
            #:when 
 	   (for/or ([k (list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app #'#%expression
diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
new file mode 100644
index 00000000..40d11cdf
--- /dev/null
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -0,0 +1,100 @@
+#lang scheme/base
+
+(require syntax/parse
+         scheme/list scheme/dict
+         "../utils/utils.rkt"
+         "../utils/tc-utils.rkt"
+         (for-template scheme/base)
+         (types abbrev)
+         (optimizer utils inexact-complex))
+
+(provide unboxed-let-opt-expr)
+
+;; possibly replace bindings of complex numbers by bindings of their 2 components
+;; useful for intermediate results used more than once and for loop variables
+
+(define-syntax-class unboxed-let-opt-expr
+  #:literal-sets (kernel-literals)
+  (pattern (~and exp (let-values (clause:expr ...) body:expr ...))
+           ;; we look for bindings of complexes that are not mutated and only
+           ;; used in positions where we would unbox them
+           ;; these are candidates for unboxing
+           #:with ((candidates ...) (others ...))
+           (let-values
+               (((candidates others)
+                 ;; clauses of form ((v) rhs), currently only suppose 1 lhs var
+                 (partition (lambda (p)
+                              (and (isoftype? (cadr p) -InexactComplex)
+                                   (let ((v (car (syntax-e (car p)))))
+                                     (not (is-var-mutated? v))
+                                     (could-be-unboxed-in? v #'(begin body ...)))))
+                            (map syntax->list (syntax->list #'(clause ...))))))
+             (list candidates others))
+           #:with (opt-candidates:unboxed-let-clause ...) #'(candidates ...)
+           #:with (opt-others:let-clause ...) #'(others ...)
+           #:with opt
+           (begin (log-optimization "unboxed let bindings" #'exp)
+                  ;; add the unboxed bindings to the table, for them to be used by
+                  ;; further optimizations
+                  (for ((v (in-list (syntax->list #'(opt-candidates.id ...))))
+                        (r (in-list (syntax->list #'(opt-candidates.real-part ...))))
+                        (i (in-list (syntax->list #'(opt-candidates.imag-part ...)))))
+                       (dict-set! unboxed-vars-table v (list r i)))
+                  #`(let* (opt-candidates.bindings ... ... opt-others.res ...)
+                      #,@(map (optimize) (syntax->list #'(body ...)))))))
+
+;; if a variable is only used in complex arithmetic operations, it's safe
+;; to unbox it
+(define (could-be-unboxed-in? v exp)
+
+  (define (direct-child-of? exp)
+    (ormap (lambda (x) (and (identifier? x) (free-identifier=? x v)))
+           (syntax->list exp)))
+
+  ;; if v is a direct child of exp, that means it's used in a boxed
+  ;; fashion, and is not safe to unboxed
+  ;; if not, recur on the subforms
+  (define (look-at exp)
+    (and (not (direct-child-of? exp))
+         (andmap rec (syntax->list exp))))
+  
+  (define (rec exp)
+    (syntax-parse exp
+      #:literal-sets (kernel-literals)
+      
+      ;; used within a complex arithmetic expression? safe to unbox
+      [exp:inexact-complex-arith-opt-expr
+       (direct-child-of? #'exp)]
+      
+      ;; recur down
+      [((~and op (~or (~literal #%plain-lambda) (~literal define-values)))
+        formals e:expr ...)
+       (look-at #'(e ...))]
+      [(case-lambda [formals e:expr ...] ...)
+       (look-at #'(e ... ...))]
+      [((~or (~literal let-values) (~literal letrec-values))
+        ([ids e-rhs:expr] ...) e-body:expr ...)
+       (look-at #'(e-rhs ... e-body ...))]
+      [(letrec-syntaxes+values stx-bindings
+                               ([(ids ...) e-rhs:expr] ...)
+                               e-body:expr ...)
+       (look-at #'(e-rhs ... e-body ...))]
+      [(kw:identifier expr ...)
+       #:when (ormap (lambda (k) (free-identifier=? k #'kw))
+                     (list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app #'#%expression
+                           #'#%variable-reference #'with-continuation-mark))
+       (look-at #'(expr ...))]
+            
+      ;; not used, safe to unbox
+      [_ #t]))
+  (rec exp))
+
+(define-syntax-class unboxed-let-clause
+  (pattern ((v:id) rhs:unboxed-inexact-complex-opt-expr)
+           #:with id #'v
+           #:with real-part #'rhs.real-part
+           #:with imag-part #'rhs.imag-part
+           #:with (bindings ...) #'(rhs.bindings ...)))
+(define-syntax-class let-clause ; to turn let-values clauses into let clauses
+  (pattern ((v:id) rhs:expr)
+           #:with res #`(v #,((optimize) #'rhs))))

From e9d9c2aca90d1d974d33ad5cb3cfc9c618b00ea8 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 23 Jul 2010 16:47:30 -0400
Subject: [PATCH 017/198] Added a test to the optimizer.

original commit: ea580e6ff88cb3be758690b99a1968179cbc3c26
---
 collects/tests/typed-scheme/optimizer/generic/let-rhs.rkt | 6 ++++++
 1 file changed, 6 insertions(+)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/let-rhs.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/let-rhs.rkt b/collects/tests/typed-scheme/optimizer/generic/let-rhs.rkt
new file mode 100644
index 00000000..e9f58d5d
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/let-rhs.rkt
@@ -0,0 +1,6 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+(let ((x (+ 1.0 2.0)))
+  x)

From a479e9d5e3fec2052c3e34923d4f58db8d10b36b Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 23 Jul 2010 17:03:02 -0400
Subject: [PATCH 018/198] The optimizer now ignores expressions ignored by the
 typechecker.

original commit: 82b064a520405575ea69e453dfd768ac2df2b17c
---
 collects/typed-scheme/optimizer/optimizer.rkt | 7 ++++++-
 1 file changed, 6 insertions(+), 1 deletion(-)

diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt
index d7ea4dff..f5303671 100644
--- a/collects/typed-scheme/optimizer/optimizer.rkt
+++ b/collects/typed-scheme/optimizer/optimizer.rkt
@@ -69,7 +69,12 @@
                   (current-output-port))))
     (begin0
       (parameterize ([current-output-port port]
-                     [optimize (syntax-parser [e:opt-expr #'e.opt])])
+                     [optimize (syntax-parser
+                                [e:expr
+                                 #:when (not (syntax-property #'e 'typechecker:ignore))
+                                 #:with e*:opt-expr #'e
+                                 #'e*.opt]
+                                [e:expr #'e])])
         ((optimize) stx))
       (when (and *log-optimizations?*
                  *log-optimizatons-to-log-file?*)

From 5c75aa179336f5355273a76e3e254447ed416f40 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 23 Jul 2010 17:03:53 -0400
Subject: [PATCH 019/198] Fixed typo.

original commit: 12ce9abda6916bd590ac76666a6f3db4a63dd2f3
---
 collects/typed-scheme/optimizer/unboxed-let.rkt | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index 40d11cdf..3dbc38ce 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -22,7 +22,7 @@
            #:with ((candidates ...) (others ...))
            (let-values
                (((candidates others)
-                 ;; clauses of form ((v) rhs), currently only suppose 1 lhs var
+                 ;; clauses of form ((v) rhs), currently only supports 1 lhs var
                  (partition (lambda (p)
                               (and (isoftype? (cadr p) -InexactComplex)
                                    (let ((v (car (syntax-e (car p)))))

From 56fde8109f34be0d67812f44f0e66e728ce858ac Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 23 Jul 2010 17:44:53 -0400
Subject: [PATCH 020/198] Fixed unboxing of let bindings.

original commit: 5892ef2fad2c92346cd2871e25846696f3312185
---
 collects/typed-scheme/optimizer/unboxed-let.rkt | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index 3dbc38ce..eeaca1e7 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -62,9 +62,9 @@
     (syntax-parse exp
       #:literal-sets (kernel-literals)
       
-      ;; used within a complex arithmetic expression? safe to unbox
+      ;; can be used in a complex arithmetic expr, can be a direct child
       [exp:inexact-complex-arith-opt-expr
-       (direct-child-of? #'exp)]
+       (andmap rec (syntax->list #'exp))]
       
       ;; recur down
       [((~and op (~or (~literal #%plain-lambda) (~literal define-values)))

From 27fe7f732fd2b0c64b6bf3dcc54b9dc4de909716 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 23 Jul 2010 17:51:36 -0400
Subject: [PATCH 021/198] Fixed a test that could not work because of shadowing
 in hand-optimized code.

original commit: 5d86813267521e3191b91e884418ac39bdb3a8e2
---
 collects/tests/typed-scheme/optimizer/generic/unboxed-let.rkt | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let.rkt
index bbdf3f63..bfa8fff1 100644
--- a/collects/tests/typed-scheme/optimizer/generic/unboxed-let.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let.rkt
@@ -4,5 +4,5 @@
 
 (let* ((t1 (+ 1.0+2.0i 2.0+4.0i))
        (t2 (- t1 3.0+6.0i))
-       (t3 (- t1 4.0+8.0i)))
+       (t3 4.0+8.0i))
   (+ t2 t3))

From ea0d96e9ddc23a0c20a561b7e04587d13d6ac81d Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 23 Jul 2010 18:35:36 -0400
Subject: [PATCH 022/198] The optimizer now ignores code that is inside a
 with-handlers form, since it would be typechecked in an unusual manner.

original commit: 80b6ef7dd19e7d094578ae176442ee3fa8047b96
---
 collects/typed-scheme/optimizer/optimizer.rkt | 44 +++++++++++++------
 1 file changed, 30 insertions(+), 14 deletions(-)

diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt
index f5303671..eb07adcd 100644
--- a/collects/typed-scheme/optimizer/optimizer.rkt
+++ b/collects/typed-scheme/optimizer/optimizer.rkt
@@ -37,27 +37,42 @@
   
   ;; boring cases, just recur down
   (pattern ((~and op (~or (~literal #%plain-lambda) (~literal define-values)))
-            formals e:opt-expr ...)
-           #:with opt #'(op formals e.opt ...))
-  (pattern (case-lambda [formals e:opt-expr ...] ...)
-           #:with opt #'(case-lambda [formals e.opt ...] ...))
+            formals e:expr ...)
+           #:with opt #`(op formals #,@(map (optimize) (syntax->list #'(e ...)))))
+  (pattern (case-lambda [formals e:expr ...] ...)
+           ;; optimize all the bodies
+           #:with (opt-parts ...)
+           (map (lambda (part)
+                  (let ((l (syntax->list part)))
+                    (cons (car l)
+                          (map (optimize) (cdr l)))))
+                (syntax->list #'([formals e ...] ...)))
+           #:with opt #'(case-lambda opt-parts ...))
   (pattern ((~and op (~or (~literal let-values) (~literal letrec-values)))
-            ([ids e-rhs:opt-expr] ...) e-body:opt-expr ...)
-           #:with opt #'(op ([ids e-rhs.opt] ...) e-body.opt ...))
+            ([ids e-rhs:expr] ...) e-body:expr ...)
+           #:with (opt-rhs ...) (map (optimize) (syntax->list #'(e-rhs ...)))
+           #:with opt #`(op ([ids opt-rhs] ...)
+                            #,@(map (optimize) (syntax->list #'(e-body ...)))))
   (pattern (letrec-syntaxes+values stx-bindings
-                                   ([(ids ...) e-rhs:opt-expr] ...)
-                                   e-body:opt-expr ...)
-           #:with opt #'(letrec-syntaxes+values stx-bindings
-                                                ([(ids ...) e-rhs.opt] ...)
-                                                e-body.opt ...))
+                                   ([(ids ...) e-rhs:expr] ...)
+                                   e-body:expr ...)
+           ;; optimize all the rhss
+           #:with (opt-clauses ...)
+           (map (lambda (clause)
+                  (let ((l (syntax->list clause)))
+                    (list (car l) ((optimize) (cadr l)))))
+                (syntax->list #'([(ids ...) e-rhs] ...)))
+           #:with opt #`(letrec-syntaxes+values
+                         stx-bindings
+                         (opt-clauses ...)
+                         #,@(map (optimize) (syntax->list #'(e-body ...)))))
   (pattern (kw:identifier expr ...)
            #:when 
 	   (for/or ([k (list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app #'#%expression
 			     #'#%variable-reference #'with-continuation-mark)])
 	     (free-identifier=? k #'kw))
            ;; we don't want to optimize in the cases that don't match the #:when clause
-           #:with (expr*:opt-expr ...) #'(expr ...)
-           #:with opt #'(kw expr*.opt ...))
+           #:with opt #`(kw #,@(map (optimize) (syntax->list #'(expr ...)))))
   (pattern other:expr
            #:with opt #'other))
 
@@ -71,7 +86,8 @@
       (parameterize ([current-output-port port]
                      [optimize (syntax-parser
                                 [e:expr
-                                 #:when (not (syntax-property #'e 'typechecker:ignore))
+                                 #:when (and (not (syntax-property #'e 'typechecker:ignore))
+                                             (not (syntax-property #'e 'typechecker:with-handlers)))
                                  #:with e*:opt-expr #'e
                                  #'e*.opt]
                                 [e:expr #'e])])

From a248746a2d8d7e1cd1bbdce9352c47ab0cd720ea Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Sat, 24 Jul 2010 17:01:07 -0400
Subject: [PATCH 023/198] Added one more test for unboxed let bindings.

original commit: ec39ea5f3352068497a97c959e72814fab7089d0
---
 .../tests/typed-scheme/optimizer/generic/unboxed-let2.rkt  | 7 +++++++
 1 file changed, 7 insertions(+)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/unboxed-let2.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let2.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let2.rkt
new file mode 100644
index 00000000..f5f8c2a5
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let2.rkt
@@ -0,0 +1,7 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+(let ((t1 (+ 1.0+2.0i 2.0+4.0i))
+      (t2 (+ 3.0+6.0i 4.0+8.0i)))
+  (+ t1 t2))

From 34d7dda8440c77e5cc0cbfe1f760a341b56693c5 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 8 Jul 2010 18:29:02 -0400
Subject: [PATCH 024/198] Added a test for cross-module struct optimization.
 (cherry picked from commit 4e6fc3154bd286d3edcd36a25bfc672cc6a0659d)

original commit: 8f47f0019fae4faf0ea8bb09d7fbd3b3e06254df
---
 .../optimizer/generic/cross-module-struct.rkt         |  5 +++++
 .../optimizer/generic/cross-module-struct2.rkt        |  5 +++++
 collects/tests/typed-scheme/optimizer/run.rkt         | 11 ++++++++---
 3 files changed, 18 insertions(+), 3 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/cross-module-struct.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/cross-module-struct2.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/cross-module-struct.rkt b/collects/tests/typed-scheme/optimizer/generic/cross-module-struct.rkt
new file mode 100644
index 00000000..7b52b214
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/cross-module-struct.rkt
@@ -0,0 +1,5 @@
+#lang typed/scheme #:optimize
+
+;; will be imported by cross-module-struct2
+(provide (struct-out x))
+(define-struct: x ((x : Integer)))
diff --git a/collects/tests/typed-scheme/optimizer/generic/cross-module-struct2.rkt b/collects/tests/typed-scheme/optimizer/generic/cross-module-struct2.rkt
new file mode 100644
index 00000000..45a1696e
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/cross-module-struct2.rkt
@@ -0,0 +1,5 @@
+#lang typed/scheme #:optimize
+
+(require (file "cross-module-struct.rkt") racket/unsafe/ops)
+(define a (make-x 1))
+(x-x a)
diff --git a/collects/tests/typed-scheme/optimizer/run.rkt b/collects/tests/typed-scheme/optimizer/run.rkt
index b4139e25..6edd366d 100644
--- a/collects/tests/typed-scheme/optimizer/run.rkt
+++ b/collects/tests/typed-scheme/optimizer/run.rkt
@@ -15,7 +15,8 @@
    (match-lambda [(list 'define-values-for-syntax '() _ ...) #f] [_ #t])
    (cadddr
     (syntax->datum
-     (parameterize ([current-namespace (make-base-namespace)])
+     (parameterize ([current-namespace (make-base-namespace)]
+                    [read-accept-reader #t])
        (with-handlers
            ([exn:fail? (lambda (exn)
                          (printf "~a\n" (exn-message exn))
@@ -25,8 +26,12 @@
 (define (test gen)
   (let-values (((base name _) (split-path gen)))
     (or (regexp-match ".*~" name) ; we ignore backup files
-        (equal? (read-and-expand gen)
-                (read-and-expand (build-path base "../hand-optimized/" name)))
+        (equal? (parameterize ([current-load-relative-directory
+                                (build-path here "generic")])
+                  (read-and-expand gen))
+                (let ((hand-opt-dir (build-path here "hand-optimized")))
+                  (parameterize ([current-load-relative-directory hand-opt-dir])
+                    (read-and-expand (build-path hand-opt-dir name)))))
         (begin (printf "~a failed\n\n" name)
                #f))))
 

From c625d547cae154236ae49c771fb8adf6a52f2797 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Sun, 25 Jul 2010 22:01:50 -0400
Subject: [PATCH 025/198] Fixed a bug with exact complexes.

original commit: 4803eafa6722acfdf0d37dab3782660d22665b84
---
 .../typed-scheme/optimizer/generic/maybe-exact-complex.rkt  | 5 +++++
 collects/typed-scheme/optimizer/inexact-complex.rkt         | 6 ++++--
 2 files changed, 9 insertions(+), 2 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/maybe-exact-complex.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/maybe-exact-complex.rkt b/collects/tests/typed-scheme/optimizer/generic/maybe-exact-complex.rkt
new file mode 100644
index 00000000..7201c0d4
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/maybe-exact-complex.rkt
@@ -0,0 +1,5 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+(+ 1.0+2.0i 2+4i)
diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt
index 3eeaa32b..b1987878 100644
--- a/collects/typed-scheme/optimizer/inexact-complex.rkt
+++ b/collects/typed-scheme/optimizer/inexact-complex.rkt
@@ -254,11 +254,13 @@
            #`((real-binding (exact->inexact #,((optimize) #'e)))))
   (pattern e:expr
            #:when (isoftype? #'e -Number) ; complex, maybe exact, maybe not
+           #:with e* (unboxed-gensym)
            #:with real-binding (unboxed-gensym)
            #:with imag-binding (unboxed-gensym)
            #:with (bindings ...)
-           #`((real-binding (real-part #,((optimize) #'e)))
-              (imag-binding (imag-part #,((optimize) #'e)))))
+           #`((e* #,((optimize) #'e))
+              (real-binding (exact->inexact (real-part e*)))
+              (imag-binding (exact->inexact (imag-part e*)))))
   (pattern e:expr
            #:with (bindings ...)
            (error "non exhaustive pattern match")

From 277df87ff6d223ae7c07bf8a177c300e91b17b73 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 26 Jul 2010 16:12:46 -0400
Subject: [PATCH 026/198] Added unboxed letrec bindings.

original commit: 8dc23d43eb23eac7a887ae2f3ef3633c54d3ba87
---
 .../typed-scheme/optimizer/generic/nested-unboxed-let.rkt | 7 +++++++
 .../typed-scheme/optimizer/generic/unboxed-letrec.rkt     | 8 ++++++++
 collects/typed-scheme/optimizer/unboxed-let.rkt           | 6 ++++--
 3 files changed, 19 insertions(+), 2 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/nested-unboxed-let.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/unboxed-letrec.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/nested-unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/generic/nested-unboxed-let.rkt
new file mode 100644
index 00000000..c16bdebb
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/nested-unboxed-let.rkt
@@ -0,0 +1,7 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+(let ((x (+ 1.0+2.0i 2.0+3.0i)))
+  (let ((x (+ x 2.0+3.0i)))
+    (+ x 3.0+6.0i)))
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-letrec.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-letrec.rkt
new file mode 100644
index 00000000..aed81a45
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-letrec.rkt
@@ -0,0 +1,8 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+(letrec ((#{f : (Any -> Any)} (lambda: ((x : Any)) (f x)))
+         (#{x : Inexact-Complex} 1.0+2.0i)
+         (#{y : Inexact-Complex} (+ 2.0+4.0i 3.0+6.0i)))
+  (+ x y))
diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index 1f28db63..ceb1c975 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -15,7 +15,8 @@
 
 (define-syntax-class unboxed-let-opt-expr
   #:literal-sets (kernel-literals)
-  (pattern (~and exp (let-values (clause:expr ...) body:expr ...))
+  (pattern (~and exp ((~and op (~or (~literal let-values) (~literal letrec-values)))
+                      (clause:expr ...) body:expr ...))
            ;; we look for bindings of complexes that are not mutated and only
            ;; used in positions where we would unbox them
            ;; these are candidates for unboxing
@@ -40,7 +41,8 @@
                         (r (in-list (syntax->list #'(opt-candidates.real-binding ...))))
                         (i (in-list (syntax->list #'(opt-candidates.imag-binding ...)))))
                        (dict-set! unboxed-vars-table v (list r i)))
-                  #`(let* (opt-candidates.bindings ... ... opt-others.res ...)
+                  #`(#,(if (free-identifier=? #'op #'let-values) #'let* #'letrec)
+                        (opt-candidates.bindings ... ... opt-others.res ...)
                       #,@(map (optimize) (syntax->list #'(body ...)))))))
 
 ;; if a variable is only used in complex arithmetic operations, it's safe

From 28378f77d565c2841230d9b28085f029de51e44c Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 26 Jul 2010 19:11:52 -0400
Subject: [PATCH 027/198] Added unboxed letrec-syntaxes+values bindings.

original commit: b0d299d1b86e2bf07c7715e87ebb303f03bde853
---
 .../unboxed-letrec-syntaxes+values.rkt        |  7 +++
 .../optimizer/inexact-complex.rkt             | 62 +++++++++----------
 .../typed-scheme/optimizer/unboxed-let.rkt    | 21 +++++--
 3 files changed, 53 insertions(+), 37 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/unboxed-letrec-syntaxes+values.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-letrec-syntaxes+values.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-letrec-syntaxes+values.rkt
new file mode 100644
index 00000000..f0923031
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-letrec-syntaxes+values.rkt
@@ -0,0 +1,7 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+(letrec-syntaxes+values (((s) (syntax-rules () [(_ x) x])))
+                        (((x) (+ 1.0+2.0i 2.0+4.0i)))
+                        (+ x 2.0+4.0i))
diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt
index b1987878..499d53e5 100644
--- a/collects/typed-scheme/optimizer/inexact-complex.rkt
+++ b/collects/typed-scheme/optimizer/inexact-complex.rkt
@@ -41,8 +41,8 @@
                                               ((e (cdr l)))
                                             #`(unsafe-fl+ #,o #,e))))))
                                    (list
-                                    #`(real-binding #,(skip-0s #'(c1.real-binding c2.real-binding cs.real-binding ...)))
-                                    #`(imag-binding #,(skip-0s #'(c1.imag-binding c2.imag-binding cs.imag-binding ...)))))))))
+                                    #`((real-binding) #,(skip-0s #'(c1.real-binding c2.real-binding cs.real-binding ...)))
+                                    #`((imag-binding) #,(skip-0s #'(c1.imag-binding c2.imag-binding cs.imag-binding ...)))))))))
   
   (pattern (#%plain-app (~and op (~literal -))
                         c1:unboxed-inexact-complex-opt-expr
@@ -68,8 +68,8 @@
                                              ((e l2))
                                            #`(unsafe-fl- #,o #,e))))))
                                   (list
-                                   #`(real-binding #,(skip-0s #'(c1.real-binding c2.real-binding cs.real-binding ...)))
-                                   #`(imag-binding #,(skip-0s #'(c1.imag-binding c2.imag-binding cs.imag-binding ...)))))))))
+                                   #`((real-binding) #,(skip-0s #'(c1.real-binding c2.real-binding cs.real-binding ...)))
+                                   #`((imag-binding) #,(skip-0s #'(c1.imag-binding c2.imag-binding cs.imag-binding ...)))))))))
   
   (pattern (#%plain-app (~and op (~literal *))
                         c1:unboxed-inexact-complex-opt-expr
@@ -104,14 +104,14 @@
                                       ;; we eliminate operations on the imaginary parts of reals
                                       (let ((o-real? (equal? (syntax->datum o2) 0.0))
                                             (e-real? (equal? (syntax->datum (car e2)) 0.0)))
-                                        (list* #`(#,(car is)
+                                        (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)
+                                               #`((#,(car rs))
                                                   #,(cond ((or o-real? e-real?)
                                                            #`(unsafe-fl* #,o1 #,(car e1)))
                                                           (else
@@ -155,36 +155,36 @@
                                           (e-real? (equal? (syntax->datum (car e2)) 0.0)))
                                       (cond [(and o-real? e-real?)
                                              (list*
-                                              #`(#,(car is) 0.0) ; currently not propagated
-                                              #`(#,(car rs) (unsafe-fl/ #,o1 #,(car e1)))
+                                              #`((#,(car is)) 0.0) ; currently not propagated
+                                              #`((#,(car rs)) (unsafe-fl/ #,o1 #,(car e1)))
                                               res)]
                                             [o-real?
                                              (list*
-                                              #`(#,(car is)
+                                              #`((#,(car is))
                                                  (unsafe-fl/ (unsafe-fl- 0.0
                                                                          (unsafe-fl* #,o1 #,(car e2)))
                                                              #,(car ds)))
-                                              #`(#,(car rs) (unsafe-fl/ (unsafe-fl* #,o1 #,(car e1))
-                                                                        #,(car ds)))
-                                              #`(#,(car ds) (unsafe-fl+ (unsafe-fl* #,(car e1) #,(car e1))
-                                                                        (unsafe-fl* #,(car e2) #,(car e2))))
+                                              #`((#,(car rs)) (unsafe-fl/ (unsafe-fl* #,o1 #,(car e1))
+                                                                          #,(car ds)))
+                                              #`((#,(car ds)) (unsafe-fl+ (unsafe-fl* #,(car e1) #,(car e1))
+                                                                          (unsafe-fl* #,(car e2) #,(car e2))))
                                               res)]
                                             [e-real?
                                              (list*
-                                              #`(#,(car is) (unsafe-fl/ #,o2 #,(car e1)))
-                                              #`(#,(car rs) (unsafe-fl/ #,o1 #,(car e1)))
+                                              #`((#,(car is)) (unsafe-fl/ #,o2 #,(car e1)))
+                                              #`((#,(car rs)) (unsafe-fl/ #,o1 #,(car e1)))
                                               res)]
                                             [else
                                              (list*
-                                              #`(#,(car is)
+                                              #`((#,(car is))
                                                  (unsafe-fl/ (unsafe-fl- (unsafe-fl* #,o2 #,(car e1))
                                                                          (unsafe-fl* #,o1 #,(car e2)))
                                                              #,(car ds)))
-                                              #`(#,(car rs)
+                                              #`((#,(car rs))
                                                  (unsafe-fl/ (unsafe-fl+ (unsafe-fl* #,o1 #,(car e1))
                                                                          (unsafe-fl* #,o2 #,(car e2)))
                                                              #,(car ds)))
-                                              #`(#,(car ds)
+                                              #`((#,(car ds))
                                                  (unsafe-fl+ (unsafe-fl* #,(car e1) #,(car e1))
                                                              (unsafe-fl* #,(car e2) #,(car e2))))
                                               res)]))))))))
@@ -195,7 +195,7 @@
            #:with (bindings ...)
            (begin (log-optimization "unboxed unary inexact complex" #'op)
                   #`(#,@(append (syntax->list #'(c.bindings ...))
-                                (list #'(imag-binding (unsafe-fl- 0.0 c.imag-binding)))))))
+                                (list #'((imag-binding) (unsafe-fl- 0.0 c.imag-binding)))))))
 
   (pattern (#%plain-app (~and op (~or (~literal real-part) (~literal unsafe-flreal-part)))
                         c:unboxed-inexact-complex-opt-expr)
@@ -227,40 +227,40 @@
            #:with real-binding (unboxed-gensym)
            #:with imag-binding (unboxed-gensym)
            #:with (bindings ...)
-           #`((e* #,((optimize) #'e))
-              (real-binding (unsafe-flreal-part e*))
-              (imag-binding (unsafe-flimag-part e*))))
+           #`(((e*) #,((optimize) #'e))
+              ((real-binding) (unsafe-flreal-part e*))
+              ((imag-binding) (unsafe-flimag-part e*))))
   ;; special handling of reals
   (pattern e:float-expr
            #:with real-binding (unboxed-gensym)
            #:with imag-binding #f
            #:with (bindings ...)
-           #`((real-binding #,((optimize) #'e))))
+           #`(((real-binding) #,((optimize) #'e))))
   (pattern e:fixnum-expr
            #:with real-binding (unboxed-gensym)
            #:with imag-binding #f
            #:with (bindings ...)
-           #`((real-binding (unsafe-fx->fl #,((optimize) #'e)))))
+           #`(((real-binding) (unsafe-fx->fl #,((optimize) #'e)))))
   (pattern e:int-expr
            #:with real-binding (unboxed-gensym)
            #:with imag-binding #f
            #:with (bindings ...)
-           #`((real-binding (->fl #,((optimize) #'e)))))
+           #`(((real-binding) (->fl #,((optimize) #'e)))))
   (pattern e:expr
            #:when (isoftype? #'e -Real)
            #:with real-binding (unboxed-gensym)
            #:with imag-binding #f
            #:with (bindings ...)
-           #`((real-binding (exact->inexact #,((optimize) #'e)))))
+           #`(((real-binding) (exact->inexact #,((optimize) #'e)))))
   (pattern e:expr
            #:when (isoftype? #'e -Number) ; complex, maybe exact, maybe not
            #:with e* (unboxed-gensym)
            #:with real-binding (unboxed-gensym)
            #:with imag-binding (unboxed-gensym)
            #:with (bindings ...)
-           #`((e* #,((optimize) #'e))
-              (real-binding (exact->inexact (real-part e*)))
-              (imag-binding (exact->inexact (imag-part e*)))))
+           #`(((e*) #,((optimize) #'e))
+              ((real-binding) (exact->inexact (real-part e*)))
+              ((imag-binding) (exact->inexact (imag-part e*)))))
   (pattern e:expr
            #:with (bindings ...)
            (error "non exhaustive pattern match")
@@ -290,7 +290,7 @@
            #:with opt
            (begin (log-optimization "unboxed inexact complex" #'op)
                   (reset-unboxed-gensym)
-                  #`(let* (c*.bindings ...)
+                  #`(let*-values (c*.bindings ...)
                       #,(if (or (free-identifier=? #'op #'real-part)
                                 (free-identifier=? #'op #'unsafe-flreal-part))
                             #'c*.real-binding
@@ -314,5 +314,5 @@
            #:with opt
            (begin (log-optimization "unboxed inexact complex" #'exp)
                   (reset-unboxed-gensym)
-                  #'(let* (exp*.bindings ...)
+                  #'(let*-values (exp*.bindings ...)
                       (unsafe-make-flrectangular exp*.real-binding exp*.imag-binding)))))
diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index ceb1c975..dfab4bd6 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -15,7 +15,7 @@
 
 (define-syntax-class unboxed-let-opt-expr
   #:literal-sets (kernel-literals)
-  (pattern (~and exp ((~and op (~or (~literal let-values) (~literal letrec-values)))
+  (pattern (~and exp (letk:let-like-keyword
                       (clause:expr ...) body:expr ...))
            ;; we look for bindings of complexes that are not mutated and only
            ;; used in positions where we would unbox them
@@ -32,7 +32,7 @@
                             (map syntax->list (syntax->list #'(clause ...))))))
              (list candidates others))
            #:with (opt-candidates:unboxed-let-clause ...) #'(candidates ...)
-           #:with (opt-others:let-clause ...) #'(others ...)
+           #:with (opt-others:opt-let-values-clause ...) #'(others ...)
            #:with opt
            (begin (log-optimization "unboxed let bindings" #'exp)
                   ;; add the unboxed bindings to the table, for them to be used by
@@ -41,10 +41,19 @@
                         (r (in-list (syntax->list #'(opt-candidates.real-binding ...))))
                         (i (in-list (syntax->list #'(opt-candidates.imag-binding ...)))))
                        (dict-set! unboxed-vars-table v (list r i)))
-                  #`(#,(if (free-identifier=? #'op #'let-values) #'let* #'letrec)
+                  #`(letk.key ...
                         (opt-candidates.bindings ... ... opt-others.res ...)
                       #,@(map (optimize) (syntax->list #'(body ...)))))))
 
+(define-splicing-syntax-class let-like-keyword
+  #:literal-sets (kernel-literals)
+  (pattern (~literal let-values)
+           #:with (key ...) #'(let*-values))
+  (pattern (~literal letrec-values)
+           #:with (key ...) #'(letrec-values))
+  (pattern (~seq (~literal letrec-syntaxes+values) stx-bindings)
+           #:with (key ...) #'(letrec-syntaxes+values stx-bindings)))
+
 ;; if a variable is only used in complex arithmetic operations, it's safe
 ;; to unbox it
 (define (could-be-unboxed-in? v exp)
@@ -97,6 +106,6 @@
            #:with real-binding #'rhs.real-binding
            #:with imag-binding #'rhs.imag-binding
            #:with (bindings ...) #'(rhs.bindings ...)))
-(define-syntax-class let-clause ; to turn let-values clauses into let clauses
-  (pattern ((v:id) rhs:expr)
-           #:with res #`(v #,((optimize) #'rhs))))
+(define-syntax-class opt-let-values-clause
+  (pattern (vs rhs:expr)
+           #:with res #`(vs #,((optimize) #'rhs))))

From ff4a589eee593347120fbb0f0bec8a8cd645cf50 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 27 Jul 2010 12:00:29 -0400
Subject: [PATCH 028/198] Register type of loop lambdas generated by the for
 macros.

original commit: 27f0e50d537ef3adc5c8db94927e6f61b3e89dee
---
 collects/typed-scheme/typecheck/tc-app.rkt | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/collects/typed-scheme/typecheck/tc-app.rkt b/collects/typed-scheme/typecheck/tc-app.rkt
index 8102b6c1..6b59f06d 100644
--- a/collects/typed-scheme/typecheck/tc-app.rkt
+++ b/collects/typed-scheme/typecheck/tc-app.rkt
@@ -565,10 +565,11 @@
        [(tc-result1: t) (tc-error/expr #:return (ret (Un))
                                        "Cannot apply expression of type ~a, since it is not a function type" t)])]
     ;; even more special case for match
-    [(#%plain-app (letrec-values ([(lp) (#%plain-lambda args . body)]) lp*) . actuals)
+    [(#%plain-app (letrec-values ([(lp) (~and lam (#%plain-lambda args . body))]) lp*) . actuals)
      #:fail-unless expected #f 
      #:fail-unless (not (andmap type-annotation (syntax->list #'(lp . args)))) #f
      #:fail-unless (free-identifier=? #'lp #'lp*) #f
+     (add-typeof-expr #'lam expected)
      (let-loop-check form #'lp #'actuals #'args #'body expected)]
     ;; special cases for classes
     [(#%plain-app make-object cl . args)     

From 7bc583e27bbdfff916e63dc8e01933522bebcc51 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 27 Jul 2010 19:46:36 -0400
Subject: [PATCH 029/198] Added an option to see the result of the optimizer
 before compiling.

original commit: 1d758ee78221a87e477e62ab9cca03c816adf49a
---
 collects/typed-scheme/optimizer/optimizer.rkt | 6 +++++-
 collects/typed-scheme/optimizer/utils.rkt     | 5 ++++-
 2 files changed, 9 insertions(+), 2 deletions(-)

diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt
index eb07adcd..3e7b9e73 100644
--- a/collects/typed-scheme/optimizer/optimizer.rkt
+++ b/collects/typed-scheme/optimizer/optimizer.rkt
@@ -2,6 +2,7 @@
 
 (require syntax/parse 
          syntax/id-table racket/dict
+         racket/pretty
          (for-template scheme/base
                        scheme/flonum scheme/fixnum scheme/unsafe/ops
                        racket/private/for)
@@ -91,7 +92,10 @@
                                  #:with e*:opt-expr #'e
                                  #'e*.opt]
                                 [e:expr #'e])])
-        ((optimize) stx))
+        (let ((result ((optimize) stx)))
+          (when *show-optimized-code*
+            (pretty-print (syntax->datum result)))
+          result))
       (when (and *log-optimizations?*
                  *log-optimizatons-to-log-file?*)
         (close-output-port port)))))
diff --git a/collects/typed-scheme/optimizer/utils.rkt b/collects/typed-scheme/optimizer/utils.rkt
index 088f0fd0..dfe0b200 100644
--- a/collects/typed-scheme/optimizer/utils.rkt
+++ b/collects/typed-scheme/optimizer/utils.rkt
@@ -7,7 +7,8 @@
          (types abbrev type-table utils subtype)
          (rep type-rep))
 
-(provide log-optimization *log-optimizations?* *log-optimizatons-to-log-file?* *optimization-log-file*
+(provide log-optimization *log-optimizations?* *log-optimizatons-to-log-file?*
+         *optimization-log-file* *show-optimized-code*
          subtypeof? isoftype?
          mk-unsafe-tbl
          n-ary->binary
@@ -25,6 +26,8 @@
               (syntax->datum stx)
               kind)
       #t))
+;; if set to #t, the optimizer will dump its result to stdout before compilation
+(define *show-optimized-code* #f)
 
 ;; is the syntax object s's type a subtype of t?
 (define (subtypeof? s t)

From f86dd7f384b8f00fca17dd796f2a0b76940972ef Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 27 Jul 2010 20:16:16 -0400
Subject: [PATCH 030/198] Added unboxed arguments to let-bound functions.

original commit: 9d471df8b96be389202d39d5346f37eefb6d6607
---
 .../generic/unboxed-let-functions1.rkt        |   7 +
 .../optimizer/inexact-complex.rkt             |  35 +++-
 .../typed-scheme/optimizer/unboxed-let.rkt    | 170 +++++++++++++++---
 3 files changed, 191 insertions(+), 21 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions1.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions1.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions1.rkt
new file mode 100644
index 00000000..2c3ec851
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions1.rkt
@@ -0,0 +1,7 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+;; simple case, function with single complex arg
+(let ((f (lambda: ((x : Inexact-Complex)) (+ x 3.0+6.0i))))
+  (f (+ 1.0+2.0i 2.0+4.0i)))
diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt
index 499d53e5..def4dde9 100644
--- a/collects/typed-scheme/optimizer/inexact-complex.rkt
+++ b/collects/typed-scheme/optimizer/inexact-complex.rkt
@@ -7,13 +7,23 @@
          (optimizer utils float fixnum))
 
 (provide inexact-complex-opt-expr inexact-complex-arith-opt-expr
-         unboxed-inexact-complex-opt-expr unboxed-vars-table)
+         unboxed-inexact-complex-opt-expr
+         unboxed-vars-table unboxed-funs-table)
 
 
 ;; contains the bindings which actually exist as separate bindings for each component
 ;; associates identifiers to lists (real-binding imag-binding)
 (define unboxed-vars-table (make-free-id-table))
 
+;; associates the names of functions with unboxed args (and whose call sites have to
+;; be modified) to the arguments which can be unboxed and those which have to be boxed
+;; entries in the table are of the form:
+;; ((unboxed ...) (boxed ...))
+;; all these values are indices, since arg names don't make sense for call sites
+;; the new calling convention for these functions have all real parts of unboxed
+;; params first, then all imaginary parts, then all boxed arguments
+(define unboxed-funs-table (make-free-id-table))
+
 ;; it's faster to take apart a complex number and use unsafe operations on
 ;; its parts than it is to use generic operations
 ;; we keep the real and imaginary parts unboxed as long as we stay within
@@ -300,6 +310,29 @@
            #:with opt
            (begin (log-optimization "unary inexact complex" #'op)
                   #'(op.unsafe n.opt)))
+
+  ;; call site of a function with unboxed parameters
+  ;; the calling convention is: real parts of unboxed, imag parts, boxed
+  (pattern (#%plain-app op:id args:expr ...)
+           #:with unboxed-info (dict-ref unboxed-funs-table #'op #f)
+           #:when (syntax->datum #'unboxed-info)
+           #:with ((to-unbox ...) (boxed ...)) #'unboxed-info
+           #:with opt
+           (let ((args    (syntax->list #'(args ...)))
+                 (unboxed (syntax->datum #'(to-unbox ...)))
+                 (boxed   (syntax->datum #'(boxed ...))))
+             (define (get-arg i) (list-ref args i))
+             (syntax-parse (map get-arg unboxed)
+               [(e:unboxed-inexact-complex-opt-expr ...)
+                (log-optimization "unboxed call site" #'op)
+                (reset-unboxed-gensym)
+                #`(let*-values (e.bindings ... ...)
+                    (#%plain-app op
+                                 e.real-binding ...
+                                 e.imag-binding ...
+                                 #,@(map (lambda (i) ((optimize) (get-arg i)))
+                                         boxed)))]))) ; boxed params
+  
   (pattern e:inexact-complex-arith-opt-expr
            #:with opt
            #'e.opt))
diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index dfab4bd6..e6a7a3e5 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -1,11 +1,12 @@
 #lang scheme/base
 
 (require syntax/parse
-         scheme/list scheme/dict
+         scheme/list scheme/dict scheme/match
          "../utils/utils.rkt"
          "../utils/tc-utils.rkt"
          (for-template scheme/base)
-         (types abbrev)
+         (types abbrev utils type-table)
+         (rep type-rep)
          (optimizer utils inexact-complex))
 
 (provide unboxed-let-opt-expr)
@@ -20,19 +21,66 @@
            ;; we look for bindings of complexes that are not mutated and only
            ;; used in positions where we would unbox them
            ;; these are candidates for unboxing
-           #:with ((candidates ...) (others ...))
-           (let-values
-               (((candidates others)
+           #:with ((candidates ...) (function-candidates ...) (others ...))
+           (let*-values
+               (((candidates rest)
                  ;; clauses of form ((v) rhs), currently only supports 1 lhs var
-                 (partition (lambda (p)
-                              (and (isoftype? (cadr p) -InexactComplex)
-                                   (let ((v (car (syntax-e (car p)))))
-                                     (not (is-var-mutated? v))
-                                     (could-be-unboxed-in? v #'(begin body ...)))))
-                            (map syntax->list (syntax->list #'(clause ...))))))
-             (list candidates others))
+                 (partition
+                  (lambda (p)
+                    (and (isoftype? (cadr p) -InexactComplex)
+                         (could-be-unboxed-in? (car (syntax-e (car p)))
+                                               #'(begin body ...))))
+                  (map syntax->list (syntax->list #'(clause ...)))))
+                ((function-candidates others)
+                 ;; extract function bindings that have inexact-complex arguments
+                 ;; we may be able to pass arguments unboxed
+                 ;; this covers loop variables
+                 (partition
+                  (lambda (p)
+                    (let ((fun-name (car (syntax-e (car p)))))
+                      (and (match (type-of (cadr p)) ; rhs, we want a lambda
+                             [(tc-result1: (Function: (list (arr: doms rngs
+                                                                  (and rests #f)
+                                                                  (and drests #f)
+                                                                  (and kws '())))))
+                              ;; at least 1 argument has to be of type inexact-complex
+                              ;; and can be unboxed
+                              (syntax-parse (cadr p)
+                                [(#%plain-lambda params body ...)
+                                 ;; keep track of the param # of each param that can be unboxed
+                                 (let loop ((unboxed '())
+                                            (boxed   '())
+                                            (i        0)
+                                            (params   (syntax->list #'params))
+                                            (doms     doms))
+                                   (cond [(null? params)
+                                          ;; done. can we unbox anything?
+                                          (and (> (length unboxed) 0)
+                                               ;; if so, add to the table of functions with
+                                               ;; unboxed params, so we can modify its call
+                                               ;; sites, it's body and its header
+                                               (dict-set! unboxed-funs-table fun-name
+                                                          (list (reverse unboxed)
+                                                                (reverse boxed))))]
+                                         [(and (equal? (car doms) -InexactComplex)
+                                               (could-be-unboxed-in?
+                                                (car params) #'(begin body ...)))
+                                          ;; we can unbox
+                                          (loop (cons i unboxed) boxed
+                                                (add1 i) (cdr params) (cdr doms))]
+                                         [else ; can't unbox
+                                          (loop unboxed (cons i boxed)
+                                                (add1 i) (cdr params) (cdr doms))]))]
+                                [_ #f])]
+                             [_ #f])
+                           ;; if the function escapes, we can't change it's interface
+                           (and (not (is-var-mutated? fun-name))
+                                (not (escapes? fun-name #'(begin body ...)))))))
+                  rest)))
+             (list candidates function-candidates others))
            #:with (opt-candidates:unboxed-let-clause ...) #'(candidates ...)
-           #:with (opt-others:opt-let-values-clause ...) #'(others ...)
+           #:with (opt-functions:unboxed-fun-clause ...) #'(function-candidates ...)
+           #:with (opt-others:opt-let-clause ...) #'(others ...)
            #:with opt
            (begin (log-optimization "unboxed let bindings" #'exp)
                   ;; add the unboxed bindings to the table, for them to be used by
@@ -42,7 +90,9 @@
                         (i (in-list (syntax->list #'(opt-candidates.imag-binding ...)))))
                        (dict-set! unboxed-vars-table v (list r i)))
                   #`(letk.key ...
-                        (opt-candidates.bindings ... ... opt-others.res ...)
+                        (opt-candidates.bindings ... ...
+                         opt-functions.res ...
+                         opt-others.res ...)
                       #,@(map (optimize) (syntax->list #'(body ...)))))))
 
 (define-splicing-syntax-class let-like-keyword
@@ -54,19 +104,20 @@
   (pattern (~seq (~literal letrec-syntaxes+values) stx-bindings)
            #:with (key ...) #'(letrec-syntaxes+values stx-bindings)))
 
+
+(define (direct-child-of? v exp)
+  (ormap (lambda (x) (and (identifier? x) (free-identifier=? x v)))
+         (syntax->list exp)))
+
 ;; if a variable is only used in complex arithmetic operations, it's safe
 ;; to unbox it
 (define (could-be-unboxed-in? v exp)
 
-  (define (direct-child-of? exp)
-    (ormap (lambda (x) (and (identifier? x) (free-identifier=? x v)))
-           (syntax->list exp)))
-
   ;; if v is a direct child of exp, that means it's used in a boxed
   ;; fashion, and is not safe to unboxed
   ;; if not, recur on the subforms
   (define (look-at exp)
-    (and (not (direct-child-of? exp))
+    (and (not (direct-child-of? v exp))
          (andmap rec (syntax->list exp))))
   
   (define (rec exp)
@@ -98,14 +149,93 @@
             
       ;; not used, safe to unbox
       [_ #t]))
+
+  ;; of course, if the var is mutated, we can't do anything
+  (and (not (is-var-mutated? v))
+       (rec exp)))
+
+;; very simple escape analysis for functions
+;; if a function is ever used in a non-operator position, we consider it escapes
+;; if it doesn't escape, we may be able to pass its inexact complex args unboxed
+(define (escapes? v exp)
+
+  (define (look-at exp)
+    (or (direct-child-of? v exp)
+        (ormap rec (syntax->list exp))))
+
+  (define (rec exp)
+    (syntax-parse exp
+      #:literal-sets (kernel-literals)
+
+      [((~or (~literal #%plain-app) (~literal #%app))
+        rator:expr rands:expr ...)
+       (or (direct-child-of? v #'(rands ...)) ; used as an argument, escapes
+           (ormap rec (syntax->list #'(rator rands ...))))]
+
+      [((~and op (~or (~literal #%plain-lambda) (~literal define-values)))
+        formals e:expr ...)
+       (look-at #'(e ...))]
+      [(case-lambda [formals e:expr ...] ...)
+       (look-at #'(e ... ...))]
+      [((~or (~literal let-values) (~literal letrec-values))
+        ([ids e-rhs:expr] ...) e-body:expr ...)
+       (look-at #'(e-rhs ... e-body ...))]
+      [(letrec-syntaxes+values stx-bindings
+                               ([(ids ...) e-rhs:expr] ...)
+                               e-body:expr ...)
+       (look-at #'(e-rhs ... e-body ...))]
+      [(kw:identifier expr ...)
+       #:when (ormap (lambda (k) (free-identifier=? k #'kw))
+                     (list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app #'#%expression
+                           #'#%variable-reference #'with-continuation-mark))
+       (look-at #'(expr ...))]
+
+      ;; does not escape
+      [_ #f]))
   (rec exp))
 
+;; let clause whose rhs is going to be unboxed (turned into multiple bindings)
 (define-syntax-class unboxed-let-clause
   (pattern ((v:id) rhs:unboxed-inexact-complex-opt-expr)
            #:with id #'v
            #:with real-binding #'rhs.real-binding
            #:with imag-binding #'rhs.imag-binding
            #:with (bindings ...) #'(rhs.bindings ...)))
-(define-syntax-class opt-let-values-clause
+
+;; let clause whose rhs is a function with some inexact complex arguments
+;; these arguments may be unboxed
+;; the new function will have all the unboxed arguments first, then all the boxed
+(define-syntax-class unboxed-fun-clause
+  (pattern ((v:id) (#%plain-lambda params body:expr ...))
+           #:with id #'v
+           #:with unboxed-info (dict-ref unboxed-funs-table #'v #f)
+           #:when (syntax->datum #'unboxed-info)
+           ;; partition of the arguments
+           #:with ((to-unbox ...) (boxed ...)) #'unboxed-info
+           #:with (real-params ...) (map (lambda (x) (unboxed-gensym 'unboxed-real-))
+                                         (syntax->list #'(to-unbox ...)))
+           #:with (imag-params ...) (map (lambda (x) (unboxed-gensym 'unboxed-imag-))
+                                         (syntax->list #'(to-unbox ...)))
+           #:with res
+           (begin
+             ;; add unboxed parameters to the unboxed vars table
+             (let ((to-unbox (map syntax->datum (syntax->list #'(to-unbox ...)))))
+               (let loop ((params     (syntax->list #'params))
+                          (i          0)
+                          (real-parts (syntax->list #'(real-params ...)))
+                          (imag-parts (syntax->list #'(imag-params ...))))
+                 (cond [(null? params)] ; done
+                       [(memq i to-unbox) ; we unbox the current param, add to the table
+                        (dict-set! unboxed-vars-table (car params)
+                                   (list (car real-parts) (car imag-parts)))
+                        (loop (cdr params) (add1 i) (cdr real-parts) (cdr imag-parts))]
+                       [else ; that param stays boxed, keep going
+                        (loop (cdr params) (add1 i) real-parts imag-parts)])))
+             ;; real parts of unboxed parameters go first, then all imag parts, then boxed
+             ;; occurrences of unboxed parameters will be inserted when optimizing the body
+             #`((v) (#%plain-lambda (real-params ... imag-params ... boxed ...)
+                                    #,@(map (optimize) (syntax->list #'(body ...))))))))
+
+(define-syntax-class opt-let-clause
   (pattern (vs rhs:expr)
            #:with res #`(vs #,((optimize) #'rhs))))

From da5586ca57b78167d8d6fa351b7899a9899be4b2 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 27 Jul 2010 21:04:12 -0400
Subject: [PATCH 031/198] Fixed a bug with functions with unboxed complex and
 non-complex args.

original commit: defe96a148227eceaee94c886ac565cf8f253951
---
 .../typed-scheme/optimizer/unboxed-let.rkt    | 24 ++++++++++++-------
 1 file changed, 16 insertions(+), 8 deletions(-)

diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index e6a7a3e5..f4f7948d 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -223,18 +223,26 @@
                (let loop ((params     (syntax->list #'params))
                           (i          0)
                           (real-parts (syntax->list #'(real-params ...)))
-                          (imag-parts (syntax->list #'(imag-params ...))))
-                 (cond [(null? params)] ; done
+                          (imag-parts (syntax->list #'(imag-params ...)))
+                          (boxed      '()))
+                 (cond [(null? params) ; done, create the new clause
+                        ;; real parts of unboxed parameters go first, then all imag
+                        ;; parts, then boxed occurrences of unboxed parameters will
+                        ;; be inserted when optimizing the body
+                        #`((v) (#%plain-lambda
+                                (real-params ... imag-params ... #,@(reverse boxed))
+                                #,@(map (optimize) (syntax->list #'(body ...)))))]
+
                        [(memq i to-unbox) ; we unbox the current param, add to the table
                         (dict-set! unboxed-vars-table (car params)
                                    (list (car real-parts) (car imag-parts)))
-                        (loop (cdr params) (add1 i) (cdr real-parts) (cdr imag-parts))]
+                        (loop (cdr params) (add1 i)
+                              (cdr real-parts) (cdr imag-parts)
+                              boxed)]
                        [else ; that param stays boxed, keep going
-                        (loop (cdr params) (add1 i) real-parts imag-parts)])))
-             ;; real parts of unboxed parameters go first, then all imag parts, then boxed
-             ;; occurrences of unboxed parameters will be inserted when optimizing the body
-             #`((v) (#%plain-lambda (real-params ... imag-params ... boxed ...)
-                                    #,@(map (optimize) (syntax->list #'(body ...))))))))
+                        (loop (cdr params) (add1 i)
+                              real-parts imag-parts
+                              (cons (car params) boxed))]))))))
 
 (define-syntax-class opt-let-clause
   (pattern (vs rhs:expr)

From 7c875c3bb2edb93521ddbde9a0d2912931924ace Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 27 Jul 2010 21:04:55 -0400
Subject: [PATCH 032/198] More tests for unboxed args of let-bound functions.

original commit: bb144249183f8e287a37a1590df5a5aa219862f8
---
 .../optimizer/generic/unboxed-let-functions2.rkt       |  9 +++++++++
 .../optimizer/generic/unboxed-let-functions3.rkt       |  9 +++++++++
 .../optimizer/generic/unboxed-let-functions4.rkt       |  9 +++++++++
 .../optimizer/generic/unboxed-let-functions5.rkt       | 10 ++++++++++
 4 files changed, 37 insertions(+)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions2.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions3.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions4.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions5.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions2.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions2.rkt
new file mode 100644
index 00000000..9c923800
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions2.rkt
@@ -0,0 +1,9 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+;; function with multiple complex args
+(let ((f (lambda: ((x : Inexact-Complex) (y : Inexact-Complex))
+                  (+ x y))))
+  (f (+ 1.0+2.0i 2.0+4.0i)
+     3.0+6.0i))
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions3.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions3.rkt
new file mode 100644
index 00000000..9bc0f44c
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions3.rkt
@@ -0,0 +1,9 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+;; function with a mix of complex and non-complex args
+(let ((f (lambda: ((x : Inexact-Complex) (y : Float))
+                  (+ x y))))
+  (f (+ 1.0+2.0i 2.0+4.0i)
+     3.0))
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions4.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions4.rkt
new file mode 100644
index 00000000..eef46901
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions4.rkt
@@ -0,0 +1,9 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+;; function with a mix of complex and non-complex args, non-complex first
+(let ((f (lambda: ((y : Float) (x : Inexact-Complex))
+                  (+ x y))))
+  (f 3.0
+     (+ 1.0+2.0i 2.0+4.0i)))
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions5.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions5.rkt
new file mode 100644
index 00000000..7b685942
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions5.rkt
@@ -0,0 +1,10 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+;; invalid: f "escapes", according to our analysis
+(letrec: ((f : (Inexact-Complex -> Inexact-Complex)
+             (lambda: ((x : Inexact-Complex))
+                      (let: ((y : (Inexact-Complex -> Inexact-Complex) f))
+                            x))))
+         (f (+ 1.0+2.0i 2.0+4.0i)))

From 0f5db893f58c66b143a6c1f955d3ba38a3df8e59 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 28 Jul 2010 12:31:01 -0400
Subject: [PATCH 033/198] Be more aggressive when unboxing let bindings.

original commit: 3e9e5560bf216a0d555b38ee2cb6cf8a4c5ef908
---
 .../optimizer/generic/unboxed-let3.rkt            | 15 +++++++++++++++
 .../typed-scheme/optimizer/inexact-complex.rkt    | 10 ++++++++++
 collects/typed-scheme/optimizer/unboxed-let.rkt   | 10 +++++-----
 3 files changed, 30 insertions(+), 5 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/unboxed-let3.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let3.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let3.rkt
new file mode 100644
index 00000000..b52e893c
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let3.rkt
@@ -0,0 +1,15 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+;; both boxed and unboxed uses, we unbox anyway
+;; causes unnecessary boxing/unboxing if we take a boxed path when
+;; unboxing a complex literal or variable, but I expect this case
+;; to be uncommon
+;; by comparison, cases where we leave a result unboxed and box it
+;; if needed (like here) or cases where this would unbox loop variables
+;; are likely to be more common, and more interesting
+(let ((x (+ 1.0+2.0i 2.0+4.0i)))
+  (if (even? 2)
+      x
+      (+ x 2.0+4.0i)))
diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt
index def4dde9..95be4637 100644
--- a/collects/typed-scheme/optimizer/inexact-complex.rkt
+++ b/collects/typed-scheme/optimizer/inexact-complex.rkt
@@ -332,6 +332,16 @@
                                  e.imag-binding ...
                                  #,@(map (lambda (i) ((optimize) (get-arg i)))
                                          boxed)))]))) ; boxed params
+
+  ;; unboxed variable used in a boxed fashion, we have to box
+  (pattern v:id
+           #:with unboxed-info (dict-ref unboxed-vars-table #'v #f)
+           #:when (syntax->datum #'unboxed-info)
+           #:with real-binding (car  (syntax->list #'unboxed-info))
+           #:with imag-binding (cadr (syntax->list #'unboxed-info))
+           #:with opt
+           (begin (log-optimization "boxing of an unboxed variable" #'v)
+                  #'(unsafe-make-flrectangular real-binding imag-binding)))
   
   (pattern e:inexact-complex-arith-opt-expr
            #:with opt
diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index f4f7948d..a5a0369b 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -109,16 +109,15 @@
   (ormap (lambda (x) (and (identifier? x) (free-identifier=? x v)))
          (syntax->list exp)))
 
-;; if a variable is only used in complex arithmetic operations, it's safe
-;; to unbox it
+;; if a variable is used at least once in complex arithmetic operations,
+;; it's worth unboxing
 (define (could-be-unboxed-in? v exp)
 
   ;; if v is a direct child of exp, that means it's used in a boxed
   ;; fashion, and is not safe to unboxed
   ;; if not, recur on the subforms
   (define (look-at exp)
-    (and (not (direct-child-of? v exp))
-         (andmap rec (syntax->list exp))))
+    (ormap rec (syntax->list exp)))
   
   (define (rec exp)
     (syntax-parse exp
@@ -126,7 +125,8 @@
       
       ;; can be used in a complex arithmetic expr, can be a direct child
       [exp:inexact-complex-arith-opt-expr
-       (andmap rec (syntax->list #'exp))]
+       (or (direct-child-of? v #'exp)
+           (ormap rec (syntax->list #'exp)))]
       
       ;; recur down
       [((~and op (~or (~literal #%plain-lambda) (~literal define-values)))

From c631cec4d8db3ad7c7d09ac23c3045f80a755739 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 28 Jul 2010 12:39:50 -0400
Subject: [PATCH 034/198] Fix for escaping functions.

original commit: eed20f7c3a8a459dedc8798777ff3df71f2cfb2b
---
 .../typed-scheme/optimizer/unboxed-let.rkt    | 77 ++++++++++---------
 1 file changed, 39 insertions(+), 38 deletions(-)

diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index a5a0369b..00dc8742 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -38,44 +38,45 @@
                  (partition
                   (lambda (p)
                     (let ((fun-name (car (syntax-e (car p)))))
-                      (and (match (type-of (cadr p)) ; rhs, we want a lambda
-                             [(tc-result1: (Function: (list (arr: doms rngs
-                                                                  (and rests #f)
-                                                                  (and drests #f)
-                                                                  (and kws '())))))
-                              ;; at least 1 argument has to be of type inexact-complex
-                              ;; and can be unboxed
-                              (syntax-parse (cadr p)
-                                [(#%plain-lambda params body ...)
-                                 ;; keep track of the param # of each param that can be unboxed
-                                 (let loop ((unboxed '())
-                                            (boxed   '())
-                                            (i        0)
-                                            (params   (syntax->list #'params))
-                                            (doms     doms))
-                                   (cond [(null? params)
-                                          ;; done. can we unbox anything?
-                                          (and (> (length unboxed) 0)
-                                               ;; if so, add to the table of functions with
-                                               ;; unboxed params, so we can modify its call
-                                               ;; sites, it's body and its header
-                                               (dict-set! unboxed-funs-table fun-name
-                                                          (list (reverse unboxed)
-                                                                (reverse boxed))))]
-                                         [(and (equal? (car doms) -InexactComplex)
-                                               (could-be-unboxed-in?
-                                                (car params) #'(begin body ...)))
-                                          ;; we can unbox
-                                          (loop (cons i unboxed) boxed
-                                                (add1 i) (cdr params) (cdr doms))]
-                                         [else ; can't unbox
-                                          (loop unboxed (cons i boxed)
-                                                (add1 i) (cdr params) (cdr doms))]))]
-                                [_ #f])]
-                             [_ #f])
-                           ;; if the function escapes, we can't change it's interface
-                           (and (not (is-var-mutated? fun-name))
-                                (not (escapes? fun-name #'(begin body ...)))))))
+                      (and
+                       ;; if the function escapes, we can't change it's interface
+                       (and (not (is-var-mutated? fun-name))
+                            (not (escapes? fun-name #'(begin body ...))))
+                       (match (type-of (cadr p)) ; rhs, we want a lambda
+                         [(tc-result1: (Function: (list (arr: doms rngs
+                                                              (and rests #f)
+                                                              (and drests #f)
+                                                              (and kws '())))))
+                          ;; at least 1 argument has to be of type inexact-complex
+                          ;; and can be unboxed
+                          (syntax-parse (cadr p)
+                            [(#%plain-lambda params body ...)
+                             ;; keep track of the param # of each param that can be unboxed
+                             (let loop ((unboxed '())
+                                        (boxed   '())
+                                        (i        0)
+                                        (params   (syntax->list #'params))
+                                        (doms     doms))
+                               (cond [(null? params)
+                                      ;; done. can we unbox anything?
+                                      (and (> (length unboxed) 0)
+                                           ;; if so, add to the table of functions with
+                                           ;; unboxed params, so we can modify its call
+                                           ;; sites, it's body and its header
+                                           (dict-set! unboxed-funs-table fun-name
+                                                      (list (reverse unboxed)
+                                                            (reverse boxed))))]
+                                     [(and (equal? (car doms) -InexactComplex)
+                                           (could-be-unboxed-in?
+                                            (car params) #'(begin body ...)))
+                                      ;; we can unbox
+                                      (loop (cons i unboxed) boxed
+                                            (add1 i) (cdr params) (cdr doms))]
+                                     [else ; can't unbox
+                                      (loop unboxed (cons i boxed)
+                                            (add1 i) (cdr params) (cdr doms))]))]
+                            [_ #f])]
+                         [_ #f]))))
                   rest)))
              (list candidates function-candidates others))
            #:with (opt-candidates:unboxed-let-clause ...) #'(candidates ...)

From 1b054179b6fc554355ec59f9a5cb91a273ddfaed Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 28 Jul 2010 18:59:40 -0400
Subject: [PATCH 035/198] Changed optimization order, to avoid potential
 conflicts.

original commit: 29b9eb389d8e5ee68c922e18d67e75fe6eaa607d
---
 collects/typed-scheme/optimizer/optimizer.rkt | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt
index 3e7b9e73..4ac752a8 100644
--- a/collects/typed-scheme/optimizer/optimizer.rkt
+++ b/collects/typed-scheme/optimizer/optimizer.rkt
@@ -22,6 +22,8 @@
   #:literal-sets (kernel-literals)
 
   ;; interesting cases, where something is optimized
+  (pattern e:dead-code-opt-expr       #:with opt #'e.opt)
+  (pattern e:unboxed-let-opt-expr     #:with opt #'e.opt)
   (pattern e:apply-opt-expr           #:with opt #'e.opt)
   (pattern e:number-opt-expr          #:with opt #'e.opt)
   (pattern e:fixnum-opt-expr          #:with opt #'e.opt)
@@ -33,8 +35,6 @@
   (pattern e:sequence-opt-expr        #:with opt #'e.opt)
   (pattern e:box-opt-expr             #:with opt #'e.opt)
   (pattern e:struct-opt-expr          #:with opt #'e.opt)
-  (pattern e:dead-code-opt-expr       #:with opt #'e.opt)
-  (pattern e:unboxed-let-opt-expr     #:with opt #'e.opt)
   
   ;; boring cases, just recur down
   (pattern ((~and op (~or (~literal #%plain-lambda) (~literal define-values)))

From 425ec70787dd437bbb896aaa01ed30d5214ef15b Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 28 Jul 2010 19:01:43 -0400
Subject: [PATCH 036/198] Refactoring of the call-site correction code.

original commit: 4633a2a30aef91dd7d10445d1a445c75be08fe1b
---
 .../optimizer/inexact-complex.rkt             | 51 ++++++++++++-------
 1 file changed, 32 insertions(+), 19 deletions(-)

diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt
index 95be4637..0526c42e 100644
--- a/collects/typed-scheme/optimizer/inexact-complex.rkt
+++ b/collects/typed-scheme/optimizer/inexact-complex.rkt
@@ -6,8 +6,10 @@
          (types abbrev type-table utils subtype)
          (optimizer utils float fixnum))
 
-(provide inexact-complex-opt-expr inexact-complex-arith-opt-expr
+(provide inexact-complex-opt-expr
+         inexact-complex-arith-opt-expr
          unboxed-inexact-complex-opt-expr
+         inexact-complex-call-site-opt-expr
          unboxed-vars-table unboxed-funs-table)
 
 
@@ -311,27 +313,14 @@
            (begin (log-optimization "unary inexact complex" #'op)
                   #'(op.unsafe n.opt)))
 
-  ;; call site of a function with unboxed parameters
-  ;; the calling convention is: real parts of unboxed, imag parts, boxed
-  (pattern (#%plain-app op:id args:expr ...)
+  (pattern (~and e (#%plain-app op:id args:expr ...))
            #:with unboxed-info (dict-ref unboxed-funs-table #'op #f)
            #:when (syntax->datum #'unboxed-info)
-           #:with ((to-unbox ...) (boxed ...)) #'unboxed-info
+           #:with (~var e* (inexact-complex-call-site-opt-expr
+                            #'unboxed-info #'op)) ; no need to optimize op
+           #'e
            #:with opt
-           (let ((args    (syntax->list #'(args ...)))
-                 (unboxed (syntax->datum #'(to-unbox ...)))
-                 (boxed   (syntax->datum #'(boxed ...))))
-             (define (get-arg i) (list-ref args i))
-             (syntax-parse (map get-arg unboxed)
-               [(e:unboxed-inexact-complex-opt-expr ...)
-                (log-optimization "unboxed call site" #'op)
-                (reset-unboxed-gensym)
-                #`(let*-values (e.bindings ... ...)
-                    (#%plain-app op
-                                 e.real-binding ...
-                                 e.imag-binding ...
-                                 #,@(map (lambda (i) ((optimize) (get-arg i)))
-                                         boxed)))]))) ; boxed params
+           #'e*.opt)
 
   ;; unboxed variable used in a boxed fashion, we have to box
   (pattern v:id
@@ -359,3 +348,27 @@
                   (reset-unboxed-gensym)
                   #'(let*-values (exp*.bindings ...)
                       (unsafe-make-flrectangular exp*.real-binding exp*.imag-binding)))))
+
+;; takes as argument a structure describing which arguments will be unboxed
+;; and the optimized version of the operator. operators are optimized elsewhere
+;; to benefit from local information
+(define-syntax-class (inexact-complex-call-site-opt-expr unboxed-info opt-operator)
+  ;; call site of a function with unboxed parameters
+  ;; the calling convention is: real parts of unboxed, imag parts, boxed
+  (pattern (#%plain-app op:expr args:expr ...)
+           #:with ((to-unbox ...) (boxed ...)) unboxed-info
+           #:with opt
+           (let ((args    (syntax->list #'(args ...)))
+                 (unboxed (syntax->datum #'(to-unbox ...)))
+                 (boxed   (syntax->datum #'(boxed ...))))
+             (define (get-arg i) (list-ref args i))
+             (syntax-parse (map get-arg unboxed)
+               [(e:unboxed-inexact-complex-opt-expr ...)
+                (log-optimization "unboxed call site" #'op)
+                (reset-unboxed-gensym)
+                #`(let*-values (e.bindings ... ...)
+                    (#%plain-app #,opt-operator
+                                 e.real-binding ...
+                                 e.imag-binding ...
+                                 #,@(map (lambda (i) ((optimize) (get-arg i)))
+                                         boxed)))])))) ; boxed params

From a2e41f4588662552e82a89571bbb286b91bfea1e Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 28 Jul 2010 19:06:23 -0400
Subject: [PATCH 037/198] Fixed a bug in the complex use-site analysis.

original commit: 855928eb7b446d7c7eb741afe8f3a6e632f95141
---
 collects/typed-scheme/optimizer/unboxed-let.rkt | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index 00dc8742..00a2c5ae 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -148,8 +148,8 @@
                            #'#%variable-reference #'with-continuation-mark))
        (look-at #'(expr ...))]
             
-      ;; not used, safe to unbox
-      [_ #t]))
+      ;; not used, not worth unboxing
+      [_ #f]))
 
   ;; of course, if the var is mutated, we can't do anything
   (and (not (is-var-mutated? v))

From 0edccc7db9f3b4d50064ab42b4df09ec6b5fd736 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 28 Jul 2010 19:07:10 -0400
Subject: [PATCH 038/198] Extended unboxing of let-bound functions to support
 let loops.

original commit: f08456cf0708483f267fba86e10f52c318d0dedd
---
 .../generic/unboxed-let-functions6.rkt        | 10 ++++
 .../generic/unboxed-let-functions7.rkt        | 10 ++++
 .../typed-scheme/optimizer/unboxed-let.rkt    | 52 +++++++++++++++++--
 3 files changed, 67 insertions(+), 5 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions6.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions7.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions6.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions6.rkt
new file mode 100644
index 00000000..b50c6e86
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions6.rkt
@@ -0,0 +1,10 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops racket/flonum)
+
+(let: loop : Inexact-Complex ((z : Inexact-Complex 0.0+0.0i)
+                              (l : (Listof Integer) '(1 2 3)))
+      (if (null? l)
+          (+ z 0.0+1.0i)
+          (loop (+ z (car l))
+                (cdr l))))
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions7.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions7.rkt
new file mode 100644
index 00000000..792b46a5
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions7.rkt
@@ -0,0 +1,10 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops racket/flonum)
+
+(let: loop : Inexact-Complex ((z : Inexact-Complex 0.0+0.0i)
+                              (l : (Listof Integer) '(1 2 3)))
+  (if (null? l)
+      z ; boxed use. z should be unboxed anyway
+      (loop (+ z (car l))
+            (cdr l))))
diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index 00a2c5ae..4233a566 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -13,8 +13,37 @@
 
 ;; possibly replace bindings of complex numbers by bindings of their 2 components
 ;; useful for intermediate results used more than once and for loop variables
-
 (define-syntax-class unboxed-let-opt-expr
+  (pattern e:app-of-unboxed-let-opt-expr
+           #:with opt #'e.opt)
+  (pattern (~var e (unboxed-let-opt-expr-internal #f))
+           #:with opt #'e.opt))
+
+;; let loops expand to an application of a letrec-values
+;; thus, the loop function technically escapes from the letrec, but it
+;; escapes in the operator position of a call site we control (here)
+;; we can extend unboxing
+(define-syntax-class app-of-unboxed-let-opt-expr
+  #:literal-sets (kernel-literals)
+  (pattern (~and e ((~literal #%plain-app)
+                    (~and let-e
+                          ((~literal letrec-values)
+                           bindings
+                           loop-fun:id)) ; sole element of the body
+                    args:expr ...))
+           #:with (~var operator (unboxed-let-opt-expr-internal #t)) #'let-e
+           #:with unboxed-info (dict-ref unboxed-funs-table #'loop-fun #f)
+           #:when (syntax->datum #'unboxed-info)
+           #:with (~var e* (inexact-complex-call-site-opt-expr
+                            #'unboxed-info #'operator.opt))
+           #'e
+           #:with opt
+           #'e*.opt))
+
+;; does the bulk of the work
+;; detects which let bindings can be unboxed, same for arguments of let-bound
+;; functions
+(define-syntax-class (unboxed-let-opt-expr-internal let-loop?)
   #:literal-sets (kernel-literals)
   (pattern (~and exp (letk:let-like-keyword
                       (clause:expr ...) body:expr ...))
@@ -40,8 +69,8 @@
                     (let ((fun-name (car (syntax-e (car p)))))
                       (and
                        ;; if the function escapes, we can't change it's interface
-                       (and (not (is-var-mutated? fun-name))
-                            (not (escapes? fun-name #'(begin body ...))))
+                       (not (is-var-mutated? fun-name))
+                       (not (escapes? fun-name #'(begin body ...) let-loop?))
                        (match (type-of (cadr p)) ; rhs, we want a lambda
                          [(tc-result1: (Function: (list (arr: doms rngs
                                                               (and rests #f)
@@ -158,7 +187,10 @@
 ;; very simple escape analysis for functions
 ;; if a function is ever used in a non-operator position, we consider it escapes
 ;; if it doesn't escape, we may be able to pass its inexact complex args unboxed
-(define (escapes? v exp)
+;; if we are in a let loop, don't consider functions that escape by being the
+;; sole thing in the let's body as escaping, since they would only escape to
+;; a call site that we control, which is fine
+(define (escapes? v exp let-loop?)
 
   (define (look-at exp)
     (or (direct-child-of? v exp)
@@ -193,7 +225,17 @@
 
       ;; does not escape
       [_ #f]))
-  (rec exp))
+
+  ;; if the given var is the _only_ element of the body and we're in a
+  ;; let loop, we let it slide
+  (and (not (and let-loop?
+                 (syntax-parse exp
+                   #:literal-sets (kernel-literals)
+                   ;; the body gets wrapped in a begin before it's sent here
+                   [(begin i:identifier)
+                    (free-identifier=? #'i v)]
+                   [_ #f])))
+       (rec exp)))
 
 ;; let clause whose rhs is going to be unboxed (turned into multiple bindings)
 (define-syntax-class unboxed-let-clause

From 851401b25be1ea25f6cc48d9f656a340023bd36e Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 29 Jul 2010 11:50:40 -0400
Subject: [PATCH 039/198] Fixed a bug that caused the let optimizations to
 choke on TR-introduced code.

original commit: b58461da2dc2fd495e555e24ffd1abddca3a25b3
---
 .../typed-scheme/optimizer/unboxed-let.rkt    | 84 ++++++++++---------
 1 file changed, 44 insertions(+), 40 deletions(-)

diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index 4233a566..b4f95da1 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -66,46 +66,50 @@
                  ;; this covers loop variables
                  (partition
                   (lambda (p)
-                    (let ((fun-name (car (syntax-e (car p)))))
-                      (and
-                       ;; if the function escapes, we can't change it's interface
-                       (not (is-var-mutated? fun-name))
-                       (not (escapes? fun-name #'(begin body ...) let-loop?))
-                       (match (type-of (cadr p)) ; rhs, we want a lambda
-                         [(tc-result1: (Function: (list (arr: doms rngs
-                                                              (and rests #f)
-                                                              (and drests #f)
-                                                              (and kws '())))))
-                          ;; at least 1 argument has to be of type inexact-complex
-                          ;; and can be unboxed
-                          (syntax-parse (cadr p)
-                            [(#%plain-lambda params body ...)
-                             ;; keep track of the param # of each param that can be unboxed
-                             (let loop ((unboxed '())
-                                        (boxed   '())
-                                        (i        0)
-                                        (params   (syntax->list #'params))
-                                        (doms     doms))
-                               (cond [(null? params)
-                                      ;; done. can we unbox anything?
-                                      (and (> (length unboxed) 0)
-                                           ;; if so, add to the table of functions with
-                                           ;; unboxed params, so we can modify its call
-                                           ;; sites, it's body and its header
-                                           (dict-set! unboxed-funs-table fun-name
-                                                      (list (reverse unboxed)
-                                                            (reverse boxed))))]
-                                     [(and (equal? (car doms) -InexactComplex)
-                                           (could-be-unboxed-in?
-                                            (car params) #'(begin body ...)))
-                                      ;; we can unbox
-                                      (loop (cons i unboxed) boxed
-                                            (add1 i) (cdr params) (cdr doms))]
-                                     [else ; can't unbox
-                                      (loop unboxed (cons i boxed)
-                                            (add1 i) (cdr params) (cdr doms))]))]
-                            [_ #f])]
-                         [_ #f]))))
+                    (and
+                     ;; typed racket introduces let-values that bind no values
+                     ;; we can't optimize these
+                     (not (null? (syntax-e (car p))))
+                     (let ((fun-name (car (syntax-e (car p)))))
+                       (and
+                        ;; if the function escapes, we can't change it's interface
+                        (not (is-var-mutated? fun-name))
+                        (not (escapes? fun-name #'(begin body ...) let-loop?))
+                        (match (type-of (cadr p)) ; rhs, we want a lambda
+                          [(tc-result1: (Function: (list (arr: doms rngs
+                                                               (and rests #f)
+                                                               (and drests #f)
+                                                               (and kws '())))))
+                           ;; at least 1 argument has to be of type inexact-complex
+                           ;; and can be unboxed
+                           (syntax-parse (cadr p)
+                             [(#%plain-lambda params body ...)
+                              ;; keep track of the param # of each param that can be unboxed
+                              (let loop ((unboxed '())
+                                         (boxed   '())
+                                         (i        0)
+                                         (params   (syntax->list #'params))
+                                         (doms     doms))
+                                (cond [(null? params)
+                                       ;; done. can we unbox anything?
+                                       (and (> (length unboxed) 0)
+                                            ;; if so, add to the table of functions with
+                                            ;; unboxed params, so we can modify its call
+                                            ;; sites, it's body and its header
+                                            (dict-set! unboxed-funs-table fun-name
+                                                       (list (reverse unboxed)
+                                                             (reverse boxed))))]
+                                      [(and (equal? (car doms) -InexactComplex)
+                                            (could-be-unboxed-in?
+                                             (car params) #'(begin body ...)))
+                                       ;; we can unbox
+                                       (loop (cons i unboxed) boxed
+                                             (add1 i) (cdr params) (cdr doms))]
+                                      [else ; can't unbox
+                                       (loop unboxed (cons i boxed)
+                                             (add1 i) (cdr params) (cdr doms))]))]
+                             [_ #f])]
+                          [_ #f])))))
                   rest)))
              (list candidates function-candidates others))
            #:with (opt-candidates:unboxed-let-clause ...) #'(candidates ...)

From 78a27d2bf9576e830b7ad16bf5aa12823a70bc8d Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 29 Jul 2010 11:59:57 -0400
Subject: [PATCH 040/198] Fixed over-generous pattern matching.

original commit: 435407b37a519c2e0c4401f9a07f93de99e134cb
---
 collects/typed-scheme/optimizer/unboxed-let.rkt | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index b4f95da1..cac5f063 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -83,7 +83,7 @@
                            ;; at least 1 argument has to be of type inexact-complex
                            ;; and can be unboxed
                            (syntax-parse (cadr p)
-                             [(#%plain-lambda params body ...)
+                             [((~literal #%plain-lambda) params body ...)
                               ;; keep track of the param # of each param that can be unboxed
                               (let loop ((unboxed '())
                                          (boxed   '())

From a016db469714e4df1a568c81ebb01e5d5210b3e2 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 29 Jul 2010 13:55:19 -0400
Subject: [PATCH 041/198] Make sure that let-bound functions don't escape
 through a rhs before we change their interface.

original commit: 260de85a6efbc692abaec64d6837a4dfa965cb78
---
 .../optimizer/generic/unboxed-let-functions8.rkt           | 7 +++++++
 collects/typed-scheme/optimizer/unboxed-let.rkt            | 4 +++-
 2 files changed, 10 insertions(+), 1 deletion(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions8.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions8.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions8.rkt
new file mode 100644
index 00000000..124b4cbd
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions8.rkt
@@ -0,0 +1,7 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+(letrec: ((f : (Inexact-Complex -> Inexact-Complex) (lambda (x) (+ x 2.0+4.0i)))
+          (g : (Inexact-Complex -> Inexact-Complex) f)) ; f escapes! can't unbox it's args
+  (f 1.0+2.0i))
diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index cac5f063..2b92412d 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -46,7 +46,8 @@
 (define-syntax-class (unboxed-let-opt-expr-internal let-loop?)
   #:literal-sets (kernel-literals)
   (pattern (~and exp (letk:let-like-keyword
-                      (clause:expr ...) body:expr ...))
+                      ((~and clause (lhs rhs ...)) ...)
+                      body:expr ...))
            ;; we look for bindings of complexes that are not mutated and only
            ;; used in positions where we would unbox them
            ;; these are candidates for unboxing
@@ -74,6 +75,7 @@
                        (and
                         ;; if the function escapes, we can't change it's interface
                         (not (is-var-mutated? fun-name))
+                        (not (escapes? fun-name #'(begin rhs ... ...) #f))
                         (not (escapes? fun-name #'(begin body ...) let-loop?))
                         (match (type-of (cadr p)) ; rhs, we want a lambda
                           [(tc-result1: (Function: (list (arr: doms rngs

From db1103ebbc02eb87fd0aa5a6f40fa22256ab3fe4 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 29 Jul 2010 16:59:18 -0400
Subject: [PATCH 042/198] Fixed types of let loop lambdas.

original commit: 914f142f4fc16e4053e9e899b12e094ac93cf53e
---
 collects/typed-scheme/typecheck/tc-app.rkt | 11 +++++------
 1 file changed, 5 insertions(+), 6 deletions(-)

diff --git a/collects/typed-scheme/typecheck/tc-app.rkt b/collects/typed-scheme/typecheck/tc-app.rkt
index 6b59f06d..ef163169 100644
--- a/collects/typed-scheme/typecheck/tc-app.rkt
+++ b/collects/typed-scheme/typecheck/tc-app.rkt
@@ -195,7 +195,7 @@
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 ;; let loop
 
-(define (let-loop-check form lp actuals args body expected)
+(define (let-loop-check form lam lp actuals args body expected)
   (syntax-parse #`(#,args #,body #,actuals) 
     #:literals (#%plain-app if null? pair? null)
     [((val acc ...)
@@ -216,7 +216,7 @@
                   [t ann-ts])
          (tc-expr/check a (ret t)))
        ;; then check that the function typechecks with the inferred types
-       (tc/rec-lambda/check form args body lp ts expected)
+       (add-typeof-expr lam (tc/rec-lambda/check form args body lp ts expected))
        expected)]
     ;; special case `for/list'
     [((val acc ...)
@@ -234,7 +234,7 @@
                       [(tc-result1: (and t (Listof: _))) t]
                       [_ #f])
                     (generalize (-val '())))])
-       (tc/rec-lambda/check form args body lp (cons acc-ty ts) expected)
+       (add-typeof-expr lam (tc/rec-lambda/check form args body lp (cons acc-ty ts) expected))
        expected)]
     ;; special case when argument needs inference
     [(_ body* _)
@@ -246,7 +246,7 @@
                        (begin (check-below (tc-expr/t ac) infer-t)
                               infer-t)
                        (generalize (tc-expr/t ac)))))])
-       (tc/rec-lambda/check form args body lp ts expected)
+       (add-typeof-expr lam (tc/rec-lambda/check form args body lp ts expected))
        expected)]))
 
 
@@ -569,8 +569,7 @@
      #:fail-unless expected #f 
      #:fail-unless (not (andmap type-annotation (syntax->list #'(lp . args)))) #f
      #:fail-unless (free-identifier=? #'lp #'lp*) #f
-     (add-typeof-expr #'lam expected)
-     (let-loop-check form #'lp #'actuals #'args #'body expected)]
+     (let-loop-check form #'lam #'lp #'actuals #'args #'body expected)]
     ;; special cases for classes
     [(#%plain-app make-object cl . args)     
      (check-do-make-object #'cl #'args #'() #'())]

From fbb55c63c4515bb57bbc946402c8ec3630079c72 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 29 Jul 2010 17:25:44 -0400
Subject: [PATCH 043/198] Extended use-site analysis to look through trivial
 rebindings, to support for loops.

original commit: 27f8279711ae93601c00d27c8041a017afdf592c
---
 .../optimizer/generic/unboxed-for.rkt         |  7 ++++++
 .../typed-scheme/optimizer/unboxed-let.rkt    | 24 +++++++++++++------
 2 files changed, 24 insertions(+), 7 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/unboxed-for.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-for.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-for.rkt
new file mode 100644
index 00000000..24e60d24
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-for.rkt
@@ -0,0 +1,7 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+(for/fold: : Inexact-Complex ((sum : Inexact-Complex 0.0+0.0i))
+           ((i : Inexact-Complex '(1.0+2.0i 2.0+4.0i)))
+      (+ i sum))
diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index 2b92412d..227055fc 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -163,6 +163,23 @@
       [exp:inexact-complex-arith-opt-expr
        (or (direct-child-of? v #'exp)
            (ormap rec (syntax->list #'exp)))]
+      ;; if the variable gets rebound to something else, we look for unboxing
+      ;; opportunities for the new variable too
+      ;; this case happens in the expansion of the for macros, so we care
+      [(l:let-like-keyword
+        ([ids e-rhs:expr] ...) e-body:expr ...)
+       #:with rebindings
+       (filter (lambda (x) x)
+               (map (syntax-parser
+                     [((id) rhs)
+                      #:when (and (identifier? #'rhs)
+                                  (free-identifier=? v #'rhs))
+                      #'id]
+                     [_ #f])
+                    (syntax->list #'((ids e-rhs) ...))))
+       (or (look-at #'(e-rhs ... e-body ...))
+           (ormap (lambda (x) (could-be-unboxed-in? x exp))
+                  (syntax->list #'rebindings)))]
       
       ;; recur down
       [((~and op (~or (~literal #%plain-lambda) (~literal define-values)))
@@ -170,13 +187,6 @@
        (look-at #'(e ...))]
       [(case-lambda [formals e:expr ...] ...)
        (look-at #'(e ... ...))]
-      [((~or (~literal let-values) (~literal letrec-values))
-        ([ids e-rhs:expr] ...) e-body:expr ...)
-       (look-at #'(e-rhs ... e-body ...))]
-      [(letrec-syntaxes+values stx-bindings
-                               ([(ids ...) e-rhs:expr] ...)
-                               e-body:expr ...)
-       (look-at #'(e-rhs ... e-body ...))]
       [(kw:identifier expr ...)
        #:when (ormap (lambda (k) (free-identifier=? k #'kw))
                      (list #'if #'begin #'begin0 #'set! #'#%plain-app #'#%app #'#%expression

From d19a3ff923e08bae32472ed43acb6adaeaabaf18 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 29 Jul 2010 19:11:20 -0400
Subject: [PATCH 044/198] Added some reflection functions to Typed Racket.

original commit: c4ba6b60388a2d65fcb44a726d12373f9ca17eee
---
 collects/typed-scheme/private/base-env.rkt   | 70 +++++++++++++++++++-
 collects/typed-scheme/private/base-types.rkt |  4 ++
 collects/typed-scheme/types/abbrev.rkt       |  4 ++
 3 files changed, 77 insertions(+), 1 deletion(-)

diff --git a/collects/typed-scheme/private/base-env.rkt b/collects/typed-scheme/private/base-env.rkt
index 0ce98a90..3e45706d 100644
--- a/collects/typed-scheme/private/base-env.rkt
+++ b/collects/typed-scheme/private/base-env.rkt
@@ -18,7 +18,9 @@
  (only-in mzscheme make-namespace)
  (only-in racket/match/runtime match:error matchable? match-equality-test)
  (for-syntax (only-in (types abbrev) [-Number N] [-Boolean B] [-Symbol Sym])
-             (only-in (rep type-rep) make-HashtableTop make-MPairTop make-BoxTop make-ChannelTop make-VectorTop)))
+             (only-in (rep type-rep) make-HashtableTop make-MPairTop
+                                     make-BoxTop make-ChannelTop make-VectorTop
+                                     make-HeterogenousVector)))
 
 [raise (Univ . -> . (Un))]
 [raise-syntax-error (cl->* 
@@ -933,3 +935,69 @@
 [mlength (-poly (a) (-> (-mlst a) -NonnegativeFixnum))]
 [mreverse! (-poly (a) (-> (-mlst a) (-mlst a)))]
 [mappend (-poly (a) (->* (list) (-mlst a) (-mlst a)))]
+
+;; module names and loading
+[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? (make-pred-ty -Module-Path)]
+[current-module-name-resolver (-Param (cl->* (-Resolved-Module-Path . -> . Univ)
+                                             ((Un -Module-Path -Path)
+                                              (-opt -Resolved-Module-Path)
+                                              (-opt (-Syntax Univ))
+                                              -Boolean
+                                              . -> . -Resolved-Module-Path))
+                                      (cl->* (-Resolved-Module-Path . -> . Univ)
+                                             ((Un -Module-Path -Path)
+                                              (-opt -Resolved-Module-Path)
+                                              (-opt (-Syntax Univ))
+                                              -Boolean
+                                              . -> . -Resolved-Module-Path)))]
+[current-module-declare-name (-Param (-opt -Resolved-Module-Path)
+                                     (-opt -Resolved-Module-Path))]
+[current-module-declare-source (-Param (-opt (Un -Symbol -Path))
+                                       (-opt (Un -Symbol -Path)))]
+[module-path-index? (make-pred-ty -Module-Path-Index)]
+[module-path-index-resolve (-> -Module-Path-Index -Resolved-Module-Path)]
+[module-path-index-split (-> -Module-Path-Index
+                             (-values
+                              (list (-opt -Module-Path)
+                                    (-opt (Un -Module-Path-Index
+                                              -Resolved-Module-Path)))))]
+[module-path-index-join (-> (-opt -Module-Path)
+                            (-opt (Un -Module-Path-Index -Resolved-Module-Path))
+                            -Module-Path-Index)]
+[compiled-module-expression? (make-pred-ty -Compiled-Module-Expression)]
+[module-compiled-name (-> -Compiled-Module-Expression -Symbol)]
+[module-compiled-imports (-> -Compiled-Module-Expression
+                             (-lst (-pair (-opt -Integer)
+                                          (-lst -Module-Path-Index))))]
+[module-compiled-exports
+ (-> -Compiled-Module-Expression
+     (-values
+      (list
+       (-lst (-pair (-opt -Integer)
+                    (-lst (-pair -Symbol
+                                 (-pair
+                                  (-lst
+                                   (Un -Module-Path-Index
+                                       (-pair -Module-Path-Index
+                                              (-pair (-opt -Integer)
+                                                     (-pair -Symbol
+                                                            (-pair (-opt -Integer)
+                                                                   (-val null)))))))
+                                  (-val null))))))
+       (-lst (-pair (-opt -Integer)
+                    (-lst (-pair -Symbol
+                                 (-pair
+                                  (-lst
+                                   (Un -Module-Path-Index
+                                       (-pair -Module-Path-Index
+                                              (-pair (-opt -Integer)
+                                                     (-pair -Symbol
+                                                            (-pair (-opt -Integer)
+                                                                   (-val null)))))))
+                                  (-val null)))))))))]
+[module-compiled-language-info
+ (-> -Compiled-Module-Expression
+     (-opt (make-HeterogenousVector (list -Module-Path -Symbol Univ))))]
diff --git a/collects/typed-scheme/private/base-types.rkt b/collects/typed-scheme/private/base-types.rkt
index 5b51c829..ad6104da 100644
--- a/collects/typed-scheme/private/base-types.rkt
+++ b/collects/typed-scheme/private/base-types.rkt
@@ -44,6 +44,10 @@
 [Procedure top-func]
 [Keyword -Keyword]
 [Thread -Thread]
+[Resolved-Module-Path -Resolved-Module-Path]
+[Module-Path -Module-Path]
+[Module-Path-Index -Module-Path-Index]
+[Compiled-Module-Expression -Compiled-Module-Expression]
 [Listof -Listof]
 [Vectorof (-poly (a) (make-Vector a))]
 [FlVector -FlVector]
diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt
index 5ce0ce8a..fca12fa8 100644
--- a/collects/typed-scheme/types/abbrev.rkt
+++ b/collects/typed-scheme/types/abbrev.rkt
@@ -107,6 +107,10 @@
 (define -Keyword (make-Base 'Keyword #'keyword?))
 (define -Char (make-Base 'Char #'char?))
 (define -Thread (make-Base 'Thread #'thread?))
+(define -Resolved-Module-Path (make-Base 'Resolved-Module-Path #'resolved-module-path?))
+(define -Module-Path (make-Base 'Module-Path #'module-path?))
+(define -Module-Path-Index (make-Base 'Module-Path-Index #'module-path-index?))
+(define -Compiled-Module-Expression (make-Base 'Compiled-Module-Expression #'compiled-module-expression?))
 (define -Prompt-Tag (make-Base 'Prompt-Tag #'continuation-prompt-tag?))
 (define -Cont-Mark-Set (make-Base 'Continuation-Mark-Set #'continuation-mark-set?))
 (define -Path (make-Base 'Path #'path?))

From 1f05ee70e23ad7b8931f21f01da243c0e72bfcc3 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Mon, 2 Aug 2010 13:26:54 -0400
Subject: [PATCH 045/198] Don't treat Error types as potentially non-regular.
 (Reported by SK)

original commit: 431ff8d794425e12577c662be7827a38531ad39f
---
 collects/tests/typed-scheme/fail/unbound-non-reg.rkt | 7 +++++++
 collects/typed-scheme/private/parse-type.rkt         | 3 ++-
 collects/typed-scheme/types/resolve.rkt              | 3 ++-
 3 files changed, 11 insertions(+), 2 deletions(-)
 create mode 100644 collects/tests/typed-scheme/fail/unbound-non-reg.rkt

diff --git a/collects/tests/typed-scheme/fail/unbound-non-reg.rkt b/collects/tests/typed-scheme/fail/unbound-non-reg.rkt
new file mode 100644
index 00000000..5b286373
--- /dev/null
+++ b/collects/tests/typed-scheme/fail/unbound-non-reg.rkt
@@ -0,0 +1,7 @@
+#;
+(exn-pred 2)
+#lang typed/racket
+
+
+(define-struct: (T) Node ([v : T] [l : (BinTreeof t)] [r : (BinTreeof t)]))
+(define-type (BinTreeof t) (U 'empty [Node t]))
diff --git a/collects/typed-scheme/private/parse-type.rkt b/collects/typed-scheme/private/parse-type.rkt
index 23285bcd..bff49836 100644
--- a/collects/typed-scheme/private/parse-type.rkt
+++ b/collects/typed-scheme/private/parse-type.rkt
@@ -311,7 +311,8 @@
            [(Name: n)
             (when (and (current-poly-struct) 
                        (free-identifier=? n (poly-name (current-poly-struct)))
-                       (not (andmap type-equal? args (poly-vars (current-poly-struct)))))
+                       (not (or (ormap Error? args)
+                                (andmap type-equal? args (poly-vars (current-poly-struct))))))
               (tc-error "Structure type constructor ~a applied to non-regular arguments ~a" rator args))
             (make-App rator args stx)]
            [(Poly: ns _)
diff --git a/collects/typed-scheme/types/resolve.rkt b/collects/typed-scheme/types/resolve.rkt
index 4a30c813..b0bbc1c9 100644
--- a/collects/typed-scheme/types/resolve.rkt
+++ b/collects/typed-scheme/types/resolve.rkt
@@ -34,7 +34,8 @@
       [(Name: n) 
        (when (and (current-poly-struct) 
                   (free-identifier=? n (poly-name (current-poly-struct)))
-                  (not (andmap type-equal? rands (poly-vars (current-poly-struct)))))
+                  (not (or (ormap Error? rands)
+                           (andmap type-equal? rands (poly-vars (current-poly-struct))))))
          (tc-error "Structure type constructor ~a applied to non-regular arguments ~a" rator rands))
        (let ([r (resolve-name rator)])
          (and r  (resolve-app r rands stx)))]

From 2c1f173d6214aa5c402ee568e1da295ce7f17b9b Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Mon, 2 Aug 2010 16:59:37 -0400
Subject: [PATCH 046/198] `define-struct:' -> `struct:' in docs. Fix typo.

original commit: 1ce4040cd299de6c837c81b872a3b722b42c9635
---
 collects/typed-scheme/scribblings/begin.scrbl | 10 ++++-----
 .../scribblings/ts-reference.scrbl            |  2 +-
 collects/typed-scheme/scribblings/types.scrbl | 22 +++++++++----------
 3 files changed, 17 insertions(+), 17 deletions(-)

diff --git a/collects/typed-scheme/scribblings/begin.scrbl b/collects/typed-scheme/scribblings/begin.scrbl
index 137b8e29..5c68d127 100644
--- a/collects/typed-scheme/scribblings/begin.scrbl
+++ b/collects/typed-scheme/scribblings/begin.scrbl
@@ -23,7 +23,7 @@ are provided as well; for example, the
 @racketmodname[typed/racket/base] language corresponds to
 @racketmodname[racket/base].   
 
-@racketblock[(define-struct: pt ([x : Real] [y : Real]))]
+@racketblock[(struct: pt ([x : Real] [y : Real]))]
 
 @margin-note{Many forms in Typed Racket have the same name as the
 untyped forms, with a @racket[:] suffix.}
@@ -31,10 +31,10 @@ This defines a new structure, name @racket[pt], with two fields,
 @racket[x] and @racket[y].  Both fields are specified to have the type
 @racket[Real], which corresponds to the @rtech{real numbers}.
  The
-@racket[define-struct:] form corresponds to the @racket[define-struct]
+@racket[struct:] form corresponds to the @racket[struct]
 form from @racketmodname[racket]---when porting a program from
 @racketmodname[racket] to @racketmodname[typed/racket], uses of
-@racket[define-struct] should be changed to @racket[define-struct:].
+@racket[struct] should be changed to @racket[struct:].
 
 @racketblock[(: mag (pt -> Number))]
 
@@ -71,8 +71,8 @@ represent these using @italic{union types}, written @racket[(U t1 t2 ...)].
 @racketmod[
 typed/racket
 (define-type Tree (U leaf node))
-(define-struct: leaf ([val : Number]))
-(define-struct: node ([left : Tree] [right : Tree]))
+(struct: leaf ([val : Number]))
+(struct: node ([left : Tree] [right : Tree]))
 
 (: tree-height (Tree -> Integer))
 (define (tree-height t)
diff --git a/collects/typed-scheme/scribblings/ts-reference.scrbl b/collects/typed-scheme/scribblings/ts-reference.scrbl
index 4b546d66..8dbb564c 100644
--- a/collects/typed-scheme/scribblings/ts-reference.scrbl
+++ b/collects/typed-scheme/scribblings/ts-reference.scrbl
@@ -397,7 +397,7 @@ corresponding to @racket[define-struct].}
 @defform/subs[
 (define-struct/exec: name-spec ([f : t] ...) [e : proc-t])
 ([name-spec name (name parent)])]{
- Like @racket[define-struct:], but defines an procedural structure.  
+ 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].}
 
 @subsection{Names for Types}
diff --git a/collects/typed-scheme/scribblings/types.scrbl b/collects/typed-scheme/scribblings/types.scrbl
index 1d020b11..20915ea4 100644
--- a/collects/typed-scheme/scribblings/types.scrbl
+++ b/collects/typed-scheme/scribblings/types.scrbl
@@ -102,12 +102,12 @@ refers to the whole binary tree type within the body of the
 
 @section{Structure Types}
 
-Using @racket[define-struct:] introduces new types, distinct from any
+Using @racket[struct:] introduces new types, distinct from any
 previous type.    
 
-@racketblock[(define-struct: point ([x : Real] [y : Real]))]
+@racketblock[(struct: point ([x : Real] [y : Real]))]
 
-Instances of this structure, such as @racket[(make-point 7 12)], have type @racket[point].
+Instances of this structure, such as @racket[(point 7 12)], have type @racket[point].
 
 @section{Subtyping}
 
@@ -172,25 +172,25 @@ an analog of the @tt{Maybe} type constructor from Haskell:
 
 @racketmod[
 typed/racket
-(define-struct: None ())
-(define-struct: (a) Some ([v : a]))
+(struct: None ())
+(struct: (a) Some ([v : a]))
 
 (define-type (Opt a) (U None (Some a)))
 
 (: find (Number (Listof Number) -> (Opt Number)))
 (define (find v l)
-  (cond [(null? l) (make-None)]
-        [(= v (car l)) (make-Some v)]
+  (cond [(null? l) (None)]
+        [(= v (car l)) (Some v)]
         [else (find v (cdr l))]))
 ]
 
-The first @racket[define-struct:] defines @racket[None] to be
+The first @racket[struct:] defines @racket[None] to be
 a structure with no contents.  
 
 The second definition
 
 @racketblock[
-(define-struct: (a) Some ([v : a]))
+(struct: (a) Some ([v : a]))
 ]
 
 creates a parameterized type, @racket[Just], which is a structure with
@@ -207,8 +207,8 @@ creates a parameterized type --- @racket[Opt] is a potential
 container for whatever type is supplied.
 
 The @racket[find] function takes a number @racket[v] and list, and
-produces @racket[(make-Some v)] when the number is found in the list,
-and @racket[(make-None)] otherwise.  Therefore, it produces a
+produces @racket[(Some v)] when the number is found in the list,
+and @racket[(None)] otherwise.  Therefore, it produces a
 @racket[(Opt Number)], just as the annotation specified.  
 
 @subsection{Polymorphic Functions}

From 875e95973a07189b005f59a10e812ddef63d3ec0 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Mon, 2 Aug 2010 17:23:01 -0400
Subject: [PATCH 047/198] Remove obselete docs. Add docs for legacy forms.

original commit: 39c2359006e2cc5da862d50b6d45e38bcf8cd72f
---
 .../scribblings/ts-reference.scrbl            | 26 ++++++++++++-------
 1 file changed, 16 insertions(+), 10 deletions(-)

diff --git a/collects/typed-scheme/scribblings/ts-reference.scrbl b/collects/typed-scheme/scribblings/ts-reference.scrbl
index 8dbb564c..c8660970 100644
--- a/collects/typed-scheme/scribblings/ts-reference.scrbl
+++ b/collects/typed-scheme/scribblings/ts-reference.scrbl
@@ -231,16 +231,6 @@ recursive type in the body @racket[t]}
 
 @defform[(Option t)]{Either @racket[t] of @racket[#f]}
 
-Other types cannot be written by the programmer, but are used
-internally and may appear in error messages.
-
-@defform/none[(struct:n (t ...))]{is the type of structures named
-@racket[n] with field types @racket[t].  There may be multiple such
-types with the same printed representation.}
-@defform/none[<n>]{is the printed representation of a reference to the
-type variable @racket[n]}
-
-
 @section[#:tag "special-forms"]{Special Form Reference}
 
 Typed Racket provides a variety of special forms above and beyond
@@ -616,4 +606,20 @@ specifying the language of your program:
 
 @racketmod[typed/racket #:optimize]
 
+@section{Legacy Forms}
+
+The following forms are provided by Typed Racket for backwards
+compatibility.  
+
+@defidform[define-type-alias]{Equivalent to @racket[define-type].}
+@defidform[require/opaque-type]{Similar to using the @racket[opaque]
+keyword with @racket[require/typed].}
+@defidform[require-typed-struct]{Similar to using the @racket[struct]
+keyword with @racket[require/typed].}
+
+@(defmodulelang* (typed-scheme)
+                 #:use-sources (typed-scheme/typed-scheme
+                 typed-scheme/private/prims))
+Equivalent to the @racketmod[typed/racket/base] language.
+
 }

From 492c89be8dd3041cc8266259f9386711db38d1b7 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 30 Jul 2010 11:59:38 -0400
Subject: [PATCH 048/198] Eliminate user-introduced boxing.

original commit: b47a77dd57a4ed92f49cd92253c6c06905923f9f
---
 .../generic/unboxed-make-rectangular.rkt      |  8 +++++
 collects/typed-scheme/optimizer/float.rkt     | 15 ++++++++-
 .../optimizer/inexact-complex.rkt             | 31 ++++++++-----------
 3 files changed, 35 insertions(+), 19 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/unboxed-make-rectangular.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-make-rectangular.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-make-rectangular.rkt
new file mode 100644
index 00000000..87d3f05d
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-make-rectangular.rkt
@@ -0,0 +1,8 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+(let ((x (make-rectangular 1.0 2.0)))
+  (+ x 2.0+4.0i))
+(let ((x (unsafe-make-flrectangular 1.0 2.0)))
+  (+ x 2.0+4.0i))
diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-scheme/optimizer/float.rkt
index b7970212..17917d44 100644
--- a/collects/typed-scheme/optimizer/float.rkt
+++ b/collects/typed-scheme/optimizer/float.rkt
@@ -7,7 +7,7 @@
          (types abbrev type-table utils subtype)
          (optimizer utils fixnum))
 
-(provide float-opt-expr float-expr int-expr)
+(provide float-opt-expr float-expr int-expr float-coerce-expr)
 
 
 (define (mk-float-tbl generic)
@@ -40,6 +40,19 @@
   (pattern e:expr
            #:when (subtypeof? #'e -Integer)
            #:with opt ((optimize) #'e)))
+(define-syntax-class real-expr
+  (pattern e:expr
+           #:when (subtypeof? #'e -Real)
+           #:with opt ((optimize) #'e)))
+
+
+;; generates coercions to floats
+(define-syntax-class float-coerce-expr
+  (pattern e:float-arg-expr
+           #:with opt #'e.opt)
+  (pattern e:real-expr
+           #:with opt #'(exact->inexact e.opt)))
+
 
 ;; if the result of an operation is of type float, its non float arguments
 ;; can be promoted, and we can use unsafe float operations
diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt
index 0526c42e..d18ac9f0 100644
--- a/collects/typed-scheme/optimizer/inexact-complex.rkt
+++ b/collects/typed-scheme/optimizer/inexact-complex.rkt
@@ -224,6 +224,17 @@
            (begin (log-optimization "unboxed unary inexact complex" #'op)
                   #'(c.bindings ...)))
 
+  ;; we can eliminate boxing that was introduced by the user
+  (pattern (#%plain-app (~and op (~or (~literal make-rectangular)
+                                      (~literal unsafe-make-flrectangular)))
+                        real:float-coerce-expr imag:float-coerce-expr)
+           #:with real-binding (unboxed-gensym)
+           #:with imag-binding (unboxed-gensym)
+           #:with (bindings ...)
+           (begin (log-optimization "make-rectangular elimination" #'op)
+                  #`(((real-binding) real.opt)
+                     ((imag-binding) imag.opt))))
+
   ;; if we see a variable that's already unboxed, use the unboxed bindings
   (pattern v:id
            #:with unboxed-info (dict-ref unboxed-vars-table #'v #f)
@@ -243,27 +254,11 @@
               ((real-binding) (unsafe-flreal-part e*))
               ((imag-binding) (unsafe-flimag-part e*))))
   ;; special handling of reals
-  (pattern e:float-expr
+  (pattern e:float-coerce-expr
            #:with real-binding (unboxed-gensym)
            #:with imag-binding #f
            #:with (bindings ...)
-           #`(((real-binding) #,((optimize) #'e))))
-  (pattern e:fixnum-expr
-           #:with real-binding (unboxed-gensym)
-           #:with imag-binding #f
-           #:with (bindings ...)
-           #`(((real-binding) (unsafe-fx->fl #,((optimize) #'e)))))
-  (pattern e:int-expr
-           #:with real-binding (unboxed-gensym)
-           #:with imag-binding #f
-           #:with (bindings ...)
-           #`(((real-binding) (->fl #,((optimize) #'e)))))
-  (pattern e:expr
-           #:when (isoftype? #'e -Real)
-           #:with real-binding (unboxed-gensym)
-           #:with imag-binding #f
-           #:with (bindings ...)
-           #`(((real-binding) (exact->inexact #,((optimize) #'e)))))
+           #`(((real-binding) e.opt)))
   (pattern e:expr
            #:when (isoftype? #'e -Number) ; complex, maybe exact, maybe not
            #:with e* (unboxed-gensym)

From 83c6f990419b711e9d894e49536256834c97d029 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 2 Aug 2010 10:35:17 -0400
Subject: [PATCH 049/198] Documented the optimizer.

original commit: cb516081c742cfeb04d754d4925389de33319cd7
---
 .../scribblings/optimization.scrbl            | 89 +++++++++++++++++++
 1 file changed, 89 insertions(+)

diff --git a/collects/typed-scheme/scribblings/optimization.scrbl b/collects/typed-scheme/scribblings/optimization.scrbl
index e7d70054..dc576155 100644
--- a/collects/typed-scheme/scribblings/optimization.scrbl
+++ b/collects/typed-scheme/scribblings/optimization.scrbl
@@ -19,3 +19,92 @@ want to activate it, you must add the @racket[#:optimize] keyword when
 specifying the language of your program:
 
 @racketmod[typed/racket #:optimize]
+
+@section{Getting the most out of the optimizer}
+Typed Racket's optimizer can improve the performance of various common
+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.
+
+@subsection{Numeric types}
+Being type-driven, the optimizer makes most of its decisions based on
+the types you assigned to your data. As such, you can improve the
+optimizer's usefulness by writing informative types.
+
+For example, the following programs both typecheck:
+@racketblock[(define: (f (x : Real))  : Real  (+ x 2.5))
+             (f 3.5)]
+@racketblock[(define: (f (x : Float)) : Float (+ x 2.5))
+             (f 3.5)]
+
+However, the second one uses more informative types: the
+@racket[Float] type includes only inexact real numbers whereas the
+@racket[Real] type includes both exact and inexact real numbers. Typed
+Racket's optimizer can optimize the latter program to use
+inexact-specific operations whereas it cannot do anything with the
+former program.
+
+Thus, to get the most of Typed Racket's optimizer, you should use the
+@racket[Float] type when possible.
+
+On a similar note, the @racket[Inexact-Complex] type is preferable to
+the @racket[Complex] type for the same reason. Typed Racket can keep
+inexact complex numbers unboxed; as such, programs using complex
+numbers can have better performance than equivalent programs that
+represent complex numbers as two real numbers. To get the most of
+Typed Racket's optimizer, you should also favor rectangular
+coordinates over polar coordinates.
+
+@subsection{Lists}
+Typed Racket handles potentially empty lists and lists that are known
+to be non-empty differently: when taking the @racket[car] or the
+@racket[cdr] of a list Typed Racket knows is non-empty, it can skip
+the check for the empty list that is usually done when calling
+@racket[car] and @racket[cdr].
+
+@racketblock[
+(define: (sum (l : (Listof Integer))) : Integer
+  (if (null? l)
+      0
+      (+ (car l) (sum (cdr l)))))
+]
+
+In this example, Typed Racket knows that if we reach the else branch,
+@racket[l] is not empty. The checks associated with @racket[car] and
+@racket[cdr] would be redundant and are eliminated.
+
+In addition to explicitly checking for the empty list using
+@racket[null?], you can inform Typed Racket that a list is non-empty
+by using the known-length list type constructor; if your data is
+stored in lists of fixed length, you can use the @racket[List] type
+constructors.
+
+For instance, the type of a list of two @racket[Integer]s can be
+written either as:
+@racketblock[(define-type List-2-Ints (Listof Integer))]
+or as the more precise:
+@racketblock[(define-type List-2-Ints (List Integer Integer))]
+
+Using the second definition, all @racket[car] and @racket[cdr]-related
+checks can be eliminated in this function:
+@racketblock[
+(define: (sum2 (l : List-2-Ints) : Integer)
+  (+ (car l) (car (cdr l))))
+]
+
+@subsection{Vectors}
+
+In addition to known-length lists, Typed Racket supports known-length
+vectors through the @racket[Vector] type constructor. Known-length
+vector access using constant indices can be optimized in a similar
+fashion as @racket[car] and @racket[cdr].
+
+@#reader scribble/comment-reader (racketblock
+;; #(name r g b)
+(define-type Color (Vector String Integer Integer Integer))
+(define: x : Color (vector "red" 255 0 0))
+(vector-ref x 0) ; good
+(define color-name 0)
+(vector-ref x color-name) ; good
+(vector-ref x (* 0 10)) ; bad
+)

From 6e1c0a9ca58c4af3e9251f2d17828c40c1d8fbe2 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 2 Aug 2010 11:41:14 -0400
Subject: [PATCH 050/198] Added a link to the optimization guide in the TR
 reference.

original commit: 82f976a4d9c94d880a817a8a70b99f8673d01616
---
 collects/typed-scheme/scribblings/ts-reference.scrbl | 8 +++++++-
 1 file changed, 7 insertions(+), 1 deletion(-)

diff --git a/collects/typed-scheme/scribblings/ts-reference.scrbl b/collects/typed-scheme/scribblings/ts-reference.scrbl
index c8660970..8daab985 100644
--- a/collects/typed-scheme/scribblings/ts-reference.scrbl
+++ b/collects/typed-scheme/scribblings/ts-reference.scrbl
@@ -1,6 +1,6 @@
 #lang scribble/manual
 
-@begin[(require "utils.rkt" scribble/eval
+@begin[(require "utils.rkt" scribble/eval scriblib/footnote
                 racket/sandbox)
        (require (for-label (only-meta-in 0 typed/racket)
                            racket/list srfi/14
@@ -596,6 +596,12 @@ have the types ascribed to them; these types are converted to contracts and chec
 
 @section{Optimization in Typed Racket}
 
+@note{
+See
+@secref[#:doc '(lib "typed-scheme/scribblings/ts-guide.scrbl")]{optimization}
+in the guide for tips to get the most out of the optimizer.
+}
+
 Typed Racket provides a type-driven optimizer that rewrites well-typed
 programs to potentially make them faster. It should in no way make
 your programs slower or unsafe.

From f51d1e640d49b2ac5dd40d834da307db0e55d845 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 3 Aug 2010 13:53:46 -0400
Subject: [PATCH 051/198] Imaginaries can't be inexact complexes.

original commit: bce003fa1813b309382d6af01090f3cb5b9f84d5
---
 collects/typed-scheme/types/abbrev.rkt | 14 +++++++++-----
 1 file changed, 9 insertions(+), 5 deletions(-)

diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt
index fca12fa8..6f9ad4e4 100644
--- a/collects/typed-scheme/types/abbrev.rkt
+++ b/collects/typed-scheme/types/abbrev.rkt
@@ -154,13 +154,17 @@
 ;; Numeric hierarchy
 (define -Number (make-Base 'Number #'number?))
 
-;; a complex number can't have an inexact imaginary part and an exact real part
-(define -InexactComplex (make-Base 'InexactComplex #'(and/c number? (lambda (x) (inexact-real? (imag-part x))))))
+(define -InexactComplex (make-Base 'InexactComplex
+                                   #'(and/c number?
+                                            (lambda (x)
+                                              (and (inexact-real? (imag-part x))
+                                                   (inexact-real? (real-part x)))))))
 
 (define -Flonum (make-Base 'Flonum #'inexact-real?))
-(define -NonnegativeFlonum (make-Base 'Nonnegative-Flonum #'(and/c inexact-real?
-                                                                   (or/c positive? zero?)
-                                                                   (lambda (x) (not (eq? x -0.0))))))
+(define -NonnegativeFlonum (make-Base 'Nonnegative-Flonum
+                                      #'(and/c inexact-real?
+                                               (or/c positive? zero?)
+                                               (lambda (x) (not (eq? x -0.0))))))
 
 (define -ExactRational 
   (make-Base 'Exact-Rational #'(and/c number? rational? exact?)))

From 5b89be655b8c5e820474005ecc74d632c41ecb45 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 3 Aug 2010 14:40:51 -0400
Subject: [PATCH 052/198] Added technical term links to the optimizer
 documentation.

original commit: 5fa6b1c1391b80eb3a9cb9a7823780359cc91d73
---
 .../scribblings/optimization.scrbl            | 31 ++++++++++++++-----
 1 file changed, 24 insertions(+), 7 deletions(-)

diff --git a/collects/typed-scheme/scribblings/optimization.scrbl b/collects/typed-scheme/scribblings/optimization.scrbl
index dc576155..20073dc9 100644
--- a/collects/typed-scheme/scribblings/optimization.scrbl
+++ b/collects/typed-scheme/scribblings/optimization.scrbl
@@ -38,10 +38,19 @@ For example, the following programs both typecheck:
              (f 3.5)]
 
 However, the second one uses more informative types: the
-@racket[Float] type includes only inexact real numbers whereas the
-@racket[Real] type includes both exact and inexact real numbers. Typed
-Racket's optimizer can optimize the latter program to use
-inexact-specific operations whereas it cannot do anything with the
+@racket[Float] type includes only
+@tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key
+"inexact numbers"]{inexact}
+@tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{real numbers}
+whereas the
+@racket[Real] type includes both exact and
+@tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key
+"inexact numbers"]{inexact}
+@tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{real numbers}.
+Typed Racket's optimizer can optimize the latter program to use
+@tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key
+"inexact numbers"]{inexact}
+-specific operations whereas it cannot do anything with the
 former program.
 
 Thus, to get the most of Typed Racket's optimizer, you should use the
@@ -49,9 +58,17 @@ Thus, to get the most of Typed Racket's optimizer, you should use the
 
 On a similar note, the @racket[Inexact-Complex] type is preferable to
 the @racket[Complex] type for the same reason. Typed Racket can keep
-inexact complex numbers unboxed; as such, programs using complex
-numbers can have better performance than equivalent programs that
-represent complex numbers as two real numbers. To get the most of
+@tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key
+"inexact numbers"]{inexact}
+@tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{complex numbers}
+unboxed; as such, programs using
+@tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{complex numbers}
+can have better performance than equivalent programs that
+represent
+@tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{complex numbers}
+as two
+@tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{real numbers}.
+To get the most of
 Typed Racket's optimizer, you should also favor rectangular
 coordinates over polar coordinates.
 

From 4c41407d64ad7e279afa32c8da287afdc58d8a37 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 3 Aug 2010 15:31:38 -0400
Subject: [PATCH 053/198] Added optimization for make-polar

original commit: fb31a6556e04d9aa6aa31c215394a80b9d146bd7
---
 .../optimizer/generic/invalid-make-polar.rkt  |  3 +++
 .../optimizer/generic/make-polar.rkt          |  9 +++++++
 .../optimizer/inexact-complex.rkt             | 24 ++++++++++++++++++-
 3 files changed, 35 insertions(+), 1 deletion(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/invalid-make-polar.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/make-polar.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-make-polar.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-make-polar.rkt
new file mode 100644
index 00000000..f6a646b6
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/invalid-make-polar.rkt
@@ -0,0 +1,3 @@
+#lang typed/scheme #:optimize
+
+(make-polar 0 0)
diff --git a/collects/tests/typed-scheme/optimizer/generic/make-polar.rkt b/collects/tests/typed-scheme/optimizer/generic/make-polar.rkt
new file mode 100644
index 00000000..137f0b17
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/make-polar.rkt
@@ -0,0 +1,9 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+;; top level
+(make-polar 1.0 1.0)
+
+;; nested
+(+ 1.0+2.0i (make-polar 2.0 4.0))
diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt
index d18ac9f0..5fed8415 100644
--- a/collects/typed-scheme/optimizer/inexact-complex.rkt
+++ b/collects/typed-scheme/optimizer/inexact-complex.rkt
@@ -232,8 +232,20 @@
            #:with imag-binding (unboxed-gensym)
            #:with (bindings ...)
            (begin (log-optimization "make-rectangular elimination" #'op)
-                  #`(((real-binding) real.opt)
+                  #'(((real-binding) real.opt)
                      ((imag-binding) imag.opt))))
+  (pattern (#%plain-app (~and op (~literal make-polar))
+                        r:float-coerce-expr theta:float-coerce-expr)
+           #:with magnitude    (unboxed-gensym)
+           #:with angle        (unboxed-gensym)
+           #:with real-binding (unboxed-gensym)
+           #:with imag-binding (unboxed-gensym)
+           #:with (bindings ...)
+           (begin (log-optimization "make-rectangular elimination" #'op)
+                  #'(((magnitude)    r.opt)
+                     ((angle)        theta.opt)
+                     ((real-binding) (unsafe-fl* magnitude (unsafe-flcos angle)))
+                     ((imag-binding) (unsafe-fl* magnitude (unsafe-flsin angle))))))
 
   ;; if we see a variable that's already unboxed, use the unboxed bindings
   (pattern v:id
@@ -308,6 +320,16 @@
            (begin (log-optimization "unary inexact complex" #'op)
                   #'(op.unsafe n.opt)))
 
+  (pattern (~and exp (#%plain-app (~and op (~literal make-polar)) r theta))
+           #:when (isoftype? #'exp -InexactComplex)
+           #:with exp*:unboxed-inexact-complex-opt-expr #'exp
+           #:with opt
+           (begin (log-optimization "make-polar" #'op)
+                  (reset-unboxed-gensym)
+                  #'(let*-values (exp*.bindings ...)
+                      (unsafe-make-flrectangular exp*.real-binding
+                                                 exp*.imag-binding))))
+
   (pattern (~and e (#%plain-app op:id args:expr ...))
            #:with unboxed-info (dict-ref unboxed-funs-table #'op #f)
            #:when (syntax->datum #'unboxed-info)

From 82340857d96691e3749ac45e740059df0cee3948 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 3 Aug 2010 16:55:03 -0400
Subject: [PATCH 054/198] Optimize coercion of integer literals.

original commit: bdf84f371d4ccf952e08251703a4249c37f81a85
---
 .../typed-scheme/optimizer/generic/float-promotion.rkt     | 2 +-
 .../optimizer/generic/inexact-complex-fixnum.rkt           | 2 +-
 .../tests/typed-scheme/optimizer/generic/literal-int.rkt   | 6 ++++++
 collects/typed-scheme/optimizer/float.rkt                  | 7 ++++++-
 4 files changed, 14 insertions(+), 3 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/literal-int.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/float-promotion.rkt b/collects/tests/typed-scheme/optimizer/generic/float-promotion.rkt
index 1fc32fa9..09d106f4 100644
--- a/collects/tests/typed-scheme/optimizer/generic/float-promotion.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/float-promotion.rkt
@@ -1,4 +1,4 @@
 (module float-promotion typed/scheme #:optimize
   (require racket/unsafe/ops racket/flonum)
-  (+ 1 2.0)
+  (+ (quotient 1 1) 2.0)
   (+ (expt 100 100) 2.0))
diff --git a/collects/tests/typed-scheme/optimizer/generic/inexact-complex-fixnum.rkt b/collects/tests/typed-scheme/optimizer/generic/inexact-complex-fixnum.rkt
index 3f99e881..796242a9 100644
--- a/collects/tests/typed-scheme/optimizer/generic/inexact-complex-fixnum.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/inexact-complex-fixnum.rkt
@@ -1,3 +1,3 @@
 #lang typed/scheme #:optimize
 (require racket/unsafe/ops)
-(+ 2 1.0+2.0i 3.0+6.0i)
+(+ (quotient 2 1) 1.0+2.0i 3.0+6.0i)
diff --git a/collects/tests/typed-scheme/optimizer/generic/literal-int.rkt b/collects/tests/typed-scheme/optimizer/generic/literal-int.rkt
new file mode 100644
index 00000000..6d6d6b8a
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/literal-int.rkt
@@ -0,0 +1,6 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+(+ 1 2.0)
+1
diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-scheme/optimizer/float.rkt
index 17917d44..334b3600 100644
--- a/collects/typed-scheme/optimizer/float.rkt
+++ b/collects/typed-scheme/optimizer/float.rkt
@@ -1,7 +1,7 @@
 #lang scheme/base
 
 (require syntax/parse
-         syntax/id-table racket/dict
+         syntax/id-table racket/dict scheme/flonum
          (for-template scheme/base scheme/flonum scheme/unsafe/ops)
          "../utils/utils.rkt"
          (types abbrev type-table utils subtype)
@@ -59,6 +59,11 @@
 ;; note: none of the unary operations have types where non-float arguments
 ;;  can result in float (as opposed to real) results
 (define-syntax-class float-arg-expr
+  ;; we can convert literals right away
+  (pattern (quote n)
+           #:when (exact-integer? (syntax->datum #'n))
+           #:with opt
+           (datum->syntax #'here (->fl (syntax->datum #'n))))
   (pattern e:fixnum-expr
            #:with opt #'(unsafe-fx->fl e.opt))
   (pattern e:int-expr

From d65ea9ef3862ace67f942711b794c296e400cb43 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 4 Aug 2010 11:02:33 -0400
Subject: [PATCH 055/198] Unbox literals at expansion time.

original commit: 1105e70b302416c40269c11e60d7ddaa3d14b66e
---
 .../optimizer/inexact-complex.rkt             | 27 ++++++++++++++++++-
 1 file changed, 26 insertions(+), 1 deletion(-)

diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt
index 5fed8415..d74a9ea6 100644
--- a/collects/typed-scheme/optimizer/inexact-complex.rkt
+++ b/collects/typed-scheme/optimizer/inexact-complex.rkt
@@ -255,7 +255,32 @@
            #:with imag-binding (cadr (syntax->list #'unboxed-info))
            #:with (bindings ...) #'())
   
-  ;; else, do the unboxing here  
+  ;; else, do the unboxing here
+
+  ;; we can unbox literals right away
+  (pattern (quote n)
+           #:when (let ((x (syntax->datum #'n)))
+                    (and (number? x)
+                         (not (eq? (imag-part x) 0))))
+           #:with real-binding (unboxed-gensym)
+           #:with imag-binding (unboxed-gensym)
+           #:with (bindings ...)
+           (let ((n (syntax->datum #'n)))
+             #`(((real-binding) #,(datum->syntax
+                                   #'here
+                                   (exact->inexact (real-part n))))
+                ((imag-binding) #,(datum->syntax
+                                   #'here
+                                   (exact->inexact (imag-part n)))))))
+  (pattern (quote n)
+           #:when (real? (syntax->datum #'n))
+           #:with real-binding (unboxed-gensym)
+           #:with imag-binding #f
+           #:with (bindings ...)
+           #`(((real-binding) #,(datum->syntax
+                                 #'here
+                                 (exact->inexact (syntax->datum #'n))))))
+  
   (pattern e:expr
            #:when (isoftype? #'e -InexactComplex)
            #:with e* (unboxed-gensym)

From d1e64146d46945390893d71fb48f8e039be609ad Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 4 Aug 2010 13:17:15 -0400
Subject: [PATCH 056/198] Fixed parsing of keyword types.

original commit: 416591b35532d117bb70acf7a8282329b626c27b
---
 collects/typed-scheme/private/parse-type.rkt | 15 +++++++++++----
 1 file changed, 11 insertions(+), 4 deletions(-)

diff --git a/collects/typed-scheme/private/parse-type.rkt b/collects/typed-scheme/private/parse-type.rkt
index bff49836..6005433a 100644
--- a/collects/typed-scheme/private/parse-type.rkt
+++ b/collects/typed-scheme/private/parse-type.rkt
@@ -88,6 +88,13 @@
   (pattern (~seq [k:keyword t:expr])
            #:attr Keyword (make-Keyword (syntax-e #'k) (parse-type #'t) #f)))
 
+(define-syntax-class non-keyword-ty
+  (pattern (k e:expr ...)
+           #:when (not (keyword? (syntax->datum #'k))))
+  (pattern t:expr
+           #:when (and (not (keyword? (syntax->datum #'t)))
+                       (not (syntax->list #'t)))))
+
 (define-syntax-class path-elem
   #:description "path element"
   #:literals (car cdr)
@@ -214,7 +221,7 @@
        (add-type-name-reference #'kw)
        ;; use parse-type instead of parse-values-type because we need to add the filters from the pred-ty
        (make-pred-ty (list (parse-type #'dom)) (parse-type #'rng) (attribute latent.type) 0 (attribute latent.path))]
-      [(dom:expr ... rest:expr ddd:star kws:keyword-tys ... (~and kw t:->) rng)
+      [(dom:non-keyword-ty ... rest:non-keyword-ty ddd:star kws:keyword-tys ... (~and kw t:->) rng)
        (add-type-name-reference #'kw)
        (make-Function
         (list (make-arr
@@ -222,7 +229,7 @@
                (parse-values-type #'rng)
                #:rest (parse-type #'rest)
                #:kws (attribute kws.Keyword))))]
-      [(dom:expr ... rest:expr :ddd/bound (~and kw t:->) rng)
+      [(dom:non-keyword-ty ... rest:non-keyword-ty :ddd/bound (~and kw t:->) rng)
        (add-type-name-reference #'kw)
        (let* ([bnd (syntax-e #'bound)])
          (unless (bound-index? bnd)
@@ -236,7 +243,7 @@
                           (extend-tvars (list bnd)
                             (parse-type #'rest))
                           bnd))))]
-      [(dom:expr ... rest:expr _:ddd (~and kw t:->) rng)
+      [(dom:non-keyword-ty ... rest:non-keyword-ty _:ddd (~and kw t:->) rng)
        (add-type-name-reference #'kw)
        (let ([var (infer-index stx)])
          (make-Function
@@ -251,7 +258,7 @@
       (->* (map parse-type (syntax->list #'(dom ...)))
            (parse-values-type #'rng))]     |#
       ;; use expr to rule out keywords
-      [(dom:expr ... kws:keyword-tys ... (~and kw t:->) rng)
+      [(dom:non-keyword-ty ... kws:keyword-tys ... (~and kw t:->) rng)
        (add-type-name-reference #'kw)
       (let ([doms (for/list ([d (syntax->list #'(dom ...))])
                     (parse-type d))])

From a29f10633f5ff7434b1ae25972b04c3c8962c8a4 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 4 Aug 2010 15:08:27 -0400
Subject: [PATCH 057/198] Added another tracing option to TR.

original commit: 0b3c637f5d5215e3fced3e83433119524145b488
---
 collects/typed-scheme/tc-setup.rkt    | 3 +++
 collects/typed-scheme/utils/utils.rkt | 3 ++-
 2 files changed, 5 insertions(+), 1 deletion(-)

diff --git a/collects/typed-scheme/tc-setup.rkt b/collects/typed-scheme/tc-setup.rkt
index e3288fe8..04f05fdb 100644
--- a/collects/typed-scheme/tc-setup.rkt
+++ b/collects/typed-scheme/tc-setup.rkt
@@ -3,6 +3,7 @@
 (require (rename-in "utils/utils.rkt" [infer r:infer])
          (except-in syntax/parse id)
          unstable/mutated-vars
+         racket/pretty
          scheme/base
          (private type-contract)
          (types utils convenience)
@@ -51,6 +52,8 @@
                      [type-name-references null])
         (do-time "Initialized Envs")
         (let ([fully-expanded-stx (local-expand stx expand-ctxt null)])
+          (when (show-input?)
+            (pretty-print (syntax->datum fully-expanded-stx)))
           (do-time "Local Expand Done")
           (parameterize ([mutated-vars (find-mutated-vars fully-expanded-stx)]
                          [orig-module-stx (or (orig-module-stx) orig-stx)]
diff --git a/collects/typed-scheme/utils/utils.rkt b/collects/typed-scheme/utils/utils.rkt
index afed7b55..47c621d1 100644
--- a/collects/typed-scheme/utils/utils.rkt
+++ b/collects/typed-scheme/utils/utils.rkt
@@ -19,7 +19,7 @@ at least theoretically.
  ;; timing
  start-timing do-time  
  ;; logging
- printf/log
+ printf/log show-input?
  ;; struct printing
  custom-printer define-struct/printer
  ;; provide macros
@@ -27,6 +27,7 @@ at least theoretically.
 
 (define optimize? (make-parameter #f))
 (define-for-syntax enable-contracts? #f)
+(define show-input? (make-parameter #f))
 
 ;; fancy require syntax
 (define-syntax (define-requirer stx)

From ece22fd4fd7c0680f9c2e8b7a52b3ef81263071f Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 4 Aug 2010 15:52:41 -0400
Subject: [PATCH 058/198] Added opt-lambda:.

original commit: 4cb749130954c821754fd976d92c02aca2013429
---
 .../typed-scheme/private/annotate-classes.rkt | 22 +++++++++++++++++++
 collects/typed-scheme/private/prims.rkt       | 15 +++++++++++++
 2 files changed, 37 insertions(+)

diff --git a/collects/typed-scheme/private/annotate-classes.rkt b/collects/typed-scheme/private/annotate-classes.rkt
index e9d65a81..92c788cd 100644
--- a/collects/typed-scheme/private/annotate-classes.rkt
+++ b/collects/typed-scheme/private/annotate-classes.rkt
@@ -63,3 +63,25 @@
                                               (~or rest:annotated-star-rest rest:annotated-dots-rest)))
            #:with ann-formals #'(n.ann-name ... . rest.ann-name)
            #:with (arg-ty ...) #'(n.ty ... . rest.formal-ty)))
+
+(define-syntax-class opt-lambda-annotated-formal
+  #:description "annotated variable, potentially with a default value"
+  #:opaque
+  #:attributes (name ty ann-name)
+  (pattern [:annotated-name])
+  (pattern [n:annotated-name val]
+           #:with name #'n.name
+           #:with ty #'n.name
+           #:with ann-name #'(n.ann-name val)))
+
+(define-syntax-class opt-lambda-annotated-formals
+  #:attributes (ann-formals (arg-ty 1))
+  #:literals (:)
+  (pattern (n:opt-lambda-annotated-formal ...)
+           #:with ann-formals #'(n.ann-name ...)
+           #:with (arg-ty ...) #'(n.ty ...))
+  (pattern (n:opt-lambda-annotated-formal ...
+            (~describe "dotted or starred type"
+                       (~or rest:annotated-star-rest rest:annotated-dots-rest)))
+           #:with ann-formals #'(n.ann-name ... . rest.ann-name)
+           #:with (arg-ty ...) #'(n.ty ... . rest.formal-ty)))
diff --git a/collects/typed-scheme/private/prims.rkt b/collects/typed-scheme/private/prims.rkt
index cef82b22..980675b3 100644
--- a/collects/typed-scheme/private/prims.rkt
+++ b/collects/typed-scheme/private/prims.rkt
@@ -27,6 +27,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
 
 (require "../utils/utils.rkt"
          racket/base
+         mzlib/etc
 	 (for-syntax 
           syntax/parse
 	  syntax/private/util
@@ -173,6 +174,15 @@ This file defines two sorts of primitives. All of them are provided into any mod
                            'typechecker:plambda
                            #'(tvars ...))))]))
 
+(define-syntax (popt-lambda: stx)
+  (syntax-parse stx
+    [(popt-lambda: (tvars:id ...) formals . body)
+     (quasisyntax/loc stx
+       (#%expression
+        #,(syntax-property (syntax/loc stx (opt-lambda: formals . body))
+                           'typechecker:plambda
+                           #'(tvars ...))))]))
+
 (define-syntax (pdefine: stx)
   (syntax-parse stx #:literals (:)
     [(pdefine: (tvars:id ...) (nm:id . formals:annotated-formals) : ret-ty . body)
@@ -223,6 +233,11 @@ This file defines two sorts of primitives. All of them are provided into any mod
     [(case-lambda: [formals:annotated-formals . body] ...)
      (syntax/loc stx (case-lambda [formals.ann-formals . body] ...))]))
 
+(define-syntax (opt-lambda: stx)
+  (syntax-parse stx
+    [(opt-lambda: formals:opt-lambda-annotated-formals . body)
+     (syntax/loc stx (opt-lambda formals.ann-formals . body))]))
+
 (define-syntaxes (let-internal: let*: letrec:)
   (let ([mk (lambda (form)
               (lambda (stx)

From 79f4bcfbdb5c3f5ec690d298438de3d68bcafde7 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 4 Aug 2010 17:13:55 -0400
Subject: [PATCH 059/198] Generalize naturals to integers to minimize
 annotations on mutated variables.

original commit: b18f2353cab9712c827dda692649bcd16bc3e79e
---
 collects/tests/typed-scheme/succeed/metrics.rkt  | 16 ++++++++--------
 .../tests/typed-scheme/succeed/new-metrics.rkt   | 14 +++++++-------
 .../typed-scheme/unit-tests/typecheck-tests.rkt  |  4 ++--
 .../private/base-env-indexing-abs.rkt            |  2 +-
 4 files changed, 18 insertions(+), 18 deletions(-)

diff --git a/collects/tests/typed-scheme/succeed/metrics.rkt b/collects/tests/typed-scheme/succeed/metrics.rkt
index 04a679fb..8839c7dd 100644
--- a/collects/tests/typed-scheme/succeed/metrics.rkt
+++ b/collects/tests/typed-scheme/succeed/metrics.rkt
@@ -84,11 +84,11 @@
            [table
             `((,a-hits ,b-hits)
               (,a-misses ,b-misses))]
-           [expected (lambda: ([i : Natural] [j : Natural])
+           [expected (lambda: ([i : Integer] [j : Integer])
                               (/ (* (row-total i table) (col-total j table)) total-subjects))])
       (exact->inexact 
        (table-sum 
-        (lambda: ([i : Natural] [j : Natural])
+        (lambda: ([i : Integer] [j : Integer])
                  (/ (sqr (- (expected i j) (table-ref i j table))) (expected i j)))
         table)))))
 
@@ -473,7 +473,7 @@
           (show result ))))
 
 ;; applies only to the combined metric [or more generally to listof-answer results]
-(pdefine: (a b c) (total [experiment-number : Natural] [result : (Result (Listof number) b c)]) : (Listof number)
+(pdefine: (a b c) (total [experiment-number : Integer] [result : (Result (Listof number) b c)]) : (Listof number)
           (define: (total/s [s : Table]) : number (apply + (list-ref (pivot s) experiment-number)))
           (list (total/s (result-seqA result)) (total/s (result-seqB result))))
 
@@ -491,7 +491,7 @@
             [(null? l) '()]
             [else
              (let ([n (length (car l))])
-               (build-list n (lambda: ([i : Natural]) (map (lambda: ([j : (Listof X)]) (list-ref j i)) l))))]))
+               (build-list n (lambda: ([i : Integer]) (map (lambda: ([j : (Listof X)]) (list-ref j i)) l))))]))
 
 (define: (sqr [x : Real]) : Real (* x x))
 (define: (variance [xs : (Listof Real)]): Real
@@ -499,13 +499,13 @@
     (/ (apply + (map (lambda: ([x : number]) (sqr (- x avg))) xs))
        (sub1 (length xs)))))
 
-(define: (table-ref [i : Natural] [j : Natural] [table : Table]): number
+(define: (table-ref [i : Integer] [j : Integer] [table : Table]): number
   (list-ref (list-ref table i) j))
-(define: (row-total [i : Natural] [table : Table]) : number
+(define: (row-total [i : Integer] [table : Table]) : number
   (apply + (list-ref table i)))
-(define: (col-total [j : Natural] [table : Table]) : number
+(define: (col-total [j : Integer] [table : Table]) : number
   (apply + (map (lambda: ([x : (Listof number)]) (list-ref x j)) table)))
-(define: (table-sum [f : (Natural Natural -> Real)] [table : Table]) : number
+(define: (table-sum [f : (Integer Integer -> Real)] [table : Table]) : number
   (let ([rows (length table)]
         [cols (length (car table))])
     (let loop ([i 0] [j 0] [#{sum : Real} 0])
diff --git a/collects/tests/typed-scheme/succeed/new-metrics.rkt b/collects/tests/typed-scheme/succeed/new-metrics.rkt
index 5513eda8..4635f79f 100644
--- a/collects/tests/typed-scheme/succeed/new-metrics.rkt
+++ b/collects/tests/typed-scheme/succeed/new-metrics.rkt
@@ -61,7 +61,7 @@
            [table
             `((,a-hits ,b-hits)
               (,a-misses ,b-misses))]
-           [expected (λ: ([i : Natural] [j : Natural])
+           [expected (λ: ([i : Integer] [j : Integer])
                          (/ (* (row-total i table) (col-total j table)) total-subjects))])
       (exact->inexact 
        (table-sum 
@@ -425,7 +425,7 @@
           (show result))))
 
 ;; applies only to the combined metric [or more generally to listof-answer results]
-(: total (All (b c) (Natural (result (Listof Number) b c) -> (Listof Number))))
+(: total (All (b c) (Integer (result (Listof Number) b c) -> (Listof Number))))
 (define (total experiment-number result)
   (: total/s (Table -> Number))
   (define (total/s s) (apply + (list-ref (pivot s) experiment-number)))
@@ -447,7 +447,7 @@
     [(null? l) '()]
     [else
      (let ([n (length (car l))])
-       (build-list n (λ: ([i : Natural]) (map (λ: ([j : (Listof X)]) (list-ref j i)) l))))]))
+       (build-list n (λ: ([i : Integer]) (map (λ: ([j : (Listof X)]) (list-ref j i)) l))))]))
 
 (: variance ((Listof Number) -> Number))
 (define (variance xs)
@@ -455,16 +455,16 @@
     (/ (apply + (map (λ: ([x : Number]) (sqr (- x avg))) xs))
        (sub1 (length xs)))))
 
-(: table-ref (Natural Natural Table -> Number))
+(: table-ref (Integer Integer Table -> Number))
 (define (table-ref i j table)
   (list-ref (list-ref table i) j))
-(: row-total (Natural Table -> Number))
+(: row-total (Integer Table -> Number))
 (define (row-total i table)
   (apply + (list-ref table i)))
-(: col-total (Natural Table -> Number))
+(: col-total (Integer Table -> Number))
 (define (col-total j table)
   (apply + (map (λ: ([x : (Listof Number)]) (list-ref x j)) table)))
-(: table-sum ((Natural Natural -> Number) Table -> Number))
+(: table-sum ((Integer Integer -> Number) Table -> Number))
 (define (table-sum f table)
   (let ([rows (length table)]
         [cols (length (car table))])
diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
index 406dc955..e03ec46d 100644
--- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
+++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
@@ -154,10 +154,10 @@
         [tc-e (void) -Void]
         [tc-e (void 3 4) -Void]
         [tc-e (void #t #f '(1 2 3)) -Void]
-        [tc-e/t #(3 4 5) (make-HeterogenousVector (list -Nat -Nat -Nat))]
+        [tc-e/t #(3 4 5) (make-HeterogenousVector (list -Integer -Integer -Integer))]
         [tc-e/t '(2 3 4) (-lst* -PositiveFixnum -PositiveFixnum -PositiveFixnum)]
         [tc-e/t '(2 3 #t) (-lst* -PositiveFixnum -PositiveFixnum (-val #t))]
-        [tc-e/t #(2 3 #t) (make-HeterogenousVector (list -Nat -Nat (-val #t)))]
+        [tc-e/t #(2 3 #t) (make-HeterogenousVector (list -Integer -Integer (-val #t)))]
         [tc-e/t '(#t #f) (-lst* (-val #t) (-val #f))]
         [tc-e/t (plambda: (a) ([l : (Listof a)]) (car l))
                 (make-Poly '(a) (t:-> (make-Listof (-v a)) (-v a)))]
diff --git a/collects/typed-scheme/private/base-env-indexing-abs.rkt b/collects/typed-scheme/private/base-env-indexing-abs.rkt
index a2525f1d..c4c852d2 100644
--- a/collects/typed-scheme/private/base-env-indexing-abs.rkt
+++ b/collects/typed-scheme/private/base-env-indexing-abs.rkt
@@ -137,7 +137,7 @@
    [unsafe-vector-set! (-poly (a) (-> (-vec a) index-type a -Void))]
    [unsafe-vector*-set! (-poly (a) (-> (-vec a) index-type a -Void))]
    [vector-copy! (-poly (a) ((-vec a) index-type (-vec a) [index-type index-type] . ->opt . -Void))]
-   [make-vector (-poly (a) (cl-> [(index-type) (-vec (Un -Nat a))]
+   [make-vector (-poly (a) (cl-> [(index-type) (-vec (Un -Integer a))]
                                  [(index-type a) (-vec a)]))]
 
    [bytes-ref (-> -Bytes index-type -NonnegativeFixnum)]

From 507afc21f4bc2b2d2d42b9bfe9caae3d9a9c2754 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 4 Aug 2010 17:46:03 -0400
Subject: [PATCH 060/198] Fixed source location for for:.

original commit: 500685c0f2b02ccc8ffb8746d93fde5b25a20ccc
---
 collects/typed-scheme/private/prims.rkt | 8 ++++----
 1 file changed, 4 insertions(+), 4 deletions(-)

diff --git a/collects/typed-scheme/private/prims.rkt b/collects/typed-scheme/private/prims.rkt
index 980675b3..bf9cdbc8 100644
--- a/collects/typed-scheme/private/prims.rkt
+++ b/collects/typed-scheme/private/prims.rkt
@@ -451,7 +451,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
          (syntax-parse clauses
            [(head:for-clause next:for-clause ... #:when rest ...)
             (syntax-property
-             (quasisyntax/loc clauses
+             (quasisyntax/loc stx
                (for
                 (head.expand next.expand ...)
                 #,(loop #'(#:when rest ...))))
@@ -459,18 +459,18 @@ This file defines two sorts of primitives. All of them are provided into any mod
              #'Void)]
            [(head:for-clause ...) ; we reached the end
             (syntax-property
-             (quasisyntax/loc clauses
+             (quasisyntax/loc stx
                (for
                 (head.expand ...)
                 #,@body))
              'type-ascription
              #'Void)]
            [(#:when guard) ; we end on a #:when clause
-            (quasisyntax/loc clauses
+            (quasisyntax/loc stx
               (when guard
                 #,@body))]
            [(#:when guard rest ...)
-            (quasisyntax/loc clauses
+            (quasisyntax/loc stx
               (when guard
                 #,(loop #'(rest ...))))])))]))
 

From 019ea62c25b9604d97ef653d05d4bf00ba59c4c9 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 5 Aug 2010 17:21:54 -0400
Subject: [PATCH 061/198] Added a test for unboxed nested loops.

original commit: 4d43c2156562540bcd70cf91a4c712b1546f9f2e
---
 .../optimizer/generic/nested-let-loop.rkt         | 15 +++++++++++++++
 1 file changed, 15 insertions(+)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/nested-let-loop.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/nested-let-loop.rkt b/collects/tests/typed-scheme/optimizer/generic/nested-let-loop.rkt
new file mode 100644
index 00000000..a63ed243
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/nested-let-loop.rkt
@@ -0,0 +1,15 @@
+#lang typed/scheme #:optimize
+
+(require racket/unsafe/ops)
+
+(let: loop1 : Inexact-Complex
+      ((x : (Listof Inexact-Complex) '(1.0+2.0i 2.0+4.0i))
+       (r : Inexact-Complex 0.0+0.0i))
+      (if (null? x)
+          r
+          (let: loop2 : Inexact-Complex
+                ((y : (Listof Inexact-Complex) '(3.0+6.0i 4.0+8.0i))
+                 (s : Inexact-Complex 0.0+0.0i))
+                (if (null? y)
+                    (loop1 (cdr x) (+ r s))
+                    (loop2 (cdr y) (+ s (car x) (car y)))))))

From b9ef6ec241873397387c798478431ca74190add0 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 6 Aug 2010 11:09:04 -0400
Subject: [PATCH 062/198] More precise type for expt.

original commit: 0a45e0e361d811ac07440fb24d415502d191583c
---
 collects/typed-scheme/private/base-env-numeric.rkt | 1 +
 1 file changed, 1 insertion(+)

diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt
index 7805bd08..73713950 100644
--- a/collects/typed-scheme/private/base-env-numeric.rkt
+++ b/collects/typed-scheme/private/base-env-numeric.rkt
@@ -397,6 +397,7 @@
                     (-Real -Real . -> . N))]
 [expt (cl->* (-Nat -Nat . -> . -Nat)
              (-Integer -Nat . -> . -Integer)
+             (-Integer -Integer . -> . -ExactRational)
              (-Real -Integer . -> . -Real)
              (-InexactComplex -InexactComplex . -> . -InexactComplex)
              (N N . -> . N))]

From da31c3f9a26b230f32f65b44ae9c592e55b9bde6 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 6 Aug 2010 12:21:50 -0400
Subject: [PATCH 063/198] Documented TR's behavior on literals.

original commit: 201aaa9090b3aeedc0454bdd575565f8764ef2c8
---
 .../scribblings/optimization.scrbl            | 19 ++++++++++++++++++-
 1 file changed, 18 insertions(+), 1 deletion(-)

diff --git a/collects/typed-scheme/scribblings/optimization.scrbl b/collects/typed-scheme/scribblings/optimization.scrbl
index 20073dc9..4f82a1ab 100644
--- a/collects/typed-scheme/scribblings/optimization.scrbl
+++ b/collects/typed-scheme/scribblings/optimization.scrbl
@@ -54,7 +54,9 @@ Typed Racket's optimizer can optimize the latter program to use
 former program.
 
 Thus, to get the most of Typed Racket's optimizer, you should use the
-@racket[Float] type when possible.
+@racket[Float] type when possible. For similar reasons, you should use
+floating-point literals instead of exact literals when doing
+floating-point computations.
 
 On a similar note, the @racket[Inexact-Complex] type is preferable to
 the @racket[Complex] type for the same reason. Typed Racket can keep
@@ -68,6 +70,21 @@ represent
 @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{complex numbers}
 as two
 @tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{real numbers}.
+As with floating-point literals,
+@tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key
+"inexact numbers"]{inexact}
+@tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key
+"complex numbers"]{complex}
+literals (such as @racket[1.0+1.0i]) should be preferred over exact
+@tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key
+"complex numbers"]{complex}
+literals (such as @racket[1+1i]). Note that both parts of a literal must be
+present and
+@tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key
+"inexact numbers"]{inexact}
+for the literal to be of type
+@racket[Inexact-Complex]; @racket[0.0+1.0i] is of type
+@racket[Inexact-Complex] but @racket[+1.0i] is not.
 To get the most of
 Typed Racket's optimizer, you should also favor rectangular
 coordinates over polar coordinates.

From 21da67fbd9b1c9441547495132aba23dc5c80ae4 Mon Sep 17 00:00:00 2001
From: Stevie Strickland <sstrickl@racket-lang.org>
Date: Thu, 12 Aug 2010 17:38:18 -0400
Subject: [PATCH 064/198] Fix creation of a reversed List type from ListDots
 substitution.

original commit: a9f6ea69bfbb23d4e6ab1b5ebfcb6bb9e3b3c05a
---
 collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt | 3 +++
 collects/typed-scheme/types/substitute.rkt                 | 2 +-
 2 files changed, 4 insertions(+), 1 deletion(-)

diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
index e03ec46d..75f94b57 100644
--- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
+++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
@@ -640,6 +640,9 @@
                         (apply (plambda: (b ...) ([x : Number] . [y : Number ... b]) x)
                                1 w))
               (-polydots (a) ((list -String) (N a) . ->... . N))]
+        [tc-e/t (let ([f (plambda: (a ...) [w : a ... a] w)])
+                  (f 1 "hello" #\c))
+                (-pair -PositiveFixnum (-pair -String (-pair -Char (-val null))))]
         ;; instantiating non-dotted terms
         [tc-e/t (inst (plambda: (a) ([x : a]) x) Integer)
                 (make-Function (list (make-arr* (list -Integer) -Integer
diff --git a/collects/typed-scheme/types/substitute.rkt b/collects/typed-scheme/types/substitute.rkt
index a2957404..f148e8bc 100644
--- a/collects/typed-scheme/types/substitute.rkt
+++ b/collects/typed-scheme/types/substitute.rkt
@@ -71,7 +71,7 @@
                                  ;; We need to recur first, just to expand out any dotted usages of this.
                                  (let ([expanded (sb dty)])
                                    (for/fold ([t (make-Value null)])
-                                     ([img images])
+                                     ([img (reverse images)])
                                      (make-Pair (substitute img name expanded) t)))
                                  (make-ListDots (sb dty) dbound))]
                  [#:ValuesDots types dty dbound

From 6369cdb91c115cc7c74181a73e03cc948206aef2 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Fri, 6 Aug 2010 10:40:17 -0400
Subject: [PATCH 065/198] Require flat contracts in box/c, hash/c, and
 vector/c.

Closes PR 11085.

original commit: 0c1dfd3c5e3490fedf2ec27b7aed962bd0cbd174
---
 collects/tests/typed-scheme/succeed/ho-box.rkt  |  6 ++++++
 collects/typed-scheme/private/type-contract.rkt | 17 ++++++++++-------
 2 files changed, 16 insertions(+), 7 deletions(-)
 create mode 100644 collects/tests/typed-scheme/succeed/ho-box.rkt

diff --git a/collects/tests/typed-scheme/succeed/ho-box.rkt b/collects/tests/typed-scheme/succeed/ho-box.rkt
new file mode 100644
index 00000000..35edc08e
--- /dev/null
+++ b/collects/tests/typed-scheme/succeed/ho-box.rkt
@@ -0,0 +1,6 @@
+#lang typed/racket
+
+(: f (Boxof (Number -> Number)))
+(define f (box (lambda: ([x : Number]) x)))
+
+(provide f)
diff --git a/collects/typed-scheme/private/type-contract.rkt b/collects/typed-scheme/private/type-contract.rkt
index 4d8d6bf8..ebf7ba12 100644
--- a/collects/typed-scheme/private/type-contract.rkt
+++ b/collects/typed-scheme/private/type-contract.rkt
@@ -55,9 +55,11 @@
 (define (type->contract ty fail #:out [out? #f] #:typed-side [from-typed? #t] #:flat [flat? #f])
   (define vars (make-parameter '()))
   (let/ec exit
-    (let loop ([ty ty] [pos? #t] [from-typed? from-typed?] [structs-seen null])
-      (define (t->c t #:seen [structs-seen structs-seen]) (loop t pos? from-typed? structs-seen))
-      (define (t->c/neg t #:seen [structs-seen structs-seen]) (loop t (not pos?) (not from-typed?) structs-seen))
+    (let loop ([ty ty] [pos? #t] [from-typed? from-typed?] [structs-seen null] [flat? flat?])
+      (define (t->c t #:seen [structs-seen structs-seen] #:flat [flat? flat?])
+        (loop t pos? from-typed? structs-seen flat?))
+      (define (t->c/neg t #:seen [structs-seen structs-seen] #:flat [flat? flat?])
+        (loop t (not pos?) (not from-typed?) structs-seen flat?))
       (define (t->c/fun f #:method [method? #f])
         (match f
           [(Function: (list (top-arr:))) #'procedure?]
@@ -128,9 +130,9 @@
              #'(or/c . cnts)))]
         [(and t (Function: _)) (t->c/fun t)]
         [(Vector: t)
-         #`(vectorof #,(t->c t))]
+         #`(vectorof #,(t->c t #:flat #t))]
         [(Box: t)
-         #`(box/c #,(t->c t))]
+         #`(box/c #,(t->c t #:flat #t))]
         [(Pair: t1 t2)
          #`(cons/c #,(t->c t1) #,(t->c t2))]
         [(Opaque: p? cert)
@@ -177,7 +179,8 @@
                            [cnt-name nm]
                            [(fld-cnts ...)
                             (for/list ([fty flds]
-                                       [f-acc acc-ids])
+                                       [f-acc acc-ids]
+                                       [m? mut?])
                               #`(((contract-projection
                                    #,(t->c fty #:seen (cons (cons ty #'(recursive-contract rec)) structs-seen)))
                                   blame)
@@ -196,7 +199,7 @@
         [(Syntax: t) #`(syntax/c #,(t->c t))]
         [(Value: v) #`(flat-named-contract #,(format "~a" v) (lambda (x) (equal? x '#,v)))]
         [(Param: in out) #`(parameter/c #,(t->c out))]
-	[(Hashtable: k v) #`(hash/c #,(t->c k) #,(t->c v) #:immutable 'dont-care)]
+	[(Hashtable: k v) #`(hash/c #,(t->c k #:flat #t) #,(t->c v #:flat #t) #:immutable 'dont-care)]
         [else          
          (exit (fail))]))))
 

From 4d5a707d99697087051ee5a0b824c503ce02a6e1 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Fri, 6 Aug 2010 15:59:52 -0400
Subject: [PATCH 066/198] Handle structs with special constructors and
 mutability.

Closes PR 11089.

original commit: 3359032ad58d94c9447bf842d8abcf3ad98b41fd
---
 .../tests/typed-scheme/succeed/struct:-mutable.rkt     |  6 ++++++
 collects/typed-scheme/typecheck/tc-toplevel.rkt        | 10 +++++++++-
 2 files changed, 15 insertions(+), 1 deletion(-)
 create mode 100644 collects/tests/typed-scheme/succeed/struct:-mutable.rkt

diff --git a/collects/tests/typed-scheme/succeed/struct:-mutable.rkt b/collects/tests/typed-scheme/succeed/struct:-mutable.rkt
new file mode 100644
index 00000000..3ea0c171
--- /dev/null
+++ b/collects/tests/typed-scheme/succeed/struct:-mutable.rkt
@@ -0,0 +1,6 @@
+#lang typed/racket
+
+(struct: foo ([x : Integer]) #:mutable)
+
+(: f (Integer -> foo))
+(define (f x) (foo x))
\ No newline at end of file
diff --git a/collects/typed-scheme/typecheck/tc-toplevel.rkt b/collects/typed-scheme/typecheck/tc-toplevel.rkt
index 5acdfdbb..bb330b89 100644
--- a/collects/typed-scheme/typecheck/tc-toplevel.rkt
+++ b/collects/typed-scheme/typecheck/tc-toplevel.rkt
@@ -97,6 +97,11 @@
                                 (#%plain-app values)))
        (tc/struct #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...)) 
 		  #:maker #'m)]
+      [(define-values () (begin (quote-syntax (define-typed-struct-internal nm ([fld : ty] ...)
+						#:maker m #:mutable)) 
+                                (#%plain-app values)))
+       (tc/struct #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...)) 
+		  #:maker #'m #:mutable #t)]
       [(define-values () (begin (quote-syntax (define-typed-struct-internal (vars ...) nm ([fld : ty] ...)
 						#:maker m)) 
                                 (#%plain-app values)))
@@ -107,7 +112,10 @@
        (tc/struct #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...)) #:type-only #t)]
       ;; define-typed-struct w/ polymorphism
       [(define-values () (begin (quote-syntax (define-typed-struct-internal (vars ...) nm ([fld : ty] ...))) (#%plain-app values)))
-       (tc/poly-struct (syntax->list #'(vars ...)) #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...)))]    
+       (tc/poly-struct (syntax->list #'(vars ...)) #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...)))]
+      ;; error in other cases
+      [(define-values () (begin (quote-syntax (define-typed-struct-internal . _)) (#%plain-app values)))
+       (int-err "unknown structure form")]
       
       ;; executable structs - this is a big hack
       [(define-values () (begin (quote-syntax (define-typed-struct/exec-internal nm ([fld : ty] ...) proc-ty)) (#%plain-app values)))

From f9b31465773f1947c5ecb337eb220c51c28803d3 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Fri, 13 Aug 2010 10:43:49 -0400
Subject: [PATCH 067/198] Fix variance of hash tables and parameters

original commit: 6e489f8464d2bc60e64a03e3c618e8ebf7561129
---
 collects/typed-scheme/rep/type-rep.rkt | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/collects/typed-scheme/rep/type-rep.rkt b/collects/typed-scheme/rep/type-rep.rkt
index f942dc8b..ade9bffa 100644
--- a/collects/typed-scheme/rep/type-rep.rkt
+++ b/collects/typed-scheme/rep/type-rep.rkt
@@ -330,11 +330,14 @@
 
 ;; in : Type
 ;; out : Type
-(dt Param ([in Type/c] [out Type/c]) [#:key 'parameter])
+(dt Param ([in Type/c] [out Type/c]) 
+    [#:key 'parameter]
+    [#:frees (λ (f) (combine-frees (list (f out) (flip-variances (f in)))))])
 
 ;; key : Type
 ;; value : Type
-(dt Hashtable ([key Type/c] [value Type/c]) [#:key 'hash])
+(dt Hashtable ([key Type/c] [value Type/c]) [#:key 'hash]
+    [#:frees (λ (f) (combine-frees (list (make-invariant (f key)) (make-invariant (f value)))))])
 
 ;; parent : Type
 ;; pred : Identifier

From f2b9a8fe2c8f88dc62f75aa1b79b082fd1fee184 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 11 Aug 2010 20:00:01 -0400
Subject: [PATCH 068/198] Documented TR's behavior when mixing exactness.

original commit: cf692e986d2a3690260884d929daae321d21eeb3
---
 collects/typed-scheme/scribblings/optimization.scrbl | 8 ++++++++
 1 file changed, 8 insertions(+)

diff --git a/collects/typed-scheme/scribblings/optimization.scrbl b/collects/typed-scheme/scribblings/optimization.scrbl
index 4f82a1ab..0431cfdc 100644
--- a/collects/typed-scheme/scribblings/optimization.scrbl
+++ b/collects/typed-scheme/scribblings/optimization.scrbl
@@ -58,6 +58,14 @@ Thus, to get the most of Typed Racket's optimizer, you should use the
 floating-point literals instead of exact literals when doing
 floating-point computations.
 
+When mixing floating-point numbers and exact reals in arithmetic
+operations, the result is not necessarily a @racket[Float]. For
+instance, the result of @racket[(* 2.0 0)] is @racket[0] which is not
+a @racket[Float]. This can result in missed optimizations. To prevent
+this, when mixing floating-point numbers and exact reals, coerce exact
+reals to floating-point numbers using @racket[exact->inexact]. This is
+not necessary when using @racket[+] or @racket[-].
+
 On a similar note, the @racket[Inexact-Complex] type is preferable to
 the @racket[Complex] type for the same reason. Typed Racket can keep
 @tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key

From 04481bfb648e6c889b92b18d2fdc350cc8160026 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 18 Aug 2010 16:34:43 -0400
Subject: [PATCH 069/198] Better printing for environments.

original commit: 510c80b70077f09d0d5d54c5ba566abaeb59316e
---
 collects/typed-scheme/env/type-env-structs.rkt | 12 ++++++++++--
 1 file changed, 10 insertions(+), 2 deletions(-)

diff --git a/collects/typed-scheme/env/type-env-structs.rkt b/collects/typed-scheme/env/type-env-structs.rkt
index 1d9047b9..ccedb246 100644
--- a/collects/typed-scheme/env/type-env-structs.rkt
+++ b/collects/typed-scheme/env/type-env-structs.rkt
@@ -20,8 +20,16 @@
 
 ;; eq? has the type of equal?, and l is an alist (with conses!)
 ;; props is a list of known propositions
-(r:d-s/c env ([l (and/c (not/c dict-mutable?) dict?)]) #:transparent)
-(r:d-s/c (prop-env env) ([props (listof Filter/c)]) #:transparent)
+(r:d-s/c env ([l (and/c (not/c dict-mutable?) dict?)]) 
+         #:transparent
+         #:property prop:custom-write
+         (lambda (e prt mode)
+           (fprintf prt "(env ~a)" (dict-map (env-l e) list))))
+(r:d-s/c (prop-env env) ([props (listof Filter/c)])
+         #:transparent
+         #:property prop:custom-write
+         (lambda (e prt mode)
+           (fprintf prt "(env ~a ~a)" (dict-map (env-l e) list) (prop-env-props e))))
 
 (define (mk-env orig dict)
   (match orig

From cb7ab0f8ad46c54667950b7b37ff84eb71e87a5a Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 18 Aug 2010 16:35:03 -0400
Subject: [PATCH 070/198] Provide -> in typed-scheme/no-check.

- Closes PR 10882

original commit: 90eeef60d73229217f87b847b38d180e6a929301
---
 .../tests/typed-scheme/succeed/typed-scheme-no-check-arrow.rkt | 3 +++
 collects/typed-scheme/no-check.rkt                             | 3 ++-
 2 files changed, 5 insertions(+), 1 deletion(-)
 create mode 100644 collects/tests/typed-scheme/succeed/typed-scheme-no-check-arrow.rkt

diff --git a/collects/tests/typed-scheme/succeed/typed-scheme-no-check-arrow.rkt b/collects/tests/typed-scheme/succeed/typed-scheme-no-check-arrow.rkt
new file mode 100644
index 00000000..bfa511c1
--- /dev/null
+++ b/collects/tests/typed-scheme/succeed/typed-scheme-no-check-arrow.rkt
@@ -0,0 +1,3 @@
+#lang typed-scheme/no-check
+(: foo : Void -> Void)
+(define (foo x) x)
\ No newline at end of file
diff --git a/collects/typed-scheme/no-check.rkt b/collects/typed-scheme/no-check.rkt
index ed542f85..fb1ac85d 100644
--- a/collects/typed-scheme/no-check.rkt
+++ b/collects/typed-scheme/no-check.rkt
@@ -3,10 +3,11 @@
 (require 
  (except-in "private/prims.rkt"
             require/typed require/opaque-type require-typed-struct)
+ "private/base-types-extra.rkt"
  (for-syntax scheme/base syntax/parse syntax/struct))
 (provide (all-from-out scheme/base)
 	 (all-defined-out)
-	 (all-from-out "private/prims.rkt"))
+	 (all-from-out "private/prims.rkt" "private/base-types-extra.rkt"))
 
 
 (define-syntax (require/typed stx)

From 69ebe6711bf817972dc06fb2dd91ca26d630d239 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 24 Aug 2010 16:58:21 -0400
Subject: [PATCH 071/198] Fixed the type of file-position.

original commit: a4b0c69ec20074eba319070613ff63d40cd937e0
---
 collects/typed-scheme/private/base-env.rkt | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/collects/typed-scheme/private/base-env.rkt b/collects/typed-scheme/private/base-env.rkt
index 3e45706d..eb2f195d 100644
--- a/collects/typed-scheme/private/base-env.rkt
+++ b/collects/typed-scheme/private/base-env.rkt
@@ -601,7 +601,8 @@
 [flush-output (->opt [-Output-Port] -Void)]
 [file-stream-buffer-mode (cl-> [(-Port) (Un (-val 'none) (-val 'line) (-val 'block) (-val #f))]
                                [(-Port (Un (-val 'none) (-val 'line) (-val 'block))) -Void])]
-[file-position (-> -Port -Nat)]
+[file-position (cl-> [(-Port) -Nat]
+                     [(-Port -Integer) -Void])]
 
 [force (-poly (a) (-> (-Promise a) a))]
 [regexp-replace*

From 7efb07a4b06f80b30edf6aa42732092775214f00 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 25 Aug 2010 10:15:14 -0400
Subject: [PATCH 072/198] Add `Futureof' type, types for `future' and `touch'

original commit: b08de170bc616d2217c6fde3dff8c3f1b042eb3b
---
 .../tests/typed-scheme/succeed/mandelbrot.rkt | 30 +++++++++++++++++++
 collects/typed-scheme/infer/infer-unit.rkt    |  3 ++
 collects/typed-scheme/private/base-env.rkt    |  4 +++
 collects/typed-scheme/private/base-types.rkt  |  1 +
 collects/typed-scheme/rep/type-rep.rkt        |  2 ++
 collects/typed-scheme/types/abbrev.rkt        |  1 +
 collects/typed-scheme/types/printer.rkt       |  1 +
 collects/typed-scheme/types/subtype.rkt       |  2 ++
 8 files changed, 44 insertions(+)
 create mode 100644 collects/tests/typed-scheme/succeed/mandelbrot.rkt

diff --git a/collects/tests/typed-scheme/succeed/mandelbrot.rkt b/collects/tests/typed-scheme/succeed/mandelbrot.rkt
new file mode 100644
index 00000000..95869a6e
--- /dev/null
+++ b/collects/tests/typed-scheme/succeed/mandelbrot.rkt
@@ -0,0 +1,30 @@
+#lang typed/racket/base #:optimize
+(require racket/future racket/flonum)
+(define: MAX-ITERS : Positive-Fixnum 50)
+(define MAX-DIST 2.0)
+(define: N : Positive-Fixnum 512)
+(: mandelbrot-point : Integer Integer -> Integer)
+(define (mandelbrot-point x y)
+  (define c 
+    (+ (- (/ (* 2.0 (->fl x)) N) 1.5)
+       (* 0.0+1.0i (- (/ (* 2.0 (->fl y)) N) 1.0))))
+  (let loop ((i 0) (z 0.0+0.0i))
+    (cond
+      [(> i MAX-ITERS) (char->integer #\*)]
+      [(> (magnitude z) MAX-DIST)
+       (char->integer #\space)]
+      [else (loop (add1 i) (+ (* z z) c))])))
+
+(: fs (Listof (Futureof Bytes)))
+(define fs
+  (for/list ([y (in-range N)])
+    (let ([bstr (make-bytes N)])
+      (future
+       (lambda ()
+         (for ([x (in-range N)])
+           (bytes-set! bstr x (mandelbrot-point x y)))
+         bstr)))))
+#;
+(for: ([f : (Futureof Bytes) (in-list fs)])
+  (write-bytes (touch f))
+  (newline))
diff --git a/collects/typed-scheme/infer/infer-unit.rkt b/collects/typed-scheme/infer/infer-unit.rkt
index e5fff323..9f1cc668 100644
--- a/collects/typed-scheme/infer/infer-unit.rkt
+++ b/collects/typed-scheme/infer/infer-unit.rkt
@@ -476,6 +476,9 @@
           ;; syntax is covariant
           [((Syntax: s1) (Syntax: s2))
            (cg s1 s2)]
+          ;; futures are covariant
+          [((Future: s1) (Future: s2))
+           (cg s1 s2)]
           ;; parameters are just like one-arg functions
           [((Param: in1 out1) (Param: in2 out2))
            (cset-meet (cg in2 in1) (cg out1 out2))]
diff --git a/collects/typed-scheme/private/base-env.rkt b/collects/typed-scheme/private/base-env.rkt
index eb2f195d..bf36ecc5 100644
--- a/collects/typed-scheme/private/base-env.rkt
+++ b/collects/typed-scheme/private/base-env.rkt
@@ -5,6 +5,7 @@
  racket
  racket/unsafe/ops
  racket/fixnum
+ racket/future
  (only-in rnrs/lists-6 fold-left)
  '#%paramz
  "extra-procs.rkt"
@@ -311,6 +312,9 @@
 [thread-try-receive (-> Univ)]
 [thread-rewind-receive (-> (-lst Univ) -Void)]
 
+[future (-poly (A) ((-> A) . -> . (-future A)))]
+[touch (-poly (A) ((-future A) . -> . A))]
+
 [reverse (-poly (a) (-> (-lst a) (-lst a)))]
 [append (-poly (a) (->* (list) (-lst a) (-lst a)))]
 [length (-poly (a) (-> (-lst a) -NonnegativeFixnum))]
diff --git a/collects/typed-scheme/private/base-types.rkt b/collects/typed-scheme/private/base-types.rkt
index ad6104da..8249e11b 100644
--- a/collects/typed-scheme/private/base-types.rkt
+++ b/collects/typed-scheme/private/base-types.rkt
@@ -62,6 +62,7 @@
 [True (-val #t)]
 [Null (-val null)]
 [Nothing (Un)]
+[Futureof (-poly (a) (-future a))]
 [Pairof (-poly (a b) (-pair a b))]
 [MPairof (-poly (a b) (-mpair a b))]
 [MListof (-poly (a) (-mlst a))]
diff --git a/collects/typed-scheme/rep/type-rep.rkt b/collects/typed-scheme/rep/type-rep.rkt
index ade9bffa..46793127 100644
--- a/collects/typed-scheme/rep/type-rep.rkt
+++ b/collects/typed-scheme/rep/type-rep.rkt
@@ -386,6 +386,8 @@
     [#:frees (λ (f) (combine-frees (map f tys)))]
     [#:key #f] [#:fold-rhs (*Sequence (map type-rec-id tys))])
 
+(dt Future ([t Type/c]) [#:key 'future])
+
 ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
 ;; Ugly hack - should use units
diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt
index 6f9ad4e4..635bdc07 100644
--- a/collects/typed-scheme/types/abbrev.rkt
+++ b/collects/typed-scheme/types/abbrev.rkt
@@ -29,6 +29,7 @@
 (define -box make-Box)
 (define -channel make-Channel)
 (define -vec make-Vector)
+(define -future make-Future)
 (define (-seq . args) (make-Sequence args))
 
 (define-syntax *Un
diff --git a/collects/typed-scheme/types/printer.rkt b/collects/typed-scheme/types/printer.rkt
index 2569ab18..4a621008 100644
--- a/collects/typed-scheme/types/printer.rkt
+++ b/collects/typed-scheme/types/printer.rkt
@@ -168,6 +168,7 @@
                                (fp " ~a" i))
                              (fp ")")]
     [(Box: e) (fp "(Boxof ~a)" e)]
+    [(Future: e) (fp "(Futureof ~a)" e)]
     [(Channel: e) (fp "(Channelof ~a)" e)]
     [(Union: elems) (fp "~a" (cons 'U elems))]
     [(Pair: l r) (fp "(Pairof ~a ~a)" l r)]
diff --git a/collects/typed-scheme/types/subtype.rkt b/collects/typed-scheme/types/subtype.rkt
index 6f946a89..6b2c0994 100644
--- a/collects/typed-scheme/types/subtype.rkt
+++ b/collects/typed-scheme/types/subtype.rkt
@@ -393,6 +393,8 @@
 	      ;; subtyping on other stuff
 	      [((Syntax: t) (Syntax: t*))
 	       (subtype* A0 t t*)]
+              [((Future: t) (Future: t*))
+               (subtype* A0 t t*)]
 	      [((Instance: t) (Instance: t*))
 	       (subtype* A0 t t*)]
               [((Class: '() '() (list (and s  (list names  meths )) ...))

From d4b36230034eacb574d31514997cea454f635e3e Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@barzilay.org>
Date: Wed, 25 Aug 2010 16:10:55 -0400
Subject: [PATCH 073/198] Lots of "~e" to "~.s" changes.

original commit: 606b7f60dc597a6870efc11364e1dd3e1a8b4a1b
---
 collects/typed-scheme/utils/tc-utils.rkt | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/typed-scheme/utils/tc-utils.rkt b/collects/typed-scheme/utils/tc-utils.rkt
index 90a96e0f..cc9ca93b 100644
--- a/collects/typed-scheme/utils/tc-utils.rkt
+++ b/collects/typed-scheme/utils/tc-utils.rkt
@@ -54,7 +54,7 @@ don't depend on any other portion of the system
                (and (syntax-transforming?) (syntax-original? (syntax-local-introduce e)))
                #;(and (orig-module-stx) (eq? (debugf syntax-source-module e) (debugf syntax-source-module (orig-module-stx))))
 	       #;(syntax-source-module stx))
-      (log-message l 'warning (format "Typed Scheme has detected unreachable code: ~e" (syntax->datum (locate-stx e)))
+      (log-message l 'warning (format "Typed Scheme has detected unreachable code: ~.s" (syntax->datum (locate-stx e)))
                    e))))
 
 (define (locate-stx stx)

From 8ab581cf2efce5dfc1e80c743d89cf583e1fc2aa Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@barzilay.org>
Date: Wed, 25 Aug 2010 17:16:32 -0400
Subject: [PATCH 074/198] Change a bunch of "~%" and "~n" in format strings to
 "\n".

original commit: 7dc4d2e5a63ab416d90e44d7bf75cb5593329909
---
 collects/typed-scheme/private/colon.rkt        |  4 ++--
 collects/typed-scheme/private/parse-type.rkt   |  8 ++++----
 .../typed-scheme/private/type-annotation.rkt   | 14 +++++++-------
 .../typed-scheme/private/type-env-lang.rkt     |  2 +-
 .../typecheck/check-subforms-unit.rkt          |  4 ++--
 collects/typed-scheme/typecheck/tc-app.rkt     | 12 ++++++------
 collects/typed-scheme/typecheck/tc-apply.rkt   |  8 ++++----
 .../typed-scheme/typecheck/tc-expr-unit.rkt    | 18 +++++++++---------
 collects/typed-scheme/typecheck/tc-if.rkt      | 12 ++++++------
 .../typed-scheme/typecheck/tc-let-unit.rkt     |  6 +++---
 collects/typed-scheme/utils/tc-utils.rkt       |  6 +++---
 11 files changed, 47 insertions(+), 47 deletions(-)

diff --git a/collects/typed-scheme/private/colon.rkt b/collects/typed-scheme/private/colon.rkt
index fb84c179..58152646 100644
--- a/collects/typed-scheme/private/colon.rkt
+++ b/collects/typed-scheme/private/colon.rkt
@@ -12,11 +12,11 @@
   (define-syntax-class arr
     (pattern x:id
              #:fail-unless (eq? (syntax-e #'x) '->) #f
-             #:fail-unless (printf "id: ~a ~a~n"
+             #:fail-unless (printf "id: ~a ~a\n"
                                    (identifier-binding #'All-kw) 
                                    (identifier-transformer-binding #'All-kw)) 
              #f
-             #:fail-unless (printf "kw: ~a ~a~n"
+             #:fail-unless (printf "kw: ~a ~a\n"
                                    (identifier-binding #'t:All) 
                                    (identifier-transformer-binding #'t:All)) 
              #f
diff --git a/collects/typed-scheme/private/parse-type.rkt b/collects/typed-scheme/private/parse-type.rkt
index 6005433a..d542a8e5 100644
--- a/collects/typed-scheme/private/parse-type.rkt
+++ b/collects/typed-scheme/private/parse-type.rkt
@@ -24,7 +24,7 @@
 (define enable-mu-parsing (make-parameter #t))
 
 (define ((parse/id p) loc datum)
-  #;(printf "parse-type/id id : ~a~n ty: ~a~n" (syntax-object->datum loc) (syntax-object->datum stx))
+  #;(printf "parse-type/id id : ~a\n ty: ~a\n" (syntax-object->datum loc) (syntax-object->datum stx))
   (let* ([stx* (datum->syntax loc datum loc loc)])
     (p stx*)))
 
@@ -65,7 +65,7 @@
      (parse-type s)]))
 
 (define (parse-all-type stx parse-type)
-  ;(printf "parse-all-type: ~a ~n" (syntax->datum stx))
+  ;(printf "parse-all-type: ~a \n" (syntax->datum stx))
   (syntax-parse stx #:literals (t:All)
     [((~and kw t:All) (vars:id ... v:id dd:ddd) . t)
      (let* ([vars (map syntax-e (syntax->list #'(vars ...)))]
@@ -282,13 +282,13 @@
          [(lookup-type-alias #'id parse-type (lambda () #f))
           =>
           (lambda (t)
-            ;(printf "found a type alias ~a~n" #'id)
+            ;(printf "found a type alias ~a\n" #'id)
             (add-type-name-reference #'id)
             t)]
          ;; if it's a type name, we just use the name
          [(lookup-type-name #'id (lambda () #f))
           (add-type-name-reference #'id)
-          ;(printf "found a type name ~a~n" #'id)
+          ;(printf "found a type name ~a\n" #'id)
           (make-Name #'id)]
          [(free-identifier=? #'id #'t:->)
           (tc-error/delayed "Incorrect use of -> type constructor")
diff --git a/collects/typed-scheme/private/type-annotation.rkt b/collects/typed-scheme/private/type-annotation.rkt
index 75c4db9a..e5ab42be 100644
--- a/collects/typed-scheme/private/type-annotation.rkt
+++ b/collects/typed-scheme/private/type-annotation.rkt
@@ -27,10 +27,10 @@
 (define (print-size stx)
   (syntax-case stx ()
     [(a . b) (begin
-               (printf/log "Annotation Sexp Pair ~n")
+               (printf/log "Annotation Sexp Pair \n")
                (print-size #'a)
                (print-size #'b))]      
-    [_ (printf/log "Annotation Sexp ~n" )]))
+    [_ (printf/log "Annotation Sexp \n" )]))
 
 ;; get the type annotation of this syntax
 ;; syntax -> Maybe[Type]
@@ -46,7 +46,7 @@
         (parse-type prop)
         (parse-type/id stx prop)))
   ;(unless let-binding (error 'ohno))
-  ;(printf "in type-annotation:~a~n" (syntax->datum stx))
+  ;(printf "in type-annotation:~a\n" (syntax->datum stx))
   (cond       
     [(syntax-property stx type-label-symbol) => pt]
     [(syntax-property stx type-ascrip-symbol) => pt]
@@ -87,11 +87,11 @@
                      [else #f])))
 
 (define (log/ann stx ty)
-  (printf/log "Required Annotated Variable: ~a ~a~n" (syntax-e stx) ty))
+  (printf/log "Required Annotated Variable: ~a ~a\n" (syntax-e stx) ty))
 (define (log/extra stx ty ty2)
-  (printf/log "Extra Annotated Variable: ~a ~a ~a~n" (syntax-e stx) ty ty2))
+  (printf/log "Extra Annotated Variable: ~a ~a ~a\n" (syntax-e stx) ty ty2))
 (define (log/noann stx ty)
-  (printf/log "Unannotated Variable: ~a ~a~n" (syntax-e stx) ty))
+  (printf/log "Unannotated Variable: ~a ~a\n" (syntax-e stx) ty))
 
 ;; get the type annotation of this identifier, otherwise error
 ;; if #:default is provided, return that instead of error
@@ -146,7 +146,7 @@
   (parameterize ([current-orig-stx stx])
     (unless (subtype e-type ty)
       ;(printf "orig-stx: ~a" (syntax->datum stx*))
-      (tc-error "Body had type:~n~a~nVariable had type:~n~a~n" e-type ty))))
+      (tc-error "Body had type:\n~a\nVariable had type:\n~a\n" e-type ty))))
 
 (define (dotted? stx)
   (cond [(syntax-property stx type-dotted-symbol) => syntax-e]
diff --git a/collects/typed-scheme/private/type-env-lang.rkt b/collects/typed-scheme/private/type-env-lang.rkt
index 3892a583..dd017394 100644
--- a/collects/typed-scheme/private/type-env-lang.rkt
+++ b/collects/typed-scheme/private/type-env-lang.rkt
@@ -21,7 +21,7 @@
             ;(define-syntax provider (lambda (stx) #'(begin (provide nm) ...)))
             ;(provide provider)            
             (begin-for-syntax 
-              ;(printf "running base-types~n")
+              ;(printf "running base-types\n")
               (initialize-type-name-env
                (list (list #'nm ty) ...))))))]
     [(mb . rest)
diff --git a/collects/typed-scheme/typecheck/check-subforms-unit.rkt b/collects/typed-scheme/typecheck/check-subforms-unit.rkt
index 6196c0b9..ac0bf4e2 100644
--- a/collects/typed-scheme/typecheck/check-subforms-unit.rkt
+++ b/collects/typed-scheme/typecheck/check-subforms-unit.rkt
@@ -25,7 +25,7 @@
 	       (Values: (list (Result: rngs _ _) ...)) 
 	       _ _ (list (Keyword: _ _ #t) ...))))
        (apply Un rngs)]
-      [_ (int-err "Internal error in get-result-ty: not a function type: ~n~a" t)]))
+      [_ (int-err "Internal error in get-result-ty: not a function type: \n~a" t)]))
   (let loop ([form form])
     (parameterize ([current-orig-stx form])
       (syntax-parse form
@@ -44,7 +44,7 @@
 		    (Function: (list (arr: (list _) _ _ _ (list (Keyword: _ _ #f) ...)) ...))))
 	      (set! handler-tys (cons (get-result-ty t) handler-tys))]
 	     [(tc-results: t)
-	      (tc-error "Exception handler must be a single-argument function, got ~n~a" t)]))]
+	      (tc-error "Exception handler must be a single-argument function, got \n~a" t)]))]
         [stx
          ;; this is the body of the with-handlers
          #:when (syntax-property form 'typechecker:exn-body)
diff --git a/collects/typed-scheme/typecheck/tc-app.rkt b/collects/typed-scheme/typecheck/tc-app.rkt
index ef163169..0263ccc8 100644
--- a/collects/typed-scheme/typecheck/tc-app.rkt
+++ b/collects/typed-scheme/typecheck/tc-app.rkt
@@ -173,7 +173,7 @@
          (for ([n names]
                #:when (not (memq n tnames)))
            (tc-error/delayed 
-            "unknown named argument ~a for class~nlegal named arguments are ~a"
+            "unknown named argument ~a for class\nlegal named arguments are ~a"
             n (stringify tnames)))
          (for-each (match-lambda
                      [(list tname tfty opt?)
@@ -623,25 +623,25 @@
     ;; special case for `list'
     [(#%plain-app list . args)
      (begin
-       ;(printf "calling list: ~a ~a~n" (syntax->datum #'args) expected)
+       ;(printf "calling list: ~a ~a\n" (syntax->datum #'args) expected)
        (match expected
          [(tc-result1: (Mu: var (Union: (or 
                                          (list (Pair: elem-ty (F: var)) (Value: '()))
                                          (list (Value: '()) (Pair: elem-ty (F: var)))))))
-          ;(printf "special case 1 ~a~n" elem-ty)
+          ;(printf "special case 1 ~a\n" elem-ty)
           (for ([i (in-list (syntax->list #'args))])
                (tc-expr/check i (ret elem-ty)))
           expected]
          [(tc-result1: (app untuple (? (lambda (ts) (and ts (= (length (syntax->list #'args))
                                                                (length ts))))
                                        ts)))    
-          ;(printf "special case 2 ~a~n" ts)
+          ;(printf "special case 2 ~a\n" ts)
           (for ([ac (in-list (syntax->list #'args))]
                 [exp (in-list ts)])
                (tc-expr/check ac (ret exp)))
           expected]
          [_
-          ;(printf "not special case~n")
+          ;(printf "not special case\n")
           (let ([tys (map tc-expr/t (syntax->list #'args))])
             (ret (apply -lst* tys)))]))]
     ;; special case for `list*'
@@ -699,7 +699,7 @@
                                          dom)
                                       (Values: (list (Result: v (FilterSet: (Top:) (Top:)) (Empty:))))
                                       #f #f (list (Keyword: _ _ #f) ...)))))))
-          ;(printf "f dom: ~a ~a~n" (syntax->datum #'f) dom)
+          ;(printf "f dom: ~a ~a\n" (syntax->datum #'f) dom)
           (let ([arg-tys (map (lambda (a t) (tc-expr/check a (ret t))) 
                               (syntax->list #'args)
                               dom)])
diff --git a/collects/typed-scheme/typecheck/tc-apply.rkt b/collects/typed-scheme/typecheck/tc-apply.rkt
index a28ef371..99400ff3 100644
--- a/collects/typed-scheme/typecheck/tc-apply.rkt
+++ b/collects/typed-scheme/typecheck/tc-apply.rkt
@@ -53,7 +53,7 @@
            [(null? doms*)
             (tc-error/expr #:return (ret (Un))
                            (string-append 
-                            "Bad arguments to function in apply:~n"
+                            "Bad arguments to function in apply:\n"
                             (domain-mismatches f-ty doms rests drests rngs arg-tys tail-ty #f)))]
            ;; this case of the function type has a rest argument
            [(and (car rests*)
@@ -87,7 +87,7 @@
                   [(tc-result1: (Poly-names: _ (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ..1))))
                    (tc-error/expr #:return (ret (Un))
                                  (string-append 
-                                  "Bad arguments to polymorphic function in apply:~n"
+                                  "Bad arguments to polymorphic function in apply:\n"
                                   (domain-mismatches f-ty doms rests drests rngs arg-tys tail-ty tail-bound)))])]
                ;; the actual work, when we have a * function and a list final argument
                [(and (car rests*)
@@ -141,7 +141,7 @@
                   [(tc-result1: (PolyDots-names: _ (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ..1))))
                    (tc-error/expr #:return (ret (Un))
                                  (string-append 
-                                  "Bad arguments to polymorphic function in apply:~n"
+                                  "Bad arguments to polymorphic function in apply:\n"
                                   (domain-mismatches f-ty doms rests drests rngs arg-tys tail-ty tail-bound)))])]
                ;; the actual work, when we have a * function and a list final argument
                [(and (car rests*)
@@ -208,4 +208,4 @@
      (tc-error/expr #:return (ret (Un))
                     "Function has no cases")]
     [(tc-result1: f-ty) (tc-error/expr #:return (ret (Un))
-                         "Type of argument to apply is not a function type: ~n~a" f-ty)]))
+                         "Type of argument to apply is not a function type: \n~a" f-ty)]))
diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.rkt b/collects/typed-scheme/typecheck/tc-expr-unit.rkt
index 7a42fb87..bf632f86 100644
--- a/collects/typed-scheme/typecheck/tc-expr-unit.rkt
+++ b/collects/typed-scheme/typecheck/tc-expr-unit.rkt
@@ -116,12 +116,12 @@
               [(and (Poly? ty)
                     (not (= (length (syntax->list inst)) (Poly-n ty))))
                (tc-error/expr #:return (Un)
-                              "Wrong number of type arguments to polymorphic type ~a:~nexpected: ~a~ngot: ~a"
+                              "Wrong number of type arguments to polymorphic type ~a:\nexpected: ~a\ngot: ~a"
                               ty (Poly-n ty) (length (syntax->list inst)))]
               [(and (PolyDots? ty) (not (>= (length (syntax->list inst)) (sub1 (PolyDots-n ty)))))
                ;; we can provide 0 arguments for the ... var
                (tc-error/expr #:return (Un)
-                              "Wrong number of type arguments to polymorphic type ~a:~nexpected at least: ~a~ngot: ~a"
+                              "Wrong number of type arguments to polymorphic type ~a:\nexpected at least: ~a\ngot: ~a"
                               ty (sub1 (PolyDots-n ty)) (length (syntax->list inst)))]
               [(PolyDots? ty)
                ;; In this case, we need to check the last thing.  If it's a dotted var, then we need to
@@ -135,7 +135,7 @@
                         (let* ([last-id (syntax-e last-id-stx)]
                                [last-ty (extend-tvars (list last-id) (parse-type last-ty-stx))])
                           (instantiate-poly-dotted ty (map parse-type all-but-last) last-ty last-id))
-                        (tc-error/expr #:return (Un) "Wrong number of fixed type arguments to polymorphic type ~a:~nexpected: ~a~ngot: ~a"
+                        (tc-error/expr #:return (Un) "Wrong number of fixed type arguments to polymorphic type ~a:\nexpected: ~a\ngot: ~a"
                                        ty (sub1 (PolyDots-n ty)) (length all-but-last)))]
                    [_
                     (instantiate-poly ty (map parse-type (syntax->list inst)))]))]
@@ -210,7 +210,7 @@
 ;; tc-expr/check : syntax tc-results -> tc-results
 (define (tc-expr/check/internal form expected)
   (parameterize ([current-orig-stx form])
-    ;(printf "form: ~a~n" (syntax-object->datum form))
+    ;(printf "form: ~a\n" (syntax-object->datum form))
     ;; the argument must be syntax
     (unless (syntax? form) 
       (int-err "bad form input to tc-expr: ~a" form))
@@ -243,7 +243,7 @@
          (match-let* ([(tc-result1: id-t) (single-value #'id)]
                       [(tc-result1: val-t) (single-value #'val)])
            (unless (subtype val-t id-t)
-             (tc-error/expr "Mutation only allowed with compatible types:~n~a is not a subtype of ~a" val-t id-t))
+             (tc-error/expr "Mutation only allowed with compatible types:\n~a is not a subtype of ~a" val-t id-t))
            (ret -Void))]
         ;; top-level variable reference - occurs at top level
         [(#%top . id) (check-below (tc-id #'id) expected)]
@@ -296,7 +296,7 @@
         [(letrec-values ([(name ...) expr] ...) . body)
          (tc/letrec-values #'((name ...) ...) #'(expr ...) #'body form expected)]        
         ;; other
-        [_ (tc-error/expr #:return (ret expected) "cannot typecheck unknown form : ~a~n" (syntax->datum form))]
+        [_ (tc-error/expr #:return (ret expected) "cannot typecheck unknown form : ~a\n" (syntax->datum form))]
         ))))
 
 ;; type check form in the current type environment
@@ -355,7 +355,7 @@
        (match-let* ([(tc-result1: id-t) (tc-expr #'id)]
                     [(tc-result1: val-t) (tc-expr #'val)])
          (unless (subtype val-t id-t)
-           (tc-error/expr "Mutation only allowed with compatible types:~n~a is not a subtype of ~a" val-t id-t))
+           (tc-error/expr "Mutation only allowed with compatible types:\n~a is not a subtype of ~a" val-t id-t))
          (ret -Void))]        
       ;; top-level variable reference - occurs at top level
       [(#%top . id) (tc-id #'id)]
@@ -384,10 +384,10 @@
        (begin (tc-exprs (syntax->list #'es))
               (tc-expr #'e))]
       ;; other
-      [_ (tc-error/expr #:return (ret (Un)) "cannot typecheck unknown form : ~a~n" (syntax->datum form))]))
+      [_ (tc-error/expr #:return (ret (Un)) "cannot typecheck unknown form : ~a\n" (syntax->datum form))]))
   
   (parameterize ([current-orig-stx form])
-    ;(printf "form: ~a~n" (syntax->datum form))
+    ;(printf "form: ~a\n" (syntax->datum form))
     ;; the argument must be syntax
     (unless (syntax? form) 
       (int-err "bad form input to tc-expr: ~a" form))
diff --git a/collects/typed-scheme/typecheck/tc-if.rkt b/collects/typed-scheme/typecheck/tc-if.rkt
index ce1bca7b..0c61c883 100644
--- a/collects/typed-scheme/typecheck/tc-if.rkt
+++ b/collects/typed-scheme/typecheck/tc-if.rkt
@@ -50,12 +50,12 @@
                     [(tc-results: ts fs2 os2) (with-lexical-env env-thn (tc thn (unbox flag+)))]
                     [(tc-results: us fs3 os3) (with-lexical-env env-els (tc els (unbox flag-)))])
          ;(printf "old props: ~a\n" (env-props (lexical-env)))
-         ;(printf "fs+: ~a~n" fs+)
-         ;(printf "fs-: ~a~n" fs-)
-         ;(printf "thn-props: ~a~n" (env-props env-thn))
-         ;(printf "els-props: ~a~n" (env-props env-els))
-         ;(printf "new-thn-props: ~a~n" new-thn-props)
-         ;(printf "new-els-props: ~a~n" new-els-props)
+         ;(printf "fs+: ~a\n" fs+)
+         ;(printf "fs-: ~a\n" fs-)
+         ;(printf "thn-props: ~a\n" (env-props env-thn))
+         ;(printf "els-props: ~a\n" (env-props env-els))
+         ;(printf "new-thn-props: ~a\n" new-thn-props)
+         ;(printf "new-els-props: ~a\n" new-els-props)
 
          ;; record reachability
          (when (not (unbox flag+))
diff --git a/collects/typed-scheme/typecheck/tc-let-unit.rkt b/collects/typed-scheme/typecheck/tc-let-unit.rkt
index cbd401cc..aa4a8967 100644
--- a/collects/typed-scheme/typecheck/tc-let-unit.rkt
+++ b/collects/typed-scheme/typecheck/tc-let-unit.rkt
@@ -42,8 +42,8 @@
                [names (in-list namess)])
               (match r 
                 [(tc-results: ts (FilterSet: fs+ fs-) os)
-                 ;(printf "f+: ~a~n" fs+)
-                 ;(printf "f-: ~a~n" fs-)
+                 ;(printf "f+: ~a\n" fs+)
+                 ;(printf "f-: ~a\n" fs-)
                  (values ts
                          (apply append
                                 (for/list ([n names]
@@ -129,7 +129,7 @@
                   [(tc-results: ts) ts]))
           (loop (cdr names) (cdr exprs) (apply append (cdr names)) (cdr clauses)))]
         [else
-         ;(for-each (lambda (vs) (for-each (lambda (v) (printf/log "Letrec Var: ~a~n" (syntax-e v))) vs)) names)
+         ;(for-each (lambda (vs) (for-each (lambda (v) (printf/log "Letrec Var: ~a\n" (syntax-e v))) vs)) names)
          (do-check (lambda (stx e t) (tc-expr/check e t))
                    names (map (λ (l) (ret (map get-type l))) names) form exprs body clauses expected)]))))
 
diff --git a/collects/typed-scheme/utils/tc-utils.rkt b/collects/typed-scheme/utils/tc-utils.rkt
index cc9ca93b..7ce94208 100644
--- a/collects/typed-scheme/utils/tc-utils.rkt
+++ b/collects/typed-scheme/utils/tc-utils.rkt
@@ -60,9 +60,9 @@ don't depend on any other portion of the system
 (define (locate-stx stx)
   (define omodule (orig-module-stx))
   (define emodule (expanded-module-stx))
-  ;(printf "orig: ~a~n" (syntax-object->datum omodule))
-  ;(printf "exp: ~a~n" (syntax-object->datum emodule))
-  ;(printf "stx (locate): ~a~n" (syntax-object->datum stx))
+  ;(printf "orig: ~a\n" (syntax-object->datum omodule))
+  ;(printf "exp: ~a\n" (syntax-object->datum emodule))
+  ;(printf "stx (locate): ~a\n" (syntax-object->datum stx))
   (if (and (not (print-syntax?)) omodule emodule stx)
       (or (look-for-in-orig omodule emodule stx) stx)
       stx))

From 48b70747528d45f3ec81220b9f55a7ddbf7b5f7d Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@barzilay.org>
Date: Thu, 26 Aug 2010 12:10:48 -0400
Subject: [PATCH 075/198] More "~n" -> "\n" changes

original commit: 8e0f8dd39c3744472b450021f003f9cbe8cbcb62
---
 collects/tests/typed-scheme/succeed/apply-dots-list.rkt | 4 ++--
 collects/typed-scheme/env/global-env.rkt                | 2 +-
 collects/typed-scheme/env/type-alias-env.rkt            | 2 +-
 collects/typed-scheme/env/type-name-env.rkt             | 2 +-
 collects/typed-scheme/infer/infer-unit.rkt              | 2 +-
 collects/typed-scheme/typecheck/tc-app-helper.rkt       | 4 ++--
 collects/typed-scheme/typecheck/tc-lambda-unit.rkt      | 4 ++--
 collects/typed-scheme/types/printer.rkt                 | 2 +-
 collects/typed-scheme/types/subtype.rkt                 | 2 +-
 collects/typed-scheme/utils/utils.rkt                   | 4 ++--
 10 files changed, 14 insertions(+), 14 deletions(-)

diff --git a/collects/tests/typed-scheme/succeed/apply-dots-list.rkt b/collects/tests/typed-scheme/succeed/apply-dots-list.rkt
index ec5c25fe..cd1b832f 100644
--- a/collects/tests/typed-scheme/succeed/apply-dots-list.rkt
+++ b/collects/tests/typed-scheme/succeed/apply-dots-list.rkt
@@ -10,14 +10,14 @@
  (let aux ([tests tests]
            [num-passed 0])
    (if (null? tests)
-       (printf "~a tests passed.~n" num-passed)
+       (printf "~a tests passed.\n" num-passed)
        (let ((test (car tests)))
          (let ((actual ((car test)))
                (expected (cadr test))
                (msg (caddr test)))
            (if (equal? actual expected)
                (aux (cdr tests) (+ num-passed 1))
-               (printf "Test failed: ~a. Expected ~a, got ~a.~n"
+               (printf "Test failed: ~a. Expected ~a, got ~a.\n"
                        msg expected actual)))))))
 
 (apply check-all tests) ; Works in untyped, but not in typed
diff --git a/collects/typed-scheme/env/global-env.rkt b/collects/typed-scheme/env/global-env.rkt
index 369f6cfd..b22f47c2 100644
--- a/collects/typed-scheme/env/global-env.rkt
+++ b/collects/typed-scheme/env/global-env.rkt
@@ -39,7 +39,7 @@
 ;; add a single type to the mapping
 ;; identifier type -> void
 (define (register-type/undefined id type)
-  ;(printf "register-type/undef ~a~n" (syntax-e id))
+  ;(printf "register-type/undef ~a\n" (syntax-e id))
   (if (free-id-table-ref the-mapping id (lambda _ #f))
       (void (tc-error/expr #:stx id "Duplicate type annotation for ~a" (syntax-e id)))
       (free-id-table-set! the-mapping id (box type))))
diff --git a/collects/typed-scheme/env/type-alias-env.rkt b/collects/typed-scheme/env/type-alias-env.rkt
index 0d1b6298..05547eec 100644
--- a/collects/typed-scheme/env/type-alias-env.rkt
+++ b/collects/typed-scheme/env/type-alias-env.rkt
@@ -27,7 +27,7 @@
 ;; add a name to the mapping
 ;; identifier type-stx -> void
 (define (register-type-alias id stx)
-  ;(printf "registering type ~a~n~a~n" (syntax-e id) id)
+  ;(printf "registering type ~a\n~a\n" (syntax-e id) id)
   (mapping-put! id (make-unresolved stx #f)))
 
 (define (register-resolved-type-alias id ty)
diff --git a/collects/typed-scheme/env/type-name-env.rkt b/collects/typed-scheme/env/type-name-env.rkt
index c741b552..47b553db 100644
--- a/collects/typed-scheme/env/type-name-env.rkt
+++ b/collects/typed-scheme/env/type-name-env.rkt
@@ -24,7 +24,7 @@
 ;; add a name to the mapping
 ;; identifier Type -> void
 (define (register-type-name id [type #t])
-  ;(printf "registering type ~a~n~a~n" (syntax-e id) id)
+  ;(printf "registering type ~a\n~a\n" (syntax-e id) id)
   (mapping-put! id type))
 
 ;; add a bunch of names to the mapping
diff --git a/collects/typed-scheme/infer/infer-unit.rkt b/collects/typed-scheme/infer/infer-unit.rkt
index 9f1cc668..c177d37c 100644
--- a/collects/typed-scheme/infer/infer-unit.rkt
+++ b/collects/typed-scheme/infer/infer-unit.rkt
@@ -525,7 +525,7 @@
     (match v
       [(c S X T)
        (let ([var (hash-ref h (or variable X) Constant)])
-         ;(printf "variance was: ~a~nR was ~a~nX was ~a~nS T ~a ~a~n" var R (or variable X) S T)
+         ;(printf "variance was: ~a\nR was ~a\nX was ~a\nS T ~a ~a\n" var R (or variable X) S T)
          (evcase var 
                  [Constant S]
                  [Covariant S]
diff --git a/collects/typed-scheme/typecheck/tc-app-helper.rkt b/collects/typed-scheme/typecheck/tc-app-helper.rkt
index d829d632..42492eea 100644
--- a/collects/typed-scheme/typecheck/tc-app-helper.rkt
+++ b/collects/typed-scheme/typecheck/tc-app-helper.rkt
@@ -94,7 +94,7 @@
                            "\n"))
            (tc-error/expr #:return (ret (Un))
                           (string-append
-                           "Polymorphic " fcn-string " could not be applied to arguments:~n"
+                           "Polymorphic " fcn-string " could not be applied to arguments:\n"
                            (domain-mismatches t msg-doms msg-rests msg-drests msg-rngs argtypes #f #f #:expected expected)
                            (if (not (for/and ([t (apply append (map fv/list msg-doms))]) (memq t msg-vars)))
                                (string-append "Type Variables: " (stringify msg-vars) "\n")
@@ -113,7 +113,7 @@
                            "\n"))
            (tc-error/expr #:return (ret (Un))
                           (string-append
-                           "Polymorphic " fcn-string " could not be applied to arguments:~n"
+                           "Polymorphic " fcn-string " could not be applied to arguments:\n"
                            (domain-mismatches t msg-doms msg-rests msg-drests msg-rngs argtypes #f #f #:expected expected)
                            (if (not (for/and ([t (apply append (map fv/list msg-doms))]) (memq t msg-vars)))
                                (string-append "Type Variables: " (stringify msg-vars) "\n")
diff --git a/collects/typed-scheme/typecheck/tc-lambda-unit.rkt b/collects/typed-scheme/typecheck/tc-lambda-unit.rkt
index b213cce5..4cd62e40 100644
--- a/collects/typed-scheme/typecheck/tc-lambda-unit.rkt
+++ b/collects/typed-scheme/typecheck/tc-lambda-unit.rkt
@@ -251,7 +251,7 @@
                          ns))]
             [ty (extend-tvars tvars
                   (maybe-loop form formals bodies (ret expected*)))])
-       ;(printf "plambda: ~a ~a ~a ~n" literal-tvars new-tvars ty)
+       ;(printf "plambda: ~a ~a ~a \n" literal-tvars new-tvars ty)
        t)]
     [(tc-result1: (and t (PolyDots-names: (list ns ... dvar) expected*)))
      (let-values 
@@ -278,7 +278,7 @@
        [tvars
         (let* ([ty (extend-tvars tvars
                      (tc/mono-lambda/type formals bodies #f))])
-          ;(printf "plambda: ~a ~a ~a ~n" literal-tvars new-tvars ty)
+          ;(printf "plambda: ~a ~a ~a \n" literal-tvars new-tvars ty)
           (make-Poly tvars ty))])]
     [(tc-result1: t) 
      (unless (check-below (tc/plambda form formals bodies #f) t)
diff --git a/collects/typed-scheme/types/printer.rkt b/collects/typed-scheme/types/printer.rkt
index 4a621008..d92c6cc1 100644
--- a/collects/typed-scheme/types/printer.rkt
+++ b/collects/typed-scheme/types/printer.rkt
@@ -187,7 +187,7 @@
     
     #;[(Poly-unsafe: n b) (fp "(unsafe-poly ~a ~a ~a)" (Type-seq c) n b)]
     [(Poly-names: names body) 
-     #;(fprintf (current-error-port) "POLY SEQ: ~a~n" (Type-seq body))
+     #;(fprintf (current-error-port) "POLY SEQ: ~a\n" (Type-seq body))
      (fp "(All ~a ~a)" names body)]
     #;[(PolyDots-unsafe: n b) (fp "(unsafe-polydots ~a ~a ~a)" (Type-seq c) n b)]
     [(PolyDots-names: (list names ... dotted) body)
diff --git a/collects/typed-scheme/types/subtype.rkt b/collects/typed-scheme/types/subtype.rkt
index 6b2c0994..140cdce2 100644
--- a/collects/typed-scheme/types/subtype.rkt
+++ b/collects/typed-scheme/types/subtype.rkt
@@ -378,7 +378,7 @@
               [((Hashtable: _ _) (HashtableTop:)) A0]
 	      ;; subtyping on structs follows the declared hierarchy
 	      [((Struct: nm (? Type? parent) flds proc _ _ _ _) other) 
-               ;(printf "subtype - hierarchy : ~a ~a ~a~n" nm parent other)
+               ;(printf "subtype - hierarchy : ~a ~a ~a\n" nm parent other)
 	       (subtype* A0 parent other)]
 	      ;; Promises are covariant
 	      [((Struct: (== promise-sym) _ (list t) _ _ _ _ _) (Struct: (== promise-sym) _ (list t*) _ _ _ _ _)) (subtype* A0 t t*)]
diff --git a/collects/typed-scheme/utils/utils.rkt b/collects/typed-scheme/utils/utils.rkt
index 47c621d1..e855edc8 100644
--- a/collects/typed-scheme/utils/utils.rkt
+++ b/collects/typed-scheme/utils/utils.rkt
@@ -115,7 +115,7 @@ at least theoretically.
             (when (last-time)
               (error #f "Timing already started"))
             (last-time (current-process-milliseconds))
-            (printf "Starting ~a at ~a~n" msg (last-time)))])
+            (printf "Starting ~a at ~a\n" msg (last-time)))])
        (syntax-rules ()
          [(_ msg)
           (begin
@@ -125,7 +125,7 @@ at least theoretically.
                    [old (last-time)]
                    [diff (- t old)])
               (last-time t)
-              (printf "Timing ~a at ~a@~a~n" msg diff t)))]))
+              (printf "Timing ~a at ~a@~a\n" msg diff t)))]))
       (values (lambda _ #'(void)) (lambda _ #'(void)))))
 
 ;; custom printing

From daa11ce61fde595dd4171825f2529f02f019ab92 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 25 Aug 2010 10:25:40 -0400
Subject: [PATCH 076/198] Add optimization for `magnitude', fix handling of
 functions that return floats, not complexes.

original commit: fd2d37a7108855691b566997d4c9a3032416f169
---
 .../tests/typed-scheme/succeed/mandelbrot.rkt |  9 ++--
 .../optimizer/inexact-complex.rkt             | 53 +++++++++++++++----
 2 files changed, 47 insertions(+), 15 deletions(-)

diff --git a/collects/tests/typed-scheme/succeed/mandelbrot.rkt b/collects/tests/typed-scheme/succeed/mandelbrot.rkt
index 95869a6e..f481e8ee 100644
--- a/collects/tests/typed-scheme/succeed/mandelbrot.rkt
+++ b/collects/tests/typed-scheme/succeed/mandelbrot.rkt
@@ -24,7 +24,8 @@
          (for ([x (in-range N)])
            (bytes-set! bstr x (mandelbrot-point x y)))
          bstr)))))
-#;
-(for: ([f : (Futureof Bytes) (in-list fs)])
-  (write-bytes (touch f))
-  (newline))
+
+(lambda ()
+  (for: ([f : (Futureof Bytes) (in-list fs)])
+    (write-bytes (touch f))
+    (newline)))
diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt
index 47cb3390..8867f828 100644
--- a/collects/typed-scheme/optimizer/inexact-complex.rkt
+++ b/collects/typed-scheme/optimizer/inexact-complex.rkt
@@ -32,17 +32,11 @@
 ;; complex operations
 (define-syntax-class unboxed-inexact-complex-opt-expr
 
-  ;; special handling of reals inside complex operations
-  (pattern e:float-coerce-expr
-           #:with real-binding (unboxed-gensym 'unboxed-float-)
-           #:with imag-binding #f
-           #:with (bindings ...)
-           #`(((real-binding) e.opt)))
-  
   (pattern (#%plain-app (~and op (~literal +))
                         c1:unboxed-inexact-complex-opt-expr
                         c2:unboxed-inexact-complex-opt-expr
                         cs:unboxed-inexact-complex-opt-expr ...)
+           #:when (isoftype? this-syntax -InexactComplex)
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with (bindings ...)
@@ -67,6 +61,7 @@
                         c1:unboxed-inexact-complex-opt-expr
                         c2:unboxed-inexact-complex-opt-expr
                         cs:unboxed-inexact-complex-opt-expr ...)
+           #:when (isoftype? this-syntax -InexactComplex)
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with (bindings ...)
@@ -94,6 +89,7 @@
                         c1:unboxed-inexact-complex-opt-expr
                         c2:unboxed-inexact-complex-opt-expr
                         cs:unboxed-inexact-complex-opt-expr ...)
+           #:when (isoftype? this-syntax -InexactComplex)
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with (bindings ...)
@@ -142,6 +138,7 @@
                         c1:unboxed-inexact-complex-opt-expr
                         c2:unboxed-inexact-complex-opt-expr
                         cs:unboxed-inexact-complex-opt-expr ...)
+           #:when (isoftype? this-syntax -InexactComplex)
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with reals (map (lambda (x) (if (syntax->datum x) x #'0.0))
@@ -209,13 +206,31 @@
                                               res)]))))))))
 
   (pattern (#%plain-app (~and op (~literal conjugate)) c:unboxed-inexact-complex-opt-expr)
+           #:when (isoftype? this-syntax -InexactComplex)
            #:with real-binding #'c.real-binding
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with (bindings ...)
            (begin (log-optimization "unboxed unary inexact complex" #'op)
                   #`(#,@(append (syntax->list #'(c.bindings ...))
                                 (list #'((imag-binding) (unsafe-fl- 0.0 c.imag-binding)))))))
-
+  
+  (pattern (#%plain-app (~and op (~literal magnitude)) c:unboxed-inexact-complex-opt-expr)
+           #:with real-binding (unboxed-gensym "unboxed-real-")
+           #:with imag-binding #f
+           #:with (bindings ...)
+           (begin (log-optimization "unboxed unary inexact complex" #'op)
+                  #`(c.bindings ...
+                     ((real-binding) (unsafe-flsqrt 
+                                      (unsafe-fl+ (unsafe-fl* c.real-binding c.real-binding) 
+                                                  (unsafe-fl* c.imag-binding c.imag-binding)))))))
+  
+  ;; special handling of reals inside complex operations
+  (pattern e:float-coerce-expr
+           #:with real-binding (unboxed-gensym 'unboxed-float-)
+           #:with imag-binding #f
+           #:with (bindings ...)
+           #`(((real-binding) e.opt)))
+  
   (pattern (#%plain-app (~and op (~or (~literal real-part) (~literal unsafe-flreal-part)))
                         c:unboxed-inexact-complex-opt-expr)
            #:with real-binding #'c.real-binding
@@ -319,6 +334,11 @@
 (define-syntax-class inexact-complex-op
   (pattern (~or (~literal +) (~literal -) (~literal *) (~literal /) (~literal conjugate))))
 
+(define-syntax-class inexact-complex->float-op
+  (pattern (~or (~literal magnitude)
+                (~literal real-part) (~literal flreal-part) (~literal unsafe-flreal-part)
+                (~literal imag-part) (~literal flimag-part) (~literal unsafe-flimag-part))))
+
 (define-syntax-class inexact-complex-expr
   (pattern e:expr
            #:when (isoftype? #'e -InexactComplex)
@@ -376,8 +396,7 @@
                   #'(unsafe-make-flrectangular real-binding imag-binding)))
   
   (pattern e:inexact-complex-arith-opt-expr
-           #:with opt
-           #'e.opt))
+           #:with opt #'e.opt))
 
 (define-syntax-class inexact-complex-arith-opt-expr
   (pattern (~and exp (#%plain-app op:inexact-complex-op e:expr ...))
@@ -390,7 +409,19 @@
            (begin (log-optimization "unboxed inexact complex" #'exp)
                   (reset-unboxed-gensym)
                   #'(let*-values (exp*.bindings ...)
-                      (unsafe-make-flrectangular exp*.real-binding exp*.imag-binding)))))
+                      (unsafe-make-flrectangular exp*.real-binding exp*.imag-binding))))
+  
+  (pattern (~and exp (#%plain-app op:inexact-complex->float-op e:expr ...))
+           #:when (subtypeof? #'exp -Flonum)
+           #:with exp*:unboxed-inexact-complex-opt-expr #'exp
+           #:with real-binding #'exp*.real-binding
+           #:with imag-binding #f
+           #:with (bindings ...) #'(exp*.bindings ...)
+           #:with opt
+           (begin (log-optimization "unboxed inexact complex->float" #'exp)
+                  (reset-unboxed-gensym)
+                  #'(let*-values (exp*.bindings ...)
+                      real-binding))))
 
 ;; takes as argument a structure describing which arguments will be unboxed
 ;; and the optimized version of the operator. operators are optimized elsewhere

From c35ef60c7fc9f2fa627cdda9c08ba987e1fe76a6 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 26 Aug 2010 11:46:25 -0400
Subject: [PATCH 077/198] Avoid reboxing when computing real/imag-part.

original commit: c40c48bd97b12526e8cc9da0b9a68926478cdbdf
---
 .../optimizer/inexact-complex.rkt             | 27 ++++++++++---------
 1 file changed, 15 insertions(+), 12 deletions(-)

diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt
index 8867f828..3bb2107d 100644
--- a/collects/typed-scheme/optimizer/inexact-complex.rkt
+++ b/collects/typed-scheme/optimizer/inexact-complex.rkt
@@ -383,17 +383,7 @@
                             #'unboxed-info #'op)) ; no need to optimize op
            #'e
            #:with opt
-           #'e*.opt)
-
-  ;; unboxed variable used in a boxed fashion, we have to box
-  (pattern v:id
-           #:with unboxed-info (dict-ref unboxed-vars-table #'v #f)
-           #:when (syntax->datum #'unboxed-info)
-           #:with real-binding (car  (syntax->list #'unboxed-info))
-           #:with imag-binding (cadr (syntax->list #'unboxed-info))
-           #:with opt
-           (begin (log-optimization "boxing of an unboxed variable" #'v)
-                  #'(unsafe-make-flrectangular real-binding imag-binding)))
+           #'e*.opt)  
   
   (pattern e:inexact-complex-arith-opt-expr
            #:with opt #'e.opt))
@@ -421,7 +411,20 @@
            (begin (log-optimization "unboxed inexact complex->float" #'exp)
                   (reset-unboxed-gensym)
                   #'(let*-values (exp*.bindings ...)
-                      real-binding))))
+                      real-binding)))
+  
+  (pattern v:id
+           #:with unboxed-info (dict-ref unboxed-vars-table #'v #f)
+           #:when (syntax->datum #'unboxed-info)
+           #:when (subtypeof? #'v -InexactComplex)
+           #:with real-binding (car  (syntax->list #'unboxed-info))
+           #:with imag-binding (cadr (syntax->list #'unboxed-info))
+           #:with (bindings ...) #'()
+           ;; unboxed variable used in a boxed fashion, we have to box
+           #:with opt
+           (begin (log-optimization "unboxed complex variable " #'v)
+                  (reset-unboxed-gensym)
+                  #'(unsafe-make-flrectangular real-binding imag-binding))))
 
 ;; takes as argument a structure describing which arguments will be unboxed
 ;; and the optimized version of the operator. operators are optimized elsewhere

From 3929e32f26678232dd8a1866af509df1790070ef Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 26 Aug 2010 11:45:44 -0400
Subject: [PATCH 078/198] Tests for new optimizer additions.

original commit: 3e4ddde80806795923ee8dab602da80ca38e2ec0
---
 .../tests/typed-scheme/optimizer/generic/magnitude.rkt |  5 +++++
 .../typed-scheme/optimizer/generic/real-part-loop.rkt  | 10 ++++++++++
 2 files changed, 15 insertions(+)
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/magnitude.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/generic/real-part-loop.rkt

diff --git a/collects/tests/typed-scheme/optimizer/generic/magnitude.rkt b/collects/tests/typed-scheme/optimizer/generic/magnitude.rkt
new file mode 100644
index 00000000..aa0f1fc5
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/magnitude.rkt
@@ -0,0 +1,5 @@
+#lang typed/racket/base #:optimize
+
+(require racket/unsafe/ops)
+
+(magnitude 3.0+4.0i)
\ No newline at end of file
diff --git a/collects/tests/typed-scheme/optimizer/generic/real-part-loop.rkt b/collects/tests/typed-scheme/optimizer/generic/real-part-loop.rkt
new file mode 100644
index 00000000..3b333b19
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/generic/real-part-loop.rkt
@@ -0,0 +1,10 @@
+#lang typed/racket/base #:optimize
+
+(require racket/unsafe/ops)
+
+(ann
+ (let loop ([v 0.0+1.0i])
+  (if (> (real-part v) 70000.2) 
+      0
+      (loop (+ v 3.6))))
+ Integer)

From 4d0a7b1d974107fae3b2571ad0b615388ecfab77 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 26 Aug 2010 16:57:40 -0400
Subject: [PATCH 079/198] Fixes for real/imag-part

original commit: 52c90628ce5ec306287c8202ab863fefbb9a1d62
---
 .../optimizer/inexact-complex.rkt             | 55 ++++++++++---------
 .../typed-scheme/optimizer/unboxed-let.rkt    |  1 +
 2 files changed, 31 insertions(+), 25 deletions(-)

diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt
index 3bb2107d..1d177801 100644
--- a/collects/typed-scheme/optimizer/inexact-complex.rkt
+++ b/collects/typed-scheme/optimizer/inexact-complex.rkt
@@ -1,7 +1,7 @@
 #lang scheme/base
 
 (require syntax/parse syntax/id-table scheme/dict
-         "../utils/utils.rkt"
+         "../utils/utils.rkt" racket/unsafe/ops
          (for-template scheme/base scheme/math scheme/flonum scheme/unsafe/ops)
          (types abbrev type-table utils subtype)
          (optimizer utils float fixnum))
@@ -89,7 +89,7 @@
                         c1:unboxed-inexact-complex-opt-expr
                         c2:unboxed-inexact-complex-opt-expr
                         cs:unboxed-inexact-complex-opt-expr ...)
-           #:when (isoftype? this-syntax -InexactComplex)
+           #:when (or (isoftype? this-syntax -InexactComplex) (isoftype? this-syntax -Number))
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with (bindings ...)
@@ -138,7 +138,7 @@
                         c1:unboxed-inexact-complex-opt-expr
                         c2:unboxed-inexact-complex-opt-expr
                         cs:unboxed-inexact-complex-opt-expr ...)
-           #:when (isoftype? this-syntax -InexactComplex)
+           #:when (or (isoftype? this-syntax -InexactComplex) (isoftype? this-syntax -Number))
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with reals (map (lambda (x) (if (syntax->datum x) x #'0.0))
@@ -224,19 +224,12 @@
                                       (unsafe-fl+ (unsafe-fl* c.real-binding c.real-binding) 
                                                   (unsafe-fl* c.imag-binding c.imag-binding)))))))
   
-  ;; special handling of reals inside complex operations
-  (pattern e:float-coerce-expr
-           #:with real-binding (unboxed-gensym 'unboxed-float-)
-           #:with imag-binding #f
-           #:with (bindings ...)
-           #`(((real-binding) e.opt)))
-  
   (pattern (#%plain-app (~and op (~or (~literal real-part) (~literal unsafe-flreal-part)))
                         c:unboxed-inexact-complex-opt-expr)
            #:with real-binding #'c.real-binding
            #:with imag-binding #f
            #:with (bindings ...)
-           (begin (log-optimization "unboxed unary inexact complex" #'op)
+           (begin (log-optimization "unboxed unary inexact complex**" #'op)
                   #'(c.bindings ...)))
   (pattern (#%plain-app (~and op (~or (~literal imag-part) (~literal unsafe-flimag-part)))
                         c:unboxed-inexact-complex-opt-expr)
@@ -245,6 +238,16 @@
            #:with (bindings ...)
            (begin (log-optimization "unboxed unary inexact complex" #'op)
                   #'(c.bindings ...)))
+  
+  ;; special handling of reals inside complex operations
+  ;; must be after any cases that we are supposed to handle
+  (pattern e:float-coerce-expr
+           #:with real-binding (unboxed-gensym 'unboxed-float-)
+           #:with imag-binding #f
+           #:when (log-optimization "float-coerce-expr" #'e)
+           #:with (bindings ...)
+           #`(((real-binding) e.opt)))
+    
 
   ;; we can eliminate boxing that was introduced by the user
   (pattern (#%plain-app (~and op (~or (~literal make-rectangular)
@@ -348,15 +351,16 @@
 
   ;; we can optimize taking the real of imag part of an unboxed complex
   ;; hopefully, the compiler can eliminate unused bindings for the other part if it's not used
-  (pattern (#%plain-app (~and op (~or (~literal real-part) (~literal unsafe-flreal-part)
-                                      (~literal imag-part) (~literal unsafe-flimag-part)))
+  (pattern (#%plain-app (~and op (~or (~literal real-part) (~literal flreal-part) (~literal unsafe-flreal-part)
+                                      (~literal imag-part) (~literal flimag-part) (~literal unsafe-flimag-part)))
                         c:inexact-complex-expr)
-           #:with c*:inexact-complex-arith-opt-expr #'c
+           #:with c*:unboxed-inexact-complex-opt-expr #'c
            #:with opt
            (begin (log-optimization "unboxed inexact complex" #'op)
                   (reset-unboxed-gensym)
                   #`(let*-values (c*.bindings ...)
                       #,(if (or (free-identifier=? #'op #'real-part)
+                                (free-identifier=? #'op #'flreal-part)
                                 (free-identifier=? #'op #'unsafe-flreal-part))
                             #'c*.real-binding
                             #'c*.imag-binding))))
@@ -389,17 +393,6 @@
            #:with opt #'e.opt))
 
 (define-syntax-class inexact-complex-arith-opt-expr
-  (pattern (~and exp (#%plain-app op:inexact-complex-op e:expr ...))
-           #:when (isoftype? #'exp -InexactComplex)
-           #:with exp*:unboxed-inexact-complex-opt-expr #'exp
-           #:with real-binding #'exp*.real-binding
-           #:with imag-binding #'exp*.imag-binding
-           #:with (bindings ...) #'(exp*.bindings ...)
-           #:with opt
-           (begin (log-optimization "unboxed inexact complex" #'exp)
-                  (reset-unboxed-gensym)
-                  #'(let*-values (exp*.bindings ...)
-                      (unsafe-make-flrectangular exp*.real-binding exp*.imag-binding))))
   
   (pattern (~and exp (#%plain-app op:inexact-complex->float-op e:expr ...))
            #:when (subtypeof? #'exp -Flonum)
@@ -412,6 +405,18 @@
                   (reset-unboxed-gensym)
                   #'(let*-values (exp*.bindings ...)
                       real-binding)))
+
+  (pattern (~and exp (#%plain-app op:inexact-complex-op e:expr ...))
+           #:when (isoftype? #'exp -InexactComplex)
+           #:with exp*:unboxed-inexact-complex-opt-expr #'exp
+           #:with real-binding #'exp*.real-binding
+           #:with imag-binding #'exp*.imag-binding
+           #:with (bindings ...) #'(exp*.bindings ...)
+           #:with opt
+           (begin (log-optimization "unboxed inexact complex" #'exp)
+                  (reset-unboxed-gensym)
+                  #'(let*-values (exp*.bindings ...)
+                      (unsafe-make-flrectangular exp*.real-binding exp*.imag-binding))))
   
   (pattern v:id
            #:with unboxed-info (dict-ref unboxed-vars-table #'v #f)
diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index c7a10551..cb8fb9ee 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -161,6 +161,7 @@
       
       ;; can be used in a complex arithmetic expr, can be a direct child
       [exp:inexact-complex-arith-opt-expr
+       #:when (not (identifier? #'exp))
        (or (direct-child-of? v #'exp)
            (ormap rec (syntax->list #'exp)))]
       ;; if the variable gets rebound to something else, we look for unboxing

From ee39b520ce4840bd57ec410e00f7974098ca754b Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 24 Aug 2010 19:37:04 -0400
Subject: [PATCH 080/198] Extend sign analysis to sqr.

original commit: 694d2da4b362f83b6f492095c712703856acb068
---
 collects/typed-scheme/private/base-env-numeric.rkt | 6 ++----
 1 file changed, 2 insertions(+), 4 deletions(-)

diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt
index 73713950..07701808 100644
--- a/collects/typed-scheme/private/base-env-numeric.rkt
+++ b/collects/typed-scheme/private/base-env-numeric.rkt
@@ -428,11 +428,9 @@
 [sgn (-Real . -> . -Real)]
 [pi -NonnegativeFlonum]
 [sqr (cl->* (-> -Pos -Pos)
-            (-> -Nat -Nat)
-            (-> -Integer -Integer)
+            (-> -Integer -Nat)
             (-> -ExactRational -ExactRational)
-            (-> -NonnegativeFlonum -NonnegativeFlonum)
-            (-> -Flonum -Flonum)
+            (-> -Flonum -NonnegativeFlonum)
             (-> -Real -Real)
             (-> -InexactComplex -InexactComplex)
             (-> N N))]

From acd7b572aefd98f11e2bc5380d21486eabe2d042 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 25 Aug 2010 17:12:24 -0400
Subject: [PATCH 081/198] Added with-asserts, from code from Neil Toronto.

original commit: ea472a9d57b7344e9111bd37663fd7ad0884f0d5
---
 .../tests/typed-scheme/fail/with-asserts.rkt  |  7 +++++++
 .../tests/typed-scheme/fail/with-asserts2.rkt |  7 +++++++
 .../tests/typed-scheme/fail/with-asserts3.rkt |  7 +++++++
 .../typed-scheme/succeed/with-asserts.rkt     | 20 +++++++++++++++++++
 collects/typed-scheme/private/prims.rkt       | 19 ++++++++++++++++++
 5 files changed, 60 insertions(+)
 create mode 100644 collects/tests/typed-scheme/fail/with-asserts.rkt
 create mode 100644 collects/tests/typed-scheme/fail/with-asserts2.rkt
 create mode 100644 collects/tests/typed-scheme/fail/with-asserts3.rkt
 create mode 100644 collects/tests/typed-scheme/succeed/with-asserts.rkt

diff --git a/collects/tests/typed-scheme/fail/with-asserts.rkt b/collects/tests/typed-scheme/fail/with-asserts.rkt
new file mode 100644
index 00000000..b543f7b9
--- /dev/null
+++ b/collects/tests/typed-scheme/fail/with-asserts.rkt
@@ -0,0 +1,7 @@
+#;
+(exn-pred exn:fail?)
+#lang typed/racket
+
+(let ([x 1] [y "2"])
+  (with-asserts ([x string?] [y integer?])
+                x))
diff --git a/collects/tests/typed-scheme/fail/with-asserts2.rkt b/collects/tests/typed-scheme/fail/with-asserts2.rkt
new file mode 100644
index 00000000..79ec314a
--- /dev/null
+++ b/collects/tests/typed-scheme/fail/with-asserts2.rkt
@@ -0,0 +1,7 @@
+#;
+(exn-pred exn:fail?)
+#lang typed/racket
+
+(let ([x 1] [y "2"])
+  (with-asserts ([x string?])
+                x))
diff --git a/collects/tests/typed-scheme/fail/with-asserts3.rkt b/collects/tests/typed-scheme/fail/with-asserts3.rkt
new file mode 100644
index 00000000..f38cb1e6
--- /dev/null
+++ b/collects/tests/typed-scheme/fail/with-asserts3.rkt
@@ -0,0 +1,7 @@
+#;
+(exn-pred exn:fail?)
+#lang typed/racket
+
+(let ([x #f])
+  (with-asserts ([x])
+                x))
diff --git a/collects/tests/typed-scheme/succeed/with-asserts.rkt b/collects/tests/typed-scheme/succeed/with-asserts.rkt
new file mode 100644
index 00000000..c6dc9b32
--- /dev/null
+++ b/collects/tests/typed-scheme/succeed/with-asserts.rkt
@@ -0,0 +1,20 @@
+#lang typed/racket
+
+(let ([x 1] [y "2"])
+  (with-asserts ([x integer?] [y string?])
+                x))
+(let ([x 1] [y "2"])
+  (with-asserts ([x integer?])
+                x))
+(let ([x 1] [y "2"])
+  (with-asserts ()
+                x))
+(let ([x 1] [y "2"])
+  (with-asserts ([x])
+                x))
+
+(: f : (U Integer String) -> Integer)
+(define (f x)
+  (with-asserts ([x integer?])
+                x))
+(f 1)
diff --git a/collects/typed-scheme/private/prims.rkt b/collects/typed-scheme/private/prims.rkt
index bf9cdbc8..522ee962 100644
--- a/collects/typed-scheme/private/prims.rkt
+++ b/collects/typed-scheme/private/prims.rkt
@@ -624,3 +624,22 @@ This file defines two sorts of primitives. All of them are provided into any mod
        [(_ (~var k (param-annotated-name (lambda (s) #`(#,s -> (U))))) . body)
 	(quasisyntax/loc stx (#,l/c k.ann-name . body))]))
     (values (mk #'let/cc) (mk #'let/ec))))
+
+(define-syntax (with-asserts stx)
+  (define-syntax-class with-asserts-clause
+    [pattern [x:id]
+             #:with cond-clause
+             (syntax/loc #'x
+               [(not x)
+                (error "Assertion failed")])]
+    [pattern [x:id pred]
+             #:with cond-clause
+             (syntax/loc #'x
+               [(not (pred x))
+                (error "Assertion failed")])])
+   (syntax-parse stx
+     [(_ (c:with-asserts-clause ...) body:expr ...+)
+      (syntax/loc stx
+        (cond c.cond-clause
+              ...
+              [else body ...]))]))

From 6e2563c2a94b15f5447b9fffc86dc5538e5847cf Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 25 Aug 2010 17:30:19 -0400
Subject: [PATCH 082/198] Documented with-asserts.

original commit: 63530ed74df880b55b4dc85398181fb2925e6947
---
 collects/typed-scheme/scribblings/ts-reference.scrbl | 7 +++++++
 1 file changed, 7 insertions(+)

diff --git a/collects/typed-scheme/scribblings/ts-reference.scrbl b/collects/typed-scheme/scribblings/ts-reference.scrbl
index 8daab985..19cff7c9 100644
--- a/collects/typed-scheme/scribblings/ts-reference.scrbl
+++ b/collects/typed-scheme/scribblings/ts-reference.scrbl
@@ -529,6 +529,13 @@ y
 (assert y number?)
 (assert y boolean?)]
 
+@defform*/subs[[(with-asserts ([id maybe-pred] ...) body ...+)]
+              ([maybe-pred code:blank
+                           (code:line predicate)])]{
+Guard the body with assertions. If any of the assertions fail, the
+program errors. These assertions behave like @racket[assert].
+}
+
 
 @section{Typed Racket Syntax Without Type Checking}
 

From e291319f9686cab65038e5715bc5cbb181cf7822 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 26 Aug 2010 17:38:57 -0400
Subject: [PATCH 083/198] Exclude directories when testing TR's optimizer.

original commit: eadc2a7e4c35d56ad84a251a52f1af7ce5548425
---
 collects/tests/typed-scheme/optimizer/run.rkt | 1 +
 1 file changed, 1 insertion(+)

diff --git a/collects/tests/typed-scheme/optimizer/run.rkt b/collects/tests/typed-scheme/optimizer/run.rkt
index 63cb7f8f..d089824f 100644
--- a/collects/tests/typed-scheme/optimizer/run.rkt
+++ b/collects/tests/typed-scheme/optimizer/run.rkt
@@ -26,6 +26,7 @@
 (define (test gen)
   (let-values (((base name _) (split-path gen)))
     (or (regexp-match ".*~" name) ; we ignore backup files
+        (directory-exists? gen)   ; and directories
         ;; machine optimized and hand optimized versions must expand to the
         ;; same code
         (and (or (equal? (parameterize ([current-load-relative-directory

From 7b0682b8d07bf81dd75ef3af623d9670232c835b Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 26 Aug 2010 17:44:21 -0400
Subject: [PATCH 084/198] Use sandboxes instead of duplicate files to test
 results when optimizing.

original commit: 46b2a2113af3e6f8174379880620f7add5b0f079
---
 .../optimizer/generic/apply-plus.rkt          |  3 +-
 .../optimizer/generic/begin-float.rkt         |  9 +++--
 .../optimizer/generic/binary-fixnum.rkt       | 11 +++---
 .../generic/binary-nonzero-fixnum.rkt         |  7 ++--
 .../typed-scheme/optimizer/generic/box.rkt    |  3 +-
 .../optimizer/generic/dead-else.rkt           |  3 +-
 .../optimizer/generic/dead-substructs.rkt     |  3 +-
 .../optimizer/generic/dead-then.rkt           |  3 +-
 .../optimizer/generic/define-begin-float.rkt  |  9 +++--
 .../optimizer/generic/define-call-float.rkt   |  7 ++--
 .../optimizer/generic/define-float.rkt        |  7 ++--
 .../optimizer/generic/define-pair.rkt         |  7 ++--
 .../optimizer/generic/different-langs.rkt     |  5 ++-
 .../optimizer/generic/double-float.rkt        |  7 ++--
 .../optimizer/generic/exact-inexact.rkt       |  7 ++--
 .../optimizer/generic/fixnum-comparison.rkt   |  7 ++--
 .../optimizer/generic/float-comp.rkt          |  7 ++--
 .../optimizer/generic/float-fun.rkt           | 12 +++---
 .../optimizer/generic/float-promotion.rkt     |  9 +++--
 .../optimizer/generic/flvector-length.rkt     |  7 ++--
 .../typed-scheme/optimizer/generic/fx-fl.rkt  |  7 ++--
 .../optimizer/generic/in-bytes.rkt            |  3 +-
 .../optimizer/generic/in-list.rkt             |  9 +++--
 .../optimizer/generic/in-string.rkt           |  3 +-
 .../optimizer/generic/in-vector.rkt           |  3 +-
 .../generic/inexact-complex-conjugate-top.rkt |  3 +-
 .../generic/inexact-complex-fixnum.rkt        |  3 +-
 .../generic/invalid-binary-nonzero-fixnum.rkt |  9 +++--
 .../generic/invalid-exact-inexact.rkt         |  5 ++-
 .../optimizer/generic/invalid-float-comp.rkt  |  7 ++--
 .../generic/invalid-float-promotion.rkt       |  5 ++-
 .../generic/invalid-inexact-complex-parts.rkt |  5 ++-
 .../generic/invalid-make-flrectangular.rkt    |  5 ++-
 .../optimizer/generic/invalid-make-polar.rkt  |  3 +-
 .../optimizer/generic/invalid-mpair.rkt       |  3 +-
 .../optimizer/generic/invalid-sqrt.rkt        |  5 ++-
 .../optimizer/generic/invalid-unboxed-let.rkt |  3 +-
 .../generic/invalid-unboxed-let2.rkt          |  3 +-
 .../optimizer/generic/invalid-vector-ref.rkt  |  9 +++--
 .../optimizer/generic/invalid-vector-set.rkt  |  9 +++--
 .../optimizer/generic/known-vector-length.rkt |  7 ++--
 .../optimizer/generic/let-float.rkt           |  9 +++--
 .../optimizer/generic/let-rhs.rkt             |  3 +-
 .../optimizer/generic/literal-int.rkt         |  3 +-
 .../optimizer/generic/magnitude.rkt           |  3 +-
 .../optimizer/generic/make-flrectangular.rkt  |  9 +++--
 .../optimizer/generic/make-polar.rkt          |  3 +-
 .../optimizer/generic/maybe-exact-complex.rkt |  3 +-
 .../typed-scheme/optimizer/generic/mpair.rkt  |  3 +-
 .../optimizer/generic/n-ary-float.rkt         |  7 ++--
 .../optimizer/generic/nested-float.rkt        |  7 ++--
 .../optimizer/generic/nested-float2.rkt       |  7 ++--
 .../optimizer/generic/nested-let-loop.rkt     |  3 +-
 .../optimizer/generic/nested-pair1.rkt        |  7 ++--
 .../optimizer/generic/nested-pair2.rkt        |  7 ++--
 .../optimizer/generic/nested-unboxed-let.rkt  |  3 +-
 .../optimizer/generic/one-arg-arith.rkt       |  3 +-
 .../optimizer/generic/pair-fun.rkt            | 15 ++++----
 .../typed-scheme/optimizer/generic/quote.rkt  |  5 ++-
 .../optimizer/generic/real-part-loop.rkt      |  3 +-
 .../optimizer/generic/simple-float.rkt        |  7 ++--
 .../optimizer/generic/simple-pair.rkt         |  7 ++--
 .../optimizer/generic/sqrt-segfault.rkt       |  3 +-
 .../typed-scheme/optimizer/generic/sqrt.rkt   | 11 +++---
 .../optimizer/generic/string-length.rkt       |  3 +-
 .../optimizer/generic/structs.rkt             | 13 ++++---
 .../optimizer/generic/unary-fixnum-nested.rkt |  7 ++--
 .../optimizer/generic/unary-fixnum.rkt        |  7 ++--
 .../optimizer/generic/unary-float.rkt         |  7 ++--
 .../optimizer/generic/unboxed-for.rkt         |  3 +-
 .../generic/unboxed-let-functions1.rkt        |  3 +-
 .../generic/unboxed-let-functions2.rkt        |  3 +-
 .../generic/unboxed-let-functions3.rkt        |  3 +-
 .../generic/unboxed-let-functions4.rkt        |  3 +-
 .../generic/unboxed-let-functions5.rkt        |  3 +-
 .../generic/unboxed-let-functions6.rkt        |  3 +-
 .../generic/unboxed-let-functions7.rkt        |  3 +-
 .../generic/unboxed-let-functions8.rkt        |  3 +-
 .../optimizer/generic/unboxed-let.rkt         |  3 +-
 .../optimizer/generic/unboxed-let2.rkt        |  3 +-
 .../optimizer/generic/unboxed-let3.rkt        |  3 +-
 .../unboxed-letrec-syntaxes+values.rkt        |  3 +-
 .../optimizer/generic/unboxed-letrec.rkt      |  9 +++--
 .../generic/unboxed-make-rectangular.rkt      |  3 +-
 .../generic/vector-length-nested.rkt          | 15 ++++----
 .../optimizer/generic/vector-length.rkt       |  7 ++--
 .../optimizer/generic/vector-ref-set-ref.rkt  | 15 ++++----
 .../optimizer/generic/vector-ref.rkt          |  7 ++--
 .../optimizer/generic/vector-ref2.rkt         |  7 ++--
 .../optimizer/generic/vector-set-quote.rkt    | 11 +++---
 .../optimizer/generic/vector-set.rkt          | 11 +++---
 .../optimizer/generic/vector-set2.rkt         |  7 ++--
 .../typed-scheme/optimizer/generic/zero.rkt   |  3 +-
 collects/tests/typed-scheme/optimizer/run.rkt | 37 +++++++++++++++----
 94 files changed, 348 insertions(+), 233 deletions(-)

diff --git a/collects/tests/typed-scheme/optimizer/generic/apply-plus.rkt b/collects/tests/typed-scheme/optimizer/generic/apply-plus.rkt
index 800f688e..19479ca7 100644
--- a/collects/tests/typed-scheme/optimizer/generic/apply-plus.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/apply-plus.rkt
@@ -1,4 +1,5 @@
-#lang typed/racket #:optimize
+#lang typed/racket
+#:optimize
 (require racket/unsafe/ops)
 (apply + (map add1 (list 1 2 3)))
 (apply * (map add1 (list 1 2 3)))
diff --git a/collects/tests/typed-scheme/optimizer/generic/begin-float.rkt b/collects/tests/typed-scheme/optimizer/generic/begin-float.rkt
index a3bb961e..791e75b3 100644
--- a/collects/tests/typed-scheme/optimizer/generic/begin-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/begin-float.rkt
@@ -1,4 +1,5 @@
-(module begin-float typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (begin (- 2.0 3.0)
-         (* 2.0 3.0)))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(begin (- 2.0 3.0)
+       (* 2.0 3.0))
diff --git a/collects/tests/typed-scheme/optimizer/generic/binary-fixnum.rkt b/collects/tests/typed-scheme/optimizer/generic/binary-fixnum.rkt
index 6c1dcba3..3f7f72d4 100644
--- a/collects/tests/typed-scheme/optimizer/generic/binary-fixnum.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/binary-fixnum.rkt
@@ -1,5 +1,6 @@
-(module binary-fixnum typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (: f (All (X) ((Vectorof X) -> Natural)))
-  (define (f v)
-    (bitwise-and (vector-length v) 1)))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(: f (All (X) ((Vectorof X) -> Natural)))
+(define (f v)
+  (bitwise-and (vector-length v) 1))
diff --git a/collects/tests/typed-scheme/optimizer/generic/binary-nonzero-fixnum.rkt b/collects/tests/typed-scheme/optimizer/generic/binary-nonzero-fixnum.rkt
index 0e5c46a6..6c82520d 100644
--- a/collects/tests/typed-scheme/optimizer/generic/binary-nonzero-fixnum.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/binary-nonzero-fixnum.rkt
@@ -1,3 +1,4 @@
-(module binary-nonzero-fixnum typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (quotient (vector-length '#(1 2 3)) 2))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(quotient (vector-length '#(1 2 3)) 2)
diff --git a/collects/tests/typed-scheme/optimizer/generic/box.rkt b/collects/tests/typed-scheme/optimizer/generic/box.rkt
index aa6695de..44dd0a01 100644
--- a/collects/tests/typed-scheme/optimizer/generic/box.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/box.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/dead-else.rkt b/collects/tests/typed-scheme/optimizer/generic/dead-else.rkt
index 6e2868ef..9ec67d3d 100644
--- a/collects/tests/typed-scheme/optimizer/generic/dead-else.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/dead-else.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 (require racket/unsafe/ops)
 (display (if (number? 3)
              (+ 2.0 3.0)
diff --git a/collects/tests/typed-scheme/optimizer/generic/dead-substructs.rkt b/collects/tests/typed-scheme/optimizer/generic/dead-substructs.rkt
index a01a5e5b..796076c4 100644
--- a/collects/tests/typed-scheme/optimizer/generic/dead-substructs.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/dead-substructs.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 ;; originally from nucleic3
 ;; cond on substructs, branches were considered dead
diff --git a/collects/tests/typed-scheme/optimizer/generic/dead-then.rkt b/collects/tests/typed-scheme/optimizer/generic/dead-then.rkt
index c4ec905b..ddcf70e5 100644
--- a/collects/tests/typed-scheme/optimizer/generic/dead-then.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/dead-then.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 (require racket/unsafe/ops)
 (display (if (number? "eh")
              (+ 2.0 3.0)
diff --git a/collects/tests/typed-scheme/optimizer/generic/define-begin-float.rkt b/collects/tests/typed-scheme/optimizer/generic/define-begin-float.rkt
index 508bd0e5..6c214e4b 100644
--- a/collects/tests/typed-scheme/optimizer/generic/define-begin-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/define-begin-float.rkt
@@ -1,4 +1,5 @@
-(module define-begin-float typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (define a (begin (display (- 2.0 3.0))
-                   (* 2.0 3.0))))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(define a (begin (display (- 2.0 3.0))
+                 (* 2.0 3.0)))
diff --git a/collects/tests/typed-scheme/optimizer/generic/define-call-float.rkt b/collects/tests/typed-scheme/optimizer/generic/define-call-float.rkt
index fe2ff165..0b0b3112 100644
--- a/collects/tests/typed-scheme/optimizer/generic/define-call-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/define-call-float.rkt
@@ -1,3 +1,4 @@
-(module define-call-float typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (define x (cons (+ 1.0 2.0) 3.0)))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(define x (cons (+ 1.0 2.0) 3.0))
diff --git a/collects/tests/typed-scheme/optimizer/generic/define-float.rkt b/collects/tests/typed-scheme/optimizer/generic/define-float.rkt
index 9dfeb431..fb4e85ec 100644
--- a/collects/tests/typed-scheme/optimizer/generic/define-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/define-float.rkt
@@ -1,3 +1,4 @@
-(module define-float typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (define x (+ 1.0 2.0)))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(define x (+ 1.0 2.0))
diff --git a/collects/tests/typed-scheme/optimizer/generic/define-pair.rkt b/collects/tests/typed-scheme/optimizer/generic/define-pair.rkt
index ec30e20c..f32efdc1 100644
--- a/collects/tests/typed-scheme/optimizer/generic/define-pair.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/define-pair.rkt
@@ -1,3 +1,4 @@
-(module define-pair typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (define x (car '(1 3))))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(define x (car '(1 3)))
diff --git a/collects/tests/typed-scheme/optimizer/generic/different-langs.rkt b/collects/tests/typed-scheme/optimizer/generic/different-langs.rkt
index 9754b392..2d52084c 100644
--- a/collects/tests/typed-scheme/optimizer/generic/different-langs.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/different-langs.rkt
@@ -1,4 +1,5 @@
+#lang typed/scheme
+#:optimize
 ;; to see if the harness supports having the 2 versions of a test being
 ;; written in different languages
-(module different-langs typed/scheme #:optimize
-  (+ 1 2))
+(+ 1 2)
diff --git a/collects/tests/typed-scheme/optimizer/generic/double-float.rkt b/collects/tests/typed-scheme/optimizer/generic/double-float.rkt
index 1d686451..a46f1de8 100644
--- a/collects/tests/typed-scheme/optimizer/generic/double-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/double-float.rkt
@@ -1,3 +1,4 @@
-(module double-float typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (+ 2.0 2.0 2.0))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(+ 2.0 2.0 2.0)
diff --git a/collects/tests/typed-scheme/optimizer/generic/exact-inexact.rkt b/collects/tests/typed-scheme/optimizer/generic/exact-inexact.rkt
index f19e3812..66b5cd34 100644
--- a/collects/tests/typed-scheme/optimizer/generic/exact-inexact.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/exact-inexact.rkt
@@ -1,3 +1,4 @@
-(module exact-inexact typed/scheme #:optimize
-  (require racket/flonum)
-  (exact->inexact (expt 10 100))) ; must not be a fixnum
+#lang typed/scheme
+#:optimize
+(require racket/flonum)
+(exact->inexact (expt 10 100)) ; must not be a fixnum
diff --git a/collects/tests/typed-scheme/optimizer/generic/fixnum-comparison.rkt b/collects/tests/typed-scheme/optimizer/generic/fixnum-comparison.rkt
index 905b4c8b..9f959d12 100644
--- a/collects/tests/typed-scheme/optimizer/generic/fixnum-comparison.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/fixnum-comparison.rkt
@@ -1,3 +1,4 @@
-(module fixnum-comparison typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (< (vector-length '#(1 2 3)) (string-length "asdf")))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(< (vector-length '#(1 2 3)) (string-length "asdf"))
diff --git a/collects/tests/typed-scheme/optimizer/generic/float-comp.rkt b/collects/tests/typed-scheme/optimizer/generic/float-comp.rkt
index d644a1c9..2d67b7ec 100644
--- a/collects/tests/typed-scheme/optimizer/generic/float-comp.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/float-comp.rkt
@@ -1,3 +1,4 @@
-(module float-comp typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (< 1.0 2.0))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(< 1.0 2.0)
diff --git a/collects/tests/typed-scheme/optimizer/generic/float-fun.rkt b/collects/tests/typed-scheme/optimizer/generic/float-fun.rkt
index 788a2181..4aaa4a1e 100644
--- a/collects/tests/typed-scheme/optimizer/generic/float-fun.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/float-fun.rkt
@@ -1,5 +1,7 @@
-(module float-fun typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (: f (Float -> Float))
-  (define (f x)
-    (+ x 1.0)))
+#lang typed/racket
+#:optimize
+
+(require racket/unsafe/ops)
+(: f (Float -> Float))
+(define (f x)
+  (+ x 1.0))
diff --git a/collects/tests/typed-scheme/optimizer/generic/float-promotion.rkt b/collects/tests/typed-scheme/optimizer/generic/float-promotion.rkt
index 09d106f4..134bd64d 100644
--- a/collects/tests/typed-scheme/optimizer/generic/float-promotion.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/float-promotion.rkt
@@ -1,4 +1,5 @@
-(module float-promotion typed/scheme #:optimize
-  (require racket/unsafe/ops racket/flonum)
-  (+ (quotient 1 1) 2.0)
-  (+ (expt 100 100) 2.0))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops racket/flonum)
+(+ (quotient 1 1) 2.0)
+(+ (expt 100 100) 2.0)
diff --git a/collects/tests/typed-scheme/optimizer/generic/flvector-length.rkt b/collects/tests/typed-scheme/optimizer/generic/flvector-length.rkt
index 34add429..35af6f4f 100644
--- a/collects/tests/typed-scheme/optimizer/generic/flvector-length.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/flvector-length.rkt
@@ -1,3 +1,4 @@
-(module flvector-length typed/scheme #:optimize
-  (require racket/unsafe/ops racket/flonum)
-  (flvector-length (flvector 0.0 1.2)))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops racket/flonum)
+(flvector-length (flvector 0.0 1.2))
diff --git a/collects/tests/typed-scheme/optimizer/generic/fx-fl.rkt b/collects/tests/typed-scheme/optimizer/generic/fx-fl.rkt
index ee505dfd..f72ed808 100644
--- a/collects/tests/typed-scheme/optimizer/generic/fx-fl.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/fx-fl.rkt
@@ -1,3 +1,4 @@
-(module fx-fl typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (exact->inexact 1))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(exact->inexact 1)
diff --git a/collects/tests/typed-scheme/optimizer/generic/in-bytes.rkt b/collects/tests/typed-scheme/optimizer/generic/in-bytes.rkt
index 4abbe294..3ee63e31 100644
--- a/collects/tests/typed-scheme/optimizer/generic/in-bytes.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/in-bytes.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 (require racket/unsafe/ops)
 (for: ((i : Integer #"123"))
       (display i))
diff --git a/collects/tests/typed-scheme/optimizer/generic/in-list.rkt b/collects/tests/typed-scheme/optimizer/generic/in-list.rkt
index 6d9dde83..4aec40c8 100644
--- a/collects/tests/typed-scheme/optimizer/generic/in-list.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/in-list.rkt
@@ -1,4 +1,5 @@
-(module in-list typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (for: ((i : Natural '(1 2 3)))
-    (display i)))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(for: ((i : Natural '(1 2 3)))
+      (display i))
diff --git a/collects/tests/typed-scheme/optimizer/generic/in-string.rkt b/collects/tests/typed-scheme/optimizer/generic/in-string.rkt
index 5a17acc3..4b0bc6f2 100644
--- a/collects/tests/typed-scheme/optimizer/generic/in-string.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/in-string.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 (require racket/unsafe/ops)
 (for: ((i : Char "123"))
       (display i))
diff --git a/collects/tests/typed-scheme/optimizer/generic/in-vector.rkt b/collects/tests/typed-scheme/optimizer/generic/in-vector.rkt
index 6cddafcf..c86d3f32 100644
--- a/collects/tests/typed-scheme/optimizer/generic/in-vector.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/in-vector.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 (require racket/unsafe/ops)
 (for: ((i : Integer (vector 1 2 3)))
       (display i))
diff --git a/collects/tests/typed-scheme/optimizer/generic/inexact-complex-conjugate-top.rkt b/collects/tests/typed-scheme/optimizer/generic/inexact-complex-conjugate-top.rkt
index 3e9b4090..98896f9b 100644
--- a/collects/tests/typed-scheme/optimizer/generic/inexact-complex-conjugate-top.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/inexact-complex-conjugate-top.rkt
@@ -1,3 +1,4 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 (require racket/unsafe/ops)
 (conjugate (+ 1.0+2.0i 2.0+4.0i))
diff --git a/collects/tests/typed-scheme/optimizer/generic/inexact-complex-fixnum.rkt b/collects/tests/typed-scheme/optimizer/generic/inexact-complex-fixnum.rkt
index 796242a9..11a63667 100644
--- a/collects/tests/typed-scheme/optimizer/generic/inexact-complex-fixnum.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/inexact-complex-fixnum.rkt
@@ -1,3 +1,4 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 (require racket/unsafe/ops)
 (+ (quotient 2 1) 1.0+2.0i 3.0+6.0i)
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-binary-nonzero-fixnum.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-binary-nonzero-fixnum.rkt
index e1e94c47..389c47d4 100644
--- a/collects/tests/typed-scheme/optimizer/generic/invalid-binary-nonzero-fixnum.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/invalid-binary-nonzero-fixnum.rkt
@@ -1,4 +1,5 @@
-(module invalid-binary-nonzero-fixnum typed/scheme #:optimize
-  (: f ( -> Void))
-  (define (f) ; in a function, to prevent evaluation
-    (display (quotient 4 0)))) ; 2 fixnums, but the second is 0, cannot optimize
+#lang typed/scheme
+#:optimize
+(: f ( -> Void))
+(define (f) ; in a function, to prevent evaluation
+  (display (quotient 4 0))) ; 2 fixnums, but the second is 0, cannot optimize
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-exact-inexact.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-exact-inexact.rkt
index f0fec025..be9df5ae 100644
--- a/collects/tests/typed-scheme/optimizer/generic/invalid-exact-inexact.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/invalid-exact-inexact.rkt
@@ -1,2 +1,3 @@
-(module exact-inexact typed/scheme #:optimize
-  (exact->inexact 1.0)) ; not an integer, can't optimize
+#lang typed/scheme
+#:optimize
+(exact->inexact 1.0) ; not an integer, can't optimize
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-float-comp.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-float-comp.rkt
index 1f972d6b..058e9568 100644
--- a/collects/tests/typed-scheme/optimizer/generic/invalid-float-comp.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/invalid-float-comp.rkt
@@ -1,3 +1,4 @@
-(module float-comp typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (< 1.0 2))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(< 1.0 2)
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-float-promotion.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-float-promotion.rkt
index 169909be..ef72d390 100644
--- a/collects/tests/typed-scheme/optimizer/generic/invalid-float-promotion.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/invalid-float-promotion.rkt
@@ -1,2 +1,3 @@
-(module float-promotion typed/scheme #:optimize
-  (/ 1 2.0)) ; result is not a float, can't optimize
+#lang typed/scheme
+#:optimize
+(/ 1 2.0) ; result is not a float, can't optimize
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-inexact-complex-parts.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-inexact-complex-parts.rkt
index b0a2ab9d..6a3345d3 100644
--- a/collects/tests/typed-scheme/optimizer/generic/invalid-inexact-complex-parts.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/invalid-inexact-complex-parts.rkt
@@ -1,2 +1,3 @@
-(module invalid-inexact-complex-parts.rkt typed/scheme #:optimize
-  (real-part 1+2i))
+#lang typed/scheme
+#:optimize
+(real-part 1+2i)
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-make-flrectangular.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-make-flrectangular.rkt
index ce166151..45995fcc 100644
--- a/collects/tests/typed-scheme/optimizer/generic/invalid-make-flrectangular.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/invalid-make-flrectangular.rkt
@@ -1,2 +1,3 @@
-(module invalid-make-flrectangular typed/scheme #:optimize
-  (make-rectangular 1 2))
+#lang typed/scheme
+#:optimize
+(make-rectangular 1 2)
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-make-polar.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-make-polar.rkt
index f6a646b6..cd94a758 100644
--- a/collects/tests/typed-scheme/optimizer/generic/invalid-make-polar.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/invalid-make-polar.rkt
@@ -1,3 +1,4 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (make-polar 0 0)
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-mpair.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-mpair.rkt
index a7a74511..54fd281b 100644
--- a/collects/tests/typed-scheme/optimizer/generic/invalid-mpair.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/invalid-mpair.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 (: f ((MListof Integer) -> Integer))
 (define (f x)
   (mcar x))
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-sqrt.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-sqrt.rkt
index 39b0336c..bd4182fa 100644
--- a/collects/tests/typed-scheme/optimizer/generic/invalid-sqrt.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/invalid-sqrt.rkt
@@ -1,2 +1,3 @@
-(module invalid-sqrt typed/scheme #:optimize
-  (sqrt -2.0)) ; not a nonnegative flonum, can't optimize
+#lang typed/scheme
+#:optimize
+(sqrt -2.0) ; not a nonnegative flonum, can't optimize
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let.rkt
index 4039f652..532ea426 100644
--- a/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let2.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let2.rkt
index f41ef094..2d4b6144 100644
--- a/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let2.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let2.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-vector-ref.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-vector-ref.rkt
index 74714405..d0a39f04 100644
--- a/collects/tests/typed-scheme/optimizer/generic/invalid-vector-ref.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/invalid-vector-ref.rkt
@@ -1,4 +1,5 @@
-(module invalid-vector-ref typed/scheme #:optimize
-  (: f ((Vectorof Integer) -> Integer))
-  (define (f x)
-    (vector-ref x 0))) ; type is (Vectorof Integer), length is unknown, can't optimize
+#lang typed/scheme
+#:optimize
+(: f ((Vectorof Integer) -> Integer))
+(define (f x)
+  (vector-ref x 0)) ; type is (Vectorof Integer), length is unknown, can't optimize
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-vector-set.rkt b/collects/tests/typed-scheme/optimizer/generic/invalid-vector-set.rkt
index b02fbdc0..391b1940 100644
--- a/collects/tests/typed-scheme/optimizer/generic/invalid-vector-set.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/invalid-vector-set.rkt
@@ -1,4 +1,5 @@
-(module invalid-vector-set typed/scheme #:optimize
-  (: f ((Vectorof Integer) -> Void))
-  (define (f x)
-    (vector-set! x 0 2))) ; type is (Vectorof Integer), length is ot known, can't optimize
+#lang typed/scheme
+#:optimize
+(: f ((Vectorof Integer) -> Void))
+(define (f x)
+  (vector-set! x 0 2)) ; type is (Vectorof Integer), length is ot known, can't optimize
diff --git a/collects/tests/typed-scheme/optimizer/generic/known-vector-length.rkt b/collects/tests/typed-scheme/optimizer/generic/known-vector-length.rkt
index 083d8730..08483637 100644
--- a/collects/tests/typed-scheme/optimizer/generic/known-vector-length.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/known-vector-length.rkt
@@ -1,3 +1,4 @@
-(module known-vector-length typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (+ 2 (vector-length (ann (vector 1 2) (Vector Integer Integer)))))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(+ 2 (vector-length (ann (vector 1 2) (Vector Integer Integer))))
diff --git a/collects/tests/typed-scheme/optimizer/generic/let-float.rkt b/collects/tests/typed-scheme/optimizer/generic/let-float.rkt
index 98e6a9fe..bfc23b14 100644
--- a/collects/tests/typed-scheme/optimizer/generic/let-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/let-float.rkt
@@ -1,4 +1,5 @@
-(module let-float typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (let ((x (+ 3.0 2.0)))
-    (* 9.0 x)))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(let ((x (+ 3.0 2.0)))
+  (* 9.0 x))
diff --git a/collects/tests/typed-scheme/optimizer/generic/let-rhs.rkt b/collects/tests/typed-scheme/optimizer/generic/let-rhs.rkt
index e9f58d5d..d93d5c2a 100644
--- a/collects/tests/typed-scheme/optimizer/generic/let-rhs.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/let-rhs.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/literal-int.rkt b/collects/tests/typed-scheme/optimizer/generic/literal-int.rkt
index 6d6d6b8a..8cd8fd7d 100644
--- a/collects/tests/typed-scheme/optimizer/generic/literal-int.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/literal-int.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/magnitude.rkt b/collects/tests/typed-scheme/optimizer/generic/magnitude.rkt
index aa0f1fc5..1ba1330b 100644
--- a/collects/tests/typed-scheme/optimizer/generic/magnitude.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/magnitude.rkt
@@ -1,4 +1,5 @@
-#lang typed/racket/base #:optimize
+#lang typed/racket/base
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/make-flrectangular.rkt b/collects/tests/typed-scheme/optimizer/generic/make-flrectangular.rkt
index b9250d0e..130f19d6 100644
--- a/collects/tests/typed-scheme/optimizer/generic/make-flrectangular.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/make-flrectangular.rkt
@@ -1,4 +1,5 @@
-(module make-flrectangular typed/scheme #:optimize
-  (require racket/unsafe/ops racket/flonum)
-  (make-rectangular 1.0 2.2)
-  (make-flrectangular 1.0 2.2))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops racket/flonum)
+(make-rectangular 1.0 2.2)
+(make-flrectangular 1.0 2.2)
diff --git a/collects/tests/typed-scheme/optimizer/generic/make-polar.rkt b/collects/tests/typed-scheme/optimizer/generic/make-polar.rkt
index 137f0b17..6916033f 100644
--- a/collects/tests/typed-scheme/optimizer/generic/make-polar.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/make-polar.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/maybe-exact-complex.rkt b/collects/tests/typed-scheme/optimizer/generic/maybe-exact-complex.rkt
index 7201c0d4..fdf7e3a6 100644
--- a/collects/tests/typed-scheme/optimizer/generic/maybe-exact-complex.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/maybe-exact-complex.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/mpair.rkt b/collects/tests/typed-scheme/optimizer/generic/mpair.rkt
index 5fc67a69..5734c82b 100644
--- a/collects/tests/typed-scheme/optimizer/generic/mpair.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/mpair.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 (require racket/unsafe/ops)
 (: x (MPairof Integer Float))
 (define x (mcons 1 1.0))
diff --git a/collects/tests/typed-scheme/optimizer/generic/n-ary-float.rkt b/collects/tests/typed-scheme/optimizer/generic/n-ary-float.rkt
index 54b59581..d93384be 100644
--- a/collects/tests/typed-scheme/optimizer/generic/n-ary-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/n-ary-float.rkt
@@ -1,3 +1,4 @@
-(module n-ary-float typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (+ 1.0 2.0 3.0))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(+ 1.0 2.0 3.0)
diff --git a/collects/tests/typed-scheme/optimizer/generic/nested-float.rkt b/collects/tests/typed-scheme/optimizer/generic/nested-float.rkt
index 04950423..290db71b 100644
--- a/collects/tests/typed-scheme/optimizer/generic/nested-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/nested-float.rkt
@@ -1,3 +1,4 @@
-(module nested-float typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (+ 2.0 (+ 3.0 4.0)))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(+ 2.0 (+ 3.0 4.0))
diff --git a/collects/tests/typed-scheme/optimizer/generic/nested-float2.rkt b/collects/tests/typed-scheme/optimizer/generic/nested-float2.rkt
index ebe30a18..ec44730a 100644
--- a/collects/tests/typed-scheme/optimizer/generic/nested-float2.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/nested-float2.rkt
@@ -1,3 +1,4 @@
-(module nested-float typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (+ 2.0 (* 3.0 4.0)))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(+ 2.0 (* 3.0 4.0))
diff --git a/collects/tests/typed-scheme/optimizer/generic/nested-let-loop.rkt b/collects/tests/typed-scheme/optimizer/generic/nested-let-loop.rkt
index a63ed243..0a8dfc63 100644
--- a/collects/tests/typed-scheme/optimizer/generic/nested-let-loop.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/nested-let-loop.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/nested-pair1.rkt b/collects/tests/typed-scheme/optimizer/generic/nested-pair1.rkt
index 744d0c83..bfe2d3c3 100644
--- a/collects/tests/typed-scheme/optimizer/generic/nested-pair1.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/nested-pair1.rkt
@@ -1,3 +1,4 @@
-(module nested-pair typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (car (cdr '(1 2))))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(car (cdr '(1 2)))
diff --git a/collects/tests/typed-scheme/optimizer/generic/nested-pair2.rkt b/collects/tests/typed-scheme/optimizer/generic/nested-pair2.rkt
index a4c429d1..15baf314 100644
--- a/collects/tests/typed-scheme/optimizer/generic/nested-pair2.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/nested-pair2.rkt
@@ -1,3 +1,4 @@
-(module nested-pair2 typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (car (cdr (cons 3 (cons (cons 2 '()) 1)))))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(car (cdr (cons 3 (cons (cons 2 '()) 1))))
diff --git a/collects/tests/typed-scheme/optimizer/generic/nested-unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/generic/nested-unboxed-let.rkt
index c16bdebb..9d1529e4 100644
--- a/collects/tests/typed-scheme/optimizer/generic/nested-unboxed-let.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/nested-unboxed-let.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/one-arg-arith.rkt b/collects/tests/typed-scheme/optimizer/generic/one-arg-arith.rkt
index 990036e4..686ca154 100644
--- a/collects/tests/typed-scheme/optimizer/generic/one-arg-arith.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/one-arg-arith.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/pair-fun.rkt b/collects/tests/typed-scheme/optimizer/generic/pair-fun.rkt
index 2fea5497..505f290c 100644
--- a/collects/tests/typed-scheme/optimizer/generic/pair-fun.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/pair-fun.rkt
@@ -1,7 +1,8 @@
-(module pair-fun typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (: f ((Listof Integer) -> Integer))
-  (define (f x)
-    (if (null? x)
-        1
-        (car x))))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(: f ((Listof Integer) -> Integer))
+(define (f x)
+  (if (null? x)
+      1
+      (car x)))
diff --git a/collects/tests/typed-scheme/optimizer/generic/quote.rkt b/collects/tests/typed-scheme/optimizer/generic/quote.rkt
index 2d62416f..cedbcaf9 100644
--- a/collects/tests/typed-scheme/optimizer/generic/quote.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/quote.rkt
@@ -1,2 +1,3 @@
-(module quote typed/scheme #:optimize
-  '(+ 1.0 2.0))
+#lang typed/scheme
+#:optimize
+'(+ 1.0 2.0)
diff --git a/collects/tests/typed-scheme/optimizer/generic/real-part-loop.rkt b/collects/tests/typed-scheme/optimizer/generic/real-part-loop.rkt
index 3b333b19..adf87802 100644
--- a/collects/tests/typed-scheme/optimizer/generic/real-part-loop.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/real-part-loop.rkt
@@ -1,4 +1,5 @@
-#lang typed/racket/base #:optimize
+#lang typed/racket/base
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/simple-float.rkt b/collects/tests/typed-scheme/optimizer/generic/simple-float.rkt
index 90676b7a..850c34c9 100644
--- a/collects/tests/typed-scheme/optimizer/generic/simple-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/simple-float.rkt
@@ -1,3 +1,4 @@
-(module simple-float typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (+ 2.0 3.0))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(+ 2.0 3.0)
diff --git a/collects/tests/typed-scheme/optimizer/generic/simple-pair.rkt b/collects/tests/typed-scheme/optimizer/generic/simple-pair.rkt
index e5f69f70..b7020283 100644
--- a/collects/tests/typed-scheme/optimizer/generic/simple-pair.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/simple-pair.rkt
@@ -1,3 +1,4 @@
-(module simple-pair typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (car (cons 1 2)))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(car (cons 1 2))
diff --git a/collects/tests/typed-scheme/optimizer/generic/sqrt-segfault.rkt b/collects/tests/typed-scheme/optimizer/generic/sqrt-segfault.rkt
index 887eb629..af42b1ff 100644
--- a/collects/tests/typed-scheme/optimizer/generic/sqrt-segfault.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/sqrt-segfault.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/sqrt.rkt b/collects/tests/typed-scheme/optimizer/generic/sqrt.rkt
index 411ff900..9ff52d70 100644
--- a/collects/tests/typed-scheme/optimizer/generic/sqrt.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/sqrt.rkt
@@ -1,5 +1,6 @@
-(module sqrt typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (: f (Nonnegative-Float -> Nonnegative-Float))
-  (define (f x)
-    (sqrt x)))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(: f (Nonnegative-Float -> Nonnegative-Float))
+(define (f x)
+  (sqrt x))
diff --git a/collects/tests/typed-scheme/optimizer/generic/string-length.rkt b/collects/tests/typed-scheme/optimizer/generic/string-length.rkt
index 30210100..b3053d04 100644
--- a/collects/tests/typed-scheme/optimizer/generic/string-length.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/string-length.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/structs.rkt b/collects/tests/typed-scheme/optimizer/generic/structs.rkt
index 4fb39c9d..7ea3763b 100644
--- a/collects/tests/typed-scheme/optimizer/generic/structs.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/structs.rkt
@@ -1,6 +1,7 @@
-(module structs typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (define-struct: pt ((x : Integer) (y : Integer)) #:mutable)
-  (define a (pt 3 4))
-  (pt-x a)
-  (set-pt-y! a 5))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(define-struct: pt ((x : Integer) (y : Integer)) #:mutable)
+(define a (pt 3 4))
+(pt-x a)
+(set-pt-y! a 5)
diff --git a/collects/tests/typed-scheme/optimizer/generic/unary-fixnum-nested.rkt b/collects/tests/typed-scheme/optimizer/generic/unary-fixnum-nested.rkt
index 710197af..054dcc37 100644
--- a/collects/tests/typed-scheme/optimizer/generic/unary-fixnum-nested.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/unary-fixnum-nested.rkt
@@ -1,3 +1,4 @@
-(module unary-fixnum-nested typed/scheme #:optimize
-  (require racket/unsafe/ops racket/fixnum)
-  (abs (bitwise-not (length '(1 2 3)))))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops racket/fixnum)
+(abs (bitwise-not (length '(1 2 3))))
diff --git a/collects/tests/typed-scheme/optimizer/generic/unary-fixnum.rkt b/collects/tests/typed-scheme/optimizer/generic/unary-fixnum.rkt
index b9309084..c6183cbe 100644
--- a/collects/tests/typed-scheme/optimizer/generic/unary-fixnum.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/unary-fixnum.rkt
@@ -1,3 +1,4 @@
-(module unary-fixnum typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (bitwise-not 4))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(bitwise-not 4)
diff --git a/collects/tests/typed-scheme/optimizer/generic/unary-float.rkt b/collects/tests/typed-scheme/optimizer/generic/unary-float.rkt
index d57f3950..0f9075a0 100644
--- a/collects/tests/typed-scheme/optimizer/generic/unary-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/unary-float.rkt
@@ -1,3 +1,4 @@
-(module float-unary typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (sin 2.0))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(sin 2.0)
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-for.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-for.rkt
index 24e60d24..ebc3fc37 100644
--- a/collects/tests/typed-scheme/optimizer/generic/unboxed-for.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-for.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions1.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions1.rkt
index 2c3ec851..ae8623a4 100644
--- a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions1.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions1.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions2.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions2.rkt
index 9c923800..1b2b401f 100644
--- a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions2.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions2.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions3.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions3.rkt
index 9bc0f44c..32a0c2d8 100644
--- a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions3.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions3.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions4.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions4.rkt
index eef46901..ec577333 100644
--- a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions4.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions4.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions5.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions5.rkt
index 7b685942..fb5da8d2 100644
--- a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions5.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions5.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions6.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions6.rkt
index b50c6e86..31fae6f1 100644
--- a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions6.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions6.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops racket/flonum)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions7.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions7.rkt
index 792b46a5..b60a7eec 100644
--- a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions7.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions7.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops racket/flonum)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions8.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions8.rkt
index 124b4cbd..88610a8c 100644
--- a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions8.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions8.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let.rkt
index bfa8fff1..faa7be8a 100644
--- a/collects/tests/typed-scheme/optimizer/generic/unboxed-let.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let2.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let2.rkt
index f5f8c2a5..fc47b9a2 100644
--- a/collects/tests/typed-scheme/optimizer/generic/unboxed-let2.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let2.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let3.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-let3.rkt
index b52e893c..2ca3e9d1 100644
--- a/collects/tests/typed-scheme/optimizer/generic/unboxed-let3.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-let3.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-letrec-syntaxes+values.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-letrec-syntaxes+values.rkt
index f0923031..ae3c43b4 100644
--- a/collects/tests/typed-scheme/optimizer/generic/unboxed-letrec-syntaxes+values.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-letrec-syntaxes+values.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-letrec.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-letrec.rkt
index aed81a45..c70b05d2 100644
--- a/collects/tests/typed-scheme/optimizer/generic/unboxed-letrec.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-letrec.rkt
@@ -1,8 +1,9 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
-(letrec ((#{f : (Any -> Any)} (lambda: ((x : Any)) (f x)))
-         (#{x : Inexact-Complex} 1.0+2.0i)
-         (#{y : Inexact-Complex} (+ 2.0+4.0i 3.0+6.0i)))
+(letrec: ((f : (Any -> Any) (lambda: ((x : Any)) (f x)))
+          (x : Inexact-Complex 1.0+2.0i)
+          (y : Inexact-Complex (+ 2.0+4.0i 3.0+6.0i)))
   (+ x y))
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-make-rectangular.rkt b/collects/tests/typed-scheme/optimizer/generic/unboxed-make-rectangular.rkt
index 87d3f05d..eeffd93a 100644
--- a/collects/tests/typed-scheme/optimizer/generic/unboxed-make-rectangular.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/unboxed-make-rectangular.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 
 (require racket/unsafe/ops)
 
diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-length-nested.rkt b/collects/tests/typed-scheme/optimizer/generic/vector-length-nested.rkt
index ade363e1..81bf26b2 100644
--- a/collects/tests/typed-scheme/optimizer/generic/vector-length-nested.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/vector-length-nested.rkt
@@ -1,7 +1,8 @@
-(module vector-length typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (vector-length
-   (vector-ref
-    (ann (vector (vector 1 2) 2 3)
-         (Vector (Vectorof Integer) Integer Integer))
-    0)))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(vector-length
+ (vector-ref
+  (ann (vector (vector 1 2) 2 3)
+       (Vector (Vectorof Integer) Integer Integer))
+  0))
diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-length.rkt b/collects/tests/typed-scheme/optimizer/generic/vector-length.rkt
index 51093a09..7992fb63 100644
--- a/collects/tests/typed-scheme/optimizer/generic/vector-length.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/vector-length.rkt
@@ -1,3 +1,4 @@
-(module vector-length typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (vector-length (vector 1 2 3)))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(vector-length (vector 1 2 3))
diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-ref-set-ref.rkt b/collects/tests/typed-scheme/optimizer/generic/vector-ref-set-ref.rkt
index 711633ea..8833301a 100644
--- a/collects/tests/typed-scheme/optimizer/generic/vector-ref-set-ref.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/vector-ref-set-ref.rkt
@@ -1,7 +1,8 @@
-(module vector-ref-set-ref typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (: x (Vector Integer String))
-  (define x (vector 1 "1"))
-  (vector-ref x 0)
-  (vector-set! x 1 "2")
-  (vector-ref x 1))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(: x (Vector Integer String))
+(define x (vector 1 "1"))
+(vector-ref x 0)
+(vector-set! x 1 "2")
+(vector-ref x 1)
diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-ref.rkt b/collects/tests/typed-scheme/optimizer/generic/vector-ref.rkt
index 00261f8a..1f149356 100644
--- a/collects/tests/typed-scheme/optimizer/generic/vector-ref.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/vector-ref.rkt
@@ -1,3 +1,4 @@
-(module vector-ref typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (vector-ref (ann (vector 1 2) (Vector Integer Integer)) 0))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(vector-ref (ann (vector 1 2) (Vector Integer Integer)) 0)
diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-ref2.rkt b/collects/tests/typed-scheme/optimizer/generic/vector-ref2.rkt
index 434fa07c..e9cf5ee5 100644
--- a/collects/tests/typed-scheme/optimizer/generic/vector-ref2.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/vector-ref2.rkt
@@ -1,3 +1,4 @@
-(module vector-ref2 typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (vector-ref (vector 1 2 3) 0))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(vector-ref (vector 1 2 3) 0)
diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-set-quote.rkt b/collects/tests/typed-scheme/optimizer/generic/vector-set-quote.rkt
index 063b78d3..5243c3f3 100644
--- a/collects/tests/typed-scheme/optimizer/generic/vector-set-quote.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/vector-set-quote.rkt
@@ -1,5 +1,6 @@
-(module vector-set-quote typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (vector-set! (ann (vector '(1 2)) (Vector Any))
-               0
-               '(+ 1.0 2.0))) ; we should not optimize under quote
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(vector-set! (ann (vector '(1 2)) (Vector Any))
+             0
+             '(+ 1.0 2.0)) ; we should not optimize under quote
diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-set.rkt b/collects/tests/typed-scheme/optimizer/generic/vector-set.rkt
index 5f29aa5e..d01f53c5 100644
--- a/collects/tests/typed-scheme/optimizer/generic/vector-set.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/vector-set.rkt
@@ -1,5 +1,6 @@
-(module vector-set typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (vector-set! (ann (vector 1 2) (Vector Integer Integer))
-               0
-               1))
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(vector-set! (ann (vector 1 2) (Vector Integer Integer))
+             0
+             1)
diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-set2.rkt b/collects/tests/typed-scheme/optimizer/generic/vector-set2.rkt
index 910575d5..d66ff004 100644
--- a/collects/tests/typed-scheme/optimizer/generic/vector-set2.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/vector-set2.rkt
@@ -1,3 +1,4 @@
-(module invalid-vector-set typed/scheme #:optimize
-  (require racket/unsafe/ops)
-  (vector-set! (vector 1 2) 0 2)) ; type is (Vectorof Integer), length is ot known, can't optimize
+#lang typed/scheme
+#:optimize
+(require racket/unsafe/ops)
+(vector-set! (vector 1 2) 0 2) ; type is (Vectorof Integer), length is ot known, can't optimize
diff --git a/collects/tests/typed-scheme/optimizer/generic/zero.rkt b/collects/tests/typed-scheme/optimizer/generic/zero.rkt
index dc78943c..e853019b 100644
--- a/collects/tests/typed-scheme/optimizer/generic/zero.rkt
+++ b/collects/tests/typed-scheme/optimizer/generic/zero.rkt
@@ -1,4 +1,5 @@
-#lang typed/scheme #:optimize
+#lang typed/scheme
+#:optimize
 (require racket/unsafe/ops)
 (zero? 1)
 (zero? (sqrt 3.0))
diff --git a/collects/tests/typed-scheme/optimizer/run.rkt b/collects/tests/typed-scheme/optimizer/run.rkt
index d089824f..29dd9088 100644
--- a/collects/tests/typed-scheme/optimizer/run.rkt
+++ b/collects/tests/typed-scheme/optimizer/run.rkt
@@ -1,5 +1,5 @@
 #lang racket
-(require racket/runtime-path)
+(require racket/runtime-path racket/sandbox)
 
 ;; since Typed Scheme's optimizer does source to source transformations,
 ;; we compare the expansion of automatically optimized and hand optimized
@@ -23,6 +23,33 @@
                          #'(#f #f #f (#f)))]) ; for cadddr
          (expand (with-input-from-file file read-syntax))))))))
 
+
+;; the first line must be the #lang line
+;; the second line must be #:optimize
+(define (evaluator file #:optimize [optimize? #f])
+  (call-with-trusted-sandbox-configuration
+   (lambda ()
+     (parameterize ([current-load-relative-directory
+                     (build-path here "generic")]
+                    [sandbox-memory-limit #f] ; TR needs memory
+                    [sandbox-output 'string]
+                    [sandbox-namespace-specs
+                     (list (car (sandbox-namespace-specs))
+                           'typed/racket
+                           'typed/scheme)])
+       (let* ((lines (cdr (file->lines file))) ;; drop the #lang line
+              (in    (if optimize?
+                         lines
+                         (cdr lines))) ;; drop the #:optimize
+              (evaluator
+               (make-evaluator 'typed/racket
+                               (foldl (lambda (acc new)
+                                        (string-append new "\n" acc))
+                                      "" in)))
+              (out (get-output evaluator)))
+         (kill-evaluator evaluator)
+         out)))))
+
 (define (test gen)
   (let-values (((base name _) (split-path gen)))
     (or (regexp-match ".*~" name) ; we ignore backup files
@@ -39,13 +66,7 @@
                         #f))
              ;; optimized and non-optimized versions must evaluate to the
              ;; same thing
-             (or (equal? (with-output-to-string
-                           (lambda ()
-                             (dynamic-require gen #f)))
-                         (with-output-to-string
-                           (lambda ()
-                             (let ((non-opt-dir (build-path here "non-optimized")))
-                               (dynamic-require (build-path non-opt-dir name) #f)))))
+             (or (equal? (evaluator gen) (evaluator gen #:optimize #t))
                  (begin (printf "~a failed: result mismatch\n\n" name)
                         #f))))))
 

From 99658f326c0db93eab6fe202357887ceeb5ecd9d Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 26 Aug 2010 18:51:48 -0400
Subject: [PATCH 085/198] Logging can be turned on from the command-line.

original commit: 9b598df60a5fb621491a3513ff445e2db6053f83
---
 collects/typed-scheme/optimizer/utils.rkt | 5 +++--
 1 file changed, 3 insertions(+), 2 deletions(-)

diff --git a/collects/typed-scheme/optimizer/utils.rkt b/collects/typed-scheme/optimizer/utils.rkt
index dfe0b200..bea4208e 100644
--- a/collects/typed-scheme/optimizer/utils.rkt
+++ b/collects/typed-scheme/optimizer/utils.rkt
@@ -15,8 +15,9 @@
          unboxed-gensym reset-unboxed-gensym
          optimize)
 
-
-(define *log-optimizations?* #f)
+(define *log-optimizations?*
+  (member "--log-optimizations"
+          (vector->list (current-command-line-arguments))))
 (define *log-optimizatons-to-log-file?* #f)
 (define *optimization-log-file* "opt-log")
 (define (log-optimization kind stx)

From 2ed40e6b09b86b2badc5aeea44c39515ff4b77e5 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 26 Aug 2010 18:53:11 -0400
Subject: [PATCH 086/198] Adapted filename logging for testing purposes.

original commit: 6f6ec3b2bf1999e64c04b9ff2afb29739e9c3eef
---
 collects/typed-scheme/optimizer/utils.rkt | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/collects/typed-scheme/optimizer/utils.rkt b/collects/typed-scheme/optimizer/utils.rkt
index bea4208e..d36b92e2 100644
--- a/collects/typed-scheme/optimizer/utils.rkt
+++ b/collects/typed-scheme/optimizer/utils.rkt
@@ -23,7 +23,8 @@
 (define (log-optimization kind stx)
   (if *log-optimizations?*
       (printf "~a line ~a col ~a - ~a - ~a\n"
-              (syntax-source stx) (syntax-line stx) (syntax-column stx)
+              (syntax-source-file-name stx)
+              (syntax-line stx) (syntax-column stx)
               (syntax->datum stx)
               kind)
       #t))

From 5169f42b2868f7ae9f65ca3d7d06b09116c41545 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 27 Aug 2010 11:35:02 -0400
Subject: [PATCH 087/198] Test expected optimizations by comparing optimizer
 logs instead of expanded code.

original commit: 18af26ec9b4a20aa62bddc5cd04d54c6c35a7ac2
---
 collects/tests/typed-scheme/optimizer/run.rkt | 54 +++++++------------
 1 file changed, 20 insertions(+), 34 deletions(-)

diff --git a/collects/tests/typed-scheme/optimizer/run.rkt b/collects/tests/typed-scheme/optimizer/run.rkt
index 29dd9088..f171ce05 100644
--- a/collects/tests/typed-scheme/optimizer/run.rkt
+++ b/collects/tests/typed-scheme/optimizer/run.rkt
@@ -1,29 +1,6 @@
 #lang racket
 (require racket/runtime-path racket/sandbox)
 
-;; since Typed Scheme's optimizer does source to source transformations,
-;; we compare the expansion of automatically optimized and hand optimized
-;; modules
-(define (read-and-expand file)
-  ;; drop the type tables added by typed scheme, since they can be in a
-  ;; different order each time, and that would make tests fail when they
-  ;; shouldn't
-  (filter
-   ;; drop the "module", its name and its language, so that we can write
-   ;; the 2 versions of each test in different languages (typed and
-   ;; untyped) if need be
-   (match-lambda [(list 'define-values-for-syntax '() _ ...) #f] [_ #t])
-   (cadddr
-    (syntax->datum
-     (parameterize ([current-namespace (make-base-namespace)]
-                    [read-accept-reader #t])
-       (with-handlers
-           ([exn:fail? (lambda (exn)
-                         (printf "~a\n" (exn-message exn))
-                         #'(#f #f #f (#f)))]) ; for cadddr
-         (expand (with-input-from-file file read-syntax))))))))
-
-
 ;; the first line must be the #lang line
 ;; the second line must be #:optimize
 (define (evaluator file #:optimize [optimize? #f])
@@ -50,19 +27,28 @@
          (kill-evaluator evaluator)
          out)))))
 
+(define (generate-opt-log name)
+  (parameterize ([current-load-relative-directory (build-path here "generic")]
+                 [current-command-line-arguments  '#("--log-optimizations")])
+    (with-output-to-string
+      (lambda ()
+        (dynamic-require (build-path (current-load-relative-directory) name)
+                         #f)))))
+
 (define (test gen)
   (let-values (((base name _) (split-path gen)))
-    (or (regexp-match ".*~" name) ; we ignore backup files
-        (directory-exists? gen)   ; and directories
-        ;; machine optimized and hand optimized versions must expand to the
-        ;; same code
-        (and (or (equal? (parameterize ([current-load-relative-directory
-                                         (build-path here "generic")])
-                           (read-and-expand gen))
-                         (let ((hand-opt-dir (build-path here "hand-optimized")))
-                           (parameterize ([current-load-relative-directory hand-opt-dir])
-                             (read-and-expand (build-path hand-opt-dir name)))))
-                 (begin (printf "~a failed: expanded code mismatch\n\n" name)
+    (or (not (regexp-match ".*rkt$" name)) ; we ignore all but racket files
+        ;; we log optimizations and compare to an expected log to make sure
+        ;; that all the optimizations we expected did indeed happen
+        (and (or (let ((log      (generate-opt-log name))
+                       ;; expected optimizer log, to see what was optimized
+                       (expected
+                        (file->string
+                         (build-path base
+                                     (string-append (path->string name)
+                                                    ".log")))))
+                   (equal? log expected))
+                 (begin (printf "~a failed: optimization log mismatch\n\n" name)
                         #f))
              ;; optimized and non-optimized versions must evaluate to the
              ;; same thing

From 31342660e4c33e2aa11ddd42d217d2f237f97249 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 27 Aug 2010 12:22:19 -0400
Subject: [PATCH 088/198] Improved logging since it's now used for testing.

original commit: ca16ac4db50032324c2886766f477909f38b983c
---
 .../optimizer/inexact-complex.rkt             | 49 +++++++++++--------
 collects/typed-scheme/optimizer/string.rkt    |  4 +-
 .../typed-scheme/optimizer/unboxed-let.rkt    | 10 +++-
 collects/typed-scheme/optimizer/vector.rkt    |  6 +--
 4 files changed, 42 insertions(+), 27 deletions(-)

diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt
index 1d177801..a733651c 100644
--- a/collects/typed-scheme/optimizer/inexact-complex.rkt
+++ b/collects/typed-scheme/optimizer/inexact-complex.rkt
@@ -229,7 +229,7 @@
            #:with real-binding #'c.real-binding
            #:with imag-binding #f
            #:with (bindings ...)
-           (begin (log-optimization "unboxed unary inexact complex**" #'op)
+           (begin (log-optimization "unboxed unary inexact complex" #'op)
                   #'(c.bindings ...)))
   (pattern (#%plain-app (~and op (~or (~literal imag-part) (~literal unsafe-flimag-part)))
                         c:unboxed-inexact-complex-opt-expr)
@@ -244,7 +244,7 @@
   (pattern e:float-coerce-expr
            #:with real-binding (unboxed-gensym 'unboxed-float-)
            #:with imag-binding #f
-           #:when (log-optimization "float-coerce-expr" #'e)
+           #:when (log-optimization "float-coerce-expr in complex ops" #'e)
            #:with (bindings ...)
            #`(((real-binding) e.opt)))
     
@@ -278,7 +278,9 @@
            #:when (syntax->datum #'unboxed-info)
            #:with real-binding (car  (syntax->list #'unboxed-info))
            #:with imag-binding (cadr (syntax->list #'unboxed-info))
-           #:with (bindings ...) #'())
+           #:with (bindings ...)
+           (begin (log-optimization "leave var unboxed" #'v)
+                  #'()))
   
   ;; else, do the unboxing here
 
@@ -290,21 +292,23 @@
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with (bindings ...)
-           (let ((n (syntax->datum #'n)))
-             #`(((real-binding) #,(datum->syntax
-                                   #'here
-                                   (exact->inexact (real-part n))))
-                ((imag-binding) #,(datum->syntax
-                                   #'here
-                                   (exact->inexact (imag-part n)))))))
+           (begin (log-optimization "unboxed literal" #'n)
+                  (let ((n (syntax->datum #'n)))
+                    #`(((real-binding) #,(datum->syntax
+                                          #'here
+                                          (exact->inexact (real-part n))))
+                       ((imag-binding) #,(datum->syntax
+                                          #'here
+                                          (exact->inexact (imag-part n))))))))
   (pattern (quote n)
            #:when (real? (syntax->datum #'n))
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding #f
            #:with (bindings ...)
-           #`(((real-binding) #,(datum->syntax
-                                 #'here
-                                 (exact->inexact (syntax->datum #'n))))))
+           (begin (log-optimization "unboxed literal" #'n)
+                  #`(((real-binding) #,(datum->syntax
+                                        #'here
+                                        (exact->inexact (syntax->datum #'n)))))))
   
   (pattern e:expr
            #:when (isoftype? #'e -InexactComplex)
@@ -312,18 +316,20 @@
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with (bindings ...)
-           #`(((e*) #,((optimize) #'e))
-              ((real-binding) (unsafe-flreal-part e*))
-              ((imag-binding) (unsafe-flimag-part e*))))
+           (begin (log-optimization "unbox inexact-complex" #'e)
+                  #`(((e*) #,((optimize) #'e))
+                     ((real-binding) (unsafe-flreal-part e*))
+                     ((imag-binding) (unsafe-flimag-part e*)))))
   (pattern e:expr
            #:when (isoftype? #'e -Number) ; complex, maybe exact, maybe not
            #:with e* (unboxed-gensym)
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with (bindings ...)
-           #`(((e*) #,((optimize) #'e))
-              ((real-binding) (exact->inexact (real-part e*)))
-              ((imag-binding) (exact->inexact (imag-part e*)))))
+           (begin (log-optimization "unbox complex" #'e)
+                  #`(((e*) #,((optimize) #'e))
+                     ((real-binding) (exact->inexact (real-part e*)))
+                     ((imag-binding) (exact->inexact (imag-part e*))))))
   (pattern e:expr
            #:with (bindings ...)
            (error "non exhaustive pattern match")
@@ -387,7 +393,8 @@
                             #'unboxed-info #'op)) ; no need to optimize op
            #'e
            #:with opt
-           #'e*.opt)  
+           (begin (log-optimization "call to fun with unboxed args" #'op)
+                  #'e*.opt))
   
   (pattern e:inexact-complex-arith-opt-expr
            #:with opt #'e.opt))
@@ -427,7 +434,7 @@
            #:with (bindings ...) #'()
            ;; unboxed variable used in a boxed fashion, we have to box
            #:with opt
-           (begin (log-optimization "unboxed complex variable " #'v)
+           (begin (log-optimization "unboxed complex variable" #'v)
                   (reset-unboxed-gensym)
                   #'(unsafe-make-flrectangular real-binding imag-binding))))
 
diff --git a/collects/typed-scheme/optimizer/string.rkt b/collects/typed-scheme/optimizer/string.rkt
index 8f9f019e..6d29c5ca 100644
--- a/collects/typed-scheme/optimizer/string.rkt
+++ b/collects/typed-scheme/optimizer/string.rkt
@@ -20,9 +20,9 @@
 (define-syntax-class string-opt-expr
   (pattern (#%plain-app (~literal string-length) s:string-expr)
            #:with opt
-           (begin (log-optimization "string" #'op)
+           (begin (log-optimization "string-length" #'op)
                   #'(unsafe-string-length s.opt)))
   (pattern (#%plain-app (~literal bytes-length) s:bytes-expr)
            #:with opt
-           (begin (log-optimization "bytes" #'op)
+           (begin (log-optimization "bytes-length" #'op)
                   #'(unsafe-bytes-length s.opt))))
diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index cb8fb9ee..73047acd 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -38,7 +38,8 @@
                             #'unboxed-info #'operator.opt))
            #'e
            #:with opt
-           #'e*.opt))
+           (begin (log-optimization "unboxed let loop" #'loop-fun)
+                  #'e*.opt)))
 
 ;; does the bulk of the work
 ;; detects which let bindings can be unboxed, same for arguments of let-bound
@@ -98,6 +99,10 @@
                                             ;; if so, add to the table of functions with
                                             ;; unboxed params, so we can modify its call
                                             ;; sites, it's body and its header
+                                            (begin (log-optimization
+                                                    "unboxed function -> table"
+                                                    fun-name)
+                                                   #t)
                                             (dict-set! unboxed-funs-table fun-name
                                                        (list (reverse unboxed)
                                                              (reverse boxed))))]
@@ -105,6 +110,8 @@
                                             (could-be-unboxed-in?
                                              (car params) #'(begin body ...)))
                                        ;; we can unbox
+                                       (log-optimization "unboxed var -> table"
+                                                         (car params))
                                        (loop (cons i unboxed) boxed
                                              (add1 i) (cdr params) (cdr doms))]
                                       [else ; can't unbox
@@ -278,6 +285,7 @@
                                          (syntax->list #'(to-unbox ...)))
            #:with res
            (begin
+             (log-optimization "fun -> unboxed fun" #'v)
              ;; add unboxed parameters to the unboxed vars table
              (let ((to-unbox (map syntax->datum (syntax->list #'(to-unbox ...)))))
                (let loop ((params     (syntax->list #'params))
diff --git a/collects/typed-scheme/optimizer/vector.rkt b/collects/typed-scheme/optimizer/vector.rkt
index 10144147..d162dcab 100644
--- a/collects/typed-scheme/optimizer/vector.rkt
+++ b/collects/typed-scheme/optimizer/vector.rkt
@@ -30,7 +30,7 @@
                                       (~literal unsafe-vector*-length)))
                         v:vector-expr)
            #:with opt
-           (begin (log-optimization "known-length vector" #'op)
+           (begin (log-optimization "known-length vector-length" #'op)
                   (match (type-of #'v)
                     [(tc-result1: (HeterogenousVector: es))
                      #`(begin v.opt #,(length es))]))) ; v may have side effects
@@ -39,12 +39,12 @@
   ;; we can optimize no matter what.
   (pattern (#%plain-app (~and op (~literal vector-length)) v:expr)
            #:with opt
-           (begin (log-optimization "vector" #'op)
+           (begin (log-optimization "vector-length" #'op)
                   #`(unsafe-vector*-length #,((optimize) #'v))))
   ;; same for flvector-length
   (pattern (#%plain-app (~and op (~literal flvector-length)) v:expr)
            #:with opt
-           (begin (log-optimization "flvector" #'op)
+           (begin (log-optimization "flvector-length" #'op)
                   #`(unsafe-flvector-length #,((optimize) #'v))))
   ;; we can optimize vector ref and set! on vectors of known length if we know
   ;; the index is within bounds (for now, literal or singleton type)

From 989cd5ce81a1969aa06323bdc0cf68ee5f7aa328 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 27 Aug 2010 12:24:31 -0400
Subject: [PATCH 089/198] Renamed tests directory to make more sense with the
 new structure.

original commit: 7cfba9f02d48d10a886bf2cfce2499a26b8db9af
---
 .../optimizer/generic/inexact-complex-conjugate-top.rkt   | 4 ----
 .../optimizer/generic/inexact-complex-fixnum.rkt          | 4 ----
 collects/tests/typed-scheme/optimizer/run.rkt             | 8 ++++----
 .../optimizer/{generic => tests}/apply-plus.rkt           | 0
 .../optimizer/{generic => tests}/begin-float.rkt          | 0
 .../optimizer/{generic => tests}/binary-fixnum.rkt        | 0
 .../{generic => tests}/binary-nonzero-fixnum.rkt          | 0
 .../typed-scheme/optimizer/{generic => tests}/box.rkt     | 0
 .../optimizer/{generic => tests}/cross-module-struct.rkt  | 0
 .../optimizer/{generic => tests}/cross-module-struct2.rkt | 0
 .../optimizer/{generic => tests}/dead-else.rkt            | 0
 .../optimizer/{generic => tests}/dead-substructs.rkt      | 0
 .../optimizer/{generic => tests}/dead-then.rkt            | 0
 .../optimizer/{generic => tests}/define-begin-float.rkt   | 0
 .../optimizer/{generic => tests}/define-call-float.rkt    | 0
 .../optimizer/{generic => tests}/define-float.rkt         | 0
 .../optimizer/{generic => tests}/define-pair.rkt          | 0
 .../optimizer/{generic => tests}/different-langs.rkt      | 0
 .../optimizer/{generic => tests}/double-float.rkt         | 0
 .../optimizer/{generic => tests}/exact-inexact.rkt        | 0
 .../optimizer/{generic => tests}/fixnum-comparison.rkt    | 0
 .../optimizer/{generic => tests}/float-comp.rkt           | 0
 .../optimizer/{generic => tests}/float-fun.rkt            | 0
 .../optimizer/{generic => tests}/float-promotion.rkt      | 0
 .../optimizer/{generic => tests}/flvector-length.rkt      | 0
 .../typed-scheme/optimizer/{generic => tests}/fx-fl.rkt   | 0
 .../optimizer/{generic => tests}/in-bytes.rkt             | 0
 .../typed-scheme/optimizer/{generic => tests}/in-list.rkt | 0
 .../optimizer/{generic => tests}/in-string.rkt            | 0
 .../optimizer/{generic => tests}/in-vector.rkt            | 0
 .../{generic => tests}/invalid-binary-nonzero-fixnum.rkt  | 0
 .../{generic => tests}/invalid-exact-inexact.rkt          | 0
 .../optimizer/{generic => tests}/invalid-float-comp.rkt   | 0
 .../{generic => tests}/invalid-float-promotion.rkt        | 0
 .../{generic => tests}/invalid-inexact-complex-parts.rkt  | 0
 .../{generic => tests}/invalid-make-flrectangular.rkt     | 0
 .../optimizer/{generic => tests}/invalid-make-polar.rkt   | 0
 .../optimizer/{generic => tests}/invalid-mpair.rkt        | 0
 .../optimizer/{generic => tests}/invalid-sqrt.rkt         | 0
 .../optimizer/{generic => tests}/invalid-unboxed-let.rkt  | 0
 .../optimizer/{generic => tests}/invalid-unboxed-let2.rkt | 0
 .../optimizer/{generic => tests}/invalid-vector-ref.rkt   | 0
 .../optimizer/{generic => tests}/invalid-vector-set.rkt   | 0
 .../optimizer/{generic => tests}/known-vector-length.rkt  | 0
 .../optimizer/{generic => tests}/let-float.rkt            | 0
 .../typed-scheme/optimizer/{generic => tests}/let-rhs.rkt | 0
 .../optimizer/{generic => tests}/literal-int.rkt          | 0
 .../optimizer/{generic => tests}/magnitude.rkt            | 0
 .../optimizer/{generic => tests}/make-flrectangular.rkt   | 0
 .../optimizer/{generic => tests}/make-polar.rkt           | 0
 .../optimizer/{generic => tests}/maybe-exact-complex.rkt  | 0
 .../typed-scheme/optimizer/{generic => tests}/mpair.rkt   | 0
 .../optimizer/{generic => tests}/n-ary-float.rkt          | 0
 .../optimizer/{generic => tests}/nested-float.rkt         | 0
 .../optimizer/{generic => tests}/nested-float2.rkt        | 0
 .../optimizer/{generic => tests}/nested-let-loop.rkt      | 0
 .../optimizer/{generic => tests}/nested-pair1.rkt         | 0
 .../optimizer/{generic => tests}/nested-pair2.rkt         | 0
 .../optimizer/{generic => tests}/nested-unboxed-let.rkt   | 0
 .../optimizer/{generic => tests}/one-arg-arith.rkt        | 0
 .../optimizer/{generic => tests}/pair-fun.rkt             | 0
 .../typed-scheme/optimizer/{generic => tests}/quote.rkt   | 0
 .../optimizer/{generic => tests}/real-part-loop.rkt       | 0
 .../optimizer/{generic => tests}/simple-float.rkt         | 0
 .../optimizer/{generic => tests}/simple-pair.rkt          | 0
 .../optimizer/{generic => tests}/sqrt-segfault.rkt        | 0
 .../typed-scheme/optimizer/{generic => tests}/sqrt.rkt    | 0
 .../optimizer/{generic => tests}/string-length.rkt        | 0
 .../typed-scheme/optimizer/{generic => tests}/structs.rkt | 0
 .../optimizer/{generic => tests}/unary-fixnum-nested.rkt  | 0
 .../optimizer/{generic => tests}/unary-fixnum.rkt         | 0
 .../optimizer/{generic => tests}/unary-float.rkt          | 0
 .../optimizer/{generic => tests}/unboxed-for.rkt          | 0
 .../{generic => tests}/unboxed-let-functions1.rkt         | 0
 .../{generic => tests}/unboxed-let-functions2.rkt         | 0
 .../{generic => tests}/unboxed-let-functions3.rkt         | 0
 .../{generic => tests}/unboxed-let-functions4.rkt         | 0
 .../{generic => tests}/unboxed-let-functions5.rkt         | 0
 .../{generic => tests}/unboxed-let-functions6.rkt         | 0
 .../{generic => tests}/unboxed-let-functions7.rkt         | 0
 .../{generic => tests}/unboxed-let-functions8.rkt         | 0
 .../optimizer/{generic => tests}/unboxed-let.rkt          | 0
 .../optimizer/{generic => tests}/unboxed-let2.rkt         | 0
 .../optimizer/{generic => tests}/unboxed-let3.rkt         | 0
 .../{generic => tests}/unboxed-letrec-syntaxes+values.rkt | 0
 .../optimizer/{generic => tests}/unboxed-letrec.rkt       | 0
 .../{generic => tests}/unboxed-make-rectangular.rkt       | 0
 .../optimizer/{generic => tests}/vector-length-nested.rkt | 0
 .../optimizer/{generic => tests}/vector-length.rkt        | 0
 .../optimizer/{generic => tests}/vector-ref-set-ref.rkt   | 0
 .../optimizer/{generic => tests}/vector-ref.rkt           | 0
 .../optimizer/{generic => tests}/vector-ref2.rkt          | 0
 .../optimizer/{generic => tests}/vector-set-quote.rkt     | 0
 .../optimizer/{generic => tests}/vector-set.rkt           | 0
 .../optimizer/{generic => tests}/vector-set2.rkt          | 0
 .../typed-scheme/optimizer/{generic => tests}/zero.rkt    | 0
 96 files changed, 4 insertions(+), 12 deletions(-)
 delete mode 100644 collects/tests/typed-scheme/optimizer/generic/inexact-complex-conjugate-top.rkt
 delete mode 100644 collects/tests/typed-scheme/optimizer/generic/inexact-complex-fixnum.rkt
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/apply-plus.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/begin-float.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/binary-fixnum.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/binary-nonzero-fixnum.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/box.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/cross-module-struct.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/cross-module-struct2.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/dead-else.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/dead-substructs.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/dead-then.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/define-begin-float.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/define-call-float.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/define-float.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/define-pair.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/different-langs.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/double-float.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/exact-inexact.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/fixnum-comparison.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/float-comp.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/float-fun.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/float-promotion.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/flvector-length.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/fx-fl.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/in-bytes.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/in-list.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/in-string.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/in-vector.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/invalid-binary-nonzero-fixnum.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/invalid-exact-inexact.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/invalid-float-comp.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/invalid-float-promotion.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/invalid-inexact-complex-parts.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/invalid-make-flrectangular.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/invalid-make-polar.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/invalid-mpair.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/invalid-sqrt.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/invalid-unboxed-let.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/invalid-unboxed-let2.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/invalid-vector-ref.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/invalid-vector-set.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/known-vector-length.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/let-float.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/let-rhs.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/literal-int.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/magnitude.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/make-flrectangular.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/make-polar.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/maybe-exact-complex.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/mpair.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/n-ary-float.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/nested-float.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/nested-float2.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/nested-let-loop.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/nested-pair1.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/nested-pair2.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/nested-unboxed-let.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/one-arg-arith.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/pair-fun.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/quote.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/real-part-loop.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/simple-float.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/simple-pair.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/sqrt-segfault.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/sqrt.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/string-length.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/structs.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/unary-fixnum-nested.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/unary-fixnum.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/unary-float.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/unboxed-for.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/unboxed-let-functions1.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/unboxed-let-functions2.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/unboxed-let-functions3.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/unboxed-let-functions4.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/unboxed-let-functions5.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/unboxed-let-functions6.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/unboxed-let-functions7.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/unboxed-let-functions8.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/unboxed-let.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/unboxed-let2.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/unboxed-let3.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/unboxed-letrec-syntaxes+values.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/unboxed-letrec.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/unboxed-make-rectangular.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/vector-length-nested.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/vector-length.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/vector-ref-set-ref.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/vector-ref.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/vector-ref2.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/vector-set-quote.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/vector-set.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/vector-set2.rkt (100%)
 rename collects/tests/typed-scheme/optimizer/{generic => tests}/zero.rkt (100%)

diff --git a/collects/tests/typed-scheme/optimizer/generic/inexact-complex-conjugate-top.rkt b/collects/tests/typed-scheme/optimizer/generic/inexact-complex-conjugate-top.rkt
deleted file mode 100644
index 98896f9b..00000000
--- a/collects/tests/typed-scheme/optimizer/generic/inexact-complex-conjugate-top.rkt
+++ /dev/null
@@ -1,4 +0,0 @@
-#lang typed/scheme
-#:optimize
-(require racket/unsafe/ops)
-(conjugate (+ 1.0+2.0i 2.0+4.0i))
diff --git a/collects/tests/typed-scheme/optimizer/generic/inexact-complex-fixnum.rkt b/collects/tests/typed-scheme/optimizer/generic/inexact-complex-fixnum.rkt
deleted file mode 100644
index 11a63667..00000000
--- a/collects/tests/typed-scheme/optimizer/generic/inexact-complex-fixnum.rkt
+++ /dev/null
@@ -1,4 +0,0 @@
-#lang typed/scheme
-#:optimize
-(require racket/unsafe/ops)
-(+ (quotient 2 1) 1.0+2.0i 3.0+6.0i)
diff --git a/collects/tests/typed-scheme/optimizer/run.rkt b/collects/tests/typed-scheme/optimizer/run.rkt
index f171ce05..e3080a9c 100644
--- a/collects/tests/typed-scheme/optimizer/run.rkt
+++ b/collects/tests/typed-scheme/optimizer/run.rkt
@@ -7,7 +7,7 @@
   (call-with-trusted-sandbox-configuration
    (lambda ()
      (parameterize ([current-load-relative-directory
-                     (build-path here "generic")]
+                     (build-path here "tests")]
                     [sandbox-memory-limit #f] ; TR needs memory
                     [sandbox-output 'string]
                     [sandbox-namespace-specs
@@ -28,7 +28,7 @@
          out)))))
 
 (define (generate-opt-log name)
-  (parameterize ([current-load-relative-directory (build-path here "generic")]
+  (parameterize ([current-load-relative-directory (build-path here "tests")]
                  [current-command-line-arguments  '#("--log-optimizations")])
     (with-output-to-string
       (lambda ()
@@ -60,11 +60,11 @@
 
 (let ((n-failures
        (if (> (vector-length (current-command-line-arguments)) 0)
-           (if (test (format "generic/~a.rkt"
+           (if (test (format "tests/~a.rkt"
                              (vector-ref (current-command-line-arguments) 0)))
                0 1)
            (for/fold ((n-failures 0))
-             ((gen (in-directory (build-path here "generic"))))
+             ((gen (in-directory (build-path here "tests"))))
              (+ n-failures (if (test gen) 0 1))))))
   (unless (= n-failures 0)
     (error (format "~a tests failed." n-failures))))
diff --git a/collects/tests/typed-scheme/optimizer/generic/apply-plus.rkt b/collects/tests/typed-scheme/optimizer/tests/apply-plus.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/apply-plus.rkt
rename to collects/tests/typed-scheme/optimizer/tests/apply-plus.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/begin-float.rkt b/collects/tests/typed-scheme/optimizer/tests/begin-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/begin-float.rkt
rename to collects/tests/typed-scheme/optimizer/tests/begin-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/binary-fixnum.rkt b/collects/tests/typed-scheme/optimizer/tests/binary-fixnum.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/binary-fixnum.rkt
rename to collects/tests/typed-scheme/optimizer/tests/binary-fixnum.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/binary-nonzero-fixnum.rkt b/collects/tests/typed-scheme/optimizer/tests/binary-nonzero-fixnum.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/binary-nonzero-fixnum.rkt
rename to collects/tests/typed-scheme/optimizer/tests/binary-nonzero-fixnum.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/box.rkt b/collects/tests/typed-scheme/optimizer/tests/box.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/box.rkt
rename to collects/tests/typed-scheme/optimizer/tests/box.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/cross-module-struct.rkt b/collects/tests/typed-scheme/optimizer/tests/cross-module-struct.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/cross-module-struct.rkt
rename to collects/tests/typed-scheme/optimizer/tests/cross-module-struct.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/cross-module-struct2.rkt b/collects/tests/typed-scheme/optimizer/tests/cross-module-struct2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/cross-module-struct2.rkt
rename to collects/tests/typed-scheme/optimizer/tests/cross-module-struct2.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/dead-else.rkt b/collects/tests/typed-scheme/optimizer/tests/dead-else.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/dead-else.rkt
rename to collects/tests/typed-scheme/optimizer/tests/dead-else.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/dead-substructs.rkt b/collects/tests/typed-scheme/optimizer/tests/dead-substructs.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/dead-substructs.rkt
rename to collects/tests/typed-scheme/optimizer/tests/dead-substructs.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/dead-then.rkt b/collects/tests/typed-scheme/optimizer/tests/dead-then.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/dead-then.rkt
rename to collects/tests/typed-scheme/optimizer/tests/dead-then.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/define-begin-float.rkt b/collects/tests/typed-scheme/optimizer/tests/define-begin-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/define-begin-float.rkt
rename to collects/tests/typed-scheme/optimizer/tests/define-begin-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/define-call-float.rkt b/collects/tests/typed-scheme/optimizer/tests/define-call-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/define-call-float.rkt
rename to collects/tests/typed-scheme/optimizer/tests/define-call-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/define-float.rkt b/collects/tests/typed-scheme/optimizer/tests/define-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/define-float.rkt
rename to collects/tests/typed-scheme/optimizer/tests/define-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/define-pair.rkt b/collects/tests/typed-scheme/optimizer/tests/define-pair.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/define-pair.rkt
rename to collects/tests/typed-scheme/optimizer/tests/define-pair.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/different-langs.rkt b/collects/tests/typed-scheme/optimizer/tests/different-langs.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/different-langs.rkt
rename to collects/tests/typed-scheme/optimizer/tests/different-langs.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/double-float.rkt b/collects/tests/typed-scheme/optimizer/tests/double-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/double-float.rkt
rename to collects/tests/typed-scheme/optimizer/tests/double-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/exact-inexact.rkt b/collects/tests/typed-scheme/optimizer/tests/exact-inexact.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/exact-inexact.rkt
rename to collects/tests/typed-scheme/optimizer/tests/exact-inexact.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/fixnum-comparison.rkt b/collects/tests/typed-scheme/optimizer/tests/fixnum-comparison.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/fixnum-comparison.rkt
rename to collects/tests/typed-scheme/optimizer/tests/fixnum-comparison.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/float-comp.rkt b/collects/tests/typed-scheme/optimizer/tests/float-comp.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/float-comp.rkt
rename to collects/tests/typed-scheme/optimizer/tests/float-comp.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/float-fun.rkt b/collects/tests/typed-scheme/optimizer/tests/float-fun.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/float-fun.rkt
rename to collects/tests/typed-scheme/optimizer/tests/float-fun.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/float-promotion.rkt b/collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/float-promotion.rkt
rename to collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/flvector-length.rkt b/collects/tests/typed-scheme/optimizer/tests/flvector-length.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/flvector-length.rkt
rename to collects/tests/typed-scheme/optimizer/tests/flvector-length.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/fx-fl.rkt b/collects/tests/typed-scheme/optimizer/tests/fx-fl.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/fx-fl.rkt
rename to collects/tests/typed-scheme/optimizer/tests/fx-fl.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/in-bytes.rkt b/collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/in-bytes.rkt
rename to collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/in-list.rkt b/collects/tests/typed-scheme/optimizer/tests/in-list.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/in-list.rkt
rename to collects/tests/typed-scheme/optimizer/tests/in-list.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/in-string.rkt b/collects/tests/typed-scheme/optimizer/tests/in-string.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/in-string.rkt
rename to collects/tests/typed-scheme/optimizer/tests/in-string.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/in-vector.rkt b/collects/tests/typed-scheme/optimizer/tests/in-vector.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/in-vector.rkt
rename to collects/tests/typed-scheme/optimizer/tests/in-vector.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-binary-nonzero-fixnum.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-binary-nonzero-fixnum.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/invalid-binary-nonzero-fixnum.rkt
rename to collects/tests/typed-scheme/optimizer/tests/invalid-binary-nonzero-fixnum.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-exact-inexact.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-exact-inexact.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/invalid-exact-inexact.rkt
rename to collects/tests/typed-scheme/optimizer/tests/invalid-exact-inexact.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-float-comp.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-float-comp.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/invalid-float-comp.rkt
rename to collects/tests/typed-scheme/optimizer/tests/invalid-float-comp.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-float-promotion.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-float-promotion.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/invalid-float-promotion.rkt
rename to collects/tests/typed-scheme/optimizer/tests/invalid-float-promotion.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-inexact-complex-parts.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-inexact-complex-parts.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/invalid-inexact-complex-parts.rkt
rename to collects/tests/typed-scheme/optimizer/tests/invalid-inexact-complex-parts.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-make-flrectangular.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-make-flrectangular.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/invalid-make-flrectangular.rkt
rename to collects/tests/typed-scheme/optimizer/tests/invalid-make-flrectangular.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-make-polar.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-make-polar.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/invalid-make-polar.rkt
rename to collects/tests/typed-scheme/optimizer/tests/invalid-make-polar.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-mpair.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-mpair.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/invalid-mpair.rkt
rename to collects/tests/typed-scheme/optimizer/tests/invalid-mpair.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-sqrt.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-sqrt.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/invalid-sqrt.rkt
rename to collects/tests/typed-scheme/optimizer/tests/invalid-sqrt.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let.rkt
rename to collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let2.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/invalid-unboxed-let2.rkt
rename to collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-vector-ref.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-vector-ref.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/invalid-vector-ref.rkt
rename to collects/tests/typed-scheme/optimizer/tests/invalid-vector-ref.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/invalid-vector-set.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-vector-set.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/invalid-vector-set.rkt
rename to collects/tests/typed-scheme/optimizer/tests/invalid-vector-set.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/known-vector-length.rkt b/collects/tests/typed-scheme/optimizer/tests/known-vector-length.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/known-vector-length.rkt
rename to collects/tests/typed-scheme/optimizer/tests/known-vector-length.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/let-float.rkt b/collects/tests/typed-scheme/optimizer/tests/let-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/let-float.rkt
rename to collects/tests/typed-scheme/optimizer/tests/let-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/let-rhs.rkt b/collects/tests/typed-scheme/optimizer/tests/let-rhs.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/let-rhs.rkt
rename to collects/tests/typed-scheme/optimizer/tests/let-rhs.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/literal-int.rkt b/collects/tests/typed-scheme/optimizer/tests/literal-int.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/literal-int.rkt
rename to collects/tests/typed-scheme/optimizer/tests/literal-int.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/magnitude.rkt b/collects/tests/typed-scheme/optimizer/tests/magnitude.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/magnitude.rkt
rename to collects/tests/typed-scheme/optimizer/tests/magnitude.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/make-flrectangular.rkt b/collects/tests/typed-scheme/optimizer/tests/make-flrectangular.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/make-flrectangular.rkt
rename to collects/tests/typed-scheme/optimizer/tests/make-flrectangular.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/make-polar.rkt b/collects/tests/typed-scheme/optimizer/tests/make-polar.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/make-polar.rkt
rename to collects/tests/typed-scheme/optimizer/tests/make-polar.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/maybe-exact-complex.rkt b/collects/tests/typed-scheme/optimizer/tests/maybe-exact-complex.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/maybe-exact-complex.rkt
rename to collects/tests/typed-scheme/optimizer/tests/maybe-exact-complex.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/mpair.rkt b/collects/tests/typed-scheme/optimizer/tests/mpair.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/mpair.rkt
rename to collects/tests/typed-scheme/optimizer/tests/mpair.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/n-ary-float.rkt b/collects/tests/typed-scheme/optimizer/tests/n-ary-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/n-ary-float.rkt
rename to collects/tests/typed-scheme/optimizer/tests/n-ary-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/nested-float.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/nested-float.rkt
rename to collects/tests/typed-scheme/optimizer/tests/nested-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/nested-float2.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-float2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/nested-float2.rkt
rename to collects/tests/typed-scheme/optimizer/tests/nested-float2.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/nested-let-loop.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/nested-let-loop.rkt
rename to collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/nested-pair1.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-pair1.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/nested-pair1.rkt
rename to collects/tests/typed-scheme/optimizer/tests/nested-pair1.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/nested-pair2.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-pair2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/nested-pair2.rkt
rename to collects/tests/typed-scheme/optimizer/tests/nested-pair2.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/nested-unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-unboxed-let.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/nested-unboxed-let.rkt
rename to collects/tests/typed-scheme/optimizer/tests/nested-unboxed-let.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/one-arg-arith.rkt b/collects/tests/typed-scheme/optimizer/tests/one-arg-arith.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/one-arg-arith.rkt
rename to collects/tests/typed-scheme/optimizer/tests/one-arg-arith.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/pair-fun.rkt b/collects/tests/typed-scheme/optimizer/tests/pair-fun.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/pair-fun.rkt
rename to collects/tests/typed-scheme/optimizer/tests/pair-fun.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/quote.rkt b/collects/tests/typed-scheme/optimizer/tests/quote.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/quote.rkt
rename to collects/tests/typed-scheme/optimizer/tests/quote.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/real-part-loop.rkt b/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/real-part-loop.rkt
rename to collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/simple-float.rkt b/collects/tests/typed-scheme/optimizer/tests/simple-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/simple-float.rkt
rename to collects/tests/typed-scheme/optimizer/tests/simple-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/simple-pair.rkt b/collects/tests/typed-scheme/optimizer/tests/simple-pair.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/simple-pair.rkt
rename to collects/tests/typed-scheme/optimizer/tests/simple-pair.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/sqrt-segfault.rkt b/collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/sqrt-segfault.rkt
rename to collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/sqrt.rkt b/collects/tests/typed-scheme/optimizer/tests/sqrt.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/sqrt.rkt
rename to collects/tests/typed-scheme/optimizer/tests/sqrt.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/string-length.rkt b/collects/tests/typed-scheme/optimizer/tests/string-length.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/string-length.rkt
rename to collects/tests/typed-scheme/optimizer/tests/string-length.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/structs.rkt b/collects/tests/typed-scheme/optimizer/tests/structs.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/structs.rkt
rename to collects/tests/typed-scheme/optimizer/tests/structs.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/unary-fixnum-nested.rkt b/collects/tests/typed-scheme/optimizer/tests/unary-fixnum-nested.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/unary-fixnum-nested.rkt
rename to collects/tests/typed-scheme/optimizer/tests/unary-fixnum-nested.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/unary-fixnum.rkt b/collects/tests/typed-scheme/optimizer/tests/unary-fixnum.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/unary-fixnum.rkt
rename to collects/tests/typed-scheme/optimizer/tests/unary-fixnum.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/unary-float.rkt b/collects/tests/typed-scheme/optimizer/tests/unary-float.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/unary-float.rkt
rename to collects/tests/typed-scheme/optimizer/tests/unary-float.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-for.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/unboxed-for.rkt
rename to collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions1.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions1.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions1.rkt
rename to collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions1.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions2.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions2.rkt
rename to collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions2.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions3.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions3.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions3.rkt
rename to collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions3.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions4.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions4.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions4.rkt
rename to collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions4.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions5.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions5.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions5.rkt
rename to collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions5.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions6.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions6.rkt
rename to collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions7.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions7.rkt
rename to collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions8.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions8.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/unboxed-let-functions8.rkt
rename to collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions8.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/unboxed-let.rkt
rename to collects/tests/typed-scheme/optimizer/tests/unboxed-let.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let2.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/unboxed-let2.rkt
rename to collects/tests/typed-scheme/optimizer/tests/unboxed-let2.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-let3.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let3.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/unboxed-let3.rkt
rename to collects/tests/typed-scheme/optimizer/tests/unboxed-let3.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-letrec-syntaxes+values.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec-syntaxes+values.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/unboxed-letrec-syntaxes+values.rkt
rename to collects/tests/typed-scheme/optimizer/tests/unboxed-letrec-syntaxes+values.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-letrec.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/unboxed-letrec.rkt
rename to collects/tests/typed-scheme/optimizer/tests/unboxed-letrec.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/unboxed-make-rectangular.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-make-rectangular.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/unboxed-make-rectangular.rkt
rename to collects/tests/typed-scheme/optimizer/tests/unboxed-make-rectangular.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-length-nested.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-length-nested.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/vector-length-nested.rkt
rename to collects/tests/typed-scheme/optimizer/tests/vector-length-nested.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-length.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-length.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/vector-length.rkt
rename to collects/tests/typed-scheme/optimizer/tests/vector-length.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-ref-set-ref.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-ref-set-ref.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/vector-ref-set-ref.rkt
rename to collects/tests/typed-scheme/optimizer/tests/vector-ref-set-ref.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-ref.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-ref.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/vector-ref.rkt
rename to collects/tests/typed-scheme/optimizer/tests/vector-ref.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-ref2.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-ref2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/vector-ref2.rkt
rename to collects/tests/typed-scheme/optimizer/tests/vector-ref2.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-set-quote.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-set-quote.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/vector-set-quote.rkt
rename to collects/tests/typed-scheme/optimizer/tests/vector-set-quote.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-set.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-set.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/vector-set.rkt
rename to collects/tests/typed-scheme/optimizer/tests/vector-set.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/vector-set2.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-set2.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/vector-set2.rkt
rename to collects/tests/typed-scheme/optimizer/tests/vector-set2.rkt
diff --git a/collects/tests/typed-scheme/optimizer/generic/zero.rkt b/collects/tests/typed-scheme/optimizer/tests/zero.rkt
similarity index 100%
rename from collects/tests/typed-scheme/optimizer/generic/zero.rkt
rename to collects/tests/typed-scheme/optimizer/tests/zero.rkt

From 6df18f3f24afbbf13ad95ecc61944d9868cdb3b3 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 27 Aug 2010 12:26:23 -0400
Subject: [PATCH 090/198] Cleanup of the test harness.

original commit: 1c9e8e05b061648ee7a54bf120c288eefddbfb15
---
 collects/tests/typed-scheme/optimizer/run.rkt | 9 ++++-----
 1 file changed, 4 insertions(+), 5 deletions(-)

diff --git a/collects/tests/typed-scheme/optimizer/run.rkt b/collects/tests/typed-scheme/optimizer/run.rkt
index e3080a9c..04c337c6 100644
--- a/collects/tests/typed-scheme/optimizer/run.rkt
+++ b/collects/tests/typed-scheme/optimizer/run.rkt
@@ -6,8 +6,7 @@
 (define (evaluator file #:optimize [optimize? #f])
   (call-with-trusted-sandbox-configuration
    (lambda ()
-     (parameterize ([current-load-relative-directory
-                     (build-path here "tests")]
+     (parameterize ([current-load-relative-directory tests-dir]
                     [sandbox-memory-limit #f] ; TR needs memory
                     [sandbox-output 'string]
                     [sandbox-namespace-specs
@@ -28,7 +27,7 @@
          out)))))
 
 (define (generate-opt-log name)
-  (parameterize ([current-load-relative-directory (build-path here "tests")]
+  (parameterize ([current-load-relative-directory tests-dir]
                  [current-command-line-arguments  '#("--log-optimizations")])
     (with-output-to-string
       (lambda ()
@@ -56,7 +55,7 @@
                  (begin (printf "~a failed: result mismatch\n\n" name)
                         #f))))))
 
-(define-runtime-path here ".")
+(define-runtime-path tests-dir "./tests")
 
 (let ((n-failures
        (if (> (vector-length (current-command-line-arguments)) 0)
@@ -64,7 +63,7 @@
                              (vector-ref (current-command-line-arguments) 0)))
                0 1)
            (for/fold ((n-failures 0))
-             ((gen (in-directory (build-path here "tests"))))
+             ((gen (in-directory tests-dir)))
              (+ n-failures (if (test gen) 0 1))))))
   (unless (= n-failures 0)
     (error (format "~a tests failed." n-failures))))

From 5ead0f43e28ecab8fc504d0db8b9ed7e66718219 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 27 Aug 2010 13:48:25 -0400
Subject: [PATCH 091/198] Cleanup of syntax-parse patterns.

original commit: 988466369739ac5682205e49185c3956e07f3f0d
---
 collects/typed-scheme/optimizer/float.rkt     | 14 +++++-----
 .../optimizer/inexact-complex.rkt             | 26 +++++++++----------
 .../typed-scheme/optimizer/unboxed-let.rkt    | 20 +++++++-------
 3 files changed, 29 insertions(+), 31 deletions(-)

diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-scheme/optimizer/float.rkt
index 334b3600..236c0be3 100644
--- a/collects/typed-scheme/optimizer/float.rkt
+++ b/collects/typed-scheme/optimizer/float.rkt
@@ -72,17 +72,17 @@
            #:with opt #'e.opt))
 
 (define-syntax-class float-opt-expr
-  (pattern (~and res (#%plain-app (~var op (float-op unary-float-ops)) f:float-expr))
-           #:when (subtypeof? #'res -Flonum)
+  (pattern (#%plain-app (~var op (float-op unary-float-ops)) f:float-expr)
+           #:when (subtypeof? this-syntax -Flonum)
            #:with opt
            (begin (log-optimization "unary float" #'op)
                   #'(op.unsafe f.opt)))
-  (pattern (~and res (#%plain-app (~var op (float-op binary-float-ops))
-                                  f1:float-arg-expr
-                                  f2:float-arg-expr
-                                  fs:float-arg-expr ...))
+  (pattern (#%plain-app (~var op (float-op binary-float-ops))
+                        f1:float-arg-expr
+                        f2:float-arg-expr
+                        fs:float-arg-expr ...)
            ;; if the result is a float, we can coerce integers to floats and optimize
-           #:when (subtypeof? #'res -Flonum)
+           #:when (subtypeof? this-syntax -Flonum)
            #:with opt
            (begin (log-optimization "binary float" #'op)
                   (n-ary->binary #'op.unsafe #'f1.opt #'f2.opt #'(fs.opt ...))))
diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt
index a733651c..27443c5a 100644
--- a/collects/typed-scheme/optimizer/inexact-complex.rkt
+++ b/collects/typed-scheme/optimizer/inexact-complex.rkt
@@ -376,9 +376,9 @@
            (begin (log-optimization "unary inexact complex" #'op)
                   #'(op.unsafe n.opt)))
 
-  (pattern (~and exp (#%plain-app (~and op (~literal make-polar)) r theta))
-           #:when (isoftype? #'exp -InexactComplex)
-           #:with exp*:unboxed-inexact-complex-opt-expr #'exp
+  (pattern (#%plain-app (~and op (~literal make-polar)) r theta)
+           #:when (isoftype? this-syntax -InexactComplex)
+           #:with exp*:unboxed-inexact-complex-opt-expr this-syntax
            #:with opt
            (begin (log-optimization "make-polar" #'op)
                   (reset-unboxed-gensym)
@@ -386,12 +386,12 @@
                       (unsafe-make-flrectangular exp*.real-binding
                                                  exp*.imag-binding))))
 
-  (pattern (~and e (#%plain-app op:id args:expr ...))
+  (pattern (#%plain-app op:id args:expr ...)
            #:with unboxed-info (dict-ref unboxed-funs-table #'op #f)
            #:when (syntax->datum #'unboxed-info)
            #:with (~var e* (inexact-complex-call-site-opt-expr
                             #'unboxed-info #'op)) ; no need to optimize op
-           #'e
+           this-syntax
            #:with opt
            (begin (log-optimization "call to fun with unboxed args" #'op)
                   #'e*.opt))
@@ -401,26 +401,26 @@
 
 (define-syntax-class inexact-complex-arith-opt-expr
   
-  (pattern (~and exp (#%plain-app op:inexact-complex->float-op e:expr ...))
-           #:when (subtypeof? #'exp -Flonum)
-           #:with exp*:unboxed-inexact-complex-opt-expr #'exp
+  (pattern (#%plain-app op:inexact-complex->float-op e:expr ...)
+           #:when (subtypeof? this-syntax -Flonum)
+           #:with exp*:unboxed-inexact-complex-opt-expr this-syntax
            #:with real-binding #'exp*.real-binding
            #:with imag-binding #f
            #:with (bindings ...) #'(exp*.bindings ...)
            #:with opt
-           (begin (log-optimization "unboxed inexact complex->float" #'exp)
+           (begin (log-optimization "unboxed inexact complex->float" this-syntax)
                   (reset-unboxed-gensym)
                   #'(let*-values (exp*.bindings ...)
                       real-binding)))
 
-  (pattern (~and exp (#%plain-app op:inexact-complex-op e:expr ...))
-           #:when (isoftype? #'exp -InexactComplex)
-           #:with exp*:unboxed-inexact-complex-opt-expr #'exp
+  (pattern (#%plain-app op:inexact-complex-op e:expr ...)
+           #:when (isoftype? this-syntax -InexactComplex)
+           #:with exp*:unboxed-inexact-complex-opt-expr this-syntax
            #:with real-binding #'exp*.real-binding
            #:with imag-binding #'exp*.imag-binding
            #:with (bindings ...) #'(exp*.bindings ...)
            #:with opt
-           (begin (log-optimization "unboxed inexact complex" #'exp)
+           (begin (log-optimization "unboxed inexact complex" this-syntax)
                   (reset-unboxed-gensym)
                   #'(let*-values (exp*.bindings ...)
                       (unsafe-make-flrectangular exp*.real-binding exp*.imag-binding))))
diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index 73047acd..a50225c4 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -25,18 +25,17 @@
 ;; we can extend unboxing
 (define-syntax-class app-of-unboxed-let-opt-expr
   #:literal-sets (kernel-literals)
-  (pattern (~and e ((~literal #%plain-app)
-                    (~and let-e
-                          ((~literal letrec-values)
-                           bindings
-                           loop-fun:id)) ; sole element of the body
-                    args:expr ...))
+  (pattern (#%plain-app
+            (~and let-e ((~literal letrec-values)
+                         bindings
+                         loop-fun:id)) ; sole element of the body
+            args:expr ...)
            #:with (~var operator (unboxed-let-opt-expr-internal #t)) #'let-e
            #:with unboxed-info (dict-ref unboxed-funs-table #'loop-fun #f)
            #:when (syntax->datum #'unboxed-info)
            #:with (~var e* (inexact-complex-call-site-opt-expr
                             #'unboxed-info #'operator.opt))
-           #'e
+           this-syntax
            #:with opt
            (begin (log-optimization "unboxed let loop" #'loop-fun)
                   #'e*.opt)))
@@ -46,9 +45,8 @@
 ;; functions
 (define-syntax-class (unboxed-let-opt-expr-internal let-loop?)
   #:literal-sets (kernel-literals)
-  (pattern (~and exp (letk:let-like-keyword
-                      ((~and clause (lhs rhs ...)) ...)
-                      body:expr ...))
+  (pattern (letk:let-like-keyword ((~and clause (lhs rhs ...)) ...)
+                                  body:expr ...)
            ;; we look for bindings of complexes that are not mutated and only
            ;; used in positions where we would unbox them
            ;; these are candidates for unboxing
@@ -125,7 +123,7 @@
            #:with (opt-functions:unboxed-fun-clause ...) #'(function-candidates ...)
            #:with (opt-others:opt-let-clause ...) #'(others ...)
            #:with opt
-           (begin (log-optimization "unboxed let bindings" #'exp)
+           (begin (log-optimization "unboxed let bindings" this-syntax)
                   ;; add the unboxed bindings to the table, for them to be used by
                   ;; further optimizations
                   (for ((v (in-list (syntax->list #'(opt-candidates.id ...))))

From d516bb877d8e9b581d544e3f5e1e0874f006de23 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 27 Aug 2010 13:59:39 -0400
Subject: [PATCH 092/198] Better way to setup the sandbox input.

original commit: 9f540bce011106dfcda7de2c13eae3bcd3d42582
---
 collects/tests/typed-scheme/optimizer/run.rkt | 19 +++++++++----------
 1 file changed, 9 insertions(+), 10 deletions(-)

diff --git a/collects/tests/typed-scheme/optimizer/run.rkt b/collects/tests/typed-scheme/optimizer/run.rkt
index 04c337c6..0aa6d6a2 100644
--- a/collects/tests/typed-scheme/optimizer/run.rkt
+++ b/collects/tests/typed-scheme/optimizer/run.rkt
@@ -13,16 +13,15 @@
                      (list (car (sandbox-namespace-specs))
                            'typed/racket
                            'typed/scheme)])
-       (let* ((lines (cdr (file->lines file))) ;; drop the #lang line
-              (in    (if optimize?
-                         lines
-                         (cdr lines))) ;; drop the #:optimize
-              (evaluator
-               (make-evaluator 'typed/racket
-                               (foldl (lambda (acc new)
-                                        (string-append new "\n" acc))
-                                      "" in)))
-              (out (get-output evaluator)))
+       ;; drop the #lang line
+       (let* ((prog (regexp-replace #rx"^#lang typed/(scheme|racket)(/base)?"
+                                     (file->string file) ""))
+              (in   (if optimize?
+                        prog
+                        ;; drop the #:optimize
+                        (regexp-replace #rx"#:optimize" prog "")))
+              (evaluator (make-evaluator 'typed/racket in))
+              (out       (get-output evaluator)))
          (kill-evaluator evaluator)
          out)))))
 

From b12db574b26aff9d11e6ea9124ae49cad0ab4a99 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 27 Aug 2010 14:48:26 -0400
Subject: [PATCH 093/198] Removed obsolete comment.

original commit: f06c2d492653b52b720d8776f942255d284c756e
---
 collects/tests/typed-scheme/optimizer/run.rkt | 2 --
 1 file changed, 2 deletions(-)

diff --git a/collects/tests/typed-scheme/optimizer/run.rkt b/collects/tests/typed-scheme/optimizer/run.rkt
index 0aa6d6a2..5e5eebc6 100644
--- a/collects/tests/typed-scheme/optimizer/run.rkt
+++ b/collects/tests/typed-scheme/optimizer/run.rkt
@@ -1,8 +1,6 @@
 #lang racket
 (require racket/runtime-path racket/sandbox)
 
-;; the first line must be the #lang line
-;; the second line must be #:optimize
 (define (evaluator file #:optimize [optimize? #f])
   (call-with-trusted-sandbox-configuration
    (lambda ()

From e9e53e838276d116b77a59502ff23cce5eb75b6d Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 27 Aug 2010 16:55:31 -0400
Subject: [PATCH 094/198] Improved sandboxing with code from Eli.

original commit: b386f01ee45b5d6f0d6dcb59668b16e729a80cc8
---
 collects/tests/typed-scheme/optimizer/run.rkt | 24 ++++++++++++-------
 1 file changed, 16 insertions(+), 8 deletions(-)

diff --git a/collects/tests/typed-scheme/optimizer/run.rkt b/collects/tests/typed-scheme/optimizer/run.rkt
index 5e5eebc6..bd543654 100644
--- a/collects/tests/typed-scheme/optimizer/run.rkt
+++ b/collects/tests/typed-scheme/optimizer/run.rkt
@@ -1,6 +1,13 @@
 #lang racket
 (require racket/runtime-path racket/sandbox)
 
+(define prog-rx
+  (pregexp (string-append "^\\s*"
+                          "(#lang typed/(?:scheme|racket)(?:/base)?)"
+                          "\\s+"
+                          "#:optimize"
+                          "\\s+")))
+
 (define (evaluator file #:optimize [optimize? #f])
   (call-with-trusted-sandbox-configuration
    (lambda ()
@@ -12,14 +19,15 @@
                            'typed/racket
                            'typed/scheme)])
        ;; drop the #lang line
-       (let* ((prog (regexp-replace #rx"^#lang typed/(scheme|racket)(/base)?"
-                                     (file->string file) ""))
-              (in   (if optimize?
-                        prog
-                        ;; drop the #:optimize
-                        (regexp-replace #rx"#:optimize" prog "")))
-              (evaluator (make-evaluator 'typed/racket in))
-              (out       (get-output evaluator)))
+       (let* ([prog (file->string file)]
+              ;; drop the #lang line and #:optimize
+              [m    (or (regexp-match-positions prog-rx prog)
+                        (error 'evaluator "bad program contents in ~e" file))]
+              [prog (string-append (substring prog (caadr m) (cdadr m))
+                                   (if optimize? "\n#:optimize\n" "\n")
+                                   (substring prog (cdar m)))]
+              [evaluator (make-module-evaluator prog)]
+              [out       (get-output evaluator)])
          (kill-evaluator evaluator)
          out)))))
 

From f360fac1383c08007f351ac98c90e3468c40f27c Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 27 Aug 2010 17:16:14 -0400
Subject: [PATCH 095/198] Added annotations to plain for and for* in typed
 code.

original commit: d3ee52d4514170b514faecb80b5c939bf7da3aea
---
 collects/typed-scheme/main.rkt          |  4 ++--
 collects/typed-scheme/private/prims.rkt | 16 +++++++++++++++-
 collects/typed/racket/base.rkt          |  4 ++--
 collects/typed/scheme/base.rkt          |  4 ++--
 4 files changed, 21 insertions(+), 7 deletions(-)

diff --git a/collects/typed-scheme/main.rkt b/collects/typed-scheme/main.rkt
index c135bc51..eb46ac97 100644
--- a/collects/typed-scheme/main.rkt
+++ b/collects/typed-scheme/main.rkt
@@ -2,7 +2,7 @@
            
 
 
-(providing (libs (except scheme/base #%module-begin #%top-interaction with-handlers lambda #%app)
+(providing (libs (except scheme/base #%module-begin #%top-interaction with-handlers lambda #%app for for*)
                  (except "private/prims.rkt")
                  (except "private/base-types.rkt")
                  (except "private/base-types-extra.rkt"))
@@ -18,4 +18,4 @@
          (for-syntax "private/base-types-extra.rkt"))
 (provide (rename-out [with-handlers: with-handlers])
          (for-syntax (all-from-out "private/base-types-extra.rkt"))
-	 assert with-type)
+	 assert with-type for for*)
diff --git a/collects/typed-scheme/private/prims.rkt b/collects/typed-scheme/private/prims.rkt
index 522ee962..c30c9419 100644
--- a/collects/typed-scheme/private/prims.rkt
+++ b/collects/typed-scheme/private/prims.rkt
@@ -23,7 +23,9 @@ This file defines two sorts of primitives. All of them are provided into any mod
          :
 	 (rename-out [define-typed-struct define-struct:]
                      [lambda: λ:]
-                     [define-typed-struct/exec define-struct/exec:]))
+                     [define-typed-struct/exec define-struct/exec:]
+                     [for/annotation for]
+                     [for*/annotation for*]))
 
 (require "../utils/utils.rkt"
          racket/base
@@ -427,6 +429,18 @@ This file defines two sorts of primitives. All of them are provided into any mod
               c ...)
             ty))]))
 
+;; wrap the original for with a type annotation
+(define-syntax (for/annotation stx)
+  (syntax-parse stx
+   [(_ x ...)
+    (syntax/loc stx
+      (ann (for x ...) Void))]))
+(define-syntax (for*/annotation stx)
+  (syntax-parse stx
+   [(_ x ...)
+    (syntax/loc stx
+      (ann (for* x ...) Void))]))
+
 ;; we need handle #:when clauses manually because we need to annotate
 ;; the type of each nested for
 (define-syntax (for: stx)
diff --git a/collects/typed/racket/base.rkt b/collects/typed/racket/base.rkt
index b728ae5f..a98b88cd 100644
--- a/collects/typed/racket/base.rkt
+++ b/collects/typed/racket/base.rkt
@@ -2,7 +2,7 @@
            
 
 
-(providing (libs (except racket/base #%module-begin #%top-interaction with-handlers lambda #%app define-struct)
+(providing (libs (except racket/base #%module-begin #%top-interaction with-handlers lambda #%app define-struct for for*)
                  (except typed-scheme/private/prims)
                  (except typed-scheme/private/base-types)
                  (except typed-scheme/private/base-types-extra))
@@ -18,5 +18,5 @@
 	 (for-syntax typed-scheme/private/base-types-extra))
 (provide (rename-out [with-handlers: with-handlers]
                      [define-type-alias define-type])
-	 assert with-type
+	 assert with-type for for*
          (for-syntax (all-from-out typed-scheme/private/base-types-extra)))
diff --git a/collects/typed/scheme/base.rkt b/collects/typed/scheme/base.rkt
index 2a751ed8..20d6f356 100644
--- a/collects/typed/scheme/base.rkt
+++ b/collects/typed/scheme/base.rkt
@@ -2,7 +2,7 @@
            
 
 
-(providing (libs (except scheme/base #%module-begin #%top-interaction with-handlers lambda #%app define-struct)
+(providing (libs (except scheme/base #%module-begin #%top-interaction with-handlers lambda #%app define-struct for for*)
                  (except typed-scheme/private/prims)
                  (except typed-scheme/private/base-types)
                  (except typed-scheme/private/base-types-extra))
@@ -18,5 +18,5 @@
 	 (for-syntax typed-scheme/private/base-types-extra))
 (provide (rename-out [with-handlers: with-handlers]
                      [define-type-alias define-type])
-	 assert with-type
+	 assert with-type for for*
          (for-syntax (all-from-out typed-scheme/private/base-types-extra)))

From a6a1840da1d4375ae8977d975360bf107ff92e16 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Fri, 27 Aug 2010 17:42:22 -0400
Subject: [PATCH 096/198] Use the correct name in the provide.

original commit: d38af188f6ee5d52b442b14a572b7e579b417925
---
 collects/typed-scheme/typecheck/provide-handling.rkt | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/typed-scheme/typecheck/provide-handling.rkt b/collects/typed-scheme/typecheck/provide-handling.rkt
index 48734be0..970dc0f8 100644
--- a/collects/typed-scheme/typecheck/provide-handling.rkt
+++ b/collects/typed-scheme/typecheck/provide-handling.rkt
@@ -90,7 +90,7 @@
                    (make-provide/contract-transformer
                     (quote-syntax the-contract)
                     (quote-syntax id)
-                    (quote-syntax out-id)
+                    (quote-syntax export-id)
                     (quote-syntax module-source)))
                  (def-export export-id id cnt-id)))
            new-id)]

From 01fd7f5b8c30cde66da0267874ccac34d5a1b819 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Fri, 27 Aug 2010 17:42:33 -0400
Subject: [PATCH 097/198] Use `any/c' for contracts for polymorphic functions.

original commit: 92ce3ca02d448df97ba8e9e2210a898848cae0f1
---
 .../typed-scheme/private/type-contract.rkt    | 20 +++++++++++--------
 1 file changed, 12 insertions(+), 8 deletions(-)

diff --git a/collects/typed-scheme/private/type-contract.rkt b/collects/typed-scheme/private/type-contract.rkt
index ebf7ba12..0ea776a7 100644
--- a/collects/typed-scheme/private/type-contract.rkt
+++ b/collects/typed-scheme/private/type-contract.rkt
@@ -139,18 +139,22 @@
          #`(flat-named-contract (quote #,(syntax-e p?)) #,(cert p?))]
         [(F: v) (cond [(assoc v (vars)) => second]
                       [else (int-err "unknown var: ~a" v)])]
-	[(Poly: vs (and b (Function: _)))
-         (when flat? (exit (fail)))
-         (match-let ([(Poly-names: vs-nm _) ty])
-           (with-syntax ([(v ...) (generate-temporaries vs-nm)])
-             (parameterize ([vars (append (map list vs (syntax->list #'(v ...)))
-					  (vars))])
-               #`(parametric/c (v ...) #,(t->c b)))))]
+	[(Poly: vs b)
+         (if from-typed?
+             ;; in positive position, no checking needed for the variables
+             (parameterize ([vars (append (for/list ([v vs]) (list v #'any/c)))])
+               (t->c b))
+             ;; in negative position, use `parameteric/c'
+             (match-let ([(Poly-names: vs-nm _) ty])
+               (with-syntax ([(v ...) (generate-temporaries vs-nm)])
+                 (parameterize ([vars (append (map list vs (syntax->list #'(v ...)))
+                                              (vars))])
+                   #`(parametric/c (v ...) #,(t->c b))))))]
         [(Mu: n b)
          (match-let ([(Mu-name: n-nm _) ty])
            (with-syntax ([(n*) (generate-temporaries (list n-nm))])
              (parameterize ([vars (cons (list n #'n* #'n*) (vars))])
-               #`(flat-rec-contract n* #,(t->c b)))))]
+               #`(flat-rec-contract n* #,(t->c b #:flat #t)))))]
         [(Value: #f) #'false/c]
         [(Instance: (Class: _ _ (list (list name fcn) ...)))
          (when flat? (exit (fail)))

From a506c6cefb1e330e7337853b04f186a38d2cc96f Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Sun, 29 Aug 2010 10:12:49 -0400
Subject: [PATCH 098/198] Ignored a rounding error between PPC and x86.

original commit: e1fd445fa4acab85eb2894bc94dc1a9b009fc9ba
---
 collects/tests/typed-scheme/optimizer/tests/make-polar.rkt | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/collects/tests/typed-scheme/optimizer/tests/make-polar.rkt b/collects/tests/typed-scheme/optimizer/tests/make-polar.rkt
index 6916033f..5a0600e0 100644
--- a/collects/tests/typed-scheme/optimizer/tests/make-polar.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/make-polar.rkt
@@ -7,4 +7,6 @@
 (make-polar 1.0 1.0)
 
 ;; nested
-(+ 1.0+2.0i (make-polar 2.0 4.0))
+(let ((p (+ 1.0+2.0i (make-polar 2.0 4.0))))
+  (string-append (real->decimal-string (real-part p) 10)
+                 (real->decimal-string (imag-part p) 10)))

From 7799959a8b289e647f53621674bdb2517cf9d036 Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Tue, 31 Aug 2010 00:38:52 -0600
Subject: [PATCH 099/198] fixed TR optimizer to work with backtracking
 syntax/parse update   problem was unboxed-inexact-complex-opt-expr, "non
 exhaustive" error variant

original commit: 04a93812b455586ca3ad8c69844e20ddc6025162
---
 collects/typed-scheme/optimizer/inexact-complex.rkt | 1 +
 1 file changed, 1 insertion(+)

diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt
index 27443c5a..26420711 100644
--- a/collects/typed-scheme/optimizer/inexact-complex.rkt
+++ b/collects/typed-scheme/optimizer/inexact-complex.rkt
@@ -31,6 +31,7 @@
 ;; we keep the real and imaginary parts unboxed as long as we stay within
 ;; complex operations
 (define-syntax-class unboxed-inexact-complex-opt-expr
+  #:commit
 
   (pattern (#%plain-app (~and op (~literal +))
                         c1:unboxed-inexact-complex-opt-expr

From 721c939b958f10ee51808d5e0880985ac88406f9 Mon Sep 17 00:00:00 2001
From: Ryan Culpepper <ryanc@racket-lang.org>
Date: Tue, 31 Aug 2010 14:36:22 -0600
Subject: [PATCH 100/198] added #:commit to TR optimizer stxclasses

original commit: 0c4f82a434daa05decb6f4c92bede7ef11d5b998
---
 collects/typed-scheme/optimizer/apply.rkt           | 4 +++-
 collects/typed-scheme/optimizer/box.rkt             | 3 +++
 collects/typed-scheme/optimizer/dead-code.rkt       | 1 +
 collects/typed-scheme/optimizer/fixnum.rkt          | 6 ++++++
 collects/typed-scheme/optimizer/float.rkt           | 7 +++++++
 collects/typed-scheme/optimizer/inexact-complex.rkt | 7 +++++++
 collects/typed-scheme/optimizer/number.rkt          | 1 +
 collects/typed-scheme/optimizer/optimizer.rkt       | 2 ++
 collects/typed-scheme/optimizer/pair.rkt            | 5 +++++
 collects/typed-scheme/optimizer/sequence.rkt        | 3 +++
 collects/typed-scheme/optimizer/string.rkt          | 3 +++
 collects/typed-scheme/optimizer/struct.rkt          | 1 +
 collects/typed-scheme/optimizer/unboxed-let.rkt     | 7 +++++++
 collects/typed-scheme/optimizer/vector.rkt          | 3 +++
 14 files changed, 52 insertions(+), 1 deletion(-)

diff --git a/collects/typed-scheme/optimizer/apply.rkt b/collects/typed-scheme/optimizer/apply.rkt
index 4fa67d97..d2675175 100644
--- a/collects/typed-scheme/optimizer/apply.rkt
+++ b/collects/typed-scheme/optimizer/apply.rkt
@@ -12,12 +12,14 @@
 (provide apply-opt-expr)
 
 (define-syntax-class apply-op
+  #:commit
   #:literals (+ *)
   (pattern + #:with identity #'0)
   (pattern * #:with identity #'1))
 
 (define-syntax-class apply-opt-expr
-		     #:literals (k:apply map #%plain-app #%app)
+  #:commit
+  #:literals (k:apply map #%plain-app #%app)
   (pattern (#%plain-app k:apply op:apply-op (#%plain-app map f l))
            #:with opt
            (begin (reset-unboxed-gensym)
diff --git a/collects/typed-scheme/optimizer/box.rkt b/collects/typed-scheme/optimizer/box.rkt
index 99efba91..483741fa 100644
--- a/collects/typed-scheme/optimizer/box.rkt
+++ b/collects/typed-scheme/optimizer/box.rkt
@@ -11,6 +11,7 @@
 (provide box-opt-expr)
 
 (define-syntax-class box-expr
+  #:commit
   (pattern e:expr
            #:when (match (type-of #'e)
                     [(tc-result1: (Box: _)) #t]
@@ -18,11 +19,13 @@
            #:with opt ((optimize) #'e)))
 
 (define-syntax-class box-op
+  #:commit
   ;; we need the * versions of these unsafe operations to be chaperone-safe
   (pattern (~literal unbox)    #:with unsafe #'unsafe-unbox*)
   (pattern (~literal set-box!) #:with unsafe #'unsafe-set-box*!))
 
 (define-syntax-class box-opt-expr
+  #:commit
   (pattern (#%plain-app op:box-op b:box-expr new:expr ...)
            #:with opt
            (begin (log-optimization "box" #'op)
diff --git a/collects/typed-scheme/optimizer/dead-code.rkt b/collects/typed-scheme/optimizer/dead-code.rkt
index f20019de..eb2c5ba7 100644
--- a/collects/typed-scheme/optimizer/dead-code.rkt
+++ b/collects/typed-scheme/optimizer/dead-code.rkt
@@ -9,6 +9,7 @@
 (provide dead-code-opt-expr)
 
 (define-syntax-class dead-code-opt-expr
+  #:commit
   ;; if one of the brances of an if is unreachable, we can eliminate it
   ;; we have to keep the test, in case it has side effects
   (pattern (if tst:expr thn:expr els:expr)
diff --git a/collects/typed-scheme/optimizer/fixnum.rkt b/collects/typed-scheme/optimizer/fixnum.rkt
index fbe684c1..c62f3a3c 100644
--- a/collects/typed-scheme/optimizer/fixnum.rkt
+++ b/collects/typed-scheme/optimizer/fixnum.rkt
@@ -30,30 +30,36 @@
     #'bitwise-xor #'unsafe-fxxor)
    #'fxxor #'unsafe-fxxor))
 (define-syntax-class fixnum-unary-op
+  #:commit
   (pattern (~or (~literal bitwise-not) (~literal fxnot)) #:with unsafe #'unsafe-fxnot)
   (pattern (~or (~literal abs)         (~literal fxabs)) #:with unsafe #'unsafe-fxabs))
 ;; closed on fixnums, but 2nd argument must not be 0
 (define-syntax-class nonzero-fixnum-binary-op
+  #:commit
   (pattern (~or (~literal quotient)  (~literal fxquotient))  #:with unsafe #'unsafe-fxquotient)
   (pattern (~or (~literal modulo)    (~literal fxmodulo))    #:with unsafe #'unsafe-fxmodulo)
   (pattern (~or (~literal remainder) (~literal fxremainder)) #:with unsafe #'unsafe-fxremainder))
 
 (define-syntax-class (fixnum-op tbl)
+  #:commit
   (pattern i:id
            #:when (dict-ref tbl #'i #f)
            #:with unsafe (dict-ref tbl #'i)))
 
 
 (define-syntax-class fixnum-expr
+  #:commit
   (pattern e:expr
            #:when (subtypeof? #'e -Fixnum)
            #:with opt ((optimize) #'e)))
 (define-syntax-class nonzero-fixnum-expr
+  #:commit
   (pattern e:expr
            #:when (or (isoftype? #'e -PositiveFixnum) (isoftype? #'e -NegativeFixnum))
            #:with opt ((optimize) #'e)))
 
 (define-syntax-class fixnum-opt-expr
+  #:commit
   (pattern (#%plain-app op:fixnum-unary-op n:fixnum-expr)
            #:with opt
            (begin (log-optimization "unary fixnum" #'op)
diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-scheme/optimizer/float.rkt
index 236c0be3..d31beb50 100644
--- a/collects/typed-scheme/optimizer/float.rkt
+++ b/collects/typed-scheme/optimizer/float.rkt
@@ -28,19 +28,23 @@
                       #'sqrt #'round #'floor #'ceiling #'truncate)))
 
 (define-syntax-class (float-op tbl)
+  #:commit
   (pattern i:id
            #:when (dict-ref tbl #'i #f)
            #:with unsafe (dict-ref tbl #'i)))
 
 (define-syntax-class float-expr
+  #:commit
   (pattern e:expr
            #:when (subtypeof? #'e -Flonum)
            #:with opt ((optimize) #'e)))
 (define-syntax-class int-expr
+  #:commit
   (pattern e:expr
            #:when (subtypeof? #'e -Integer)
            #:with opt ((optimize) #'e)))
 (define-syntax-class real-expr
+  #:commit
   (pattern e:expr
            #:when (subtypeof? #'e -Real)
            #:with opt ((optimize) #'e)))
@@ -48,6 +52,7 @@
 
 ;; generates coercions to floats
 (define-syntax-class float-coerce-expr
+  #:commit
   (pattern e:float-arg-expr
            #:with opt #'e.opt)
   (pattern e:real-expr
@@ -59,6 +64,7 @@
 ;; note: none of the unary operations have types where non-float arguments
 ;;  can result in float (as opposed to real) results
 (define-syntax-class float-arg-expr
+  #:commit
   ;; we can convert literals right away
   (pattern (quote n)
            #:when (exact-integer? (syntax->datum #'n))
@@ -72,6 +78,7 @@
            #:with opt #'e.opt))
 
 (define-syntax-class float-opt-expr
+  #:commit
   (pattern (#%plain-app (~var op (float-op unary-float-ops)) f:float-expr)
            #:when (subtypeof? this-syntax -Flonum)
            #:with opt
diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt
index 26420711..86ebf002 100644
--- a/collects/typed-scheme/optimizer/inexact-complex.rkt
+++ b/collects/typed-scheme/optimizer/inexact-complex.rkt
@@ -338,23 +338,28 @@
            #:with imag-binding #f))
 
 (define-syntax-class inexact-complex-unary-op
+  #:commit
   (pattern (~or (~literal real-part) (~literal flreal-part)) #:with unsafe #'unsafe-flreal-part)
   (pattern (~or (~literal imag-part) (~literal flimag-part)) #:with unsafe #'unsafe-flimag-part))
 
 (define-syntax-class inexact-complex-op
+  #:commit
   (pattern (~or (~literal +) (~literal -) (~literal *) (~literal /) (~literal conjugate))))
 
 (define-syntax-class inexact-complex->float-op
+  #:commit
   (pattern (~or (~literal magnitude)
                 (~literal real-part) (~literal flreal-part) (~literal unsafe-flreal-part)
                 (~literal imag-part) (~literal flimag-part) (~literal unsafe-flimag-part))))
 
 (define-syntax-class inexact-complex-expr
+  #:commit
   (pattern e:expr
            #:when (isoftype? #'e -InexactComplex)
            #:with opt ((optimize) #'e)))
 
 (define-syntax-class inexact-complex-opt-expr
+  #:commit
 
   ;; we can optimize taking the real of imag part of an unboxed complex
   ;; hopefully, the compiler can eliminate unused bindings for the other part if it's not used
@@ -401,6 +406,7 @@
            #:with opt #'e.opt))
 
 (define-syntax-class inexact-complex-arith-opt-expr
+  #:commit
   
   (pattern (#%plain-app op:inexact-complex->float-op e:expr ...)
            #:when (subtypeof? this-syntax -Flonum)
@@ -443,6 +449,7 @@
 ;; and the optimized version of the operator. operators are optimized elsewhere
 ;; to benefit from local information
 (define-syntax-class (inexact-complex-call-site-opt-expr unboxed-info opt-operator)
+  #:commit
   ;; call site of a function with unboxed parameters
   ;; the calling convention is: real parts of unboxed, imag parts, boxed
   (pattern (#%plain-app op:expr args:expr ...)
diff --git a/collects/typed-scheme/optimizer/number.rkt b/collects/typed-scheme/optimizer/number.rkt
index 81acd094..40b24875 100644
--- a/collects/typed-scheme/optimizer/number.rkt
+++ b/collects/typed-scheme/optimizer/number.rkt
@@ -8,6 +8,7 @@
 (provide number-opt-expr)
 
 (define-syntax-class number-opt-expr
+  #:commit
   ;; these cases are all identity
   (pattern (#%plain-app (~and op (~or (~literal +) (~literal *) (~literal min) (~literal max)))
                         f:expr)
diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt
index 4ac752a8..90bb70f7 100644
--- a/collects/typed-scheme/optimizer/optimizer.rkt
+++ b/collects/typed-scheme/optimizer/optimizer.rkt
@@ -15,10 +15,12 @@
 
 
 (define-syntax-class opt-expr
+  #:commit
   (pattern e:opt-expr*
            #:with opt (syntax-recertify #'e.opt this-syntax (current-code-inspector) #f)))
 
 (define-syntax-class opt-expr*
+  #:commit
   #:literal-sets (kernel-literals)
 
   ;; interesting cases, where something is optimized
diff --git a/collects/typed-scheme/optimizer/pair.rkt b/collects/typed-scheme/optimizer/pair.rkt
index 145d31bc..8245c3c9 100644
--- a/collects/typed-scheme/optimizer/pair.rkt
+++ b/collects/typed-scheme/optimizer/pair.rkt
@@ -13,9 +13,11 @@
 
 
 (define-syntax-class pair-unary-op
+  #:commit
   (pattern (~literal car) #:with unsafe #'unsafe-car)
   (pattern (~literal cdr) #:with unsafe #'unsafe-cdr))
 (define-syntax-class mpair-op
+  #:commit
   (pattern (~literal mcar) #:with unsafe #'unsafe-mcar)
   (pattern (~literal mcdr) #:with unsafe #'unsafe-mcdr)
   (pattern (~literal set-mcar!) #:with unsafe #'unsafe-set-mcar!)
@@ -23,12 +25,14 @@
 
 
 (define-syntax-class pair-expr
+  #:commit
   (pattern e:expr
            #:when (match (type-of #'e) ; type of the operand
                     [(tc-result1: (Pair: _ _)) #t]
                     [_ #f])
            #:with opt ((optimize) #'e)))
 (define-syntax-class mpair-expr
+  #:commit
   (pattern e:expr
            #:when (match (type-of #'e) ; type of the operand
                     [(tc-result1: (MPair: _ _)) #t]
@@ -36,6 +40,7 @@
            #:with opt ((optimize) #'e)))
 
 (define-syntax-class pair-opt-expr
+  #:commit
   (pattern (#%plain-app op:pair-unary-op p:pair-expr)
            #:with opt
            (begin (log-optimization "unary pair" #'op)
diff --git a/collects/typed-scheme/optimizer/sequence.rkt b/collects/typed-scheme/optimizer/sequence.rkt
index 3821e886..ac8f49aa 100644
--- a/collects/typed-scheme/optimizer/sequence.rkt
+++ b/collects/typed-scheme/optimizer/sequence.rkt
@@ -13,6 +13,7 @@
 
 
 (define-syntax-class list-expr
+  #:commit
   (pattern e:expr
            #:when (match (type-of #'e)
                     [(tc-result1: (Listof: _)) #t]
@@ -22,6 +23,7 @@
 
 ;; unlike other vector optimizations, this works on unknown-length vectors
 (define-syntax-class vector-expr
+  #:commit
   (pattern e:expr
            #:when (match (type-of #'e)
                     [(tc-result1: (Vector: _)) #t]
@@ -30,6 +32,7 @@
            #:with opt ((optimize) #'e)))
 
 (define-syntax-class sequence-opt-expr
+  #:commit
   ;; if we're iterating (with the for macros) over something we know is a list,
   ;; we can generate code that would be similar to if in-list had been used
   (pattern (#%plain-app op:id _ l)
diff --git a/collects/typed-scheme/optimizer/string.rkt b/collects/typed-scheme/optimizer/string.rkt
index 6d29c5ca..0d8575ca 100644
--- a/collects/typed-scheme/optimizer/string.rkt
+++ b/collects/typed-scheme/optimizer/string.rkt
@@ -9,15 +9,18 @@
 (provide string-opt-expr string-expr bytes-expr)
 
 (define-syntax-class string-expr
+  #:commit
   (pattern e:expr
            #:when (isoftype? #'e -String)
            #:with opt ((optimize) #'e)))
 (define-syntax-class bytes-expr
+  #:commit
   (pattern e:expr
            #:when (isoftype? #'e -Bytes)
            #:with opt ((optimize) #'e)))
 
 (define-syntax-class string-opt-expr
+  #:commit
   (pattern (#%plain-app (~literal string-length) s:string-expr)
            #:with opt
            (begin (log-optimization "string-length" #'op)
diff --git a/collects/typed-scheme/optimizer/struct.rkt b/collects/typed-scheme/optimizer/struct.rkt
index 575b985e..77ee71b1 100644
--- a/collects/typed-scheme/optimizer/struct.rkt
+++ b/collects/typed-scheme/optimizer/struct.rkt
@@ -12,6 +12,7 @@
 (provide struct-opt-expr)
 
 (define-syntax-class struct-opt-expr
+  #:commit
   ;; we can always optimize struct accessors and mutators
   ;; if they typecheck, they're safe
   (pattern (#%plain-app op:id s:expr v:expr ...)
diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index a50225c4..34d16c33 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -14,6 +14,7 @@
 ;; possibly replace bindings of complex numbers by bindings of their 2 components
 ;; useful for intermediate results used more than once and for loop variables
 (define-syntax-class unboxed-let-opt-expr
+  #:commit
   (pattern e:app-of-unboxed-let-opt-expr
            #:with opt #'e.opt)
   (pattern (~var e (unboxed-let-opt-expr-internal #f))
@@ -24,6 +25,7 @@
 ;; escapes in the operator position of a call site we control (here)
 ;; we can extend unboxing
 (define-syntax-class app-of-unboxed-let-opt-expr
+  #:commit
   #:literal-sets (kernel-literals)
   (pattern (#%plain-app
             (~and let-e ((~literal letrec-values)
@@ -44,6 +46,7 @@
 ;; detects which let bindings can be unboxed, same for arguments of let-bound
 ;; functions
 (define-syntax-class (unboxed-let-opt-expr-internal let-loop?)
+  #:commit
   #:literal-sets (kernel-literals)
   (pattern (letk:let-like-keyword ((~and clause (lhs rhs ...)) ...)
                                   body:expr ...)
@@ -137,6 +140,7 @@
                       #,@(map (optimize) (syntax->list #'(body ...)))))))
 
 (define-splicing-syntax-class let-like-keyword
+  #:commit
   #:literal-sets (kernel-literals)
   (pattern (~literal let-values)
            #:with (key ...) #'(let*-values))
@@ -261,6 +265,7 @@
 
 ;; let clause whose rhs is going to be unboxed (turned into multiple bindings)
 (define-syntax-class unboxed-let-clause
+  #:commit
   (pattern ((v:id) rhs:unboxed-inexact-complex-opt-expr)
            #:with id #'v
            #:with real-binding #'rhs.real-binding
@@ -271,6 +276,7 @@
 ;; these arguments may be unboxed
 ;; the new function will have all the unboxed arguments first, then all the boxed
 (define-syntax-class unboxed-fun-clause
+  #:commit
   (pattern ((v:id) (#%plain-lambda params body:expr ...))
            #:with id #'v
            #:with unboxed-info (dict-ref unboxed-funs-table #'v #f)
@@ -311,5 +317,6 @@
                               (cons (car params) boxed))]))))))
 
 (define-syntax-class opt-let-clause
+  #:commit
   (pattern (vs rhs:expr)
            #:with res #`(vs #,((optimize) #'rhs))))
diff --git a/collects/typed-scheme/optimizer/vector.rkt b/collects/typed-scheme/optimizer/vector.rkt
index d162dcab..e3386903 100644
--- a/collects/typed-scheme/optimizer/vector.rkt
+++ b/collects/typed-scheme/optimizer/vector.rkt
@@ -12,11 +12,13 @@
 
 
 (define-syntax-class vector-op
+  #:commit
   ;; we need the * versions of these unsafe operations to be chaperone-safe
   (pattern (~literal vector-ref)  #:with unsafe #'unsafe-vector*-ref)
   (pattern (~literal vector-set!) #:with unsafe #'unsafe-vector*-set!))
 
 (define-syntax-class vector-expr
+  #:commit
   (pattern e:expr
            #:when (match (type-of #'e)
                     [(tc-result1: (HeterogenousVector: _)) #t]
@@ -24,6 +26,7 @@
            #:with opt ((optimize) #'e)))
 
 (define-syntax-class vector-opt-expr
+  #:commit
   ;; vector-length of a known-length vector
   (pattern (#%plain-app (~and op (~or (~literal vector-length)
                                       (~literal unsafe-vector-length)

From 3e6ab819c61264dc946bccf5a613e637dce11de0 Mon Sep 17 00:00:00 2001
From: Stevie Strickland <sstrickl@racket-lang.org>
Date: Thu, 2 Sep 2010 16:28:10 -0400
Subject: [PATCH 101/198] Check struct predicate before checking fields.

original commit: 3b0de9c141edee84be57768a22b1ae3264fcc7f5
---
 collects/typed-scheme/private/type-contract.rkt | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/collects/typed-scheme/private/type-contract.rkt b/collects/typed-scheme/private/type-contract.rkt
index 0ea776a7..2e7d7aba 100644
--- a/collects/typed-scheme/private/type-contract.rkt
+++ b/collects/typed-scheme/private/type-contract.rkt
@@ -196,6 +196,8 @@
                            #:projection 
                            (lambda (blame)
                              (lambda (val)
+                               (unless (#,pred? val)
+                                 (raise-blame-error blame val "expected ~a value, got ~v" 'cnt-name val))
                                (maker fld-cnts ...))))])
                   rec))]
            [else #`(flat-named-contract '#,(syntax-e pred?) #,(cert pred?))])]

From 0df6f293ce00abd0ceeb2b9b0f4e5157172e5dd1 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 7 Sep 2010 16:45:50 -0400
Subject: [PATCH 102/198] Added the fixnum types to the documentation.

original commit: 440871f99d8edc425f633e87555c9f4d110c501d
---
 collects/typed-scheme/scribblings/ts-reference.scrbl | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/collects/typed-scheme/scribblings/ts-reference.scrbl b/collects/typed-scheme/scribblings/ts-reference.scrbl
index 19cff7c9..970d5798 100644
--- a/collects/typed-scheme/scribblings/ts-reference.scrbl
+++ b/collects/typed-scheme/scribblings/ts-reference.scrbl
@@ -43,6 +43,9 @@ any expression of this type will not evaluate to a value.}
 @defidform[Natural]
 @defidform[Exact-Nonnegative-Integer]
 @defidform[Exact-Positive-Integer]
+@defidform[Fixnum]
+@defidform[Nonnegative-Fixnum]
+@defidform[Positive-Fixnum]
 @defidform[Zero]
 )]{These types represent the hierarchy of @rtech{numbers} of Racket.
 @racket[Integer] includes only @rtech{integers} that are @rtech{exact

From a50913b597491c8ce5e2b590b7ff3d9f0195ace6 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 7 Sep 2010 16:49:13 -0400
Subject: [PATCH 103/198] Removed unsafe optimization on fixnums.

original commit: ae88abd5c849b664e4720fb0ac20b29c684b2a2b
---
 collects/typed-scheme/optimizer/fixnum.rkt | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/typed-scheme/optimizer/fixnum.rkt b/collects/typed-scheme/optimizer/fixnum.rkt
index c62f3a3c..5aefac8f 100644
--- a/collects/typed-scheme/optimizer/fixnum.rkt
+++ b/collects/typed-scheme/optimizer/fixnum.rkt
@@ -36,7 +36,7 @@
 ;; closed on fixnums, but 2nd argument must not be 0
 (define-syntax-class nonzero-fixnum-binary-op
   #:commit
-  (pattern (~or (~literal quotient)  (~literal fxquotient))  #:with unsafe #'unsafe-fxquotient)
+  ;; quotient is not closed. (quotient most-negative-fixnum -1) is not a fixnum
   (pattern (~or (~literal modulo)    (~literal fxmodulo))    #:with unsafe #'unsafe-fxmodulo)
   (pattern (~or (~literal remainder) (~literal fxremainder)) #:with unsafe #'unsafe-fxremainder))
 

From ae11f47dbd668c4ce965838e256a8911a3500bb7 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 7 Sep 2010 16:56:15 -0400
Subject: [PATCH 104/198] Fixed a dangling link in the doc.

original commit: 11e168f01eecd7b39228d5399e045510d6349e01
---
 collects/typed-scheme/scribblings/ts-reference.scrbl | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/collects/typed-scheme/scribblings/ts-reference.scrbl b/collects/typed-scheme/scribblings/ts-reference.scrbl
index 970d5798..4cab0717 100644
--- a/collects/typed-scheme/scribblings/ts-reference.scrbl
+++ b/collects/typed-scheme/scribblings/ts-reference.scrbl
@@ -2,7 +2,8 @@
 
 @begin[(require "utils.rkt" scribble/eval scriblib/footnote
                 racket/sandbox)
-       (require (for-label (only-meta-in 0 typed/racket)
+       (require (for-label (only-meta-in 0 [except-in typed/racket for])
+                           (only-in racket/base for)
                            racket/list srfi/14
                            version/check))]
 

From 73decd8674ba87b2a596a33e4d55b98ba513ba60 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 7 Sep 2010 17:31:30 -0400
Subject: [PATCH 105/198] Fix broken tests that depended on an unsafe
 optimization.

original commit: 14097dd90e787c08a138fa5e907680f6af96aea3
---
 .../typed-scheme/optimizer/tests/binary-nonzero-fixnum.rkt      | 2 +-
 collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/collects/tests/typed-scheme/optimizer/tests/binary-nonzero-fixnum.rkt b/collects/tests/typed-scheme/optimizer/tests/binary-nonzero-fixnum.rkt
index 6c82520d..59a38b9a 100644
--- a/collects/tests/typed-scheme/optimizer/tests/binary-nonzero-fixnum.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/binary-nonzero-fixnum.rkt
@@ -1,4 +1,4 @@
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
-(quotient (vector-length '#(1 2 3)) 2)
+(modulo (vector-length '#(1 2 3)) 2)
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt b/collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt
index 134bd64d..c3fda6ea 100644
--- a/collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt
@@ -1,5 +1,5 @@
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops racket/flonum)
-(+ (quotient 1 1) 2.0)
+(+ (modulo 1 1) 2.0)
 (+ (expt 100 100) 2.0)

From 617496f14e74bf731bfd44b7ed32745f7e9727ac Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Tue, 7 Sep 2010 18:50:42 -0400
Subject: [PATCH 106/198] Make syntax of #{} less accepting of errors.

original commit: 91fefa055ea0b0fda8ae8bffb993bc163e4160af
---
 .../typed-scheme/succeed/basic-tests.rkt      | 10 +--
 .../succeed/match-expander-problem.rkt        |  2 +-
 .../tests/typed-scheme/succeed/stream.rkt     | 66 +++++++++++++++++++
 .../typed-scheme/private/type-annotation.rkt  |  5 +-
 collects/typed-scheme/typed-reader.rkt        |  8 ++-
 5 files changed, 79 insertions(+), 12 deletions(-)
 create mode 100644 collects/tests/typed-scheme/succeed/stream.rkt

diff --git a/collects/tests/typed-scheme/succeed/basic-tests.rkt b/collects/tests/typed-scheme/succeed/basic-tests.rkt
index 7fb9cfb9..f127a11b 100644
--- a/collects/tests/typed-scheme/succeed/basic-tests.rkt
+++ b/collects/tests/typed-scheme/succeed/basic-tests.rkt
@@ -17,7 +17,7 @@
 
 #;(define: match-test : number
 (match 3
-       [(? number? #{x number}) (+ 17 x)]
+       [(? number? #{x : number}) (+ 17 x)]
        [_ 12]))
 
 
@@ -45,7 +45,7 @@
 
 #;(define: (pt-add/match [v : top]) : number
 (match v
-       [($ pt #{x number} #{y number}) (+ x y)]
+       [($ pt #{x : number} #{y : number}) (+ x y)]
        [_ 0]))
 
 #;(pt-add/match x-struct)
@@ -77,9 +77,9 @@
 
 (define: (f [x : number] [y : number]) : number (+ x y))
 (define: (g [x : number] [y : number]) : boolean
-  (let+ (#;[val #{z number} #f]
-	 [val #{x1 number} (* x x)]
-	 [rec #{y1 number} (* y y)])
+  (let+ (#;[val #{z : number} #f]
+	 [val #{x1 : number} (* x x)]
+	 [rec #{y1 : number} (* y y)])
 	#|(define-syntax foo
 	(syntax-rules ()
 	[(foo) (= x1 y1)]))
diff --git a/collects/tests/typed-scheme/succeed/match-expander-problem.rkt b/collects/tests/typed-scheme/succeed/match-expander-problem.rkt
index dd563dfc..dc6400e6 100644
--- a/collects/tests/typed-scheme/succeed/match-expander-problem.rkt
+++ b/collects/tests/typed-scheme/succeed/match-expander-problem.rkt
@@ -14,7 +14,7 @@
 
 (define: (pt-add/match/blah [v : Any]) : Number
   (match v
-	 [(blah pt #{x Number} #{y Number}) (+ x y)]
+	 [(blah pt #{x : Number} #{y : Number}) (+ x y)]
 	 [_ 0]))
 
 
diff --git a/collects/tests/typed-scheme/succeed/stream.rkt b/collects/tests/typed-scheme/succeed/stream.rkt
new file mode 100644
index 00000000..afedf86e
--- /dev/null
+++ b/collects/tests/typed-scheme/succeed/stream.rkt
@@ -0,0 +1,66 @@
+#lang typed/racket
+#:optimize
+
+(provide Stream stream-cons stream-car stream-cdr empty-stream?)
+
+(define-type Stream
+  (All (A)
+    (Rec S
+      (U Null (Boxof (U (-> (Pair A S))
+                        (Pair A S)))))))
+
+(: empty-stream? : (All (A) ((Stream A) -> Boolean)))
+(define (empty-stream? stream) (null? stream))
+
+(define-syntax-rule (stream-cons x stream)
+  (box (lambda () (cons x stream))))
+
+(: stream-car : (All (A) ((Stream A) -> A)))
+(define (stream-car stream)
+  (if (null? stream)
+    (error 'stream-car "empty stream: ~e" stream)
+    (let ([p (unbox stream)])
+      (if (procedure? p)
+        (let ([pair (p)])
+          (set-box! stream pair)
+          (car pair))
+        (car p)))))
+
+(: stream-cdr : (All (A) ((Stream A) -> (Stream A))))
+(define (stream-cdr stream)
+  (if (null? stream)
+    (error 'stream-cdr "empty stream: ~e" stream)
+    (let ([p (unbox stream)])
+      (if (procedure? p)
+        (let ([pair (p)])
+          (set-box! stream pair)
+          (cdr pair))
+        (cdr p)))))
+
+(: stream : (All (A) (A * -> (Stream A))))
+(define (stream . xs)
+  (: loop : (All (A) ((Listof A) -> (Stream A))))
+  (define (loop xs)
+    (if (null? xs)
+      '()
+      (box (cons (car xs) (loop (cdr xs))))))
+  (loop xs))
+
+(: stream->list : (All (A) ((Stream A) -> (Listof A))))
+(define (stream->list stream)
+  (if (null? stream)
+    '()
+    (cons (stream-car stream) (stream->list (stream-cdr stream)))))
+
+(: rotate : (All (A) ((Stream A) (Listof A) (Stream A) -> (Stream A))))
+(define (rotate frnt rer accum)
+  (let ([carrer (car rer)])   
+    ;; Manually expanded `stream-cons', and added type annotations
+    (if (empty-stream? frnt)
+        (stream-cons carrer accum)
+        (stream-cons
+         (stream-car frnt)
+         ((inst rotate A)
+          (stream-cdr frnt) 
+          (cdr rer)
+          (box (lambda () (cons carrer accum))))))))
\ No newline at end of file
diff --git a/collects/typed-scheme/private/type-annotation.rkt b/collects/typed-scheme/private/type-annotation.rkt
index e5ab42be..5dd07fe7 100644
--- a/collects/typed-scheme/private/type-annotation.rkt
+++ b/collects/typed-scheme/private/type-annotation.rkt
@@ -30,7 +30,7 @@
                (printf/log "Annotation Sexp Pair \n")
                (print-size #'a)
                (print-size #'b))]      
-    [_ (printf/log "Annotation Sexp \n" )]))
+    [_ (printf/log "Annotation Sexp \n")]))
 
 ;; get the type annotation of this syntax
 ;; syntax -> Maybe[Type]
@@ -62,7 +62,6 @@
 
 (define (type-ascription stx)
   (define (pt prop)
-    #;(print-size prop)
     (if (syntax? prop)
         (parse-tc-results prop)
         (parse-tc-results/id stx prop)))
@@ -72,7 +71,7 @@
      (lambda (prop)
        (if (pair? prop)
            (pt (car prop))
-           (pt prop)))]
+           (pt prop)))]    
     [else #f]))
 
 (define (remove-ascription stx)
diff --git a/collects/typed-scheme/typed-reader.rkt b/collects/typed-scheme/typed-reader.rkt
index 2d4e2efa..810aa6e8 100644
--- a/collects/typed-scheme/typed-reader.rkt
+++ b/collects/typed-scheme/typed-reader.rkt
@@ -51,11 +51,13 @@
                          (let* ([prop-name (syntax-e (read-one))])   
                            (skip-whitespace port)
                            (syntax-property name prop-name (read-one)))]
-                 ;; type annotation
-                 [else (syntax-property name 'type-label (syntax->datum next))])))
+                 ;; otherwise error
+                 [else 
+                  (let-values ([(l c p) (port-next-location port)])
+                    (raise-read-error (format "typed expression ~a must be followed by :, ::, or @"
+                                              (syntax->datum name)) src l c p 1))])))
       (skip-whitespace port)
       (let ([c (read-char port)])
-        #;(printf "char: ~a" c)
         (unless (equal? #\} c)
           (let-values ([(l c p) (port-next-location port)])
             (raise-read-error (format "typed expression ~a not properly terminated" (syntax->datum name)) src l c p 1)))))))

From 4bf64acde5e10d050c282065989147bb3ff6a49d Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Tue, 7 Sep 2010 10:39:13 -0400
Subject: [PATCH 107/198] Fix polymorphic structs with mutability.

original commit: 6130f3551c1019c1bc035d802378c29bf574a0c1
---
 .../typed-scheme/private/type-contract.rkt    | 35 ++++++++++---------
 .../typed-scheme/typecheck/tc-structs.rkt     |  3 +-
 2 files changed, 20 insertions(+), 18 deletions(-)

diff --git a/collects/typed-scheme/private/type-contract.rkt b/collects/typed-scheme/private/type-contract.rkt
index 2e7d7aba..6fcf80a9 100644
--- a/collects/typed-scheme/private/type-contract.rkt
+++ b/collects/typed-scheme/private/type-contract.rkt
@@ -117,7 +117,9 @@
         [(Univ:) (if from-typed? #'any-wrap/c #'any/c)]
         ;; we special-case lists:
         [(Mu: var (Union: (list (Value: '()) (Pair: elem-ty (F: var)))))
-         #`(listof #,(t->c elem-ty))]
+         (if (and (not from-typed?) (type-equal? elem-ty t:Univ))
+             #'list?
+             #`(listof #,(t->c elem-ty)))]
         [(? (lambda (e) (eq? t:Any-Syntax e))) #'syntax?]
         [(Base: sym cnt) #`(flat-named-contract '#,sym (flat-contract-predicate #,cnt))]
         [(Refinement: par p? cert)
@@ -168,7 +170,6 @@
                        [(name ...) name]
                        [(by-name-cnt ...) (for/list ([t by-name-init-ty]) (t->c/neg t))]
                        [(by-name-init ...) by-name-init])
-           #;#'class?           
            #'(class/c (name fcn-cnt) ... (init [by-name-init by-name-cnt] ...)))]
         [(Value: '()) #'null?]
         [(Struct: nm par (list (fld: flds acc-ids mut?) ...) proc poly? pred? cert maker-id)
@@ -185,21 +186,21 @@
                             (for/list ([fty flds]
                                        [f-acc acc-ids]
                                        [m? mut?])
-                              #`(((contract-projection
-                                   #,(t->c fty #:seen (cons (cons ty #'(recursive-contract rec)) structs-seen)))
-                                  blame)
-                                 (#,f-acc val)))])
-              #`(letrec ([rec 
-                          (make-contract 
-                           #:name 'cnt-name
-                           #:first-order #,pred?
-                           #:projection 
-                           (lambda (blame)
-                             (lambda (val)
-                               (unless (#,pred? val)
-                                 (raise-blame-error blame val "expected ~a value, got ~v" 'cnt-name val))
-                               (maker fld-cnts ...))))])
-                  rec))]
+                #`(((contract-projection
+                     #,(t->c fty #:seen (cons (cons ty #'(recursive-contract rec)) structs-seen)))
+                    blame)
+                   (#,f-acc val)))])
+                #`(letrec ([rec 
+                            (make-contract 
+                             #:name 'cnt-name
+                             #:first-order #,pred?
+                             #:projection 
+                             (lambda (blame)
+                               (lambda (val)
+                                 (unless (#,pred? val)
+                                   (raise-blame-error blame val "expected ~a value, got ~v" 'cnt-name val))
+                                 (maker fld-cnts ...))))])
+                    rec))]
            [else #`(flat-named-contract '#,(syntax-e pred?) #,(cert pred?))])]
         [(Syntax: (Base: 'Symbol _)) #'identifier?]
         [(Syntax: t) #`(syntax/c #,(t->c t))]
diff --git a/collects/typed-scheme/typecheck/tc-structs.rkt b/collects/typed-scheme/typecheck/tc-structs.rkt
index c43bce64..5a9bfec9 100644
--- a/collects/typed-scheme/typecheck/tc-structs.rkt
+++ b/collects/typed-scheme/typecheck/tc-structs.rkt
@@ -211,7 +211,7 @@
 
 ;; check and register types for a polymorphic define struct
 ;; tc/poly-struct : Listof[identifier] (U identifier (list identifier identifier)) Listof[identifier] Listof[syntax] -> void
-(define (tc/poly-struct vars nm/par flds tys #:maker [maker #f])
+(define (tc/poly-struct vars nm/par flds tys #:maker [maker #f] #:mutable [mutable #f])
   ;; parent field types can't actually be determined here
   (define-values (nm parent-name parent name name-tvar) (parse-parent nm/par))
   ;; create type variables for the new type parameters
@@ -236,6 +236,7 @@
   ;; then register them
   (mk/register-sty nm flds parent-name parent-field-types types
                    #:maker maker
+                   #:mutable mutable
                    ;; wrap everything in the approriate forall
                    #:wrapper (λ (t) (make-Poly tvars t))
                    #:type-wrapper (λ (t) (make-App t new-tvars #f))

From fba3c3b9ca74f8adc5acc2f6539837aec05e5a3f Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 8 Sep 2010 10:46:44 -0400
Subject: [PATCH 108/198] Propogate #:mutable for polymorphic structs.

 Closes PR 11127

original commit: a0e77705e578927e5d8180e6bc811461173580ab
---
 .../typed-scheme/succeed/mutable-poly-struct.rkt   |  9 +++++++++
 collects/typed-scheme/private/prims.rkt            | 14 ++++++++------
 collects/typed-scheme/typecheck/tc-toplevel.rkt    |  7 +++++++
 3 files changed, 24 insertions(+), 6 deletions(-)
 create mode 100644 collects/tests/typed-scheme/succeed/mutable-poly-struct.rkt

diff --git a/collects/tests/typed-scheme/succeed/mutable-poly-struct.rkt b/collects/tests/typed-scheme/succeed/mutable-poly-struct.rkt
new file mode 100644
index 00000000..4c1f16bd
--- /dev/null
+++ b/collects/tests/typed-scheme/succeed/mutable-poly-struct.rkt
@@ -0,0 +1,9 @@
+#lang typed/racket
+
+(define-struct: (A) X ([b : A]) #:mutable)
+
+set-X-b!
+
+(struct: (A) Foo ([x : Integer]) #:mutable)
+(define x (Foo 10))
+(set-Foo-x! x 100)
diff --git a/collects/typed-scheme/private/prims.rkt b/collects/typed-scheme/private/prims.rkt
index c30c9419..8abe9f81 100644
--- a/collects/typed-scheme/private/prims.rkt
+++ b/collects/typed-scheme/private/prims.rkt
@@ -347,10 +347,11 @@ This file defines two sorts of primitives. All of them are provided into any mod
                           [dtsi (quasisyntax/loc stx (dtsi* () nm (fs ...) #,@mutable))])
               #'(begin d-s dtsi)))]
          [(_ (vars:id ...) nm:struct-name (fs:fld-spec ...) . opts)
-          (with-syntax ([d-s (syntax-property (syntax/loc stx (define-struct nm (fs.fld ...) . opts))
-                                              'typechecker:ignore #t)]
-                        [dtsi (syntax/loc stx (dtsi* (vars ...) nm (fs ...)))])
-            #'(begin d-s dtsi))]))
+          (let ([mutable (mutable? #'opts)])
+            (with-syntax ([d-s (syntax-property (syntax/loc stx (define-struct nm (fs.fld ...) . opts))
+                                                'typechecker:ignore #t)]
+                          [dtsi (quasisyntax/loc stx (dtsi* (vars ...) nm (fs ...)  #,@mutable))])
+              #'(begin d-s dtsi)))]))
      (lambda (stx)
        (syntax-parse stx
          [(_ nm:struct-name/new (fs:fld-spec ...) . opts)
@@ -364,13 +365,14 @@ This file defines two sorts of primitives. All of them are provided into any mod
                           [dtsi (quasisyntax/loc stx (dtsi* () nm.old-spec (fs ...) #:maker #,cname #,@mutable))])
               #'(begin d-s dtsi)))]
          [(_ (vars:id ...) nm:struct-name/new (fs:fld-spec ...) . opts)
-          (let ([cname (datum->syntax #f (syntax-e #'nm.name))])
+          (let ([cname (datum->syntax #f (syntax-e #'nm.name))]
+                [mutable (mutable? #'opts)])
             (with-syntax ([d-s (syntax-property (quasisyntax/loc stx 
                                                   (struct #,@(attribute nm.new-spec) (fs.fld ...)
                                                           #:extra-constructor-name #,cname
                                                           . opts))
                                                 'typechecker:ignore #t)]
-                          [dtsi (quasisyntax/loc stx (dtsi* (vars ...) nm.old-spec (fs ...) #:maker #,cname))])
+                          [dtsi (quasisyntax/loc stx (dtsi* (vars ...) nm.old-spec (fs ...) #:maker #,cname #,@mutable))])
               #'(begin d-s dtsi)))])))))
 
 (define-syntax (require-typed-struct stx)
diff --git a/collects/typed-scheme/typecheck/tc-toplevel.rkt b/collects/typed-scheme/typecheck/tc-toplevel.rkt
index bb330b89..011410fd 100644
--- a/collects/typed-scheme/typecheck/tc-toplevel.rkt
+++ b/collects/typed-scheme/typecheck/tc-toplevel.rkt
@@ -107,10 +107,17 @@
                                 (#%plain-app values)))
        (tc/poly-struct (syntax->list #'(vars ...)) #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...))
                        #:maker #'m)]
+      [(define-values () (begin (quote-syntax (define-typed-struct-internal (vars ...) nm ([fld : ty] ...)
+						#:maker m #:mutable)) 
+                                (#%plain-app values)))
+       (tc/poly-struct (syntax->list #'(vars ...)) #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...))
+                       #:maker #'m #:mutable #t)]
       [(define-values () (begin (quote-syntax (define-typed-struct-internal nm ([fld : ty] ...) #:type-only))
                                 (#%plain-app values)))
        (tc/struct #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...)) #:type-only #t)]
       ;; define-typed-struct w/ polymorphism
+      [(define-values () (begin (quote-syntax (define-typed-struct-internal (vars ...) nm ([fld : ty] ...) #:mutable)) (#%plain-app values)))
+       (tc/poly-struct (syntax->list #'(vars ...)) #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...)) #:mutable #t)]
       [(define-values () (begin (quote-syntax (define-typed-struct-internal (vars ...) nm ([fld : ty] ...))) (#%plain-app values)))
        (tc/poly-struct (syntax->list #'(vars ...)) #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...)))]
       ;; error in other cases

From 8cdcde83cdcfee737a2e1ccd660e6b93698ffd02 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 8 Sep 2010 11:05:51 -0400
Subject: [PATCH 109/198] Fix contract name references.

original commit: 350cef9af8bc27dc5eb223875d3f7a3c408753a4
---
 collects/typed-scheme/typecheck/check-below.rkt | 2 +-
 collects/typed-scheme/typecheck/tc-funapp.rkt   | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/collects/typed-scheme/typecheck/check-below.rkt b/collects/typed-scheme/typecheck/check-below.rkt
index 9f06b138..1a6d0fce 100644
--- a/collects/typed-scheme/typecheck/check-below.rkt
+++ b/collects/typed-scheme/typecheck/check-below.rkt
@@ -12,7 +12,7 @@
          (only-in srfi/1 split-at))
 
 (p/c
- [check-below (->d ([s (or/c Type/c tc-results?)] [t (or/c Type/c tc-results?)]) () [_ (if (Type? s) Type/c tc-results?)])])
+ [check-below (-->d ([s (-or/c Type/c tc-results?)] [t (-or/c Type/c tc-results?)]) () [_ (if (Type? s) Type/c tc-results?)])])
 
 (define (print-object o)
   (match o
diff --git a/collects/typed-scheme/typecheck/tc-funapp.rkt b/collects/typed-scheme/typecheck/tc-funapp.rkt
index 63f12298..f4403c78 100644
--- a/collects/typed-scheme/typecheck/tc-funapp.rkt
+++ b/collects/typed-scheme/typecheck/tc-funapp.rkt
@@ -43,7 +43,7 @@
              (poly-fail t argtys #:name (and (identifier? f-stx) f-stx) #:expected expected))))]))
 
 (d/c (tc/funapp f-stx args-stx ftype0 argtys expected)
-  (syntax? syntax? tc-results? (listof tc-results?) (or/c #f tc-results?) . -> . tc-results?)
+  (syntax? syntax? tc-results? (c:listof tc-results?) (c:or/c #f tc-results?) . c:-> . tc-results?)
   (match* (ftype0 argtys)
     ;; we special-case this (no case-lambda) for improved error messages
     [((tc-result1: (and t (Function: (list (and a (arr: dom (Values: _) rest #f kws)))))) argtys)

From 1503fed8c3adfdae510397570a9060ebd2f0f4b4 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 8 Sep 2010 11:32:04 -0400
Subject: [PATCH 110/198] Add memory fns.

original commit: fae02be9f06aefd55c65211d2e95a07041ebfede
---
 collects/typed-scheme/private/base-env.rkt | 2 ++
 1 file changed, 2 insertions(+)

diff --git a/collects/typed-scheme/private/base-env.rkt b/collects/typed-scheme/private/base-env.rkt
index bf36ecc5..dfa13622 100644
--- a/collects/typed-scheme/private/base-env.rkt
+++ b/collects/typed-scheme/private/base-env.rkt
@@ -640,6 +640,8 @@
 [exit (-> (Un))]
 
 [collect-garbage (-> -Void)]
+[current-memory-use (-> -Nat)]
+[dump-memory-stats (-> Univ)]
 
 [module->namespace (-> (-mu x (-lst (Un -Symbol -String -Nat x (-val #f)))) -Namespace)]
 [current-namespace (-Param -Namespace -Namespace)]

From 673abe2e46a2bbc5ea705ed923bf9528c8eded6c Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 8 Sep 2010 11:37:02 -0400
Subject: [PATCH 111/198] simplify

original commit: cfc289d806a4a71e34df8dc8b98b5024b66a4cff
---
 collects/typed-scheme/utils/tc-utils.rkt | 19 ++++++++-----------
 1 file changed, 8 insertions(+), 11 deletions(-)

diff --git a/collects/typed-scheme/utils/tc-utils.rkt b/collects/typed-scheme/utils/tc-utils.rkt
index 7ce94208..84cf6441 100644
--- a/collects/typed-scheme/utils/tc-utils.rkt
+++ b/collects/typed-scheme/utils/tc-utils.rkt
@@ -6,10 +6,8 @@ don't depend on any other portion of the system
 |#
 
 (provide (all-defined-out))
-(require "syntax-traversal.rkt"
-	 "utils.rkt" racket/dict
-	 syntax/parse (for-syntax scheme/base syntax/parse) scheme/match unstable/debug
-         (for-syntax unstable/syntax))
+(require "syntax-traversal.rkt" racket/dict
+	 syntax/parse (for-syntax scheme/base syntax/parse) scheme/match)
 
 ;; a parameter representing the original location of the syntax being currently checked
 (define current-orig-stx (make-parameter #'here))
@@ -138,13 +136,12 @@ don't depend on any other portion of the system
 
 ;; raise an internal error - typechecker bug!
 (define (int-err msg . args) 
-  (parameterize ([custom-printer #t])
-    (raise (make-exn:fail:tc (string-append "Internal Typechecker Error: "
-					    (apply format msg args)
-					    (format "\nwhile typechecking\n~aoriginally\n~a"
-						    (syntax->datum (current-orig-stx))
-						    (syntax->datum (locate-stx (current-orig-stx)))))
-			     (current-continuation-marks)))))
+  (raise (make-exn:fail:tc (string-append "Internal Typechecker Error: "
+                                          (apply format msg args)
+                                          (format "\nwhile typechecking\n~aoriginally\n~a"
+                                                  (syntax->datum (current-orig-stx))
+                                                  (syntax->datum (locate-stx (current-orig-stx)))))
+                           (current-continuation-marks))))
 
 (define-syntax (nyi stx)
   (syntax-case stx ()

From 72a11f2d561344a8cdc3b8fcff110427383d6254 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 8 Sep 2010 11:38:28 -0400
Subject: [PATCH 112/198] Load typechecker dynamically to reduce footprint.

original commit: 120a1d0d87824f90b153047cc3a5408a60753b65
---
 collects/typed-scheme/core.rkt                |  69 +++++++
 collects/typed-scheme/private/with-types.rkt  | 188 +++++++++---------
 .../typed-scheme/typecheck/def-export.rkt     |  12 +-
 collects/typed-scheme/typecheck/renamer.rkt   |   9 +
 collects/typed-scheme/typed-scheme.rkt        |  71 +------
 5 files changed, 185 insertions(+), 164 deletions(-)
 create mode 100644 collects/typed-scheme/core.rkt
 create mode 100644 collects/typed-scheme/typecheck/renamer.rkt

diff --git a/collects/typed-scheme/core.rkt b/collects/typed-scheme/core.rkt
new file mode 100644
index 00000000..04ac1879
--- /dev/null
+++ b/collects/typed-scheme/core.rkt
@@ -0,0 +1,69 @@
+#lang racket/base
+
+(require (rename-in "utils/utils.rkt" [infer r:infer])
+         (for-syntax racket/base)
+         (for-template racket/base)
+         (private with-types type-contract)
+         (except-in syntax/parse id)
+         racket/match unstable/syntax unstable/match
+         (optimizer optimizer)
+         (types utils convenience)
+         (typecheck typechecker provide-handling tc-toplevel)
+         (env type-name-env type-alias-env)
+         (r:infer infer)         
+         (rep type-rep)
+         (except-in (utils utils tc-utils) infer)
+         (only-in (r:infer infer-dummy) infer-param)          
+         "tc-setup.rkt")
+
+(provide mb-core ti-core wt-core)
+
+(define (mb-core stx)
+  (syntax-parse stx
+    [(mb (~optional (~and #:optimize (~bind [opt? #'#t]))) forms ...)
+     (let ([pmb-form (syntax/loc stx (#%plain-module-begin forms ...))])
+       (parameterize ([optimize? (or (optimize?) (attribute opt?))])
+         (tc-setup 
+          stx pmb-form 'module-begin new-mod tc-module after-code
+          (with-syntax*
+           (;; pmb = #%plain-module-begin    
+            [(pmb . body2) new-mod]
+            ;; add in syntax property on useless expression to draw check-syntax arrows
+            [check-syntax-help (syntax-property #'(void) 'disappeared-use (type-name-references))]
+            ;; perform the provide transformation from [Culpepper 07]
+            [transformed-body (remove-provides #'body2)]
+            ;; add the real definitions of contracts on requires
+            [transformed-body (change-contract-fixups #'transformed-body)]
+            ;; potentially optimize the code based on the type information
+            [(optimized-body ...)
+             ;; do we optimize?
+             (if (optimize?)
+                 (begin0 (map optimize-top (syntax->list #'transformed-body))
+                         (do-time "Optimized"))
+                 #'transformed-body)])
+           ;; reconstruct the module with the extra code
+           ;; use the regular %#module-begin from `racket/base' for top-level printing
+           #`(#%module-begin optimized-body ... #,after-code check-syntax-help)))))]))
+
+(define (ti-core stx)  
+  (syntax-parse stx 
+    [(_ . ((~datum module) . rest))
+     #'(module . rest)]
+    [(_ . form)
+     (tc-setup
+      stx #'form 'top-level body2 tc-toplevel-form type
+      (syntax-parse body2
+        ;; any of these do not produce an expression to be printed
+        [(head:invis-kw . _) body2]
+        [_ (let ([ty-str (match type
+                           ;; don't print results of type void
+                           [(tc-result1: (== -Void type-equal?)) #f]
+                           [(tc-result1: t f o)
+                            (format "- : ~a\n" t)]
+                           [(tc-results: t)
+                            (format "- : ~a\n" (cons 'Values t))]
+                           [x (int-err "bad type result: ~a" x)])])
+             (if ty-str                  
+                 #`(let ([type '#,ty-str])
+                     (begin0 #,body2 (display type)))
+                 body2))]))]))
\ No newline at end of file
diff --git a/collects/typed-scheme/private/with-types.rkt b/collects/typed-scheme/private/with-types.rkt
index 601bdb38..a3eb62dc 100644
--- a/collects/typed-scheme/private/with-types.rkt
+++ b/collects/typed-scheme/private/with-types.rkt
@@ -1,11 +1,14 @@
 #lang racket/base
 
-(require racket/require racket/contract/regions racket/contract/base
+(require racket/require
+         (for-template 
+          (except-in racket/base for for*)
+          "prims.rkt"
+          (prefix-in c: (combine-in racket/contract/regions racket/contract/base)))
          "base-env.rkt" "base-special-env.rkt" "base-env-numeric.rkt"
 	 "base-env-indexing.rkt" "extra-procs.rkt" "prims.rkt"         
-         (for-syntax 
-          scheme/base syntax/parse racket/block racket/match
-          unstable/sequence unstable/debug "base-types-extra.rkt"
+         syntax/parse racket/block racket/match
+         unstable/sequence unstable/debug "base-types-extra.rkt"
          (except-in (path-up "env/type-name-env.rkt"
                              "env/type-alias-env.rkt"
                              "infer/infer-dummy.rkt"
@@ -21,98 +24,97 @@
                              "types/convenience.rkt"
                              "types/abbrev.rkt")
                     ->)
-         (except-in (path-up "utils/utils.rkt") infer)))
+         (except-in (path-up "utils/utils.rkt") infer))
 
-(provide with-type)
+(provide wt-core)
 
-(define-for-syntax (with-type-helper stx body fvids fvtys exids extys resty expr? ctx)
-  (block
-    (define old-context (unbox typed-context?))
-    (define ((no-contract t [stx stx]))
-      (tc-error/stx stx "Type ~a could not be converted to a contract." t))
-    (set-box! typed-context? #t)
-    (define fv-types (for/list ([t (in-list (syntax->list fvtys))])
-                       (parse-type t)))
-    (define fv-cnts (for/list ([t (in-list fv-types)]
-                               [stx (in-list (syntax->list fvtys))])
-                      (type->contract t #:typed-side #f (no-contract t))))
-    (define ex-types (for/list ([t (syntax->list extys)])
-                       (parse-type t)))
-    (define ex-cnts (for/list ([t (in-list ex-types)]
-                               [stx (in-list (syntax->list extys))])
-                      (type->contract t #:typed-side #t (no-contract t))))
-    (define region-tc-result 
-      (and expr? (parse-tc-results resty)))
-    (define region-cnts 
-      (if region-tc-result
-          (match region-tc-result 
-            [(tc-result1: t)
-             (list (type->contract t #:typed-side #t (no-contract t #'region-ty-stx)))]
-            [(tc-results: ts)
-             (for/list ([t (in-list ts)])
-               (type->contract
-                t #:typed-side #t
-                (no-contract t #'region-ty-stx)))])
-          null))
-    (for ([i (in-list (syntax->list fvids))]
-          [ty (in-list fv-types)])
-      (register-type i ty))
-    (define expanded-body 
-      (if expr?
-          (with-syntax ([body body])
-            (local-expand #'(let () . body) ctx null))
-          (with-syntax ([(body ...) body]
-                        [(id ...) exids]
-                        [(ty ...) extys])
-            (local-expand #'(let () (begin (: id ty) ... body ... (values id ...))) ctx null))))
-    (parameterize (;; disable fancy printing?
-                   [custom-printer #t]
-                   ;; a cheat to avoid units
-                   [infer-param infer]
-                   ;; do we report multiple errors
-                   [delay-errors? #t]
-                   ;; this parameter is just for printing types
-                   ;; this is a parameter to avoid dependency issues
-                   [current-type-names
-                    (lambda ()
-                      (append 
-                       (type-name-env-map (lambda (id ty)
-                                            (cons (syntax-e id) ty)))
-                       (type-alias-env-map (lambda (id ty)
-                                             (cons (syntax-e id) ty)))))]
-                   ;; reinitialize seen type variables
-                   [type-name-references null]
-                   ;; for error reporting
-                   [orig-module-stx stx]
-                   [expanded-module-stx expanded-body])     
-          (tc-expr/check expanded-body (if expr? region-tc-result (ret ex-types))))
-    (report-all-errors)
-    (set-box! typed-context? old-context)
-    ;; then clear the new entries from the env ht
-    (for ([i (in-list (syntax->list fvids))])
-      (unregister-type i))
-    (with-syntax ([(fv.id ...) fvids]
-                  [(cnt ...) fv-cnts]
-                  [(ex-id ...) exids]
-                  [(ex-cnt ...) ex-cnts]
-                  [(region-cnt ...) region-cnts]
-                  [body expanded-body]
-                  [check-syntax-help (syntax-property #'(void) 'disappeared-use (type-name-references))])
-      (if expr?
-          (quasisyntax/loc stx
-            (begin check-syntax-help
-                   (with-contract typed-region
-                     #:results (region-cnt ...)
-                     #:freevars ([fv.id cnt] ...)                                
-                     body)))
-          (syntax/loc stx
-            (begin
-              (define-values () (begin check-syntax-help (values)))
-              (with-contract typed-region
-                ([ex-id ex-cnt] ...)
-                (define-values (ex-id ...) body))))))))
+(define (with-type-helper stx body fvids fvtys exids extys resty expr? ctx)
+  (define old-context (unbox typed-context?))
+  (define ((no-contract t [stx stx]))
+    (tc-error/stx stx "Type ~a could not be converted to a contract." t))
+  (set-box! typed-context? #t)
+  (define fv-types (for/list ([t (in-list (syntax->list fvtys))])
+                     (parse-type t)))
+  (define fv-cnts (for/list ([t (in-list fv-types)]
+                             [stx (in-list (syntax->list fvtys))])
+                    (type->contract t #:typed-side #f (no-contract t))))
+  (define ex-types (for/list ([t (syntax->list extys)])
+                     (parse-type t)))
+  (define ex-cnts (for/list ([t (in-list ex-types)]
+                             [stx (in-list (syntax->list extys))])
+                    (type->contract t #:typed-side #t (no-contract t))))
+  (define region-tc-result 
+    (and expr? (parse-tc-results resty)))
+  (define region-cnts 
+    (if region-tc-result
+        (match region-tc-result 
+          [(tc-result1: t)
+           (list (type->contract t #:typed-side #t (no-contract t #'region-ty-stx)))]
+          [(tc-results: ts)
+           (for/list ([t (in-list ts)])
+             (type->contract
+              t #:typed-side #t
+              (no-contract t #'region-ty-stx)))])
+        null))
+  (for ([i (in-list (syntax->list fvids))]
+        [ty (in-list fv-types)])
+    (register-type i ty))
+  (define expanded-body 
+    (if expr?
+        (with-syntax ([body body])
+          (local-expand #'(let () . body) ctx null))
+        (with-syntax ([(body ...) body]
+                      [(id ...) exids]
+                      [(ty ...) extys])
+          (local-expand #'(let () (begin (: id ty) ... body ... (values id ...))) ctx null))))
+  (parameterize (;; disable fancy printing?
+                 [custom-printer #t]
+                 ;; a cheat to avoid units
+                 [infer-param infer]
+                 ;; do we report multiple errors
+                 [delay-errors? #t]
+                 ;; this parameter is just for printing types
+                 ;; this is a parameter to avoid dependency issues
+                 [current-type-names
+                  (lambda ()
+                    (append 
+                     (type-name-env-map (lambda (id ty)
+                                          (cons (syntax-e id) ty)))
+                     (type-alias-env-map (lambda (id ty)
+                                           (cons (syntax-e id) ty)))))]
+                 ;; reinitialize seen type variables
+                 [type-name-references null]
+                 ;; for error reporting
+                 [orig-module-stx stx]
+                 [expanded-module-stx expanded-body])     
+    (tc-expr/check expanded-body (if expr? region-tc-result (ret ex-types))))
+  (report-all-errors)
+  (set-box! typed-context? old-context)
+  ;; then clear the new entries from the env ht
+  (for ([i (in-list (syntax->list fvids))])
+    (unregister-type i))
+  (with-syntax ([(fv.id ...) fvids]
+                [(cnt ...) fv-cnts]
+                [(ex-id ...) exids]
+                [(ex-cnt ...) ex-cnts]
+                [(region-cnt ...) region-cnts]
+                [body expanded-body]
+                [check-syntax-help (syntax-property #'(void) 'disappeared-use (type-name-references))])
+    (if expr?
+        (quasisyntax/loc stx
+          (begin check-syntax-help
+                 (c:with-contract typed-region
+                                  #:results (region-cnt ...)
+                                  #:freevars ([fv.id cnt] ...)                                
+                                  body)))
+        (syntax/loc stx
+          (begin
+            (define-values () (begin check-syntax-help (values)))
+            (c:with-contract typed-region
+                             ([ex-id ex-cnt] ...)
+                             (define-values (ex-id ...) body)))))))
 
-(define-syntax (with-type stx)
+(define (wt-core stx)
   (define-syntax-class typed-id
     #:description "[id type]"
     [pattern (id ty)])
diff --git a/collects/typed-scheme/typecheck/def-export.rkt b/collects/typed-scheme/typecheck/def-export.rkt
index acf624d6..16b70823 100644
--- a/collects/typed-scheme/typecheck/def-export.rkt
+++ b/collects/typed-scheme/typecheck/def-export.rkt
@@ -1,16 +1,10 @@
 #lang racket/base
 
-(require racket/require
-         (for-syntax syntax/parse racket/base 
-                     (path-up "utils/tc-utils.rkt" "private/typed-renaming.rkt" "env/type-name-env.rkt")))
+(require racket/require (for-template "renamer.rkt") "renamer.rkt"
+         (for-syntax syntax/parse racket/base "renamer.rkt"
+                     (path-up "utils/tc-utils.rkt" "env/type-name-env.rkt")))
 (provide def-export)
 
-
-(define-for-syntax (renamer id #:alt [alt #f])
-  (if alt
-      (make-typed-renaming (syntax-property id 'not-free-identifier=? #t) alt)
-      (make-rename-transformer (syntax-property id 'not-free-identifier=? #t))))
-
 (define-syntax (def-export stx)
   (syntax-parse stx
     [(def-export export-id:identifier id:identifier cnt-id:identifier)
diff --git a/collects/typed-scheme/typecheck/renamer.rkt b/collects/typed-scheme/typecheck/renamer.rkt
new file mode 100644
index 00000000..a1f19cff
--- /dev/null
+++ b/collects/typed-scheme/typecheck/renamer.rkt
@@ -0,0 +1,9 @@
+#lang racket/base
+
+(require "../private/typed-renaming.rkt")
+(provide renamer)
+
+(define (renamer id #:alt [alt #f])
+  (if alt
+      (make-typed-renaming (syntax-property id 'not-free-identifier=? #t) alt)
+      (make-rename-transformer (syntax-property id 'not-free-identifier=? #t))))
\ No newline at end of file
diff --git a/collects/typed-scheme/typed-scheme.rkt b/collects/typed-scheme/typed-scheme.rkt
index 6063fdfa..88f1e416 100644
--- a/collects/typed-scheme/typed-scheme.rkt
+++ b/collects/typed-scheme/typed-scheme.rkt
@@ -1,21 +1,6 @@
 #lang racket/base
 
-(require (rename-in "utils/utils.rkt" [infer r:infer])
-         (private with-types)
-         (for-syntax 
-          (except-in syntax/parse id)
-          racket/match unstable/syntax racket/base unstable/match
-          (private type-contract)
-          (optimizer optimizer)
-          (types utils convenience)
-	  (typecheck typechecker provide-handling tc-toplevel)
-	  (env type-name-env type-alias-env)
-	  (r:infer infer)
-	  (utils tc-utils)
-	  (rep type-rep)
-	  (except-in (utils utils) infer)
-          (only-in (r:infer infer-dummy) infer-param)          
-          "tc-setup.rkt"))
+(require (for-syntax racket/base "typecheck/renamer.rkt"))
 
 (provide (rename-out [module-begin #%module-begin]
                      [top-interaction #%top-interaction]
@@ -25,54 +10,16 @@
          with-type)
 
 (define-syntax (module-begin stx)
-  (syntax-parse stx
-     [(mb (~optional (~and #:optimize (~bind [opt? #'#t]))) forms ...)
-      (let ([pmb-form (syntax/loc stx (#%plain-module-begin forms ...))])
-        (parameterize ([optimize? (or (optimize?) (attribute opt?))])
-          (tc-setup 
-           stx pmb-form 'module-begin new-mod tc-module after-code
-           (with-syntax*
-            (;; pmb = #%plain-module-begin    
-             [(pmb . body2) new-mod]
-             ;; add in syntax property on useless expression to draw check-syntax arrows
-             [check-syntax-help (syntax-property #'(void) 'disappeared-use (type-name-references))]
-             ;; perform the provide transformation from [Culpepper 07]
-             [transformed-body (remove-provides #'body2)]
-             ;; add the real definitions of contracts on requires
-             [transformed-body (change-contract-fixups #'transformed-body)]
-             ;; potentially optimize the code based on the type information
-             [(optimized-body ...)
-              ;; do we optimize?
-              (if (optimize?)
-                  (begin0 (map optimize-top (syntax->list #'transformed-body))
-                    (do-time "Optimized"))
-                  #'transformed-body)])
-            ;; reconstruct the module with the extra code
-            ;; use the regular %#module-begin from `racket/base' for top-level printing
-            #`(#%module-begin optimized-body ... #,after-code check-syntax-help)))))]))
+  (dynamic-require 'typed-scheme/private/base-env #f)
+  (dynamic-require 'typed-scheme/private/base-env-numeric #f)
+  (dynamic-require 'typed-scheme/private/base-env-indexing #f)
+  ((dynamic-require 'typed-scheme/core 'mb-core) stx))
 
 (define-syntax (top-interaction stx)
-  (syntax-parse stx 
-    [(_ . ((~datum module) . rest))
-     #'(module . rest)]
-    [(_ . form)
-     (tc-setup
-      stx #'form 'top-level body2 tc-toplevel-form type
-      (syntax-parse body2
-        ;; any of these do not produce an expression to be printed
-        [(head:invis-kw . _) body2]
-        [_ (let ([ty-str (match type
-                           ;; don't print results of type void
-                           [(tc-result1: (== -Void type-equal?)) #f]
-                           [(tc-result1: t f o)
-                            (format "- : ~a\n" t)]
-                           [(tc-results: t)
-                            (format "- : ~a\n" (cons 'Values t))]
-                           [x (int-err "bad type result: ~a" x)])])
-             (if ty-str                  
-                 #`(let ([type '#,ty-str])
-                     (begin0 #,body2 (display type)))
-                 body2))]))]))
+  ((dynamic-require 'typed-scheme/core 'ti-core) stx))
+
+(define-syntax (with-type stx)
+  ((dynamic-require 'typed-scheme/core 'wt-core) stx))
 
 
 

From 54763a9ca3dd3a2f7e1d09fef01419f51cb41d2d Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 8 Sep 2010 11:38:59 -0400
Subject: [PATCH 113/198] simplify requires

original commit: 837291a793bd9602af16404db1b4fc49e639021f
---
 collects/typed-scheme/private/prims.rkt | 32 ++++++++++++-------------
 1 file changed, 16 insertions(+), 16 deletions(-)

diff --git a/collects/typed-scheme/private/prims.rkt b/collects/typed-scheme/private/prims.rkt
index 8abe9f81..20573f35 100644
--- a/collects/typed-scheme/private/prims.rkt
+++ b/collects/typed-scheme/private/prims.rkt
@@ -30,31 +30,31 @@ This file defines two sorts of primitives. All of them are provided into any mod
 (require "../utils/utils.rkt"
          racket/base
          mzlib/etc
-	 (for-syntax 
+         "../utils/require-contract.rkt"
+         "colon.rkt"
+         "../typecheck/internal-forms.rkt"
+         (rename-in racket/contract [-> c->])
+         mzlib/struct
+         "base-types.rkt"
+         "base-types-extra.rkt"
+         (for-syntax 
           syntax/parse
 	  syntax/private/util
           scheme/base
-          (rep type-rep)
           mzlib/match
-          "parse-type.rkt" "annotate-classes.rkt"
+          scheme/struct-info
           syntax/struct
           syntax/stx
-          scheme/struct-info
-          (private internal)
-	  (except-in (utils utils tc-utils))
-          (env type-name-env)
+          "../rep/type-rep.rkt"
+          "parse-type.rkt"
+          "annotate-classes.rkt"
+          "internal.rkt"
+          "../utils/utils.rkt"
+          "../utils/tc-utils.rkt"	  
+          "../env/type-name-env.rkt"
           "type-contract.rkt"
           "for-clauses.rkt"))
 
-(require (utils require-contract)
-         "colon.rkt"
-         (typecheck internal-forms)
-         (except-in mzlib/contract ->)
-         (only-in mzlib/contract [-> c->])
-         mzlib/struct
-         "base-types.rkt"
-         "base-types-extra.rkt")
-
 (define-for-syntax (ignore stx) (syntax-property stx 'typechecker:ignore #t))
 
 

From 63748f9460a9f141c827dadebe0f43a1d7973e67 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 8 Sep 2010 15:30:33 -0400
Subject: [PATCH 114/198] Progress on delaying some environments.

original commit: de0e8bc81ce566d9a540832f794d96b2cf9409ce
---
 collects/typed-scheme/main.rkt                |   6 +-
 .../private/base-env-indexing.rkt             |  11 +-
 collects/typed-scheme/private/base-env.rkt    |   3 +-
 .../typed-scheme/private/base-special-env.rkt | 168 +++---------------
 .../typed-scheme/private/base-structs.rkt     |  99 +++++++++++
 collects/typed-scheme/typed-scheme.rkt        |  14 +-
 6 files changed, 146 insertions(+), 155 deletions(-)
 create mode 100644 collects/typed-scheme/private/base-structs.rkt

diff --git a/collects/typed-scheme/main.rkt b/collects/typed-scheme/main.rkt
index eb46ac97..2082ac80 100644
--- a/collects/typed-scheme/main.rkt
+++ b/collects/typed-scheme/main.rkt
@@ -10,11 +10,7 @@
 		   #%top-interaction
 		   lambda
 		   #%app))
-(require "private/base-env.rkt" 
-	 "private/base-special-env.rkt"
-	 "private/base-env-numeric.rkt"
-	 "private/base-env-indexing.rkt"
-	 "private/extra-procs.rkt"
+(require "private/extra-procs.rkt"
          (for-syntax "private/base-types-extra.rkt"))
 (provide (rename-out [with-handlers: with-handlers])
          (for-syntax (all-from-out "private/base-types-extra.rkt"))
diff --git a/collects/typed-scheme/private/base-env-indexing.rkt b/collects/typed-scheme/private/base-env-indexing.rkt
index 23b72c05..04035590 100644
--- a/collects/typed-scheme/private/base-env-indexing.rkt
+++ b/collects/typed-scheme/private/base-env-indexing.rkt
@@ -1,11 +1,12 @@
-#lang scheme
+#lang racket/base
 
 (require
  (rename-in "../utils/utils.rkt" [infer r:infer])
- (for-syntax (types abbrev) (env init-envs) (r:infer infer-dummy infer)
-             "base-env-indexing-abs.rkt"))
+ (types abbrev) (env init-envs) (r:infer infer-dummy infer)
+ "base-env-indexing-abs.rkt")
 
-(define-for-syntax e (parameterize ([infer-param infer]) (indexing -Integer)))
-(begin-for-syntax (initialize-type-env e))
+(define e (parameterize ([infer-param infer]) (indexing -Integer)))
+(define (initialize-indexing) (initialize-type-env e))
+(provide initialize-indexing)
 
 
diff --git a/collects/typed-scheme/private/base-env.rkt b/collects/typed-scheme/private/base-env.rkt
index dfa13622..c4347f7c 100644
--- a/collects/typed-scheme/private/base-env.rkt
+++ b/collects/typed-scheme/private/base-env.rkt
@@ -11,8 +11,7 @@
  "extra-procs.rkt"
  (only-in '#%kernel [apply kernel:apply])
  (only-in racket/private/pre-base new-apply-proc)
- (for-syntax (only-in racket/private/pre-base new-apply-proc)
-             #;racket/string)
+ (for-syntax (only-in racket/private/pre-base new-apply-proc))
  scheme/promise scheme/system
  racket/mpair
  (only-in string-constants/private/only-once maybe-print-message)
diff --git a/collects/typed-scheme/private/base-special-env.rkt b/collects/typed-scheme/private/base-special-env.rkt
index 02c33f62..95d47db7 100644
--- a/collects/typed-scheme/private/base-special-env.rkt
+++ b/collects/typed-scheme/private/base-special-env.rkt
@@ -1,16 +1,10 @@
 #lang racket/base
 
-;; these are libraries providing functions we add types to that are not in scheme/base
+;; this file cheats to define types for unexported variables that are expanded into by Racket macros
 (require
- "extra-procs.rkt"
  "../utils/utils.rkt"
- (only-in scheme/list cons? take drop add-between last filter-map)
- (only-in rnrs/lists-6 fold-left)
- '#%paramz
- (only-in racket/match/runtime match:error)
- scheme/promise
- string-constants/string-constant
- ;(prefix-in ce: test-engine/scheme-tests)
+ racket/promise
+ string-constants/string-constant 
  (for-syntax
   scheme/base syntax/parse
   (only-in unstable/syntax syntax-local-eval)
@@ -18,137 +12,42 @@
   (env init-envs)          
   (except-in (rep filter-rep object-rep type-rep) make-arr)
   (types convenience union)
-  (only-in (types convenience) [make-arr* make-arr])          
-  (typecheck tc-structs))
- (for-meta 2 scheme/base syntax/parse))
-
-
-(define-for-syntax (initialize-others)
-
-  (define-syntax define-hierarchy
-    (syntax-rules (define-hierarchy)
-      [(_ parent ([name : type] ...)
-          (define-hierarchy child (spec ...) grand ...)
-          ...)
-       (begin
-         (d-s parent ([name : type] ...))
-         (define-sub-hierarchy [child parent] (type ...) (spec ...) grand ...)
-         ...)]))
-
-  (define-syntax define-sub-hierarchy
-    (syntax-rules (define-hierarchy)
-      [(_ [child parent] (inheritance ...) ([name : type] ...)
-          (define-hierarchy grandchild (spec ...) great ...)
-          ...)
-       (begin
-         (d-s [child parent] ([name : type] ...) (inheritance ...))
-         (define-sub-hierarchy [grandchild child]
-           (inheritance ... type ...) (spec ...)
-           great
-           ...)
-         ...)]))
-
-  (define-hierarchy srcloc
-    ([source : Univ]
-     [line : (*Un -Integer (-val #f))]
-     [column : (*Un -Integer (-val #f))]
-     [position : (*Un -Integer (-val #f))]
-     [span : (*Un -Integer (-val #f))]))
-
-  (define-hierarchy date 
-    ([second : -Number]
-     [minute : -Number]
-     [hour : -Number]
-     [day : -Number]
-     [month : -Number] 
-     [year : -Number]
-     [weekday : -Number]
-     [year-day : -Number]
-     [dst? : -Boolean]
-     [time-zone-offset : -Number]))
-  
-  (define-hierarchy arity-at-least
-    ([value : -Nat]))
-
-  (define-hierarchy exn
-    ([message : -String] [continuation-marks : -Cont-Mark-Set])
-    
-    (define-hierarchy exn:break ([continuation : top-func]))
-
-    (define-hierarchy exn:fail ()
-
-      (define-hierarchy exn:fail:contract ()
-        (define-hierarchy exn:fail:contract:arity ())
-        (define-hierarchy exn:fail:contract:divide-by-zero ())
-        (define-hierarchy exn:fail:contract:non-fixnum-result ())
-        (define-hierarchy exn:fail:contract:continuation ())
-        (define-hierarchy exn:fail:contract:variable ()))
-
-      (define-hierarchy exn:fail:syntax ([exprs : (-lst (-Syntax Univ))]))
-
-      (define-hierarchy exn:fail:read
-        ([srclocs : (-lst Univ)]) ;; cce: Univ here should be srcloc
-        (define-hierarchy exn:fail:read:eof ())
-        (define-hierarchy exn:fail:read:non-char ()))
-
-      (define-hierarchy exn:fail:filesystem ()
-        (define-hierarchy exn:fail:filesystem:exists ())
-        (define-hierarchy exn:fail:filesystem:version ()))
-
-      (define-hierarchy exn:fail:network ())
-
-      (define-hierarchy exn:fail:out-of-memory ())
-
-      (define-hierarchy exn:fail:unsupported ())
-
-      (define-hierarchy exn:fail:user ())))
-
-  ;; cce: adding exn:break would require a generic type for continuations
-
-  )
-
-(provide (for-syntax initial-env/special-case initialize-others initialize-type-env)
-         define-initial-env)
+  (only-in (types convenience) [make-arr* make-arr])))
 
 (define-syntax (define-initial-env stx)
-    (syntax-case stx ()
-      [(_ initial-env make-promise-ty language-ty qq-append-ty
-          [id-expr ty] ...)
-       (with-syntax ([(_ make-promise . _)
-                      (local-expand #'(delay 3)
-                                    'expression
-                                    null)]
-                     [language
-                      (local-expand #'(this-language)
-                                    'expression
-                                    null)]
-                     [(_ qq-append . _)
-                      (local-expand #'`(,@'() 1)
-                                    'expression
-                                    null)]
-                     [(id ...)
-                      (for/list ([expr (syntax->list #'(id-expr ...))])
-                        (syntax-local-eval expr))])
-         #`(define-for-syntax initial-env
+  (syntax-parse stx
+    [(_ initialize-env [id-expr ty] ...)
+     (with-syntax ([(id ...)
+                    (for/list ([expr (syntax->list #'(id-expr ...))])
+                      (syntax-local-eval expr))])
+       #`(begin
+           (define-for-syntax initial-env
              (make-env
-              [make-promise make-promise-ty]
-              [language language-ty]
-              [qq-append qq-append-ty]
-              [id ty] ...)))]))
+              [id ty] ...))
+           (define-for-syntax (initialize-env)
+             (initialize-type-env initial-env))
+           (provide (for-syntax initialize-env))))]))
 
 
-
-
-(define-initial-env initial-env/special-case
+(define-initial-env initialize-special
   ;; make-promise
-  (-poly (a) (-> (-> a) (-Promise a)))
+  [(syntax-parse (local-expand #'(delay 3) 'expression null)
+     #:context #'make-promise
+     [(_ mp . _) #'mp])
+   (-poly (a) (-> (-> a) (-Promise a)))]
   ;; language
-  -Symbol
+  [(syntax-parse (local-expand #'(this-language) 'expression null)
+     #:context #'language
+     [lang #'lang])
+   -Symbol]
   ;; qq-append
-  (-poly (a b) 
+  [(syntax-parse (local-expand #'`(,@'() 1) 'expression null)
+     #:context #'qq-append
+     [(_ qqa . _) #'qqa])
+   (-poly (a b) 
          (cl->*
           (-> (-lst a) (-val '()) (-lst a))
-          (-> (-lst a) (-lst b) (-lst (*Un a b)))))
+          (-> (-lst a) (-lst b) (-lst (*Un a b)))))]
   ;; make-sequence
   [(syntax-parse (local-expand #'(for ([x '()]) x) 'expression #f)
      #:context #'make-sequence
@@ -234,12 +133,3 @@
       #'i-n])
    (->opt [-Input-Port -Symbol] (-seq -Bytes))])
 
-
-
-
-(begin-for-syntax   
-  (initialize-type-env initial-env/special-case)
-  (initialize-others))
-
-
-
diff --git a/collects/typed-scheme/private/base-structs.rkt b/collects/typed-scheme/private/base-structs.rkt
new file mode 100644
index 00000000..03bcb0f3
--- /dev/null
+++ b/collects/typed-scheme/private/base-structs.rkt
@@ -0,0 +1,99 @@
+#lang racket/base
+
+(require 
+ "../utils/utils.rkt"
+ (utils tc-utils)
+ (env init-envs)          
+ (except-in (rep filter-rep object-rep type-rep) make-arr)
+ (types convenience union)
+ (only-in (types convenience) [make-arr* make-arr])          
+ (typecheck tc-structs))
+
+(require (for-template racket/base))
+
+(provide initialize-structs)
+
+(define-syntax define-hierarchy
+  (syntax-rules (define-hierarchy)
+    [(_ parent ([name : type] ...)
+        (define-hierarchy child (spec ...) grand ...)
+        ...)
+     (begin
+       (d-s parent ([name : type] ...))
+       (define-sub-hierarchy [child parent] (type ...) (spec ...) grand ...)
+       ...)]))
+
+(define-syntax define-sub-hierarchy
+  (syntax-rules (define-hierarchy)
+    [(_ [child parent] (inheritance ...) ([name : type] ...)
+        (define-hierarchy grandchild (spec ...) great ...)
+        ...)
+     (begin
+       (d-s [child parent] ([name : type] ...) (inheritance ...))
+       (define-sub-hierarchy [grandchild child]
+         (inheritance ... type ...) (spec ...)
+         great
+         ...)
+       ...)]))
+
+
+(define (initialize-structs)
+  
+
+  (define-hierarchy srcloc
+    ([source : Univ]
+     [line : (*Un -Integer (-val #f))]
+     [column : (*Un -Integer (-val #f))]
+     [position : (*Un -Integer (-val #f))]
+     [span : (*Un -Integer (-val #f))]))
+
+  (define-hierarchy date 
+    ([second : -Number]
+     [minute : -Number]
+     [hour : -Number]
+     [day : -Number]
+     [month : -Number] 
+     [year : -Number]
+     [weekday : -Number]
+     [year-day : -Number]
+     [dst? : -Boolean]
+     [time-zone-offset : -Number]))
+  
+  (define-hierarchy arity-at-least
+    ([value : -Nat]))
+
+  (define-hierarchy exn
+    ([message : -String] [continuation-marks : -Cont-Mark-Set])
+    
+    (define-hierarchy exn:break ([continuation : top-func]))
+
+    (define-hierarchy exn:fail ()
+
+      (define-hierarchy exn:fail:contract ()
+        (define-hierarchy exn:fail:contract:arity ())
+        (define-hierarchy exn:fail:contract:divide-by-zero ())
+        (define-hierarchy exn:fail:contract:non-fixnum-result ())
+        (define-hierarchy exn:fail:contract:continuation ())
+        (define-hierarchy exn:fail:contract:variable ()))
+
+      (define-hierarchy exn:fail:syntax ([exprs : (-lst (-Syntax Univ))]))
+
+      (define-hierarchy exn:fail:read
+        ([srclocs : (-lst Univ)]) ;; cce: Univ here should be srcloc
+        (define-hierarchy exn:fail:read:eof ())
+        (define-hierarchy exn:fail:read:non-char ()))
+
+      (define-hierarchy exn:fail:filesystem ()
+        (define-hierarchy exn:fail:filesystem:exists ())
+        (define-hierarchy exn:fail:filesystem:version ()))
+
+      (define-hierarchy exn:fail:network ())
+
+      (define-hierarchy exn:fail:out-of-memory ())
+
+      (define-hierarchy exn:fail:unsupported ())
+
+      (define-hierarchy exn:fail:user ())))
+
+  ;; cce: adding exn:break would require a generic type for continuations
+  )
\ No newline at end of file
diff --git a/collects/typed-scheme/typed-scheme.rkt b/collects/typed-scheme/typed-scheme.rkt
index 88f1e416..5ef1eef9 100644
--- a/collects/typed-scheme/typed-scheme.rkt
+++ b/collects/typed-scheme/typed-scheme.rkt
@@ -1,6 +1,11 @@
 #lang racket/base
 
-(require (for-syntax racket/base "typecheck/renamer.rkt"))
+(require (for-syntax racket/base "typecheck/renamer.rkt")
+         "private/base-special-env.rkt"
+         "private/base-env.rkt"
+         "private/base-env-numeric.rkt")
+
+(begin-for-syntax (initialize-special))
 
 (provide (rename-out [module-begin #%module-begin]
                      [top-interaction #%top-interaction]
@@ -10,15 +15,16 @@
          with-type)
 
 (define-syntax (module-begin stx)
-  (dynamic-require 'typed-scheme/private/base-env #f)
-  (dynamic-require 'typed-scheme/private/base-env-numeric #f)
-  (dynamic-require 'typed-scheme/private/base-env-indexing #f)
+  ((dynamic-require 'typed-scheme/private/base-structs 'initialize-structs))
+  ((dynamic-require 'typed-scheme/private/base-env-indexing 'initialize-indexing))
   ((dynamic-require 'typed-scheme/core 'mb-core) stx))
 
 (define-syntax (top-interaction stx)
+  ((dynamic-require 'typed-scheme/private/base-structs 'initialize-structs))
   ((dynamic-require 'typed-scheme/core 'ti-core) stx))
 
 (define-syntax (with-type stx)
+  ((dynamic-require 'typed-scheme/private/base-structs 'initialize-structs))
   ((dynamic-require 'typed-scheme/core 'wt-core) stx))
 
 

From e717d29b74f0ded66091f97de338320101154855 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 8 Sep 2010 19:27:07 -0400
Subject: [PATCH 115/198] Lots more laziness, and useless require removal.

original commit: b6b840076b275d653843400f18259bf7f67c7a53
---
 .../unit-tests/typecheck-tests.rkt            | 10 +--
 collects/typed-scheme/env/init-envs.rkt       |  2 +-
 collects/typed-scheme/env/type-alias-env.rkt  |  2 +-
 .../typed-scheme/env/type-env-structs.rkt     |  2 +-
 .../typed-scheme/infer/constraint-structs.rkt |  2 +-
 collects/typed-scheme/infer/constraints.rkt   |  2 +-
 collects/typed-scheme/infer/dmap.rkt          |  2 +-
 collects/typed-scheme/infer/infer-unit.rkt    |  8 +-
 .../typed-scheme/infer/promote-demote.rkt     |  2 +-
 collects/typed-scheme/infer/restrict.rkt      |  2 +-
 collects/typed-scheme/optimizer/apply.rkt     |  2 +-
 collects/typed-scheme/optimizer/box.rkt       |  2 +-
 collects/typed-scheme/optimizer/float.rkt     |  4 +-
 .../optimizer/inexact-complex.rkt             |  2 +-
 collects/typed-scheme/optimizer/number.rkt    |  2 +-
 collects/typed-scheme/optimizer/optimizer.rkt |  2 +-
 collects/typed-scheme/optimizer/pair.rkt      |  2 +-
 collects/typed-scheme/optimizer/sequence.rkt  |  2 +-
 collects/typed-scheme/optimizer/string.rkt    |  2 +-
 collects/typed-scheme/optimizer/struct.rkt    |  2 +-
 .../typed-scheme/optimizer/unboxed-let.rkt    |  2 +-
 collects/typed-scheme/optimizer/utils.rkt     |  4 +-
 collects/typed-scheme/optimizer/vector.rkt    |  4 +-
 .../private/base-env-indexing-abs.rkt         | 25 ++++---
 .../typed-scheme/private/base-env-numeric.rkt | 73 ++++++++-----------
 collects/typed-scheme/private/base-env.rkt    | 43 ++++++-----
 .../typed-scheme/private/base-special-env.rkt | 14 ++--
 collects/typed-scheme/private/env-lang.rkt    | 29 ++++----
 collects/typed-scheme/private/parse-type.rkt  |  2 +-
 collects/typed-scheme/private/prims.rkt       | 21 ++----
 .../typed-scheme/private/type-annotation.rkt  |  2 +-
 .../typed-scheme/private/type-contract.rkt    |  2 +-
 collects/typed-scheme/private/with-types.rkt  |  3 +-
 collects/typed-scheme/rep/filter-rep.rkt      |  2 +-
 collects/typed-scheme/rep/object-rep.rkt      |  2 +-
 collects/typed-scheme/rep/rep-utils.rkt       |  4 +-
 collects/typed-scheme/rep/type-rep.rkt        |  2 +-
 .../typecheck/check-subforms-unit.rkt         |  2 +-
 .../typecheck/find-annotation.rkt             |  2 +-
 .../typecheck/provide-handling.rkt            |  2 +-
 .../typed-scheme/typecheck/tc-app-helper.rkt  |  2 +-
 collects/typed-scheme/typecheck/tc-envops.rkt |  2 +-
 .../typed-scheme/typecheck/tc-expr-unit.rkt   |  2 +-
 .../typed-scheme/typecheck/tc-lambda-unit.rkt |  2 +-
 .../typecheck/tc-metafunctions.rkt            |  2 +-
 .../typed-scheme/typecheck/tc-structs.rkt     |  2 +-
 collects/typed-scheme/typecheck/tc-subst.rkt  |  2 +-
 .../typed-scheme/typecheck/tc-toplevel.rkt    |  2 +-
 collects/typed-scheme/typed-scheme.rkt        | 19 +++--
 collects/typed-scheme/types/abbrev.rkt        | 18 ++---
 collects/typed-scheme/types/filter-ops.rkt    |  4 +-
 .../typed-scheme/types/remove-intersect.rkt   |  2 +-
 collects/typed-scheme/types/resolve.rkt       |  2 +-
 collects/typed-scheme/types/substitute.rkt    |  2 +-
 collects/typed-scheme/types/subtype.rkt       | 11 ++-
 collects/typed-scheme/types/type-table.rkt    |  4 +-
 collects/typed-scheme/types/union.rkt         |  7 +-
 collects/typed-scheme/types/utils.rkt         | 16 ++--
 collects/typed-scheme/utils/any-wrap.rkt      |  2 +-
 .../typed-scheme/utils/require-contract.rkt   |  2 -
 collects/typed-scheme/utils/tc-utils.rkt      |  6 +-
 collects/typed-scheme/utils/utils.rkt         | 10 +--
 62 files changed, 201 insertions(+), 216 deletions(-)

diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
index 75f94b57..249ae7ef 100644
--- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
+++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
@@ -3,9 +3,9 @@
 (require "test-utils.ss"
          (for-syntax scheme/base)
          (for-template scheme/base))
-(require (private base-env prims type-annotation 
+(require (private #;base-env prims type-annotation 
 		  base-types-extra
-		  base-env-numeric
+		  #;base-env-numeric
 		  base-env-indexing
                   parse-type)
 	 (typecheck typechecker)
@@ -24,10 +24,10 @@
          (for-syntax (utils tc-utils)
                      (typecheck typechecker)
 	             (env global-env)
-	             (private base-env base-env-numeric
+	             (private #;base-env #;base-env-numeric
 			      base-env-indexing))
-         (for-template (private base-env base-types base-types-extra
-				base-env-numeric
+         (for-template (private #;base-env base-types base-types-extra
+				#;base-env-numeric
 				base-env-indexing))
          (for-syntax syntax/kerncase syntax/parse))
 
diff --git a/collects/typed-scheme/env/init-envs.rkt b/collects/typed-scheme/env/init-envs.rkt
index d9a3729c..3a39da0b 100644
--- a/collects/typed-scheme/env/init-envs.rkt
+++ b/collects/typed-scheme/env/init-envs.rkt
@@ -10,7 +10,7 @@
 		       (types union)
 		       mzlib/pconvert mzlib/shared scheme/base)
 	 (types union convenience)         
-	 mzlib/pconvert scheme/match mzlib/shared)
+	 mzlib/pconvert racket/match mzlib/shared)
 
 (define (initialize-type-name-env initial-type-names)
   (for-each (lambda (nm/ty) (register-resolved-type-alias (car nm/ty) (cadr nm/ty))) initial-type-names))
diff --git a/collects/typed-scheme/env/type-alias-env.rkt b/collects/typed-scheme/env/type-alias-env.rkt
index 05547eec..35e88063 100644
--- a/collects/typed-scheme/env/type-alias-env.rkt
+++ b/collects/typed-scheme/env/type-alias-env.rkt
@@ -4,7 +4,7 @@
 	 syntax/boundmap
          (utils tc-utils)
          mzlib/trace
-         scheme/match)
+         racket/match)
 
 (provide register-type-alias
          lookup-type-alias
diff --git a/collects/typed-scheme/env/type-env-structs.rkt b/collects/typed-scheme/env/type-env-structs.rkt
index ccedb246..6cb5a6fe 100644
--- a/collects/typed-scheme/env/type-env-structs.rkt
+++ b/collects/typed-scheme/env/type-env-structs.rkt
@@ -2,7 +2,7 @@
 
 (require scheme/contract unstable/sequence racket/dict syntax/id-table
          (prefix-in r: "../utils/utils.rkt")
-         scheme/match (r:rep filter-rep rep-utils type-rep) unstable/struct
+         racket/match (r:rep filter-rep rep-utils type-rep) unstable/struct
          (except-in (r:utils tc-utils) make-env))
 
 (provide extend
diff --git a/collects/typed-scheme/infer/constraint-structs.rkt b/collects/typed-scheme/infer/constraint-structs.rkt
index 82e65033..395bc2f4 100644
--- a/collects/typed-scheme/infer/constraint-structs.rkt
+++ b/collects/typed-scheme/infer/constraint-structs.rkt
@@ -1,6 +1,6 @@
 #lang scheme/base
 
-(require "../utils/utils.rkt" (rep type-rep) scheme/contract scheme/match (for-syntax scheme/base syntax/parse))
+(require "../utils/utils.rkt" (rep type-rep) scheme/contract racket/match (for-syntax scheme/base syntax/parse))
 
 ;; S, T types
 ;; X a var
diff --git a/collects/typed-scheme/infer/constraints.rkt b/collects/typed-scheme/infer/constraints.rkt
index 444ddca9..6d6c6f30 100644
--- a/collects/typed-scheme/infer/constraints.rkt
+++ b/collects/typed-scheme/infer/constraints.rkt
@@ -6,7 +6,7 @@
 	 (utils tc-utils)
 	 unstable/sequence unstable/hash
          "signatures.rkt" "constraint-structs.rkt"
-         scheme/match)
+         racket/match)
 
 (import restrict^ dmap^)
 (export constraints^)
diff --git a/collects/typed-scheme/infer/dmap.rkt b/collects/typed-scheme/infer/dmap.rkt
index c76702bf..52022f12 100644
--- a/collects/typed-scheme/infer/dmap.rkt
+++ b/collects/typed-scheme/infer/dmap.rkt
@@ -3,7 +3,7 @@
 (require "../utils/utils.rkt" 
 	 "signatures.rkt" "constraint-structs.rkt"
 	 (utils tc-utils) racket/contract
-	 unstable/sequence unstable/hash scheme/match)
+	 unstable/sequence unstable/hash racket/match)
 
 (import constraints^)
 (export dmap^)
diff --git a/collects/typed-scheme/infer/infer-unit.rkt b/collects/typed-scheme/infer/infer-unit.rkt
index c177d37c..813fa321 100644
--- a/collects/typed-scheme/infer/infer-unit.rkt
+++ b/collects/typed-scheme/infer/infer-unit.rkt
@@ -1,6 +1,6 @@
-#lang scheme/unit
+#lang racket/unit
 
-(require scheme/require (path-up "utils/utils.rkt")
+(require racket/require (path-up "utils/utils.rkt")
          (except-in 
           (combine-in
            (utils tc-utils)
@@ -11,11 +11,11 @@
           make-env -> ->* one-of/c)
          "constraint-structs.rkt"
 	 "signatures.rkt"                  
-         scheme/match
+         racket/match
          mzlib/etc
          racket/trace racket/contract
 	 unstable/sequence unstable/list unstable/debug unstable/hash
-         scheme/list)
+         racket/list)
 
 (import dmap^ constraints^ promote-demote^)
 (export infer^)
diff --git a/collects/typed-scheme/infer/promote-demote.rkt b/collects/typed-scheme/infer/promote-demote.rkt
index 334eecc7..eee913af 100644
--- a/collects/typed-scheme/infer/promote-demote.rkt
+++ b/collects/typed-scheme/infer/promote-demote.rkt
@@ -4,7 +4,7 @@
 (require (rep type-rep rep-utils)
 	 (types convenience union utils)
          "signatures.rkt"
-         scheme/list scheme/match)
+         scheme/list racket/match)
 
 (import)
 (export promote-demote^)
diff --git a/collects/typed-scheme/infer/restrict.rkt b/collects/typed-scheme/infer/restrict.rkt
index 9664ee4b..e09f0ac3 100644
--- a/collects/typed-scheme/infer/restrict.rkt
+++ b/collects/typed-scheme/infer/restrict.rkt
@@ -4,7 +4,7 @@
 (require (rep type-rep)
 	 (types utils union subtype remove-intersect resolve substitute)
          "signatures.rkt"
-         scheme/match mzlib/trace)
+         racket/match mzlib/trace)
 
 (import infer^)
 (export restrict^)
diff --git a/collects/typed-scheme/optimizer/apply.rkt b/collects/typed-scheme/optimizer/apply.rkt
index d2675175..7ed6191c 100644
--- a/collects/typed-scheme/optimizer/apply.rkt
+++ b/collects/typed-scheme/optimizer/apply.rkt
@@ -1,7 +1,7 @@
 #lang scheme/base
 (require syntax/parse
          syntax/id-table racket/dict
-         unstable/match scheme/match
+         unstable/match racket/match
          (for-template scheme/unsafe/ops racket/base (prefix-in k: '#%kernel))
          (for-syntax racket/base)
          "../utils/utils.rkt"
diff --git a/collects/typed-scheme/optimizer/box.rkt b/collects/typed-scheme/optimizer/box.rkt
index 483741fa..a54d8d1b 100644
--- a/collects/typed-scheme/optimizer/box.rkt
+++ b/collects/typed-scheme/optimizer/box.rkt
@@ -1,7 +1,7 @@
 #lang scheme/base
 
 (require syntax/parse
-         unstable/match scheme/match
+         unstable/match racket/match
          "../utils/utils.rkt"
          (for-template scheme/base scheme/fixnum scheme/unsafe/ops)
          (rep type-rep)
diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-scheme/optimizer/float.rkt
index d31beb50..386f69da 100644
--- a/collects/typed-scheme/optimizer/float.rkt
+++ b/collects/typed-scheme/optimizer/float.rkt
@@ -1,8 +1,8 @@
 #lang scheme/base
 
 (require syntax/parse
-         syntax/id-table racket/dict scheme/flonum
-         (for-template scheme/base scheme/flonum scheme/unsafe/ops)
+         syntax/id-table racket/dict racket/flonum
+         (for-template scheme/base racket/flonum scheme/unsafe/ops)
          "../utils/utils.rkt"
          (types abbrev type-table utils subtype)
          (optimizer utils fixnum))
diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt
index 86ebf002..5bade6cc 100644
--- a/collects/typed-scheme/optimizer/inexact-complex.rkt
+++ b/collects/typed-scheme/optimizer/inexact-complex.rkt
@@ -2,7 +2,7 @@
 
 (require syntax/parse syntax/id-table scheme/dict
          "../utils/utils.rkt" racket/unsafe/ops
-         (for-template scheme/base scheme/math scheme/flonum scheme/unsafe/ops)
+         (for-template scheme/base scheme/math racket/flonum scheme/unsafe/ops)
          (types abbrev type-table utils subtype)
          (optimizer utils float fixnum))
 
diff --git a/collects/typed-scheme/optimizer/number.rkt b/collects/typed-scheme/optimizer/number.rkt
index 40b24875..5e051571 100644
--- a/collects/typed-scheme/optimizer/number.rkt
+++ b/collects/typed-scheme/optimizer/number.rkt
@@ -1,7 +1,7 @@
 #lang scheme/base
 
 (require syntax/parse
-         (for-template scheme/base scheme/flonum scheme/unsafe/ops)
+         (for-template scheme/base racket/flonum scheme/unsafe/ops)
          "../utils/utils.rkt"
          (optimizer utils))
 
diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt
index 90bb70f7..d0e9550b 100644
--- a/collects/typed-scheme/optimizer/optimizer.rkt
+++ b/collects/typed-scheme/optimizer/optimizer.rkt
@@ -4,7 +4,7 @@
          syntax/id-table racket/dict
          racket/pretty
          (for-template scheme/base
-                       scheme/flonum scheme/fixnum scheme/unsafe/ops
+                       racket/flonum scheme/fixnum scheme/unsafe/ops
                        racket/private/for)
          "../utils/utils.rkt"
          (types abbrev type-table utils subtype)
diff --git a/collects/typed-scheme/optimizer/pair.rkt b/collects/typed-scheme/optimizer/pair.rkt
index 8245c3c9..8bab0ab7 100644
--- a/collects/typed-scheme/optimizer/pair.rkt
+++ b/collects/typed-scheme/optimizer/pair.rkt
@@ -2,7 +2,7 @@
 
 (require syntax/parse
          syntax/id-table racket/dict
-         unstable/match scheme/match
+         unstable/match racket/match
          (for-template scheme/base scheme/unsafe/ops)
          "../utils/utils.rkt"
          (rep type-rep)
diff --git a/collects/typed-scheme/optimizer/sequence.rkt b/collects/typed-scheme/optimizer/sequence.rkt
index ac8f49aa..3d333acf 100644
--- a/collects/typed-scheme/optimizer/sequence.rkt
+++ b/collects/typed-scheme/optimizer/sequence.rkt
@@ -2,7 +2,7 @@
 
 (require syntax/parse
          syntax/id-table racket/dict
-         unstable/match scheme/match
+         unstable/match racket/match
          (for-template scheme/base scheme/unsafe/ops)
          "../utils/utils.rkt" "../utils/tc-utils.rkt"
          (rep type-rep)
diff --git a/collects/typed-scheme/optimizer/string.rkt b/collects/typed-scheme/optimizer/string.rkt
index 0d8575ca..18f09bee 100644
--- a/collects/typed-scheme/optimizer/string.rkt
+++ b/collects/typed-scheme/optimizer/string.rkt
@@ -1,7 +1,7 @@
 #lang scheme/base
 
 (require syntax/parse
-         (for-template scheme/base scheme/flonum scheme/unsafe/ops)
+         (for-template scheme/base racket/flonum scheme/unsafe/ops)
          "../utils/utils.rkt"
          (types abbrev type-table utils subtype)
          (optimizer utils))
diff --git a/collects/typed-scheme/optimizer/struct.rkt b/collects/typed-scheme/optimizer/struct.rkt
index 77ee71b1..48b02f07 100644
--- a/collects/typed-scheme/optimizer/struct.rkt
+++ b/collects/typed-scheme/optimizer/struct.rkt
@@ -2,7 +2,7 @@
 
 (require syntax/parse
          syntax/id-table racket/dict
-         unstable/match scheme/match
+         unstable/match racket/match
          (for-template scheme/base scheme/unsafe/ops)
          "../utils/utils.rkt"
          (rep type-rep)
diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index 34d16c33..c8baa000 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -1,7 +1,7 @@
 #lang scheme/base
 
 (require syntax/parse
-         scheme/list scheme/dict scheme/match
+         scheme/list scheme/dict racket/match
          "../utils/utils.rkt"
          "../utils/tc-utils.rkt"
          (for-template scheme/base)
diff --git a/collects/typed-scheme/optimizer/utils.rkt b/collects/typed-scheme/optimizer/utils.rkt
index d36b92e2..49c2765a 100644
--- a/collects/typed-scheme/optimizer/utils.rkt
+++ b/collects/typed-scheme/optimizer/utils.rkt
@@ -1,8 +1,8 @@
 #lang scheme/base
 
-(require unstable/match scheme/match
+(require unstable/match racket/match
          racket/dict syntax/id-table unstable/syntax
-         (for-template scheme/base scheme/flonum scheme/fixnum scheme/unsafe/ops)
+         (for-template scheme/base racket/flonum scheme/fixnum scheme/unsafe/ops)
          "../utils/utils.rkt"
          (types abbrev type-table utils subtype)
          (rep type-rep))
diff --git a/collects/typed-scheme/optimizer/vector.rkt b/collects/typed-scheme/optimizer/vector.rkt
index e3386903..dff88f05 100644
--- a/collects/typed-scheme/optimizer/vector.rkt
+++ b/collects/typed-scheme/optimizer/vector.rkt
@@ -1,8 +1,8 @@
 #lang scheme/base
 
 (require syntax/parse
-         unstable/match scheme/match
-         (for-template scheme/base scheme/flonum scheme/unsafe/ops)
+         unstable/match racket/match
+         (for-template scheme/base racket/flonum scheme/unsafe/ops)
          "../utils/utils.rkt"
          (rep type-rep)
          (types abbrev type-table utils subtype)
diff --git a/collects/typed-scheme/private/base-env-indexing-abs.rkt b/collects/typed-scheme/private/base-env-indexing-abs.rkt
index c4c852d2..c99ba38f 100644
--- a/collects/typed-scheme/private/base-env-indexing-abs.rkt
+++ b/collects/typed-scheme/private/base-env-indexing-abs.rkt
@@ -1,18 +1,19 @@
 #lang racket
 
 (require
- "../utils/utils.rkt"
- racket/tcp 
- (only-in rnrs/lists-6 fold-left)
- '#%paramz
- "extra-procs.rkt"
- (utils tc-utils )
- (types  union convenience)
- (only-in '#%kernel [apply kernel:apply])
- racket/promise racket/system
- (only-in string-constants/private/only-once maybe-print-message)
- (only-in racket/match/runtime match:error matchable? match-equality-test)
- (for-template racket racket/unsafe/ops)
+ "../utils/utils.rkt" 
+ (for-template '#%paramz racket/base racket/list
+               racket/tcp 
+               (only-in rnrs/lists-6 fold-left)
+               '#%paramz
+               "extra-procs.rkt"
+               (only-in '#%kernel [apply kernel:apply])
+               racket/promise racket/system
+               (only-in string-constants/private/only-once maybe-print-message)
+               (only-in racket/match/runtime match:error matchable? match-equality-test)
+               racket/unsafe/ops)
+ (utils tc-utils)
+ (types union convenience) 
  (rename-in (types abbrev) [-Number N] [-Boolean B] [-Symbol Sym]))
 
 (provide indexing)
diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt
index 07701808..04806992 100644
--- a/collects/typed-scheme/private/base-env-numeric.rkt
+++ b/collects/typed-scheme/private/base-env-numeric.rkt
@@ -2,24 +2,15 @@
 
 (begin
   (require
-   scheme/tcp
-   scheme scheme/flonum scheme/fixnum
-   scheme/unsafe/ops
-   (only-in rnrs/lists-6 fold-left)
-   '#%paramz
-   "extra-procs.rkt"
-   (only-in '#%kernel [apply kernel:apply])
-   scheme/promise scheme/system
-   (only-in string-constants/private/only-once maybe-print-message)
-   (only-in racket/match/runtime match:error matchable? match-equality-test)
-   (for-syntax (only-in (types abbrev) [-Number N] [-Boolean B] [-Symbol Sym] [-Real R] [-ExactPositiveInteger -Pos])))
+   (for-template racket/flonum racket/fixnum racket/math racket/unsafe/ops racket/base)
+   (only-in (types abbrev) [-Number N] [-Boolean B] [-Symbol Sym] [-Real R] [-ExactPositiveInteger -Pos]))
   
-  (define-for-syntax all-num-types (list -Pos -Nat -Integer -ExactRational -Flonum -Real N))
+  (define all-num-types (list -Pos -Nat -Integer -ExactRational -Flonum -Real N))
 
-  (define-for-syntax binop 
+  (define binop 
     (lambda (t [r t])
       (t t . -> . r)))
-  (define-for-syntax rounder 
+  (define rounder 
     (cl->* (-> -PositiveFixnum -PositiveFixnum)
            (-> -NonnegativeFixnum -NonnegativeFixnum)
            (-> -Fixnum -Fixnum)
@@ -30,37 +21,37 @@
            (-> -Flonum -Flonum)
            (-> -Real -Real)))
   
-  (define-for-syntax (unop t) (-> t t))
+  (define (unop t) (-> t t))
   
-  (define-for-syntax fl-comp (binop -Flonum B))
-  (define-for-syntax fl-op (binop -Flonum))
-  (define-for-syntax fl-unop (unop -Flonum))
-  (define-for-syntax fl-rounder
+  (define fl-comp (binop -Flonum B))
+  (define fl-op (binop -Flonum))
+  (define fl-unop (unop -Flonum))
+  (define fl-rounder
     (cl->* (-> -NonnegativeFlonum -NonnegativeFlonum)
            (-> -Flonum -Flonum)))
   
-  (define-for-syntax int-op (binop -Integer))
-  (define-for-syntax nat-op (binop -Nat))
+  (define int-op (binop -Integer))
+  (define nat-op (binop -Nat))
   
-  (define-for-syntax fx-comp (binop -Integer B))
-  (define-for-syntax fx-op (cl->* (-Pos -Pos . -> . -PositiveFixnum)
+  (define fx-comp (binop -Integer B))
+  (define fx-op (cl->* (-Pos -Pos . -> . -PositiveFixnum)
                                   (-Nat -Nat . -> . -NonnegativeFixnum)
                                   (-Integer -Integer . -> . -Fixnum)))
-  (define-for-syntax fx-natop (cl->* (-Nat -Nat . -> . -NonnegativeFixnum)
+  (define fx-natop (cl->* (-Nat -Nat . -> . -NonnegativeFixnum)
                                      (-Integer -Integer . -> . -Fixnum)))
-  (define-for-syntax fx-unop (-Integer . -> . -Fixnum))
+  (define fx-unop (-Integer . -> . -Fixnum))
 
-  (define-for-syntax real-comp (->* (list R R) R B))
+  (define real-comp (->* (list R R) R B))
 
   ;; types for specific operations, to avoid repetition between safe and unsafe versions
-  (define-for-syntax fx+-type
+  (define fx+-type
     (cl->* (-Pos -Nat . -> . -PositiveFixnum)
            (-Nat -Pos . -> . -PositiveFixnum)
            (-Nat -Nat . -> . -NonnegativeFixnum)
            (-Integer -Integer . -> . -Fixnum)))
-  (define-for-syntax fx--type
+  (define fx--type
     (-Integer -Integer . -> . -Fixnum))
-  (define-for-syntax fx=-type
+  (define fx=-type
     (cl->*
      (-> -Integer (-val 0) B : (-FS (-filter (-val 0) 0) -top))
      (-> (-val 0) -Integer B : (-FS (-filter (-val 0) 1) -top))
@@ -71,40 +62,40 @@
      (-> -Integer -NegativeFixnum B : (-FS (-filter -NegativeFixnum 0) -top))
      (-> -NegativeFixnum -Integer B : (-FS (-filter -NegativeFixnum 1) -top))
      fx-comp))
-  (define-for-syntax fx<-type
+  (define fx<-type
     (cl->*
      (-> -Integer (-val 0) B : (-FS (-filter -NegativeFixnum 0) (-filter -NonnegativeFixnum 0)))
      (-> -Integer -NegativeFixnum B : (-FS (-filter -NegativeFixnum 0) -top))
      (-> -Nat -Integer B : (-FS (-filter -PositiveFixnum 1) -top))
      fx-comp))
-  (define-for-syntax fx>-type
+  (define fx>-type
     (cl->*
      (-> -Integer (-val 0) B : (-FS (-filter -PositiveFixnum 0) -top))
      (-> -NegativeFixnum -Integer B : (-FS (-filter -NegativeFixnum 1) -top))
      (-> -Integer -Nat B : (-FS (-filter -PositiveFixnum 0) -top))
      fx-comp))
-  (define-for-syntax fx<=-type
+  (define fx<=-type
     (cl->*
      (-> -Integer (-val 0) B : (-FS -top (-filter -PositiveFixnum 0)))
      (-> -Integer -NegativeFixnum B : (-FS (-filter -NegativeFixnum 0) -top))
      (-> -Pos -Integer B : (-FS (-filter -Pos 1) -top))
      (-> -Nat -Integer B : (-FS (-filter -Nat 1) -top))
      fx-comp))
-  (define-for-syntax fx>=-type
+  (define fx>=-type
     (cl->*
      (-> -Integer (-val 0) B : (-FS (-filter -NonnegativeFixnum 0) -top))
      (-> -NegativeFixnum -Integer B : (-FS (-filter -NegativeFixnum 1) -top))
      (-> -Integer -Pos B : (-FS (-filter -Pos 0) -top))
      (-> -Integer -Nat B : (-FS (-filter -Nat 0) -top))
      fx-comp))
-  (define-for-syntax fxmin-type
+  (define fxmin-type
     (cl->*
      (-> -NegativeFixnum -Integer -NegativeFixnum)
      (-> -Integer -NegativeFixnum -NegativeFixnum)
      (-> -Pos -Pos -PositiveFixnum)
      (-> -Nat -Nat -NonnegativeFixnum)
      (-> -Integer -Integer -Fixnum)))
-  (define-for-syntax fxmax-type
+  (define fxmax-type
     (cl->*
      (-> -NegativeFixnum -NegativeFixnum -NegativeFixnum)
      (-> -Pos -Integer -PositiveFixnum)
@@ -113,26 +104,26 @@
      (-> -Integer -Nat -NonnegativeFixnum)
      (-> -Integer -Integer -Fixnum)))
 
-  (define-for-syntax fl+*-type
+  (define fl+*-type
     (cl->* (-NonnegativeFlonum -NonnegativeFlonum . -> . -NonnegativeFlonum)
            (-Flonum -Flonum . -> . -Flonum)))
-  (define-for-syntax fl=-type
+  (define fl=-type
     (cl->*
      (-> -Flonum -NonnegativeFlonum B : (-FS (-filter -NonnegativeFlonum 0) -top))
      (-> -NonnegativeFlonum -Flonum B : (-FS (-filter -NonnegativeFlonum 1) -top))
      fl-comp))
-  (define-for-syntax fl<-type
+  (define fl<-type
     (cl->*
      (-> -NonnegativeFlonum -Flonum B : (-FS (-filter -NonnegativeFlonum 1) -top))
      fl-comp))
-  (define-for-syntax fl>-type
+  (define fl>-type
     (cl->*
      (-> -Flonum -NonnegativeFlonum B : (-FS (-filter -NonnegativeFlonum 0) -top))
      fl-comp))
-  (define-for-syntax flmin-type
+  (define flmin-type
     (cl->* (-> -NonnegativeFlonum -NonnegativeFlonum -NonnegativeFlonum)
            (-> -Flonum -Flonum -Flonum)))
-  (define-for-syntax flmax-type
+  (define flmax-type
     (cl->* (-> -NonnegativeFlonum -Flonum -NonnegativeFlonum)
            (-> -Flonum -NonnegativeFlonum -NonnegativeFlonum)
            (-> -Flonum -Flonum -Flonum)))
diff --git a/collects/typed-scheme/private/base-env.rkt b/collects/typed-scheme/private/base-env.rkt
index c4347f7c..e135badb 100644
--- a/collects/typed-scheme/private/base-env.rkt
+++ b/collects/typed-scheme/private/base-env.rkt
@@ -1,26 +1,29 @@
 #lang s-exp "env-lang.rkt"
 
 (require
- racket/tcp
- racket
- racket/unsafe/ops
- racket/fixnum
- racket/future
- (only-in rnrs/lists-6 fold-left)
- '#%paramz
- "extra-procs.rkt"
- (only-in '#%kernel [apply kernel:apply])
- (only-in racket/private/pre-base new-apply-proc)
- (for-syntax (only-in racket/private/pre-base new-apply-proc))
- scheme/promise scheme/system
- racket/mpair
- (only-in string-constants/private/only-once maybe-print-message)
- (only-in mzscheme make-namespace)
- (only-in racket/match/runtime match:error matchable? match-equality-test)
- (for-syntax (only-in (types abbrev) [-Number N] [-Boolean B] [-Symbol Sym])
-             (only-in (rep type-rep) make-HashtableTop make-MPairTop
-                                     make-BoxTop make-ChannelTop make-VectorTop
-                                     make-HeterogenousVector)))
+ 
+ 
+ (for-template 
+  (except-in racket -> ->* one-of/c)
+  racket/unsafe/ops
+  racket/tcp
+  racket/fixnum
+  racket/future
+  (only-in rnrs/lists-6 fold-left)
+  '#%paramz
+  "extra-procs.rkt"
+  (only-in '#%kernel [apply kernel:apply])
+  (only-in racket/private/pre-base new-apply-proc) 
+  scheme/promise scheme/system
+  racket/mpair
+  racket/base
+  (only-in string-constants/private/only-once maybe-print-message)
+  (only-in mzscheme make-namespace)
+  (only-in racket/match/runtime match:error matchable? match-equality-test))
+ (only-in (types abbrev) [-Number N] [-Boolean B] [-Symbol Sym])
+ (only-in (rep type-rep) make-HashtableTop make-MPairTop
+          make-BoxTop make-ChannelTop make-VectorTop
+          make-HeterogenousVector))
 
 [raise (Univ . -> . (Un))]
 [raise-syntax-error (cl->* 
diff --git a/collects/typed-scheme/private/base-special-env.rkt b/collects/typed-scheme/private/base-special-env.rkt
index 95d47db7..2140c4fa 100644
--- a/collects/typed-scheme/private/base-special-env.rkt
+++ b/collects/typed-scheme/private/base-special-env.rkt
@@ -5,14 +5,12 @@
  "../utils/utils.rkt"
  racket/promise
  string-constants/string-constant 
- (for-syntax
-  scheme/base syntax/parse
-  (only-in unstable/syntax syntax-local-eval)
-  (utils tc-utils)
-  (env init-envs)          
-  (except-in (rep filter-rep object-rep type-rep) make-arr)
-  (types convenience union)
-  (only-in (types convenience) [make-arr* make-arr])))
+ (for-syntax racket/base syntax/parse (only-in unstable/syntax syntax-local-eval)
+             (utils tc-utils)
+             (env init-envs)          
+             (except-in (rep filter-rep object-rep type-rep) make-arr)
+             (types convenience union)
+             (only-in (types convenience) [make-arr* make-arr])))
 
 (define-syntax (define-initial-env stx)
   (syntax-parse stx
diff --git a/collects/typed-scheme/private/env-lang.rkt b/collects/typed-scheme/private/env-lang.rkt
index 1f306b17..eb5ff44b 100644
--- a/collects/typed-scheme/private/env-lang.rkt
+++ b/collects/typed-scheme/private/env-lang.rkt
@@ -2,14 +2,14 @@
 
 (require (rename-in "../utils/utils.rkt" [infer r:infer]))
 
-(require (for-syntax (utils tc-utils)
-                     (env init-envs)
-                     scheme/base syntax/parse
-                     (r:infer infer)
-                     (only-in (r:infer infer-dummy) infer-param)
-                     (except-in (rep object-rep filter-rep type-rep) make-arr)
-                     (types convenience union)
-                     (only-in (types convenience) [make-arr* make-arr])))
+(require (for-syntax scheme/base syntax/parse)
+         (utils tc-utils)
+         (env init-envs)         
+         (r:infer infer)
+         (only-in (r:infer infer-dummy) infer-param)
+         (except-in (rep object-rep filter-rep type-rep) make-arr)
+         (types convenience union)
+         (only-in (types convenience) [make-arr* make-arr]))
 
 (define-syntax (-#%module-begin stx)
   (define-syntax-class clause
@@ -21,18 +21,17 @@
      #'(#%plain-module-begin
 	(begin
 	  extra
-	  (define-for-syntax e
+	  (define e
 	    (parameterize ([infer-param infer])
 	      (make-env [id ty] ...)))
-	  (begin-for-syntax
-	   (initialize-type-env e))))]
+	  (define (init)
+	   (initialize-type-env e))
+          (provide init)))]
     [(mb . rest)
      #'(mb (begin) . rest)]))
 
 (provide (rename-out [-#%module-begin #%module-begin])
          require
          (except-out (all-from-out scheme/base) #%module-begin)
-         types rep private utils
-         (for-syntax          
-          (types-out convenience union)
-          (all-from-out scheme/base)))
+         types rep private utils         
+         (types-out convenience union))
diff --git a/collects/typed-scheme/private/parse-type.rkt b/collects/typed-scheme/private/parse-type.rkt
index d542a8e5..b86a1104 100644
--- a/collects/typed-scheme/private/parse-type.rkt
+++ b/collects/typed-scheme/private/parse-type.rkt
@@ -7,7 +7,7 @@
          syntax/stx (prefix-in c: scheme/contract)
          syntax/parse
          (env type-env-structs tvar-env type-name-env type-alias-env lexical-env index-env)         
-         scheme/match unstable/debug
+         racket/match unstable/debug
          (for-template scheme/base "colon.ss")
          ;; needed at this phase for tests
          (combine-in (prefix-in t: "base-types-extra.ss") "colon.ss")
diff --git a/collects/typed-scheme/private/prims.rkt b/collects/typed-scheme/private/prims.rkt
index 20573f35..f01c8b1c 100644
--- a/collects/typed-scheme/private/prims.rkt
+++ b/collects/typed-scheme/private/prims.rkt
@@ -1,8 +1,8 @@
-#lang scheme/base
+#lang racket/base
 
 #|
 
-This file defines two sorts of primitives. All of them are provided into any module using the typed scheme language.
+This file defines two sorts of primitives. All of them are provided into any module using the typed racket language.
 
 1. macros for defining type annotated code. 
    this includes: lambda:, define:, etc
@@ -27,29 +27,22 @@ This file defines two sorts of primitives. All of them are provided into any mod
                      [for/annotation for]
                      [for*/annotation for*]))
 
-(require "../utils/utils.rkt"
-         racket/base
-         mzlib/etc
-         "../utils/require-contract.rkt"
+(require "../utils/require-contract.rkt"
          "colon.rkt"
          "../typecheck/internal-forms.rkt"
          (rename-in racket/contract [-> c->])
-         mzlib/struct
          "base-types.rkt"
          "base-types-extra.rkt"
          (for-syntax 
           syntax/parse
 	  syntax/private/util
-          scheme/base
-          mzlib/match
-          scheme/struct-info
+          racket/base
+          racket/struct-info
           syntax/struct
-          syntax/stx
           "../rep/type-rep.rkt"
           "parse-type.rkt"
           "annotate-classes.rkt"
           "internal.rkt"
-          "../utils/utils.rkt"
           "../utils/tc-utils.rkt"	  
           "../env/type-name-env.rkt"
           "type-contract.rkt"
@@ -277,8 +270,8 @@ This file defines two sorts of primitives. All of them are provided into any mod
     [(_ nm ((~describe "field specification" [fld:annotated-name]) ...) [proc : proc-ty])
      (with-syntax* 
       ([proc* (syntax-property #'(ann proc : proc-ty) 'typechecker:with-type #t)]
-       [d-s (syntax-property (syntax/loc stx (define-struct/properties nm (fld.name ...)
-                                               ([prop:procedure proc*])))
+       [d-s (syntax-property (syntax/loc stx (define-struct nm (fld.name ...)
+                                               #:property prop:procedure proc*))
                              'typechecker:ignore-some #t)]
        [dtsi (internal (syntax/loc stx (define-typed-struct/exec-internal nm (fld ...) proc-ty)))])
       #'(begin d-s dtsi))]))
diff --git a/collects/typed-scheme/private/type-annotation.rkt b/collects/typed-scheme/private/type-annotation.rkt
index 5dd07fe7..6889c650 100644
--- a/collects/typed-scheme/private/type-annotation.rkt
+++ b/collects/typed-scheme/private/type-annotation.rkt
@@ -7,7 +7,7 @@
          (except-in (types subtype union convenience resolve utils) -> ->*)
          (private parse-type)
          (only-in scheme/contract listof ->)
-         scheme/match mzlib/trace)
+         racket/match mzlib/trace)
 (provide type-annotation
          get-type
          get-types
diff --git a/collects/typed-scheme/private/type-contract.rkt b/collects/typed-scheme/private/type-contract.rkt
index 6fcf80a9..dd59522a 100644
--- a/collects/typed-scheme/private/type-contract.rkt
+++ b/collects/typed-scheme/private/type-contract.rkt
@@ -12,7 +12,7 @@
  (types resolve utils)
  (prefix-in t: (types convenience))
  (private parse-type)
- scheme/match syntax/struct syntax/stx mzlib/trace unstable/syntax scheme/list 
+ racket/match syntax/struct syntax/stx mzlib/trace unstable/syntax scheme/list 
  (only-in scheme/contract -> ->* case-> cons/c flat-rec-contract provide/contract any/c)
  (for-template scheme/base scheme/contract unstable/poly-c (utils any-wrap)
 	       (only-in scheme/class object% is-a?/c subclass?/c object-contract class/c init object/c class?)))
diff --git a/collects/typed-scheme/private/with-types.rkt b/collects/typed-scheme/private/with-types.rkt
index a3eb62dc..2733010b 100644
--- a/collects/typed-scheme/private/with-types.rkt
+++ b/collects/typed-scheme/private/with-types.rkt
@@ -5,8 +5,7 @@
           (except-in racket/base for for*)
           "prims.rkt"
           (prefix-in c: (combine-in racket/contract/regions racket/contract/base)))
-         "base-env.rkt" "base-special-env.rkt" "base-env-numeric.rkt"
-	 "base-env-indexing.rkt" "extra-procs.rkt" "prims.rkt"         
+         "extra-procs.rkt" "prims.rkt"
          syntax/parse racket/block racket/match
          unstable/sequence unstable/debug "base-types-extra.rkt"
          (except-in (path-up "env/type-name-env.rkt"
diff --git a/collects/typed-scheme/rep/filter-rep.rkt b/collects/typed-scheme/rep/filter-rep.rkt
index 5b65d050..4e5e4f37 100644
--- a/collects/typed-scheme/rep/filter-rep.rkt
+++ b/collects/typed-scheme/rep/filter-rep.rkt
@@ -1,6 +1,6 @@
 #lang scheme/base
 
-(require scheme/match scheme/contract)
+(require racket/match scheme/contract)
 (require "rep-utils.rkt" "free-variance.rkt")
 
 (define (Filter/c-predicate? e)
diff --git a/collects/typed-scheme/rep/object-rep.rkt b/collects/typed-scheme/rep/object-rep.rkt
index 3608a0e9..97b9a441 100644
--- a/collects/typed-scheme/rep/object-rep.rkt
+++ b/collects/typed-scheme/rep/object-rep.rkt
@@ -1,6 +1,6 @@
 #lang scheme/base
 
-(require scheme/match scheme/contract "rep-utils.rkt" "free-variance.rkt" "filter-rep.rkt")
+(require racket/match scheme/contract "rep-utils.rkt" "free-variance.rkt" "filter-rep.rkt")
 (provide object-equal?)
 
 (dpe CarPE () [#:fold-rhs #:base])
diff --git a/collects/typed-scheme/rep/rep-utils.rkt b/collects/typed-scheme/rep/rep-utils.rkt
index a52d800e..eccd1b6b 100644
--- a/collects/typed-scheme/rep/rep-utils.rkt
+++ b/collects/typed-scheme/rep/rep-utils.rkt
@@ -2,7 +2,7 @@
 (require "../utils/utils.rkt")
 
 (require mzlib/struct mzlib/pconvert
-         scheme/match
+         racket/match
          syntax/boundmap
          "free-variance.rkt"
          "interning.rkt"
@@ -12,7 +12,7 @@
          (for-syntax 
           scheme/list
           (only-in unstable/syntax generate-temporary)
-          scheme/match
+          racket/match
           (except-in syntax/parse id identifier keyword)
           scheme/base
           syntax/struct
diff --git a/collects/typed-scheme/rep/type-rep.rkt b/collects/typed-scheme/rep/type-rep.rkt
index c9bb029c..8f6b3d64 100644
--- a/collects/typed-scheme/rep/type-rep.rkt
+++ b/collects/typed-scheme/rep/type-rep.rkt
@@ -3,7 +3,7 @@
 
 (require (utils tc-utils) 
 	 "rep-utils.rkt" "object-rep.rkt" "filter-rep.rkt" "free-variance.rkt"
-         mzlib/trace scheme/match mzlib/etc
+         mzlib/trace racket/match mzlib/etc
          scheme/contract unstable/debug
          (for-syntax scheme/base syntax/parse))
 
diff --git a/collects/typed-scheme/typecheck/check-subforms-unit.rkt b/collects/typed-scheme/typecheck/check-subforms-unit.rkt
index ac0bf4e2..83b34289 100644
--- a/collects/typed-scheme/typecheck/check-subforms-unit.rkt
+++ b/collects/typed-scheme/typecheck/check-subforms-unit.rkt
@@ -3,7 +3,7 @@
 (require "../utils/utils.rkt"
 	 syntax/kerncase
 	 syntax/parse
-         scheme/match unstable/debug
+         racket/match unstable/debug
          "signatures.rkt" "tc-metafunctions.rkt"
          (types utils convenience union subtype)
 	 (utils tc-utils)
diff --git a/collects/typed-scheme/typecheck/find-annotation.rkt b/collects/typed-scheme/typecheck/find-annotation.rkt
index 48b5612f..c03d4184 100644
--- a/collects/typed-scheme/typecheck/find-annotation.rkt
+++ b/collects/typed-scheme/typecheck/find-annotation.rkt
@@ -72,5 +72,5 @@
     [e:core-expr
      (ormap find (syntax->list #'(e.expr ...)))]))
 
-; (require scheme/trace)
+; (require racket/trace)
 ; (trace find-annotation)
diff --git a/collects/typed-scheme/typecheck/provide-handling.rkt b/collects/typed-scheme/typecheck/provide-handling.rkt
index 970dc0f8..c84890ba 100644
--- a/collects/typed-scheme/typecheck/provide-handling.rkt
+++ b/collects/typed-scheme/typecheck/provide-handling.rkt
@@ -12,7 +12,7 @@
          (for-syntax syntax/parse racket/base)
          racket/contract/private/provide unstable/list
          unstable/debug syntax/id-table racket/dict
-         unstable/syntax scheme/struct-info scheme/match
+         unstable/syntax scheme/struct-info racket/match
          "def-binding.rkt" syntax/parse
          (for-template scheme/base "def-export.rkt" scheme/contract))
 
diff --git a/collects/typed-scheme/typecheck/tc-app-helper.rkt b/collects/typed-scheme/typecheck/tc-app-helper.rkt
index 42492eea..df152dfa 100644
--- a/collects/typed-scheme/typecheck/tc-app-helper.rkt
+++ b/collects/typed-scheme/typecheck/tc-app-helper.rkt
@@ -1,6 +1,6 @@
 #lang scheme/base
 
-(require "../utils/utils.rkt" scheme/match unstable/list
+(require "../utils/utils.rkt" racket/match unstable/list
          (utils tc-utils) (rep type-rep) (types utils union abbrev))
 
 (provide (all-defined-out))
diff --git a/collects/typed-scheme/typecheck/tc-envops.rkt b/collects/typed-scheme/typecheck/tc-envops.rkt
index c7c59fb5..8643a6b3 100644
--- a/collects/typed-scheme/typecheck/tc-envops.rkt
+++ b/collects/typed-scheme/typecheck/tc-envops.rkt
@@ -11,7 +11,7 @@
          (types resolve)
          (only-in (env type-env-structs lexical-env) 
                   env? update-type/lexical env-map env-props replace-props)
-         scheme/contract scheme/match
+         scheme/contract racket/match
          mzlib/trace unstable/debug unstable/struct
          (typecheck tc-metafunctions)
          (for-syntax scheme/base))
diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.rkt b/collects/typed-scheme/typecheck/tc-expr-unit.rkt
index bf632f86..360c3d54 100644
--- a/collects/typed-scheme/typecheck/tc-expr-unit.rkt
+++ b/collects/typed-scheme/typecheck/tc-expr-unit.rkt
@@ -3,7 +3,7 @@
 
 (require (rename-in "../utils/utils.rkt" [private private-in])
          syntax/kerncase mzlib/trace
-         scheme/match (prefix-in - scheme/contract)
+         racket/match (prefix-in - scheme/contract)
          "signatures.rkt" "tc-envops.rkt" "tc-metafunctions.rkt" "tc-subst.rkt"
          "check-below.rkt" "tc-funapp.rkt"
          (types utils convenience union subtype remove-intersect type-table filter-ops)
diff --git a/collects/typed-scheme/typecheck/tc-lambda-unit.rkt b/collects/typed-scheme/typecheck/tc-lambda-unit.rkt
index 4cd62e40..de693f9c 100644
--- a/collects/typed-scheme/typecheck/tc-lambda-unit.rkt
+++ b/collects/typed-scheme/typecheck/tc-lambda-unit.rkt
@@ -16,7 +16,7 @@
 	 (env type-env-structs lexical-env tvar-env index-env)
 	 (utils tc-utils)
          unstable/debug
-         scheme/match)
+         racket/match)
 (require (for-template scheme/base "internal-forms.rkt"))
 
 (import tc-expr^)
diff --git a/collects/typed-scheme/typecheck/tc-metafunctions.rkt b/collects/typed-scheme/typecheck/tc-metafunctions.rkt
index 3e366341..a047f084 100644
--- a/collects/typed-scheme/typecheck/tc-metafunctions.rkt
+++ b/collects/typed-scheme/typecheck/tc-metafunctions.rkt
@@ -6,7 +6,7 @@
                     [->* -->*]
                     [one-of/c -one-of/c])
          (rep type-rep filter-rep rep-utils) scheme/list
-         scheme/contract scheme/match unstable/match scheme/trace
+         scheme/contract racket/match unstable/match racket/trace
          unstable/debug
          (for-syntax scheme/base))
 
diff --git a/collects/typed-scheme/typecheck/tc-structs.rkt b/collects/typed-scheme/typecheck/tc-structs.rkt
index 5a9bfec9..f594acc2 100644
--- a/collects/typed-scheme/typecheck/tc-structs.rkt
+++ b/collects/typed-scheme/typecheck/tc-structs.rkt
@@ -12,7 +12,7 @@
          mzlib/trace      
          unstable/debug
          racket/function
-         scheme/match
+         racket/match
          (only-in racket/contract
                   listof any/c or/c
                   [->* c->*]
diff --git a/collects/typed-scheme/typecheck/tc-subst.rkt b/collects/typed-scheme/typecheck/tc-subst.rkt
index 7f07fa6b..30f65678 100644
--- a/collects/typed-scheme/typecheck/tc-subst.rkt
+++ b/collects/typed-scheme/typecheck/tc-subst.rkt
@@ -6,7 +6,7 @@
                     [->* -->*]
                     [one-of/c -one-of/c])
          (rep type-rep filter-rep rep-utils) scheme/list
-         scheme/contract scheme/match unstable/match unstable/debug
+         scheme/contract racket/match unstable/match unstable/debug
          (for-syntax scheme/base)
          "tc-metafunctions.rkt")
 
diff --git a/collects/typed-scheme/typecheck/tc-toplevel.rkt b/collects/typed-scheme/typecheck/tc-toplevel.rkt
index 011410fd..8d4787e6 100644
--- a/collects/typed-scheme/typecheck/tc-toplevel.rkt
+++ b/collects/typed-scheme/typecheck/tc-toplevel.rkt
@@ -4,7 +4,7 @@
          syntax/kerncase
          unstable/list unstable/syntax syntax/parse unstable/debug
          mzlib/etc
-         scheme/match
+         racket/match
          "signatures.rkt"
          "tc-structs.rkt"
          "typechecker.rkt"
diff --git a/collects/typed-scheme/typed-scheme.rkt b/collects/typed-scheme/typed-scheme.rkt
index 5ef1eef9..2f7a9154 100644
--- a/collects/typed-scheme/typed-scheme.rkt
+++ b/collects/typed-scheme/typed-scheme.rkt
@@ -1,11 +1,9 @@
 #lang racket/base
 
-(require (for-syntax racket/base "typecheck/renamer.rkt")
-         "private/base-special-env.rkt"
-         "private/base-env.rkt"
-         "private/base-env-numeric.rkt")
+(require (for-syntax racket/base "typecheck/renamer.rkt")         
+         "private/base-special-env.rkt")
 
-(begin-for-syntax (initialize-special))
+(begin-for-syntax )
 
 (provide (rename-out [module-begin #%module-begin]
                      [top-interaction #%top-interaction]
@@ -15,16 +13,27 @@
          with-type)
 
 (define-syntax (module-begin stx)
+  (initialize-special)
   ((dynamic-require 'typed-scheme/private/base-structs 'initialize-structs))
   ((dynamic-require 'typed-scheme/private/base-env-indexing 'initialize-indexing))
+  ((dynamic-require 'typed-scheme/private/base-env 'init))
+  ((dynamic-require 'typed-scheme/private/base-env-numeric 'init))
   ((dynamic-require 'typed-scheme/core 'mb-core) stx))
 
 (define-syntax (top-interaction stx)
+  (initialize-special)
   ((dynamic-require 'typed-scheme/private/base-structs 'initialize-structs))
+  ((dynamic-require 'typed-scheme/private/base-env-indexing 'initialize-indexing))
+  ((dynamic-require 'typed-scheme/private/base-env 'init))
+  ((dynamic-require 'typed-scheme/private/base-env-numeric 'init))
   ((dynamic-require 'typed-scheme/core 'ti-core) stx))
 
 (define-syntax (with-type stx)
+  (initialize-special)
   ((dynamic-require 'typed-scheme/private/base-structs 'initialize-structs))
+  ((dynamic-require 'typed-scheme/private/base-env-indexing 'initialize-indexing))
+  ((dynamic-require 'typed-scheme/private/base-env 'init))
+  ((dynamic-require 'typed-scheme/private/base-env-numeric 'init))
   ((dynamic-require 'typed-scheme/core 'wt-core) stx))
 
 
diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt
index 635bdc07..75d158b0 100644
--- a/collects/typed-scheme/types/abbrev.rkt
+++ b/collects/typed-scheme/types/abbrev.rkt
@@ -2,17 +2,15 @@
 
 (require "../utils/utils.rkt")
 
-(require (rep type-rep object-rep filter-rep rep-utils)
-	 #;"printer.rkt" "utils.rkt" "resolve.rkt"
+(require (rep type-rep object-rep filter-rep)
+         "resolve.rkt"
          (utils tc-utils)
-         scheme/list
-         scheme/match         
-         scheme/promise
-         scheme/flonum (except-in scheme/contract ->* ->)
-         unstable/syntax
-         (prefix-in c: scheme/contract)
-         (for-syntax scheme/base syntax/parse)
-	 (for-template scheme/base scheme/contract scheme/promise scheme/tcp scheme/flonum))
+         racket/list
+         racket/match         
+         (except-in racket/contract ->* ->)
+         (prefix-in c: racket/contract)
+         (for-syntax racket/base syntax/parse)
+	 (for-template racket/base racket/contract racket/promise racket/tcp racket/flonum))
 
 (provide (all-defined-out)
          (rename-out [make-Listof -lst]
diff --git a/collects/typed-scheme/types/filter-ops.rkt b/collects/typed-scheme/types/filter-ops.rkt
index 2d247537..0acb8666 100644
--- a/collects/typed-scheme/types/filter-ops.rkt
+++ b/collects/typed-scheme/types/filter-ops.rkt
@@ -5,10 +5,10 @@
          (utils tc-utils) (only-in (infer infer) restrict)
          "abbrev.rkt" (only-in scheme/contract current-blame-format [-> -->] listof)
 	 (types comparison printer union subtype utils remove-intersect)
-         scheme/list scheme/match scheme/promise
+         scheme/list racket/match scheme/promise
          (for-syntax syntax/parse scheme/base)
          unstable/debug syntax/id-table scheme/dict
-         scheme/trace
+         racket/trace
          (for-template scheme/base))
 
 (provide (all-defined-out))
diff --git a/collects/typed-scheme/types/remove-intersect.rkt b/collects/typed-scheme/types/remove-intersect.rkt
index 64d55e8f..9ea45efe 100644
--- a/collects/typed-scheme/types/remove-intersect.rkt
+++ b/collects/typed-scheme/types/remove-intersect.rkt
@@ -3,7 +3,7 @@
 (require "../utils/utils.rkt" 
 	 (rep type-rep rep-utils)
 	 (types union subtype resolve convenience utils)
-         scheme/match mzlib/trace unstable/debug)
+         racket/match mzlib/trace unstable/debug)
 
 (provide (rename-out [*remove remove]) overlap)
 
diff --git a/collects/typed-scheme/types/resolve.rkt b/collects/typed-scheme/types/resolve.rkt
index b0bbc1c9..73767a04 100644
--- a/collects/typed-scheme/types/resolve.rkt
+++ b/collects/typed-scheme/types/resolve.rkt
@@ -5,7 +5,7 @@
 	 (env type-name-env)
 	 (utils tc-utils)
          (types utils)
-         scheme/match
+         racket/match
          scheme/contract)
 
 (provide resolve-name resolve-app needs-resolving? resolve)
diff --git a/collects/typed-scheme/types/substitute.rkt b/collects/typed-scheme/types/substitute.rkt
index f148e8bc..60850e27 100644
--- a/collects/typed-scheme/types/substitute.rkt
+++ b/collects/typed-scheme/types/substitute.rkt
@@ -5,7 +5,7 @@
          (utils tc-utils)
          (only-in (rep free-variance) combine-frees)
          (env index-env tvar-env)
-         scheme/match
+         racket/match
          scheme/contract)
 
 (provide subst-all substitute substitute-dots substitute-dotted subst
diff --git a/collects/typed-scheme/types/subtype.rkt b/collects/typed-scheme/types/subtype.rkt
index 140cdce2..56e151e1 100644
--- a/collects/typed-scheme/types/subtype.rkt
+++ b/collects/typed-scheme/types/subtype.rkt
@@ -1,15 +1,14 @@
-#lang scheme/base
+#lang racket/base
 (require "../utils/utils.rkt"
          (rep type-rep filter-rep object-rep rep-utils)
          (utils tc-utils)
 	 (types utils comparison resolve abbrev substitute)
          (env type-name-env)
          (only-in (infer infer-dummy) unify)
-         scheme/match unstable/match
-         mzlib/trace (rename-in scheme/contract
-                                [-> c->]
-                                [->* c->*])
-	 (for-syntax scheme/base syntax/parse))
+         racket/match unstable/match
+         (rename-in racket/contract
+                    [-> c->] [->* c->*])
+	 (for-syntax racket/base syntax/parse))
 
 ;; exn representing failure of subtyping
 ;; s,t both types
diff --git a/collects/typed-scheme/types/type-table.rkt b/collects/typed-scheme/types/type-table.rkt
index a4bb8890..f07efd59 100644
--- a/collects/typed-scheme/types/type-table.rkt
+++ b/collects/typed-scheme/types/type-table.rkt
@@ -1,6 +1,6 @@
-#lang scheme/base
+#lang racket/base
 
-(require unstable/debug scheme/contract "../utils/utils.rkt" syntax/id-table racket/dict racket/match
+(require unstable/debug racket/contract "../utils/utils.rkt" syntax/id-table racket/dict racket/match
          (rep type-rep object-rep) (only-in (types abbrev utils) tc-results?) (utils tc-utils)
          (env init-envs) mzlib/pconvert)
 
diff --git a/collects/typed-scheme/types/union.rkt b/collects/typed-scheme/types/union.rkt
index 4452a8ec..e61c03c3 100644
--- a/collects/typed-scheme/types/union.rkt
+++ b/collects/typed-scheme/types/union.rkt
@@ -1,11 +1,10 @@
 #lang scheme/base
 
-(require "../utils/utils.rkt")
-
-(require (rep type-rep rep-utils)
+(require "../utils/utils.rkt"
+         (rep type-rep rep-utils)
 	 (utils tc-utils)
 	 (types utils subtype abbrev printer comparison)
-         scheme/match mzlib/trace)
+         racket/match)
 
 (provide Un)
 
diff --git a/collects/typed-scheme/types/utils.rkt b/collects/typed-scheme/types/utils.rkt
index 5b1670b4..466ae18c 100644
--- a/collects/typed-scheme/types/utils.rkt
+++ b/collects/typed-scheme/types/utils.rkt
@@ -1,17 +1,15 @@
-#lang scheme/base
+#lang racket/base
 
-(require "../utils/utils.rkt")
-
-(require (rep type-rep filter-rep object-rep rep-utils)
+(require "../utils/utils.rkt"
+         (rep type-rep filter-rep object-rep rep-utils)
          (utils tc-utils)
          "substitute.rkt"
          (only-in (rep free-variance) combine-frees)
          (env index-env tvar-env)
-         scheme/match
-         scheme/list
-         mzlib/trace
-         scheme/contract
-         (for-syntax scheme/base syntax/parse))
+         racket/match
+         racket/list
+         racket/contract
+         (for-syntax racket/base syntax/parse))
 
 (provide fv fv/list fi
          instantiate-poly
diff --git a/collects/typed-scheme/utils/any-wrap.rkt b/collects/typed-scheme/utils/any-wrap.rkt
index b1c63e0b..6bc2ae17 100644
--- a/collects/typed-scheme/utils/any-wrap.rkt
+++ b/collects/typed-scheme/utils/any-wrap.rkt
@@ -1,6 +1,6 @@
 #lang scheme/base
 
-(require scheme/match scheme/vector scheme/contract)
+(require racket/match scheme/vector scheme/contract)
 
 (define-struct any-wrap (val)
   #:property prop:custom-write
diff --git a/collects/typed-scheme/utils/require-contract.rkt b/collects/typed-scheme/utils/require-contract.rkt
index 3c43b7e7..3e8b43d5 100644
--- a/collects/typed-scheme/utils/require-contract.rkt
+++ b/collects/typed-scheme/utils/require-contract.rkt
@@ -3,9 +3,7 @@
 (require scheme/contract
          unstable/location
          (for-syntax scheme/base
-                     syntax/kerncase 
                      syntax/parse                     
-                     "../utils/tc-utils.rkt"
                      (prefix-in tr: "../private/typed-renaming.rkt")))
 
 (provide require/contract define-ignored)
diff --git a/collects/typed-scheme/utils/tc-utils.rkt b/collects/typed-scheme/utils/tc-utils.rkt
index 84cf6441..4a21c083 100644
--- a/collects/typed-scheme/utils/tc-utils.rkt
+++ b/collects/typed-scheme/utils/tc-utils.rkt
@@ -7,7 +7,7 @@ don't depend on any other portion of the system
 
 (provide (all-defined-out))
 (require "syntax-traversal.rkt" racket/dict
-	 syntax/parse (for-syntax scheme/base syntax/parse) scheme/match)
+	 syntax/parse (for-syntax scheme/base syntax/parse) racket/match)
 
 ;; a parameter representing the original location of the syntax being currently checked
 (define current-orig-stx (make-parameter #'here))
@@ -165,8 +165,8 @@ don't depend on any other portion of the system
     #:transparent
     #:attributes (ty id)
     (pattern [nm:identifier ~! ty]
-             #:fail-unless (list? (identifier-template-binding #'nm)) "not a bound identifier"
-             #:with id #'#'nm)
+             #:fail-unless (list? ((if (= 1 (syntax-local-phase-level)) identifier-template-binding identifier-template-binding) #'nm)) "not a bound identifier"
+             #:with id #'(quote-syntax nm))
     (pattern [e:expr ty]
              #:with id #'e))
   (syntax-parse stx
diff --git a/collects/typed-scheme/utils/utils.rkt b/collects/typed-scheme/utils/utils.rkt
index e855edc8..78768203 100644
--- a/collects/typed-scheme/utils/utils.rkt
+++ b/collects/typed-scheme/utils/utils.rkt
@@ -1,14 +1,14 @@
-#lang scheme/base
+#lang racket/base
 
 #|
 This file is for utilities that are of general interest, 
 at least theoretically.
 |#
 
-(require (for-syntax scheme/base syntax/parse scheme/string)
-         scheme/contract scheme/match scheme/require-syntax 
-	 scheme/provide-syntax mzlib/struct scheme/unit
-	 scheme/pretty mzlib/pconvert syntax/parse)
+(require (for-syntax racket/base syntax/parse racket/string)
+         racket/contract racket/require-syntax 
+	 racket/provide-syntax racket/unit
+	 racket/pretty mzlib/pconvert syntax/parse)
 
 ;; to move to unstable
 (provide reverse-begin list-update list-set)

From 63f68276221c6cbc07e8a67f3c94afa5ed552156 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 9 Sep 2010 14:02:50 -0400
Subject: [PATCH 116/198] Fix `hash-name' to avoid collisions.

original commit: eea479b34a2014f259f59098a38aa33ba0ee1971
---
 collects/typed-scheme/rep/filter-rep.rkt | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/typed-scheme/rep/filter-rep.rkt b/collects/typed-scheme/rep/filter-rep.rkt
index 4e5e4f37..7adb624b 100644
--- a/collects/typed-scheme/rep/filter-rep.rkt
+++ b/collects/typed-scheme/rep/filter-rep.rkt
@@ -15,7 +15,7 @@
 (provide Filter/c FilterSet/c name-ref/c hash-name)
 
 (define name-ref/c (or/c identifier? integer?))
-(define (hash-name v) (if (identifier? v) (hash-id v) v))
+(define (hash-name v) (if (identifier? v) (hash-id v) (list v)))
 
 (df Bot () [#:fold-rhs #:base])
 (df Top () [#:fold-rhs #:base])

From 0c00609adefd07c1053107286f11c63b72ff9522 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 9 Sep 2010 14:06:09 -0400
Subject: [PATCH 117/198] Enable struct construction when not transforming. 
 Necessary for testing.

original commit: 71ae5f0a6e92f571ab34ed1849ff31c71117e12c
---
 collects/typed-scheme/typecheck/tc-structs.rkt | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/collects/typed-scheme/typecheck/tc-structs.rkt b/collects/typed-scheme/typecheck/tc-structs.rkt
index f594acc2..7aa506ef 100644
--- a/collects/typed-scheme/typecheck/tc-structs.rkt
+++ b/collects/typed-scheme/typecheck/tc-structs.rkt
@@ -123,7 +123,9 @@
                        (make-fld t g setters?))]
          [flds (append parent-fields this-flds)]
          [sty (make-Struct name parent flds proc-ty poly? pred
-                           (syntax-local-certifier) (or maker* maker))]
+                           ;; this check is so that the tests work
+                           (if (syntax-transforming?) (syntax-local-certifier) values)
+                           (or maker* maker))]
          [external-fld-types/no-parent types]
          [external-fld-types (map fld-t flds)])
     (if type-only

From a074f3dc6d42c96d9e111b0d01a4a652aaa62dca Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 9 Sep 2010 14:06:43 -0400
Subject: [PATCH 118/198] `require' changes

original commit: 7a1b29c8f27328cacc01b34c8e01f0ac361ccc3d
---
 collects/typed-scheme/typecheck/tc-funapp.rkt       |  7 ++-----
 collects/typed-scheme/typecheck/tc-let-unit.rkt     |  8 ++++----
 .../typed-scheme/typecheck/tc-metafunctions.rkt     | 13 ++++++-------
 3 files changed, 12 insertions(+), 16 deletions(-)

diff --git a/collects/typed-scheme/typecheck/tc-funapp.rkt b/collects/typed-scheme/typecheck/tc-funapp.rkt
index f4403c78..b2df3743 100644
--- a/collects/typed-scheme/typecheck/tc-funapp.rkt
+++ b/collects/typed-scheme/typecheck/tc-funapp.rkt
@@ -5,11 +5,9 @@
          "tc-app-helper.rkt" "find-annotation.rkt"
          "tc-subst.rkt" "check-below.rkt"
          (prefix-in c: racket/contract)
-         syntax/parse racket/match racket/list 
-	 unstable/sequence unstable/debug
+         syntax/parse racket/match racket/list unstable/sequence
          ;; fixme - don't need to be bound in this phase - only to make syntax/parse happy
-         racket/bool
-         racket/unsafe/ops
+         racket/bool racket/unsafe/ops
          (only-in racket/private/class-internal make-object do-make-object)
          (only-in '#%kernel [apply k:apply])
          ;; end fixme
@@ -17,7 +15,6 @@
          (private type-annotation)
          (types utils abbrev union subtype resolve convenience type-table substitute)
          (utils tc-utils)
-         (only-in srfi/1 alist-delete)
          (except-in (env type-env-structs tvar-env index-env) extend)
          (rep type-rep filter-rep object-rep rep-utils)
          (r:infer infer)
diff --git a/collects/typed-scheme/typecheck/tc-let-unit.rkt b/collects/typed-scheme/typecheck/tc-let-unit.rkt
index aa4a8967..5506bb2f 100644
--- a/collects/typed-scheme/typecheck/tc-let-unit.rkt
+++ b/collects/typed-scheme/typecheck/tc-let-unit.rkt
@@ -1,24 +1,24 @@
 #lang racket/unit
 
-(require (rename-in "../utils/utils.rkt" [infer r:infer]))
-(require "signatures.rkt" "tc-metafunctions.rkt" "tc-subst.rkt"
+(require (rename-in "../utils/utils.rkt" [infer r:infer])
+         "signatures.rkt" "tc-metafunctions.rkt" "tc-subst.rkt"
          "check-below.rkt"
          (types utils convenience)
          (private type-annotation parse-type)
 	 (env lexical-env type-alias-env global-env type-env-structs)
          (rep type-rep)
          syntax/free-vars
-         racket/trace unstable/debug
+         ;racket/trace unstable/debug
          racket/match (prefix-in c: racket/contract)
          (except-in racket/contract -> ->* one-of/c)
          syntax/kerncase syntax/parse
+         unstable/debug
          (for-template 
           racket/base
           "internal-forms.rkt"))
 
 (require (only-in srfi/1/list s:member))
 
-
 (import tc-expr^)
 (export tc-let^)
 
diff --git a/collects/typed-scheme/typecheck/tc-metafunctions.rkt b/collects/typed-scheme/typecheck/tc-metafunctions.rkt
index a047f084..3b6977e8 100644
--- a/collects/typed-scheme/typecheck/tc-metafunctions.rkt
+++ b/collects/typed-scheme/typecheck/tc-metafunctions.rkt
@@ -1,14 +1,13 @@
-#lang scheme/base
+#lang racket/base
 
-(require "../utils/utils.rkt")
-(require (rename-in (types subtype convenience remove-intersect union utils filter-ops)                   
+(require "../utils/utils.rkt"
+         (rename-in (types subtype convenience remove-intersect union utils filter-ops)                   
                     [-> -->]
                     [->* -->*]
                     [one-of/c -one-of/c])
-         (rep type-rep filter-rep rep-utils) scheme/list
-         scheme/contract racket/match unstable/match racket/trace
-         unstable/debug
-         (for-syntax scheme/base))
+         (rep type-rep filter-rep rep-utils) racket/list
+         racket/contract racket/match unstable/match
+         (for-syntax racket/base))
 
 ;; this implements the sequence invariant described on the first page relating to Bot
 

From eba0c35b6cd4850b58aa94ff75117a7d8e4be460 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 9 Sep 2010 14:08:52 -0400
Subject: [PATCH 119/198] Fix `require' for contracts.

original commit: 867f35927430b61c411ae7c930964b9e70f42cc5
---
 collects/typed-scheme/types/abbrev.rkt | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt
index 75d158b0..3255022f 100644
--- a/collects/typed-scheme/types/abbrev.rkt
+++ b/collects/typed-scheme/types/abbrev.rkt
@@ -2,7 +2,7 @@
 
 (require "../utils/utils.rkt")
 
-(require (rep type-rep object-rep filter-rep)
+(require (rep type-rep object-rep filter-rep rep-utils)
          "resolve.rkt"
          (utils tc-utils)
          racket/list

From df6cce314c433d81b0ea8a940fa7cf860f79e8fb Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 9 Sep 2010 14:11:06 -0400
Subject: [PATCH 120/198] Avoid printing results of `define-hierarchy'

original commit: bc6d8f98ed08e1f70f1b3ea255869b06533d2372
---
 collects/typed-scheme/private/base-structs.rkt | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/typed-scheme/private/base-structs.rkt b/collects/typed-scheme/private/base-structs.rkt
index 03bcb0f3..2fe17fe9 100644
--- a/collects/typed-scheme/private/base-structs.rkt
+++ b/collects/typed-scheme/private/base-structs.rkt
@@ -96,4 +96,4 @@
       (define-hierarchy exn:fail:user ())))
 
   ;; cce: adding exn:break would require a generic type for continuations
-  )
\ No newline at end of file
+  (void))

From e0b7b06a21231a3966f8239a4df13ed1744bbdc1 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 9 Sep 2010 14:11:32 -0400
Subject: [PATCH 121/198] Add `require' to fix tests.

original commit: 0ae9e0ff851a1d5835ac8ab1eb1bd1a0b7ab3c8c
---
 collects/typed-scheme/private/base-env.rkt | 1 +
 1 file changed, 1 insertion(+)

diff --git a/collects/typed-scheme/private/base-env.rkt b/collects/typed-scheme/private/base-env.rkt
index e135badb..21a14cf0 100644
--- a/collects/typed-scheme/private/base-env.rkt
+++ b/collects/typed-scheme/private/base-env.rkt
@@ -20,6 +20,7 @@
   (only-in string-constants/private/only-once maybe-print-message)
   (only-in mzscheme make-namespace)
   (only-in racket/match/runtime match:error matchable? match-equality-test))
+ (only-in racket/private/pre-base new-apply-proc)
  (only-in (types abbrev) [-Number N] [-Boolean B] [-Symbol Sym])
  (only-in (rep type-rep) make-HashtableTop make-MPairTop
           make-BoxTop make-ChannelTop make-VectorTop

From ea078904a56b83045f197f03477e7149ba1e143b Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 9 Sep 2010 14:11:58 -0400
Subject: [PATCH 122/198] Remove requires for environments now handled
 dynamically.

original commit: 5302b3e87c01be9c11e5f2098c90615bf5c883bc
---
 collects/typed/racket/base.rkt | 6 +-----
 collects/typed/scheme/base.rkt | 6 +-----
 2 files changed, 2 insertions(+), 10 deletions(-)

diff --git a/collects/typed/racket/base.rkt b/collects/typed/racket/base.rkt
index a98b88cd..9d0942a2 100644
--- a/collects/typed/racket/base.rkt
+++ b/collects/typed/racket/base.rkt
@@ -10,11 +10,7 @@
 		   #%top-interaction
 		   lambda
 		   #%app))
-(require typed-scheme/private/base-env
-	 typed-scheme/private/base-special-env
-	 typed-scheme/private/base-env-numeric
-	 typed-scheme/private/base-env-indexing
-	 typed-scheme/private/extra-procs
+(require typed-scheme/private/extra-procs
 	 (for-syntax typed-scheme/private/base-types-extra))
 (provide (rename-out [with-handlers: with-handlers]
                      [define-type-alias define-type])
diff --git a/collects/typed/scheme/base.rkt b/collects/typed/scheme/base.rkt
index 20d6f356..abbf0ebf 100644
--- a/collects/typed/scheme/base.rkt
+++ b/collects/typed/scheme/base.rkt
@@ -10,11 +10,7 @@
 		   #%top-interaction
 		   lambda
 		   #%app))
-(require typed-scheme/private/base-env
-	 typed-scheme/private/base-special-env
-	 typed-scheme/private/base-env-numeric
-	 typed-scheme/private/base-env-indexing
-	 typed-scheme/private/extra-procs
+(require typed-scheme/private/extra-procs
 	 (for-syntax typed-scheme/private/base-types-extra))
 (provide (rename-out [with-handlers: with-handlers]
                      [define-type-alias define-type])

From 9e9680d5ff13f1c61b5e1fb7c94a67e2a806dade Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 9 Sep 2010 14:12:49 -0400
Subject: [PATCH 123/198] Fix typechecker tests for new environment setup.

original commit: 00a8a85f9dd344026a1ca8a4087a86d9bf571728
---
 .../typed-scheme/unit-tests/typecheck-tests.rkt  | 16 ++++++++++------
 1 file changed, 10 insertions(+), 6 deletions(-)

diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
index 249ae7ef..9c9283fb 100644
--- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
+++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
@@ -3,10 +3,9 @@
 (require "test-utils.ss"
          (for-syntax scheme/base)
          (for-template scheme/base))
-(require (private #;base-env prims type-annotation 
-		  base-types-extra
-		  #;base-env-numeric
-		  base-env-indexing
+(require (private prims type-annotation 
+		  base-types-extra base-special-env
+		  base-env-indexing base-structs
                   parse-type)
 	 (typecheck typechecker)
 	 (rep type-rep filter-rep object-rep)
@@ -25,14 +24,19 @@
                      (typecheck typechecker)
 	             (env global-env)
 	             (private #;base-env #;base-env-numeric
-			      base-env-indexing))
+			      base-env-indexing base-special-env))
          (for-template (private #;base-env base-types base-types-extra
-				#;base-env-numeric
+				#;base-env-numeric base-special-env
 				base-env-indexing))
          (for-syntax syntax/kerncase syntax/parse))
 
+(require (prefix-in b: (private base-env))
+         (prefix-in n: (private base-env-numeric)))
+
 (provide typecheck-tests g tc-expr/expand)
 
+(b:init) (n:init) (initialize-structs) (initialize-indexing)
+
 (define N -Number)
 (define B -Boolean)
 (define Sym -Symbol)

From c13d984042e9a8ce41870be9bf38d8a0a6465c65 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 9 Sep 2010 15:28:47 -0400
Subject: [PATCH 124/198] Add additional require for identifiers in the
 residual program.

original commit: c15871a0284fcf2a6a8c78fafde4fdd9a9551bca
---
 collects/typed-scheme/typed-scheme.rkt     | 5 ++++-
 collects/typed-scheme/types/type-table.rkt | 9 ++++++---
 2 files changed, 10 insertions(+), 4 deletions(-)

diff --git a/collects/typed-scheme/typed-scheme.rkt b/collects/typed-scheme/typed-scheme.rkt
index 2f7a9154..9dc546c1 100644
--- a/collects/typed-scheme/typed-scheme.rkt
+++ b/collects/typed-scheme/typed-scheme.rkt
@@ -1,6 +1,9 @@
 #lang racket/base
 
-(require (for-syntax racket/base "typecheck/renamer.rkt")         
+(require (for-syntax racket/base 
+                     ;; these requires are needed since their code
+                     ;; appears in the residual program
+                     "typecheck/renamer.rkt" "types/type-table.rkt")         
          "private/base-special-env.rkt")
 
 (begin-for-syntax )
diff --git a/collects/typed-scheme/types/type-table.rkt b/collects/typed-scheme/types/type-table.rkt
index f07efd59..2e1c7896 100644
--- a/collects/typed-scheme/types/type-table.rkt
+++ b/collects/typed-scheme/types/type-table.rkt
@@ -1,8 +1,11 @@
 #lang racket/base
 
-(require unstable/debug racket/contract "../utils/utils.rkt" syntax/id-table racket/dict racket/match
-         (rep type-rep object-rep) (only-in (types abbrev utils) tc-results?) (utils tc-utils)
-         (env init-envs) mzlib/pconvert)
+(require racket/contract syntax/id-table racket/dict racket/match mzlib/pconvert
+         "../utils/utils.rkt"
+         (rep type-rep object-rep)
+         (only-in (types utils) tc-results?)
+         (utils tc-utils)
+         (env init-envs))
 
 (define table (make-hasheq))
 

From ba761592c6992bcedbf256338c48f4491199b335 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 8 Sep 2010 14:43:37 -0400
Subject: [PATCH 125/198] Included expected optimization logs in the test
 files.

original commit: 7f546434ed1648ff52efdb0e84883e8af5b2837a
---
 collects/tests/typed-scheme/optimizer/run.rkt | 48 ++++++++++++------
 .../optimizer/tests/apply-plus.rkt            |  8 +++
 .../optimizer/tests/begin-float.rkt           |  8 +++
 .../optimizer/tests/binary-fixnum.rkt         |  6 +++
 .../optimizer/tests/binary-nonzero-fixnum.rkt |  7 +++
 .../typed-scheme/optimizer/tests/box.rkt      |  9 ++++
 .../optimizer/tests/cross-module-struct.rkt   |  3 ++
 .../optimizer/tests/cross-module-struct2.rkt  |  6 +++
 .../optimizer/tests/dead-else.rkt             |  9 ++++
 .../optimizer/tests/dead-substructs.rkt       |  6 +++
 .../optimizer/tests/dead-then.rkt             |  9 ++++
 .../optimizer/tests/define-begin-float.rkt    |  7 +++
 .../optimizer/tests/define-call-float.rkt     |  5 ++
 .../optimizer/tests/define-float.rkt          |  5 ++
 .../optimizer/tests/define-pair.rkt           |  5 ++
 .../optimizer/tests/different-langs.rkt       |  5 ++
 .../optimizer/tests/double-float.rkt          |  6 +++
 .../optimizer/tests/exact-inexact.rkt         |  6 +++
 .../optimizer/tests/fixnum-comparison.rkt     |  8 +++
 .../optimizer/tests/float-comp.rkt            |  6 +++
 .../optimizer/tests/float-fun.rkt             |  5 ++
 .../optimizer/tests/float-promotion.rkt       |  9 ++++
 .../optimizer/tests/flvector-length.rkt       |  6 +++
 .../typed-scheme/optimizer/tests/fx-fl.rkt    |  6 +++
 .../typed-scheme/optimizer/tests/in-bytes.rkt | 18 +++++++
 .../typed-scheme/optimizer/tests/in-list.rkt  | 18 +++++++
 .../optimizer/tests/in-string.rkt             | 18 +++++++
 .../optimizer/tests/in-vector.rkt             | 18 +++++++
 .../tests/invalid-binary-nonzero-fixnum.rkt   |  3 ++
 .../optimizer/tests/invalid-exact-inexact.rkt |  6 +++
 .../optimizer/tests/invalid-float-comp.rkt    |  5 ++
 .../tests/invalid-float-promotion.rkt         |  5 ++
 .../tests/invalid-inexact-complex-parts.rkt   |  5 ++
 .../tests/invalid-make-flrectangular.rkt      |  5 ++
 .../optimizer/tests/invalid-make-polar.rkt    |  5 ++
 .../optimizer/tests/invalid-mpair.rkt         |  3 ++
 .../optimizer/tests/invalid-sqrt.rkt          |  5 ++
 .../optimizer/tests/invalid-unboxed-let.rkt   | 28 +++++++++++
 .../optimizer/tests/invalid-unboxed-let2.rkt  | 18 +++++++
 .../optimizer/tests/invalid-vector-ref.rkt    |  3 ++
 .../optimizer/tests/invalid-vector-set.rkt    |  3 ++
 .../optimizer/tests/known-vector-length.rkt   |  7 +++
 .../optimizer/tests/let-float.rkt             |  8 +++
 .../typed-scheme/optimizer/tests/let-rhs.rkt  |  7 +++
 .../optimizer/tests/literal-int.rkt           |  7 +++
 .../optimizer/tests/magnitude.rkt             | 10 +++-
 .../optimizer/tests/make-flrectangular.rkt    |  8 +++
 .../optimizer/tests/make-polar.rkt            | 21 ++++++++
 .../optimizer/tests/maybe-exact-complex.rkt   |  9 ++++
 .../typed-scheme/optimizer/tests/mpair.rkt    | 12 +++++
 .../optimizer/tests/n-ary-float.rkt           |  6 +++
 .../optimizer/tests/nested-float.rkt          |  7 +++
 .../optimizer/tests/nested-float2.rkt         |  7 +++
 .../optimizer/tests/nested-let-loop.rkt       | 43 ++++++++++++++++
 .../optimizer/tests/nested-pair1.rkt          |  7 +++
 .../optimizer/tests/nested-pair2.rkt          |  7 +++
 .../optimizer/tests/nested-unboxed-let.rkt    | 25 ++++++++++
 .../optimizer/tests/one-arg-arith.rkt         | 34 +++++++++++++
 .../typed-scheme/optimizer/tests/pair-fun.rkt |  5 ++
 .../typed-scheme/optimizer/tests/quote.rkt    |  5 ++
 .../optimizer/tests/real-part-loop.rkt        | 24 +++++++++
 .../optimizer/tests/simple-float.rkt          |  6 +++
 .../optimizer/tests/simple-pair.rkt           |  6 +++
 .../optimizer/tests/sqrt-segfault.rkt         | 10 ++++
 .../typed-scheme/optimizer/tests/sqrt.rkt     |  5 ++
 .../optimizer/tests/string-length.rkt         |  8 +++
 .../typed-scheme/optimizer/tests/structs.rkt  |  7 +++
 .../optimizer/tests/unary-fixnum-nested.rkt   |  7 +++
 .../optimizer/tests/unary-fixnum.rkt          |  6 +++
 .../optimizer/tests/unary-float.rkt           |  6 +++
 .../optimizer/tests/unboxed-for.rkt           | 49 +++++++++++++++++++
 .../tests/unboxed-let-functions1.rkt          | 22 +++++++++
 .../tests/unboxed-let-functions2.rkt          | 28 +++++++++++
 .../tests/unboxed-let-functions3.rkt          | 22 +++++++++
 .../tests/unboxed-let-functions4.rkt          | 22 +++++++++
 .../tests/unboxed-let-functions5.rkt          | 11 +++++
 .../tests/unboxed-let-functions6.rkt          | 27 ++++++++++
 .../tests/unboxed-let-functions7.rkt          | 25 ++++++++++
 .../tests/unboxed-let-functions8.rkt          | 10 ++++
 .../optimizer/tests/unboxed-let.rkt           | 31 ++++++++++++
 .../optimizer/tests/unboxed-let2.rkt          | 24 +++++++++
 .../optimizer/tests/unboxed-let3.rkt          | 18 +++++++
 .../tests/unboxed-letrec-syntaxes+values.rkt  | 17 +++++++
 .../optimizer/tests/unboxed-letrec.rkt        | 22 +++++++++
 .../tests/unboxed-make-rectangular.rkt        | 26 ++++++++++
 .../optimizer/tests/vector-length-nested.rkt  |  7 +++
 .../optimizer/tests/vector-length.rkt         |  6 +++
 .../optimizer/tests/vector-ref-set-ref.rkt    |  9 ++++
 .../optimizer/tests/vector-ref.rkt            |  6 +++
 .../optimizer/tests/vector-ref2.rkt           |  6 +++
 .../optimizer/tests/vector-set-quote.rkt      |  5 ++
 .../optimizer/tests/vector-set.rkt            |  5 ++
 .../optimizer/tests/vector-set2.rkt           |  5 ++
 .../typed-scheme/optimizer/tests/zero.rkt     |  9 ++++
 94 files changed, 1080 insertions(+), 16 deletions(-)

diff --git a/collects/tests/typed-scheme/optimizer/run.rkt b/collects/tests/typed-scheme/optimizer/run.rkt
index bd543654..ebff7709 100644
--- a/collects/tests/typed-scheme/optimizer/run.rkt
+++ b/collects/tests/typed-scheme/optimizer/run.rkt
@@ -1,6 +1,8 @@
 #lang racket
 (require racket/runtime-path racket/sandbox)
 
+(define show-names? (make-parameter #f))
+
 (define prog-rx
   (pregexp (string-append "^\\s*"
                           "(#lang typed/(?:scheme|racket)(?:/base)?)"
@@ -18,9 +20,12 @@
                      (list (car (sandbox-namespace-specs))
                            'typed/racket
                            'typed/scheme)])
-       ;; drop the #lang line
-       (let* ([prog (file->string file)]
-              ;; drop the #lang line and #:optimize
+       ;; drop the expected log
+       (let* ([prog (with-input-from-file file
+                      (lambda ()
+                        (read-line) ; drop #;
+                        (read)      ; drop expected log
+                        (port->string)))] ; get the actual program
               [m    (or (regexp-match-positions prog-rx prog)
                         (error 'evaluator "bad program contents in ~e" file))]
               [prog (string-append (substring prog (caadr m) (cdadr m))
@@ -34,23 +39,29 @@
 (define (generate-opt-log name)
   (parameterize ([current-load-relative-directory tests-dir]
                  [current-command-line-arguments  '#("--log-optimizations")])
-    (with-output-to-string
-      (lambda ()
-        (dynamic-require (build-path (current-load-relative-directory) name)
-                         #f)))))
+    (let ((log-string
+           (with-output-to-string
+             (lambda ()
+               (dynamic-require (build-path (current-load-relative-directory)
+                                            name)
+                                #f)))))
+      ;; have the log as an sexp, since that's what the expected log is
+      (with-input-from-string (string-append "(" log-string ")")
+        read))))
 
 (define (test gen)
   (let-values (((base name _) (split-path gen)))
+    (when (show-names?) (displayln name))
     (or (not (regexp-match ".*rkt$" name)) ; we ignore all but racket files
         ;; we log optimizations and compare to an expected log to make sure
         ;; that all the optimizations we expected did indeed happen
         (and (or (let ((log      (generate-opt-log name))
                        ;; expected optimizer log, to see what was optimized
                        (expected
-                        (file->string
-                         (build-path base
-                                     (string-append (path->string name)
-                                                    ".log")))))
+                        (with-input-from-file gen
+                          (lambda ()
+                            (read-line) ; skip the #;
+                            (read)))))  ; get the log itself
                    (equal? log expected))
                  (begin (printf "~a failed: optimization log mismatch\n\n" name)
                         #f))
@@ -60,13 +71,20 @@
                  (begin (printf "~a failed: result mismatch\n\n" name)
                         #f))))))
 
+(define to-run
+  (command-line
+   #:once-each
+   ["--show-names" "show the names of tests as they are run" (show-names? #t)]
+   ;; we optionally take a test name. if none is given, run everything (#f)
+   #:args maybe-test-to-run
+   (and (not (null? maybe-test-to-run))
+        (car maybe-test-to-run))))
+
 (define-runtime-path tests-dir "./tests")
 
 (let ((n-failures
-       (if (> (vector-length (current-command-line-arguments)) 0)
-           (if (test (format "tests/~a.rkt"
-                             (vector-ref (current-command-line-arguments) 0)))
-               0 1)
+       (if to-run
+           (if (test (format "tests/~a.rkt" to-run)) 0 1)
            (for/fold ((n-failures 0))
              ((gen (in-directory tests-dir)))
              (+ n-failures (if (test gen) 0 1))))))
diff --git a/collects/tests/typed-scheme/optimizer/tests/apply-plus.rkt b/collects/tests/typed-scheme/optimizer/tests/apply-plus.rkt
index 19479ca7..8478d8d4 100644
--- a/collects/tests/typed-scheme/optimizer/tests/apply-plus.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/apply-plus.rkt
@@ -1,3 +1,11 @@
+#;
+(
+apply-plus.rkt line 12 col 7 - + - apply-map
+apply-plus.rkt line 13 col 7 - * - apply-map
+9
+24
+)
+
 #lang typed/racket
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/begin-float.rkt b/collects/tests/typed-scheme/optimizer/tests/begin-float.rkt
index 791e75b3..da828b4d 100644
--- a/collects/tests/typed-scheme/optimizer/tests/begin-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/begin-float.rkt
@@ -1,3 +1,11 @@
+#;
+(
+begin-float.rkt line 12 col 8 - - - binary float
+begin-float.rkt line 13 col 8 - * - binary float
+-1.0
+6.0
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/binary-fixnum.rkt b/collects/tests/typed-scheme/optimizer/tests/binary-fixnum.rkt
index 3f7f72d4..31dce5f9 100644
--- a/collects/tests/typed-scheme/optimizer/tests/binary-fixnum.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/binary-fixnum.rkt
@@ -1,3 +1,9 @@
+#;
+(
+binary-fixnum.rkt line 12 col 16 - vector-length - vector-length
+binary-fixnum.rkt line 12 col 3 - bitwise-and - binary fixnum
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/binary-nonzero-fixnum.rkt b/collects/tests/typed-scheme/optimizer/tests/binary-nonzero-fixnum.rkt
index 59a38b9a..2e3ad2e7 100644
--- a/collects/tests/typed-scheme/optimizer/tests/binary-nonzero-fixnum.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/binary-nonzero-fixnum.rkt
@@ -1,3 +1,10 @@
+#;
+(
+binary-nonzero-fixnum.rkt line 11 col 9 - vector-length - vector-length
+binary-nonzero-fixnum.rkt line 11 col 1 - modulo - binary nonzero fixnum
+1
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/box.rkt b/collects/tests/typed-scheme/optimizer/tests/box.rkt
index 44dd0a01..c7c7bbb6 100644
--- a/collects/tests/typed-scheme/optimizer/tests/box.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/box.rkt
@@ -1,3 +1,12 @@
+#;
+(
+box.rkt line 17 col 1 - unbox - box
+box.rkt line 18 col 1 - set-box! - box
+box.rkt line 19 col 1 - unbox - box
+1
+2
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/cross-module-struct.rkt b/collects/tests/typed-scheme/optimizer/tests/cross-module-struct.rkt
index 7b52b214..0959962c 100644
--- a/collects/tests/typed-scheme/optimizer/tests/cross-module-struct.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/cross-module-struct.rkt
@@ -1,3 +1,6 @@
+#;
+()
+
 #lang typed/scheme #:optimize
 
 ;; will be imported by cross-module-struct2
diff --git a/collects/tests/typed-scheme/optimizer/tests/cross-module-struct2.rkt b/collects/tests/typed-scheme/optimizer/tests/cross-module-struct2.rkt
index 45a1696e..b9255c56 100644
--- a/collects/tests/typed-scheme/optimizer/tests/cross-module-struct2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/cross-module-struct2.rkt
@@ -1,3 +1,9 @@
+#;
+(
+cross-module-struct2.rkt line 11 col 1 - x-x - struct ref
+1
+)
+
 #lang typed/scheme #:optimize
 
 (require (file "cross-module-struct.rkt") racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/dead-else.rkt b/collects/tests/typed-scheme/optimizer/tests/dead-else.rkt
index 9ec67d3d..ad1fcb95 100644
--- a/collects/tests/typed-scheme/optimizer/tests/dead-else.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/dead-else.rkt
@@ -1,3 +1,12 @@
+#;
+(
+#f line #f col #f - op - dead else branch
+dead-else.rkt line 14 col 14 - + - binary float
+#f line #f col #f - op - dead else branch
+dead-else.rkt line 17 col 14 - + - binary float
+5.05.0
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/dead-substructs.rkt b/collects/tests/typed-scheme/optimizer/tests/dead-substructs.rkt
index 796076c4..638a5cf0 100644
--- a/collects/tests/typed-scheme/optimizer/tests/dead-substructs.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/dead-substructs.rkt
@@ -1,3 +1,9 @@
+#;
+(
+1
+2
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/dead-then.rkt b/collects/tests/typed-scheme/optimizer/tests/dead-then.rkt
index ddcf70e5..86b40211 100644
--- a/collects/tests/typed-scheme/optimizer/tests/dead-then.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/dead-then.rkt
@@ -1,3 +1,12 @@
+#;
+(
+#f line #f col #f - op - dead then branch
+dead-then.rkt line 15 col 14 - + - binary float
+#f line #f col #f - op - dead then branch
+dead-then.rkt line 18 col 14 - + - binary float
+9.09.0
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/define-begin-float.rkt b/collects/tests/typed-scheme/optimizer/tests/define-begin-float.rkt
index 6c214e4b..f6d0b6f7 100644
--- a/collects/tests/typed-scheme/optimizer/tests/define-begin-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/define-begin-float.rkt
@@ -1,3 +1,10 @@
+#;
+(
+define-begin-float.rkt line 11 col 27 - - - binary float
+define-begin-float.rkt line 12 col 18 - * - binary float
+-1.0
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/define-call-float.rkt b/collects/tests/typed-scheme/optimizer/tests/define-call-float.rkt
index 0b0b3112..0aa84331 100644
--- a/collects/tests/typed-scheme/optimizer/tests/define-call-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/define-call-float.rkt
@@ -1,3 +1,8 @@
+#;
+(
+define-call-float.rkt line 9 col 17 - + - binary float
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/define-float.rkt b/collects/tests/typed-scheme/optimizer/tests/define-float.rkt
index fb4e85ec..9113cefa 100644
--- a/collects/tests/typed-scheme/optimizer/tests/define-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/define-float.rkt
@@ -1,3 +1,8 @@
+#;
+(
+define-float.rkt line 9 col 11 - + - binary float
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/define-pair.rkt b/collects/tests/typed-scheme/optimizer/tests/define-pair.rkt
index f32efdc1..379dcf8c 100644
--- a/collects/tests/typed-scheme/optimizer/tests/define-pair.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/define-pair.rkt
@@ -1,3 +1,8 @@
+#;
+(
+define-pair.rkt line 9 col 11 - car - unary pair
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/different-langs.rkt b/collects/tests/typed-scheme/optimizer/tests/different-langs.rkt
index 2d52084c..cee704bb 100644
--- a/collects/tests/typed-scheme/optimizer/tests/different-langs.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/different-langs.rkt
@@ -1,3 +1,8 @@
+#;
+(
+3
+)
+
 #lang typed/scheme
 #:optimize
 ;; to see if the harness supports having the 2 versions of a test being
diff --git a/collects/tests/typed-scheme/optimizer/tests/double-float.rkt b/collects/tests/typed-scheme/optimizer/tests/double-float.rkt
index a46f1de8..a6400339 100644
--- a/collects/tests/typed-scheme/optimizer/tests/double-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/double-float.rkt
@@ -1,3 +1,9 @@
+#;
+(
+double-float.rkt line 10 col 1 - + - binary float
+6.0
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/exact-inexact.rkt b/collects/tests/typed-scheme/optimizer/tests/exact-inexact.rkt
index 66b5cd34..d3382c3a 100644
--- a/collects/tests/typed-scheme/optimizer/tests/exact-inexact.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/exact-inexact.rkt
@@ -1,3 +1,9 @@
+#;
+(
+exact-inexact.rkt line 10 col 1 - exact->inexact - int to float
+1e+100
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/flonum)
diff --git a/collects/tests/typed-scheme/optimizer/tests/fixnum-comparison.rkt b/collects/tests/typed-scheme/optimizer/tests/fixnum-comparison.rkt
index 9f959d12..53384429 100644
--- a/collects/tests/typed-scheme/optimizer/tests/fixnum-comparison.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/fixnum-comparison.rkt
@@ -1,3 +1,11 @@
+#;
+(
+fixnum-comparison.rkt line 12 col 4 - vector-length - vector-length
+#f line #f col #f - op - string-length
+fixnum-comparison.rkt line 12 col 1 - < - binary fixnum
+#t
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-comp.rkt b/collects/tests/typed-scheme/optimizer/tests/float-comp.rkt
index 2d67b7ec..6cd3e00c 100644
--- a/collects/tests/typed-scheme/optimizer/tests/float-comp.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/float-comp.rkt
@@ -1,3 +1,9 @@
+#;
+(
+float-comp.rkt line 10 col 1 - < - binary float comp
+#t
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-fun.rkt b/collects/tests/typed-scheme/optimizer/tests/float-fun.rkt
index 4aaa4a1e..0a20f92c 100644
--- a/collects/tests/typed-scheme/optimizer/tests/float-fun.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/float-fun.rkt
@@ -1,3 +1,8 @@
+#;
+(
+float-fun.rkt line 12 col 3 - + - binary float
+)
+
 #lang typed/racket
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt b/collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt
index c3fda6ea..64138644 100644
--- a/collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt
@@ -1,3 +1,12 @@
+#;
+(
+float-promotion.rkt line 13 col 4 - modulo - binary nonzero fixnum
+float-promotion.rkt line 13 col 1 - + - binary float
+float-promotion.rkt line 14 col 1 - + - binary float
+2.0
+1e+200
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops racket/flonum)
diff --git a/collects/tests/typed-scheme/optimizer/tests/flvector-length.rkt b/collects/tests/typed-scheme/optimizer/tests/flvector-length.rkt
index 35af6f4f..2cfe1cd1 100644
--- a/collects/tests/typed-scheme/optimizer/tests/flvector-length.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/flvector-length.rkt
@@ -1,3 +1,9 @@
+#;
+(
+flvector-length.rkt line 10 col 1 - flvector-length - flvector-length
+2
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops racket/flonum)
diff --git a/collects/tests/typed-scheme/optimizer/tests/fx-fl.rkt b/collects/tests/typed-scheme/optimizer/tests/fx-fl.rkt
index f72ed808..7fac058b 100644
--- a/collects/tests/typed-scheme/optimizer/tests/fx-fl.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/fx-fl.rkt
@@ -1,3 +1,9 @@
+#;
+(
+fx-fl.rkt line 10 col 1 - exact->inexact - fixnum to float
+1.0
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt b/collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt
index 3ee63e31..5c5d8ba0 100644
--- a/collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt
@@ -1,3 +1,21 @@
+#;
+(
+#f line #f col #f - make-sequence - in-bytes
+#f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (quote 123)))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) (#%app void) init)) - unboxed let bindings
+#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
+#f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
+#f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
+in-bytes.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
+#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
+#f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
+#f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
+in-bytes.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
+495051)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/in-list.rkt b/collects/tests/typed-scheme/optimizer/tests/in-list.rkt
index 4aec40c8..eaca57ac 100644
--- a/collects/tests/typed-scheme/optimizer/tests/in-list.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/in-list.rkt
@@ -1,3 +1,21 @@
+#;
+(
+#f line #f col #f - make-sequence - in-list
+#f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (quote (1 2 3))))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) (#%app void) init)) - unboxed let bindings
+#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
+#f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
+#f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
+in-list.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
+#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
+#f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
+#f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
+in-list.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
+123)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/in-string.rkt b/collects/tests/typed-scheme/optimizer/tests/in-string.rkt
index 4b0bc6f2..5622cbea 100644
--- a/collects/tests/typed-scheme/optimizer/tests/in-string.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/in-string.rkt
@@ -1,3 +1,21 @@
+#;
+(
+#f line #f col #f - make-sequence - in-string
+#f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (quote 123)))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) (#%app void) init)) - unboxed let bindings
+#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
+#f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
+#f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
+in-string.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
+#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
+#f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
+#f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
+in-string.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
+123)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/in-vector.rkt b/collects/tests/typed-scheme/optimizer/tests/in-vector.rkt
index c86d3f32..333debdd 100644
--- a/collects/tests/typed-scheme/optimizer/tests/in-vector.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/in-vector.rkt
@@ -1,3 +1,21 @@
+#;
+(
+#f line #f col #f - make-sequence - in-vector
+#f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (#%app vector (quote 1) (quote 2) (quote 3))))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) (#%app void) init)) - unboxed let bindings
+#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
+#f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
+#f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
+in-vector.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
+#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
+#f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
+#f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
+in-vector.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
+123)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-binary-nonzero-fixnum.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-binary-nonzero-fixnum.rkt
index 389c47d4..d4090067 100644
--- a/collects/tests/typed-scheme/optimizer/tests/invalid-binary-nonzero-fixnum.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-binary-nonzero-fixnum.rkt
@@ -1,3 +1,6 @@
+#;
+()
+
 #lang typed/scheme
 #:optimize
 (: f ( -> Void))
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-exact-inexact.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-exact-inexact.rkt
index be9df5ae..283a9c37 100644
--- a/collects/tests/typed-scheme/optimizer/tests/invalid-exact-inexact.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-exact-inexact.rkt
@@ -1,3 +1,9 @@
+#;
+(
+invalid-exact-inexact.rkt line 9 col 1 - exact->inexact - float to float
+1.0
+)
+
 #lang typed/scheme
 #:optimize
 (exact->inexact 1.0) ; not an integer, can't optimize
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-float-comp.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-float-comp.rkt
index 058e9568..1de1b624 100644
--- a/collects/tests/typed-scheme/optimizer/tests/invalid-float-comp.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-float-comp.rkt
@@ -1,3 +1,8 @@
+#;
+(
+#t
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-float-promotion.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-float-promotion.rkt
index ef72d390..5a2588a8 100644
--- a/collects/tests/typed-scheme/optimizer/tests/invalid-float-promotion.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-float-promotion.rkt
@@ -1,3 +1,8 @@
+#;
+(
+0.5
+)
+
 #lang typed/scheme
 #:optimize
 (/ 1 2.0) ; result is not a float, can't optimize
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-inexact-complex-parts.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-inexact-complex-parts.rkt
index 6a3345d3..3a8bad9e 100644
--- a/collects/tests/typed-scheme/optimizer/tests/invalid-inexact-complex-parts.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-inexact-complex-parts.rkt
@@ -1,3 +1,8 @@
+#;
+(
+1
+)
+
 #lang typed/scheme
 #:optimize
 (real-part 1+2i)
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-make-flrectangular.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-make-flrectangular.rkt
index 45995fcc..607b0d4a 100644
--- a/collects/tests/typed-scheme/optimizer/tests/invalid-make-flrectangular.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-make-flrectangular.rkt
@@ -1,3 +1,8 @@
+#;
+(
+1+2i
+)
+
 #lang typed/scheme
 #:optimize
 (make-rectangular 1 2)
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-make-polar.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-make-polar.rkt
index cd94a758..4c3b0d1d 100644
--- a/collects/tests/typed-scheme/optimizer/tests/invalid-make-polar.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-make-polar.rkt
@@ -1,3 +1,8 @@
+#;
+(
+0
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-mpair.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-mpair.rkt
index 54fd281b..3d2995ba 100644
--- a/collects/tests/typed-scheme/optimizer/tests/invalid-mpair.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-mpair.rkt
@@ -1,3 +1,6 @@
+#;
+()
+
 #lang typed/scheme
 #:optimize
 (: f ((MListof Integer) -> Integer))
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-sqrt.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-sqrt.rkt
index bd4182fa..2f9bb37a 100644
--- a/collects/tests/typed-scheme/optimizer/tests/invalid-sqrt.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-sqrt.rkt
@@ -1,3 +1,8 @@
+#;
+(
+0+1.4142135623730951i
+)
+
 #lang typed/scheme
 #:optimize
 (sqrt -2.0) ; not a nonnegative flonum, can't optimize
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let.rkt
index 532ea426..afc7c9e6 100644
--- a/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let.rkt
@@ -1,3 +1,31 @@
+#;
+(
+invalid-unboxed-let.rkt line 38 col 14 - t1 - unbox inexact-complex
+invalid-unboxed-let.rkt line 38 col 17 - t1 - unbox inexact-complex
+invalid-unboxed-let.rkt line 38 col 12 - + - unboxed binary inexact complex
+invalid-unboxed-let.rkt line 38 col 11 - (#%app + t1 t1) - unboxed inexact complex
+invalid-unboxed-let.rkt line 38 col 14 - t1 - unbox inexact-complex
+invalid-unboxed-let.rkt line 38 col 17 - t1 - unbox inexact-complex
+invalid-unboxed-let.rkt line 38 col 12 - + - unboxed binary inexact complex
+invalid-unboxed-let.rkt line 38 col 11 - (#%app + t1 t1) - unboxed inexact complex
+invalid-unboxed-let.rkt line 38 col 14 - t1 - unbox inexact-complex
+invalid-unboxed-let.rkt line 38 col 17 - t1 - unbox inexact-complex
+invalid-unboxed-let.rkt line 38 col 12 - + - unboxed binary inexact complex
+invalid-unboxed-let.rkt line 38 col 11 - (#%app + t1 t1) - unboxed inexact complex
+invalid-unboxed-let.rkt line 34 col 13 - 1.0+2.0i - unboxed literal
+invalid-unboxed-let.rkt line 34 col 22 - 2.0+4.0i - unboxed literal
+invalid-unboxed-let.rkt line 34 col 11 - + - unboxed binary inexact complex
+invalid-unboxed-let.rkt line 35 col 13 - 3.0+6.0i - unboxed literal
+invalid-unboxed-let.rkt line 35 col 22 - 4.0+8.0i - unboxed literal
+invalid-unboxed-let.rkt line 35 col 11 - + - unboxed binary inexact complex
+invalid-unboxed-let.rkt line 35 col 10 - (#%app + (quote 3.0+6.0i) (quote 4.0+8.0i)) - unboxed inexact complex
+invalid-unboxed-let.rkt line 34 col 0 - (let-values (((t1) (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i))) ((t2) (#%app + (quote 3.0+6.0i) (quote 4.0+8.0i))) ((t3) (quote 1.0+2.0i)) ((t4) (quote 1))) (#%app display (#%app + t1 t1)) (#%app display t2) (#%app display t3) (#%app display t4)) - unboxed let bindings
+invalid-unboxed-let.rkt line 38 col 14 - t1 - leave var unboxed
+invalid-unboxed-let.rkt line 38 col 17 - t1 - leave var unboxed
+invalid-unboxed-let.rkt line 38 col 12 - + - unboxed binary inexact complex
+invalid-unboxed-let.rkt line 38 col 11 - (#%app + t1 t1) - unboxed inexact complex
+6.0+12.0i7.0+14.0i1.0+2.0i1)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt
index 2d4b6144..8875971b 100644
--- a/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt
@@ -1,3 +1,21 @@
+#;
+(
+invalid-unboxed-let2.rkt line 25 col 33 - 1.0+2.0i - unboxed literal
+invalid-unboxed-let2.rkt line 25 col 42 - 2.0+4.0i - unboxed literal
+invalid-unboxed-let2.rkt line 25 col 31 - + - unboxed binary inexact complex
+invalid-unboxed-let2.rkt line 25 col 30 - (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) - unboxed inexact complex
+invalid-unboxed-let2.rkt line 25 col 55 - 3.0+6.0i - unboxed literal
+invalid-unboxed-let2.rkt line 25 col 64 - 4.0+8.0i - unboxed literal
+invalid-unboxed-let2.rkt line 25 col 53 - + - unboxed binary inexact complex
+invalid-unboxed-let2.rkt line 25 col 52 - (#%app + (quote 3.0+6.0i) (quote 4.0+8.0i)) - unboxed inexact complex
+invalid-unboxed-let2.rkt line 25 col 0 - (let-values (((t1 t2) (#%app values (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) (#%app + (quote 3.0+6.0i) (quote 4.0+8.0i))))) (#%app + t1 t2)) - unboxed let bindings
+invalid-unboxed-let2.rkt line 26 col 5 - t1 - unbox inexact-complex
+invalid-unboxed-let2.rkt line 26 col 8 - t2 - unbox inexact-complex
+invalid-unboxed-let2.rkt line 26 col 3 - + - unboxed binary inexact complex
+invalid-unboxed-let2.rkt line 26 col 2 - (#%app + t1 t2) - unboxed inexact complex
+10.0+20.0i
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-vector-ref.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-vector-ref.rkt
index d0a39f04..2bc6634e 100644
--- a/collects/tests/typed-scheme/optimizer/tests/invalid-vector-ref.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-vector-ref.rkt
@@ -1,3 +1,6 @@
+#;
+()
+
 #lang typed/scheme
 #:optimize
 (: f ((Vectorof Integer) -> Integer))
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-vector-set.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-vector-set.rkt
index 391b1940..75abb3b6 100644
--- a/collects/tests/typed-scheme/optimizer/tests/invalid-vector-set.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-vector-set.rkt
@@ -1,3 +1,6 @@
+#;
+()
+
 #lang typed/scheme
 #:optimize
 (: f ((Vectorof Integer) -> Void))
diff --git a/collects/tests/typed-scheme/optimizer/tests/known-vector-length.rkt b/collects/tests/typed-scheme/optimizer/tests/known-vector-length.rkt
index 08483637..97f4c295 100644
--- a/collects/tests/typed-scheme/optimizer/tests/known-vector-length.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/known-vector-length.rkt
@@ -1,3 +1,10 @@
+#;
+(
+known-vector-length.rkt line 11 col 6 - vector-length - known-length vector-length
+known-vector-length.rkt line 11 col 6 - vector-length - known-length vector-length
+4
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/let-float.rkt b/collects/tests/typed-scheme/optimizer/tests/let-float.rkt
index bfc23b14..e598b836 100644
--- a/collects/tests/typed-scheme/optimizer/tests/let-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/let-float.rkt
@@ -1,3 +1,11 @@
+#;
+(
+let-float.rkt line 12 col 10 - + - binary float
+let-float.rkt line 12 col 0 - (let-values (((x) (#%app + (quote 3.0) (quote 2.0)))) (#%app * (quote 9.0) x)) - unboxed let bindings
+let-float.rkt line 13 col 3 - * - binary float
+45.0
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/let-rhs.rkt b/collects/tests/typed-scheme/optimizer/tests/let-rhs.rkt
index d93d5c2a..ec49c5d4 100644
--- a/collects/tests/typed-scheme/optimizer/tests/let-rhs.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/let-rhs.rkt
@@ -1,3 +1,10 @@
+#;
+(
+let-rhs.rkt line 13 col 10 - + - binary float
+let-rhs.rkt line 13 col 0 - (let-values (((x) (#%app + (quote 1.0) (quote 2.0)))) x) - unboxed let bindings
+3.0
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/literal-int.rkt b/collects/tests/typed-scheme/optimizer/tests/literal-int.rkt
index 8cd8fd7d..eb246d7a 100644
--- a/collects/tests/typed-scheme/optimizer/tests/literal-int.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/literal-int.rkt
@@ -1,3 +1,10 @@
+#;
+(
+literal-int.rkt line 13 col 1 - + - binary float
+3.0
+1
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/magnitude.rkt b/collects/tests/typed-scheme/optimizer/tests/magnitude.rkt
index 1ba1330b..42d8cd82 100644
--- a/collects/tests/typed-scheme/optimizer/tests/magnitude.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/magnitude.rkt
@@ -1,6 +1,14 @@
+#;
+(
+magnitude.rkt line 14 col 11 - 3.0+4.0i - unboxed literal
+magnitude.rkt line 14 col 1 - magnitude - unboxed unary inexact complex
+magnitude.rkt line 14 col 0 - (#%app magnitude (quote 3.0+4.0i)) - unboxed inexact complex->float
+5.0
+)
+
 #lang typed/racket/base
 #:optimize
 
 (require racket/unsafe/ops)
 
-(magnitude 3.0+4.0i)
\ No newline at end of file
+(magnitude 3.0+4.0i)
diff --git a/collects/tests/typed-scheme/optimizer/tests/make-flrectangular.rkt b/collects/tests/typed-scheme/optimizer/tests/make-flrectangular.rkt
index 130f19d6..05a40978 100644
--- a/collects/tests/typed-scheme/optimizer/tests/make-flrectangular.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/make-flrectangular.rkt
@@ -1,3 +1,11 @@
+#;
+(
+make-flrectangular.rkt line 12 col 1 - make-rectangular - binary float comp
+make-flrectangular.rkt line 13 col 1 - make-flrectangular - binary float comp
+1.0+2.2i
+1.0+2.2i
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops racket/flonum)
diff --git a/collects/tests/typed-scheme/optimizer/tests/make-polar.rkt b/collects/tests/typed-scheme/optimizer/tests/make-polar.rkt
index 5a0600e0..0497eab5 100644
--- a/collects/tests/typed-scheme/optimizer/tests/make-polar.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/make-polar.rkt
@@ -1,3 +1,24 @@
+#;
+(
+make-polar.rkt line 28 col 1 - make-polar - make-rectangular elimination
+make-polar.rkt line 28 col 1 - make-polar - make-polar
+make-polar.rkt line 32 col 50 - p - unbox inexact-complex
+make-polar.rkt line 32 col 40 - real-part - unboxed unary inexact complex
+make-polar.rkt line 32 col 39 - (#%app real-part p) - unboxed inexact complex->float
+make-polar.rkt line 31 col 12 - 1.0+2.0i - unboxed literal
+make-polar.rkt line 31 col 22 - make-polar - make-rectangular elimination
+make-polar.rkt line 31 col 10 - + - unboxed binary inexact complex
+make-polar.rkt line 31 col 0 - (let-values (((p) (#%app + (quote 1.0+2.0i) (#%app make-polar (quote 2.0) (quote 4.0))))) (#%app string-append (#%app real->decimal-string (#%app real-part p) (quote 10)) (#%app real->decimal-string (#%app imag-part p) (quote 10)))) - unboxed let bindings
+make-polar.rkt line 32 col 50 - p - unboxed complex variable
+make-polar.rkt line 32 col 50 - p - leave var unboxed
+make-polar.rkt line 32 col 40 - real-part - unboxed inexact complex
+make-polar.rkt line 33 col 50 - p - unboxed complex variable
+make-polar.rkt line 33 col 50 - p - leave var unboxed
+make-polar.rkt line 33 col 40 - imag-part - unboxed inexact complex
+0.5403023058681398+0.8414709848078965i
+"-0.30728724170.4863950094"
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/maybe-exact-complex.rkt b/collects/tests/typed-scheme/optimizer/tests/maybe-exact-complex.rkt
index fdf7e3a6..dc3170dc 100644
--- a/collects/tests/typed-scheme/optimizer/tests/maybe-exact-complex.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/maybe-exact-complex.rkt
@@ -1,3 +1,12 @@
+#;
+(
+maybe-exact-complex.rkt line 15 col 3 - 1.0+2.0i - unboxed literal
+maybe-exact-complex.rkt line 15 col 12 - 2+4i - unboxed literal
+maybe-exact-complex.rkt line 15 col 1 - + - unboxed binary inexact complex
+maybe-exact-complex.rkt line 15 col 0 - (#%app + (quote 1.0+2.0i) (quote 2+4i)) - unboxed inexact complex
+3.0+6.0i
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/mpair.rkt b/collects/tests/typed-scheme/optimizer/tests/mpair.rkt
index 5734c82b..c357473b 100644
--- a/collects/tests/typed-scheme/optimizer/tests/mpair.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/mpair.rkt
@@ -1,3 +1,15 @@
+#;
+(
+mpair.rkt line 18 col 1 - mcar - mutable pair
+mpair.rkt line 19 col 1 - mcdr - mutable pair
+mpair.rkt line 20 col 1 - set-mcar! - mutable pair
+mpair.rkt line 21 col 1 - set-mcdr! - mutable pair
+mpair.rkt line 21 col 14 - + - binary float
+mpair.rkt line 27 col 7 - mcar - mutable pair
+1
+1.0
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/n-ary-float.rkt b/collects/tests/typed-scheme/optimizer/tests/n-ary-float.rkt
index d93384be..b2b8515f 100644
--- a/collects/tests/typed-scheme/optimizer/tests/n-ary-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/n-ary-float.rkt
@@ -1,3 +1,9 @@
+#;
+(
+n-ary-float.rkt line 10 col 1 - + - binary float
+6.0
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-float.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-float.rkt
index 290db71b..e2dee886 100644
--- a/collects/tests/typed-scheme/optimizer/tests/nested-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/nested-float.rkt
@@ -1,3 +1,10 @@
+#;
+(
+nested-float.rkt line 11 col 8 - + - binary float
+nested-float.rkt line 11 col 1 - + - binary float
+9.0
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-float2.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-float2.rkt
index ec44730a..cc3d59b9 100644
--- a/collects/tests/typed-scheme/optimizer/tests/nested-float2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/nested-float2.rkt
@@ -1,3 +1,10 @@
+#;
+(
+nested-float2.rkt line 11 col 8 - * - binary float
+nested-float2.rkt line 11 col 1 - + - binary float
+14.0
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt
index 0a8dfc63..92f40326 100644
--- a/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt
@@ -1,3 +1,46 @@
+#;
+(
+nested-let-loop.rkt line 58 col 38 - r - unbox inexact-complex
+nested-let-loop.rkt line 58 col 40 - s - unbox inexact-complex
+nested-let-loop.rkt line 58 col 36 - + - unboxed binary inexact complex
+nested-let-loop.rkt line 58 col 35 - (#%app + r s) - unboxed inexact complex
+nested-let-loop.rkt line 51 col 8 - r - unboxed var -> table
+nested-let-loop.rkt line 49 col 6 - loop1 - unboxed function -> table
+nested-let-loop.rkt line 49 col 6 - loop1 - fun -> unboxed fun
+nested-let-loop.rkt line 53 col 10 - r - unboxed complex variable
+nested-let-loop.rkt line 58 col 38 - r - leave var unboxed
+nested-let-loop.rkt line 58 col 40 - s - unbox inexact-complex
+nested-let-loop.rkt line 58 col 36 - + - unboxed binary inexact complex
+nested-let-loop.rkt line 58 col 35 - (#%app + r s) - unboxed inexact complex
+nested-let-loop.rkt line 56 col 18 - s - unboxed var -> table
+nested-let-loop.rkt line 54 col 16 - loop2 - unboxed function -> table
+nested-let-loop.rkt line 54 col 16 - loop2 - fun -> unboxed fun
+nested-let-loop.rkt line 58 col 38 - r - leave var unboxed
+nested-let-loop.rkt line 58 col 40 - s - leave var unboxed
+nested-let-loop.rkt line 58 col 36 - + - unboxed binary inexact complex
+nested-let-loop.rkt line 58 col 21 - loop1 - unboxed call site
+nested-let-loop.rkt line 58 col 28 - cdr - unary pair
+nested-let-loop.rkt line 58 col 21 - loop1 - call to fun with unboxed args
+nested-let-loop.rkt line 59 col 38 - s - leave var unboxed
+nested-let-loop.rkt line 59 col 40 - (#%app car x) - unbox inexact-complex
+nested-let-loop.rkt line 59 col 41 - car - unary pair
+nested-let-loop.rkt line 59 col 48 - (#%app car y) - unbox inexact-complex
+nested-let-loop.rkt line 59 col 49 - car - unary pair
+nested-let-loop.rkt line 59 col 36 - + - unboxed binary inexact complex
+nested-let-loop.rkt line 59 col 21 - loop2 - unboxed call site
+nested-let-loop.rkt line 59 col 28 - cdr - unary pair
+nested-let-loop.rkt line 59 col 21 - loop2 - call to fun with unboxed args
+#f line #f col #f - (letrec-values (((loop2) (lambda (y s) (if (#%app null? y) (#%app loop1 (#%app cdr x) (#%app + r s)) (#%app loop2 (#%app cdr y) (#%app + s (#%app car x) (#%app car y))))))) loop2) - unboxed let bindings
+nested-let-loop.rkt line 56 col 38 - 0.0+0.0i - unboxed literal
+#f line #f col #f - (letrec-values (((loop2) (lambda (y s) (if (#%app null? y) (#%app loop1 (#%app cdr x) (#%app + r s)) (#%app loop2 (#%app cdr y) (#%app + s (#%app car x) (#%app car y))))))) loop2) - unboxed call site
+nested-let-loop.rkt line 54 col 16 - loop2 - unboxed let loop
+#f line #f col #f - (letrec-values (((loop1) (lambda (x r) (if (#%app null? x) r (#%app (letrec-values (((loop2) (lambda (y s) (if (#%app null? y) (#%app loop1 (#%app cdr x) (#%app + r s)) (#%app loop2 (#%app cdr y) (#%app + s (#%app car x) (#%app car y))))))) loop2) (quote (3.0+6.0i 4.0+8.0i)) (quote 0.0+0.0i)))))) loop1) - unboxed let bindings
+nested-let-loop.rkt line 51 col 28 - 0.0+0.0i - unboxed literal
+#f line #f col #f - (letrec-values (((loop1) (lambda (x r) (if (#%app null? x) r (#%app (letrec-values (((loop2) (lambda (y s) (if (#%app null? y) (#%app loop1 (#%app cdr x) (#%app + r s)) (#%app loop2 (#%app cdr y) (#%app + s (#%app car x) (#%app car y))))))) loop2) (quote (3.0+6.0i 4.0+8.0i)) (quote 0.0+0.0i)))))) loop1) - unboxed call site
+nested-let-loop.rkt line 49 col 6 - loop1 - unboxed let loop
+20.0+40.0i
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-pair1.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-pair1.rkt
index bfe2d3c3..f7670a0b 100644
--- a/collects/tests/typed-scheme/optimizer/tests/nested-pair1.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/nested-pair1.rkt
@@ -1,3 +1,10 @@
+#;
+(
+nested-pair1.rkt line 11 col 6 - cdr - unary pair
+nested-pair1.rkt line 11 col 1 - car - unary pair
+2
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-pair2.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-pair2.rkt
index 15baf314..651a4d5f 100644
--- a/collects/tests/typed-scheme/optimizer/tests/nested-pair2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/nested-pair2.rkt
@@ -1,3 +1,10 @@
+#;
+(
+nested-pair2.rkt line 11 col 6 - cdr - unary pair
+nested-pair2.rkt line 11 col 1 - car - unary pair
+'(2)
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-unboxed-let.rkt
index 9d1529e4..f41eb3ce 100644
--- a/collects/tests/typed-scheme/optimizer/tests/nested-unboxed-let.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/nested-unboxed-let.rkt
@@ -1,3 +1,28 @@
+#;
+(
+nested-unboxed-let.rkt line 32 col 14 - x - unbox inexact-complex
+nested-unboxed-let.rkt line 32 col 16 - 2.0+3.0i - unboxed literal
+nested-unboxed-let.rkt line 32 col 12 - + - unboxed binary inexact complex
+nested-unboxed-let.rkt line 32 col 11 - (#%app + x (quote 2.0+3.0i)) - unboxed inexact complex
+nested-unboxed-let.rkt line 31 col 12 - 1.0+2.0i - unboxed literal
+nested-unboxed-let.rkt line 31 col 21 - 2.0+3.0i - unboxed literal
+nested-unboxed-let.rkt line 31 col 10 - + - unboxed binary inexact complex
+nested-unboxed-let.rkt line 31 col 0 - (let-values (((x) (#%app + (quote 1.0+2.0i) (quote 2.0+3.0i)))) (let-values (((x) (#%app + x (quote 2.0+3.0i)))) (#%app + x (quote 3.0+6.0i)))) - unboxed let bindings
+nested-unboxed-let.rkt line 33 col 7 - x - unbox inexact-complex
+nested-unboxed-let.rkt line 33 col 9 - 3.0+6.0i - unboxed literal
+nested-unboxed-let.rkt line 33 col 5 - + - unboxed binary inexact complex
+nested-unboxed-let.rkt line 33 col 4 - (#%app + x (quote 3.0+6.0i)) - unboxed inexact complex
+nested-unboxed-let.rkt line 32 col 14 - x - leave var unboxed
+nested-unboxed-let.rkt line 32 col 16 - 2.0+3.0i - unboxed literal
+nested-unboxed-let.rkt line 32 col 12 - + - unboxed binary inexact complex
+nested-unboxed-let.rkt line 32 col 2 - (let-values (((x) (#%app + x (quote 2.0+3.0i)))) (#%app + x (quote 3.0+6.0i))) - unboxed let bindings
+nested-unboxed-let.rkt line 33 col 7 - x - leave var unboxed
+nested-unboxed-let.rkt line 33 col 9 - 3.0+6.0i - unboxed literal
+nested-unboxed-let.rkt line 33 col 5 - + - unboxed binary inexact complex
+nested-unboxed-let.rkt line 33 col 4 - (#%app + x (quote 3.0+6.0i)) - unboxed inexact complex
+8.0+14.0i
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/one-arg-arith.rkt b/collects/tests/typed-scheme/optimizer/tests/one-arg-arith.rkt
index 686ca154..9b06cbd8 100644
--- a/collects/tests/typed-scheme/optimizer/tests/one-arg-arith.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/one-arg-arith.rkt
@@ -1,3 +1,37 @@
+#;
+(
+one-arg-arith.rkt line 40 col 1 - - - unary fixnum
+one-arg-arith.rkt line 41 col 1 - - - unary float
+one-arg-arith.rkt line 42 col 1 - / - unary float
+one-arg-arith.rkt line 44 col 1 - + - unary number
+one-arg-arith.rkt line 45 col 1 - + - unary number
+one-arg-arith.rkt line 46 col 1 - + - unary number
+one-arg-arith.rkt line 47 col 1 - * - unary number
+one-arg-arith.rkt line 48 col 1 - * - unary number
+one-arg-arith.rkt line 49 col 1 - * - unary number
+one-arg-arith.rkt line 50 col 1 - min - unary number
+one-arg-arith.rkt line 51 col 1 - min - unary number
+one-arg-arith.rkt line 52 col 1 - min - unary number
+one-arg-arith.rkt line 53 col 1 - max - unary number
+one-arg-arith.rkt line 54 col 1 - max - unary number
+one-arg-arith.rkt line 55 col 1 - max - unary number
+-12
+-12.0
+0.23809523809523808
+1
+1.0
+1267650600228229401496703205376
+1
+1.0
+1267650600228229401496703205376
+1
+1.0
+1267650600228229401496703205376
+1
+1.0
+1267650600228229401496703205376
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/pair-fun.rkt b/collects/tests/typed-scheme/optimizer/tests/pair-fun.rkt
index 505f290c..35d88957 100644
--- a/collects/tests/typed-scheme/optimizer/tests/pair-fun.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/pair-fun.rkt
@@ -1,3 +1,8 @@
+#;
+(
+pair-fun.rkt line 13 col 7 - car - unary pair
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/quote.rkt b/collects/tests/typed-scheme/optimizer/tests/quote.rkt
index cedbcaf9..a8be9955 100644
--- a/collects/tests/typed-scheme/optimizer/tests/quote.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/quote.rkt
@@ -1,3 +1,8 @@
+#;
+(
+'(+ 1.0 2.0)
+)
+
 #lang typed/scheme
 #:optimize
 '(+ 1.0 2.0)
diff --git a/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt b/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt
index adf87802..b39c9d8d 100644
--- a/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt
@@ -1,3 +1,27 @@
+#;
+(
+real-part-loop.rkt line 32 col 20 - v - unbox inexact-complex
+real-part-loop.rkt line 32 col 10 - real-part - unboxed unary inexact complex
+real-part-loop.rkt line 32 col 9 - (#%app real-part v) - unboxed inexact complex->float
+real-part-loop.rkt line 31 col 13 - v - unboxed var -> table
+real-part-loop.rkt line 31 col 6 - loop - unboxed function -> table
+real-part-loop.rkt line 31 col 6 - loop - fun -> unboxed fun
+real-part-loop.rkt line 32 col 20 - v - unboxed complex variable
+real-part-loop.rkt line 32 col 20 - v - leave var unboxed
+real-part-loop.rkt line 32 col 10 - real-part - unboxed inexact complex
+real-part-loop.rkt line 32 col 7 - > - binary float comp
+real-part-loop.rkt line 34 col 15 - v - leave var unboxed
+real-part-loop.rkt line 34 col 17 - (quote 3.6) - float-coerce-expr in complex ops
+real-part-loop.rkt line 34 col 13 - + - unboxed binary inexact complex
+real-part-loop.rkt line 34 col 7 - loop - unboxed call site
+real-part-loop.rkt line 34 col 7 - loop - call to fun with unboxed args
+real-part-loop.rkt line 31 col 1 - (letrec-values (((loop) (lambda (v) (if (#%app > (#%app real-part v) (quote 70000.2)) (quote 0) (#%app loop (#%app + v (quote 3.6))))))) loop) - unboxed let bindings
+real-part-loop.rkt line 31 col 15 - 0.0+1.0i - unboxed literal
+real-part-loop.rkt line 31 col 1 - (letrec-values (((loop) (lambda (v) (if (#%app > (#%app real-part v) (quote 70000.2)) (quote 0) (#%app loop (#%app + v (quote 3.6))))))) loop) - unboxed call site
+real-part-loop.rkt line 31 col 6 - loop - unboxed let loop
+0
+)
+
 #lang typed/racket/base
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/simple-float.rkt b/collects/tests/typed-scheme/optimizer/tests/simple-float.rkt
index 850c34c9..8d761f47 100644
--- a/collects/tests/typed-scheme/optimizer/tests/simple-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/simple-float.rkt
@@ -1,3 +1,9 @@
+#;
+(
+simple-float.rkt line 10 col 1 - + - binary float
+5.0
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/simple-pair.rkt b/collects/tests/typed-scheme/optimizer/tests/simple-pair.rkt
index b7020283..404b1377 100644
--- a/collects/tests/typed-scheme/optimizer/tests/simple-pair.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/simple-pair.rkt
@@ -1,3 +1,9 @@
+#;
+(
+simple-pair.rkt line 10 col 1 - car - unary pair
+1
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt b/collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt
index af42b1ff..a67456db 100644
--- a/collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt
@@ -1,3 +1,13 @@
+#;
+(
+sqrt-segfault.rkt line 22 col 15 - - - binary float
+sqrt-segfault.rkt line 22 col 0 - (let-values (((dx) (#%app - (quote 0.0) (quote 0.0)))) (let-values (((dist2) (#%app * dx dx))) (let-values (((mag) (let-values (((val) (#%app * dist2 (#%app sqrt dist2)))) (if (#%app inexact-real? val) val (#%app error (quote Assertion failed)))))) (#%app void)))) - unboxed let bindings
+sqrt-segfault.rkt line 23 col 15 - * - binary float
+sqrt-segfault.rkt line 22 col 0 - (let-values (((dist2) (#%app * dx dx))) (let-values (((mag) (let-values (((val) (#%app * dist2 (#%app sqrt dist2)))) (if (#%app inexact-real? val) val (#%app error (quote Assertion failed)))))) (#%app void))) - unboxed let bindings
+sqrt-segfault.rkt line 24 col 14 - (let-values (((val) (#%app * dist2 (#%app sqrt dist2)))) (if (#%app inexact-real? val) val (#%app error (quote Assertion failed)))) - unboxed let bindings
+sqrt-segfault.rkt line 22 col 0 - (let-values (((mag) (let-values (((val) (#%app * dist2 (#%app sqrt dist2)))) (if (#%app inexact-real? val) val (#%app error (quote Assertion failed)))))) (#%app void)) - unboxed let bindings
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/sqrt.rkt b/collects/tests/typed-scheme/optimizer/tests/sqrt.rkt
index 9ff52d70..3f643706 100644
--- a/collects/tests/typed-scheme/optimizer/tests/sqrt.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/sqrt.rkt
@@ -1,3 +1,8 @@
+#;
+(
+sqrt.rkt line 11 col 3 - sqrt - unary float
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/string-length.rkt b/collects/tests/typed-scheme/optimizer/tests/string-length.rkt
index b3053d04..32c2df80 100644
--- a/collects/tests/typed-scheme/optimizer/tests/string-length.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/string-length.rkt
@@ -1,3 +1,11 @@
+#;
+(
+#f line #f col #f - op - string-length
+#f line #f col #f - op - bytes-length
+2
+2
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/structs.rkt b/collects/tests/typed-scheme/optimizer/tests/structs.rkt
index 7ea3763b..190b5904 100644
--- a/collects/tests/typed-scheme/optimizer/tests/structs.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/structs.rkt
@@ -1,3 +1,10 @@
+#;
+(
+structs.rkt line 13 col 1 - pt-x - struct ref
+structs.rkt line 14 col 1 - set-pt-y! - struct set
+3
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/unary-fixnum-nested.rkt b/collects/tests/typed-scheme/optimizer/tests/unary-fixnum-nested.rkt
index 054dcc37..1bd5f21b 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unary-fixnum-nested.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unary-fixnum-nested.rkt
@@ -1,3 +1,10 @@
+#;
+(
+unary-fixnum-nested.rkt line 11 col 6 - bitwise-not - unary fixnum
+unary-fixnum-nested.rkt line 11 col 1 - abs - unary fixnum
+4
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops racket/fixnum)
diff --git a/collects/tests/typed-scheme/optimizer/tests/unary-fixnum.rkt b/collects/tests/typed-scheme/optimizer/tests/unary-fixnum.rkt
index c6183cbe..b5c321c4 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unary-fixnum.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unary-fixnum.rkt
@@ -1,3 +1,9 @@
+#;
+(
+unary-fixnum.rkt line 10 col 1 - bitwise-not - unary fixnum
+-5
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/unary-float.rkt b/collects/tests/typed-scheme/optimizer/tests/unary-float.rkt
index 0f9075a0..59bccafd 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unary-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unary-float.rkt
@@ -1,3 +1,9 @@
+#;
+(
+unary-float.rkt line 10 col 1 - sin - unary float
+0.9092974268256817
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt
index ebc3fc37..71960a72 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt
@@ -1,3 +1,52 @@
+#;
+(
+#f line #f col #f - make-sequence - in-list
+#f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (quote (1.0+2.0i 2.0+4.0i))))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (sum pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%app all-cont? pos i) (#%app for-loop sum (#%app pos-next pos)) sum)) sum)) sum)))) for-loop) (quote 0.0+0.0i) init)) - unboxed let bindings
+unboxed-for.rkt line 57 col 9 - i - unbox inexact-complex
+unboxed-for.rkt line 57 col 11 - sum - unbox inexact-complex
+unboxed-for.rkt line 57 col 7 - + - unboxed binary inexact complex
+unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed inexact complex
+unboxed-for.rkt line 57 col 9 - i - unbox inexact-complex
+unboxed-for.rkt line 57 col 11 - sum - unbox inexact-complex
+unboxed-for.rkt line 57 col 7 - + - unboxed binary inexact complex
+unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed inexact complex
+unboxed-for.rkt line 55 col 31 - sum - unboxed var -> table
+#f line #f col #f - for-loop - unboxed function -> table
+#f line #f col #f - for-loop - fun -> unboxed fun
+unboxed-for.rkt line 55 col 31 - sum - unboxed complex variable
+unboxed-for.rkt line 57 col 9 - i - unbox inexact-complex
+unboxed-for.rkt line 57 col 11 - sum - unbox inexact-complex
+unboxed-for.rkt line 57 col 7 - + - unboxed binary inexact complex
+unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed inexact complex
+#f line #f col #f - (#%app pos->vals pos) - unbox inexact-complex
+#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%app all-cont? pos i) (#%app for-loop sum (#%app pos-next pos)) sum)) sum)) - unboxed let bindings
+unboxed-for.rkt line 56 col 13 - i - unboxed complex variable
+unboxed-for.rkt line 56 col 13 - i - unboxed complex variable
+unboxed-for.rkt line 57 col 9 - i - leave var unboxed
+unboxed-for.rkt line 57 col 11 - sum - unbox inexact-complex
+unboxed-for.rkt line 57 col 7 - + - unboxed binary inexact complex
+unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed inexact complex
+unboxed-for.rkt line 55 col 31 - sum - leave var unboxed
+#f line #f col #f - (let-values (((sum) sum)) (let-values () (#%app + i sum))) - unboxed let bindings
+#f line #f col #f - (let-values () (#%app + i sum)) - unboxed let bindings
+unboxed-for.rkt line 57 col 9 - i - leave var unboxed
+unboxed-for.rkt line 57 col 11 - sum - leave var unboxed
+unboxed-for.rkt line 57 col 7 - + - unboxed binary inexact complex
+unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed inexact complex
+#f line #f col #f - (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%app all-cont? pos i) (#%app for-loop sum (#%app pos-next pos)) sum)) - unboxed let bindings
+unboxed-for.rkt line 56 col 13 - i - unboxed complex variable
+unboxed-for.rkt line 55 col 31 - sum - unbox inexact-complex
+#f line #f col #f - for-loop - unboxed call site
+#f line #f col #f - for-loop - call to fun with unboxed args
+unboxed-for.rkt line 55 col 31 - sum - unboxed complex variable
+unboxed-for.rkt line 55 col 31 - sum - unboxed complex variable
+unboxed-for.rkt line 55 col 0 - (letrec-values (((for-loop) (lambda (sum pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%app all-cont? pos i) (#%app for-loop sum (#%app pos-next pos)) sum)) sum)) sum)))) for-loop) - unboxed let bindings
+unboxed-for.rkt line 55 col 53 - 0.0+0.0i - unboxed literal
+unboxed-for.rkt line 55 col 0 - (letrec-values (((for-loop) (lambda (sum pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%app all-cont? pos i) (#%app for-loop sum (#%app pos-next pos)) sum)) sum)) sum)))) for-loop) - unboxed call site
+#f line #f col #f - for-loop - unboxed let loop
+3.0+6.0i
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions1.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions1.rkt
index ae8623a4..41b456b1 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions1.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions1.rkt
@@ -1,3 +1,25 @@
+#;
+(
+unboxed-let-functions1.rkt line 29 col 45 - x - unbox inexact-complex
+unboxed-let-functions1.rkt line 29 col 47 - 3.0+6.0i - unboxed literal
+unboxed-let-functions1.rkt line 29 col 43 - + - unboxed binary inexact complex
+unboxed-let-functions1.rkt line 29 col 42 - (#%app + x (quote 3.0+6.0i)) - unboxed inexact complex
+unboxed-let-functions1.rkt line 29 col 20 - x - unboxed var -> table
+unboxed-let-functions1.rkt line 29 col 7 - f - unboxed function -> table
+unboxed-let-functions1.rkt line 29 col 7 - f - fun -> unboxed fun
+unboxed-let-functions1.rkt line 29 col 45 - x - leave var unboxed
+unboxed-let-functions1.rkt line 29 col 47 - 3.0+6.0i - unboxed literal
+unboxed-let-functions1.rkt line 29 col 43 - + - unboxed binary inexact complex
+unboxed-let-functions1.rkt line 29 col 42 - (#%app + x (quote 3.0+6.0i)) - unboxed inexact complex
+unboxed-let-functions1.rkt line 29 col 0 - (let-values (((f) (lambda (x) (#%app + x (quote 3.0+6.0i))))) (#%app f (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)))) - unboxed let bindings
+unboxed-let-functions1.rkt line 30 col 8 - 1.0+2.0i - unboxed literal
+unboxed-let-functions1.rkt line 30 col 17 - 2.0+4.0i - unboxed literal
+unboxed-let-functions1.rkt line 30 col 6 - + - unboxed binary inexact complex
+unboxed-let-functions1.rkt line 30 col 3 - f - unboxed call site
+unboxed-let-functions1.rkt line 30 col 3 - f - call to fun with unboxed args
+6.0+12.0i
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions2.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions2.rkt
index 1b2b401f..a6040a56 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions2.rkt
@@ -1,3 +1,31 @@
+#;
+(
+unboxed-let-functions2.rkt line 36 col 21 - x - unbox inexact-complex
+unboxed-let-functions2.rkt line 36 col 23 - y - unbox inexact-complex
+unboxed-let-functions2.rkt line 36 col 19 - + - unboxed binary inexact complex
+unboxed-let-functions2.rkt line 36 col 18 - (#%app + x y) - unboxed inexact complex
+unboxed-let-functions2.rkt line 35 col 20 - x - unboxed var -> table
+unboxed-let-functions2.rkt line 36 col 21 - x - unbox inexact-complex
+unboxed-let-functions2.rkt line 36 col 23 - y - unbox inexact-complex
+unboxed-let-functions2.rkt line 36 col 19 - + - unboxed binary inexact complex
+unboxed-let-functions2.rkt line 36 col 18 - (#%app + x y) - unboxed inexact complex
+unboxed-let-functions2.rkt line 35 col 42 - y - unboxed var -> table
+unboxed-let-functions2.rkt line 35 col 7 - f - unboxed function -> table
+unboxed-let-functions2.rkt line 35 col 7 - f - fun -> unboxed fun
+unboxed-let-functions2.rkt line 36 col 21 - x - leave var unboxed
+unboxed-let-functions2.rkt line 36 col 23 - y - leave var unboxed
+unboxed-let-functions2.rkt line 36 col 19 - + - unboxed binary inexact complex
+unboxed-let-functions2.rkt line 36 col 18 - (#%app + x y) - unboxed inexact complex
+unboxed-let-functions2.rkt line 35 col 0 - (let-values (((f) (lambda (x y) (#%app + x y)))) (#%app f (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) (quote 3.0+6.0i))) - unboxed let bindings
+unboxed-let-functions2.rkt line 37 col 8 - 1.0+2.0i - unboxed literal
+unboxed-let-functions2.rkt line 37 col 17 - 2.0+4.0i - unboxed literal
+unboxed-let-functions2.rkt line 37 col 6 - + - unboxed binary inexact complex
+unboxed-let-functions2.rkt line 38 col 5 - 3.0+6.0i - unboxed literal
+unboxed-let-functions2.rkt line 37 col 3 - f - unboxed call site
+unboxed-let-functions2.rkt line 37 col 3 - f - call to fun with unboxed args
+6.0+12.0i
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions3.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions3.rkt
index 32a0c2d8..2e5a90f2 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions3.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions3.rkt
@@ -1,3 +1,25 @@
+#;
+(
+unboxed-let-functions3.rkt line 30 col 21 - x - unbox inexact-complex
+unboxed-let-functions3.rkt line 30 col 23 - y - float-coerce-expr in complex ops
+unboxed-let-functions3.rkt line 30 col 19 - + - unboxed binary inexact complex
+unboxed-let-functions3.rkt line 30 col 18 - (#%app + x y) - unboxed inexact complex
+unboxed-let-functions3.rkt line 29 col 20 - x - unboxed var -> table
+unboxed-let-functions3.rkt line 29 col 7 - f - unboxed function -> table
+unboxed-let-functions3.rkt line 29 col 7 - f - fun -> unboxed fun
+unboxed-let-functions3.rkt line 30 col 21 - x - leave var unboxed
+unboxed-let-functions3.rkt line 30 col 23 - y - float-coerce-expr in complex ops
+unboxed-let-functions3.rkt line 30 col 19 - + - unboxed binary inexact complex
+unboxed-let-functions3.rkt line 30 col 18 - (#%app + x y) - unboxed inexact complex
+unboxed-let-functions3.rkt line 29 col 0 - (let-values (((f) (lambda (x y) (#%app + x y)))) (#%app f (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) (quote 3.0))) - unboxed let bindings
+unboxed-let-functions3.rkt line 31 col 8 - 1.0+2.0i - unboxed literal
+unboxed-let-functions3.rkt line 31 col 17 - 2.0+4.0i - unboxed literal
+unboxed-let-functions3.rkt line 31 col 6 - + - unboxed binary inexact complex
+unboxed-let-functions3.rkt line 31 col 3 - f - unboxed call site
+unboxed-let-functions3.rkt line 31 col 3 - f - call to fun with unboxed args
+6.0+6.0i
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions4.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions4.rkt
index ec577333..bc294048 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions4.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions4.rkt
@@ -1,3 +1,25 @@
+#;
+(
+unboxed-let-functions4.rkt line 30 col 21 - x - unbox inexact-complex
+unboxed-let-functions4.rkt line 30 col 23 - y - float-coerce-expr in complex ops
+unboxed-let-functions4.rkt line 30 col 19 - + - unboxed binary inexact complex
+unboxed-let-functions4.rkt line 30 col 18 - (#%app + x y) - unboxed inexact complex
+unboxed-let-functions4.rkt line 29 col 32 - x - unboxed var -> table
+unboxed-let-functions4.rkt line 29 col 7 - f - unboxed function -> table
+unboxed-let-functions4.rkt line 29 col 7 - f - fun -> unboxed fun
+unboxed-let-functions4.rkt line 30 col 21 - x - leave var unboxed
+unboxed-let-functions4.rkt line 30 col 23 - y - float-coerce-expr in complex ops
+unboxed-let-functions4.rkt line 30 col 19 - + - unboxed binary inexact complex
+unboxed-let-functions4.rkt line 30 col 18 - (#%app + x y) - unboxed inexact complex
+unboxed-let-functions4.rkt line 29 col 0 - (let-values (((f) (lambda (y x) (#%app + x y)))) (#%app f (quote 3.0) (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)))) - unboxed let bindings
+unboxed-let-functions4.rkt line 32 col 8 - 1.0+2.0i - unboxed literal
+unboxed-let-functions4.rkt line 32 col 17 - 2.0+4.0i - unboxed literal
+unboxed-let-functions4.rkt line 32 col 6 - + - unboxed binary inexact complex
+unboxed-let-functions4.rkt line 31 col 3 - f - unboxed call site
+unboxed-let-functions4.rkt line 31 col 3 - f - call to fun with unboxed args
+6.0+6.0i
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions5.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions5.rkt
index fb5da8d2..0b14144b 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions5.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions5.rkt
@@ -1,3 +1,14 @@
+#;
+(
+unboxed-let-functions5.rkt line 20 col 22 - (let-values (((y) f)) x) - unboxed let bindings
+unboxed-let-functions5.rkt line 18 col 0 - (letrec-values (((f) (lambda (x) (let-values (((y) f)) x)))) (#%app f (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)))) - unboxed let bindings
+unboxed-let-functions5.rkt line 22 col 15 - 1.0+2.0i - unboxed literal
+unboxed-let-functions5.rkt line 22 col 24 - 2.0+4.0i - unboxed literal
+unboxed-let-functions5.rkt line 22 col 13 - + - unboxed binary inexact complex
+unboxed-let-functions5.rkt line 22 col 12 - (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) - unboxed inexact complex
+3.0+6.0i
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt
index 31fae6f1..6bac579c 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt
@@ -1,3 +1,30 @@
+#;
+(
+unboxed-let-functions6.rkt line 36 col 13 - z - unbox inexact-complex
+unboxed-let-functions6.rkt line 36 col 15 - 0.0+1.0i - unboxed literal
+unboxed-let-functions6.rkt line 36 col 11 - + - unboxed binary inexact complex
+unboxed-let-functions6.rkt line 36 col 10 - (#%app + z (quote 0.0+1.0i)) - unboxed inexact complex
+unboxed-let-functions6.rkt line 33 col 31 - z - unboxed var -> table
+unboxed-let-functions6.rkt line 33 col 6 - loop - unboxed function -> table
+unboxed-let-functions6.rkt line 33 col 6 - loop - fun -> unboxed fun
+unboxed-let-functions6.rkt line 36 col 13 - z - leave var unboxed
+unboxed-let-functions6.rkt line 36 col 15 - 0.0+1.0i - unboxed literal
+unboxed-let-functions6.rkt line 36 col 11 - + - unboxed binary inexact complex
+unboxed-let-functions6.rkt line 36 col 10 - (#%app + z (quote 0.0+1.0i)) - unboxed inexact complex
+unboxed-let-functions6.rkt line 37 col 19 - z - leave var unboxed
+unboxed-let-functions6.rkt line 37 col 22 - car - unary pair
+unboxed-let-functions6.rkt line 37 col 21 - (#%app car l) - float-coerce-expr in complex ops
+unboxed-let-functions6.rkt line 37 col 17 - + - unboxed binary inexact complex
+unboxed-let-functions6.rkt line 37 col 11 - loop - unboxed call site
+unboxed-let-functions6.rkt line 38 col 17 - cdr - unary pair
+unboxed-let-functions6.rkt line 37 col 11 - loop - call to fun with unboxed args
+#f line #f col #f - (letrec-values (((loop) (lambda (z l) (if (#%app null? l) (#%app + z (quote 0.0+1.0i)) (#%app loop (#%app + z (#%app car l)) (#%app cdr l)))))) loop) - unboxed let bindings
+unboxed-let-functions6.rkt line 33 col 51 - 0.0+0.0i - unboxed literal
+#f line #f col #f - (letrec-values (((loop) (lambda (z l) (if (#%app null? l) (#%app + z (quote 0.0+1.0i)) (#%app loop (#%app + z (#%app car l)) (#%app cdr l)))))) loop) - unboxed call site
+unboxed-let-functions6.rkt line 33 col 6 - loop - unboxed let loop
+6.0+1.0i
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt
index b60a7eec..59f5242d 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt
@@ -1,3 +1,28 @@
+#;
+(
+unboxed-let-functions7.rkt line 35 col 15 - z - unbox inexact-complex
+unboxed-let-functions7.rkt line 35 col 18 - car - unary pair
+unboxed-let-functions7.rkt line 35 col 17 - (#%app car l) - float-coerce-expr in complex ops
+unboxed-let-functions7.rkt line 35 col 13 - + - unboxed binary inexact complex
+unboxed-let-functions7.rkt line 35 col 12 - (#%app + z (#%app car l)) - unboxed inexact complex
+unboxed-let-functions7.rkt line 31 col 31 - z - unboxed var -> table
+unboxed-let-functions7.rkt line 31 col 6 - loop - unboxed function -> table
+unboxed-let-functions7.rkt line 31 col 6 - loop - fun -> unboxed fun
+unboxed-let-functions7.rkt line 34 col 6 - z - unboxed complex variable
+unboxed-let-functions7.rkt line 35 col 15 - z - leave var unboxed
+unboxed-let-functions7.rkt line 35 col 18 - car - unary pair
+unboxed-let-functions7.rkt line 35 col 17 - (#%app car l) - float-coerce-expr in complex ops
+unboxed-let-functions7.rkt line 35 col 13 - + - unboxed binary inexact complex
+unboxed-let-functions7.rkt line 35 col 7 - loop - unboxed call site
+unboxed-let-functions7.rkt line 36 col 13 - cdr - unary pair
+unboxed-let-functions7.rkt line 35 col 7 - loop - call to fun with unboxed args
+#f line #f col #f - (letrec-values (((loop) (lambda (z l) (if (#%app null? l) z (#%app loop (#%app + z (#%app car l)) (#%app cdr l)))))) loop) - unboxed let bindings
+unboxed-let-functions7.rkt line 31 col 51 - 0.0+0.0i - unboxed literal
+#f line #f col #f - (letrec-values (((loop) (lambda (z l) (if (#%app null? l) z (#%app loop (#%app + z (#%app car l)) (#%app cdr l)))))) loop) - unboxed call site
+unboxed-let-functions7.rkt line 31 col 6 - loop - unboxed let loop
+6.0+0.0i
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions8.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions8.rkt
index 88610a8c..45aae88c 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions8.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions8.rkt
@@ -1,3 +1,13 @@
+#;
+(
+unboxed-let-functions8.rkt line 16 col 67 - x - unbox inexact-complex
+unboxed-let-functions8.rkt line 16 col 69 - 2.0+4.0i - unboxed literal
+unboxed-let-functions8.rkt line 16 col 65 - + - unboxed binary inexact complex
+unboxed-let-functions8.rkt line 16 col 64 - (#%app + x (quote 2.0+4.0i)) - unboxed inexact complex
+unboxed-let-functions8.rkt line 16 col 0 - (letrec-values (((f) (lambda (x) (#%app + x (quote 2.0+4.0i)))) ((g) f)) (#%app f (quote 1.0+2.0i))) - unboxed let bindings
+3.0+6.0i
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let.rkt
index faa7be8a..b785896a 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let.rkt
@@ -1,3 +1,34 @@
+#;
+(
+unboxed-let.rkt line 38 col 14 - t1 - unbox inexact-complex
+unboxed-let.rkt line 38 col 17 - 3.0+6.0i - unboxed literal
+unboxed-let.rkt line 38 col 12 - - - unboxed binary inexact complex
+unboxed-let.rkt line 38 col 11 - (#%app - t1 (quote 3.0+6.0i)) - unboxed inexact complex
+unboxed-let.rkt line 37 col 14 - 1.0+2.0i - unboxed literal
+unboxed-let.rkt line 37 col 23 - 2.0+4.0i - unboxed literal
+unboxed-let.rkt line 37 col 12 - + - unboxed binary inexact complex
+unboxed-let.rkt line 37 col 0 - (let-values (((t1) (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)))) (let-values (((t2) (#%app - t1 (quote 3.0+6.0i)))) (let-values (((t3) (quote 4.0+8.0i))) (#%app + t2 t3)))) - unboxed let bindings
+unboxed-let.rkt line 40 col 5 - t2 - unbox inexact-complex
+unboxed-let.rkt line 40 col 8 - t3 - unbox inexact-complex
+unboxed-let.rkt line 40 col 3 - + - unboxed binary inexact complex
+unboxed-let.rkt line 40 col 2 - (#%app + t2 t3) - unboxed inexact complex
+unboxed-let.rkt line 38 col 14 - t1 - leave var unboxed
+unboxed-let.rkt line 38 col 17 - 3.0+6.0i - unboxed literal
+unboxed-let.rkt line 38 col 12 - - - unboxed binary inexact complex
+unboxed-let.rkt line 37 col 0 - (let-values (((t2) (#%app - t1 (quote 3.0+6.0i)))) (let-values (((t3) (quote 4.0+8.0i))) (#%app + t2 t3))) - unboxed let bindings
+unboxed-let.rkt line 40 col 5 - t2 - leave var unboxed
+unboxed-let.rkt line 40 col 8 - t3 - unbox inexact-complex
+unboxed-let.rkt line 40 col 3 - + - unboxed binary inexact complex
+unboxed-let.rkt line 40 col 2 - (#%app + t2 t3) - unboxed inexact complex
+unboxed-let.rkt line 39 col 11 - 4.0+8.0i - unboxed literal
+unboxed-let.rkt line 37 col 0 - (let-values (((t3) (quote 4.0+8.0i))) (#%app + t2 t3)) - unboxed let bindings
+unboxed-let.rkt line 40 col 5 - t2 - leave var unboxed
+unboxed-let.rkt line 40 col 8 - t3 - leave var unboxed
+unboxed-let.rkt line 40 col 3 - + - unboxed binary inexact complex
+unboxed-let.rkt line 40 col 2 - (#%app + t2 t3) - unboxed inexact complex
+4.0+8.0i
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let2.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let2.rkt
index fc47b9a2..84eff33f 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let2.rkt
@@ -1,3 +1,27 @@
+#;
+(
+unboxed-let2.rkt line 32 col 5 - t1 - unbox inexact-complex
+unboxed-let2.rkt line 32 col 8 - t2 - unbox inexact-complex
+unboxed-let2.rkt line 32 col 3 - + - unboxed binary inexact complex
+unboxed-let2.rkt line 32 col 2 - (#%app + t1 t2) - unboxed inexact complex
+unboxed-let2.rkt line 32 col 5 - t1 - unbox inexact-complex
+unboxed-let2.rkt line 32 col 8 - t2 - unbox inexact-complex
+unboxed-let2.rkt line 32 col 3 - + - unboxed binary inexact complex
+unboxed-let2.rkt line 32 col 2 - (#%app + t1 t2) - unboxed inexact complex
+unboxed-let2.rkt line 30 col 13 - 1.0+2.0i - unboxed literal
+unboxed-let2.rkt line 30 col 22 - 2.0+4.0i - unboxed literal
+unboxed-let2.rkt line 30 col 11 - + - unboxed binary inexact complex
+unboxed-let2.rkt line 31 col 13 - 3.0+6.0i - unboxed literal
+unboxed-let2.rkt line 31 col 22 - 4.0+8.0i - unboxed literal
+unboxed-let2.rkt line 31 col 11 - + - unboxed binary inexact complex
+unboxed-let2.rkt line 30 col 0 - (let-values (((t1) (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i))) ((t2) (#%app + (quote 3.0+6.0i) (quote 4.0+8.0i)))) (#%app + t1 t2)) - unboxed let bindings
+unboxed-let2.rkt line 32 col 5 - t1 - leave var unboxed
+unboxed-let2.rkt line 32 col 8 - t2 - leave var unboxed
+unboxed-let2.rkt line 32 col 3 - + - unboxed binary inexact complex
+unboxed-let2.rkt line 32 col 2 - (#%app + t1 t2) - unboxed inexact complex
+10.0+20.0i
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let3.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let3.rkt
index 2ca3e9d1..77e149d1 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let3.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let3.rkt
@@ -1,3 +1,21 @@
+#;
+(
+unboxed-let3.rkt line 34 col 9 - x - unbox inexact-complex
+unboxed-let3.rkt line 34 col 11 - 2.0+4.0i - unboxed literal
+unboxed-let3.rkt line 34 col 7 - + - unboxed binary inexact complex
+unboxed-let3.rkt line 34 col 6 - (#%app + x (quote 2.0+4.0i)) - unboxed inexact complex
+unboxed-let3.rkt line 31 col 12 - 1.0+2.0i - unboxed literal
+unboxed-let3.rkt line 31 col 21 - 2.0+4.0i - unboxed literal
+unboxed-let3.rkt line 31 col 10 - + - unboxed binary inexact complex
+unboxed-let3.rkt line 31 col 0 - (let-values (((x) (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)))) (if (#%app even? (quote 2)) x (#%app + x (quote 2.0+4.0i)))) - unboxed let bindings
+unboxed-let3.rkt line 33 col 6 - x - unboxed complex variable
+unboxed-let3.rkt line 34 col 9 - x - leave var unboxed
+unboxed-let3.rkt line 34 col 11 - 2.0+4.0i - unboxed literal
+unboxed-let3.rkt line 34 col 7 - + - unboxed binary inexact complex
+unboxed-let3.rkt line 34 col 6 - (#%app + x (quote 2.0+4.0i)) - unboxed inexact complex
+3.0+6.0i
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec-syntaxes+values.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec-syntaxes+values.rkt
index ae3c43b4..71d54170 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec-syntaxes+values.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec-syntaxes+values.rkt
@@ -1,3 +1,20 @@
+#;
+(
+unboxed-letrec-syntaxes+values.rkt line 25 col 27 - x - unbox inexact-complex
+unboxed-letrec-syntaxes+values.rkt line 25 col 29 - 2.0+4.0i - unboxed literal
+unboxed-letrec-syntaxes+values.rkt line 25 col 25 - + - unboxed binary inexact complex
+unboxed-letrec-syntaxes+values.rkt line 25 col 24 - (#%app + x (quote 2.0+4.0i)) - unboxed inexact complex
+unboxed-letrec-syntaxes+values.rkt line 24 col 33 - 1.0+2.0i - unboxed literal
+unboxed-letrec-syntaxes+values.rkt line 24 col 42 - 2.0+4.0i - unboxed literal
+unboxed-letrec-syntaxes+values.rkt line 24 col 31 - + - unboxed binary inexact complex
+unboxed-letrec-syntaxes+values.rkt line 23 col 0 - (letrec-syntaxes+values (((s) (syntax-rules () ((_ x) x)))) (((x) (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)))) (#%app + x (quote 2.0+4.0i))) - unboxed let bindings
+unboxed-letrec-syntaxes+values.rkt line 25 col 27 - x - leave var unboxed
+unboxed-letrec-syntaxes+values.rkt line 25 col 29 - 2.0+4.0i - unboxed literal
+unboxed-letrec-syntaxes+values.rkt line 25 col 25 - + - unboxed binary inexact complex
+unboxed-letrec-syntaxes+values.rkt line 25 col 24 - (#%app + x (quote 2.0+4.0i)) - unboxed inexact complex
+5.0+10.0i
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec.rkt
index c70b05d2..5a52c7dc 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec.rkt
@@ -1,3 +1,25 @@
+#;
+(
+unboxed-letrec.rkt line 31 col 5 - x - unbox inexact-complex
+unboxed-letrec.rkt line 31 col 7 - y - unbox inexact-complex
+unboxed-letrec.rkt line 31 col 3 - + - unboxed binary inexact complex
+unboxed-letrec.rkt line 31 col 2 - (#%app + x y) - unboxed inexact complex
+unboxed-letrec.rkt line 31 col 5 - x - unbox inexact-complex
+unboxed-letrec.rkt line 31 col 7 - y - unbox inexact-complex
+unboxed-letrec.rkt line 31 col 3 - + - unboxed binary inexact complex
+unboxed-letrec.rkt line 31 col 2 - (#%app + x y) - unboxed inexact complex
+unboxed-letrec.rkt line 29 col 31 - 1.0+2.0i - unboxed literal
+unboxed-letrec.rkt line 30 col 34 - 2.0+4.0i - unboxed literal
+unboxed-letrec.rkt line 30 col 43 - 3.0+6.0i - unboxed literal
+unboxed-letrec.rkt line 30 col 32 - + - unboxed binary inexact complex
+unboxed-letrec.rkt line 28 col 0 - (letrec-values (((f) (lambda (x) (#%app f x))) ((x) (quote 1.0+2.0i)) ((y) (#%app + (quote 2.0+4.0i) (quote 3.0+6.0i)))) (#%app + x y)) - unboxed let bindings
+unboxed-letrec.rkt line 31 col 5 - x - leave var unboxed
+unboxed-letrec.rkt line 31 col 7 - y - leave var unboxed
+unboxed-letrec.rkt line 31 col 3 - + - unboxed binary inexact complex
+unboxed-letrec.rkt line 31 col 2 - (#%app + x y) - unboxed inexact complex
+6.0+12.0i
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-make-rectangular.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-make-rectangular.rkt
index eeffd93a..6cd9a776 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-make-rectangular.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-make-rectangular.rkt
@@ -1,3 +1,29 @@
+#;
+(
+unboxed-make-rectangular.rkt line 33 col 5 - x - unbox inexact-complex
+unboxed-make-rectangular.rkt line 33 col 7 - 2.0+4.0i - unboxed literal
+unboxed-make-rectangular.rkt line 33 col 3 - + - unboxed binary inexact complex
+unboxed-make-rectangular.rkt line 33 col 2 - (#%app + x (quote 2.0+4.0i)) - unboxed inexact complex
+unboxed-make-rectangular.rkt line 32 col 10 - make-rectangular - make-rectangular elimination
+unboxed-make-rectangular.rkt line 32 col 0 - (let-values (((x) (#%app make-rectangular (quote 1.0) (quote 2.0)))) (#%app + x (quote 2.0+4.0i))) - unboxed let bindings
+unboxed-make-rectangular.rkt line 33 col 5 - x - leave var unboxed
+unboxed-make-rectangular.rkt line 33 col 7 - 2.0+4.0i - unboxed literal
+unboxed-make-rectangular.rkt line 33 col 3 - + - unboxed binary inexact complex
+unboxed-make-rectangular.rkt line 33 col 2 - (#%app + x (quote 2.0+4.0i)) - unboxed inexact complex
+unboxed-make-rectangular.rkt line 35 col 5 - x - unbox inexact-complex
+unboxed-make-rectangular.rkt line 35 col 7 - 2.0+4.0i - unboxed literal
+unboxed-make-rectangular.rkt line 35 col 3 - + - unboxed binary inexact complex
+unboxed-make-rectangular.rkt line 35 col 2 - (#%app + x (quote 2.0+4.0i)) - unboxed inexact complex
+unboxed-make-rectangular.rkt line 34 col 10 - unsafe-make-flrectangular - make-rectangular elimination
+unboxed-make-rectangular.rkt line 34 col 0 - (let-values (((x) (#%app unsafe-make-flrectangular (quote 1.0) (quote 2.0)))) (#%app + x (quote 2.0+4.0i))) - unboxed let bindings
+unboxed-make-rectangular.rkt line 35 col 5 - x - leave var unboxed
+unboxed-make-rectangular.rkt line 35 col 7 - 2.0+4.0i - unboxed literal
+unboxed-make-rectangular.rkt line 35 col 3 - + - unboxed binary inexact complex
+unboxed-make-rectangular.rkt line 35 col 2 - (#%app + x (quote 2.0+4.0i)) - unboxed inexact complex
+3.0+6.0i
+3.0+6.0i
+)
+
 #lang typed/scheme
 #:optimize
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-length-nested.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-length-nested.rkt
index 81bf26b2..5bcd563b 100644
--- a/collects/tests/typed-scheme/optimizer/tests/vector-length-nested.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/vector-length-nested.rkt
@@ -1,3 +1,10 @@
+#;
+(
+vector-length-nested.rkt line 11 col 1 - vector-length - vector-length
+vector-length-nested.rkt line 12 col 2 - vector-ref - vector
+2
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-length.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-length.rkt
index 7992fb63..65778288 100644
--- a/collects/tests/typed-scheme/optimizer/tests/vector-length.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/vector-length.rkt
@@ -1,3 +1,9 @@
+#;
+(
+vector-length.rkt line 10 col 1 - vector-length - vector-length
+3
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-ref-set-ref.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-ref-set-ref.rkt
index 8833301a..03f9fb71 100644
--- a/collects/tests/typed-scheme/optimizer/tests/vector-ref-set-ref.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/vector-ref-set-ref.rkt
@@ -1,3 +1,12 @@
+#;
+(
+vector-ref-set-ref.rkt line 15 col 1 - vector-ref - vector
+vector-ref-set-ref.rkt line 16 col 1 - vector-set! - vector
+vector-ref-set-ref.rkt line 17 col 1 - vector-ref - vector
+1
+"2"
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-ref.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-ref.rkt
index 1f149356..80796658 100644
--- a/collects/tests/typed-scheme/optimizer/tests/vector-ref.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/vector-ref.rkt
@@ -1,3 +1,9 @@
+#;
+(
+vector-ref.rkt line 10 col 1 - vector-ref - vector
+1
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-ref2.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-ref2.rkt
index e9cf5ee5..49f50d54 100644
--- a/collects/tests/typed-scheme/optimizer/tests/vector-ref2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/vector-ref2.rkt
@@ -1,3 +1,9 @@
+#;
+(
+vector-ref2.rkt line 10 col 1 - vector-ref - vector
+1
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-set-quote.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-set-quote.rkt
index 5243c3f3..209bc9e0 100644
--- a/collects/tests/typed-scheme/optimizer/tests/vector-set-quote.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/vector-set-quote.rkt
@@ -1,3 +1,8 @@
+#;
+(
+vector-set-quote.rkt line 9 col 1 - vector-set! - vector
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-set.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-set.rkt
index d01f53c5..d3b26758 100644
--- a/collects/tests/typed-scheme/optimizer/tests/vector-set.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/vector-set.rkt
@@ -1,3 +1,8 @@
+#;
+(
+vector-set.rkt line 9 col 1 - vector-set! - vector
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-set2.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-set2.rkt
index d66ff004..d9661383 100644
--- a/collects/tests/typed-scheme/optimizer/tests/vector-set2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/vector-set2.rkt
@@ -1,3 +1,8 @@
+#;
+(
+vector-set2.rkt line 9 col 1 - vector-set! - vector
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)
diff --git a/collects/tests/typed-scheme/optimizer/tests/zero.rkt b/collects/tests/typed-scheme/optimizer/tests/zero.rkt
index e853019b..411edd09 100644
--- a/collects/tests/typed-scheme/optimizer/tests/zero.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/zero.rkt
@@ -1,3 +1,12 @@
+#;
+(
+zero.rkt line 13 col 1 - zero? - fixnum zero?
+zero.rkt line 14 col 8 - sqrt - unary float
+zero.rkt line 14 col 1 - zero? - float zero?
+#f
+#f
+)
+
 #lang typed/scheme
 #:optimize
 (require racket/unsafe/ops)

From 66770afa1cd4ac8f7f8ed153cd094f9216fb2dba Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 8 Sep 2010 16:03:34 -0400
Subject: [PATCH 126/198] Removed unused exports.

original commit: 85550953c8b484da89bb107f7785c4e8e1188e2c
---
 collects/typed-scheme/optimizer/float.rkt | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-scheme/optimizer/float.rkt
index 386f69da..c367b746 100644
--- a/collects/typed-scheme/optimizer/float.rkt
+++ b/collects/typed-scheme/optimizer/float.rkt
@@ -7,7 +7,7 @@
          (types abbrev type-table utils subtype)
          (optimizer utils fixnum))
 
-(provide float-opt-expr float-expr int-expr float-coerce-expr)
+(provide float-opt-expr float-coerce-expr)
 
 
 (define (mk-float-tbl generic)

From 51faa45faa762556fa6ae4901427e6dd4ff71420 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 8 Sep 2010 16:25:00 -0400
Subject: [PATCH 127/198] Removed useless requires.

original commit: 6e5ea420a1bad921ab07788c64df6a2daaa933af
---
 collects/typed-scheme/optimizer/apply.rkt           | 5 -----
 collects/typed-scheme/optimizer/box.rkt             | 6 +++---
 collects/typed-scheme/optimizer/dead-code.rkt       | 2 +-
 collects/typed-scheme/optimizer/fixnum.rkt          | 2 +-
 collects/typed-scheme/optimizer/float.rkt           | 4 ++--
 collects/typed-scheme/optimizer/inexact-complex.rkt | 4 ++--
 collects/typed-scheme/optimizer/number.rkt          | 2 +-
 collects/typed-scheme/optimizer/optimizer.rkt       | 6 +-----
 collects/typed-scheme/optimizer/pair.rkt            | 5 ++---
 collects/typed-scheme/optimizer/sequence.rkt        | 5 ++---
 collects/typed-scheme/optimizer/string.rkt          | 4 ++--
 collects/typed-scheme/optimizer/struct.rkt          | 5 +----
 collects/typed-scheme/optimizer/utils.rkt           | 4 ++--
 collects/typed-scheme/optimizer/vector.rkt          | 4 ++--
 14 files changed, 22 insertions(+), 36 deletions(-)

diff --git a/collects/typed-scheme/optimizer/apply.rkt b/collects/typed-scheme/optimizer/apply.rkt
index 7ed6191c..e85c2dee 100644
--- a/collects/typed-scheme/optimizer/apply.rkt
+++ b/collects/typed-scheme/optimizer/apply.rkt
@@ -1,12 +1,7 @@
 #lang scheme/base
 (require syntax/parse
-         syntax/id-table racket/dict
-         unstable/match racket/match
          (for-template scheme/unsafe/ops racket/base (prefix-in k: '#%kernel))
-         (for-syntax racket/base)
          "../utils/utils.rkt"
-         (rep type-rep)
-         (types abbrev type-table utils subtype)
          (optimizer utils))
 
 (provide apply-opt-expr)
diff --git a/collects/typed-scheme/optimizer/box.rkt b/collects/typed-scheme/optimizer/box.rkt
index a54d8d1b..7ad707e7 100644
--- a/collects/typed-scheme/optimizer/box.rkt
+++ b/collects/typed-scheme/optimizer/box.rkt
@@ -1,11 +1,11 @@
 #lang scheme/base
 
 (require syntax/parse
-         unstable/match racket/match
+         racket/match
          "../utils/utils.rkt"
-         (for-template scheme/base scheme/fixnum scheme/unsafe/ops)
+         (for-template scheme/base scheme/unsafe/ops)
          (rep type-rep)
-         (types abbrev type-table utils subtype)
+         (types type-table utils)
          (optimizer utils))
 
 (provide box-opt-expr)
diff --git a/collects/typed-scheme/optimizer/dead-code.rkt b/collects/typed-scheme/optimizer/dead-code.rkt
index eb2c5ba7..c6ba8180 100644
--- a/collects/typed-scheme/optimizer/dead-code.rkt
+++ b/collects/typed-scheme/optimizer/dead-code.rkt
@@ -2,7 +2,7 @@
 
 (require syntax/parse
          (for-template scheme/base)
-         "../utils/utils.rkt" "../utils/tc-utils.rkt"
+         "../utils/utils.rkt"
          (types type-table)
          (optimizer utils))
 
diff --git a/collects/typed-scheme/optimizer/fixnum.rkt b/collects/typed-scheme/optimizer/fixnum.rkt
index 5aefac8f..0573112c 100644
--- a/collects/typed-scheme/optimizer/fixnum.rkt
+++ b/collects/typed-scheme/optimizer/fixnum.rkt
@@ -3,7 +3,7 @@
 (require syntax/parse
          "../utils/utils.rkt"
          (for-template scheme/base scheme/fixnum scheme/unsafe/ops)
-         (types abbrev type-table utils subtype)
+         (types abbrev)
          (optimizer utils))
 
 (provide fixnum-expr fixnum-opt-expr)
diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-scheme/optimizer/float.rkt
index c367b746..f91ec25a 100644
--- a/collects/typed-scheme/optimizer/float.rkt
+++ b/collects/typed-scheme/optimizer/float.rkt
@@ -1,10 +1,10 @@
 #lang scheme/base
 
 (require syntax/parse
-         syntax/id-table racket/dict racket/flonum
+         racket/dict racket/flonum
          (for-template scheme/base racket/flonum scheme/unsafe/ops)
          "../utils/utils.rkt"
-         (types abbrev type-table utils subtype)
+         (types abbrev)
          (optimizer utils fixnum))
 
 (provide float-opt-expr float-coerce-expr)
diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/inexact-complex.rkt
index 5bade6cc..31bc734b 100644
--- a/collects/typed-scheme/optimizer/inexact-complex.rkt
+++ b/collects/typed-scheme/optimizer/inexact-complex.rkt
@@ -3,8 +3,8 @@
 (require syntax/parse syntax/id-table scheme/dict
          "../utils/utils.rkt" racket/unsafe/ops
          (for-template scheme/base scheme/math racket/flonum scheme/unsafe/ops)
-         (types abbrev type-table utils subtype)
-         (optimizer utils float fixnum))
+         (types abbrev)
+         (optimizer utils float))
 
 (provide inexact-complex-opt-expr
          inexact-complex-arith-opt-expr
diff --git a/collects/typed-scheme/optimizer/number.rkt b/collects/typed-scheme/optimizer/number.rkt
index 5e051571..310eec3b 100644
--- a/collects/typed-scheme/optimizer/number.rkt
+++ b/collects/typed-scheme/optimizer/number.rkt
@@ -1,7 +1,7 @@
 #lang scheme/base
 
 (require syntax/parse
-         (for-template scheme/base racket/flonum scheme/unsafe/ops)
+         (for-template scheme/base)
          "../utils/utils.rkt"
          (optimizer utils))
 
diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt
index d0e9550b..685e1a9e 100644
--- a/collects/typed-scheme/optimizer/optimizer.rkt
+++ b/collects/typed-scheme/optimizer/optimizer.rkt
@@ -1,13 +1,9 @@
 #lang scheme/base
 
 (require syntax/parse 
-         syntax/id-table racket/dict
          racket/pretty
-         (for-template scheme/base
-                       racket/flonum scheme/fixnum scheme/unsafe/ops
-                       racket/private/for)
+         (for-template scheme/base)
          "../utils/utils.rkt"
-         (types abbrev type-table utils subtype)
          (optimizer utils number fixnum float inexact-complex vector string
                     pair sequence box struct dead-code apply unboxed-let))
 
diff --git a/collects/typed-scheme/optimizer/pair.rkt b/collects/typed-scheme/optimizer/pair.rkt
index 8bab0ab7..6202645c 100644
--- a/collects/typed-scheme/optimizer/pair.rkt
+++ b/collects/typed-scheme/optimizer/pair.rkt
@@ -1,12 +1,11 @@
 #lang scheme/base
 
 (require syntax/parse
-         syntax/id-table racket/dict
-         unstable/match racket/match
+         racket/match
          (for-template scheme/base scheme/unsafe/ops)
          "../utils/utils.rkt"
          (rep type-rep)
-         (types abbrev type-table utils subtype)
+         (types type-table utils)
          (optimizer utils))
 
 (provide pair-opt-expr)
diff --git a/collects/typed-scheme/optimizer/sequence.rkt b/collects/typed-scheme/optimizer/sequence.rkt
index 3d333acf..f050e91e 100644
--- a/collects/typed-scheme/optimizer/sequence.rkt
+++ b/collects/typed-scheme/optimizer/sequence.rkt
@@ -1,12 +1,11 @@
 #lang scheme/base
 
 (require syntax/parse
-         syntax/id-table racket/dict
-         unstable/match racket/match
+         racket/match
          (for-template scheme/base scheme/unsafe/ops)
          "../utils/utils.rkt" "../utils/tc-utils.rkt"
          (rep type-rep)
-         (types abbrev type-table utils subtype)
+         (types abbrev type-table utils)
          (optimizer utils string))
 
 (provide sequence-opt-expr)
diff --git a/collects/typed-scheme/optimizer/string.rkt b/collects/typed-scheme/optimizer/string.rkt
index 18f09bee..66ac4b6f 100644
--- a/collects/typed-scheme/optimizer/string.rkt
+++ b/collects/typed-scheme/optimizer/string.rkt
@@ -1,9 +1,9 @@
 #lang scheme/base
 
 (require syntax/parse
-         (for-template scheme/base racket/flonum scheme/unsafe/ops)
+         (for-template scheme/base scheme/unsafe/ops)
          "../utils/utils.rkt"
-         (types abbrev type-table utils subtype)
+         (types abbrev)
          (optimizer utils))
 
 (provide string-opt-expr string-expr bytes-expr)
diff --git a/collects/typed-scheme/optimizer/struct.rkt b/collects/typed-scheme/optimizer/struct.rkt
index 48b02f07..fac20889 100644
--- a/collects/typed-scheme/optimizer/struct.rkt
+++ b/collects/typed-scheme/optimizer/struct.rkt
@@ -1,12 +1,9 @@
 #lang scheme/base
 
 (require syntax/parse
-         syntax/id-table racket/dict
-         unstable/match racket/match
          (for-template scheme/base scheme/unsafe/ops)
          "../utils/utils.rkt"
-         (rep type-rep)
-         (types abbrev type-table utils subtype)
+         (types type-table)
          (optimizer utils))
 
 (provide struct-opt-expr)
diff --git a/collects/typed-scheme/optimizer/utils.rkt b/collects/typed-scheme/optimizer/utils.rkt
index 49c2765a..f442698c 100644
--- a/collects/typed-scheme/optimizer/utils.rkt
+++ b/collects/typed-scheme/optimizer/utils.rkt
@@ -2,9 +2,9 @@
 
 (require unstable/match racket/match
          racket/dict syntax/id-table unstable/syntax
-         (for-template scheme/base racket/flonum scheme/fixnum scheme/unsafe/ops)
          "../utils/utils.rkt"
-         (types abbrev type-table utils subtype)
+         (for-template scheme/base)
+         (types type-table utils subtype)
          (rep type-rep))
 
 (provide log-optimization *log-optimizations?* *log-optimizatons-to-log-file?*
diff --git a/collects/typed-scheme/optimizer/vector.rkt b/collects/typed-scheme/optimizer/vector.rkt
index dff88f05..6e3195d9 100644
--- a/collects/typed-scheme/optimizer/vector.rkt
+++ b/collects/typed-scheme/optimizer/vector.rkt
@@ -1,11 +1,11 @@
 #lang scheme/base
 
 (require syntax/parse
-         unstable/match racket/match
+         racket/match
          (for-template scheme/base racket/flonum scheme/unsafe/ops)
          "../utils/utils.rkt"
          (rep type-rep)
-         (types abbrev type-table utils subtype)
+         (types type-table utils)
          (optimizer utils))
 
 (provide vector-opt-expr)

From dee0ddc16e9458306cc672f8ccc6431862050ed7 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 9 Sep 2010 17:02:46 -0400
Subject: [PATCH 128/198] Extended pair optimizations to some derived pair
 accessors.

original commit: 024f873947bb5664b92cd68be55653b2ca4a24ee
---
 .../optimizer/tests/define-pair.rkt           |  2 +-
 .../optimizer/tests/derived-pair.rkt          | 30 ++++++++++++
 .../optimizer/tests/nested-let-loop.rkt       |  8 +--
 .../optimizer/tests/nested-pair1.rkt          |  4 +-
 .../optimizer/tests/nested-pair2.rkt          |  4 +-
 .../typed-scheme/optimizer/tests/pair-fun.rkt |  2 +-
 .../tests/pair-known-length-list.rkt          | 32 ++++++++++++
 .../optimizer/tests/simple-pair.rkt           |  2 +-
 .../tests/unboxed-let-functions6.rkt          |  4 +-
 .../tests/unboxed-let-functions7.rkt          |  6 +--
 collects/typed-scheme/optimizer/pair.rkt      | 49 +++++++++++++++++--
 11 files changed, 124 insertions(+), 19 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/derived-pair.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/pair-known-length-list.rkt

diff --git a/collects/tests/typed-scheme/optimizer/tests/define-pair.rkt b/collects/tests/typed-scheme/optimizer/tests/define-pair.rkt
index 379dcf8c..28036634 100644
--- a/collects/tests/typed-scheme/optimizer/tests/define-pair.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/define-pair.rkt
@@ -1,6 +1,6 @@
 #;
 (
-define-pair.rkt line 9 col 11 - car - unary pair
+define-pair.rkt line 9 col 11 - car - pair
 )
 
 #lang typed/scheme
diff --git a/collects/tests/typed-scheme/optimizer/tests/derived-pair.rkt b/collects/tests/typed-scheme/optimizer/tests/derived-pair.rkt
new file mode 100644
index 00000000..26dbab51
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/derived-pair.rkt
@@ -0,0 +1,30 @@
+#;
+(
+pair.rkt line 81 col 45 - car - pair
+pair.rkt line 81 col 39 - car - pair
+derived-pair.rkt line 27 col 0 - (#%app caar (#%app cons (#%app cons (quote 1) (quote 2)
+) (quote 3))) - derived pair                                                           
+pair.rkt line 83 col 45 - cdr - pair
+pair.rkt line 83 col 39 - car - pair
+derived-pair.rkt line 28 col 0 - (#%app cadr (#%app cons (quote 1) (#%app cons (quote 2)
+ (quote 3)))) - derived pair                                                           
+pair.rkt line 85 col 45 - car - pair
+pair.rkt line 85 col 39 - cdr - pair
+derived-pair.rkt line 29 col 0 - (#%app cdar (#%app cons (#%app cons (quote 1) (quote 2)
+) (quote 3))) - derived pair                                                           
+pair.rkt line 87 col 45 - cdr - pair
+pair.rkt line 87 col 39 - cdr - pair
+derived-pair.rkt line 30 col 0 - (#%app cddr (#%app cons (quote 1) (#%app cons (quote 2)
+ (quote 3)))) - derived pair                                                           
+1
+2
+2
+3
+)
+
+#lang typed/racket #:optimize
+
+(caar (cons (cons 1 2) 3))
+(cadr (cons 1 (cons 2 3)))
+(cdar (cons (cons 1 2) 3))
+(cddr (cons 1 (cons 2 3)))
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt
index 92f40326..4af3768e 100644
--- a/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt
@@ -19,16 +19,16 @@ nested-let-loop.rkt line 58 col 38 - r - leave var unboxed
 nested-let-loop.rkt line 58 col 40 - s - leave var unboxed
 nested-let-loop.rkt line 58 col 36 - + - unboxed binary inexact complex
 nested-let-loop.rkt line 58 col 21 - loop1 - unboxed call site
-nested-let-loop.rkt line 58 col 28 - cdr - unary pair
+nested-let-loop.rkt line 58 col 28 - cdr - pair
 nested-let-loop.rkt line 58 col 21 - loop1 - call to fun with unboxed args
 nested-let-loop.rkt line 59 col 38 - s - leave var unboxed
 nested-let-loop.rkt line 59 col 40 - (#%app car x) - unbox inexact-complex
-nested-let-loop.rkt line 59 col 41 - car - unary pair
+nested-let-loop.rkt line 59 col 41 - car - pair
 nested-let-loop.rkt line 59 col 48 - (#%app car y) - unbox inexact-complex
-nested-let-loop.rkt line 59 col 49 - car - unary pair
+nested-let-loop.rkt line 59 col 49 - car - pair
 nested-let-loop.rkt line 59 col 36 - + - unboxed binary inexact complex
 nested-let-loop.rkt line 59 col 21 - loop2 - unboxed call site
-nested-let-loop.rkt line 59 col 28 - cdr - unary pair
+nested-let-loop.rkt line 59 col 28 - cdr - pair
 nested-let-loop.rkt line 59 col 21 - loop2 - call to fun with unboxed args
 #f line #f col #f - (letrec-values (((loop2) (lambda (y s) (if (#%app null? y) (#%app loop1 (#%app cdr x) (#%app + r s)) (#%app loop2 (#%app cdr y) (#%app + s (#%app car x) (#%app car y))))))) loop2) - unboxed let bindings
 nested-let-loop.rkt line 56 col 38 - 0.0+0.0i - unboxed literal
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-pair1.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-pair1.rkt
index f7670a0b..d0caa847 100644
--- a/collects/tests/typed-scheme/optimizer/tests/nested-pair1.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/nested-pair1.rkt
@@ -1,7 +1,7 @@
 #;
 (
-nested-pair1.rkt line 11 col 6 - cdr - unary pair
-nested-pair1.rkt line 11 col 1 - car - unary pair
+nested-pair1.rkt line 11 col 6 - cdr - pair
+nested-pair1.rkt line 11 col 1 - car - pair
 2
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-pair2.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-pair2.rkt
index 651a4d5f..11bc2549 100644
--- a/collects/tests/typed-scheme/optimizer/tests/nested-pair2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/nested-pair2.rkt
@@ -1,7 +1,7 @@
 #;
 (
-nested-pair2.rkt line 11 col 6 - cdr - unary pair
-nested-pair2.rkt line 11 col 1 - car - unary pair
+nested-pair2.rkt line 11 col 6 - cdr - pair
+nested-pair2.rkt line 11 col 1 - car - pair
 '(2)
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/pair-fun.rkt b/collects/tests/typed-scheme/optimizer/tests/pair-fun.rkt
index 35d88957..b2a4bcc7 100644
--- a/collects/tests/typed-scheme/optimizer/tests/pair-fun.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/pair-fun.rkt
@@ -1,6 +1,6 @@
 #;
 (
-pair-fun.rkt line 13 col 7 - car - unary pair
+pair-fun.rkt line 13 col 7 - car - pair
 )
 
 #lang typed/scheme
diff --git a/collects/tests/typed-scheme/optimizer/tests/pair-known-length-list.rkt b/collects/tests/typed-scheme/optimizer/tests/pair-known-length-list.rkt
new file mode 100644
index 00000000..96f4c232
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/pair-known-length-list.rkt
@@ -0,0 +1,32 @@
+#;
+(
+pair-known-length-list.rkt line 27 col 1 - car - pair
+pair-known-length-list.rkt line 28 col 1 - cdr - pair
+pair-known-length-list.rkt line 29 col 6 - cdr - pair
+pair-known-length-list.rkt line 29 col 1 - car - pair
+pair-known-length-list.rkt line 30 col 6 - cdr - pair
+pair-known-length-list.rkt line 30 col 1 - cdr - pair
+pair-known-length-list.rkt line 31 col 11 - cdr - pair
+pair-known-length-list.rkt line 31 col 6 - cdr - pair
+pair-known-length-list.rkt line 31 col 1 - car - pair
+pair-known-length-list.rkt line 32 col 11 - cdr - pair
+pair-known-length-list.rkt line 32 col 6 - cdr - pair
+pair-known-length-list.rkt line 32 col 1 - cdr - pair
+1
+'(2 3)
+2
+'(3)
+3
+'()
+)
+
+#lang typed/racket #:optimize
+
+(: x (List Integer Integer Integer))
+(define x (list 1 2 3))
+(car x)
+(cdr x)
+(car (cdr x))
+(cdr (cdr x))
+(car (cdr (cdr x)))
+(cdr (cdr (cdr x)))
diff --git a/collects/tests/typed-scheme/optimizer/tests/simple-pair.rkt b/collects/tests/typed-scheme/optimizer/tests/simple-pair.rkt
index 404b1377..c5055379 100644
--- a/collects/tests/typed-scheme/optimizer/tests/simple-pair.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/simple-pair.rkt
@@ -1,6 +1,6 @@
 #;
 (
-simple-pair.rkt line 10 col 1 - car - unary pair
+simple-pair.rkt line 10 col 1 - car - pair
 1
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt
index 6bac579c..c3c220ec 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt
@@ -12,11 +12,11 @@ unboxed-let-functions6.rkt line 36 col 15 - 0.0+1.0i - unboxed literal
 unboxed-let-functions6.rkt line 36 col 11 - + - unboxed binary inexact complex
 unboxed-let-functions6.rkt line 36 col 10 - (#%app + z (quote 0.0+1.0i)) - unboxed inexact complex
 unboxed-let-functions6.rkt line 37 col 19 - z - leave var unboxed
-unboxed-let-functions6.rkt line 37 col 22 - car - unary pair
+unboxed-let-functions6.rkt line 37 col 22 - car - pair
 unboxed-let-functions6.rkt line 37 col 21 - (#%app car l) - float-coerce-expr in complex ops
 unboxed-let-functions6.rkt line 37 col 17 - + - unboxed binary inexact complex
 unboxed-let-functions6.rkt line 37 col 11 - loop - unboxed call site
-unboxed-let-functions6.rkt line 38 col 17 - cdr - unary pair
+unboxed-let-functions6.rkt line 38 col 17 - cdr - pair
 unboxed-let-functions6.rkt line 37 col 11 - loop - call to fun with unboxed args
 #f line #f col #f - (letrec-values (((loop) (lambda (z l) (if (#%app null? l) (#%app + z (quote 0.0+1.0i)) (#%app loop (#%app + z (#%app car l)) (#%app cdr l)))))) loop) - unboxed let bindings
 unboxed-let-functions6.rkt line 33 col 51 - 0.0+0.0i - unboxed literal
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt
index 59f5242d..627193c5 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt
@@ -1,7 +1,7 @@
 #;
 (
 unboxed-let-functions7.rkt line 35 col 15 - z - unbox inexact-complex
-unboxed-let-functions7.rkt line 35 col 18 - car - unary pair
+unboxed-let-functions7.rkt line 35 col 18 - car - pair
 unboxed-let-functions7.rkt line 35 col 17 - (#%app car l) - float-coerce-expr in complex ops
 unboxed-let-functions7.rkt line 35 col 13 - + - unboxed binary inexact complex
 unboxed-let-functions7.rkt line 35 col 12 - (#%app + z (#%app car l)) - unboxed inexact complex
@@ -10,11 +10,11 @@ unboxed-let-functions7.rkt line 31 col 6 - loop - unboxed function -> table
 unboxed-let-functions7.rkt line 31 col 6 - loop - fun -> unboxed fun
 unboxed-let-functions7.rkt line 34 col 6 - z - unboxed complex variable
 unboxed-let-functions7.rkt line 35 col 15 - z - leave var unboxed
-unboxed-let-functions7.rkt line 35 col 18 - car - unary pair
+unboxed-let-functions7.rkt line 35 col 18 - car - pair
 unboxed-let-functions7.rkt line 35 col 17 - (#%app car l) - float-coerce-expr in complex ops
 unboxed-let-functions7.rkt line 35 col 13 - + - unboxed binary inexact complex
 unboxed-let-functions7.rkt line 35 col 7 - loop - unboxed call site
-unboxed-let-functions7.rkt line 36 col 13 - cdr - unary pair
+unboxed-let-functions7.rkt line 36 col 13 - cdr - pair
 unboxed-let-functions7.rkt line 35 col 7 - loop - call to fun with unboxed args
 #f line #f col #f - (letrec-values (((loop) (lambda (z l) (if (#%app null? l) z (#%app loop (#%app + z (#%app car l)) (#%app cdr l)))))) loop) - unboxed let bindings
 unboxed-let-functions7.rkt line 31 col 51 - 0.0+0.0i - unboxed literal
diff --git a/collects/typed-scheme/optimizer/pair.rkt b/collects/typed-scheme/optimizer/pair.rkt
index 6202645c..f9e56084 100644
--- a/collects/typed-scheme/optimizer/pair.rkt
+++ b/collects/typed-scheme/optimizer/pair.rkt
@@ -6,12 +6,13 @@
          "../utils/utils.rkt"
          (rep type-rep)
          (types type-table utils)
+         (typecheck typechecker)
          (optimizer utils))
 
 (provide pair-opt-expr)
 
 
-(define-syntax-class pair-unary-op
+(define-syntax-class pair-op
   #:commit
   (pattern (~literal car) #:with unsafe #'unsafe-car)
   (pattern (~literal cdr) #:with unsafe #'unsafe-cdr))
@@ -40,11 +41,53 @@
 
 (define-syntax-class pair-opt-expr
   #:commit
-  (pattern (#%plain-app op:pair-unary-op p:pair-expr)
+  (pattern e:pair-derived-opt-expr
            #:with opt
-           (begin (log-optimization "unary pair" #'op)
+           (begin (log-optimization "derived pair" #'e)
+                  #'e.opt))
+  (pattern (#%plain-app op:pair-op p:pair-expr)
+           #:with opt
+           (begin (log-optimization "pair" #'op)
                   #'(op.unsafe p.opt)))
   (pattern (#%plain-app op:mpair-op p:mpair-expr e:expr ...)
            #:with opt
            (begin (log-optimization "mutable pair" #'op)
                   #`(op.unsafe p.opt #,@(map (optimize) (syntax->list #'(e ...)))))))
+
+  
+;; if the equivalent sequence of cars and cdrs is guaranteed not to fail,
+;; we can optimize
+
+;; accessors is a list of syntax objects, all #'car or #'cdr
+(define (gen-alt accessors stx)
+  (syntax-parse stx
+    [(#%plain-app op arg)
+     (define (gen-alt-helper accessors)
+       (if (null? accessors)
+           #'arg
+           #`(#%plain-app #,(car accessors)
+                          #,(gen-alt-helper (cdr accessors)))))
+     (let ((ty  (type-of stx))
+           (obj (gen-alt-helper accessors)))
+       ;; we're calling the typechecker, but this is just a shortcut, we're
+       ;; still conceptually single pass (we're not iterating). we could get
+       ;; the same result by statically destructing the types.
+       (tc-expr/check obj ty)
+       obj)]))
+
+(define-syntax-class pair-derived-expr
+  #:commit
+  (pattern (#%plain-app (~literal caar) x)
+           #:with alt (gen-alt (list #'car #'car) this-syntax))
+  (pattern (#%plain-app (~literal cadr) x)
+           #:with alt (gen-alt (list #'car #'cdr) this-syntax))
+  (pattern (#%plain-app (~literal cdar) x)
+           #:with alt (gen-alt (list #'cdr #'car) this-syntax))
+  (pattern (#%plain-app (~literal cddr) x)
+           #:with alt (gen-alt (list #'cdr #'cdr) this-syntax)))
+
+(define-syntax-class pair-derived-opt-expr
+  #:commit
+  (pattern e:pair-derived-expr
+           #:with e*:pair-opt-expr #'e.alt
+           #:with opt #'e*.opt))

From 19dcce8809df34fff138d93f32fbca466fa6d4ba Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 9 Sep 2010 18:06:03 -0400
Subject: [PATCH 129/198] Refactoring.

original commit: 74508210687ad0e415af1f28037357ec2640e3ba
---
 .../optimizer/tests/derived-pair.rkt          | 16 ++++++------
 collects/typed-scheme/optimizer/pair.rkt      | 26 ++++++++++---------
 2 files changed, 22 insertions(+), 20 deletions(-)

diff --git a/collects/tests/typed-scheme/optimizer/tests/derived-pair.rkt b/collects/tests/typed-scheme/optimizer/tests/derived-pair.rkt
index 26dbab51..575cc1c9 100644
--- a/collects/tests/typed-scheme/optimizer/tests/derived-pair.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/derived-pair.rkt
@@ -1,19 +1,19 @@
 #;
 (
-pair.rkt line 81 col 45 - car - pair
-pair.rkt line 81 col 39 - car - pair
+#f line #f col #f - car - pair
+#f line #f col #f - car - pair
 derived-pair.rkt line 27 col 0 - (#%app caar (#%app cons (#%app cons (quote 1) (quote 2)
 ) (quote 3))) - derived pair                                                           
-pair.rkt line 83 col 45 - cdr - pair
-pair.rkt line 83 col 39 - car - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - car - pair
 derived-pair.rkt line 28 col 0 - (#%app cadr (#%app cons (quote 1) (#%app cons (quote 2)
  (quote 3)))) - derived pair                                                           
-pair.rkt line 85 col 45 - car - pair
-pair.rkt line 85 col 39 - cdr - pair
+#f line #f col #f - car - pair
+#f line #f col #f - cdr - pair
 derived-pair.rkt line 29 col 0 - (#%app cdar (#%app cons (#%app cons (quote 1) (quote 2)
 ) (quote 3))) - derived pair                                                           
-pair.rkt line 87 col 45 - cdr - pair
-pair.rkt line 87 col 39 - cdr - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - cdr - pair
 derived-pair.rkt line 30 col 0 - (#%app cddr (#%app cons (quote 1) (#%app cons (quote 2)
  (quote 3)))) - derived pair                                                           
 1
diff --git a/collects/typed-scheme/optimizer/pair.rkt b/collects/typed-scheme/optimizer/pair.rkt
index f9e56084..38120a3d 100644
--- a/collects/typed-scheme/optimizer/pair.rkt
+++ b/collects/typed-scheme/optimizer/pair.rkt
@@ -65,8 +65,9 @@
      (define (gen-alt-helper accessors)
        (if (null? accessors)
            #'arg
-           #`(#%plain-app #,(car accessors)
-                          #,(gen-alt-helper (cdr accessors)))))
+           (quasisyntax/loc stx
+             (#%plain-app #,(car accessors)
+                          #,(gen-alt-helper (cdr accessors))))))
      (let ((ty  (type-of stx))
            (obj (gen-alt-helper accessors)))
        ;; we're calling the typechecker, but this is just a shortcut, we're
@@ -75,16 +76,17 @@
        (tc-expr/check obj ty)
        obj)]))
 
-(define-syntax-class pair-derived-expr
-  #:commit
-  (pattern (#%plain-app (~literal caar) x)
-           #:with alt (gen-alt (list #'car #'car) this-syntax))
-  (pattern (#%plain-app (~literal cadr) x)
-           #:with alt (gen-alt (list #'car #'cdr) this-syntax))
-  (pattern (#%plain-app (~literal cdar) x)
-           #:with alt (gen-alt (list #'cdr #'car) this-syntax))
-  (pattern (#%plain-app (~literal cddr) x)
-           #:with alt (gen-alt (list #'cdr #'cdr) this-syntax)))
+(define-syntax-rule (gen-pair-derived-expr name (orig seq ...) ...)
+  (define-syntax-class name
+    #:commit
+    (pattern (#%plain-app (~literal orig) x)
+             #:with alt (gen-alt (list seq ...) this-syntax))
+    ...))
+(gen-pair-derived-expr pair-derived-expr
+ (caar #'car #'car)
+ (cadr #'car #'cdr)
+ (cdar #'cdr #'car)
+ (cddr #'cdr #'cdr))
 
 (define-syntax-class pair-derived-opt-expr
   #:commit

From f88c8f479e6dfb07f87e2c65ab8c5b85d865b058 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 9 Sep 2010 18:32:39 -0400
Subject: [PATCH 130/198] Extended pair optimization to the rest of the
 standard derived pair accessors.

original commit: 0166ece180194605a52841a2a91fb2618e0372a1
---
 .../optimizer/tests/derived-pair2.rkt         |  54 ++++++++
 .../optimizer/tests/derived-pair3.rkt         | 118 ++++++++++++++++++
 collects/typed-scheme/optimizer/pair.rkt      |  26 +++-
 3 files changed, 197 insertions(+), 1 deletion(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/derived-pair2.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/derived-pair3.rkt

diff --git a/collects/tests/typed-scheme/optimizer/tests/derived-pair2.rkt b/collects/tests/typed-scheme/optimizer/tests/derived-pair2.rkt
new file mode 100644
index 00000000..2f540a2a
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/derived-pair2.rkt
@@ -0,0 +1,54 @@
+#;
+(
+#f line #f col #f - car - pair
+#f line #f col #f - car - pair
+#f line #f col #f - car - pair
+derived-pair2.rkt line 47 col 0 - (#%app caaar (#%app cons (#%app cons (#%app cons (quote 1) (quote 2)) (quote 3)) (quote 4))) - derived pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - car - pair
+#f line #f col #f - car - pair
+derived-pair2.rkt line 48 col 0 - (#%app caadr (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4)))) - derived pair
+#f line #f col #f - car - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - car - pair
+derived-pair2.rkt line 49 col 0 - (#%app cadar (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (quote 3))) (quote 4))) - derived pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - car - pair
+derived-pair2.rkt line 50 col 0 - (#%app caddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (quote 4))))) - derived pair
+#f line #f col #f - car - pair
+#f line #f col #f - car - pair
+#f line #f col #f - cdr - pair
+derived-pair2.rkt line 51 col 0 - (#%app cdaar (#%app cons (#%app cons (#%app cons (quote 1) (quote 2)) (quote 3)) (quote 4))) - derived pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - car - pair
+#f line #f col #f - cdr - pair
+derived-pair2.rkt line 52 col 0 - (#%app cdadr (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4)))) - derived pair
+#f line #f col #f - car - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - cdr - pair
+derived-pair2.rkt line 53 col 0 - (#%app cddar (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (quote 3))) (quote 4))) - derived pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - cdr - pair
+derived-pair2.rkt line 54 col 0 - (#%app cdddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (quote 4))))) - derived pair
+1
+2
+2
+3
+2
+3
+3
+4
+)
+
+#lang typed/racket #:optimize
+
+(caaar (cons (cons (cons 1 2) 3) 4))
+(caadr (cons 1 (cons (cons 2 3) 4)))
+(cadar (cons (cons 1 (cons 2 3)) 4))
+(caddr (cons 1 (cons 2 (cons 3 4))))
+(cdaar (cons (cons (cons 1 2) 3) 4))
+(cdadr (cons 1 (cons (cons 2 3) 4)))
+(cddar (cons (cons 1 (cons 2 3)) 4))
+(cdddr (cons 1 (cons 2 (cons 3 4))))
diff --git a/collects/tests/typed-scheme/optimizer/tests/derived-pair3.rkt b/collects/tests/typed-scheme/optimizer/tests/derived-pair3.rkt
new file mode 100644
index 00000000..4fa58e4d
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/derived-pair3.rkt
@@ -0,0 +1,118 @@
+#;
+(
+#f line #f col #f - car - pair
+#f line #f col #f - car - pair
+#f line #f col #f - car - pair
+#f line #f col #f - car - pair
+derived-pair3.rkt line 103 col 0 - (#%app caaaar (#%app cons (#%app cons (#%app cons (#%app cons (quote 1) (quote 2)) (quote 3)) (quote 4)) (quote 5))) - derived pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - car - pair
+#f line #f col #f - car - pair
+#f line #f col #f - car - pair
+derived-pair3.rkt line 104 col 0 - (#%app caaadr (#%app cons (quote 1) (#%app cons (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4)) (quote 5)))) - derived pair
+#f line #f col #f - car - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - car - pair
+#f line #f col #f - car - pair
+derived-pair3.rkt line 105 col 0 - (#%app caadar (#%app cons (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4))) (quote 5))) - derived pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - car - pair
+#f line #f col #f - car - pair
+derived-pair3.rkt line 106 col 0 - (#%app caaddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (#%app cons (quote 3) (quote 4)) (quote 5))))) - derived pair
+#f line #f col #f - car - pair
+#f line #f col #f - car - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - car - pair
+derived-pair3.rkt line 107 col 0 - (#%app cadaar (#%app cons (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (quote 3))) (quote 4)) (quote 5))) - derived pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - car - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - car - pair
+derived-pair3.rkt line 108 col 0 - (#%app cadadr (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (#%app cons (quote 3) (quote 4))) (quote 5)))) - derived pair
+#f line #f col #f - car - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - car - pair
+derived-pair3.rkt line 109 col 0 - (#%app caddar (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (quote 4)))) (quote 5))) - derived pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - car - pair
+derived-pair3.rkt line 110 col 0 - (#%app cadddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (#%app cons (quote 4) (quote 5)))))) - derived pair
+#f line #f col #f - car - pair
+#f line #f col #f - car - pair
+#f line #f col #f - car - pair
+#f line #f col #f - cdr - pair
+derived-pair3.rkt line 111 col 0 - (#%app cdaaar (#%app cons (#%app cons (#%app cons (#%app cons (quote 1) (quote 2)) (quote 3)) (quote 4)) (quote 5))) - derived pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - car - pair
+#f line #f col #f - car - pair
+#f line #f col #f - cdr - pair
+derived-pair3.rkt line 112 col 0 - (#%app cdaadr (#%app cons (quote 1) (#%app cons (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4)) (quote 5)))) - derived pair
+#f line #f col #f - car - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - car - pair
+#f line #f col #f - cdr - pair
+derived-pair3.rkt line 113 col 0 - (#%app cdadar (#%app cons (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (quote 3)) (quote 4))) (quote 5))) - derived pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - car - pair
+#f line #f col #f - cdr - pair
+derived-pair3.rkt line 114 col 0 - (#%app cdaddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (#%app cons (quote 3) (quote 4)) (quote 5))))) - derived pair
+#f line #f col #f - car - pair
+#f line #f col #f - car - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - cdr - pair
+derived-pair3.rkt line 115 col 0 - (#%app cddaar (#%app cons (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (quote 3))) (quote 4)) (quote 5))) - derived pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - car - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - cdr - pair
+derived-pair3.rkt line 116 col 0 - (#%app cddadr (#%app cons (quote 1) (#%app cons (#%app cons (quote 2) (#%app cons (quote 3) (quote 4))) (quote 5)))) - derived pair
+#f line #f col #f - car - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - cdr - pair
+derived-pair3.rkt line 117 col 0 - (#%app cdddar (#%app cons (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (quote 4)))) (quote 5))) - derived pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - cdr - pair
+#f line #f col #f - cdr - pair
+derived-pair3.rkt line 118 col 0 - (#%app cddddr (#%app cons (quote 1) (#%app cons (quote 2) (#%app cons (quote 3) (#%app cons (quote 4) (quote 5)))))) - derived pair
+1
+2
+2
+3
+2
+3
+3
+4
+2
+3
+3
+4
+3
+4
+4
+5
+)
+
+#lang typed/racket #:optimize
+
+(caaaar (cons (cons (cons (cons 1 2) 3) 4) 5))
+(caaadr (cons 1 (cons (cons (cons 2 3) 4) 5)))
+(caadar (cons (cons 1 (cons (cons 2 3) 4)) 5))
+(caaddr (cons 1 (cons 2 (cons (cons 3 4) 5))))
+(cadaar (cons (cons (cons 1 (cons 2 3)) 4) 5))
+(cadadr (cons 1 (cons (cons 2 (cons 3 4)) 5)))
+(caddar (cons (cons 1 (cons 2 (cons 3 4))) 5))
+(cadddr (cons 1 (cons 2 (cons 3 (cons 4 5)))))
+(cdaaar (cons (cons (cons (cons 1 2) 3) 4) 5))
+(cdaadr (cons 1 (cons (cons (cons 2 3) 4) 5)))
+(cdadar (cons (cons 1 (cons (cons 2 3) 4)) 5))
+(cdaddr (cons 1 (cons 2 (cons (cons 3 4) 5))))
+(cddaar (cons (cons (cons 1 (cons 2 3)) 4) 5))
+(cddadr (cons 1 (cons (cons 2 (cons 3 4)) 5)))
+(cdddar (cons (cons 1 (cons 2 (cons 3 4))) 5))
+(cddddr (cons 1 (cons 2 (cons 3 (cons 4 5)))))
diff --git a/collects/typed-scheme/optimizer/pair.rkt b/collects/typed-scheme/optimizer/pair.rkt
index 38120a3d..948eb5f1 100644
--- a/collects/typed-scheme/optimizer/pair.rkt
+++ b/collects/typed-scheme/optimizer/pair.rkt
@@ -86,7 +86,31 @@
  (caar #'car #'car)
  (cadr #'car #'cdr)
  (cdar #'cdr #'car)
- (cddr #'cdr #'cdr))
+ (cddr #'cdr #'cdr)
+ (caaar #'car #'car #'car)
+ (caadr #'car #'car #'cdr)
+ (cadar #'car #'cdr #'car)
+ (caddr #'car #'cdr #'cdr)
+ (cdaar #'cdr #'car #'car)
+ (cdadr #'cdr #'car #'cdr)
+ (cddar #'cdr #'cdr #'car)
+ (cdddr #'cdr #'cdr #'cdr)
+ (caaaar #'car #'car #'car #'car)
+ (caaadr #'car #'car #'car #'cdr)
+ (caadar #'car #'car #'cdr #'car)
+ (caaddr #'car #'car #'cdr #'cdr)
+ (cadaar #'car #'cdr #'car #'car)
+ (cadadr #'car #'cdr #'car #'cdr)
+ (caddar #'car #'cdr #'cdr #'car)
+ (cadddr #'car #'cdr #'cdr #'cdr)
+ (cdaaar #'cdr #'car #'car #'car)
+ (cdaadr #'cdr #'car #'car #'cdr)
+ (cdadar #'cdr #'car #'cdr #'car)
+ (cdaddr #'cdr #'car #'cdr #'cdr)
+ (cddaar #'cdr #'cdr #'car #'car)
+ (cddadr #'cdr #'cdr #'car #'cdr)
+ (cdddar #'cdr #'cdr #'cdr #'car)
+ (cddddr #'cdr #'cdr #'cdr #'cdr))
 
 (define-syntax-class pair-derived-opt-expr
   #:commit

From 8a568284b9f173672a50dc9a986e67d9bb3c89c5 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Fri, 10 Sep 2010 18:25:36 -0400
Subject: [PATCH 131/198] Add some file primitives.

original commit: 5789981f2c4756f2f6cd066ac6f28555dc57e1fd
---
 collects/typed-scheme/private/base-env.rkt | 13 +++++++++++--
 1 file changed, 11 insertions(+), 2 deletions(-)

diff --git a/collects/typed-scheme/private/base-env.rkt b/collects/typed-scheme/private/base-env.rkt
index 21a14cf0..c6e6b4aa 100644
--- a/collects/typed-scheme/private/base-env.rkt
+++ b/collects/typed-scheme/private/base-env.rkt
@@ -385,7 +385,7 @@
 [string-copy (-> -String -String)]
 [string->immutable-string (-> -String -String)]
 [string->path (-> -String -Path)]
-[file-exists? (-> -Pathlike B)]
+
 
 [build-path ((list -Pathlike*) -Pathlike* . ->* . -Path)]
 [with-input-from-file
@@ -489,7 +489,6 @@
 
 [match:error ((list) Univ . ->* . (Un))]
 
-[file-exists? (-Pathlike . -> . B)]
 [string->symbol (-String . -> . Sym)]
 [symbol->string (Sym . -> . -String)]
 [string->keyword (-String . -> . -Keyword)]
@@ -533,6 +532,16 @@
 [file-exists? (-> -Pathlike B)]
 [directory-list (cl-> [() (-lst -Path)]
                       [(-Path) (-lst -Path)])]
+[file-or-directory-modify-seconds
+ (cl->* (-Pathlike . -> . -Nat)
+        (-Pathlike (-val #f) . -> . -Nat)
+        (-Pathlike -Nat . -> . -Void)
+        (-Pathlike (-opt -Nat) (-> Univ) . -> . Univ))]
+
+[file-or-directory-permissions (-> -Pathlike (-lst (Un (-val 'read) (-val 'write) (-val 'execute))))]
+[file-or-directory-identity (->opt -Pathlike (Univ) -Nat)]
+[file-size (-> -Pathlike -Nat)]
+
 
 [hash? (make-pred-ty (make-HashtableTop))]
 [hash-eq? (-> (make-HashtableTop) B)]

From 087b5fd8f799f484193829853d09e4fdb030d5c1 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Fri, 10 Sep 2010 18:25:51 -0400
Subject: [PATCH 132/198] Fix internal error when single value expected.

original commit: 979561354d3c0949208e1dd7fed9fe750f4c1cef
---
 collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt | 1 +
 collects/typed-scheme/typecheck/tc-expr-unit.rkt           | 2 +-
 2 files changed, 2 insertions(+), 1 deletion(-)

diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
index 9c9283fb..ec6c555c 100644
--- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
+++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
@@ -833,6 +833,7 @@
          (make-pred-ty (-val eof))]
         [tc-e ((inst map Number (Pairof Number Number)) car (ann (list (cons 1 2) (cons 2 3) (cons 4 5)) (Listof (Pairof Number Number))))
               (-lst -Number)]
+        [tc-err (list (values 1 2))]
         )
   (test-suite
    "check-type tests"
diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.rkt b/collects/typed-scheme/typecheck/tc-expr-unit.rkt
index 360c3d54..9f4b4a2d 100644
--- a/collects/typed-scheme/typecheck/tc-expr-unit.rkt
+++ b/collects/typed-scheme/typecheck/tc-expr-unit.rkt
@@ -159,7 +159,7 @@
 
 ;; typecheck an expression, but throw away the effect
 ;; tc-expr/t : Expr -> Type
-(define (tc-expr/t e) (match (tc-expr e)
+(define (tc-expr/t e) (match (single-value e)
                         [(tc-result1: t _ _) t]
                         [t (int-err "tc-expr returned ~a, not a single tc-result, for ~a" t (syntax->datum e))]))
 

From 70a3eb615339bdb59e60f057344084602c326b9c Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Fri, 10 Sep 2010 18:38:02 -0400
Subject: [PATCH 133/198] Fix for new ->i syntax.

original commit: d1835175d7cc0cab1bc717b052c1d080e7f443f3
---
 collects/typed-scheme/rep/filter-rep.rkt | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/typed-scheme/rep/filter-rep.rkt b/collects/typed-scheme/rep/filter-rep.rkt
index 7adb624b..430b7524 100644
--- a/collects/typed-scheme/rep/filter-rep.rkt
+++ b/collects/typed-scheme/rep/filter-rep.rkt
@@ -49,7 +49,7 @@
     [#:contract (->i ([t any/c]
                       [e any/c])
                      (#:syntax [stx #f])
-                     #:pre-cond (t e)
+                     #:pre (t e)
                      (and (cond [(Bot? t) #t]
                                 [(Bot? e) (Top? t)]
                                 [else (Filter/c-predicate? t)])

From 9d31fc0726277b920ff8f077a3fb02e4afd4378d Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Sun, 12 Sep 2010 22:10:33 -0400
Subject: [PATCH 134/198] Fix doc typo.

  Closes PR 11190.
  Closes PR 11191.

original commit: 07227ed8f7e32ed552186f41df8c9fedde1c6a02
---
 collects/typed-scheme/scribblings/more.scrbl  | 2 +-
 collects/typed-scheme/scribblings/types.scrbl | 4 ++--
 2 files changed, 3 insertions(+), 3 deletions(-)

diff --git a/collects/typed-scheme/scribblings/more.scrbl b/collects/typed-scheme/scribblings/more.scrbl
index 9a6123f4..424fa8f9 100644
--- a/collects/typed-scheme/scribblings/more.scrbl
+++ b/collects/typed-scheme/scribblings/more.scrbl
@@ -44,7 +44,7 @@ in both top-level and internal contexts.
 
 @racketblock[
 (define: x : Number 7)
-(define: (id [z : Number]) z)]
+(define: (id [z : Number]) : Number z)]
 
 Here, @racket[x] has the type @racket[Number], and @racket[id] has the
 type @racket[(Number -> Number)].  In the body of @racket[id],
diff --git a/collects/typed-scheme/scribblings/types.scrbl b/collects/typed-scheme/scribblings/types.scrbl
index 20915ea4..e766f023 100644
--- a/collects/typed-scheme/scribblings/types.scrbl
+++ b/collects/typed-scheme/scribblings/types.scrbl
@@ -193,9 +193,9 @@ The second definition
 (struct: (a) Some ([v : a]))
 ]
 
-creates a parameterized type, @racket[Just], which is a structure with
+creates a parameterized type, @racket[Some], which is a structure with
 one element, whose type is that of the type argument to
-@racket[Just].  Here the type parameters (only one, @racket[a], in
+@racket[Some].  Here the type parameters (only one, @racket[a], in
 this case) are written before the type name, and can be referred to in
 the types of the fields.
 

From e7e187e1de37820f54e8a158c897db33ba6e9e20 Mon Sep 17 00:00:00 2001
From: Stevie Strickland <sstrickl@racket-lang.org>
Date: Thu, 13 May 2010 15:43:52 -0400
Subject: [PATCH 135/198] Now change box/c to use proxies or chaperones
 appropriately.

Create a mzlib/contract compatible version of the old box/c and use that
for mzlib/contract.  Change the docs so that the docs for mzlib/contract
contain the right information.

Fix the typed-scheme implementation to only force flat box (or hash)
contracts when it already is required to be flat.  Otherwise, allow
non-flat contracts for the element contract (or domain/range contracts).

original commit: 994ad6d10fc817a5ceca2f9f4874dac5c14c0aab
---
 collects/typed-scheme/private/type-contract.rkt | 9 +++++++--
 1 file changed, 7 insertions(+), 2 deletions(-)

diff --git a/collects/typed-scheme/private/type-contract.rkt b/collects/typed-scheme/private/type-contract.rkt
index dd59522a..5c4b9278 100644
--- a/collects/typed-scheme/private/type-contract.rkt
+++ b/collects/typed-scheme/private/type-contract.rkt
@@ -134,7 +134,9 @@
         [(Vector: t)
          #`(vectorof #,(t->c t #:flat #t))]
         [(Box: t)
-         #`(box/c #,(t->c t #:flat #t))]
+         (if flat?
+             #`(box/c #,(t->c t #:flat #t) #:flat? #t)
+             #`(box/c #,(t->c t)))]
         [(Pair: t1 t2)
          #`(cons/c #,(t->c t1) #,(t->c t2))]
         [(Opaque: p? cert)
@@ -206,7 +208,10 @@
         [(Syntax: t) #`(syntax/c #,(t->c t))]
         [(Value: v) #`(flat-named-contract #,(format "~a" v) (lambda (x) (equal? x '#,v)))]
         [(Param: in out) #`(parameter/c #,(t->c out))]
-	[(Hashtable: k v) #`(hash/c #,(t->c k #:flat #t) #,(t->c v #:flat #t) #:immutable 'dont-care)]
+	[(Hashtable: k v) 
+         (if flat?
+             #`(hash/c #,(t->c k #:flat #t) #,(t->c v #:flat #t) #:flat? #t #:immutable 'dont-care)
+             #`(hash/c #,(t->c k) #,(t->c v) #:immutable 'dont-care))]
         [else          
          (exit (fail))]))))
 

From f991c65bb7076ac1ffbf59782d081f32741c7159 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 10 Sep 2010 09:33:02 -0400
Subject: [PATCH 136/198] Added a test to make sure derived lists accessors
 don't get optimized then they shouldn't.

original commit: 65c502f9d75f919b8af37bee9698b24a082b27a0
---
 .../optimizer/tests/invalid-derived-pair.rkt       | 14 ++++++++++++++
 1 file changed, 14 insertions(+)
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/invalid-derived-pair.rkt

diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-derived-pair.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-derived-pair.rkt
new file mode 100644
index 00000000..89a4ca52
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-derived-pair.rkt
@@ -0,0 +1,14 @@
+#;
+()
+
+#lang typed/racket #:optimize
+
+;; can't optimize, the lists may not be long enough
+(: f ((Listof Integer) -> Integer))
+(define (f x)
+  (cadr x))
+(: g ((Listof Integer) -> Integer))
+(define (g x)
+  (if (null? x)
+      0
+      (cadr x)))

From b03abef7ffba9838ab22d12400f44cbc923db316 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 10 Sep 2010 13:53:45 -0400
Subject: [PATCH 137/198] Added annotated versions of the for macros that
 generate vectors. They are purposedly left out of the documentation since the
 typchecker can't currently handle their expansion.

original commit: a10d145f25dd4257dd216ea0b1e97184a29c7683
---
 collects/tests/typed-scheme/xfail/for-inference.rkt |  6 ++++++
 collects/typed-scheme/private/prims.rkt             | 13 +++++++++----
 .../typed-scheme/scribblings/ts-reference.scrbl     |  2 ++
 3 files changed, 17 insertions(+), 4 deletions(-)

diff --git a/collects/tests/typed-scheme/xfail/for-inference.rkt b/collects/tests/typed-scheme/xfail/for-inference.rkt
index 14a3a70d..38ac3357 100644
--- a/collects/tests/typed-scheme/xfail/for-inference.rkt
+++ b/collects/tests/typed-scheme/xfail/for-inference.rkt
@@ -79,3 +79,9 @@
 (for/and: : Boolean
           ((i : Exact-Positive-Integer '(1 2 3)))
           (< i 3))
+
+;; for/vector: would need stronger inference. same for for*/vector and
+;; both flvector variants
+(for/vector: : (Vectorof Integer)
+             ((x : Integer (in-range 10)))
+             x)
diff --git a/collects/typed-scheme/private/prims.rkt b/collects/typed-scheme/private/prims.rkt
index f01c8b1c..8632a5d3 100644
--- a/collects/typed-scheme/private/prims.rkt
+++ b/collects/typed-scheme/private/prims.rkt
@@ -33,6 +33,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
          (rename-in racket/contract [-> c->])
          "base-types.rkt"
          "base-types-extra.rkt"
+         racket/flonum ; for for/flvector and for*/flvector
          (for-syntax 
           syntax/parse
 	  syntax/private/util
@@ -511,8 +512,8 @@ This file defines two sorts of primitives. All of them are provided into any mod
      (quasisyntax/loc
          stx
        (begin (define-syntax name (define-for-variant #'untyped-name)) ...))]))
-;; for/hash{,eq,eqv}:, for/and:, for/first: and for/last:'s expansions
-;; can't currently be handled by the typechecker.
+;; for/hash{,eq,eqv}:, for/vector:, for/flvector:, for/and:, for/first: and
+;; for/last:'s expansions can't currently be handled by the typechecker.
 ;; They have been left out of the documentation.
 (define-for-variants
   (for/list: for/list)
@@ -522,7 +523,9 @@ This file defines two sorts of primitives. All of them are provided into any mod
   (for/and: for/and)
   (for/or: for/or)
   (for/first: for/first)
-  (for/last: for/last))
+  (for/last: for/last)
+  (for/vector: for/vector)
+  (for/flvector: for/flvector))
 
 ;; Unlike with the above, the inferencer can handle any number of #:when
 ;; clauses with these 2.
@@ -595,7 +598,9 @@ This file defines two sorts of primitives. All of them are provided into any mod
   (for*/and: for*/and)
   (for*/or: for*/or)
   (for*/first: for*/first)
-  (for*/last: for*/last))
+  (for*/last: for*/last)
+  (for*/vector: for*/vector)
+  (for*/flvector: for*/flvector))
 
 (define-for-syntax (define-for*-folding-variant name)
   (lambda (stx)
diff --git a/collects/typed-scheme/scribblings/ts-reference.scrbl b/collects/typed-scheme/scribblings/ts-reference.scrbl
index 4cab0717..7044a63d 100644
--- a/collects/typed-scheme/scribblings/ts-reference.scrbl
+++ b/collects/typed-scheme/scribblings/ts-reference.scrbl
@@ -309,6 +309,8 @@ the return type of a @racket[for] form is optional. Unlike
 @;@defform[(for/hash: : u (for:-clause ...) expr ...+)] @; the ones that are commented out don't currently work
 @;@defform[(for/hasheq: : u (for:-clause ...) expr ...+)]
 @;@defform[(for/hasheqv: : u (for:-clause ...) expr ...+)]
+@;@defform[(for/vector: : u (for:-clause ...) expr ...+)]
+@;@defform[(for/flvector: : u (for:-clause ...) expr ...+)]
 @;@defform[(for/and: : u (for:-clause ...) expr ...+)]
 @defform[(for/or:   : u (for:-clause ...) expr ...+)]
 @;@defform[(for/first: : u (for:-clause ...) expr ...+)]

From 71d2819cba9c1cf2fcc07938515534b82ebc8257 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 10 Sep 2010 13:59:41 -0400
Subject: [PATCH 138/198] Removed an obsolete comment.

original commit: 1b28aa41c706292734f81a61411305e8d4546847
---
 collects/typed-scheme/optimizer/utils.rkt | 2 --
 1 file changed, 2 deletions(-)

diff --git a/collects/typed-scheme/optimizer/utils.rkt b/collects/typed-scheme/optimizer/utils.rkt
index f442698c..2fa5ba4c 100644
--- a/collects/typed-scheme/optimizer/utils.rkt
+++ b/collects/typed-scheme/optimizer/utils.rkt
@@ -54,8 +54,6 @@
 
 ;; to generate temporary symbols in a predictable manner
 ;; these identifiers are unique within a sequence of unboxed operations
-;; necessary to have predictable symbols to add in the hand-optimized versions
-;; of the optimizer tests (which check for equality of expanded code)
 (define *unboxed-gensym-counter* 0)
 (define (unboxed-gensym [name 'unboxed-gensym-])
   (set! *unboxed-gensym-counter* (add1 *unboxed-gensym-counter*))

From 99b35249ab18defe20f6a9e1968677d4158f9de5 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 10 Sep 2010 17:19:40 -0400
Subject: [PATCH 139/198] Removed useless requires.

original commit: 8b60085a177d40b8a494e8f5aafe7fe52022d225
---
 collects/tests/typed-scheme/optimizer/tests/apply-plus.rkt      | 2 +-
 collects/tests/typed-scheme/optimizer/tests/begin-float.rkt     | 2 +-
 collects/tests/typed-scheme/optimizer/tests/binary-fixnum.rkt   | 2 +-
 .../typed-scheme/optimizer/tests/binary-nonzero-fixnum.rkt      | 2 +-
 collects/tests/typed-scheme/optimizer/tests/box.rkt             | 2 +-
 .../tests/typed-scheme/optimizer/tests/cross-module-struct2.rkt | 2 +-
 collects/tests/typed-scheme/optimizer/tests/dead-else.rkt       | 2 +-
 collects/tests/typed-scheme/optimizer/tests/dead-then.rkt       | 2 +-
 .../tests/typed-scheme/optimizer/tests/define-begin-float.rkt   | 2 +-
 .../tests/typed-scheme/optimizer/tests/define-call-float.rkt    | 2 +-
 collects/tests/typed-scheme/optimizer/tests/define-float.rkt    | 2 +-
 collects/tests/typed-scheme/optimizer/tests/define-pair.rkt     | 2 +-
 collects/tests/typed-scheme/optimizer/tests/double-float.rkt    | 2 +-
 collects/tests/typed-scheme/optimizer/tests/exact-inexact.rkt   | 2 +-
 .../tests/typed-scheme/optimizer/tests/fixnum-comparison.rkt    | 2 +-
 collects/tests/typed-scheme/optimizer/tests/float-comp.rkt      | 2 +-
 collects/tests/typed-scheme/optimizer/tests/float-fun.rkt       | 2 +-
 collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt | 2 +-
 collects/tests/typed-scheme/optimizer/tests/flvector-length.rkt | 2 +-
 collects/tests/typed-scheme/optimizer/tests/fx-fl.rkt           | 2 +-
 collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt        | 2 +-
 collects/tests/typed-scheme/optimizer/tests/in-list.rkt         | 2 +-
 collects/tests/typed-scheme/optimizer/tests/in-string.rkt       | 2 +-
 collects/tests/typed-scheme/optimizer/tests/in-vector.rkt       | 2 +-
 .../tests/typed-scheme/optimizer/tests/invalid-float-comp.rkt   | 2 +-
 .../tests/typed-scheme/optimizer/tests/invalid-unboxed-let.rkt  | 2 +-
 .../tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt | 2 +-
 .../tests/typed-scheme/optimizer/tests/known-vector-length.rkt  | 2 +-
 collects/tests/typed-scheme/optimizer/tests/let-float.rkt       | 2 +-
 collects/tests/typed-scheme/optimizer/tests/let-rhs.rkt         | 2 +-
 collects/tests/typed-scheme/optimizer/tests/literal-int.rkt     | 2 +-
 collects/tests/typed-scheme/optimizer/tests/magnitude.rkt       | 2 +-
 .../tests/typed-scheme/optimizer/tests/make-flrectangular.rkt   | 2 +-
 collects/tests/typed-scheme/optimizer/tests/make-polar.rkt      | 2 +-
 .../tests/typed-scheme/optimizer/tests/maybe-exact-complex.rkt  | 2 +-
 collects/tests/typed-scheme/optimizer/tests/mpair.rkt           | 2 +-
 collects/tests/typed-scheme/optimizer/tests/n-ary-float.rkt     | 2 +-
 collects/tests/typed-scheme/optimizer/tests/nested-float.rkt    | 2 +-
 collects/tests/typed-scheme/optimizer/tests/nested-float2.rkt   | 2 +-
 collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt | 2 +-
 collects/tests/typed-scheme/optimizer/tests/nested-pair1.rkt    | 2 +-
 collects/tests/typed-scheme/optimizer/tests/nested-pair2.rkt    | 2 +-
 .../tests/typed-scheme/optimizer/tests/nested-unboxed-let.rkt   | 2 +-
 collects/tests/typed-scheme/optimizer/tests/one-arg-arith.rkt   | 2 +-
 collects/tests/typed-scheme/optimizer/tests/pair-fun.rkt        | 2 +-
 collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt  | 2 +-
 collects/tests/typed-scheme/optimizer/tests/simple-float.rkt    | 2 +-
 collects/tests/typed-scheme/optimizer/tests/simple-pair.rkt     | 2 +-
 collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt   | 2 +-
 collects/tests/typed-scheme/optimizer/tests/sqrt.rkt            | 2 +-
 collects/tests/typed-scheme/optimizer/tests/string-length.rkt   | 2 +-
 collects/tests/typed-scheme/optimizer/tests/structs.rkt         | 2 +-
 .../tests/typed-scheme/optimizer/tests/unary-fixnum-nested.rkt  | 2 +-
 collects/tests/typed-scheme/optimizer/tests/unary-fixnum.rkt    | 2 +-
 collects/tests/typed-scheme/optimizer/tests/unary-float.rkt     | 2 +-
 collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt     | 2 +-
 .../typed-scheme/optimizer/tests/unboxed-let-functions1.rkt     | 2 +-
 .../typed-scheme/optimizer/tests/unboxed-let-functions2.rkt     | 2 +-
 .../typed-scheme/optimizer/tests/unboxed-let-functions3.rkt     | 2 +-
 .../typed-scheme/optimizer/tests/unboxed-let-functions4.rkt     | 2 +-
 .../typed-scheme/optimizer/tests/unboxed-let-functions5.rkt     | 2 +-
 .../typed-scheme/optimizer/tests/unboxed-let-functions6.rkt     | 2 +-
 .../typed-scheme/optimizer/tests/unboxed-let-functions7.rkt     | 2 +-
 .../typed-scheme/optimizer/tests/unboxed-let-functions8.rkt     | 2 +-
 collects/tests/typed-scheme/optimizer/tests/unboxed-let.rkt     | 2 +-
 collects/tests/typed-scheme/optimizer/tests/unboxed-let2.rkt    | 2 +-
 collects/tests/typed-scheme/optimizer/tests/unboxed-let3.rkt    | 2 +-
 .../optimizer/tests/unboxed-letrec-syntaxes+values.rkt          | 2 +-
 collects/tests/typed-scheme/optimizer/tests/unboxed-letrec.rkt  | 2 +-
 .../tests/typed-scheme/optimizer/tests/vector-length-nested.rkt | 2 +-
 collects/tests/typed-scheme/optimizer/tests/vector-length.rkt   | 2 +-
 .../tests/typed-scheme/optimizer/tests/vector-ref-set-ref.rkt   | 2 +-
 collects/tests/typed-scheme/optimizer/tests/vector-ref.rkt      | 2 +-
 collects/tests/typed-scheme/optimizer/tests/vector-ref2.rkt     | 2 +-
 .../tests/typed-scheme/optimizer/tests/vector-set-quote.rkt     | 2 +-
 collects/tests/typed-scheme/optimizer/tests/vector-set.rkt      | 2 +-
 collects/tests/typed-scheme/optimizer/tests/vector-set2.rkt     | 2 +-
 collects/tests/typed-scheme/optimizer/tests/zero.rkt            | 2 +-
 78 files changed, 78 insertions(+), 78 deletions(-)

diff --git a/collects/tests/typed-scheme/optimizer/tests/apply-plus.rkt b/collects/tests/typed-scheme/optimizer/tests/apply-plus.rkt
index 8478d8d4..d3f4b79d 100644
--- a/collects/tests/typed-scheme/optimizer/tests/apply-plus.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/apply-plus.rkt
@@ -8,6 +8,6 @@ apply-plus.rkt line 13 col 7 - * - apply-map
 
 #lang typed/racket
 #:optimize
-(require racket/unsafe/ops)
+
 (apply + (map add1 (list 1 2 3)))
 (apply * (map add1 (list 1 2 3)))
diff --git a/collects/tests/typed-scheme/optimizer/tests/begin-float.rkt b/collects/tests/typed-scheme/optimizer/tests/begin-float.rkt
index da828b4d..1514e0b0 100644
--- a/collects/tests/typed-scheme/optimizer/tests/begin-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/begin-float.rkt
@@ -8,6 +8,6 @@ begin-float.rkt line 13 col 8 - * - binary float
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (begin (- 2.0 3.0)
        (* 2.0 3.0))
diff --git a/collects/tests/typed-scheme/optimizer/tests/binary-fixnum.rkt b/collects/tests/typed-scheme/optimizer/tests/binary-fixnum.rkt
index 31dce5f9..0b6ab3e0 100644
--- a/collects/tests/typed-scheme/optimizer/tests/binary-fixnum.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/binary-fixnum.rkt
@@ -6,7 +6,7 @@ binary-fixnum.rkt line 12 col 3 - bitwise-and - binary fixnum
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (: f (All (X) ((Vectorof X) -> Natural)))
 (define (f v)
   (bitwise-and (vector-length v) 1))
diff --git a/collects/tests/typed-scheme/optimizer/tests/binary-nonzero-fixnum.rkt b/collects/tests/typed-scheme/optimizer/tests/binary-nonzero-fixnum.rkt
index 2e3ad2e7..ed3f7ed4 100644
--- a/collects/tests/typed-scheme/optimizer/tests/binary-nonzero-fixnum.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/binary-nonzero-fixnum.rkt
@@ -7,5 +7,5 @@ binary-nonzero-fixnum.rkt line 11 col 1 - modulo - binary nonzero fixnum
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (modulo (vector-length '#(1 2 3)) 2)
diff --git a/collects/tests/typed-scheme/optimizer/tests/box.rkt b/collects/tests/typed-scheme/optimizer/tests/box.rkt
index c7c7bbb6..9ea6b1df 100644
--- a/collects/tests/typed-scheme/optimizer/tests/box.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/box.rkt
@@ -10,7 +10,7 @@ box.rkt line 19 col 1 - unbox - box
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 (: x (Boxof Integer))
 (define x (box 1))
diff --git a/collects/tests/typed-scheme/optimizer/tests/cross-module-struct2.rkt b/collects/tests/typed-scheme/optimizer/tests/cross-module-struct2.rkt
index b9255c56..e310b047 100644
--- a/collects/tests/typed-scheme/optimizer/tests/cross-module-struct2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/cross-module-struct2.rkt
@@ -6,6 +6,6 @@ cross-module-struct2.rkt line 11 col 1 - x-x - struct ref
 
 #lang typed/scheme #:optimize
 
-(require (file "cross-module-struct.rkt") racket/unsafe/ops)
+(require (file "cross-module-struct.rkt"))
 (define a (make-x 1))
 (x-x a)
diff --git a/collects/tests/typed-scheme/optimizer/tests/dead-else.rkt b/collects/tests/typed-scheme/optimizer/tests/dead-else.rkt
index ad1fcb95..cbc34a9a 100644
--- a/collects/tests/typed-scheme/optimizer/tests/dead-else.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/dead-else.rkt
@@ -9,7 +9,7 @@ dead-else.rkt line 17 col 14 - + - binary float
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (display (if (number? 3)
              (+ 2.0 3.0)
              (+ 4.0 5.0)))
diff --git a/collects/tests/typed-scheme/optimizer/tests/dead-then.rkt b/collects/tests/typed-scheme/optimizer/tests/dead-then.rkt
index 86b40211..7e3ee6c8 100644
--- a/collects/tests/typed-scheme/optimizer/tests/dead-then.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/dead-then.rkt
@@ -9,7 +9,7 @@ dead-then.rkt line 18 col 14 - + - binary float
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (display (if (number? "eh")
              (+ 2.0 3.0)
              (+ 4.0 5.0)))
diff --git a/collects/tests/typed-scheme/optimizer/tests/define-begin-float.rkt b/collects/tests/typed-scheme/optimizer/tests/define-begin-float.rkt
index f6d0b6f7..e7e3641e 100644
--- a/collects/tests/typed-scheme/optimizer/tests/define-begin-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/define-begin-float.rkt
@@ -7,6 +7,6 @@ define-begin-float.rkt line 12 col 18 - * - binary float
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (define a (begin (display (- 2.0 3.0))
                  (* 2.0 3.0)))
diff --git a/collects/tests/typed-scheme/optimizer/tests/define-call-float.rkt b/collects/tests/typed-scheme/optimizer/tests/define-call-float.rkt
index 0aa84331..479a47f2 100644
--- a/collects/tests/typed-scheme/optimizer/tests/define-call-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/define-call-float.rkt
@@ -5,5 +5,5 @@ define-call-float.rkt line 9 col 17 - + - binary float
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (define x (cons (+ 1.0 2.0) 3.0))
diff --git a/collects/tests/typed-scheme/optimizer/tests/define-float.rkt b/collects/tests/typed-scheme/optimizer/tests/define-float.rkt
index 9113cefa..853afc03 100644
--- a/collects/tests/typed-scheme/optimizer/tests/define-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/define-float.rkt
@@ -5,5 +5,5 @@ define-float.rkt line 9 col 11 - + - binary float
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (define x (+ 1.0 2.0))
diff --git a/collects/tests/typed-scheme/optimizer/tests/define-pair.rkt b/collects/tests/typed-scheme/optimizer/tests/define-pair.rkt
index 28036634..006029b3 100644
--- a/collects/tests/typed-scheme/optimizer/tests/define-pair.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/define-pair.rkt
@@ -5,5 +5,5 @@ define-pair.rkt line 9 col 11 - car - pair
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (define x (car '(1 3)))
diff --git a/collects/tests/typed-scheme/optimizer/tests/double-float.rkt b/collects/tests/typed-scheme/optimizer/tests/double-float.rkt
index a6400339..951ced61 100644
--- a/collects/tests/typed-scheme/optimizer/tests/double-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/double-float.rkt
@@ -6,5 +6,5 @@ double-float.rkt line 10 col 1 - + - binary float
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (+ 2.0 2.0 2.0)
diff --git a/collects/tests/typed-scheme/optimizer/tests/exact-inexact.rkt b/collects/tests/typed-scheme/optimizer/tests/exact-inexact.rkt
index d3382c3a..e2efe744 100644
--- a/collects/tests/typed-scheme/optimizer/tests/exact-inexact.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/exact-inexact.rkt
@@ -6,5 +6,5 @@ exact-inexact.rkt line 10 col 1 - exact->inexact - int to float
 
 #lang typed/scheme
 #:optimize
-(require racket/flonum)
+
 (exact->inexact (expt 10 100)) ; must not be a fixnum
diff --git a/collects/tests/typed-scheme/optimizer/tests/fixnum-comparison.rkt b/collects/tests/typed-scheme/optimizer/tests/fixnum-comparison.rkt
index 53384429..7dcbebe6 100644
--- a/collects/tests/typed-scheme/optimizer/tests/fixnum-comparison.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/fixnum-comparison.rkt
@@ -8,5 +8,5 @@ fixnum-comparison.rkt line 12 col 1 - < - binary fixnum
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (< (vector-length '#(1 2 3)) (string-length "asdf"))
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-comp.rkt b/collects/tests/typed-scheme/optimizer/tests/float-comp.rkt
index 6cd3e00c..0cd0d1ef 100644
--- a/collects/tests/typed-scheme/optimizer/tests/float-comp.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/float-comp.rkt
@@ -6,5 +6,5 @@ float-comp.rkt line 10 col 1 - < - binary float comp
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (< 1.0 2.0)
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-fun.rkt b/collects/tests/typed-scheme/optimizer/tests/float-fun.rkt
index 0a20f92c..b659085c 100644
--- a/collects/tests/typed-scheme/optimizer/tests/float-fun.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/float-fun.rkt
@@ -6,7 +6,7 @@ float-fun.rkt line 12 col 3 - + - binary float
 #lang typed/racket
 #:optimize
 
-(require racket/unsafe/ops)
+
 (: f (Float -> Float))
 (define (f x)
   (+ x 1.0))
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt b/collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt
index 64138644..383a9a05 100644
--- a/collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/float-promotion.rkt
@@ -9,6 +9,6 @@ float-promotion.rkt line 14 col 1 - + - binary float
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops racket/flonum)
+
 (+ (modulo 1 1) 2.0)
 (+ (expt 100 100) 2.0)
diff --git a/collects/tests/typed-scheme/optimizer/tests/flvector-length.rkt b/collects/tests/typed-scheme/optimizer/tests/flvector-length.rkt
index 2cfe1cd1..5d30913b 100644
--- a/collects/tests/typed-scheme/optimizer/tests/flvector-length.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/flvector-length.rkt
@@ -6,5 +6,5 @@ flvector-length.rkt line 10 col 1 - flvector-length - flvector-length
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops racket/flonum)
+(require racket/flonum)
 (flvector-length (flvector 0.0 1.2))
diff --git a/collects/tests/typed-scheme/optimizer/tests/fx-fl.rkt b/collects/tests/typed-scheme/optimizer/tests/fx-fl.rkt
index 7fac058b..7e63776a 100644
--- a/collects/tests/typed-scheme/optimizer/tests/fx-fl.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/fx-fl.rkt
@@ -6,5 +6,5 @@ fx-fl.rkt line 10 col 1 - exact->inexact - fixnum to float
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (exact->inexact 1)
diff --git a/collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt b/collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt
index 5c5d8ba0..7983e655 100644
--- a/collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt
@@ -18,6 +18,6 @@ in-bytes.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos)
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (for: ((i : Integer #"123"))
       (display i))
diff --git a/collects/tests/typed-scheme/optimizer/tests/in-list.rkt b/collects/tests/typed-scheme/optimizer/tests/in-list.rkt
index eaca57ac..dc21f5f8 100644
--- a/collects/tests/typed-scheme/optimizer/tests/in-list.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/in-list.rkt
@@ -18,6 +18,6 @@ in-list.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (for: ((i : Natural '(1 2 3)))
       (display i))
diff --git a/collects/tests/typed-scheme/optimizer/tests/in-string.rkt b/collects/tests/typed-scheme/optimizer/tests/in-string.rkt
index 5622cbea..04ec2b02 100644
--- a/collects/tests/typed-scheme/optimizer/tests/in-string.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/in-string.rkt
@@ -18,6 +18,6 @@ in-string.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos)
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (for: ((i : Char "123"))
       (display i))
diff --git a/collects/tests/typed-scheme/optimizer/tests/in-vector.rkt b/collects/tests/typed-scheme/optimizer/tests/in-vector.rkt
index 333debdd..b1aa45e8 100644
--- a/collects/tests/typed-scheme/optimizer/tests/in-vector.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/in-vector.rkt
@@ -18,6 +18,6 @@ in-vector.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos)
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (for: ((i : Integer (vector 1 2 3)))
       (display i))
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-float-comp.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-float-comp.rkt
index 1de1b624..5e2c31ab 100644
--- a/collects/tests/typed-scheme/optimizer/tests/invalid-float-comp.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-float-comp.rkt
@@ -5,5 +5,5 @@
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (< 1.0 2)
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let.rkt
index afc7c9e6..809409c3 100644
--- a/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let.rkt
@@ -29,7 +29,7 @@ invalid-unboxed-let.rkt line 38 col 11 - (#%app + t1 t1) - unboxed inexact compl
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 (let ((t1 (+ 1.0+2.0i 2.0+4.0i)) ; can be unboxed
       (t2 (+ 3.0+6.0i 4.0+8.0i)) ; can't be unboxed
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt
index 8875971b..459f47ff 100644
--- a/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt
@@ -19,7 +19,7 @@ invalid-unboxed-let2.rkt line 26 col 2 - (#%app + t1 t2) - unboxed inexact compl
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 ;; unboxing of let bindings does not currently work with multiple values
 (let-values (((t1 t2) (values (+ 1.0+2.0i 2.0+4.0i) (+ 3.0+6.0i 4.0+8.0i))))
diff --git a/collects/tests/typed-scheme/optimizer/tests/known-vector-length.rkt b/collects/tests/typed-scheme/optimizer/tests/known-vector-length.rkt
index 97f4c295..c1503b60 100644
--- a/collects/tests/typed-scheme/optimizer/tests/known-vector-length.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/known-vector-length.rkt
@@ -7,5 +7,5 @@ known-vector-length.rkt line 11 col 6 - vector-length - known-length vector-leng
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (+ 2 (vector-length (ann (vector 1 2) (Vector Integer Integer))))
diff --git a/collects/tests/typed-scheme/optimizer/tests/let-float.rkt b/collects/tests/typed-scheme/optimizer/tests/let-float.rkt
index e598b836..09f4ca14 100644
--- a/collects/tests/typed-scheme/optimizer/tests/let-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/let-float.rkt
@@ -8,6 +8,6 @@ let-float.rkt line 13 col 3 - * - binary float
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (let ((x (+ 3.0 2.0)))
   (* 9.0 x))
diff --git a/collects/tests/typed-scheme/optimizer/tests/let-rhs.rkt b/collects/tests/typed-scheme/optimizer/tests/let-rhs.rkt
index ec49c5d4..b6994657 100644
--- a/collects/tests/typed-scheme/optimizer/tests/let-rhs.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/let-rhs.rkt
@@ -8,7 +8,7 @@ let-rhs.rkt line 13 col 0 - (let-values (((x) (#%app + (quote 1.0) (quote 2.0)))
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 (let ((x (+ 1.0 2.0)))
   x)
diff --git a/collects/tests/typed-scheme/optimizer/tests/literal-int.rkt b/collects/tests/typed-scheme/optimizer/tests/literal-int.rkt
index eb246d7a..7b54c8f5 100644
--- a/collects/tests/typed-scheme/optimizer/tests/literal-int.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/literal-int.rkt
@@ -8,7 +8,7 @@ literal-int.rkt line 13 col 1 - + - binary float
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 (+ 1 2.0)
 1
diff --git a/collects/tests/typed-scheme/optimizer/tests/magnitude.rkt b/collects/tests/typed-scheme/optimizer/tests/magnitude.rkt
index 42d8cd82..dc69d185 100644
--- a/collects/tests/typed-scheme/optimizer/tests/magnitude.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/magnitude.rkt
@@ -9,6 +9,6 @@ magnitude.rkt line 14 col 0 - (#%app magnitude (quote 3.0+4.0i)) - unboxed inexa
 #lang typed/racket/base
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 (magnitude 3.0+4.0i)
diff --git a/collects/tests/typed-scheme/optimizer/tests/make-flrectangular.rkt b/collects/tests/typed-scheme/optimizer/tests/make-flrectangular.rkt
index 05a40978..10e2ce82 100644
--- a/collects/tests/typed-scheme/optimizer/tests/make-flrectangular.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/make-flrectangular.rkt
@@ -8,6 +8,6 @@ make-flrectangular.rkt line 13 col 1 - make-flrectangular - binary float comp
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops racket/flonum)
+(require racket/flonum)
 (make-rectangular 1.0 2.2)
 (make-flrectangular 1.0 2.2)
diff --git a/collects/tests/typed-scheme/optimizer/tests/make-polar.rkt b/collects/tests/typed-scheme/optimizer/tests/make-polar.rkt
index 0497eab5..f1b0033b 100644
--- a/collects/tests/typed-scheme/optimizer/tests/make-polar.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/make-polar.rkt
@@ -22,7 +22,7 @@ make-polar.rkt line 33 col 40 - imag-part - unboxed inexact complex
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 ;; top level
 (make-polar 1.0 1.0)
diff --git a/collects/tests/typed-scheme/optimizer/tests/maybe-exact-complex.rkt b/collects/tests/typed-scheme/optimizer/tests/maybe-exact-complex.rkt
index dc3170dc..235a672e 100644
--- a/collects/tests/typed-scheme/optimizer/tests/maybe-exact-complex.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/maybe-exact-complex.rkt
@@ -10,6 +10,6 @@ maybe-exact-complex.rkt line 15 col 0 - (#%app + (quote 1.0+2.0i) (quote 2+4i))
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 (+ 1.0+2.0i 2+4i)
diff --git a/collects/tests/typed-scheme/optimizer/tests/mpair.rkt b/collects/tests/typed-scheme/optimizer/tests/mpair.rkt
index c357473b..ae62abbb 100644
--- a/collects/tests/typed-scheme/optimizer/tests/mpair.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/mpair.rkt
@@ -12,7 +12,7 @@ mpair.rkt line 27 col 7 - mcar - mutable pair
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (: x (MPairof Integer Float))
 (define x (mcons 1 1.0))
 (mcar x)
diff --git a/collects/tests/typed-scheme/optimizer/tests/n-ary-float.rkt b/collects/tests/typed-scheme/optimizer/tests/n-ary-float.rkt
index b2b8515f..5a02f030 100644
--- a/collects/tests/typed-scheme/optimizer/tests/n-ary-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/n-ary-float.rkt
@@ -6,5 +6,5 @@ n-ary-float.rkt line 10 col 1 - + - binary float
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (+ 1.0 2.0 3.0)
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-float.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-float.rkt
index e2dee886..326150d9 100644
--- a/collects/tests/typed-scheme/optimizer/tests/nested-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/nested-float.rkt
@@ -7,5 +7,5 @@ nested-float.rkt line 11 col 1 - + - binary float
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (+ 2.0 (+ 3.0 4.0))
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-float2.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-float2.rkt
index cc3d59b9..942424a1 100644
--- a/collects/tests/typed-scheme/optimizer/tests/nested-float2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/nested-float2.rkt
@@ -7,5 +7,5 @@ nested-float2.rkt line 11 col 1 - + - binary float
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (+ 2.0 (* 3.0 4.0))
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt
index 4af3768e..a11185ef 100644
--- a/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt
@@ -44,7 +44,7 @@ nested-let-loop.rkt line 49 col 6 - loop1 - unboxed let loop
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 (let: loop1 : Inexact-Complex
       ((x : (Listof Inexact-Complex) '(1.0+2.0i 2.0+4.0i))
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-pair1.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-pair1.rkt
index d0caa847..7e8a92fc 100644
--- a/collects/tests/typed-scheme/optimizer/tests/nested-pair1.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/nested-pair1.rkt
@@ -7,5 +7,5 @@ nested-pair1.rkt line 11 col 1 - car - pair
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (car (cdr '(1 2)))
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-pair2.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-pair2.rkt
index 11bc2549..d43ba10f 100644
--- a/collects/tests/typed-scheme/optimizer/tests/nested-pair2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/nested-pair2.rkt
@@ -7,5 +7,5 @@ nested-pair2.rkt line 11 col 1 - car - pair
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (car (cdr (cons 3 (cons (cons 2 '()) 1))))
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-unboxed-let.rkt
index f41eb3ce..6169762e 100644
--- a/collects/tests/typed-scheme/optimizer/tests/nested-unboxed-let.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/nested-unboxed-let.rkt
@@ -26,7 +26,7 @@ nested-unboxed-let.rkt line 33 col 4 - (#%app + x (quote 3.0+6.0i)) - unboxed in
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 (let ((x (+ 1.0+2.0i 2.0+3.0i)))
   (let ((x (+ x 2.0+3.0i)))
diff --git a/collects/tests/typed-scheme/optimizer/tests/one-arg-arith.rkt b/collects/tests/typed-scheme/optimizer/tests/one-arg-arith.rkt
index 9b06cbd8..4b8af710 100644
--- a/collects/tests/typed-scheme/optimizer/tests/one-arg-arith.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/one-arg-arith.rkt
@@ -35,7 +35,7 @@ one-arg-arith.rkt line 55 col 1 - max - unary number
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 (- 12)
 (- 12.0)
diff --git a/collects/tests/typed-scheme/optimizer/tests/pair-fun.rkt b/collects/tests/typed-scheme/optimizer/tests/pair-fun.rkt
index b2a4bcc7..b369f81e 100644
--- a/collects/tests/typed-scheme/optimizer/tests/pair-fun.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/pair-fun.rkt
@@ -5,7 +5,7 @@ pair-fun.rkt line 13 col 7 - car - pair
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (: f ((Listof Integer) -> Integer))
 (define (f x)
   (if (null? x)
diff --git a/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt b/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt
index b39c9d8d..4d478200 100644
--- a/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt
@@ -25,7 +25,7 @@ real-part-loop.rkt line 31 col 6 - loop - unboxed let loop
 #lang typed/racket/base
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 (ann
  (let loop ([v 0.0+1.0i])
diff --git a/collects/tests/typed-scheme/optimizer/tests/simple-float.rkt b/collects/tests/typed-scheme/optimizer/tests/simple-float.rkt
index 8d761f47..26b3550c 100644
--- a/collects/tests/typed-scheme/optimizer/tests/simple-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/simple-float.rkt
@@ -6,5 +6,5 @@ simple-float.rkt line 10 col 1 - + - binary float
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (+ 2.0 3.0)
diff --git a/collects/tests/typed-scheme/optimizer/tests/simple-pair.rkt b/collects/tests/typed-scheme/optimizer/tests/simple-pair.rkt
index c5055379..a4586341 100644
--- a/collects/tests/typed-scheme/optimizer/tests/simple-pair.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/simple-pair.rkt
@@ -6,5 +6,5 @@ simple-pair.rkt line 10 col 1 - car - pair
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (car (cons 1 2))
diff --git a/collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt b/collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt
index a67456db..c6faf7ff 100644
--- a/collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt
@@ -11,7 +11,7 @@ sqrt-segfault.rkt line 22 col 0 - (let-values (((mag) (let-values (((val) (#%app
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 ;; from the nbody-generic benchmark.
 ;; the result of sqrt was an Inexact-Complex, so inexact complex opts kicked
diff --git a/collects/tests/typed-scheme/optimizer/tests/sqrt.rkt b/collects/tests/typed-scheme/optimizer/tests/sqrt.rkt
index 3f643706..cb5669a3 100644
--- a/collects/tests/typed-scheme/optimizer/tests/sqrt.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/sqrt.rkt
@@ -5,7 +5,7 @@ sqrt.rkt line 11 col 3 - sqrt - unary float
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (: f (Nonnegative-Float -> Nonnegative-Float))
 (define (f x)
   (sqrt x))
diff --git a/collects/tests/typed-scheme/optimizer/tests/string-length.rkt b/collects/tests/typed-scheme/optimizer/tests/string-length.rkt
index 32c2df80..76cb9976 100644
--- a/collects/tests/typed-scheme/optimizer/tests/string-length.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/string-length.rkt
@@ -9,7 +9,7 @@
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 (string-length "eh")
 (bytes-length #"eh")
diff --git a/collects/tests/typed-scheme/optimizer/tests/structs.rkt b/collects/tests/typed-scheme/optimizer/tests/structs.rkt
index 190b5904..be8e651a 100644
--- a/collects/tests/typed-scheme/optimizer/tests/structs.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/structs.rkt
@@ -7,7 +7,7 @@ structs.rkt line 14 col 1 - set-pt-y! - struct set
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (define-struct: pt ((x : Integer) (y : Integer)) #:mutable)
 (define a (pt 3 4))
 (pt-x a)
diff --git a/collects/tests/typed-scheme/optimizer/tests/unary-fixnum-nested.rkt b/collects/tests/typed-scheme/optimizer/tests/unary-fixnum-nested.rkt
index 1bd5f21b..ff5a1212 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unary-fixnum-nested.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unary-fixnum-nested.rkt
@@ -7,5 +7,5 @@ unary-fixnum-nested.rkt line 11 col 1 - abs - unary fixnum
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops racket/fixnum)
+
 (abs (bitwise-not (length '(1 2 3))))
diff --git a/collects/tests/typed-scheme/optimizer/tests/unary-fixnum.rkt b/collects/tests/typed-scheme/optimizer/tests/unary-fixnum.rkt
index b5c321c4..51bb989b 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unary-fixnum.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unary-fixnum.rkt
@@ -6,5 +6,5 @@ unary-fixnum.rkt line 10 col 1 - bitwise-not - unary fixnum
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (bitwise-not 4)
diff --git a/collects/tests/typed-scheme/optimizer/tests/unary-float.rkt b/collects/tests/typed-scheme/optimizer/tests/unary-float.rkt
index 59bccafd..6d20a253 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unary-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unary-float.rkt
@@ -6,5 +6,5 @@ unary-float.rkt line 10 col 1 - sin - unary float
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (sin 2.0)
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt
index 71960a72..291acf7c 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt
@@ -50,7 +50,7 @@ unboxed-for.rkt line 55 col 0 - (letrec-values (((for-loop) (lambda (sum pos) (i
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 (for/fold: : Inexact-Complex ((sum : Inexact-Complex 0.0+0.0i))
            ((i : Inexact-Complex '(1.0+2.0i 2.0+4.0i)))
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions1.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions1.rkt
index 41b456b1..4f975a50 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions1.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions1.rkt
@@ -23,7 +23,7 @@ unboxed-let-functions1.rkt line 30 col 3 - f - call to fun with unboxed args
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 ;; simple case, function with single complex arg
 (let ((f (lambda: ((x : Inexact-Complex)) (+ x 3.0+6.0i))))
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions2.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions2.rkt
index a6040a56..d7841b21 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions2.rkt
@@ -29,7 +29,7 @@ unboxed-let-functions2.rkt line 37 col 3 - f - call to fun with unboxed args
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 ;; function with multiple complex args
 (let ((f (lambda: ((x : Inexact-Complex) (y : Inexact-Complex))
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions3.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions3.rkt
index 2e5a90f2..e7aff08a 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions3.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions3.rkt
@@ -23,7 +23,7 @@ unboxed-let-functions3.rkt line 31 col 3 - f - call to fun with unboxed args
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 ;; function with a mix of complex and non-complex args
 (let ((f (lambda: ((x : Inexact-Complex) (y : Float))
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions4.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions4.rkt
index bc294048..09612c21 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions4.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions4.rkt
@@ -23,7 +23,7 @@ unboxed-let-functions4.rkt line 31 col 3 - f - call to fun with unboxed args
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 ;; function with a mix of complex and non-complex args, non-complex first
 (let ((f (lambda: ((y : Float) (x : Inexact-Complex))
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions5.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions5.rkt
index 0b14144b..64a08d9c 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions5.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions5.rkt
@@ -12,7 +12,7 @@ unboxed-let-functions5.rkt line 22 col 12 - (#%app + (quote 1.0+2.0i) (quote 2.0
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 ;; invalid: f "escapes", according to our analysis
 (letrec: ((f : (Inexact-Complex -> Inexact-Complex)
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt
index c3c220ec..c9c70356 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt
@@ -28,7 +28,7 @@ unboxed-let-functions6.rkt line 33 col 6 - loop - unboxed let loop
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops racket/flonum)
+
 
 (let: loop : Inexact-Complex ((z : Inexact-Complex 0.0+0.0i)
                               (l : (Listof Integer) '(1 2 3)))
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt
index 627193c5..6265f7d3 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt
@@ -26,7 +26,7 @@ unboxed-let-functions7.rkt line 31 col 6 - loop - unboxed let loop
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops racket/flonum)
+
 
 (let: loop : Inexact-Complex ((z : Inexact-Complex 0.0+0.0i)
                               (l : (Listof Integer) '(1 2 3)))
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions8.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions8.rkt
index 45aae88c..4a1c6eba 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions8.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions8.rkt
@@ -11,7 +11,7 @@ unboxed-let-functions8.rkt line 16 col 0 - (letrec-values (((f) (lambda (x) (#%a
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 (letrec: ((f : (Inexact-Complex -> Inexact-Complex) (lambda (x) (+ x 2.0+4.0i)))
           (g : (Inexact-Complex -> Inexact-Complex) f)) ; f escapes! can't unbox it's args
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let.rkt
index b785896a..1d1c5b7d 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let.rkt
@@ -32,7 +32,7 @@ unboxed-let.rkt line 40 col 2 - (#%app + t2 t3) - unboxed inexact complex
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 (let* ((t1 (+ 1.0+2.0i 2.0+4.0i))
        (t2 (- t1 3.0+6.0i))
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let2.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let2.rkt
index 84eff33f..b80bab26 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let2.rkt
@@ -25,7 +25,7 @@ unboxed-let2.rkt line 32 col 2 - (#%app + t1 t2) - unboxed inexact complex
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 (let ((t1 (+ 1.0+2.0i 2.0+4.0i))
       (t2 (+ 3.0+6.0i 4.0+8.0i)))
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let3.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let3.rkt
index 77e149d1..d55d7e95 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let3.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let3.rkt
@@ -19,7 +19,7 @@ unboxed-let3.rkt line 34 col 6 - (#%app + x (quote 2.0+4.0i)) - unboxed inexact
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 ;; both boxed and unboxed uses, we unbox anyway
 ;; causes unnecessary boxing/unboxing if we take a boxed path when
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec-syntaxes+values.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec-syntaxes+values.rkt
index 71d54170..5c4dfd1b 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec-syntaxes+values.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec-syntaxes+values.rkt
@@ -18,7 +18,7 @@ unboxed-letrec-syntaxes+values.rkt line 25 col 24 - (#%app + x (quote 2.0+4.0i))
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 (letrec-syntaxes+values (((s) (syntax-rules () [(_ x) x])))
                         (((x) (+ 1.0+2.0i 2.0+4.0i)))
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec.rkt
index 5a52c7dc..8e41a8bf 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec.rkt
@@ -23,7 +23,7 @@ unboxed-letrec.rkt line 31 col 2 - (#%app + x y) - unboxed inexact complex
 #lang typed/scheme
 #:optimize
 
-(require racket/unsafe/ops)
+
 
 (letrec: ((f : (Any -> Any) (lambda: ((x : Any)) (f x)))
           (x : Inexact-Complex 1.0+2.0i)
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-length-nested.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-length-nested.rkt
index 5bcd563b..c616eaf8 100644
--- a/collects/tests/typed-scheme/optimizer/tests/vector-length-nested.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/vector-length-nested.rkt
@@ -7,7 +7,7 @@ vector-length-nested.rkt line 12 col 2 - vector-ref - vector
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (vector-length
  (vector-ref
   (ann (vector (vector 1 2) 2 3)
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-length.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-length.rkt
index 65778288..c045caa4 100644
--- a/collects/tests/typed-scheme/optimizer/tests/vector-length.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/vector-length.rkt
@@ -6,5 +6,5 @@ vector-length.rkt line 10 col 1 - vector-length - vector-length
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (vector-length (vector 1 2 3))
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-ref-set-ref.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-ref-set-ref.rkt
index 03f9fb71..02f1a5d3 100644
--- a/collects/tests/typed-scheme/optimizer/tests/vector-ref-set-ref.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/vector-ref-set-ref.rkt
@@ -9,7 +9,7 @@ vector-ref-set-ref.rkt line 17 col 1 - vector-ref - vector
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (: x (Vector Integer String))
 (define x (vector 1 "1"))
 (vector-ref x 0)
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-ref.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-ref.rkt
index 80796658..68a08817 100644
--- a/collects/tests/typed-scheme/optimizer/tests/vector-ref.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/vector-ref.rkt
@@ -6,5 +6,5 @@ vector-ref.rkt line 10 col 1 - vector-ref - vector
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (vector-ref (ann (vector 1 2) (Vector Integer Integer)) 0)
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-ref2.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-ref2.rkt
index 49f50d54..d98f6174 100644
--- a/collects/tests/typed-scheme/optimizer/tests/vector-ref2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/vector-ref2.rkt
@@ -6,5 +6,5 @@ vector-ref2.rkt line 10 col 1 - vector-ref - vector
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (vector-ref (vector 1 2 3) 0)
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-set-quote.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-set-quote.rkt
index 209bc9e0..53c29712 100644
--- a/collects/tests/typed-scheme/optimizer/tests/vector-set-quote.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/vector-set-quote.rkt
@@ -5,7 +5,7 @@ vector-set-quote.rkt line 9 col 1 - vector-set! - vector
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (vector-set! (ann (vector '(1 2)) (Vector Any))
              0
              '(+ 1.0 2.0)) ; we should not optimize under quote
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-set.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-set.rkt
index d3b26758..92af9b8a 100644
--- a/collects/tests/typed-scheme/optimizer/tests/vector-set.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/vector-set.rkt
@@ -5,7 +5,7 @@ vector-set.rkt line 9 col 1 - vector-set! - vector
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (vector-set! (ann (vector 1 2) (Vector Integer Integer))
              0
              1)
diff --git a/collects/tests/typed-scheme/optimizer/tests/vector-set2.rkt b/collects/tests/typed-scheme/optimizer/tests/vector-set2.rkt
index d9661383..83e5a1f1 100644
--- a/collects/tests/typed-scheme/optimizer/tests/vector-set2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/vector-set2.rkt
@@ -5,5 +5,5 @@ vector-set2.rkt line 9 col 1 - vector-set! - vector
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (vector-set! (vector 1 2) 0 2) ; type is (Vectorof Integer), length is ot known, can't optimize
diff --git a/collects/tests/typed-scheme/optimizer/tests/zero.rkt b/collects/tests/typed-scheme/optimizer/tests/zero.rkt
index 411edd09..81eee79c 100644
--- a/collects/tests/typed-scheme/optimizer/tests/zero.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/zero.rkt
@@ -9,6 +9,6 @@ zero.rkt line 14 col 1 - zero? - float zero?
 
 #lang typed/scheme
 #:optimize
-(require racket/unsafe/ops)
+
 (zero? 1)
 (zero? (sqrt 3.0))

From cc871deebb18acea68fa8d50dcad036a5c53b0b1 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 15 Sep 2010 19:22:21 -0400
Subject: [PATCH 140/198] Made some type annotations optional in the for:
 macros.

original commit: 9f87b5a7e6a2034a4d936bd2cc8e67632f8c6e3b
---
 .../tests/typed-scheme/succeed/for-no-anns.rkt   | 16 ++++++++++++++++
 .../typed-scheme/private/annotate-classes.rkt    | 11 +++++++++++
 collects/typed-scheme/private/for-clauses.rkt    |  8 ++++----
 collects/typed-scheme/private/prims.rkt          | 12 ++++++------
 4 files changed, 37 insertions(+), 10 deletions(-)
 create mode 100644 collects/tests/typed-scheme/succeed/for-no-anns.rkt

diff --git a/collects/tests/typed-scheme/succeed/for-no-anns.rkt b/collects/tests/typed-scheme/succeed/for-no-anns.rkt
new file mode 100644
index 00000000..951bc568
--- /dev/null
+++ b/collects/tests/typed-scheme/succeed/for-no-anns.rkt
@@ -0,0 +1,16 @@
+#lang typed/racket
+
+;; test for optional annotation on for:-bound variables
+
+(for: ([i (in-range 10)] ; no annotation
+       [j : Integer (in-range 10 20)])
+      (display (+ i j)))
+
+(for/fold: : Integer ([acc 0])
+           ([i (in-range 10)])
+           (+ i acc))
+
+(let ((x '(1 3 5 7 9)))
+  (do: : Number ((x x (cdr x))
+                 (sum 0 (+ sum (car x))))
+       ((null? x) sum)))
diff --git a/collects/typed-scheme/private/annotate-classes.rkt b/collects/typed-scheme/private/annotate-classes.rkt
index 92c788cd..ba822974 100644
--- a/collects/typed-scheme/private/annotate-classes.rkt
+++ b/collects/typed-scheme/private/annotate-classes.rkt
@@ -14,6 +14,17 @@
            #:with ty (syntax-property #'name 'type-label)
            #:with ann-name #'name))
 
+(define-splicing-syntax-class optionally-annotated-name
+  #:attributes (name ann-name)
+  #:description "optionally type-annotated identifier"
+  #:literals (:)
+  (pattern n:annotated-name
+           #:with name #'n.name
+           #:with ann-name #'n.ann-name)
+  (pattern n:id
+           #:with name #'n
+           #:with ann-name #'n))
+
 (define-splicing-syntax-class (param-annotated-name trans)
   #:attributes (name ty ann-name)
   #:description "type-annotated identifier"
diff --git a/collects/typed-scheme/private/for-clauses.rkt b/collects/typed-scheme/private/for-clauses.rkt
index 3d9bea9b..3d146868 100644
--- a/collects/typed-scheme/private/for-clauses.rkt
+++ b/collects/typed-scheme/private/for-clauses.rkt
@@ -9,13 +9,13 @@
 
 (define-splicing-syntax-class for-clause
     ;; single-valued seq-expr
-    (pattern (~and c (var:annotated-name seq-expr:expr))
+    (pattern (~and c (var:optionally-annotated-name seq-expr:expr))
              #:with (expand ...) (list (syntax/loc
                                            #'c
                                          (var.ann-name seq-expr))))
     ;; multi-valued seq-expr
     ;; currently disabled because it triggers an internal error in the typechecker
-    #;(pattern (~and c (((v:annotated-name) ...) seq-expr:expr))
+    #;(pattern (~and c (((v:optionally-annotated-name) ...) seq-expr:expr))
              #:with (expand ...) (list (syntax/loc
                                            #'c
                                          ((v.ann-name ...) seq-expr))))
@@ -26,14 +26,14 @@
 ;; intersperses "#:when #t" clauses to emulate the for* variants' semantics
 (define-splicing-syntax-class for*-clause
   ;; single-valued seq-expr
-    (pattern (~and c (var:annotated-name seq-expr:expr))
+    (pattern (~and c (var:optionally-annotated-name seq-expr:expr))
              #:with (expand ...) (list (syntax/loc
                                            #'c
                                          (var.ann-name seq-expr))
                                        #'#:when #'#t))
     ;; multi-valued seq-expr
     ;; currently disabled because it triggers an internal error in the typechecker
-    #;(pattern (~and c (((v:annotated-name) ...) seq-expr:expr))
+    #;(pattern (~and c (((v:optionally-annotated-name) ...) seq-expr:expr))
              #:with (expand ...) (list (quasisyntax/loc
                                            #'c
                                          ((v.ann-name ...) seq-expr))
diff --git a/collects/typed-scheme/private/prims.rkt b/collects/typed-scheme/private/prims.rkt
index 8632a5d3..82773469 100644
--- a/collects/typed-scheme/private/prims.rkt
+++ b/collects/typed-scheme/private/prims.rkt
@@ -268,7 +268,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
 
 (define-syntax (define-typed-struct/exec stx)
   (syntax-parse stx #:literals (:)
-    [(_ nm ((~describe "field specification" [fld:annotated-name]) ...) [proc : proc-ty])
+    [(_ nm ((~describe "field specification" [fld:optionally-annotated-name]) ...) [proc : proc-ty])
      (with-syntax* 
       ([proc* (syntax-property #'(ann proc : proc-ty) 'typechecker:with-type #t)]
        [d-s (syntax-property (syntax/loc stx (define-struct nm (fld.name ...)
@@ -415,7 +415,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
 (define-syntax (do: stx)
   (syntax-parse stx #:literals (:)
     [(_ : ty 
-        ((var:annotated-name rest ...) ...) 
+        ((var:optionally-annotated-name rest ...) ...) 
         (stop?:expr ret ...)
         c:expr ...)
      (syntax/loc
@@ -452,11 +452,11 @@ This file defines two sorts of primitives. All of them are provided into any mod
            ;; single-valued seq-expr
            ;; unlike the definitions in for-clauses.rkt, this does not include
            ;; #:when clauses, which are handled separately here
-           (pattern (var:annotated-name seq-expr:expr)
+           (pattern (var:optionally-annotated-name seq-expr:expr)
                     #:with expand #'(var.ann-name seq-expr))
            ;; multi-valued seq-expr
            ;; currently disabled because it triggers an internal error in the typechecker
-           #;(pattern ((v:annotated-name ...) seq-expr:expr)
+           #;(pattern ((v:optionally-annotated-name ...) seq-expr:expr)
                     #:with expand #'((v.ann-name ...) seq-expr)))
          (syntax-parse clauses
            [(head:for-clause next:for-clause ... #:when rest ...)
@@ -532,7 +532,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
 (define-syntax (for/lists: stx)
   (syntax-parse stx #:literals (:)
     [(_ : ty
-        ((var:annotated-name) ...)
+        ((var:optionally-annotated-name) ...)
         (clause:for-clause ...)
         c:expr ...)
      (syntax-property
@@ -545,7 +545,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
 (define-syntax (for/fold: stx)
   (syntax-parse stx #:literals (:)
     [(_ : ty
-        ((var:annotated-name init:expr) ...)
+        ((var:optionally-annotated-name init:expr) ...)
         (clause:for-clause ...)
         c:expr ...)
      (syntax-property

From 8a94fce374498033a330528cd96307ea4c1b915e Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 16 Sep 2010 10:48:28 -0400
Subject: [PATCH 141/198] Fix some optimizer test logs to reflect racket
 changes.

original commit: e03e53b1cba5a63b5f9c0dafbb777d7116c93d1d
---
 .../typed-scheme/optimizer/tests/in-bytes.rkt      | 14 +++++++-------
 .../tests/typed-scheme/optimizer/tests/in-list.rkt | 14 +++++++-------
 .../typed-scheme/optimizer/tests/in-string.rkt     | 14 +++++++-------
 .../typed-scheme/optimizer/tests/in-vector.rkt     | 14 +++++++-------
 .../typed-scheme/optimizer/tests/unboxed-for.rkt   | 10 +++++-----
 5 files changed, 33 insertions(+), 33 deletions(-)

diff --git a/collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt b/collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt
index 7983e655..8508fde9 100644
--- a/collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt
@@ -1,19 +1,19 @@
 #;
 (
 #f line #f col #f - make-sequence - in-bytes
-#f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (quote 123)))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) (#%app void) init)) - unboxed let bindings
-#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
+#f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (quote 123)))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) (#%app void) init)) - unboxed let bindings
+#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
 #f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
 #f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
 #f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
-in-bytes.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
-#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
+in-bytes.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
+#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
 #f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
 #f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
 #f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
-in-bytes.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
+in-bytes.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
 495051)
 
 #lang typed/scheme
diff --git a/collects/tests/typed-scheme/optimizer/tests/in-list.rkt b/collects/tests/typed-scheme/optimizer/tests/in-list.rkt
index dc21f5f8..a53f90c6 100644
--- a/collects/tests/typed-scheme/optimizer/tests/in-list.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/in-list.rkt
@@ -1,19 +1,19 @@
 #;
 (
 #f line #f col #f - make-sequence - in-list
-#f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (quote (1 2 3))))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) (#%app void) init)) - unboxed let bindings
-#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
+#f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (quote (1 2 3))))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) (#%app void) init)) - unboxed let bindings
+#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
 #f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
 #f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
 #f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
-in-list.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
-#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
+in-list.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
+#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
 #f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
 #f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
 #f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
-in-list.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
+in-list.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
 123)
 
 #lang typed/scheme
diff --git a/collects/tests/typed-scheme/optimizer/tests/in-string.rkt b/collects/tests/typed-scheme/optimizer/tests/in-string.rkt
index 04ec2b02..9f311c48 100644
--- a/collects/tests/typed-scheme/optimizer/tests/in-string.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/in-string.rkt
@@ -1,19 +1,19 @@
 #;
 (
 #f line #f col #f - make-sequence - in-string
-#f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (quote 123)))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) (#%app void) init)) - unboxed let bindings
-#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
+#f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (quote 123)))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) (#%app void) init)) - unboxed let bindings
+#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
 #f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
 #f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
 #f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
-in-string.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
-#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
+in-string.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
+#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
 #f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
 #f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
 #f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
-in-string.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
+in-string.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
 123)
 
 #lang typed/scheme
diff --git a/collects/tests/typed-scheme/optimizer/tests/in-vector.rkt b/collects/tests/typed-scheme/optimizer/tests/in-vector.rkt
index b1aa45e8..5554babd 100644
--- a/collects/tests/typed-scheme/optimizer/tests/in-vector.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/in-vector.rkt
@@ -1,19 +1,19 @@
 #;
 (
 #f line #f col #f - make-sequence - in-vector
-#f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (#%app vector (quote 1) (quote 2) (quote 3))))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) (#%app void) init)) - unboxed let bindings
-#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
+#f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (#%app vector (quote 1) (quote 2) (quote 3))))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) (#%app void) init)) - unboxed let bindings
+#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
 #f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
 #f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
 #f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
-in-vector.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
-#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
+in-vector.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
+#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
 #f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
 #f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
 #f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
-in-vector.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%app all-cont? pos i) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
+#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
+in-vector.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
 123)
 
 #lang typed/scheme
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt
index 291acf7c..3fbfda23 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt
@@ -1,7 +1,7 @@
 #;
 (
 #f line #f col #f - make-sequence - in-list
-#f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (quote (1.0+2.0i 2.0+4.0i))))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (sum pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%app all-cont? pos i) (#%app for-loop sum (#%app pos-next pos)) sum)) sum)) sum)))) for-loop) (quote 0.0+0.0i) init)) - unboxed let bindings
+#f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (quote (1.0+2.0i 2.0+4.0i))))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (sum pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop sum (#%app pos-next pos)) sum)) sum)) sum)))) for-loop) (quote 0.0+0.0i) init)) - unboxed let bindings
 unboxed-for.rkt line 57 col 9 - i - unbox inexact-complex
 unboxed-for.rkt line 57 col 11 - sum - unbox inexact-complex
 unboxed-for.rkt line 57 col 7 - + - unboxed binary inexact complex
@@ -19,7 +19,7 @@ unboxed-for.rkt line 57 col 11 - sum - unbox inexact-complex
 unboxed-for.rkt line 57 col 7 - + - unboxed binary inexact complex
 unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed inexact complex
 #f line #f col #f - (#%app pos->vals pos) - unbox inexact-complex
-#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%app all-cont? pos i) (#%app for-loop sum (#%app pos-next pos)) sum)) sum)) - unboxed let bindings
+#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop sum (#%app pos-next pos)) sum)) sum)) - unboxed let bindings
 unboxed-for.rkt line 56 col 13 - i - unboxed complex variable
 unboxed-for.rkt line 56 col 13 - i - unboxed complex variable
 unboxed-for.rkt line 57 col 9 - i - leave var unboxed
@@ -33,16 +33,16 @@ unboxed-for.rkt line 57 col 9 - i - leave var unboxed
 unboxed-for.rkt line 57 col 11 - sum - leave var unboxed
 unboxed-for.rkt line 57 col 7 - + - unboxed binary inexact complex
 unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed inexact complex
-#f line #f col #f - (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%app all-cont? pos i) (#%app for-loop sum (#%app pos-next pos)) sum)) - unboxed let bindings
+#f line #f col #f - (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop sum (#%app pos-next pos)) sum)) - unboxed let bindings
 unboxed-for.rkt line 56 col 13 - i - unboxed complex variable
 unboxed-for.rkt line 55 col 31 - sum - unbox inexact-complex
 #f line #f col #f - for-loop - unboxed call site
 #f line #f col #f - for-loop - call to fun with unboxed args
 unboxed-for.rkt line 55 col 31 - sum - unboxed complex variable
 unboxed-for.rkt line 55 col 31 - sum - unboxed complex variable
-unboxed-for.rkt line 55 col 0 - (letrec-values (((for-loop) (lambda (sum pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%app all-cont? pos i) (#%app for-loop sum (#%app pos-next pos)) sum)) sum)) sum)))) for-loop) - unboxed let bindings
+unboxed-for.rkt line 55 col 0 - (letrec-values (((for-loop) (lambda (sum pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop sum (#%app pos-next pos)) sum)) sum)) sum)))) for-loop) - unboxed let bindings
 unboxed-for.rkt line 55 col 53 - 0.0+0.0i - unboxed literal
-unboxed-for.rkt line 55 col 0 - (letrec-values (((for-loop) (lambda (sum pos) (if (#%app pos-cont? pos) (let-values (((i) (#%app pos->vals pos))) (if (#%app val-cont? i) (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%app all-cont? pos i) (#%app for-loop sum (#%app pos-next pos)) sum)) sum)) sum)))) for-loop) - unboxed call site
+unboxed-for.rkt line 55 col 0 - (letrec-values (((for-loop) (lambda (sum pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop sum (#%app pos-next pos)) sum)) sum)) sum)))) for-loop) - unboxed call site
 #f line #f col #f - for-loop - unboxed let loop
 3.0+6.0i
 )

From ef623a46b652d553bc25175b479c019dc26f9426 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 16 Sep 2010 11:21:21 -0400
Subject: [PATCH 142/198] Made annotations optional for let: and variants.

original commit: 8aab96faa6cac4fd20b7464693152d1f9a3ad106
---
 .../typed-scheme/private/annotate-classes.rkt | 37 +++++++++++++++++++
 collects/typed-scheme/private/prims.rkt       |  4 +-
 2 files changed, 39 insertions(+), 2 deletions(-)

diff --git a/collects/typed-scheme/private/annotate-classes.rkt b/collects/typed-scheme/private/annotate-classes.rkt
index ba822974..78af9997 100644
--- a/collects/typed-scheme/private/annotate-classes.rkt
+++ b/collects/typed-scheme/private/annotate-classes.rkt
@@ -37,11 +37,37 @@
   (pattern (~and whole [:annotated-name rhs:expr])
            #:with binding (syntax/loc #'whole [ann-name rhs])))
 
+(define-syntax-class optionally-annotated-binding
+  #:attributes (name ann-name binding rhs)
+  #:description "optionally type-annotated binding"
+  #:literals (:)
+  (pattern b:annotated-binding
+           #:with name #'b.name
+           #:with ann-name #'b.ann-name
+           #:with binding #'b.binding
+           #:with rhs #'b.rhs)
+  (pattern (~and whole [n:id rhs:expr])
+           #:with name #'n
+           #:with ann-name #'n
+           #:with binding #'whole))
+
 (define-syntax-class annotated-values-binding
   #:attributes ((name 1) (ty 1) (ann-name 1) binding rhs)
   (pattern (~and whole [(~describe "sequence of type-annotated identifiers" ([:annotated-name] ...)) rhs:expr])
            #:with binding (syntax/loc #'whole [(ann-name ...) rhs])))
 
+(define-syntax-class optionally-annotated-values-binding
+  #:attributes ((name 1) (ann-name 1) binding rhs)
+  (pattern b:annotated-values-binding
+           #:with (name ...) #'(b.name ...)
+           #:with (ann-name ...) #'(b.ann-name ...)
+           #:with binding #'b.binding
+           #:with rhs #'b.rhs)
+  (pattern (~and whole [(~describe "sequence of optionally type-annotated identifiers" (n:optionally-annotated-formal ...)) rhs:expr])
+           #:with (name ...) #'(n.name ...)
+           #:with (ann-name ...) #'(n.ann-name ...)
+           #:with binding #'whole))
+
 (define-splicing-syntax-class annotated-star-rest
   #:attributes (name ann-name ty formal-ty)
   #:literals (:)  
@@ -64,6 +90,17 @@
   #:attributes (name ty ann-name)
   (pattern [:annotated-name]))
 
+(define-syntax-class optionally-annotated-formal
+  #:description "optionally annotated variable of the form [x : T] or just x"
+  #:opaque
+  #:attributes (name ann-name)
+  (pattern f:annotated-formal
+           #:with name #'f.name
+           #:with ann-name #'f.ann-name)
+  (pattern f:id
+           #:with name #'f
+           #:with ann-name #'f))
+
 (define-syntax-class annotated-formals
   #:attributes (ann-formals (arg-ty 1))
   #:literals (:)
diff --git a/collects/typed-scheme/private/prims.rkt b/collects/typed-scheme/private/prims.rkt
index 82773469..92e9247f 100644
--- a/collects/typed-scheme/private/prims.rkt
+++ b/collects/typed-scheme/private/prims.rkt
@@ -238,7 +238,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
   (let ([mk (lambda (form)
               (lambda (stx)
                 (syntax-parse stx
-                  [(_ (bs:annotated-binding ...) . body)
+                  [(_ (bs:optionally-annotated-binding ...) . body)
                    (quasisyntax/loc stx (#,form (bs.binding ...) . body))])))])
     (values (mk #'let) (mk #'let*) (mk #'letrec))))
 
@@ -246,7 +246,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
   (let ([mk (lambda (form)
               (lambda (stx)
                 (syntax-parse stx
-                  [(_ (bs:annotated-values-binding ...) . body)
+                  [(_ (bs:optionally-annotated-values-binding ...) . body)
                    (quasisyntax/loc stx (#,form (bs.binding ...) . body))])))])
     (values (mk #'let-values) (mk #'let*-values) (mk #'letrec-values))))
 

From 75d628bd686acf47db7f102c63585dec5a285c6c Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 16 Sep 2010 13:07:09 -0400
Subject: [PATCH 143/198] Added a test for optional let annotations.

original commit: 7e2094f2d719cfdb626c6aa78893a8516c9a7ea0
---
 .../tests/typed-scheme/succeed/let-no-anns.rkt   | 16 ++++++++++++++++
 1 file changed, 16 insertions(+)
 create mode 100644 collects/tests/typed-scheme/succeed/let-no-anns.rkt

diff --git a/collects/tests/typed-scheme/succeed/let-no-anns.rkt b/collects/tests/typed-scheme/succeed/let-no-anns.rkt
new file mode 100644
index 00000000..15ff1f3e
--- /dev/null
+++ b/collects/tests/typed-scheme/succeed/let-no-anns.rkt
@@ -0,0 +1,16 @@
+#lang typed/racket
+
+(let: ((x : Integer 3)
+       (y 4))
+      (+ x y))
+
+(let: ((x 3) (y 4))
+      (+ x y))
+
+(let*: ((x 3)
+        (y : Integer (+ x 1)))
+       (+ x y))
+
+(letrec: ((x 3)
+          (y : (Integer -> Integer) (lambda (x) (y x))))
+         x)

From 6b979e393fe8261e6ffc4392093553ee9262aa63 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 16 Sep 2010 13:23:47 -0400
Subject: [PATCH 144/198] Documented optional for: and let: annotations.

original commit: e0bda30738a696a427d2ffc830789628da1beb4d
---
 collects/typed-scheme/scribblings/more.scrbl        |  3 ++-
 .../typed-scheme/scribblings/ts-reference.scrbl     | 13 +++++++++----
 2 files changed, 11 insertions(+), 5 deletions(-)

diff --git a/collects/typed-scheme/scribblings/more.scrbl b/collects/typed-scheme/scribblings/more.scrbl
index 424fa8f9..189e5506 100644
--- a/collects/typed-scheme/scribblings/more.scrbl
+++ b/collects/typed-scheme/scribblings/more.scrbl
@@ -60,7 +60,8 @@ type @racket[(Number -> Number)].  In the body of @racket[id],
 The @racket[let:] form is exactly like @racket[let], but type
 annotations are provided for each variable bound.  Here, @racket[x] is
 given the type @racket[Number].  The @racket[let*:] and
-@racket[letrec:] are similar.
+@racket[letrec:] are similar. Annotations are optional with
+@racket[let:] and variants.
 
 @racketblock[
 (let-values: ([([x : Number] [y : String]) (values 7 "hello")])
diff --git a/collects/typed-scheme/scribblings/ts-reference.scrbl b/collects/typed-scheme/scribblings/ts-reference.scrbl
index 7044a63d..c0913d51 100644
--- a/collects/typed-scheme/scribblings/ts-reference.scrbl
+++ b/collects/typed-scheme/scribblings/ts-reference.scrbl
@@ -252,8 +252,8 @@ creating new types, and annotating expressions.
 Local bindings, like @racket[let], each with
 associated types.  In the second form, @racket[_t0] is the type of the
 result of @racket[_loop] (and thus the result of the entire
-			      expression as well as the final
-				expression in @racket[body]).}
+expression as well as the final expression in @racket[body]).
+Type annotations are optional.}
 @deftogether[[
 @defform[(letrec: ([v : t e] ...) . body)]
 @defform[(let*: ([v : t e] ...) . body)]
@@ -262,7 +262,8 @@ result of @racket[_loop] (and thus the result of the entire
 @defform[(let*-values: ([([v : t] ...) e] ...) . body)]]]{
 Type-annotated versions of
 @racket[letrec], @racket[let*], @racket[let-values],
-  @racket[letrec-values], and @racket[let*-values].}  
+@racket[letrec-values], and @racket[let*-values]. As with
+@racket[let:], type annotations are optional.}
 
 @deftogether[[
 @defform[(let/cc: v : t . body)]
@@ -297,11 +298,14 @@ A polymorphic function of multiple arities.}
               ([type-ann-maybe code:blank
                                @code:line[: Void]]
 	       [for:-clause [id : t seq-expr]
+	                    [id seq-expr]
 	                    @code:line[#:when guard]])]{
 Like @racket[for], but each @racket[id] having the associated type
 @racket[t]. Since the return type is always @racket[Void], annotating
 the return type of a @racket[for] form is optional. Unlike
 @racket[for], multi-valued @racket[seq-expr]s are not supported.
+Type annotations in clauses are optional for all @racket[for:]
+variants.
 }
 
 @deftogether[[
@@ -351,7 +355,8 @@ These behave like their non-annotated counterparts.
               ([step-expr-maybe code:blank
                                 step-expr])]{
 Like @racket[do], but each @racket[id] having the associated type @racket[t], and 
-the final body @racket[expr] having the type @racket[u].
+the final body @racket[expr] having the type @racket[u]. Type
+annotations are optional.
 }
 
 

From dbdb62fc7bd361033f5ab0f31d1b7a105d4645e8 Mon Sep 17 00:00:00 2001
From: Stevie Strickland <sstrickl@racket-lang.org>
Date: Mon, 17 May 2010 13:11:10 -0400
Subject: [PATCH 145/198] Convert vectorof/vector-immutableof to the new
 regime.

Also add old-style vectorof to mzlib/contract.

original commit: 3028f2d1424123d076a95572a7564b8fb069a86e
---
 collects/typed-scheme/private/type-contract.rkt | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/collects/typed-scheme/private/type-contract.rkt b/collects/typed-scheme/private/type-contract.rkt
index 5c4b9278..e8eacaf4 100644
--- a/collects/typed-scheme/private/type-contract.rkt
+++ b/collects/typed-scheme/private/type-contract.rkt
@@ -132,7 +132,9 @@
              #'(or/c . cnts)))]
         [(and t (Function: _)) (t->c/fun t)]
         [(Vector: t)
-         #`(vectorof #,(t->c t #:flat #t))]
+         (if flat?
+             #`(vectorof #,(t->c t #:flat #t) #:flat? #t)
+             #`(vectorof #,(t->c t)))]
         [(Box: t)
          (if flat?
              #`(box/c #,(t->c t #:flat #t) #:flat? #t)

From b6a14210edafdeb03894e28e1393456511fd1c31 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 20 Sep 2010 03:31:18 -0600
Subject: [PATCH 146/198] rename file to avoid :, which is not allowed under
 Windows

original commit: fa7dd9b522f0dd14d3b71c74256803228379d562
---
 .../succeed/{struct:-mutable.rkt => struct-mutable.rkt}           | 0
 1 file changed, 0 insertions(+), 0 deletions(-)
 rename collects/tests/typed-scheme/succeed/{struct:-mutable.rkt => struct-mutable.rkt} (100%)

diff --git a/collects/tests/typed-scheme/succeed/struct:-mutable.rkt b/collects/tests/typed-scheme/succeed/struct-mutable.rkt
similarity index 100%
rename from collects/tests/typed-scheme/succeed/struct:-mutable.rkt
rename to collects/tests/typed-scheme/succeed/struct-mutable.rkt

From 2e1cf9d4f4a72a9e3979509937a183fd05e92f0d Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 22 Sep 2010 17:51:18 -0400
Subject: [PATCH 147/198] Explained a design decision.

original commit: 4aa7bc8439195addb172976253054ca1d41c72a1
---
 collects/typed-scheme/utils/tc-utils.rkt | 1 +
 1 file changed, 1 insertion(+)

diff --git a/collects/typed-scheme/utils/tc-utils.rkt b/collects/typed-scheme/utils/tc-utils.rkt
index 4a21c083..04b8e729 100644
--- a/collects/typed-scheme/utils/tc-utils.rkt
+++ b/collects/typed-scheme/utils/tc-utils.rkt
@@ -83,6 +83,7 @@ don't depend on any other portion of the system
   (define (reset!) (set! delayed-errors null))
   (match (reverse delayed-errors)
     [(list) (void)]
+    ;; if there's only one, we don't need multiple-error handling
     [(list (struct err (msg stx)))
      (reset!)
      (raise-typecheck-error msg stx)]

From 5fab19e4df4b0cdd96439c8940f5b8462181cd22 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 22 Sep 2010 18:05:32 -0400
Subject: [PATCH 148/198] Improved TR's error messages in presence of
 case-lambda types.

- When displaying errors involving functions that have case-lambda
  types with branches that are redundant modulo filters (such as <, >
  and others), only the general branches appear in the error message.
  (Real Real Real * -> Boolean, in the case of < and co.).
- For all errors involving case-lambda types, only domains for which
  the return type is consistent with the expected type are displayed
  in the error message. Further simplification is planned.

original commit: 206fe52047f24ab89ac1d538c939c04fbbae59b7
---
 .../typed-scheme/typecheck/tc-app-helper.rkt  | 102 +++++++++++++++---
 collects/typed-scheme/typecheck/tc-app.rkt    |   4 +-
 collects/typed-scheme/typecheck/tc-funapp.rkt |   2 +-
 3 files changed, 91 insertions(+), 17 deletions(-)

diff --git a/collects/typed-scheme/typecheck/tc-app-helper.rkt b/collects/typed-scheme/typecheck/tc-app-helper.rkt
index df152dfa..fbccd9b1 100644
--- a/collects/typed-scheme/typecheck/tc-app-helper.rkt
+++ b/collects/typed-scheme/typecheck/tc-app-helper.rkt
@@ -1,7 +1,8 @@
 #lang scheme/base
 
 (require "../utils/utils.rkt" racket/match unstable/list
-         (utils tc-utils) (rep type-rep) (types utils union abbrev))
+         (only-in srfi/1 unzip4) (only-in racket/list make-list)
+         (utils tc-utils) (rep type-rep) (types utils union abbrev subtype))
 
 (provide (all-defined-out))
 
@@ -59,20 +60,91 @@
         ""))]
     [else
      (let ([label  (if expected   "Types: "   "Domains: ")]
-           [nl+spc (if expected "\n       " "\n         ")]
-           [pdoms  (map make-printable doms)])
-       (string-append
-        label
-        (stringify (if expected
-                     (map stringify-domain pdoms rests drests rngs)
-                     (map stringify-domain pdoms rests drests))
-                   nl+spc)
-        "\nArguments: "
-        arguments-str
-        "\n"
-        (if expected
-          (format "Expected result: ~a\n" (make-printable expected))
-          "")))]))
+           [nl+spc (if expected "\n       " "\n         ")])
+       ;; we restrict the domains shown in the error messages to those that
+       ;; are useful
+       (let-values ([(pdoms rngs rests drests) (possible-domains doms rests drests rngs expected)])
+         (let ([pdoms (map make-printable pdoms)])
+           (string-append
+            label
+            (stringify (if expected
+                           (map stringify-domain pdoms rests drests rngs)
+                           (map stringify-domain pdoms rests drests))
+                       nl+spc)
+            "\nArguments: "
+            arguments-str
+            "\n"
+            (if expected
+                (format "Expected result: ~a\n" (make-printable expected))
+                "")))))]))
+
+
+;; 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
+(define (possible-domains doms rests drests rngs expected)
+
+  ;; is fun-ty subsumed by a function type in others?
+  (define (is-subsumed-in? fun-ty others)
+    ;; assumption: domains go from more specific to less specific
+    ;;  thus, a domain can only be subsumed by another that is further down
+    ;;  the list.
+    ;; this is reasonable because a more specific domain coming after a more
+    ;; general domain would never be matched
+    ;; a case subsumes another if the first one is a subtype of the other
+    (ormap (lambda (x) (subtype x fun-ty))
+           others))
+
+  (define expected-ty (and expected (match expected [(tc-result1: t) t])))
+  (define (returns-subtype-of-expected? fun-ty)
+    (and fun-ty ; was not skipped by a previous check
+         (or (not expected)
+             (match fun-ty
+                    [(Function: (list (arr: _ rng _ _ _)))
+                     (let ([rng (match rng
+                                       [(Values: (list (Result: t _ _)))
+                                        t]
+                                       [(ValuesDots: (list (Result: t _ _)) _ _)
+                                        t])])
+                       (subtype rng expected-ty))]))))
+  
+  (let loop ([cases (map (compose make-Function list make-arr)
+                         doms
+                         (map (lambda (rng) ; strip filters
+                                (match rng
+                                  [(Values: (list (Result: t _ _) ...))
+                                   (-values t)]
+                                  [(ValuesDots: (list (Result: t _ _) ...) _ _)
+                                   (-values t)]))
+                              rngs)
+                         rests drests (make-list (length doms) null))]
+             [candidates '()])
+    (if (not (null? cases))
+        ;; discard subsumed cases
+        (let ([head (car cases)] [tail (cdr cases)])
+          (if (is-subsumed-in? head tail)
+              (loop tail (cons #f   candidates)) ; will be skipped later
+              (loop tail (cons head candidates))))
+        ;; keep only the domains for which the associated function type
+        ;; fits our criteria
+        (unzip4 (map cdr ; doms, rests drests
+                     (let* ([orig (map list
+                                       (reverse candidates)
+                                       doms
+                                       rngs
+                                       rests
+                                       drests)]
+                            [after (filter (compose returns-subtype-of-expected? car)
+                                           orig)])
+                       ;; if we somehow eliminate all the cases (bogus expected type)
+                       ;; fall back to the showing extra cases
+                       (if (null? after) orig after)))))))
 
 (define (poly-fail t argtypes #:name [name #f] #:expected [expected #f])
   (match t
diff --git a/collects/typed-scheme/typecheck/tc-app.rkt b/collects/typed-scheme/typecheck/tc-app.rkt
index 0263ccc8..3a9322a8 100644
--- a/collects/typed-scheme/typecheck/tc-app.rkt
+++ b/collects/typed-scheme/typecheck/tc-app.rkt
@@ -140,7 +140,9 @@
            (tc-error/expr 
             #:return (or expected (ret (Un)))
             (string-append "No function domains matched in function application:\n"
-                           (domain-mismatches arities doms rests drests rngs (map tc-expr (syntax->list pos-args)) #f #f)))
+                           (domain-mismatches arities doms rests drests rngs
+                                              (map tc-expr (syntax->list pos-args))
+                                              #f #f #:expected expected)))
          (tc/funapp (car (syntax-e form)) kw-args
                     (ret (make-Function new-arities))
                     (map tc-expr (syntax->list pos-args)) expected)))]))
diff --git a/collects/typed-scheme/typecheck/tc-funapp.rkt b/collects/typed-scheme/typecheck/tc-funapp.rkt
index b2df3743..7531f8aa 100644
--- a/collects/typed-scheme/typecheck/tc-funapp.rkt
+++ b/collects/typed-scheme/typecheck/tc-funapp.rkt
@@ -58,7 +58,7 @@
       (tc-error/expr 
        #:return (or expected (ret (Un)))
        (string-append "No function domains matched in function application:\n"
-                      (domain-mismatches t doms rests drests rngs argtys-t #f #f))))]
+                      (domain-mismatches t doms rests drests rngs argtys-t #f #f #:expected expected))))]
     ;; any kind of dotted polymorphic function without mandatory keyword args
     [((tc-result1: (and t (PolyDots: 
                            (and vars (list fixed-vars ... dotted-var))

From 8c6264008dfce9ceeca494e50aef7365362ed974 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 30 Sep 2010 16:09:11 -0400
Subject: [PATCH 149/198] Delete compiled benchmarks when testing.

original commit: f7436b59fb3d1f91481216148f4e147315b0144c
---
 collects/tests/typed-scheme/main.rkt | 6 ++++--
 1 file changed, 4 insertions(+), 2 deletions(-)

diff --git a/collects/tests/typed-scheme/main.rkt b/collects/tests/typed-scheme/main.rkt
index 9fb96757..0d83c532 100644
--- a/collects/tests/typed-scheme/main.rkt
+++ b/collects/tests/typed-scheme/main.rkt
@@ -2,7 +2,7 @@
 
 (provide go go/text)
 
-(require rackunit rackunit/text-ui
+(require rackunit rackunit/text-ui racket/file
          mzlib/etc scheme/port
          compiler/compiler
          scheme/match mzlib/compile
@@ -134,7 +134,9 @@
                                      (check-not-exn (λ () (cfile (build-path path p)))))))))
   (test-suite "compiling"
               (mk shootout)
-              (mk common)))
+              (delete-directory/files (build-path shootout "compiled"))
+              (mk common)
+              (delete-directory/files (build-path common "compiled"))))
 
 (provide go go/text just-one compile-benchmarks)
 

From 7876c75cbc46addf13f9e372d6953e4bb82c9017 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 1 Oct 2010 17:22:15 -0400
Subject: [PATCH 150/198] Got rid of a broken subtyping rule.

original commit: 5a67535a950ba19846151a6f7a3f7a473affea86
---
 collects/tests/typed-scheme/fail/log-not-complex.rkt     | 5 +++++
 .../typed-scheme/optimizer/tests/invalid-log-complex.rkt | 9 +++++++++
 collects/typed-scheme/types/subtype.rkt                  | 1 -
 3 files changed, 14 insertions(+), 1 deletion(-)
 create mode 100644 collects/tests/typed-scheme/fail/log-not-complex.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/invalid-log-complex.rkt

diff --git a/collects/tests/typed-scheme/fail/log-not-complex.rkt b/collects/tests/typed-scheme/fail/log-not-complex.rkt
new file mode 100644
index 00000000..450a6596
--- /dev/null
+++ b/collects/tests/typed-scheme/fail/log-not-complex.rkt
@@ -0,0 +1,5 @@
+#;
+(exn-pred 1)
+#lang typed/scheme
+
+(ann (log 2.0) Inexact-Complex)
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-log-complex.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-log-complex.rkt
new file mode 100644
index 00000000..e397660e
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-log-complex.rkt
@@ -0,0 +1,9 @@
+#;
+(
+0.6931471805599453
+)
+
+#lang typed/scheme
+#:optimize
+
+(real-part (log 2.0))
diff --git a/collects/typed-scheme/types/subtype.rkt b/collects/typed-scheme/types/subtype.rkt
index 56e151e1..33f0a82e 100644
--- a/collects/typed-scheme/types/subtype.rkt
+++ b/collects/typed-scheme/types/subtype.rkt
@@ -263,7 +263,6 @@
 	      [((== -Fixnum =t) (Base: 'Integer _)) A0]
 
               [((Base: 'Nonnegative-Flonum _) (Base: 'Flonum _)) A0]
-              [((Base: 'Nonnegative-Flonum _) (Base: 'InexactComplex _)) A0]
               [((Base: 'Nonnegative-Flonum _) (Base: 'Number _)) A0]
 
               [((Base: 'InexactComplex _) (Base: 'Number _)) A0]

From 5733f06d9aa0134e9f451d5a30a6583793de1be8 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Fri, 1 Oct 2010 19:20:05 -0700
Subject: [PATCH 151/198] Contract fixes.

original commit: c739128703d917540ff963775459b6c75ccf2c80
---
 collects/typed-scheme/typecheck/tc-envops.rkt |  6 ++++--
 collects/typed-scheme/types/substitute.rkt    | 17 ++++++++++-------
 2 files changed, 14 insertions(+), 9 deletions(-)

diff --git a/collects/typed-scheme/typecheck/tc-envops.rkt b/collects/typed-scheme/typecheck/tc-envops.rkt
index 8643a6b3..de799dc4 100644
--- a/collects/typed-scheme/typecheck/tc-envops.rkt
+++ b/collects/typed-scheme/typecheck/tc-envops.rkt
@@ -72,7 +72,8 @@
 
 ;; sets the flag box to #f if anything becomes (U)
 (d/c (env+ env fs flag)
-  (env? (listof Filter/c) (box/c #t). -> . env?)
+  (([e env?] [fs (listof Filter/c)] [bx (box/c boolean?)])
+   #:pre (bx) (unbox bx) . ->i . [_ env?])
   (define-values (props atoms) (combine-props fs (env-props env) flag))
   (for/fold ([Γ (replace-props env (append atoms props))]) ([f atoms])
     (match f
@@ -85,4 +86,5 @@
                             x Γ)]
       [_ Γ])))
 
-(p/c [env+ (env? (listof Filter/c) (box/c #t). -> . env?)])
\ No newline at end of file
+(p/c [env+ (([e env?] [fs (listof Filter/c)] [bx (box/c boolean?)])
+	    #:pre (bx) (unbox bx) . ->i . [_ env?])])
diff --git a/collects/typed-scheme/types/substitute.rkt b/collects/typed-scheme/types/substitute.rkt
index 60850e27..e5fcc5ab 100644
--- a/collects/typed-scheme/types/substitute.rkt
+++ b/collects/typed-scheme/types/substitute.rkt
@@ -12,13 +12,6 @@
          (struct-out t-subst) (struct-out i-subst) (struct-out i-subst/starred) (struct-out i-subst/dotted)
          substitution/c make-simple-substitution)
 
-(define (subst v t e) (substitute t v e))
-
-(d/c (make-simple-substitution vs ts)
-  (([vs (listof symbol?)] [ts (listof Type/c)]) () #:pre-cond (= (length vs) (length ts)) . ->d . [_ substitution/c])
-  (for/hash ([v (in-list vs)] [t (in-list ts)])
-    (values v (t-subst t))))
-
 (d-s/c subst-rhs () #:transparent)
 (d-s/c (t-subst subst-rhs) ([type Type/c]) #:transparent)
 (d-s/c (i-subst subst-rhs) ([types (listof Type/c)]) #:transparent)
@@ -27,6 +20,16 @@
 
 (define substitution/c (hash/c symbol? subst-rhs? #:immutable #t))
 
+(define (subst v t e) (substitute t v e))
+
+(d/c (make-simple-substitution vs ts)
+  (([vs (listof symbol?)] [ts (listof Type/c)]) ()
+   #:pre (vs ts) (= (length vs) (length ts))
+    . ->i . [_ substitution/c])
+  (for/hash ([v (in-list vs)] [t (in-list ts)])
+    (values v (t-subst t))))
+
+
 ;; substitute : Type Name Type -> Type
 (d/c (substitute image name target #:Un [Un (get-union-maker)])
   ((Type/c symbol? Type?) (#:Un procedure?) . ->* . Type?)

From 9e13c1a6d94a18d66e7043c796e8be702f486b8c Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 4 Oct 2010 11:41:17 -0400
Subject: [PATCH 152/198] Register types for send exprs in the type table.

original commit: 21723281899d7aab5692e605386abcf6f92cefe9
---
 .../typed-scheme/typecheck/tc-expr-unit.rkt   | 64 ++++++++++---------
 1 file changed, 35 insertions(+), 29 deletions(-)

diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.rkt b/collects/typed-scheme/typecheck/tc-expr-unit.rkt
index 9f4b4a2d..6934dd2d 100644
--- a/collects/typed-scheme/typecheck/tc-expr-unit.rkt
+++ b/collects/typed-scheme/typecheck/tc-expr-unit.rkt
@@ -2,7 +2,6 @@
 
 
 (require (rename-in "../utils/utils.rkt" [private private-in])
-         syntax/kerncase mzlib/trace
          racket/match (prefix-in - scheme/contract)
          "signatures.rkt" "tc-envops.rkt" "tc-metafunctions.rkt" "tc-subst.rkt"
          "check-below.rkt" "tc-funapp.rkt"
@@ -149,8 +148,9 @@
 
 ;; typecheck an identifier
 ;; the identifier has variable effect
-;; tc-id : identifier -> tc-result
-(define (tc-id id)
+;; tc-id : identifier -> tc-results
+(d/c (tc-id id)
+  (--> identifier? tc-results?)
   (let* ([ty (lookup-type/lexical id)])
     (ret ty
          (make-FilterSet (-not-filter (-val #f) id) 
@@ -208,7 +208,8 @@
                     t)]))))
 
 ;; tc-expr/check : syntax tc-results -> tc-results
-(define (tc-expr/check/internal form expected)
+(d/c (tc-expr/check/internal form expected)
+  (--> syntax? tc-results? tc-results?)
   (parameterize ([current-orig-stx form])
     ;(printf "form: ~a\n" (syntax-object->datum form))
     ;; the argument must be syntax
@@ -219,13 +220,14 @@
            (lambda args
              (define te (apply ret args))
              (check-below te expected))])
-      (kernel-syntax-case* form #f 
-        (letrec-syntaxes+values find-method/who) ;; letrec-syntaxes+values is not in kernel-syntax-case literals
+      (syntax-parse form
+        #:literal-sets (kernel-literals)
+        #:literals (find-method/who)
         [stx
-         (syntax-property form 'typechecker:with-handlers)
+         #:when (syntax-property form 'typechecker:with-handlers)
          (check-subforms/with-handlers/check form expected)]
         [stx 
-         (syntax-property form 'typechecker:ignore-some)
+         #:when (syntax-property form 'typechecker:ignore-some)
          (let ([ty (check-subforms/ignore form)])
            (unless ty
              (int-err "internal error: ignore-some"))
@@ -251,7 +253,7 @@
         [(#%variable-reference . _)
          (tc-error/expr #:return (ret expected) "#%variable-reference is not supported by Typed Scheme")]
         ;; identifiers
-        [x (identifier? #'x) 
+        [x:identifier
            (check-below (tc-id #'x) expected)]
         ;; w-c-m
         [(with-continuation-mark e1 e2 e3)
@@ -270,31 +272,31 @@
         [(begin e . es) (tc-exprs/check (syntax->list #'(e . es)) expected)]
         [(begin0 e . es)
          (begin (tc-exprs/check (syntax->list #'es) Univ)
-                (tc-expr/check #'e expected))]          
+                (tc-expr/check #'e expected))]
         ;; if
         [(if tst thn els) (tc/if-twoarm #'tst #'thn #'els expected)]
         ;; lambda
         [(#%plain-lambda formals . body)
-         (tc/lambda/check form #'(formals) #'(body) expected)]        
+         (tc/lambda/check form #'(formals) #'(body) expected)]
         [(case-lambda [formals . body] ...)
-         (tc/lambda/check form #'(formals ...) #'(body ...) expected)] 
+         (tc/lambda/check form #'(formals ...) #'(body ...) expected)]
         ;; send
         [(let-values (((_) meth))
-           (let-values (((_ _) (#%plain-app find-method/who _ rcvr _)))
+           (let-values (((_ _) (~and find-app (#%plain-app find-method/who _ rcvr _))))
              (#%plain-app _ _ args ...)))
-         (tc/send #'rcvr #'meth #'(args ...) expected)]        
+         (tc/send #'find-app #'rcvr #'meth #'(args ...) expected)]
         ;; let
         [(let-values ([(name ...) expr] ...) . body)
          (tc/let-values #'((name ...) ...) #'(expr ...) #'body form expected)]
         [(letrec-values ([(name) expr]) name*)
-         (and (identifier? #'name*) (free-identifier=? #'name #'name*))
+         #:when (and (identifier? #'name*) (free-identifier=? #'name #'name*))
          (match expected
            [(tc-result1: t)
             (with-lexical-env/extend (list #'name) (list t) (tc-expr/check #'expr expected))]
-           [(tc-results: ts) 
+           [(tc-results: ts)
             (tc-error/expr #:return (ret (Un)) "Expected ~a values, but got only 1" (length ts))])]
         [(letrec-values ([(name ...) expr] ...) . body)
-         (tc/letrec-values #'((name ...) ...) #'(expr ...) #'body form expected)]        
+         (tc/letrec-values #'((name ...) ...) #'(expr ...) #'body form expected)]
         ;; other
         [_ (tc-error/expr #:return (ret expected) "cannot typecheck unknown form : ~a\n" (syntax->datum form))]
         ))))
@@ -307,17 +309,18 @@
   ;; do the actual typechecking of form
   ;; internal-tc-expr : syntax -> Type    
   (define (internal-tc-expr form)
-    (kernel-syntax-case* form #f 
-      (letrec-syntaxes+values #%datum #%app lambda find-method/who) ;; letrec-syntaxes+values is not in kernel-syntax-case literals
+    (syntax-parse form
+      #:literal-sets (kernel-literals)
+      #:literals (#%app lambda find-method/who)
       ;; 
       [stx
-       (syntax-property form 'typechecker:with-handlers)
+       #:when (syntax-property form 'typechecker:with-handlers)
        (let ([ty (check-subforms/with-handlers form)])
          (unless ty
            (int-err "internal error: with-handlers"))
          ty)]
       [stx 
-       (syntax-property form 'typechecker:ignore-some)
+       #:when (syntax-property form 'typechecker:ignore-some)
        (let ([ty (check-subforms/ignore form)])
          (unless ty
            (int-err "internal error: ignore-some"))
@@ -342,9 +345,9 @@
        (tc/lambda form #'(formals ...) #'(body ...))]  
       ;; send
       [(let-values (((_) meth))
-         (let-values (((_ _) (#%plain-app find-method/who _ rcvr _)))
+         (let-values (((_ _) (~and find-app (#%plain-app find-method/who _ rcvr _))))
            (#%plain-app _ _ args ...)))
-       (tc/send #'rcvr #'meth #'(args ...))]
+       (tc/send #'find-app #'rcvr #'meth #'(args ...))]
       ;; let
       [(let-values ([(name ...) expr] ...) . body)
        (tc/let-values #'((name ...) ...) #'(expr ...) #'body form)]
@@ -365,7 +368,7 @@
       [(#%variable-reference . _)
        (tc-error/expr #:return (ret (Un)) "#%variable-reference is not supported by Typed Scheme")]
       ;; identifiers
-      [x (identifier? #'x) (tc-id #'x)]                 
+      [x:identifier (tc-id #'x)]
       ;; application        
       [(#%plain-app . _) (tc/app form)]
       ;; if
@@ -402,17 +405,20 @@
            (add-typeof-expr form r)
            r)]))))
 
-(define (tc/send rcvr method args [expected #f])
+(d/c (tc/send form rcvr method args [expected #f])
+  (-->* (syntax? syntax? syntax? syntax?) ((-or/c tc-results? #f)) tc-results?)
   (match (tc-expr rcvr)
     [(tc-result1: (Instance: (and c (Class: _ _ methods))))
      (match (tc-expr method)
        [(tc-result1: (Value: (? symbol? s)))
         (let* ([ftype (cond [(assq s methods) => cadr]
                             [else (tc-error/expr "send: method ~a not understood by class ~a" s c)])]
-               [ret-ty (tc/funapp rcvr args (ret ftype) (map tc-expr (syntax->list args)) expected)])
-          (if expected
-              (begin (check-below ret-ty expected) expected)
-              ret-ty))]
+               [ret-ty (tc/funapp rcvr args (ret ftype) (map tc-expr (syntax->list args)) expected)]
+               [retval (if expected
+                           (begin (check-below ret-ty expected) expected)
+                           ret-ty)])
+          (add-typeof-expr form retval)
+          retval)]
        [(tc-result1: t) (int-err "non-symbol methods not supported by Typed Scheme: ~a" t)])]
     [(tc-result1: t) (tc-error/expr #:return (or expected (ret (Un))) "send: expected a class instance, got ~a" t)]))
 

From 105b82fb7002e4fb8928d765e88c95cf8f0fe826 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 6 Oct 2010 16:20:57 -0400
Subject: [PATCH 153/198] Fixed tautology/contradiction recording to work with
 case-lambda.

original commit: 5395dbca122c534db3d70139c871e0bc4b91515f
---
 collects/typed-scheme/typecheck/tc-if.rkt  | 20 ++++++++++++++++----
 collects/typed-scheme/types/type-table.rkt | 13 ++++++++-----
 2 files changed, 24 insertions(+), 9 deletions(-)

diff --git a/collects/typed-scheme/typecheck/tc-if.rkt b/collects/typed-scheme/typecheck/tc-if.rkt
index 0c61c883..f897a9b0 100644
--- a/collects/typed-scheme/typecheck/tc-if.rkt
+++ b/collects/typed-scheme/typecheck/tc-if.rkt
@@ -58,10 +58,22 @@
          ;(printf "new-els-props: ~a\n" new-els-props)
 
          ;; record reachability
-         (when (not (unbox flag+))
-           (add-contradiction tst))
-         (when (not (unbox flag-))
-           (add-tautology tst))
+         ;; since we may typecheck a given piece of code multiple times in different
+         ;; contexts, we need to take previous results into account
+         (cond [(and (not (unbox flag+)) ; maybe contradiction
+                     ;; to be an actual contradiction, we must have either previously
+                     ;; recorded this test as a contradiction, or have never seen it
+                     ;; before
+                     (not (tautology? tst))
+                     (not (neither? tst)))
+                (add-contradiction tst)]
+               [(and (not (unbox flag-)) ; maybe tautology
+                     ;; mirror case
+                     (not (contradiction? tst))
+                     (not (neither? tst)))
+                (add-tautology tst)]
+               [else
+                (add-neither tst)])
 
          ;; if we have the same number of values in both cases
          (cond [(= (length ts) (length us))
diff --git a/collects/typed-scheme/types/type-table.rkt b/collects/typed-scheme/types/type-table.rkt
index 2e1c7896..43b1221a 100644
--- a/collects/typed-scheme/types/type-table.rkt
+++ b/collects/typed-scheme/types/type-table.rkt
@@ -55,19 +55,20 @@
 
 ;; keeps track of expressions that always evaluate to true or always evaluate
 ;; to false, so that the optimizer can eliminate dead code
+;; 3 possible values: 'tautology 'contradiction 'neither
 (define tautology-contradiction-table (make-hasheq))
 
-(define-values (add-tautology add-contradiction)
+(define-values (add-tautology add-contradiction add-neither)
   (let ()
     (define ((mk t?) e)
       (when (optimize?)
         (hash-set! tautology-contradiction-table e t?)))
-    (values (mk #t) (mk #f))))
-(define-values (tautology? contradiction?)
+    (values (mk 'tautology) (mk 'contradiction) (mk 'neither))))
+(define-values (tautology? contradiction? neither?)
   (let ()
     (define ((mk t?) e)
       (eq? t? (hash-ref tautology-contradiction-table e 'not-there)))
-    (values (mk #t) (mk #f))))
+    (values (mk 'tautology) (mk 'contradiction) (mk 'neither))))
 
 (p/c [add-typeof-expr (syntax? tc-results? . -> . any/c)]
      [type-of (syntax? . -> . tc-results?)]
@@ -79,5 +80,7 @@
      [make-struct-table-code (-> syntax?)]
      [add-tautology (syntax? . -> . any/c)]
      [add-contradiction (syntax? . -> . any/c)]
+     [add-neither (syntax? . -> . any/c)]
      [tautology? (syntax? . -> . boolean?)]
-     [contradiction? (syntax? . -> . boolean?)])
+     [contradiction? (syntax? . -> . boolean?)]
+     [neither? (syntax? . -> . boolean?)])

From 057043c49305f2b5cbcd9805ffae05f13497d507 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 5 Oct 2010 15:56:25 -0400
Subject: [PATCH 154/198] Turned the optimizer on by default.

original commit: 8baa1682af76965400ab1071a46f8ba50f7c7165
---
 collects/typed-scheme/core.rkt        | 7 +++++--
 collects/typed-scheme/utils/utils.rkt | 2 +-
 2 files changed, 6 insertions(+), 3 deletions(-)

diff --git a/collects/typed-scheme/core.rkt b/collects/typed-scheme/core.rkt
index 04ac1879..e2e1bc90 100644
--- a/collects/typed-scheme/core.rkt
+++ b/collects/typed-scheme/core.rkt
@@ -20,9 +20,12 @@
 
 (define (mb-core stx)
   (syntax-parse stx
-    [(mb (~optional (~and #:optimize (~bind [opt? #'#t]))) forms ...)
+    [(mb (~optional (~or (~and #:optimize    (~bind [opt? #'#t])) ; kept for backward compatibility
+                         (~and #:no-optimize (~bind [opt? #'#f]))))
+         forms ...)
      (let ([pmb-form (syntax/loc stx (#%plain-module-begin forms ...))])
-       (parameterize ([optimize? (or (optimize?) (attribute opt?))])
+       (parameterize ([optimize? (or (and (not (attribute opt?)) (optimize?))
+                                     (and (attribute opt?) (syntax-e (attribute opt?))))])
          (tc-setup 
           stx pmb-form 'module-begin new-mod tc-module after-code
           (with-syntax*
diff --git a/collects/typed-scheme/utils/utils.rkt b/collects/typed-scheme/utils/utils.rkt
index 78768203..47712145 100644
--- a/collects/typed-scheme/utils/utils.rkt
+++ b/collects/typed-scheme/utils/utils.rkt
@@ -25,7 +25,7 @@ at least theoretically.
  ;; provide macros
  rep utils typecheck infer env private types)
 
-(define optimize? (make-parameter #f))
+(define optimize? (make-parameter #t))
 (define-for-syntax enable-contracts? #f)
 (define show-input? (make-parameter #f))
 

From 30780b3f6a1813e464e20f14e9d9f27b0bf884e8 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 6 Oct 2010 11:11:47 -0400
Subject: [PATCH 155/198] Changed the optimizer's test harness for optimization
 on by default.

original commit: abcbce129bf65fc63daa33d843589305efd94b81
---
 collects/tests/typed-scheme/optimizer/run.rkt | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/tests/typed-scheme/optimizer/run.rkt b/collects/tests/typed-scheme/optimizer/run.rkt
index ebff7709..87787175 100644
--- a/collects/tests/typed-scheme/optimizer/run.rkt
+++ b/collects/tests/typed-scheme/optimizer/run.rkt
@@ -29,7 +29,7 @@
               [m    (or (regexp-match-positions prog-rx prog)
                         (error 'evaluator "bad program contents in ~e" file))]
               [prog (string-append (substring prog (caadr m) (cdadr m))
-                                   (if optimize? "\n#:optimize\n" "\n")
+                                   (if (not optimize?) "\n#:no-optimize\n" "\n")
                                    (substring prog (cdar m)))]
               [evaluator (make-module-evaluator prog)]
               [out       (get-output evaluator)])

From 220b41c75e41cab6e93974ead3921fbbba51e1af Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 6 Oct 2010 16:40:26 -0400
Subject: [PATCH 156/198] Updated the documentation of TR's optimizer.

original commit: d39cb530cf335fbe9549ced308924b0691f8ff18
---
 collects/typed-scheme/scribblings/optimization.scrbl | 11 ++++++-----
 collects/typed-scheme/scribblings/ts-reference.scrbl |  9 +++++----
 2 files changed, 11 insertions(+), 9 deletions(-)

diff --git a/collects/typed-scheme/scribblings/optimization.scrbl b/collects/typed-scheme/scribblings/optimization.scrbl
index 0431cfdc..f782c5c2 100644
--- a/collects/typed-scheme/scribblings/optimization.scrbl
+++ b/collects/typed-scheme/scribblings/optimization.scrbl
@@ -12,13 +12,14 @@ Typed Racket provides a type-driven optimizer that rewrites well-typed
 programs to potentially make them faster. It should in no way make
 your programs slower or unsafe.
 
-@section{Using the optimizer}
+@section{Turning the optimizer off}
 
-Typed Racket's optimizer is not currently turned on by default. If you
-want to activate it, you must add the @racket[#:optimize] keyword when
-specifying the language of your program:
+Typed Racket's optimizer is turned on by default. If you want to
+deactivate it (for debugging, for instance), you must add the
+@racket[#:no-optimize] keyword when specifying the language of your
+program:
 
-@racketmod[typed/racket #:optimize]
+@racketmod[typed/racket #:no-optimize]
 
 @section{Getting the most out of the optimizer}
 Typed Racket's optimizer can improve the performance of various common
diff --git a/collects/typed-scheme/scribblings/ts-reference.scrbl b/collects/typed-scheme/scribblings/ts-reference.scrbl
index c0913d51..7ee92091 100644
--- a/collects/typed-scheme/scribblings/ts-reference.scrbl
+++ b/collects/typed-scheme/scribblings/ts-reference.scrbl
@@ -624,11 +624,12 @@ Typed Racket provides a type-driven optimizer that rewrites well-typed
 programs to potentially make them faster. It should in no way make
 your programs slower or unsafe.
 
-Typed Racket's optimizer is not currently turned on by default. If you
-want to activate it, you must add the @racket[#:optimize] keyword when
-specifying the language of your program:
+Typed Racket's optimizer is turned on by default. If you want to
+deactivate it (for debugging, for instance), you must add the
+@racket[#:no-optimize] keyword when specifying the language of your
+program:
 
-@racketmod[typed/racket #:optimize]
+@racketmod[typed/racket #:no-optimize]
 
 @section{Legacy Forms}
 

From ed4294a6f2bb2b886be34fc31b72a1e05c9efa69 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 6 Oct 2010 18:43:35 -0400
Subject: [PATCH 157/198] Have the optimizer ignore struct/exec.

original commit: 99178c70a0dd5add19b13eec4380f357e0e6680c
---
 collects/typed-scheme/optimizer/optimizer.rkt | 1 +
 1 file changed, 1 insertion(+)

diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt
index 685e1a9e..ac792fe0 100644
--- a/collects/typed-scheme/optimizer/optimizer.rkt
+++ b/collects/typed-scheme/optimizer/optimizer.rkt
@@ -86,6 +86,7 @@
                      [optimize (syntax-parser
                                 [e:expr
                                  #:when (and (not (syntax-property #'e 'typechecker:ignore))
+                                             (not (syntax-property #'e 'typechecker:ignore-some))
                                              (not (syntax-property #'e 'typechecker:with-handlers)))
                                  #:with e*:opt-expr #'e
                                  #'e*.opt]

From 21eb1eeadcd9e31e07eca18a3aa583f9e7536f55 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Mon, 4 Oct 2010 11:28:19 -0400
Subject: [PATCH 158/198] Remove outdated comment.

original commit: a45ce954d798f178cfd17f556f84d55dead2d460
---
 collects/typed-scheme/rep/type-rep.rkt | 1 -
 1 file changed, 1 deletion(-)

diff --git a/collects/typed-scheme/rep/type-rep.rkt b/collects/typed-scheme/rep/type-rep.rkt
index 8f6b3d64..4a7ca8b7 100644
--- a/collects/typed-scheme/rep/type-rep.rkt
+++ b/collects/typed-scheme/rep/type-rep.rkt
@@ -187,7 +187,6 @@
     [#: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))])
 
-;; types : Listof[Type]
 (dt Values ([rs (listof Result?)]) 
     [#:frees (λ (f) (combine-frees (map f rs)))]
     [#:fold-rhs (*Values (map type-rec-id rs))])

From fb0df54c790adcdc3846fb846dc6706ac1421dc9 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 7 Oct 2010 11:19:54 -0400
Subject: [PATCH 159/198] Fix `overlap' for refinements of base types.

original commit: 7bcd107e7ff5ce64791a5613a13f6445a87c638c
---
 collects/typed-scheme/types/remove-intersect.rkt | 4 ++++
 1 file changed, 4 insertions(+)

diff --git a/collects/typed-scheme/types/remove-intersect.rkt b/collects/typed-scheme/types/remove-intersect.rkt
index 9ea45efe..6b3855f0 100644
--- a/collects/typed-scheme/types/remove-intersect.rkt
+++ b/collects/typed-scheme/types/remove-intersect.rkt
@@ -28,6 +28,10 @@
               (overlap (resolve-once t1) (resolve-once t2)))]
          [(list (? Mu?) _) (overlap (unfold t1) t2)]
          [(list _ (? Mu?)) (overlap t1 (unfold t2))]
+         
+         [(list (Refinement: t _ _) t2) (overlap t t2)]
+         [(list t1 (Refinement: t _ _)) (overlap t1 t)]
+         
          [(list (Union: e) t)
           (ormap (lambda (t*) (overlap t* t)) e)]
          [(list t (Union: e))

From 19784fffe5f33825b417167d94340f775a18d2d2 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 7 Oct 2010 17:19:27 -0400
Subject: [PATCH 160/198] Improved TR's error messages when all domains but one
 have been eliminated.

original commit: db0046101cb8b75e56215b4528d280894c59a36d
---
 .../typed-scheme/fail/dead-substruct.rkt      |   2 +-
 .../typed-scheme/typecheck/tc-app-helper.rkt  | 196 ++++++++++++------
 collects/typed-scheme/typecheck/tc-app.rkt    |  20 +-
 collects/typed-scheme/typecheck/tc-apply.rkt  |  47 +++--
 collects/typed-scheme/typecheck/tc-funapp.rkt |  54 +----
 5 files changed, 186 insertions(+), 133 deletions(-)

diff --git a/collects/tests/typed-scheme/fail/dead-substruct.rkt b/collects/tests/typed-scheme/fail/dead-substruct.rkt
index eed75288..2e79f4ae 100644
--- a/collects/tests/typed-scheme/fail/dead-substruct.rkt
+++ b/collects/tests/typed-scheme/fail/dead-substruct.rkt
@@ -1,5 +1,5 @@
 #;
-(exn-pred 1)
+(exn-pred 2)
 #lang typed/scheme
 
 (define-struct: parent ((x : Integer)))
diff --git a/collects/typed-scheme/typecheck/tc-app-helper.rkt b/collects/typed-scheme/typecheck/tc-app-helper.rkt
index 36fcfd06..9d68edc3 100644
--- a/collects/typed-scheme/typecheck/tc-app-helper.rkt
+++ b/collects/typed-scheme/typecheck/tc-app-helper.rkt
@@ -1,11 +1,54 @@
 #lang scheme/base
 
-(require "../utils/utils.rkt" racket/match unstable/list
+(require "../utils/utils.rkt" racket/match unstable/list unstable/sequence
          (only-in srfi/1 unzip4) (only-in racket/list make-list)
-         (utils tc-utils) (rep type-rep) (types utils union abbrev subtype))
+         (prefix-in c: racket/contract)
+         "check-below.rkt" "tc-subst.rkt"
+         (utils tc-utils)
+         (rep type-rep object-rep)
+         (types utils union abbrev subtype))
 
 (provide (all-defined-out))
 
+
+;; syntax? syntax? arr? (listof tc-results?) (or/c #f tc-results) [boolean?] -> tc-results?
+(d/c (tc/funapp1 f-stx args-stx ftype0 argtys expected #:check [check? #t])
+  ((syntax? syntax? arr? (c:listof tc-results?) (c:or/c #f tc-results?)) (#:check boolean?) . c:->* . tc-results?)
+  (match* (ftype0 argtys)
+    ;; we check that all kw args are optional
+    [((arr: dom (Values: (and results (list (Result: t-r f-r o-r) ...))) rest #f (and kws (list (Keyword: _ _ #f) ...)))
+      (list (tc-result1: t-a phi-a o-a) ...))
+     (when check?
+       (cond [(and (not rest) (not (= (length dom) (length t-a))))
+              (tc-error/expr #:return (ret t-r)
+                             "Wrong number of arguments, expected ~a and got ~a" (length dom) (length t-a))]
+             [(and rest (< (length t-a) (length dom)))
+              (tc-error/expr #:return (ret t-r)
+                             "Wrong number of arguments, expected at least ~a and got ~a" (length dom) (length t-a))])
+       (for ([dom-t (if rest (in-sequence-forever dom rest) (in-list dom))] 
+             [a (in-list (syntax->list args-stx))]
+             [arg-t (in-list t-a)])
+         (parameterize ([current-orig-stx a]) (check-below arg-t dom-t))))
+     (let* ([dom-count (length dom)]
+            [arg-count (+ dom-count (if rest 1 0) (length kws))])
+       (let-values
+           ([(o-a t-a) (for/lists (os ts)
+                         ([nm (in-range arg-count)]
+                          [oa (in-sequence-forever (in-list o-a) (make-Empty))]
+                          [ta (in-sequence-forever (in-list t-a) (Un))])
+                         (values (if (>= nm dom-count) (make-Empty) oa)
+                                 ta))])
+         (define-values (t-r f-r o-r)
+           (for/lists (t-r f-r o-r) 
+             ([r (in-list results)])
+             (open-Result r o-a t-a)))
+         (ret t-r f-r o-r)))]
+    [((arr: _ _ _ drest '()) _)
+     (int-err "funapp with drest args ~a ~a NYI" drest argtys)]
+    [((arr: _ _ _ _ kws) _)
+     (int-err "funapp with keyword args ~a NYI" kws)]))
+
+
 (define (make-printable t)
   (match t
     [(tc-result1: t) t]
@@ -21,8 +64,17 @@
            (format "~a~a *~a" doms-string rst rng-string)]
           [else (string-append (stringify (map make-printable dom)) rng-string)])))
 
-(define (domain-mismatches ty doms rests drests rngs arg-tys tail-ty tail-bound
-                           #:expected [expected #f])
+;; Generates error messages when operand types don't match operator domains.
+(d/c (domain-mismatches f-stx args-stx ty doms rests drests rngs arg-tys tail-ty tail-bound
+                           #:expected [expected #f] #:return [return (make-Union null)]
+                           #:msg-thunk [msg-thunk (lambda (dom) dom)])
+   ((syntax? syntax? Type/c (c:listof (c:listof Type/c)) (c:listof (c:or/c #f Type/c))
+     (c:listof (c:or/c #f (c:cons/c Type/c (c:or/c c:natural-number/c symbol?))))
+     (c:listof (c:or/c Values? ValuesDots?)) (c:listof tc-results?) (c:or/c #f Type/c) c:any/c)
+    (#:expected (c:or/c #f tc-results?) #:return tc-results?
+     #:msg-thunk (c:-> string? string?))
+    . c:->* . tc-results?)
+   
   (define arguments-str
     (stringify-domain arg-tys
                       (if (not tail-bound) tail-ty #f)
@@ -31,52 +83,71 @@
     [(null? doms)
      (int-err "How could doms be null: ~a ~a" ty)]
     [(and (= 1 (length doms)) (not (car rests)) (not (car drests)) (not tail-ty) (not tail-bound))
-     (apply string-append
-            (if (not (= (length (car doms)) (length arg-tys)))
-                (format "Wrong number of arguments - Expected ~a, but got ~a\n\n" (length (car doms)) (length arg-tys))
-                "")
-            (append
-             (for/list ([dom-t (in-list (extend arg-tys (car doms) #f))]
-                        [arg-t (in-list (extend (car doms) arg-tys #f))]
-                        [i (in-naturals 1)])
-               (let ([dom-t (or dom-t "-none-")]
-                     [arg-t (or arg-t "-none-")])
-                 (format "Argument ~a:\n  Expected: ~a\n  Given:    ~a\n" i (make-printable dom-t) (make-printable arg-t))))
-             (list
-              (if expected
-                  (format "\nResult type:     ~a\nExpected result: ~a\n"
-                          (car rngs) (make-printable expected))
-                  ""))))]
+     (tc-error/expr
+      #:return return
+      (msg-thunk
+       (apply string-append
+              (if (not (= (length (car doms)) (length arg-tys)))
+                  (format "Wrong number of arguments - Expected ~a, but got ~a\n\n" (length (car doms)) (length arg-tys))
+                  "")
+              (append
+               (for/list ([dom-t (in-list (extend arg-tys (car doms) #f))]
+                          [arg-t (in-list (extend (car doms) arg-tys #f))]
+                          [i (in-naturals 1)])
+                         (let ([dom-t (or dom-t "-none-")]
+                               [arg-t (or arg-t "-none-")])
+                           (format "Argument ~a:\n  Expected: ~a\n  Given:    ~a\n" i (make-printable dom-t) (make-printable arg-t))))
+               (list
+                (if expected
+                    (format "\nResult type:     ~a\nExpected result: ~a\n"
+                            (car rngs) (make-printable expected))
+                    ""))))))]
     [(= 1 (length doms))
-     (string-append
-      "Domain: "
-      (stringify-domain (car doms) (car rests) (car drests))
-      "\nArguments: "
-      arguments-str
-      "\n"
-      (if expected
-        (format "Result type: ~a\nExpected result: ~a\n"
-                (car rngs) (make-printable expected))
-        ""))]
+     (tc-error/expr
+      #:return return
+      (msg-thunk
+       (string-append
+        "Domain: "
+        (stringify-domain (car doms) (car rests) (car drests))
+        "\nArguments: "
+        arguments-str
+        "\n"
+        (if expected
+            (format "Result type: ~a\nExpected result: ~a\n"
+                    (car rngs) (make-printable expected))
+            ""))))]
     [else
      (let ([label  (if expected   "Types: "   "Domains: ")]
            [nl+spc (if expected "\n       " "\n         ")])
        ;; we restrict the domains shown in the error messages to those that
        ;; are useful
        (let-values ([(pdoms rngs rests drests) (possible-domains doms rests drests rngs expected)])
-         (let ([pdoms (map make-printable pdoms)])
-           (string-append
-            label
-            (stringify (if expected
-                           (map stringify-domain pdoms rests drests rngs)
-                           (map stringify-domain pdoms rests drests))
-                       nl+spc)
-            "\nArguments: "
-            arguments-str
-            "\n"
-            (if expected
-                (format "Expected result: ~a\n" (make-printable expected))
-                "")))))]))
+         (if (= (length pdoms) 1)
+             ;; if we narrowed down the possible cases to a single one, have
+             ;; tc/funapp1 generate a better error message
+             (begin (tc/funapp1 f-stx args-stx
+                                (make-arr (car pdoms) (car rngs)
+                                          (car rests) (car drests) null)
+                                arg-tys expected)
+                    return)
+             ;; if not, print the message as usual
+             (let* ([pdoms (map make-printable pdoms)]
+                    [err-doms
+                     (string-append
+                      label
+                      (stringify (if expected
+                                     (map stringify-domain pdoms rests drests rngs)
+                                     (map stringify-domain pdoms rests drests))
+                                 nl+spc)
+                      "\nArguments: "
+                      arguments-str
+                      "\n"
+                      (if expected
+                          (format "Expected result: ~a\n" (make-printable expected))
+                          ""))])
+               (tc-error/expr
+                #:return return
+                (msg-thunk err-doms))))))])) ; generate message
 
 
 ;; to avoid long and confusing error messages, in the case of functions with
@@ -177,7 +248,8 @@
               (let ([fun-tys-ret-any
                      (map (match-lambda
                            [(Function: (list (arr: dom _ rest drest _)))
-                            (make-Function (list (make-arr dom Univ rest drest null)))])
+                            (make-Function (list (make-arr dom (-values (list Univ))
+                                                           rest drest null)))])
                           candidates)])
                 (let loop ([cases fun-tys-ret-any]
                            [parts parts-acc]
@@ -200,7 +272,7 @@
                                   orig
                                   (reverse parts-acc)))))))))))
 
-(define (poly-fail t argtypes #:name [name #f] #:expected [expected #f])
+(define (poly-fail f-stx args-stx t argtypes #:name [name #f] #:expected [expected #f])
   (match t
     [(or (Poly-names: 
           msg-vars 
@@ -218,13 +290,16 @@
                            "Could not infer types for applying polymorphic "
                            fcn-string
                            "\n"))
-           (tc-error/expr #:return (ret (Un))
-                          (string-append
-                           "Polymorphic " fcn-string " could not be applied to arguments:\n"
-                           (domain-mismatches t msg-doms msg-rests msg-drests msg-rngs argtypes #f #f #:expected expected)
-                           (if (not (for/and ([t (apply append (map fv/list msg-doms))]) (memq t msg-vars)))
-                               (string-append "Type Variables: " (stringify msg-vars) "\n")
-                               "")))))]
+           (domain-mismatches f-stx args-stx t msg-doms msg-rests msg-drests
+                              msg-rngs argtypes #f #f #:expected expected
+                              #:return (ret (Un))
+                              #:msg-thunk (lambda (dom)
+                                            (string-append
+                                             "Polymorphic " fcn-string " could not be applied to arguments:\n"
+                                             dom
+                                             (if (not (for/and ([t (apply append (map fv/list msg-doms))]) (memq t msg-vars)))
+                                                 (string-append "Type Variables: " (stringify msg-vars) "\n")
+                                                 ""))))))]
     [(or (Poly-names: msg-vars (Function: (list (arr: msg-doms msg-rngs msg-rests msg-drests kws) ...)))
          (PolyDots-names: msg-vars (Function: (list (arr: msg-doms msg-rngs msg-rests msg-drests kws) ...))))
      (let ([fcn-string (if name
@@ -237,10 +312,13 @@
                            "Could not infer types for applying polymorphic "
                            fcn-string
                            "\n"))
-           (tc-error/expr #:return (ret (Un))
-                          (string-append
-                           "Polymorphic " fcn-string " could not be applied to arguments:\n"
-                           (domain-mismatches t msg-doms msg-rests msg-drests msg-rngs argtypes #f #f #:expected expected)
-                           (if (not (for/and ([t (apply append (map fv/list msg-doms))]) (memq t msg-vars)))
-                               (string-append "Type Variables: " (stringify msg-vars) "\n")
-                               "")))))]))
+           (domain-mismatches f-stx args-stx t msg-doms msg-rests msg-drests
+                              msg-rngs argtypes #f #f #:expected expected
+                              #:return (ret (Un))
+                              #:msg-thunk (lambda (dom)
+                                            (string-append
+                                             "Polymorphic " fcn-string " could not be applied to arguments:\n"
+                                             dom
+                                             (if (not (for/and ([t (apply append (map fv/list msg-doms))]) (memq t msg-vars)))
+                                                 (string-append "Type Variables: " (stringify msg-vars) "\n")
+                                                 ""))))))]))
diff --git a/collects/typed-scheme/typecheck/tc-app.rkt b/collects/typed-scheme/typecheck/tc-app.rkt
index 3a9322a8..96d546e7 100644
--- a/collects/typed-scheme/typecheck/tc-app.rkt
+++ b/collects/typed-scheme/typecheck/tc-app.rkt
@@ -137,15 +137,19 @@
               (match a
                 [(arr: dom rng rest #f ktys) (make-arr* dom rng #:rest rest)]))])
        (if (null? new-arities)
-           (tc-error/expr 
+           (domain-mismatches
+            (car (syntax-e form)) (cdr (syntax-e form))
+            arities doms rests drests rngs
+            (map tc-expr (syntax->list pos-args))
+            #f #f #:expected expected
             #:return (or expected (ret (Un)))
-            (string-append "No function domains matched in function application:\n"
-                           (domain-mismatches arities doms rests drests rngs
-                                              (map tc-expr (syntax->list pos-args))
-                                              #f #f #:expected expected)))
-         (tc/funapp (car (syntax-e form)) kw-args
-                    (ret (make-Function new-arities))
-                    (map tc-expr (syntax->list pos-args)) expected)))]))
+            #:msg-thunk
+            (lambda (dom)
+              (string-append "No function domains matched in function application:\n"
+                             dom)))
+           (tc/funapp (car (syntax-e form)) kw-args
+                      (ret (make-Function new-arities))
+                      (map tc-expr (syntax->list pos-args)) expected)))]))
 
 (define (type->list t)
   (match t
diff --git a/collects/typed-scheme/typecheck/tc-apply.rkt b/collects/typed-scheme/typecheck/tc-apply.rkt
index 99400ff3..2c832ed0 100644
--- a/collects/typed-scheme/typecheck/tc-apply.rkt
+++ b/collects/typed-scheme/typecheck/tc-apply.rkt
@@ -40,21 +40,24 @@
 
   (match f-ty
     ;; apply of simple function
-    [(tc-result1: (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ...)))
+    [(tc-result1: (and t (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ...))))
      ;; special case for (case-lambda)
      (when (null? doms)
        (tc-error/expr #:return (ret (Un))
                       "empty case-lambda given as argument to apply"))
-     (match-let ([arg-tys (map tc-expr/t fixed-args)]
-                 [(tc-result1: tail-ty) (single-value tail)])
+     (match-let* ([arg-tres (map tc-expr fixed-args)]
+                  [arg-tys (map (match-lambda [(tc-result1: t _ _) t]) arg-tres)]
+                  [(tc-result1: tail-ty) (single-value tail)])
        (let loop ([doms* doms] [rngs* rngs] [rests* rests] [drests* drests])
          (cond 
            ;; we've run out of cases to try, so error out           
            [(null? doms*)
-            (tc-error/expr #:return (ret (Un))
-                           (string-append 
-                            "Bad arguments to function in apply:\n"
-                            (domain-mismatches f-ty doms rests drests rngs arg-tys tail-ty #f)))]
+            (domain-mismatches f args t doms rests drests rngs arg-tres tail-ty #f
+                               #:return (ret (Un))
+                               #:msg-thunk (lambda (dom)
+                                             (string-append 
+                                              "Bad arguments to function in apply:\n"
+                                              dom)))]
            ;; this case of the function type has a rest argument
            [(and (car rests*)
                  ;; check that the tail expression is a subtype of the rest argument
@@ -76,7 +79,8 @@
            [else (loop (cdr doms*) (cdr rngs*) (cdr rests*) (cdr drests*))])))]
     ;; apply of simple polymorphic function
     [(tc-result1: (Poly: vars (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ..1))))
-     (let*-values ([(arg-tys) (map tc-expr/t fixed-args)]
+     (let*-values ([(arg-tres) (map tc-expr fixed-args)]
+                   [(arg-tys) (map (match-lambda [(tc-result1: t _ _) t]) arg-tres)]
                    [(tail-ty tail-bound) (match (tc-expr/t tail)
                                            [(ListDots: tail-ty tail-bound)
                                             (values tail-ty tail-bound)]
@@ -84,11 +88,13 @@
        (let loop ([doms* doms] [rngs* rngs] [rests* rests] [drests* drests])
          (cond [(null? doms*)
                 (match f-ty 
-                  [(tc-result1: (Poly-names: _ (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ..1))))
-                   (tc-error/expr #:return (ret (Un))
-                                 (string-append 
-                                  "Bad arguments to polymorphic function in apply:\n"
-                                  (domain-mismatches f-ty doms rests drests rngs arg-tys tail-ty tail-bound)))])]
+                  [(tc-result1: (and t (Poly-names: _ (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ..1)))))
+                   (domain-mismatches f args t doms rests drests rngs arg-tres tail-ty tail-bound
+                                      #:return (ret (Un))
+                                      #:msg-thunk (lambda (dom)
+                                                    (string-append 
+                                                     "Bad arguments to polymorphic function in apply:\n"
+                                                     dom)))])]
                ;; the actual work, when we have a * function and a list final argument
                [(and (car rests*)
                      (not tail-bound)
@@ -129,7 +135,8 @@
                     "Function has no cases")]
     [(tc-result1: (PolyDots: (and vars (list fixed-vars ... dotted-var))
                             (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ..1))))
-     (let*-values ([(arg-tys) (map tc-expr/t fixed-args)]
+     (let*-values ([(arg-tres) (map tc-expr fixed-args)]
+                   [(arg-tys) (map (match-lambda [(tc-result1: t _ _) t]) arg-tres)]
                    [(tail-ty tail-bound) (match (tc-expr/t tail)
                                            [(ListDots: tail-ty tail-bound)
                                             (values tail-ty tail-bound)]
@@ -138,11 +145,13 @@
          (define (finish substitution) (do-ret (subst-all substitution (car rngs*))))
          (cond [(null? doms*)
                 (match f-ty 
-                  [(tc-result1: (PolyDots-names: _ (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ..1))))
-                   (tc-error/expr #:return (ret (Un))
-                                 (string-append 
-                                  "Bad arguments to polymorphic function in apply:\n"
-                                  (domain-mismatches f-ty doms rests drests rngs arg-tys tail-ty tail-bound)))])]
+                  [(tc-result1: (and t (PolyDots-names: _ (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ..1)))))
+                   (domain-mismatches f args t doms rests drests rngs arg-tres tail-ty tail-bound
+                                      #:return (ret (Un))
+                                      #:msg-thunk (lambda (dom)
+                                                    (string-append 
+                                                     "Bad arguments to polymorphic function in apply:\n"
+                                                     dom)))])]
                ;; the actual work, when we have a * function and a list final argument
                [(and (car rests*)
                      (not tail-bound)
diff --git a/collects/typed-scheme/typecheck/tc-funapp.rkt b/collects/typed-scheme/typecheck/tc-funapp.rkt
index 7531f8aa..48e5363e 100644
--- a/collects/typed-scheme/typecheck/tc-funapp.rkt
+++ b/collects/typed-scheme/typecheck/tc-funapp.rkt
@@ -3,9 +3,8 @@
 (require (rename-in "../utils/utils.rkt" [infer r:infer])
          "signatures.rkt" "tc-metafunctions.rkt"
          "tc-app-helper.rkt" "find-annotation.rkt"
-         "tc-subst.rkt" "check-below.rkt"
          (prefix-in c: racket/contract)
-         syntax/parse racket/match racket/list unstable/sequence
+         syntax/parse racket/match racket/list
          ;; fixme - don't need to be bound in this phase - only to make syntax/parse happy
          racket/bool racket/unsafe/ops
          (only-in racket/private/class-internal make-object do-make-object)
@@ -16,7 +15,7 @@
          (types utils abbrev union subtype resolve convenience type-table substitute)
          (utils tc-utils)
          (except-in (env type-env-structs tvar-env index-env) extend)
-         (rep type-rep filter-rep object-rep rep-utils)
+         (rep type-rep filter-rep rep-utils)
          (r:infer infer)
          '#%paramz
          (for-template
@@ -37,7 +36,7 @@
                (let ([substitution (infer vars ... a)])
                  (and substitution
                       (tc/funapp1 f-stx args-stx (subst-all substitution a) argtys expected #:check #f))))
-             (poly-fail t argtys #:name (and (identifier? f-stx) f-stx) #:expected expected))))]))
+             (poly-fail f-stx args-stx t argtys #:name (and (identifier? f-stx) f-stx) #:expected expected))))]))
 
 (d/c (tc/funapp f-stx args-stx ftype0 argtys expected)
   (syntax? syntax? tc-results? (c:listof tc-results?) (c:or/c #f tc-results?) . c:-> . tc-results?)
@@ -55,10 +54,11 @@
         ;; we call the separate function so that we get the appropriate filters/objects
         (tc/funapp1 f-stx args-stx a argtys expected #:check #f))
       ;; if nothing matched, error
-      (tc-error/expr 
-       #:return (or expected (ret (Un)))
-       (string-append "No function domains matched in function application:\n"
-                      (domain-mismatches t doms rests drests rngs argtys-t #f #f #:expected expected))))]
+      (domain-mismatches f-stx args-stx t doms rests drests rngs argtys #f #f
+                         #:expected expected #:return (or expected (ret (Un)))
+                         #:msg-thunk (lambda (dom)
+                                       (string-append "No function domains matched in function application:\n"
+                                                      dom))))]
     ;; any kind of dotted polymorphic function without mandatory keyword args
     [((tc-result1: (and t (PolyDots: 
                            (and vars (list fixed-vars ... dotted-var))
@@ -127,41 +127,3 @@
     [((tc-result1: f-ty) _) 
      (tc-error/expr #:return (ret (Un))
                     "Cannot apply expression of type ~a, since it is not a function type" f-ty)]))
-
-
-;; syntax? syntax? arr? (listof tc-results?) (or/c #f tc-results) [boolean?] -> tc-results?
-(d/c (tc/funapp1 f-stx args-stx ftype0 argtys expected #:check [check? #t])
-  ((syntax? syntax? arr? (c:listof tc-results?) (c:or/c #f tc-results?)) (#:check boolean?) . c:->* . tc-results?)
-  (match* (ftype0 argtys)
-    ;; we check that all kw args are optional
-    [((arr: dom (Values: (and results (list (Result: t-r f-r o-r) ...))) rest #f (and kws (list (Keyword: _ _ #f) ...)))
-      (list (tc-result1: t-a phi-a o-a) ...))
-     (when check?
-       (cond [(and (not rest) (not (= (length dom) (length t-a))))
-              (tc-error/expr #:return (ret t-r)
-                             "Wrong number of arguments, expected ~a and got ~a" (length dom) (length t-a))]
-             [(and rest (< (length t-a) (length dom)))
-              (tc-error/expr #:return (ret t-r)
-                             "Wrong number of arguments, expected at least ~a and got ~a" (length dom) (length t-a))])
-       (for ([dom-t (if rest (in-sequence-forever dom rest) (in-list dom))] 
-             [a (in-list (syntax->list args-stx))]
-             [arg-t (in-list t-a)])
-         (parameterize ([current-orig-stx a]) (check-below arg-t dom-t))))
-     (let* ([dom-count (length dom)]
-            [arg-count (+ dom-count (if rest 1 0) (length kws))])
-       (let-values
-           ([(o-a t-a) (for/lists (os ts)
-                         ([nm (in-range arg-count)]
-                          [oa (in-sequence-forever (in-list o-a) (make-Empty))]
-                          [ta (in-sequence-forever (in-list t-a) (Un))])
-                         (values (if (>= nm dom-count) (make-Empty) oa)
-                                 ta))])
-         (define-values (t-r f-r o-r)
-           (for/lists (t-r f-r o-r) 
-             ([r (in-list results)])
-             (open-Result r o-a t-a)))
-         (ret t-r f-r o-r)))]
-    [((arr: _ _ _ drest '()) _)
-     (int-err "funapp with drest args ~a ~a NYI" drest argtys)]
-    [((arr: _ _ _ _ kws) _)
-     (int-err "funapp with keyword args ~a NYI" kws)]))

From 428e96980b52b72c8f71ecb964e9ed6a13733714 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 8 Oct 2010 16:32:10 -0400
Subject: [PATCH 161/198] Added optimization for first, second and co when
 possible.

original commit: 2c4d6fbb015e7433fbd8aec68867134988f367bf
---
 collects/typed-scheme/optimizer/pair.rkt | 12 +++++++++++-
 1 file changed, 11 insertions(+), 1 deletion(-)

diff --git a/collects/typed-scheme/optimizer/pair.rkt b/collects/typed-scheme/optimizer/pair.rkt
index 948eb5f1..59ce9be2 100644
--- a/collects/typed-scheme/optimizer/pair.rkt
+++ b/collects/typed-scheme/optimizer/pair.rkt
@@ -110,7 +110,17 @@
  (cddaar #'cdr #'cdr #'car #'car)
  (cddadr #'cdr #'cdr #'car #'cdr)
  (cdddar #'cdr #'cdr #'cdr #'car)
- (cddddr #'cdr #'cdr #'cdr #'cdr))
+ (cddddr #'cdr #'cdr #'cdr #'cdr)
+ (first   #'car)
+ (second  #'car #'cdr)
+ (third   #'car #'cdr #'cdr)
+ (fourth  #'car #'cdr #'cdr #'cdr)
+ (fifth   #'car #'cdr #'cdr #'cdr #'cdr)
+ (sixth   #'car #'cdr #'cdr #'cdr #'cdr #'cdr)
+ (seventh #'car #'cdr #'cdr #'cdr #'cdr #'cdr #'cdr)
+ (eighth  #'car #'cdr #'cdr #'cdr #'cdr #'cdr #'cdr #'cdr)
+ (ninth   #'car #'cdr #'cdr #'cdr #'cdr #'cdr #'cdr #'cdr #'cdr)
+ (tenth   #'car #'cdr #'cdr #'cdr #'cdr #'cdr #'cdr #'cdr #'cdr #'cdr))
 
 (define-syntax-class pair-derived-opt-expr
   #:commit

From d60793d2713d90ef712e5d83e092c92e4632dd56 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 12 Oct 2010 15:56:00 -0400
Subject: [PATCH 162/198] Changed the interface for running single optimizer
 tests.

original commit: f3ae9c73b0f58d2d56e2ee3cee605c58a9bb3a1d
---
 collects/tests/typed-scheme/optimizer/run.rkt | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/tests/typed-scheme/optimizer/run.rkt b/collects/tests/typed-scheme/optimizer/run.rkt
index 87787175..9dfe94d0 100644
--- a/collects/tests/typed-scheme/optimizer/run.rkt
+++ b/collects/tests/typed-scheme/optimizer/run.rkt
@@ -84,7 +84,7 @@
 
 (let ((n-failures
        (if to-run
-           (if (test (format "tests/~a.rkt" to-run)) 0 1)
+           (if (test to-run) 0 1)
            (for/fold ((n-failures 0))
              ((gen (in-directory tests-dir)))
              (+ n-failures (if (test gen) 0 1))))))

From 92b3f9af03dc113d97e8ad94987b1582ed155aa3 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 11 Oct 2010 13:02:32 -0400
Subject: [PATCH 163/198] Changed the TR numeric tower to use the new flonums.

original commit: a59a99c42dffec38be98f3c0449097c80bad40fe
---
 ...{inexact-complex.rkt => float-complex.rkt} |  0
 .../typed-scheme/private/base-env-numeric.rkt | 43 +++++++++++++------
 collects/typed-scheme/private/base-types.rkt  |  6 ++-
 .../scribblings/optimization.scrbl            | 15 ++++---
 .../scribblings/ts-reference.scrbl            |  7 ++-
 .../typed-scheme/typecheck/tc-expr-unit.rkt   |  8 ++--
 collects/typed-scheme/types/abbrev.rkt        | 15 ++++---
 collects/typed-scheme/types/subtype.rkt       | 11 +++--
 8 files changed, 70 insertions(+), 35 deletions(-)
 rename collects/typed-scheme/optimizer/{inexact-complex.rkt => float-complex.rkt} (100%)

diff --git a/collects/typed-scheme/optimizer/inexact-complex.rkt b/collects/typed-scheme/optimizer/float-complex.rkt
similarity index 100%
rename from collects/typed-scheme/optimizer/inexact-complex.rkt
rename to collects/typed-scheme/optimizer/float-complex.rkt
diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt
index 04806992..d40cccca 100644
--- a/collects/typed-scheme/private/base-env-numeric.rkt
+++ b/collects/typed-scheme/private/base-env-numeric.rkt
@@ -5,7 +5,7 @@
    (for-template racket/flonum racket/fixnum racket/math racket/unsafe/ops racket/base)
    (only-in (types abbrev) [-Number N] [-Boolean B] [-Symbol Sym] [-Real R] [-ExactPositiveInteger -Pos]))
   
-  (define all-num-types (list -Pos -Nat -Integer -ExactRational -Flonum -Real N))
+  (define all-num-types (list -Pos -Nat -Integer -ExactRational -Flonum -InexactReal -Real N))
 
   (define binop 
     (lambda (t [r t])
@@ -19,6 +19,7 @@
            (-> -ExactRational -Integer)
            (-> -NonnegativeFlonum -NonnegativeFlonum)
            (-> -Flonum -Flonum)
+           (-> -InexactReal -InexactReal)
            (-> -Real -Real)))
   
   (define (unop t) (-> t t))
@@ -137,11 +138,12 @@
                                  (-not-filter -Integer 0)))]
 [exact-integer? (make-pred-ty -Integer)]
 [real? (make-pred-ty -Real)]
-[inexact-real? (make-pred-ty -Flonum)]
+[flonum? (make-pred-ty -Flonum)]
+[inexact-real? (make-pred-ty -InexactReal)]
 [complex? (make-pred-ty N)]
 [rational? (make-pred-ty -Real)]
 [exact? (asym-pred N B (-FS -top (-not-filter -ExactRational 0)))]
-[inexact? (asym-pred N B  (-FS -top (-not-filter (Un -Flonum -InexactComplex) 0)))]
+[inexact? (asym-pred N B  (-FS -top (-not-filter (Un -InexactReal -InexactComplex) 0)))]
 [fixnum? (make-pred-ty -Fixnum)]
 [positive? (cl->* (-> -Fixnum B : (-FS (-filter -PositiveFixnum 0) -top))
                   (-> -Integer B : (-FS (-filter -ExactPositiveInteger 0) -top))
@@ -228,6 +230,9 @@
           (append (for/list ([t (list -Pos -Nat -Integer -ExactRational -NonnegativeFlonum -Flonum)]) (->* (list) t t))
                   (list (->* (list) (Un -Pos -NonnegativeFlonum) -NonnegativeFlonum))
                   (list (->* (list) (Un -Pos -Flonum) -Flonum))
+                  (list (->* (list -Flonum) (Un -InexactReal -Flonum) -Flonum))
+                  (list (->* (list -InexactReal -Flonum) (Un -InexactReal -Flonum) -Flonum))
+                  (list (->* (list) -InexactReal -InexactReal))
                   (list (->* (list) -Real -Real))
                   (list (->* (list) (Un -InexactComplex -Flonum) -InexactComplex))
                   (list (->* (list) N N))))]
@@ -240,6 +245,7 @@
                   (list (->* (list) (Un -Nat -NonnegativeFlonum) -NonnegativeFlonum))
                   (list (->* (list -Flonum) -Real -Flonum))
                   (list (->* (list -Real -Flonum) -Real -Flonum))
+                  (list (->* (list) -InexactReal -InexactReal))
                   (list (->* (list) -Real -Real))
                   (list (->* (list) (Un -Real -InexactComplex) -InexactComplex))
                   (list (->* (list -InexactComplex) N -InexactComplex))
@@ -251,6 +257,7 @@
                             (->* (list t) t t))
                   (list (->* (list -Flonum) -Real -Flonum))
                   (list (->* (list -Real -Flonum) -Real -Flonum))
+                  (list (->* (list -InexactReal) -InexactReal -InexactReal))
                   (list (->* (list -Real) -Real -Real))
                   (list (->* (list) (Un -Real -InexactComplex) -InexactComplex))
                   (list (->* (list -InexactComplex) N -InexactComplex))
@@ -262,6 +269,8 @@
                             (->* (list t) t t))
                   ;; only exact 0 as first argument can cause the result of a division involving inexacts to be exact
                   (list (->* (list -Flonum) -Real -Flonum))
+                  (list (->* (list -InexactReal -Flonum) -InexactReal -Flonum))
+                  (list (->* (list -InexactReal) -InexactReal -InexactReal))
                   (list (->* (list -Real) -Real -Real))
                   (list (->* (list (Un -Flonum -InexactComplex)) (Un -Real -InexactComplex) -InexactComplex))
                   (list (->* (list -InexactComplex) -InexactComplex -InexactComplex))
@@ -277,6 +286,7 @@
             (->* (list -ExactRational) -ExactRational -ExactRational)
             (->* (list -NonnegativeFlonum) -Flonum -NonnegativeFlonum)
             (->* (list -Flonum) -Flonum -Flonum)
+            (->* (list -InexactReal) -InexactReal -InexactReal)
             (->* (list -Real) -Real -Real))]
 [min (cl->* (->* (list -PositiveFixnum) -PositiveFixnum -PositiveFixnum)
             (->* (list -NonnegativeFixnum) -NonnegativeFixnum -NonnegativeFixnum)
@@ -289,6 +299,7 @@
             (->* (list -ExactRational) -ExactRational -ExactRational)
             (->* (list -NonnegativeFlonum) -NonnegativeFlonum -NonnegativeFlonum)
             (->* (list -Flonum) -Flonum -Flonum)
+            (->* (list -InexactReal) -InexactReal -InexactReal)
             (->* (list -Real) -Real -Real))]
 
 
@@ -298,6 +309,7 @@
              (-> -ExactRational -ExactRational)
              (-> -NonnegativeFlonum -NonnegativeFlonum)
              (-> -Flonum -Flonum)
+             (-> -InexactReal -InexactReal)
              (-> -Real -Real)
              (-> -InexactComplex -InexactComplex)
              (-> N N))]
@@ -306,6 +318,7 @@
              (-> -Integer -Integer)
              (-> -ExactRational -ExactRational)
              (-> -Flonum -Flonum)
+             (-> -InexactReal -InexactReal)
              (-> -Real -Real)
              (-> -InexactComplex -InexactComplex)
              (-> N N))]
@@ -353,10 +366,13 @@
             (-Pos . -> . -Pos)
             (-Integer . -> . -Nat)
             (-Flonum . -> . -NonnegativeFlonum)
+            (-InexactReal . -> . -InexactReal)
             (-Real . -> . -Real))]
 
 ;; exactness
-[exact->inexact (cl->* 
+[exact->inexact (cl->*
+                 (-Flonum . -> . -Flonum)           ; no conversion
+                 (-InexactReal . -> . -InexactReal) ; no conversion
                  (-Real . -> . -Flonum)
                  (N . -> . -InexactComplex))]
 [inexact->exact (cl->*
@@ -384,8 +400,9 @@
 [denominator (cl->* (-ExactRational . -> . -Integer)
                     (-Real . -> . -Real))]
 [rationalize (cl->* (-ExactRational -ExactRational . -> . -ExactRational)
-                    (-Flonum . -> . -Flonum)
-                    (-Real -Real . -> . N))]
+                    (-Flonum -Flonum . -> . -Flonum)
+                    (-InexactReal -InexactReal . -> . -InexactReal)
+                    (-Real -Real . -> . -Real))]
 [expt (cl->* (-Nat -Nat . -> . -Nat)
              (-Integer -Nat . -> . -Integer)
              (-Integer -Integer . -> . -ExactRational)
@@ -402,15 +419,16 @@
       (-InexactComplex . -> . -InexactComplex)
       (N . -> . N))]
 [exp  (cl->* (-Flonum . -> . -Flonum)
+             (-InexactReal . -> . -InexactReal)
              (-Real . -> . -Real)
              (-InexactComplex . -> . -InexactComplex)
              (N . -> . N))]
-[cos  (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N))]
-[sin  (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N))]
-[tan  (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N))]
-[acos (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N))]
-[asin (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N))]
-[atan (cl->* (-Flonum . -> . -Flonum) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N) (-Real -Real . -> . N))]
+[cos  (cl->* (-Flonum . -> . -Flonum) (-InexactReal . -> . -InexactReal) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N))]
+[sin  (cl->* (-Flonum . -> . -Flonum) (-InexactReal . -> . -InexactReal) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N))]
+[tan  (cl->* (-Flonum . -> . -Flonum) (-InexactReal . -> . -InexactReal) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N))]
+[acos (cl->* (-Flonum . -> . -Flonum) (-InexactReal . -> . -InexactReal) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N))]
+[asin (cl->* (-Flonum . -> . -Flonum) (-InexactReal . -> . -InexactReal) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N))]
+[atan (cl->* (-Flonum . -> . -Flonum) (-InexactReal . -> . -InexactReal) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N) (-Real -Real . -> . N))]
 [gcd  (cl->* (null -Fixnum . ->* . -Fixnum) (null -Integer . ->* . -Integer))]
 [lcm  (null -Integer . ->* . -Integer)]
 
@@ -422,6 +440,7 @@
             (-> -Integer -Nat)
             (-> -ExactRational -ExactRational)
             (-> -Flonum -NonnegativeFlonum)
+            (-> -InexactReal -InexactReal)
             (-> -Real -Real)
             (-> -InexactComplex -InexactComplex)
             (-> N N))]
diff --git a/collects/typed-scheme/private/base-types.rkt b/collects/typed-scheme/private/base-types.rkt
index 8249e11b..c2967cfb 100644
--- a/collects/typed-scheme/private/base-types.rkt
+++ b/collects/typed-scheme/private/base-types.rkt
@@ -6,8 +6,10 @@
 [Integer -Integer]
 [Real -Real]
 [Exact-Rational -ExactRational]
-[Float -Flonum]
-[Nonnegative-Float -NonnegativeFlonum]
+[Float -Flonum] ;; these 2 are the default, 64-bit floats, can be optimized
+[Nonnegative-Float -NonnegativeFlonum] ;; associated test is: flonum? 
+[Inexact-Real -InexactReal] ;; any inexact real. could be 32- or 64-bit float
+                            ;; associated test is: inexact-real?
 [Exact-Positive-Integer -ExactPositiveInteger]
 [Exact-Nonnegative-Integer -ExactNonnegativeInteger]
 [Positive-Fixnum -PositiveFixnum]
diff --git a/collects/typed-scheme/scribblings/optimization.scrbl b/collects/typed-scheme/scribblings/optimization.scrbl
index f782c5c2..ac4f18ca 100644
--- a/collects/typed-scheme/scribblings/optimization.scrbl
+++ b/collects/typed-scheme/scribblings/optimization.scrbl
@@ -39,18 +39,17 @@ For example, the following programs both typecheck:
              (f 3.5)]
 
 However, the second one uses more informative types: the
-@racket[Float] type includes only
-@tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key
-"inexact numbers"]{inexact}
-@tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{real numbers}
+@racket[Float] type includes only 64-bit floating-point numbers
 whereas the
 @racket[Real] type includes both exact and
 @tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key
 "inexact numbers"]{inexact}
-@tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{real numbers}.
+@tech[#:doc '(lib "scribblings/reference/reference.scrbl")]{real numbers}
+and the @racket[Inexact-Real] type includes both 32- and 64-bit
+floating-point numbers.
 Typed Racket's optimizer can optimize the latter program to use
 @tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key
-"inexact numbers"]{inexact}
+"inexact numbers"]{float}
 -specific operations whereas it cannot do anything with the
 former program.
 
@@ -65,7 +64,9 @@ instance, the result of @racket[(* 2.0 0)] is @racket[0] which is not
 a @racket[Float]. This can result in missed optimizations. To prevent
 this, when mixing floating-point numbers and exact reals, coerce exact
 reals to floating-point numbers using @racket[exact->inexact]. This is
-not necessary when using @racket[+] or @racket[-].
+not necessary when using @racket[+] or @racket[-]. When mixing
+floating-point numbers of different precisions, results use the
+highest precision possible.
 
 On a similar note, the @racket[Inexact-Complex] type is preferable to
 the @racket[Complex] type for the same reason. Typed Racket can keep
diff --git a/collects/typed-scheme/scribblings/ts-reference.scrbl b/collects/typed-scheme/scribblings/ts-reference.scrbl
index 7ee92091..d43e2773 100644
--- a/collects/typed-scheme/scribblings/ts-reference.scrbl
+++ b/collects/typed-scheme/scribblings/ts-reference.scrbl
@@ -39,6 +39,7 @@ any expression of this type will not evaluate to a value.}
 @defidform[Real]
 @defidform[Float]
 @defidform[Nonnegative-Float]
+@defidform[Inexact-Real]
 @defidform[Exact-Rational]
 @defidform[Integer]
 @defidform[Natural]
@@ -50,7 +51,11 @@ any expression of this type will not evaluate to a value.}
 @defidform[Zero]
 )]{These types represent the hierarchy of @rtech{numbers} of Racket.
 @racket[Integer] includes only @rtech{integers} that are @rtech{exact
-numbers}, corresponding to the predicate @racket[exact-integer?]. 
+numbers}, corresponding to the predicate @racket[exact-integer?].
+@racket{Real} includes both exact and inexact reals.
+An @racket{Inexact-Real} can be either 32- or 64-bit floating-point
+numbers. @racket{Float} is restricted to 64-bit floats, which are the
+default in Racket.
 
 @ex[
 7
diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.rkt b/collects/typed-scheme/typecheck/tc-expr-unit.rkt
index 6934dd2d..2bd1285d 100644
--- a/collects/typed-scheme/typecheck/tc-expr-unit.rkt
+++ b/collects/typed-scheme/typecheck/tc-expr-unit.rkt
@@ -41,15 +41,15 @@
     [(~var i (3d exact-nonnegative-integer?)) -ExactNonnegativeInteger]
     [(~var i (3d exact-integer?)) -Integer]
     [(~var i (3d (conjoin number? exact? rational?))) -ExactRational]
-    [(~var i (3d (conjoin inexact-real?
+    [(~var i (3d (conjoin flonum?
                           (lambda (x) (or (positive? x) (zero? x)))
                           (lambda (x) (not (eq? x -0.0))))))
      -NonnegativeFlonum]
-    [(~var i (3d inexact-real?)) -Flonum]
+    [(~var i (3d flonum?)) -Flonum]
     [(~var i (3d real?)) -Real]
     ;; a complex number can't have an inexact imaginary part and an exact real part
-    [(~var i (3d (conjoin number? (lambda (x) (and (inexact-real? (imag-part x))
-                                                   (inexact-real? (real-part x)))))))
+    [(~var i (3d (conjoin number? (lambda (x) (and (flonum? (imag-part x))
+                                                   (flonum? (real-part x)))))))
      -InexactComplex]
     [(~var i (3d number?)) -Number]
     [i:str -String]
diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt
index 3255022f..6603b592 100644
--- a/collects/typed-scheme/types/abbrev.rkt
+++ b/collects/typed-scheme/types/abbrev.rkt
@@ -153,17 +153,20 @@
 ;; Numeric hierarchy
 (define -Number (make-Base 'Number #'number?))
 
-(define -InexactComplex (make-Base 'InexactComplex
+(define -InexactComplex (make-Base 'Inexact-Complex
                                    #'(and/c number?
                                             (lambda (x)
-                                              (and (inexact-real? (imag-part x))
-                                                   (inexact-real? (real-part x)))))))
+                                              (and (flonum? (imag-part x))
+                                                   (flonum? (real-part x)))))))
 
-(define -Flonum (make-Base 'Flonum #'inexact-real?))
+;; default 64-bit floats
+(define -Flonum (make-Base 'Flonum #'flonum?))
 (define -NonnegativeFlonum (make-Base 'Nonnegative-Flonum
-                                      #'(and/c inexact-real?
+                                      #'(and/c flonum?
                                                (or/c positive? zero?)
                                                (lambda (x) (not (eq? x -0.0))))))
+;; could be 32- or 64-bit floats
+(define -InexactReal (make-Base 'Inexact-Real #'inexact-real?))
 
 (define -ExactRational 
   (make-Base 'Exact-Rational #'(and/c number? rational? exact?)))
@@ -177,7 +180,7 @@
   (make-Base 'Negative-Fixnum #'(and/c number? fixnum? negative?)))
 
 (define -Zero (-val 0))
-(define -Real (*Un -Flonum -ExactRational))
+(define -Real (*Un -InexactReal -ExactRational))
 (define -Fixnum (*Un -PositiveFixnum -NegativeFixnum -Zero))
 (define -NonnegativeFixnum (*Un -PositiveFixnum -Zero))
 (define -ExactNonnegativeInteger (*Un -ExactPositiveInteger -Zero))
diff --git a/collects/typed-scheme/types/subtype.rkt b/collects/typed-scheme/types/subtype.rkt
index 33f0a82e..16918d20 100644
--- a/collects/typed-scheme/types/subtype.rkt
+++ b/collects/typed-scheme/types/subtype.rkt
@@ -233,9 +233,10 @@
 	      ;; value types              
 	      [((Value: v1) (Value: v2)) (=> unmatch) (if (equal? v1 v2) A0 (unmatch))]
 	      ;; now we encode the numeric hierarchy - bletch
+              [((Base: 'Integer _) (== -Real =t)) A0]
 	      [((Base: 'Integer _) (Base: 'Number _)) A0]
+              [((Base: 'Flonum _)  (Base: 'Inexact-Real _)) A0]
 	      [((Base: 'Flonum _)  (== -Real =t)) A0]
-	      [((Base: 'Integer _)  (== -Real =t)) A0]
 	      [((Base: 'Flonum _)  (Base: 'Number _)) A0]
 	      [((Base: 'Exact-Rational _) (Base: 'Number _)) A0]
 	      [((Base: 'Integer _) (Base: 'Exact-Rational _)) A0]
@@ -263,9 +264,13 @@
 	      [((== -Fixnum =t) (Base: 'Integer _)) A0]
 
               [((Base: 'Nonnegative-Flonum _) (Base: 'Flonum _)) A0]
+              [((Base: 'Nonnegative-Flonum _) (Base: 'Inexact-Real _)) A0]
               [((Base: 'Nonnegative-Flonum _) (Base: 'Number _)) A0]
 
-              [((Base: 'InexactComplex _) (Base: 'Number _)) A0]
+              [((Base: 'Inexact-Real _) (== -Real =t)) A0]
+              [((Base: 'Inexact-Real _) (Base: 'Number _)) A0]
+
+              [((Base: 'Inexact-Complex _) (Base: 'Number _)) A0]
 
               
               ;; values are subtypes of their "type"
@@ -273,7 +278,7 @@
 	      [((Value: (and n (? number?) (? exact?) (? rational?))) (Base: 'Exact-Rational _)) A0]
 	      [((Value: (? exact-nonnegative-integer? n)) (== -Nat =t)) A0]
 	      [((Value: (? exact-positive-integer? n)) (Base: 'Exact-Positive-Integer _)) A0]	      
-	      [((Value: (? inexact-real? n)) (Base: 'Flonum _)) A0]
+	      [((Value: (? flonum? n)) (Base: 'Flonum _)) A0]
 	      [((Value: (? real? n)) (== -Real =t)) A0]
 	      [((Value: (? number? n)) (Base: 'Number _)) A0]
 

From c547da857ed46c11bdb35474ef02cea37d4daa60 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 11 Oct 2010 18:19:15 -0400
Subject: [PATCH 164/198] Added the Float-Complex type for consistency with the
 new float types.

Inexact-Complex has been kept as a synonym for backward compatibility.

original commit: 52bd739d00491d2a78b62c6d6e89fb5eaf6ae046
---
 collects/typed-scheme/private/base-types.rkt         | 3 ++-
 collects/typed-scheme/scribblings/optimization.scrbl | 6 +++---
 collects/typed-scheme/scribblings/ts-reference.scrbl | 2 +-
 3 files changed, 6 insertions(+), 5 deletions(-)

diff --git a/collects/typed-scheme/private/base-types.rkt b/collects/typed-scheme/private/base-types.rkt
index c2967cfb..f7818966 100644
--- a/collects/typed-scheme/private/base-types.rkt
+++ b/collects/typed-scheme/private/base-types.rkt
@@ -1,7 +1,8 @@
 #lang s-exp "type-env-lang.rkt"
 
 [Complex -Number]
-[Inexact-Complex -InexactComplex]
+[Float-Complex -InexactComplex] ; for consistency with float vs inexact-real
+[Inexact-Complex -InexactComplex] ; for backward compatiblity
 [Number -Number]
 [Integer -Integer]
 [Real -Real]
diff --git a/collects/typed-scheme/scribblings/optimization.scrbl b/collects/typed-scheme/scribblings/optimization.scrbl
index ac4f18ca..dbe65aa7 100644
--- a/collects/typed-scheme/scribblings/optimization.scrbl
+++ b/collects/typed-scheme/scribblings/optimization.scrbl
@@ -68,7 +68,7 @@ not necessary when using @racket[+] or @racket[-]. When mixing
 floating-point numbers of different precisions, results use the
 highest precision possible.
 
-On a similar note, the @racket[Inexact-Complex] type is preferable to
+On a similar note, the @racket[Float-Complex] type is preferable to
 the @racket[Complex] type for the same reason. Typed Racket can keep
 @tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key
 "inexact numbers"]{inexact}
@@ -93,8 +93,8 @@ present and
 @tech[#:doc '(lib "scribblings/reference/reference.scrbl") #:key
 "inexact numbers"]{inexact}
 for the literal to be of type
-@racket[Inexact-Complex]; @racket[0.0+1.0i] is of type
-@racket[Inexact-Complex] but @racket[+1.0i] is not.
+@racket[Float-Complex]; @racket[0.0+1.0i] is of type
+@racket[Float-Complex] but @racket[+1.0i] is not.
 To get the most of
 Typed Racket's optimizer, you should also favor rectangular
 coordinates over polar coordinates.
diff --git a/collects/typed-scheme/scribblings/ts-reference.scrbl b/collects/typed-scheme/scribblings/ts-reference.scrbl
index d43e2773..0e711b09 100644
--- a/collects/typed-scheme/scribblings/ts-reference.scrbl
+++ b/collects/typed-scheme/scribblings/ts-reference.scrbl
@@ -35,7 +35,7 @@ any expression of this type will not evaluate to a value.}
 @deftogether[(
 @defidform[Number]
 @defidform[Complex]
-@defidform[Inexact-Complex]
+@defidform[Float-Complex]
 @defidform[Real]
 @defidform[Float]
 @defidform[Nonnegative-Float]

From 1a4e176824db29051ab9d936433587e7838c220e Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Tue, 12 Oct 2010 16:12:34 -0400
Subject: [PATCH 165/198] Inexact-Complex -> Float-Complex

original commit: 27e722f27b673cbfcee60aaba75dfdcab7e396c5
---
 .../tests/float-complex-conjugate-top.rkt     |  14 ++
 .../tests/float-complex-conjugate.rkt         |  15 +++
 .../optimizer/tests/float-complex-div.rkt     |  14 ++
 .../optimizer/tests/float-complex-fixnum.rkt  |  16 +++
 .../tests/float-complex-float-div.rkt         |  56 ++++++++
 .../tests/float-complex-float-mul.rkt         |  47 +++++++
 .../tests/float-complex-float-small.rkt       |  40 ++++++
 .../optimizer/tests/float-complex-float.rkt   |  35 +++++
 .../optimizer/tests/float-complex-i.rkt       |  15 +++
 .../optimizer/tests/float-complex-integer.rkt |  13 ++
 .../optimizer/tests/float-complex-mult.rkt    |  14 ++
 .../optimizer/tests/float-complex-parts.rkt   |  19 +++
 .../optimizer/tests/float-complex-parts2.rkt  |  49 +++++++
 .../optimizer/tests/float-complex-parts3.rkt  |  45 +++++++
 .../optimizer/tests/float-complex-sin.rkt     |  15 +++
 .../optimizer/tests/float-complex.rkt         |  19 +++
 .../optimizer/tests/invalid-unboxed-let.rkt   |  34 ++---
 .../optimizer/tests/invalid-unboxed-let2.rkt  |  16 +--
 .../optimizer/tests/magnitude.rkt             |   4 +-
 .../optimizer/tests/make-polar.rkt            |  12 +-
 .../optimizer/tests/maybe-exact-complex.rkt   |   4 +-
 .../optimizer/tests/n-ary-float-complex.rkt   |  15 +++
 .../optimizer/tests/nested-float-complex.rkt  |  15 +++
 .../optimizer/tests/nested-let-loop.rkt       |  22 ++--
 .../optimizer/tests/nested-unboxed-let.rkt    |  20 +--
 .../optimizer/tests/real-part-loop.rkt        |  10 +-
 .../optimizer/tests/sqrt-segfault.rkt         |  12 +-
 .../optimizer/tests/unboxed-for.rkt           |  38 +++---
 .../tests/unboxed-let-functions1.rkt          |  12 +-
 .../tests/unboxed-let-functions2.rkt          |  22 ++--
 .../tests/unboxed-let-functions3.rkt          |  12 +-
 .../tests/unboxed-let-functions4.rkt          |  12 +-
 .../tests/unboxed-let-functions5.rkt          |   4 +-
 .../tests/unboxed-let-functions6.rkt          |  12 +-
 .../tests/unboxed-let-functions7.rkt          |   8 +-
 .../tests/unboxed-let-functions8.rkt          |   6 +-
 .../optimizer/tests/unboxed-let.rkt           |  28 ++--
 .../optimizer/tests/unboxed-let2.rkt          |  24 ++--
 .../optimizer/tests/unboxed-let3.rkt          |  12 +-
 .../tests/unboxed-letrec-syntaxes+values.rkt  |  12 +-
 .../optimizer/tests/unboxed-letrec.rkt        |  22 ++--
 .../tests/unboxed-make-rectangular.rkt        |  20 +--
 .../unit-tests/typecheck-tests.rkt            |   6 +-
 .../typed-scheme/optimizer/float-complex.rkt  | 124 +++++++++---------
 collects/typed-scheme/optimizer/float.rkt     |   2 +-
 collects/typed-scheme/optimizer/optimizer.rkt |   4 +-
 .../typed-scheme/optimizer/unboxed-let.rkt    |  20 +--
 .../typed-scheme/private/base-env-numeric.rkt |  80 +++++------
 collects/typed-scheme/private/base-types.rkt  |   4 +-
 .../typed-scheme/typecheck/tc-expr-unit.rkt   |   4 +-
 collects/typed-scheme/types/abbrev.rkt        |  10 +-
 collects/typed-scheme/types/subtype.rkt       |   2 +-
 52 files changed, 773 insertions(+), 317 deletions(-)
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/float-complex-conjugate-top.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/float-complex-conjugate.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/float-complex-div.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/float-complex-fixnum.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/float-complex-float-div.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/float-complex-float-mul.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/float-complex-float-small.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/float-complex-float.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/float-complex-i.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/float-complex-integer.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/float-complex-mult.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/float-complex-parts.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/float-complex-parts2.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/float-complex-parts3.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/float-complex-sin.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/float-complex.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/n-ary-float-complex.rkt
 create mode 100644 collects/tests/typed-scheme/optimizer/tests/nested-float-complex.rkt

diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-conjugate-top.rkt b/collects/tests/typed-scheme/optimizer/tests/float-complex-conjugate-top.rkt
new file mode 100644
index 00000000..004a0a38
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/float-complex-conjugate-top.rkt
@@ -0,0 +1,14 @@
+#;
+(
+float-complex-conjugate-top.rkt line 14 col 14 - 1.0+2.0i - unboxed literal
+float-complex-conjugate-top.rkt line 14 col 23 - 2.0+4.0i - unboxed literal
+float-complex-conjugate-top.rkt line 14 col 12 - + - unboxed binary float complex
+float-complex-conjugate-top.rkt line 14 col 1 - conjugate - unboxed unary float complex
+float-complex-conjugate-top.rkt line 14 col 0 - (#%app conjugate (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i))) - unboxed float complex
+3.0-6.0i
+)
+
+#lang typed/scheme
+#:optimize
+
+(conjugate (+ 1.0+2.0i 2.0+4.0i))
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-conjugate.rkt b/collects/tests/typed-scheme/optimizer/tests/float-complex-conjugate.rkt
new file mode 100644
index 00000000..5ccabd70
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/float-complex-conjugate.rkt
@@ -0,0 +1,15 @@
+#;
+(
+float-complex-conjugate.rkt line 15 col 14 - 1.0+2.0i - unboxed literal
+float-complex-conjugate.rkt line 15 col 4 - conjugate - unboxed unary float complex
+float-complex-conjugate.rkt line 15 col 35 - 2.0+4.0i - unboxed literal
+float-complex-conjugate.rkt line 15 col 25 - conjugate - unboxed unary float complex
+float-complex-conjugate.rkt line 15 col 1 - + - unboxed binary float complex
+float-complex-conjugate.rkt line 15 col 0 - (#%app + (#%app conjugate (quote 1.0+2.0i)) (#%app conjugate (quote 2.0+4.0i))) - unboxed float complex
+3.0-6.0i
+)
+
+#lang typed/scheme
+#:optimize
+
+(+ (conjugate 1.0+2.0i) (conjugate 2.0+4.0i))
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-div.rkt b/collects/tests/typed-scheme/optimizer/tests/float-complex-div.rkt
new file mode 100644
index 00000000..d832839f
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/float-complex-div.rkt
@@ -0,0 +1,14 @@
+#;
+(
+float-complex-div.rkt line 14 col 3 - 1.0+2.0i - unboxed literal
+float-complex-div.rkt line 14 col 12 - 2.0+4.0i - unboxed literal
+float-complex-div.rkt line 14 col 21 - 3.0+6.0i - unboxed literal
+float-complex-div.rkt line 14 col 1 - / - unboxed binary float complex
+float-complex-div.rkt line 14 col 0 - (#%app / (quote 1.0+2.0i) (quote 2.0+4.0i) (quote 3.0+6.0i)) - unboxed float complex
+0.03333333333333333-0.06666666666666667i
+)
+
+#lang typed/scheme
+#:optimize
+
+(/ 1.0+2.0i 2.0+4.0i 3.0+6.0i)
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-fixnum.rkt b/collects/tests/typed-scheme/optimizer/tests/float-complex-fixnum.rkt
new file mode 100644
index 00000000..0d565583
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/float-complex-fixnum.rkt
@@ -0,0 +1,16 @@
+#;
+(
+float-complex-fixnum.rkt line 16 col 4 - modulo - binary nonzero fixnum
+float-complex-fixnum.rkt line 16 col 4 - modulo - binary nonzero fixnum
+float-complex-fixnum.rkt line 16 col 3 - (#%app modulo (quote 2) (quote 1)) - float-coerce-expr in complex ops
+float-complex-fixnum.rkt line 16 col 16 - 1.0+2.0i - unboxed literal
+float-complex-fixnum.rkt line 16 col 25 - 3.0+6.0i - unboxed literal
+float-complex-fixnum.rkt line 16 col 1 - + - unboxed binary float complex
+float-complex-fixnum.rkt line 16 col 0 - (#%app + (#%app modulo (quote 2) (quote 1)) (quote 1.0+2.0i) (quote 3.0+6.0i)) - unboxed float complex
+4.0+8.0i
+)
+
+#lang typed/scheme
+#:optimize
+
+(+ (modulo 2 1) 1.0+2.0i 3.0+6.0i)
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-float-div.rkt b/collects/tests/typed-scheme/optimizer/tests/float-complex-float-div.rkt
new file mode 100644
index 00000000..20e64f21
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/float-complex-float-div.rkt
@@ -0,0 +1,56 @@
+#;
+(
+float-complex-float-div.rkt line 47 col 62 - x - unbox float-complex
+float-complex-float-div.rkt line 47 col 52 - real-part - unboxed float complex
+float-complex-float-div.rkt line 48 col 62 - x - unbox float-complex
+float-complex-float-div.rkt line 48 col 52 - imag-part - unboxed float complex
+float-complex-float-div.rkt line 50 col 9 - (quote 1.0) - float-coerce-expr in complex ops
+float-complex-float-div.rkt line 50 col 13 - 2.0+4.0i - unboxed literal
+float-complex-float-div.rkt line 50 col 7 - / - unboxed binary float complex
+float-complex-float-div.rkt line 50 col 6 - (#%app / (quote 1.0) (quote 2.0+4.0i)) - unboxed float complex
+float-complex-float-div.rkt line 51 col 9 - 1.0+2.0i - unboxed literal
+float-complex-float-div.rkt line 51 col 18 - (quote 2.0) - float-coerce-expr in complex ops
+float-complex-float-div.rkt line 51 col 7 - / - unboxed binary float complex
+float-complex-float-div.rkt line 51 col 6 - (#%app / (quote 1.0+2.0i) (quote 2.0)) - unboxed float complex
+float-complex-float-div.rkt line 52 col 9 - (quote 1.0) - float-coerce-expr in complex ops
+float-complex-float-div.rkt line 52 col 13 - 2.0+4.0i - unboxed literal
+float-complex-float-div.rkt line 52 col 22 - 3.0+6.0i - unboxed literal
+float-complex-float-div.rkt line 52 col 7 - / - unboxed binary float complex
+float-complex-float-div.rkt line 52 col 6 - (#%app / (quote 1.0) (quote 2.0+4.0i) (quote 3.0+6.0i)) - unboxed float complex
+float-complex-float-div.rkt line 53 col 9 - 1.0+2.0i - unboxed literal
+float-complex-float-div.rkt line 53 col 18 - (quote 2.0) - float-coerce-expr in complex ops
+float-complex-float-div.rkt line 53 col 22 - 3.0+6.0i - unboxed literal
+float-complex-float-div.rkt line 53 col 7 - / - unboxed binary float complex
+float-complex-float-div.rkt line 53 col 6 - (#%app / (quote 1.0+2.0i) (quote 2.0) (quote 3.0+6.0i)) - unboxed float complex
+float-complex-float-div.rkt line 54 col 9 - 1.0+2.0i - unboxed literal
+float-complex-float-div.rkt line 54 col 18 - 2.0+4.0i - unboxed literal
+float-complex-float-div.rkt line 54 col 27 - (quote 3.0) - float-coerce-expr in complex ops
+float-complex-float-div.rkt line 54 col 7 - / - unboxed binary float complex
+float-complex-float-div.rkt line 54 col 6 - (#%app / (quote 1.0+2.0i) (quote 2.0+4.0i) (quote 3.0)) - unboxed float complex
+float-complex-float-div.rkt line 55 col 9 - 1.0+2.0i - unboxed literal
+float-complex-float-div.rkt line 55 col 18 - (quote 2.0) - float-coerce-expr in complex ops
+float-complex-float-div.rkt line 55 col 22 - (quote 3.0) - float-coerce-expr in complex ops
+float-complex-float-div.rkt line 55 col 7 - / - unboxed binary float complex
+float-complex-float-div.rkt line 55 col 6 - (#%app / (quote 1.0+2.0i) (quote 2.0) (quote 3.0)) - unboxed float complex
+float-complex-float-div.rkt line 56 col 9 - (quote 1.0) - float-coerce-expr in complex ops
+float-complex-float-div.rkt line 56 col 13 - (quote 2.0) - float-coerce-expr in complex ops
+float-complex-float-div.rkt line 56 col 17 - 3.0+6.0i - unboxed literal
+float-complex-float-div.rkt line 56 col 7 - / - unboxed binary float complex
+float-complex-float-div.rkt line 56 col 6 - (#%app / (quote 1.0) (quote 2.0) (quote 3.0+6.0i)) - unboxed float complex
+'("0.1000000000-0.2000000000" "0.50000000001.0000000000" "-0.0200000000-0.0266666667" "0.16666666670.0000000000" "0.16666666670.0000000000" "0.16666666670.3333333333" "0.0333333333-0.0666666667")
+)
+
+#lang typed/scheme
+#:optimize
+
+(map (lambda: ((x : Inexact-Complex))
+              (string-append (real->decimal-string (real-part x) 10)
+                             (real->decimal-string (imag-part x) 10)))
+     (list
+      (/ 1.0 2.0+4.0i)
+      (/ 1.0+2.0i 2.0)
+      (/ 1.0 2.0+4.0i 3.0+6.0i)
+      (/ 1.0+2.0i 2.0 3.0+6.0i)
+      (/ 1.0+2.0i 2.0+4.0i 3.0)
+      (/ 1.0+2.0i 2.0 3.0)
+      (/ 1.0 2.0 3.0+6.0i)))
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-float-mul.rkt b/collects/tests/typed-scheme/optimizer/tests/float-complex-float-mul.rkt
new file mode 100644
index 00000000..068906d9
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/float-complex-float-mul.rkt
@@ -0,0 +1,47 @@
+#;
+(
+float-complex-float-mul.rkt line 42 col 3 - (quote 1.0) - float-coerce-expr in complex ops
+float-complex-float-mul.rkt line 42 col 7 - 2.0+4.0i - unboxed literal
+float-complex-float-mul.rkt line 42 col 1 - * - unboxed binary float complex
+float-complex-float-mul.rkt line 42 col 0 - (#%app * (quote 1.0) (quote 2.0+4.0i)) - unboxed float complex
+float-complex-float-mul.rkt line 43 col 3 - 1.0+2.0i - unboxed literal
+float-complex-float-mul.rkt line 43 col 12 - (quote 2.0) - float-coerce-expr in complex ops
+float-complex-float-mul.rkt line 43 col 1 - * - unboxed binary float complex
+float-complex-float-mul.rkt line 43 col 0 - (#%app * (quote 1.0+2.0i) (quote 2.0)) - unboxed float complex
+float-complex-float-mul.rkt line 44 col 3 - (quote 1.0) - float-coerce-expr in complex ops
+float-complex-float-mul.rkt line 44 col 7 - 2.0+4.0i - unboxed literal
+float-complex-float-mul.rkt line 44 col 16 - 3.0+6.0i - unboxed literal
+float-complex-float-mul.rkt line 44 col 1 - * - unboxed binary float complex
+float-complex-float-mul.rkt line 44 col 0 - (#%app * (quote 1.0) (quote 2.0+4.0i) (quote 3.0+6.0i)) - unboxed float complex
+float-complex-float-mul.rkt line 45 col 3 - 1.0+2.0i - unboxed literal
+float-complex-float-mul.rkt line 45 col 12 - (quote 2.0) - float-coerce-expr in complex ops
+float-complex-float-mul.rkt line 45 col 16 - 3.0+6.0i - unboxed literal
+float-complex-float-mul.rkt line 45 col 1 - * - unboxed binary float complex
+float-complex-float-mul.rkt line 45 col 0 - (#%app * (quote 1.0+2.0i) (quote 2.0) (quote 3.0+6.0i)) - unboxed float complex
+float-complex-float-mul.rkt line 46 col 3 - 1.0+2.0i - unboxed literal
+float-complex-float-mul.rkt line 46 col 12 - 2.0+4.0i - unboxed literal
+float-complex-float-mul.rkt line 46 col 21 - (quote 3.0) - float-coerce-expr in complex ops
+float-complex-float-mul.rkt line 46 col 1 - * - unboxed binary float complex
+float-complex-float-mul.rkt line 46 col 0 - (#%app * (quote 1.0+2.0i) (quote 2.0+4.0i) (quote 3.0)) - unboxed float complex
+float-complex-float-mul.rkt line 47 col 3 - 1.0+2.0i - unboxed literal
+float-complex-float-mul.rkt line 47 col 12 - (quote 2.0) - float-coerce-expr in complex ops
+float-complex-float-mul.rkt line 47 col 16 - (quote 3.0) - float-coerce-expr in complex ops
+float-complex-float-mul.rkt line 47 col 1 - * - unboxed binary float complex
+float-complex-float-mul.rkt line 47 col 0 - (#%app * (quote 1.0+2.0i) (quote 2.0) (quote 3.0)) - unboxed float complex
+2.0+4.0i
+2.0+4.0i
+-18.0+24.0i
+-18.0+24.0i
+-18.0+24.0i
+6.0+12.0i
+)
+
+#lang typed/scheme
+#:optimize
+
+(* 1.0 2.0+4.0i)
+(* 1.0+2.0i 2.0)
+(* 1.0 2.0+4.0i 3.0+6.0i)
+(* 1.0+2.0i 2.0 3.0+6.0i)
+(* 1.0+2.0i 2.0+4.0i 3.0)
+(* 1.0+2.0i 2.0 3.0)
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-float-small.rkt b/collects/tests/typed-scheme/optimizer/tests/float-complex-float-small.rkt
new file mode 100644
index 00000000..b12f779c
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/float-complex-float-small.rkt
@@ -0,0 +1,40 @@
+#;
+(
+float-complex-float-small.rkt line 36 col 3 - 1.0+2.0i - unboxed literal
+float-complex-float-small.rkt line 36 col 12 - (quote 3.0) - float-coerce-expr in complex ops
+float-complex-float-small.rkt line 36 col 1 - + - unboxed binary float complex
+float-complex-float-small.rkt line 36 col 0 - (#%app + (quote 1.0+2.0i) (quote 3.0)) - unboxed float complex
+float-complex-float-small.rkt line 37 col 3 - (quote 1.0) - float-coerce-expr in complex ops
+float-complex-float-small.rkt line 37 col 7 - 2.0+4.0i - unboxed literal
+float-complex-float-small.rkt line 37 col 1 - + - unboxed binary float complex
+float-complex-float-small.rkt line 37 col 0 - (#%app + (quote 1.0) (quote 2.0+4.0i)) - unboxed float complex
+float-complex-float-small.rkt line 38 col 3 - 1.0+2.0i - unboxed literal
+float-complex-float-small.rkt line 38 col 12 - (quote 3.0) - float-coerce-expr in complex ops
+float-complex-float-small.rkt line 38 col 1 - - - unboxed binary float complex
+float-complex-float-small.rkt line 38 col 0 - (#%app - (quote 1.0+2.0i) (quote 3.0)) - unboxed float complex
+float-complex-float-small.rkt line 39 col 3 - (quote 1.0) - float-coerce-expr in complex ops
+float-complex-float-small.rkt line 39 col 7 - 2.0+4.0i - unboxed literal
+float-complex-float-small.rkt line 39 col 1 - - - unboxed binary float complex
+float-complex-float-small.rkt line 39 col 0 - (#%app - (quote 1.0) (quote 2.0+4.0i)) - unboxed float complex
+float-complex-float-small.rkt line 40 col 3 - 1.0+2.0i - unboxed literal
+float-complex-float-small.rkt line 40 col 15 - (quote 1.0) - float-coerce-expr in complex ops
+float-complex-float-small.rkt line 40 col 19 - (quote 2.0) - float-coerce-expr in complex ops
+float-complex-float-small.rkt line 40 col 13 - + - binary float
+float-complex-float-small.rkt line 40 col 12 - (#%app + (quote 1.0) (quote 2.0)) - float-coerce-expr in complex ops
+float-complex-float-small.rkt line 40 col 1 - + - unboxed binary float complex
+float-complex-float-small.rkt line 40 col 0 - (#%app + (quote 1.0+2.0i) (#%app + (quote 1.0) (quote 2.0))) - unboxed float complex
+4.0+2.0i
+3.0+4.0i
+-2.0+2.0i
+-1.0-4.0i
+4.0+2.0i
+)
+
+#lang typed/scheme
+#:optimize
+
+(+ 1.0+2.0i 3.0)
+(+ 1.0 2.0+4.0i)
+(- 1.0+2.0i 3.0)
+(- 1.0 2.0+4.0i)
+(+ 1.0+2.0i (+ 1.0 2.0))
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-float.rkt b/collects/tests/typed-scheme/optimizer/tests/float-complex-float.rkt
new file mode 100644
index 00000000..060813b5
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/float-complex-float.rkt
@@ -0,0 +1,35 @@
+#;
+(
+float-complex-float.rkt line 32 col 3 - 1.0+2.0i - unboxed literal
+float-complex-float.rkt line 32 col 12 - (quote 2.0) - float-coerce-expr in complex ops
+float-complex-float.rkt line 32 col 16 - 3.0+6.0i - unboxed literal
+float-complex-float.rkt line 32 col 1 - + - unboxed binary float complex
+float-complex-float.rkt line 32 col 0 - (#%app + (quote 1.0+2.0i) (quote 2.0) (quote 3.0+6.0i)) - unboxed float complex
+float-complex-float.rkt line 33 col 3 - (quote 1.0) - float-coerce-expr in complex ops
+float-complex-float.rkt line 33 col 7 - 2.0+4.0i - unboxed literal
+float-complex-float.rkt line 33 col 16 - 3.0+6.0i - unboxed literal
+float-complex-float.rkt line 33 col 1 - - - unboxed binary float complex
+float-complex-float.rkt line 33 col 0 - (#%app - (quote 1.0) (quote 2.0+4.0i) (quote 3.0+6.0i)) - unboxed float complex
+float-complex-float.rkt line 34 col 3 - 1.0+2.0i - unboxed literal
+float-complex-float.rkt line 34 col 12 - (quote 2.0) - float-coerce-expr in complex ops
+float-complex-float.rkt line 34 col 16 - 3.0+6.0i - unboxed literal
+float-complex-float.rkt line 34 col 1 - - - unboxed binary float complex
+float-complex-float.rkt line 34 col 0 - (#%app - (quote 1.0+2.0i) (quote 2.0) (quote 3.0+6.0i)) - unboxed float complex
+float-complex-float.rkt line 35 col 3 - 1.0+2.0i - unboxed literal
+float-complex-float.rkt line 35 col 12 - 2.0+4.0i - unboxed literal
+float-complex-float.rkt line 35 col 21 - (quote 3.0) - float-coerce-expr in complex ops
+float-complex-float.rkt line 35 col 1 - - - unboxed binary float complex
+float-complex-float.rkt line 35 col 0 - (#%app - (quote 1.0+2.0i) (quote 2.0+4.0i) (quote 3.0)) - unboxed float complex
+6.0+8.0i
+-4.0-10.0i
+-4.0-4.0i
+-4.0-2.0i
+)
+
+#lang typed/scheme
+#:optimize
+
+(+ 1.0+2.0i 2.0 3.0+6.0i)
+(- 1.0 2.0+4.0i 3.0+6.0i)
+(- 1.0+2.0i 2.0 3.0+6.0i)
+(- 1.0+2.0i 2.0+4.0i 3.0)
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-i.rkt b/collects/tests/typed-scheme/optimizer/tests/float-complex-i.rkt
new file mode 100644
index 00000000..83e394cb
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/float-complex-i.rkt
@@ -0,0 +1,15 @@
+#;
+(
+float-complex-i.rkt line 15 col 3 - 1.0+2.0i - unboxed literal
+float-complex-i.rkt line 15 col 15 - 0+1.0i - unboxed literal
+float-complex-i.rkt line 15 col 21 - 2.0+4.0i - unboxed literal
+float-complex-i.rkt line 15 col 13 - * - unboxed binary float complex
+float-complex-i.rkt line 15 col 1 - + - unboxed binary float complex
+float-complex-i.rkt line 15 col 0 - (#%app + (quote 1.0+2.0i) (#%app * (quote 0+1.0i) (quote 2.0+4.0i))) - unboxed float complex
+-3.0+4.0i
+)
+
+#lang typed/scheme
+#:optimize
+
+(+ 1.0+2.0i (* +1.0i 2.0+4.0i))
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-integer.rkt b/collects/tests/typed-scheme/optimizer/tests/float-complex-integer.rkt
new file mode 100644
index 00000000..b9033e5d
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/float-complex-integer.rkt
@@ -0,0 +1,13 @@
+#;
+(
+float-complex-integer.rkt line 13 col 3 - (#%app expt (quote 2) (quote 100)) - float-coerce-expr in complex ops
+float-complex-integer.rkt line 13 col 16 - 1.0+2.0i - unboxed literal
+float-complex-integer.rkt line 13 col 1 - + - unboxed binary float complex
+float-complex-integer.rkt line 13 col 0 - (#%app + (#%app expt (quote 2) (quote 100)) (quote 1.0+2.0i)) - unboxed float complex
+1.2676506002282294e+30+2.0i
+)
+
+#lang typed/scheme
+#:optimize
+
+(+ (expt 2 100) 1.0+2.0i)
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-mult.rkt b/collects/tests/typed-scheme/optimizer/tests/float-complex-mult.rkt
new file mode 100644
index 00000000..0ad65681
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/float-complex-mult.rkt
@@ -0,0 +1,14 @@
+#;
+(
+float-complex-mult.rkt line 14 col 3 - 1.0+2.0i - unboxed literal
+float-complex-mult.rkt line 14 col 12 - 2.0+4.0i - unboxed literal
+float-complex-mult.rkt line 14 col 21 - 3.0+6.0i - unboxed literal
+float-complex-mult.rkt line 14 col 1 - * - unboxed binary float complex
+float-complex-mult.rkt line 14 col 0 - (#%app * (quote 1.0+2.0i) (quote 2.0+4.0i) (quote 3.0+6.0i)) - unboxed float complex
+-66.0-12.0i
+)
+
+#lang typed/scheme
+#:optimize
+
+(* 1.0+2.0i 2.0+4.0i 3.0+6.0i)
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-parts.rkt b/collects/tests/typed-scheme/optimizer/tests/float-complex-parts.rkt
new file mode 100644
index 00000000..4b3a63dc
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/float-complex-parts.rkt
@@ -0,0 +1,19 @@
+#;
+(
+float-complex-parts.rkt line 17 col 11 - 1.0+2.0i - unboxed literal
+float-complex-parts.rkt line 17 col 1 - real-part - unboxed float complex
+float-complex-parts.rkt line 18 col 11 - 1.0+2.0i - unboxed literal
+float-complex-parts.rkt line 18 col 1 - imag-part - unboxed float complex
+float-complex-parts.rkt line 19 col 11 - 1.0+2.0i - unboxed literal
+float-complex-parts.rkt line 19 col 1 - real-part - unboxed float complex
+1.0
+2.0
+1.0
+)
+
+#lang typed/scheme
+#:optimize
+
+(real-part 1.0+2.0i)
+(imag-part 1+2.0i)
+(real-part 1.0+2i)
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-parts2.rkt b/collects/tests/typed-scheme/optimizer/tests/float-complex-parts2.rkt
new file mode 100644
index 00000000..cc1de957
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/float-complex-parts2.rkt
@@ -0,0 +1,49 @@
+#;
+(
+float-complex-parts2.rkt line 46 col 14 - 1.0+2.0i - unboxed literal
+float-complex-parts2.rkt line 46 col 23 - 2.0+4.0i - unboxed literal
+float-complex-parts2.rkt line 46 col 12 - + - unboxed binary float complex
+float-complex-parts2.rkt line 46 col 11 - (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) - unboxed float complex
+float-complex-parts2.rkt line 46 col 14 - 1.0+2.0i - unboxed literal
+float-complex-parts2.rkt line 46 col 23 - 2.0+4.0i - unboxed literal
+float-complex-parts2.rkt line 46 col 12 - + - unboxed binary float complex
+float-complex-parts2.rkt line 46 col 1 - real-part - unboxed float complex
+float-complex-parts2.rkt line 47 col 23 - 1.0+2.0i - unboxed literal
+float-complex-parts2.rkt line 47 col 32 - 2.0+4.0i - unboxed literal
+float-complex-parts2.rkt line 47 col 21 - + - unboxed binary float complex
+float-complex-parts2.rkt line 47 col 20 - (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) - unboxed float complex
+float-complex-parts2.rkt line 47 col 23 - 1.0+2.0i - unboxed literal
+float-complex-parts2.rkt line 47 col 32 - 2.0+4.0i - unboxed literal
+float-complex-parts2.rkt line 47 col 21 - + - unboxed binary float complex
+float-complex-parts2.rkt line 47 col 1 - unsafe-flreal-part - unboxed float complex
+float-complex-parts2.rkt line 48 col 14 - 1.0+2.0i - unboxed literal
+float-complex-parts2.rkt line 48 col 23 - 2.0+4.0i - unboxed literal
+float-complex-parts2.rkt line 48 col 12 - + - unboxed binary float complex
+float-complex-parts2.rkt line 48 col 11 - (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) - unboxed float complex
+float-complex-parts2.rkt line 48 col 14 - 1.0+2.0i - unboxed literal
+float-complex-parts2.rkt line 48 col 23 - 2.0+4.0i - unboxed literal
+float-complex-parts2.rkt line 48 col 12 - + - unboxed binary float complex
+float-complex-parts2.rkt line 48 col 1 - imag-part - unboxed float complex
+float-complex-parts2.rkt line 49 col 23 - 1.0+2.0i - unboxed literal
+float-complex-parts2.rkt line 49 col 32 - 2.0+4.0i - unboxed literal
+float-complex-parts2.rkt line 49 col 21 - + - unboxed binary float complex
+float-complex-parts2.rkt line 49 col 20 - (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) - unboxed float complex
+float-complex-parts2.rkt line 49 col 23 - 1.0+2.0i - unboxed literal
+float-complex-parts2.rkt line 49 col 32 - 2.0+4.0i - unboxed literal
+float-complex-parts2.rkt line 49 col 21 - + - unboxed binary float complex
+float-complex-parts2.rkt line 49 col 1 - unsafe-flimag-part - unboxed float complex
+3.0
+3.0
+6.0
+6.0
+)
+
+#lang typed/scheme
+#:optimize
+
+(require racket/unsafe/ops)
+
+(real-part (+ 1.0+2.0i 2.0+4.0i))
+(unsafe-flreal-part (+ 1.0+2.0i 2.0+4.0i))
+(imag-part (+ 1.0+2.0i 2.0+4.0i))
+(unsafe-flimag-part (+ 1.0+2.0i 2.0+4.0i))
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-parts3.rkt b/collects/tests/typed-scheme/optimizer/tests/float-complex-parts3.rkt
new file mode 100644
index 00000000..957c7d92
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/float-complex-parts3.rkt
@@ -0,0 +1,45 @@
+#;
+(
+float-complex-parts3.rkt line 42 col 3 - 1.0+2.0i - unboxed literal
+float-complex-parts3.rkt line 42 col 26 - 2.0+4.0i - unboxed literal
+float-complex-parts3.rkt line 42 col 35 - 3.0+6.0i - unboxed literal
+float-complex-parts3.rkt line 42 col 24 - + - unboxed binary float complex
+float-complex-parts3.rkt line 42 col 13 - real-part - unboxed unary float complex
+float-complex-parts3.rkt line 42 col 1 - + - unboxed binary float complex
+float-complex-parts3.rkt line 42 col 0 - (#%app + (quote 1.0+2.0i) (#%app real-part (#%app + (quote 2.0+4.0i) (quote 3.0+6.0i)))) - unboxed float complex
+float-complex-parts3.rkt line 43 col 3 - 1.0+2.0i - unboxed literal
+float-complex-parts3.rkt line 43 col 35 - 2.0+4.0i - unboxed literal
+float-complex-parts3.rkt line 43 col 44 - 3.0+6.0i - unboxed literal
+float-complex-parts3.rkt line 43 col 33 - + - unboxed binary float complex
+float-complex-parts3.rkt line 43 col 13 - unsafe-flreal-part - unboxed unary float complex
+float-complex-parts3.rkt line 43 col 1 - + - unboxed binary float complex
+float-complex-parts3.rkt line 43 col 0 - (#%app + (quote 1.0+2.0i) (#%app unsafe-flreal-part (#%app + (quote 2.0+4.0i) (quote 3.0+6.0i)))) - unboxed float complex
+float-complex-parts3.rkt line 44 col 3 - 1.0+2.0i - unboxed literal
+float-complex-parts3.rkt line 44 col 26 - 2.0+4.0i - unboxed literal
+float-complex-parts3.rkt line 44 col 35 - 3.0+6.0i - unboxed literal
+float-complex-parts3.rkt line 44 col 24 - + - unboxed binary float complex
+float-complex-parts3.rkt line 44 col 13 - imag-part - unboxed unary float complex
+float-complex-parts3.rkt line 44 col 1 - + - unboxed binary float complex
+float-complex-parts3.rkt line 44 col 0 - (#%app + (quote 1.0+2.0i) (#%app imag-part (#%app + (quote 2.0+4.0i) (quote 3.0+6.0i)))) - unboxed float complex
+float-complex-parts3.rkt line 45 col 3 - 1.0+2.0i - unboxed literal
+float-complex-parts3.rkt line 45 col 35 - 2.0+4.0i - unboxed literal
+float-complex-parts3.rkt line 45 col 44 - 3.0+6.0i - unboxed literal
+float-complex-parts3.rkt line 45 col 33 - + - unboxed binary float complex
+float-complex-parts3.rkt line 45 col 13 - unsafe-flimag-part - unboxed unary float complex
+float-complex-parts3.rkt line 45 col 1 - + - unboxed binary float complex
+float-complex-parts3.rkt line 45 col 0 - (#%app + (quote 1.0+2.0i) (#%app unsafe-flimag-part (#%app + (quote 2.0+4.0i) (quote 3.0+6.0i)))) - unboxed float complex
+6.0+2.0i
+6.0+2.0i
+11.0+2.0i
+11.0+2.0i
+)
+
+#lang typed/scheme
+#:optimize
+
+(require racket/unsafe/ops)
+
+(+ 1.0+2.0i (real-part (+ 2.0+4.0i 3.0+6.0i)))
+(+ 1.0+2.0i (unsafe-flreal-part (+ 2.0+4.0i 3.0+6.0i)))
+(+ 1.0+2.0i (imag-part (+ 2.0+4.0i 3.0+6.0i)))
+(+ 1.0+2.0i (unsafe-flimag-part (+ 2.0+4.0i 3.0+6.0i)))
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex-sin.rkt b/collects/tests/typed-scheme/optimizer/tests/float-complex-sin.rkt
new file mode 100644
index 00000000..0211deb0
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/float-complex-sin.rkt
@@ -0,0 +1,15 @@
+#;
+(
+float-complex-sin.rkt line 14 col 13 - (#%app sin (#%app * t (quote 6.28))) - float-coerce-expr in complex ops
+float-complex-sin.rkt line 14 col 30 - 0.0+0.0i - unboxed literal
+float-complex-sin.rkt line 14 col 11 - + - unboxed binary float complex
+float-complex-sin.rkt line 14 col 10 - (#%app + (#%app sin (#%app * t (quote 6.28))) (quote 0.0+0.0i)) - unboxed float complex
+-0.0031853017931379904+0.0i
+)
+
+#lang typed/scheme
+#:optimize
+
+((lambda: ((t : Integer))
+          (+ (sin (* t 6.28)) 0.0+0.0i))
+ 1)
diff --git a/collects/tests/typed-scheme/optimizer/tests/float-complex.rkt b/collects/tests/typed-scheme/optimizer/tests/float-complex.rkt
new file mode 100644
index 00000000..64721469
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/float-complex.rkt
@@ -0,0 +1,19 @@
+#;
+(
+float-complex.rkt line 18 col 3 - 1.0+2.0i - unboxed literal
+float-complex.rkt line 18 col 12 - 2.0+4.0i - unboxed literal
+float-complex.rkt line 18 col 1 - + - unboxed binary float complex
+float-complex.rkt line 18 col 0 - (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) - unboxed float complex
+float-complex.rkt line 19 col 3 - 1.0+2.0i - unboxed literal
+float-complex.rkt line 19 col 12 - 2.0+4.0i - unboxed literal
+float-complex.rkt line 19 col 1 - - - unboxed binary float complex
+float-complex.rkt line 19 col 0 - (#%app - (quote 1.0+2.0i) (quote 2.0+4.0i)) - unboxed float complex
+3.0+6.0i
+-1.0-2.0i
+)
+
+#lang typed/scheme
+#:optimize
+
+(+ 1.0+2.0i 2.0+4.0i)
+(- 1.0+2.0i 2.0+4.0i)
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let.rkt
index 809409c3..b7eb57fb 100644
--- a/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let.rkt
@@ -1,29 +1,29 @@
 #;
 (
-invalid-unboxed-let.rkt line 38 col 14 - t1 - unbox inexact-complex
-invalid-unboxed-let.rkt line 38 col 17 - t1 - unbox inexact-complex
-invalid-unboxed-let.rkt line 38 col 12 - + - unboxed binary inexact complex
-invalid-unboxed-let.rkt line 38 col 11 - (#%app + t1 t1) - unboxed inexact complex
-invalid-unboxed-let.rkt line 38 col 14 - t1 - unbox inexact-complex
-invalid-unboxed-let.rkt line 38 col 17 - t1 - unbox inexact-complex
-invalid-unboxed-let.rkt line 38 col 12 - + - unboxed binary inexact complex
-invalid-unboxed-let.rkt line 38 col 11 - (#%app + t1 t1) - unboxed inexact complex
-invalid-unboxed-let.rkt line 38 col 14 - t1 - unbox inexact-complex
-invalid-unboxed-let.rkt line 38 col 17 - t1 - unbox inexact-complex
-invalid-unboxed-let.rkt line 38 col 12 - + - unboxed binary inexact complex
-invalid-unboxed-let.rkt line 38 col 11 - (#%app + t1 t1) - unboxed inexact complex
+invalid-unboxed-let.rkt line 38 col 14 - t1 - unbox float-complex
+invalid-unboxed-let.rkt line 38 col 17 - t1 - unbox float-complex
+invalid-unboxed-let.rkt line 38 col 12 - + - unboxed binary float complex
+invalid-unboxed-let.rkt line 38 col 11 - (#%app + t1 t1) - unboxed float complex
+invalid-unboxed-let.rkt line 38 col 14 - t1 - unbox float-complex
+invalid-unboxed-let.rkt line 38 col 17 - t1 - unbox float-complex
+invalid-unboxed-let.rkt line 38 col 12 - + - unboxed binary float complex
+invalid-unboxed-let.rkt line 38 col 11 - (#%app + t1 t1) - unboxed float complex
+invalid-unboxed-let.rkt line 38 col 14 - t1 - unbox float-complex
+invalid-unboxed-let.rkt line 38 col 17 - t1 - unbox float-complex
+invalid-unboxed-let.rkt line 38 col 12 - + - unboxed binary float complex
+invalid-unboxed-let.rkt line 38 col 11 - (#%app + t1 t1) - unboxed float complex
 invalid-unboxed-let.rkt line 34 col 13 - 1.0+2.0i - unboxed literal
 invalid-unboxed-let.rkt line 34 col 22 - 2.0+4.0i - unboxed literal
-invalid-unboxed-let.rkt line 34 col 11 - + - unboxed binary inexact complex
+invalid-unboxed-let.rkt line 34 col 11 - + - unboxed binary float complex
 invalid-unboxed-let.rkt line 35 col 13 - 3.0+6.0i - unboxed literal
 invalid-unboxed-let.rkt line 35 col 22 - 4.0+8.0i - unboxed literal
-invalid-unboxed-let.rkt line 35 col 11 - + - unboxed binary inexact complex
-invalid-unboxed-let.rkt line 35 col 10 - (#%app + (quote 3.0+6.0i) (quote 4.0+8.0i)) - unboxed inexact complex
+invalid-unboxed-let.rkt line 35 col 11 - + - unboxed binary float complex
+invalid-unboxed-let.rkt line 35 col 10 - (#%app + (quote 3.0+6.0i) (quote 4.0+8.0i)) - unboxed float complex
 invalid-unboxed-let.rkt line 34 col 0 - (let-values (((t1) (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i))) ((t2) (#%app + (quote 3.0+6.0i) (quote 4.0+8.0i))) ((t3) (quote 1.0+2.0i)) ((t4) (quote 1))) (#%app display (#%app + t1 t1)) (#%app display t2) (#%app display t3) (#%app display t4)) - unboxed let bindings
 invalid-unboxed-let.rkt line 38 col 14 - t1 - leave var unboxed
 invalid-unboxed-let.rkt line 38 col 17 - t1 - leave var unboxed
-invalid-unboxed-let.rkt line 38 col 12 - + - unboxed binary inexact complex
-invalid-unboxed-let.rkt line 38 col 11 - (#%app + t1 t1) - unboxed inexact complex
+invalid-unboxed-let.rkt line 38 col 12 - + - unboxed binary float complex
+invalid-unboxed-let.rkt line 38 col 11 - (#%app + t1 t1) - unboxed float complex
 6.0+12.0i7.0+14.0i1.0+2.0i1)
 
 #lang typed/scheme
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt
index 459f47ff..79a58dab 100644
--- a/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt
@@ -2,17 +2,17 @@
 (
 invalid-unboxed-let2.rkt line 25 col 33 - 1.0+2.0i - unboxed literal
 invalid-unboxed-let2.rkt line 25 col 42 - 2.0+4.0i - unboxed literal
-invalid-unboxed-let2.rkt line 25 col 31 - + - unboxed binary inexact complex
-invalid-unboxed-let2.rkt line 25 col 30 - (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) - unboxed inexact complex
+invalid-unboxed-let2.rkt line 25 col 31 - + - unboxed binary float complex
+invalid-unboxed-let2.rkt line 25 col 30 - (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) - unboxed float complex
 invalid-unboxed-let2.rkt line 25 col 55 - 3.0+6.0i - unboxed literal
 invalid-unboxed-let2.rkt line 25 col 64 - 4.0+8.0i - unboxed literal
-invalid-unboxed-let2.rkt line 25 col 53 - + - unboxed binary inexact complex
-invalid-unboxed-let2.rkt line 25 col 52 - (#%app + (quote 3.0+6.0i) (quote 4.0+8.0i)) - unboxed inexact complex
+invalid-unboxed-let2.rkt line 25 col 53 - + - unboxed binary float complex
+invalid-unboxed-let2.rkt line 25 col 52 - (#%app + (quote 3.0+6.0i) (quote 4.0+8.0i)) - unboxed float complex
 invalid-unboxed-let2.rkt line 25 col 0 - (let-values (((t1 t2) (#%app values (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) (#%app + (quote 3.0+6.0i) (quote 4.0+8.0i))))) (#%app + t1 t2)) - unboxed let bindings
-invalid-unboxed-let2.rkt line 26 col 5 - t1 - unbox inexact-complex
-invalid-unboxed-let2.rkt line 26 col 8 - t2 - unbox inexact-complex
-invalid-unboxed-let2.rkt line 26 col 3 - + - unboxed binary inexact complex
-invalid-unboxed-let2.rkt line 26 col 2 - (#%app + t1 t2) - unboxed inexact complex
+invalid-unboxed-let2.rkt line 26 col 5 - t1 - unbox float-complex
+invalid-unboxed-let2.rkt line 26 col 8 - t2 - unbox float-complex
+invalid-unboxed-let2.rkt line 26 col 3 - + - unboxed binary float complex
+invalid-unboxed-let2.rkt line 26 col 2 - (#%app + t1 t2) - unboxed float complex
 10.0+20.0i
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/magnitude.rkt b/collects/tests/typed-scheme/optimizer/tests/magnitude.rkt
index dc69d185..0615ba8b 100644
--- a/collects/tests/typed-scheme/optimizer/tests/magnitude.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/magnitude.rkt
@@ -1,8 +1,8 @@
 #;
 (
 magnitude.rkt line 14 col 11 - 3.0+4.0i - unboxed literal
-magnitude.rkt line 14 col 1 - magnitude - unboxed unary inexact complex
-magnitude.rkt line 14 col 0 - (#%app magnitude (quote 3.0+4.0i)) - unboxed inexact complex->float
+magnitude.rkt line 14 col 1 - magnitude - unboxed unary float complex
+magnitude.rkt line 14 col 0 - (#%app magnitude (quote 3.0+4.0i)) - unboxed float complex->float
 5.0
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/make-polar.rkt b/collects/tests/typed-scheme/optimizer/tests/make-polar.rkt
index f1b0033b..8fdd9f2e 100644
--- a/collects/tests/typed-scheme/optimizer/tests/make-polar.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/make-polar.rkt
@@ -2,19 +2,19 @@
 (
 make-polar.rkt line 28 col 1 - make-polar - make-rectangular elimination
 make-polar.rkt line 28 col 1 - make-polar - make-polar
-make-polar.rkt line 32 col 50 - p - unbox inexact-complex
-make-polar.rkt line 32 col 40 - real-part - unboxed unary inexact complex
-make-polar.rkt line 32 col 39 - (#%app real-part p) - unboxed inexact complex->float
+make-polar.rkt line 32 col 50 - p - unbox float-complex
+make-polar.rkt line 32 col 40 - real-part - unboxed unary float complex
+make-polar.rkt line 32 col 39 - (#%app real-part p) - unboxed float complex->float
 make-polar.rkt line 31 col 12 - 1.0+2.0i - unboxed literal
 make-polar.rkt line 31 col 22 - make-polar - make-rectangular elimination
-make-polar.rkt line 31 col 10 - + - unboxed binary inexact complex
+make-polar.rkt line 31 col 10 - + - unboxed binary float complex
 make-polar.rkt line 31 col 0 - (let-values (((p) (#%app + (quote 1.0+2.0i) (#%app make-polar (quote 2.0) (quote 4.0))))) (#%app string-append (#%app real->decimal-string (#%app real-part p) (quote 10)) (#%app real->decimal-string (#%app imag-part p) (quote 10)))) - unboxed let bindings
 make-polar.rkt line 32 col 50 - p - unboxed complex variable
 make-polar.rkt line 32 col 50 - p - leave var unboxed
-make-polar.rkt line 32 col 40 - real-part - unboxed inexact complex
+make-polar.rkt line 32 col 40 - real-part - unboxed float complex
 make-polar.rkt line 33 col 50 - p - unboxed complex variable
 make-polar.rkt line 33 col 50 - p - leave var unboxed
-make-polar.rkt line 33 col 40 - imag-part - unboxed inexact complex
+make-polar.rkt line 33 col 40 - imag-part - unboxed float complex
 0.5403023058681398+0.8414709848078965i
 "-0.30728724170.4863950094"
 )
diff --git a/collects/tests/typed-scheme/optimizer/tests/maybe-exact-complex.rkt b/collects/tests/typed-scheme/optimizer/tests/maybe-exact-complex.rkt
index 235a672e..12877a75 100644
--- a/collects/tests/typed-scheme/optimizer/tests/maybe-exact-complex.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/maybe-exact-complex.rkt
@@ -2,8 +2,8 @@
 (
 maybe-exact-complex.rkt line 15 col 3 - 1.0+2.0i - unboxed literal
 maybe-exact-complex.rkt line 15 col 12 - 2+4i - unboxed literal
-maybe-exact-complex.rkt line 15 col 1 - + - unboxed binary inexact complex
-maybe-exact-complex.rkt line 15 col 0 - (#%app + (quote 1.0+2.0i) (quote 2+4i)) - unboxed inexact complex
+maybe-exact-complex.rkt line 15 col 1 - + - unboxed binary float complex
+maybe-exact-complex.rkt line 15 col 0 - (#%app + (quote 1.0+2.0i) (quote 2+4i)) - unboxed float complex
 3.0+6.0i
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/n-ary-float-complex.rkt b/collects/tests/typed-scheme/optimizer/tests/n-ary-float-complex.rkt
new file mode 100644
index 00000000..44416db9
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/n-ary-float-complex.rkt
@@ -0,0 +1,15 @@
+#;
+(
+n-ary-float-complex.rkt line 15 col 3 - 1.0+2.0i - unboxed literal
+n-ary-float-complex.rkt line 15 col 12 - 2.0+4.0i - unboxed literal
+n-ary-float-complex.rkt line 15 col 21 - 3.0+6.0i - unboxed literal
+n-ary-float-complex.rkt line 15 col 30 - 4.0+8.0i - unboxed literal
+n-ary-float-complex.rkt line 15 col 1 - + - unboxed binary float complex
+n-ary-float-complex.rkt line 15 col 0 - (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i) (quote 3.0+6.0i) (quote 4.0+8.0i)) - unboxed float complex
+10.0+20.0i
+)
+
+#lang typed/scheme
+#:optimize
+
+(+ 1.0+2.0i 2.0+4.0i 3.0+6.0i 4.0+8.0i)
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-float-complex.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-float-complex.rkt
new file mode 100644
index 00000000..850de65b
--- /dev/null
+++ b/collects/tests/typed-scheme/optimizer/tests/nested-float-complex.rkt
@@ -0,0 +1,15 @@
+#;
+(
+nested-float-complex.rkt line 15 col 3 - 1.0+2.0i - unboxed literal
+nested-float-complex.rkt line 15 col 15 - 2.0+4.0i - unboxed literal
+nested-float-complex.rkt line 15 col 24 - 3.0+6.0i - unboxed literal
+nested-float-complex.rkt line 15 col 13 - - - unboxed binary float complex
+nested-float-complex.rkt line 15 col 1 - + - unboxed binary float complex
+nested-float-complex.rkt line 15 col 0 - (#%app + (quote 1.0+2.0i) (#%app - (quote 2.0+4.0i) (quote 3.0+6.0i))) - unboxed float complex
+0.0+0.0i
+)
+
+#lang typed/scheme
+#:optimize
+
+(+ 1.0+2.0i (- 2.0+4.0i 3.0+6.0i))
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt
index a11185ef..4d55b2e0 100644
--- a/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt
@@ -1,32 +1,32 @@
 #;
 (
-nested-let-loop.rkt line 58 col 38 - r - unbox inexact-complex
-nested-let-loop.rkt line 58 col 40 - s - unbox inexact-complex
-nested-let-loop.rkt line 58 col 36 - + - unboxed binary inexact complex
-nested-let-loop.rkt line 58 col 35 - (#%app + r s) - unboxed inexact complex
+nested-let-loop.rkt line 58 col 38 - r - unbox float-complex
+nested-let-loop.rkt line 58 col 40 - s - unbox float-complex
+nested-let-loop.rkt line 58 col 36 - + - unboxed binary float complex
+nested-let-loop.rkt line 58 col 35 - (#%app + r s) - unboxed float complex
 nested-let-loop.rkt line 51 col 8 - r - unboxed var -> table
 nested-let-loop.rkt line 49 col 6 - loop1 - unboxed function -> table
 nested-let-loop.rkt line 49 col 6 - loop1 - fun -> unboxed fun
 nested-let-loop.rkt line 53 col 10 - r - unboxed complex variable
 nested-let-loop.rkt line 58 col 38 - r - leave var unboxed
-nested-let-loop.rkt line 58 col 40 - s - unbox inexact-complex
-nested-let-loop.rkt line 58 col 36 - + - unboxed binary inexact complex
-nested-let-loop.rkt line 58 col 35 - (#%app + r s) - unboxed inexact complex
+nested-let-loop.rkt line 58 col 40 - s - unbox float-complex
+nested-let-loop.rkt line 58 col 36 - + - unboxed binary float complex
+nested-let-loop.rkt line 58 col 35 - (#%app + r s) - unboxed float complex
 nested-let-loop.rkt line 56 col 18 - s - unboxed var -> table
 nested-let-loop.rkt line 54 col 16 - loop2 - unboxed function -> table
 nested-let-loop.rkt line 54 col 16 - loop2 - fun -> unboxed fun
 nested-let-loop.rkt line 58 col 38 - r - leave var unboxed
 nested-let-loop.rkt line 58 col 40 - s - leave var unboxed
-nested-let-loop.rkt line 58 col 36 - + - unboxed binary inexact complex
+nested-let-loop.rkt line 58 col 36 - + - unboxed binary float complex
 nested-let-loop.rkt line 58 col 21 - loop1 - unboxed call site
 nested-let-loop.rkt line 58 col 28 - cdr - pair
 nested-let-loop.rkt line 58 col 21 - loop1 - call to fun with unboxed args
 nested-let-loop.rkt line 59 col 38 - s - leave var unboxed
-nested-let-loop.rkt line 59 col 40 - (#%app car x) - unbox inexact-complex
+nested-let-loop.rkt line 59 col 40 - (#%app car x) - unbox float-complex
 nested-let-loop.rkt line 59 col 41 - car - pair
-nested-let-loop.rkt line 59 col 48 - (#%app car y) - unbox inexact-complex
+nested-let-loop.rkt line 59 col 48 - (#%app car y) - unbox float-complex
 nested-let-loop.rkt line 59 col 49 - car - pair
-nested-let-loop.rkt line 59 col 36 - + - unboxed binary inexact complex
+nested-let-loop.rkt line 59 col 36 - + - unboxed binary float complex
 nested-let-loop.rkt line 59 col 21 - loop2 - unboxed call site
 nested-let-loop.rkt line 59 col 28 - cdr - pair
 nested-let-loop.rkt line 59 col 21 - loop2 - call to fun with unboxed args
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-unboxed-let.rkt
index 6169762e..20569e8c 100644
--- a/collects/tests/typed-scheme/optimizer/tests/nested-unboxed-let.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/nested-unboxed-let.rkt
@@ -1,25 +1,25 @@
 #;
 (
-nested-unboxed-let.rkt line 32 col 14 - x - unbox inexact-complex
+nested-unboxed-let.rkt line 32 col 14 - x - unbox float-complex
 nested-unboxed-let.rkt line 32 col 16 - 2.0+3.0i - unboxed literal
-nested-unboxed-let.rkt line 32 col 12 - + - unboxed binary inexact complex
-nested-unboxed-let.rkt line 32 col 11 - (#%app + x (quote 2.0+3.0i)) - unboxed inexact complex
+nested-unboxed-let.rkt line 32 col 12 - + - unboxed binary float complex
+nested-unboxed-let.rkt line 32 col 11 - (#%app + x (quote 2.0+3.0i)) - unboxed float complex
 nested-unboxed-let.rkt line 31 col 12 - 1.0+2.0i - unboxed literal
 nested-unboxed-let.rkt line 31 col 21 - 2.0+3.0i - unboxed literal
-nested-unboxed-let.rkt line 31 col 10 - + - unboxed binary inexact complex
+nested-unboxed-let.rkt line 31 col 10 - + - unboxed binary float complex
 nested-unboxed-let.rkt line 31 col 0 - (let-values (((x) (#%app + (quote 1.0+2.0i) (quote 2.0+3.0i)))) (let-values (((x) (#%app + x (quote 2.0+3.0i)))) (#%app + x (quote 3.0+6.0i)))) - unboxed let bindings
-nested-unboxed-let.rkt line 33 col 7 - x - unbox inexact-complex
+nested-unboxed-let.rkt line 33 col 7 - x - unbox float-complex
 nested-unboxed-let.rkt line 33 col 9 - 3.0+6.0i - unboxed literal
-nested-unboxed-let.rkt line 33 col 5 - + - unboxed binary inexact complex
-nested-unboxed-let.rkt line 33 col 4 - (#%app + x (quote 3.0+6.0i)) - unboxed inexact complex
+nested-unboxed-let.rkt line 33 col 5 - + - unboxed binary float complex
+nested-unboxed-let.rkt line 33 col 4 - (#%app + x (quote 3.0+6.0i)) - unboxed float complex
 nested-unboxed-let.rkt line 32 col 14 - x - leave var unboxed
 nested-unboxed-let.rkt line 32 col 16 - 2.0+3.0i - unboxed literal
-nested-unboxed-let.rkt line 32 col 12 - + - unboxed binary inexact complex
+nested-unboxed-let.rkt line 32 col 12 - + - unboxed binary float complex
 nested-unboxed-let.rkt line 32 col 2 - (let-values (((x) (#%app + x (quote 2.0+3.0i)))) (#%app + x (quote 3.0+6.0i))) - unboxed let bindings
 nested-unboxed-let.rkt line 33 col 7 - x - leave var unboxed
 nested-unboxed-let.rkt line 33 col 9 - 3.0+6.0i - unboxed literal
-nested-unboxed-let.rkt line 33 col 5 - + - unboxed binary inexact complex
-nested-unboxed-let.rkt line 33 col 4 - (#%app + x (quote 3.0+6.0i)) - unboxed inexact complex
+nested-unboxed-let.rkt line 33 col 5 - + - unboxed binary float complex
+nested-unboxed-let.rkt line 33 col 4 - (#%app + x (quote 3.0+6.0i)) - unboxed float complex
 8.0+14.0i
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt b/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt
index 4d478200..45637a4d 100644
--- a/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt
@@ -1,18 +1,18 @@
 #;
 (
-real-part-loop.rkt line 32 col 20 - v - unbox inexact-complex
-real-part-loop.rkt line 32 col 10 - real-part - unboxed unary inexact complex
-real-part-loop.rkt line 32 col 9 - (#%app real-part v) - unboxed inexact complex->float
+real-part-loop.rkt line 32 col 20 - v - unbox float-complex
+real-part-loop.rkt line 32 col 10 - real-part - unboxed unary float complex
+real-part-loop.rkt line 32 col 9 - (#%app real-part v) - unboxed float complex->float
 real-part-loop.rkt line 31 col 13 - v - unboxed var -> table
 real-part-loop.rkt line 31 col 6 - loop - unboxed function -> table
 real-part-loop.rkt line 31 col 6 - loop - fun -> unboxed fun
 real-part-loop.rkt line 32 col 20 - v - unboxed complex variable
 real-part-loop.rkt line 32 col 20 - v - leave var unboxed
-real-part-loop.rkt line 32 col 10 - real-part - unboxed inexact complex
+real-part-loop.rkt line 32 col 10 - real-part - unboxed float complex
 real-part-loop.rkt line 32 col 7 - > - binary float comp
 real-part-loop.rkt line 34 col 15 - v - leave var unboxed
 real-part-loop.rkt line 34 col 17 - (quote 3.6) - float-coerce-expr in complex ops
-real-part-loop.rkt line 34 col 13 - + - unboxed binary inexact complex
+real-part-loop.rkt line 34 col 13 - + - unboxed binary float complex
 real-part-loop.rkt line 34 col 7 - loop - unboxed call site
 real-part-loop.rkt line 34 col 7 - loop - call to fun with unboxed args
 real-part-loop.rkt line 31 col 1 - (letrec-values (((loop) (lambda (v) (if (#%app > (#%app real-part v) (quote 70000.2)) (quote 0) (#%app loop (#%app + v (quote 3.6))))))) loop) - unboxed let bindings
diff --git a/collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt b/collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt
index c6faf7ff..b3886761 100644
--- a/collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt
@@ -1,11 +1,11 @@
 #;
 (
 sqrt-segfault.rkt line 22 col 15 - - - binary float
-sqrt-segfault.rkt line 22 col 0 - (let-values (((dx) (#%app - (quote 0.0) (quote 0.0)))) (let-values (((dist2) (#%app * dx dx))) (let-values (((mag) (let-values (((val) (#%app * dist2 (#%app sqrt dist2)))) (if (#%app inexact-real? val) val (#%app error (quote Assertion failed)))))) (#%app void)))) - unboxed let bindings
+sqrt-segfault.rkt line 22 col 0 - (let-values (((dx) (#%app - (quote 0.0) (quote 0.0)))) (let-values (((dist2) (#%app * dx dx))) (let-values (((mag) (let-values (((val) (#%app * dist2 (#%app sqrt dist2)))) (if (#%app flonum? val) val (#%app error (quote Assertion failed)))))) (#%app void)))) - unboxed let bindings
 sqrt-segfault.rkt line 23 col 15 - * - binary float
-sqrt-segfault.rkt line 22 col 0 - (let-values (((dist2) (#%app * dx dx))) (let-values (((mag) (let-values (((val) (#%app * dist2 (#%app sqrt dist2)))) (if (#%app inexact-real? val) val (#%app error (quote Assertion failed)))))) (#%app void))) - unboxed let bindings
-sqrt-segfault.rkt line 24 col 14 - (let-values (((val) (#%app * dist2 (#%app sqrt dist2)))) (if (#%app inexact-real? val) val (#%app error (quote Assertion failed)))) - unboxed let bindings
-sqrt-segfault.rkt line 22 col 0 - (let-values (((mag) (let-values (((val) (#%app * dist2 (#%app sqrt dist2)))) (if (#%app inexact-real? val) val (#%app error (quote Assertion failed)))))) (#%app void)) - unboxed let bindings
+sqrt-segfault.rkt line 22 col 0 - (let-values (((dist2) (#%app * dx dx))) (let-values (((mag) (let-values (((val) (#%app * dist2 (#%app sqrt dist2)))) (if (#%app flonum? val) val (#%app error (quote Assertion failed)))))) (#%app void))) - unboxed let bindings
+sqrt-segfault.rkt line 24 col 14 - (let-values (((val) (#%app * dist2 (#%app sqrt dist2)))) (if (#%app flonum? val) val (#%app error (quote Assertion failed)))) - unboxed let bindings
+sqrt-segfault.rkt line 22 col 0 - (let-values (((mag) (let-values (((val) (#%app * dist2 (#%app sqrt dist2)))) (if (#%app flonum? val) val (#%app error (quote Assertion failed)))))) (#%app void)) - unboxed let bindings
 )
 
 #lang typed/scheme
@@ -14,12 +14,12 @@ sqrt-segfault.rkt line 22 col 0 - (let-values (((mag) (let-values (((val) (#%app
 
 
 ;; from the nbody-generic benchmark.
-;; the result of sqrt was an Inexact-Complex, so inexact complex opts kicked
+;; the result of sqrt was an Inexact-Complex, so float complex opts kicked
 ;; in but they resulted in segfaulting code.
 ;; the problem was that having Float be a subtype of Inexact-Complex was wrong
 ;; since you can't do unsafe-flreal-part of a float
 
 (let* ([dx    (- 0.0 0.0)]
        [dist2 (* dx dx)]
-       [mag   (assert (* dist2 (sqrt dist2)) inexact-real?)])
+       [mag   (assert (* dist2 (sqrt dist2)) flonum?)])
   (void))
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt
index 3fbfda23..63045602 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt
@@ -2,40 +2,40 @@
 (
 #f line #f col #f - make-sequence - in-list
 #f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (quote (1.0+2.0i 2.0+4.0i))))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (sum pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop sum (#%app pos-next pos)) sum)) sum)) sum)))) for-loop) (quote 0.0+0.0i) init)) - unboxed let bindings
-unboxed-for.rkt line 57 col 9 - i - unbox inexact-complex
-unboxed-for.rkt line 57 col 11 - sum - unbox inexact-complex
-unboxed-for.rkt line 57 col 7 - + - unboxed binary inexact complex
-unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed inexact complex
-unboxed-for.rkt line 57 col 9 - i - unbox inexact-complex
-unboxed-for.rkt line 57 col 11 - sum - unbox inexact-complex
-unboxed-for.rkt line 57 col 7 - + - unboxed binary inexact complex
-unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed inexact complex
+unboxed-for.rkt line 57 col 9 - i - unbox float-complex
+unboxed-for.rkt line 57 col 11 - sum - unbox float-complex
+unboxed-for.rkt line 57 col 7 - + - unboxed binary float complex
+unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed float complex
+unboxed-for.rkt line 57 col 9 - i - unbox float-complex
+unboxed-for.rkt line 57 col 11 - sum - unbox float-complex
+unboxed-for.rkt line 57 col 7 - + - unboxed binary float complex
+unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed float complex
 unboxed-for.rkt line 55 col 31 - sum - unboxed var -> table
 #f line #f col #f - for-loop - unboxed function -> table
 #f line #f col #f - for-loop - fun -> unboxed fun
 unboxed-for.rkt line 55 col 31 - sum - unboxed complex variable
-unboxed-for.rkt line 57 col 9 - i - unbox inexact-complex
-unboxed-for.rkt line 57 col 11 - sum - unbox inexact-complex
-unboxed-for.rkt line 57 col 7 - + - unboxed binary inexact complex
-unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed inexact complex
-#f line #f col #f - (#%app pos->vals pos) - unbox inexact-complex
+unboxed-for.rkt line 57 col 9 - i - unbox float-complex
+unboxed-for.rkt line 57 col 11 - sum - unbox float-complex
+unboxed-for.rkt line 57 col 7 - + - unboxed binary float complex
+unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed float complex
+#f line #f col #f - (#%app pos->vals pos) - unbox float-complex
 #f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop sum (#%app pos-next pos)) sum)) sum)) - unboxed let bindings
 unboxed-for.rkt line 56 col 13 - i - unboxed complex variable
 unboxed-for.rkt line 56 col 13 - i - unboxed complex variable
 unboxed-for.rkt line 57 col 9 - i - leave var unboxed
-unboxed-for.rkt line 57 col 11 - sum - unbox inexact-complex
-unboxed-for.rkt line 57 col 7 - + - unboxed binary inexact complex
-unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed inexact complex
+unboxed-for.rkt line 57 col 11 - sum - unbox float-complex
+unboxed-for.rkt line 57 col 7 - + - unboxed binary float complex
+unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed float complex
 unboxed-for.rkt line 55 col 31 - sum - leave var unboxed
 #f line #f col #f - (let-values (((sum) sum)) (let-values () (#%app + i sum))) - unboxed let bindings
 #f line #f col #f - (let-values () (#%app + i sum)) - unboxed let bindings
 unboxed-for.rkt line 57 col 9 - i - leave var unboxed
 unboxed-for.rkt line 57 col 11 - sum - leave var unboxed
-unboxed-for.rkt line 57 col 7 - + - unboxed binary inexact complex
-unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed inexact complex
+unboxed-for.rkt line 57 col 7 - + - unboxed binary float complex
+unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed float complex
 #f line #f col #f - (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop sum (#%app pos-next pos)) sum)) - unboxed let bindings
 unboxed-for.rkt line 56 col 13 - i - unboxed complex variable
-unboxed-for.rkt line 55 col 31 - sum - unbox inexact-complex
+unboxed-for.rkt line 55 col 31 - sum - unbox float-complex
 #f line #f col #f - for-loop - unboxed call site
 #f line #f col #f - for-loop - call to fun with unboxed args
 unboxed-for.rkt line 55 col 31 - sum - unboxed complex variable
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions1.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions1.rkt
index 4f975a50..13859b9b 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions1.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions1.rkt
@@ -1,20 +1,20 @@
 #;
 (
-unboxed-let-functions1.rkt line 29 col 45 - x - unbox inexact-complex
+unboxed-let-functions1.rkt line 29 col 45 - x - unbox float-complex
 unboxed-let-functions1.rkt line 29 col 47 - 3.0+6.0i - unboxed literal
-unboxed-let-functions1.rkt line 29 col 43 - + - unboxed binary inexact complex
-unboxed-let-functions1.rkt line 29 col 42 - (#%app + x (quote 3.0+6.0i)) - unboxed inexact complex
+unboxed-let-functions1.rkt line 29 col 43 - + - unboxed binary float complex
+unboxed-let-functions1.rkt line 29 col 42 - (#%app + x (quote 3.0+6.0i)) - unboxed float complex
 unboxed-let-functions1.rkt line 29 col 20 - x - unboxed var -> table
 unboxed-let-functions1.rkt line 29 col 7 - f - unboxed function -> table
 unboxed-let-functions1.rkt line 29 col 7 - f - fun -> unboxed fun
 unboxed-let-functions1.rkt line 29 col 45 - x - leave var unboxed
 unboxed-let-functions1.rkt line 29 col 47 - 3.0+6.0i - unboxed literal
-unboxed-let-functions1.rkt line 29 col 43 - + - unboxed binary inexact complex
-unboxed-let-functions1.rkt line 29 col 42 - (#%app + x (quote 3.0+6.0i)) - unboxed inexact complex
+unboxed-let-functions1.rkt line 29 col 43 - + - unboxed binary float complex
+unboxed-let-functions1.rkt line 29 col 42 - (#%app + x (quote 3.0+6.0i)) - unboxed float complex
 unboxed-let-functions1.rkt line 29 col 0 - (let-values (((f) (lambda (x) (#%app + x (quote 3.0+6.0i))))) (#%app f (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)))) - unboxed let bindings
 unboxed-let-functions1.rkt line 30 col 8 - 1.0+2.0i - unboxed literal
 unboxed-let-functions1.rkt line 30 col 17 - 2.0+4.0i - unboxed literal
-unboxed-let-functions1.rkt line 30 col 6 - + - unboxed binary inexact complex
+unboxed-let-functions1.rkt line 30 col 6 - + - unboxed binary float complex
 unboxed-let-functions1.rkt line 30 col 3 - f - unboxed call site
 unboxed-let-functions1.rkt line 30 col 3 - f - call to fun with unboxed args
 6.0+12.0i
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions2.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions2.rkt
index d7841b21..3dd599be 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions2.rkt
@@ -1,25 +1,25 @@
 #;
 (
-unboxed-let-functions2.rkt line 36 col 21 - x - unbox inexact-complex
-unboxed-let-functions2.rkt line 36 col 23 - y - unbox inexact-complex
-unboxed-let-functions2.rkt line 36 col 19 - + - unboxed binary inexact complex
-unboxed-let-functions2.rkt line 36 col 18 - (#%app + x y) - unboxed inexact complex
+unboxed-let-functions2.rkt line 36 col 21 - x - unbox float-complex
+unboxed-let-functions2.rkt line 36 col 23 - y - unbox float-complex
+unboxed-let-functions2.rkt line 36 col 19 - + - unboxed binary float complex
+unboxed-let-functions2.rkt line 36 col 18 - (#%app + x y) - unboxed float complex
 unboxed-let-functions2.rkt line 35 col 20 - x - unboxed var -> table
-unboxed-let-functions2.rkt line 36 col 21 - x - unbox inexact-complex
-unboxed-let-functions2.rkt line 36 col 23 - y - unbox inexact-complex
-unboxed-let-functions2.rkt line 36 col 19 - + - unboxed binary inexact complex
-unboxed-let-functions2.rkt line 36 col 18 - (#%app + x y) - unboxed inexact complex
+unboxed-let-functions2.rkt line 36 col 21 - x - unbox float-complex
+unboxed-let-functions2.rkt line 36 col 23 - y - unbox float-complex
+unboxed-let-functions2.rkt line 36 col 19 - + - unboxed binary float complex
+unboxed-let-functions2.rkt line 36 col 18 - (#%app + x y) - unboxed float complex
 unboxed-let-functions2.rkt line 35 col 42 - y - unboxed var -> table
 unboxed-let-functions2.rkt line 35 col 7 - f - unboxed function -> table
 unboxed-let-functions2.rkt line 35 col 7 - f - fun -> unboxed fun
 unboxed-let-functions2.rkt line 36 col 21 - x - leave var unboxed
 unboxed-let-functions2.rkt line 36 col 23 - y - leave var unboxed
-unboxed-let-functions2.rkt line 36 col 19 - + - unboxed binary inexact complex
-unboxed-let-functions2.rkt line 36 col 18 - (#%app + x y) - unboxed inexact complex
+unboxed-let-functions2.rkt line 36 col 19 - + - unboxed binary float complex
+unboxed-let-functions2.rkt line 36 col 18 - (#%app + x y) - unboxed float complex
 unboxed-let-functions2.rkt line 35 col 0 - (let-values (((f) (lambda (x y) (#%app + x y)))) (#%app f (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) (quote 3.0+6.0i))) - unboxed let bindings
 unboxed-let-functions2.rkt line 37 col 8 - 1.0+2.0i - unboxed literal
 unboxed-let-functions2.rkt line 37 col 17 - 2.0+4.0i - unboxed literal
-unboxed-let-functions2.rkt line 37 col 6 - + - unboxed binary inexact complex
+unboxed-let-functions2.rkt line 37 col 6 - + - unboxed binary float complex
 unboxed-let-functions2.rkt line 38 col 5 - 3.0+6.0i - unboxed literal
 unboxed-let-functions2.rkt line 37 col 3 - f - unboxed call site
 unboxed-let-functions2.rkt line 37 col 3 - f - call to fun with unboxed args
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions3.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions3.rkt
index e7aff08a..74298a16 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions3.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions3.rkt
@@ -1,20 +1,20 @@
 #;
 (
-unboxed-let-functions3.rkt line 30 col 21 - x - unbox inexact-complex
+unboxed-let-functions3.rkt line 30 col 21 - x - unbox float-complex
 unboxed-let-functions3.rkt line 30 col 23 - y - float-coerce-expr in complex ops
-unboxed-let-functions3.rkt line 30 col 19 - + - unboxed binary inexact complex
-unboxed-let-functions3.rkt line 30 col 18 - (#%app + x y) - unboxed inexact complex
+unboxed-let-functions3.rkt line 30 col 19 - + - unboxed binary float complex
+unboxed-let-functions3.rkt line 30 col 18 - (#%app + x y) - unboxed float complex
 unboxed-let-functions3.rkt line 29 col 20 - x - unboxed var -> table
 unboxed-let-functions3.rkt line 29 col 7 - f - unboxed function -> table
 unboxed-let-functions3.rkt line 29 col 7 - f - fun -> unboxed fun
 unboxed-let-functions3.rkt line 30 col 21 - x - leave var unboxed
 unboxed-let-functions3.rkt line 30 col 23 - y - float-coerce-expr in complex ops
-unboxed-let-functions3.rkt line 30 col 19 - + - unboxed binary inexact complex
-unboxed-let-functions3.rkt line 30 col 18 - (#%app + x y) - unboxed inexact complex
+unboxed-let-functions3.rkt line 30 col 19 - + - unboxed binary float complex
+unboxed-let-functions3.rkt line 30 col 18 - (#%app + x y) - unboxed float complex
 unboxed-let-functions3.rkt line 29 col 0 - (let-values (((f) (lambda (x y) (#%app + x y)))) (#%app f (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) (quote 3.0))) - unboxed let bindings
 unboxed-let-functions3.rkt line 31 col 8 - 1.0+2.0i - unboxed literal
 unboxed-let-functions3.rkt line 31 col 17 - 2.0+4.0i - unboxed literal
-unboxed-let-functions3.rkt line 31 col 6 - + - unboxed binary inexact complex
+unboxed-let-functions3.rkt line 31 col 6 - + - unboxed binary float complex
 unboxed-let-functions3.rkt line 31 col 3 - f - unboxed call site
 unboxed-let-functions3.rkt line 31 col 3 - f - call to fun with unboxed args
 6.0+6.0i
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions4.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions4.rkt
index 09612c21..eab9b166 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions4.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions4.rkt
@@ -1,20 +1,20 @@
 #;
 (
-unboxed-let-functions4.rkt line 30 col 21 - x - unbox inexact-complex
+unboxed-let-functions4.rkt line 30 col 21 - x - unbox float-complex
 unboxed-let-functions4.rkt line 30 col 23 - y - float-coerce-expr in complex ops
-unboxed-let-functions4.rkt line 30 col 19 - + - unboxed binary inexact complex
-unboxed-let-functions4.rkt line 30 col 18 - (#%app + x y) - unboxed inexact complex
+unboxed-let-functions4.rkt line 30 col 19 - + - unboxed binary float complex
+unboxed-let-functions4.rkt line 30 col 18 - (#%app + x y) - unboxed float complex
 unboxed-let-functions4.rkt line 29 col 32 - x - unboxed var -> table
 unboxed-let-functions4.rkt line 29 col 7 - f - unboxed function -> table
 unboxed-let-functions4.rkt line 29 col 7 - f - fun -> unboxed fun
 unboxed-let-functions4.rkt line 30 col 21 - x - leave var unboxed
 unboxed-let-functions4.rkt line 30 col 23 - y - float-coerce-expr in complex ops
-unboxed-let-functions4.rkt line 30 col 19 - + - unboxed binary inexact complex
-unboxed-let-functions4.rkt line 30 col 18 - (#%app + x y) - unboxed inexact complex
+unboxed-let-functions4.rkt line 30 col 19 - + - unboxed binary float complex
+unboxed-let-functions4.rkt line 30 col 18 - (#%app + x y) - unboxed float complex
 unboxed-let-functions4.rkt line 29 col 0 - (let-values (((f) (lambda (y x) (#%app + x y)))) (#%app f (quote 3.0) (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)))) - unboxed let bindings
 unboxed-let-functions4.rkt line 32 col 8 - 1.0+2.0i - unboxed literal
 unboxed-let-functions4.rkt line 32 col 17 - 2.0+4.0i - unboxed literal
-unboxed-let-functions4.rkt line 32 col 6 - + - unboxed binary inexact complex
+unboxed-let-functions4.rkt line 32 col 6 - + - unboxed binary float complex
 unboxed-let-functions4.rkt line 31 col 3 - f - unboxed call site
 unboxed-let-functions4.rkt line 31 col 3 - f - call to fun with unboxed args
 6.0+6.0i
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions5.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions5.rkt
index 64a08d9c..6ba6003f 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions5.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions5.rkt
@@ -4,8 +4,8 @@ unboxed-let-functions5.rkt line 20 col 22 - (let-values (((y) f)) x) - unboxed l
 unboxed-let-functions5.rkt line 18 col 0 - (letrec-values (((f) (lambda (x) (let-values (((y) f)) x)))) (#%app f (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)))) - unboxed let bindings
 unboxed-let-functions5.rkt line 22 col 15 - 1.0+2.0i - unboxed literal
 unboxed-let-functions5.rkt line 22 col 24 - 2.0+4.0i - unboxed literal
-unboxed-let-functions5.rkt line 22 col 13 - + - unboxed binary inexact complex
-unboxed-let-functions5.rkt line 22 col 12 - (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) - unboxed inexact complex
+unboxed-let-functions5.rkt line 22 col 13 - + - unboxed binary float complex
+unboxed-let-functions5.rkt line 22 col 12 - (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) - unboxed float complex
 3.0+6.0i
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt
index c9c70356..be9b6c72 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt
@@ -1,20 +1,20 @@
 #;
 (
-unboxed-let-functions6.rkt line 36 col 13 - z - unbox inexact-complex
+unboxed-let-functions6.rkt line 36 col 13 - z - unbox float-complex
 unboxed-let-functions6.rkt line 36 col 15 - 0.0+1.0i - unboxed literal
-unboxed-let-functions6.rkt line 36 col 11 - + - unboxed binary inexact complex
-unboxed-let-functions6.rkt line 36 col 10 - (#%app + z (quote 0.0+1.0i)) - unboxed inexact complex
+unboxed-let-functions6.rkt line 36 col 11 - + - unboxed binary float complex
+unboxed-let-functions6.rkt line 36 col 10 - (#%app + z (quote 0.0+1.0i)) - unboxed float complex
 unboxed-let-functions6.rkt line 33 col 31 - z - unboxed var -> table
 unboxed-let-functions6.rkt line 33 col 6 - loop - unboxed function -> table
 unboxed-let-functions6.rkt line 33 col 6 - loop - fun -> unboxed fun
 unboxed-let-functions6.rkt line 36 col 13 - z - leave var unboxed
 unboxed-let-functions6.rkt line 36 col 15 - 0.0+1.0i - unboxed literal
-unboxed-let-functions6.rkt line 36 col 11 - + - unboxed binary inexact complex
-unboxed-let-functions6.rkt line 36 col 10 - (#%app + z (quote 0.0+1.0i)) - unboxed inexact complex
+unboxed-let-functions6.rkt line 36 col 11 - + - unboxed binary float complex
+unboxed-let-functions6.rkt line 36 col 10 - (#%app + z (quote 0.0+1.0i)) - unboxed float complex
 unboxed-let-functions6.rkt line 37 col 19 - z - leave var unboxed
 unboxed-let-functions6.rkt line 37 col 22 - car - pair
 unboxed-let-functions6.rkt line 37 col 21 - (#%app car l) - float-coerce-expr in complex ops
-unboxed-let-functions6.rkt line 37 col 17 - + - unboxed binary inexact complex
+unboxed-let-functions6.rkt line 37 col 17 - + - unboxed binary float complex
 unboxed-let-functions6.rkt line 37 col 11 - loop - unboxed call site
 unboxed-let-functions6.rkt line 38 col 17 - cdr - pair
 unboxed-let-functions6.rkt line 37 col 11 - loop - call to fun with unboxed args
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt
index 6265f7d3..b6bf4de4 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt
@@ -1,10 +1,10 @@
 #;
 (
-unboxed-let-functions7.rkt line 35 col 15 - z - unbox inexact-complex
+unboxed-let-functions7.rkt line 35 col 15 - z - unbox float-complex
 unboxed-let-functions7.rkt line 35 col 18 - car - pair
 unboxed-let-functions7.rkt line 35 col 17 - (#%app car l) - float-coerce-expr in complex ops
-unboxed-let-functions7.rkt line 35 col 13 - + - unboxed binary inexact complex
-unboxed-let-functions7.rkt line 35 col 12 - (#%app + z (#%app car l)) - unboxed inexact complex
+unboxed-let-functions7.rkt line 35 col 13 - + - unboxed binary float complex
+unboxed-let-functions7.rkt line 35 col 12 - (#%app + z (#%app car l)) - unboxed float complex
 unboxed-let-functions7.rkt line 31 col 31 - z - unboxed var -> table
 unboxed-let-functions7.rkt line 31 col 6 - loop - unboxed function -> table
 unboxed-let-functions7.rkt line 31 col 6 - loop - fun -> unboxed fun
@@ -12,7 +12,7 @@ unboxed-let-functions7.rkt line 34 col 6 - z - unboxed complex variable
 unboxed-let-functions7.rkt line 35 col 15 - z - leave var unboxed
 unboxed-let-functions7.rkt line 35 col 18 - car - pair
 unboxed-let-functions7.rkt line 35 col 17 - (#%app car l) - float-coerce-expr in complex ops
-unboxed-let-functions7.rkt line 35 col 13 - + - unboxed binary inexact complex
+unboxed-let-functions7.rkt line 35 col 13 - + - unboxed binary float complex
 unboxed-let-functions7.rkt line 35 col 7 - loop - unboxed call site
 unboxed-let-functions7.rkt line 36 col 13 - cdr - pair
 unboxed-let-functions7.rkt line 35 col 7 - loop - call to fun with unboxed args
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions8.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions8.rkt
index 4a1c6eba..ad38880b 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions8.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions8.rkt
@@ -1,9 +1,9 @@
 #;
 (
-unboxed-let-functions8.rkt line 16 col 67 - x - unbox inexact-complex
+unboxed-let-functions8.rkt line 16 col 67 - x - unbox float-complex
 unboxed-let-functions8.rkt line 16 col 69 - 2.0+4.0i - unboxed literal
-unboxed-let-functions8.rkt line 16 col 65 - + - unboxed binary inexact complex
-unboxed-let-functions8.rkt line 16 col 64 - (#%app + x (quote 2.0+4.0i)) - unboxed inexact complex
+unboxed-let-functions8.rkt line 16 col 65 - + - unboxed binary float complex
+unboxed-let-functions8.rkt line 16 col 64 - (#%app + x (quote 2.0+4.0i)) - unboxed float complex
 unboxed-let-functions8.rkt line 16 col 0 - (letrec-values (((f) (lambda (x) (#%app + x (quote 2.0+4.0i)))) ((g) f)) (#%app f (quote 1.0+2.0i))) - unboxed let bindings
 3.0+6.0i
 )
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let.rkt
index 1d1c5b7d..47eb328a 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let.rkt
@@ -1,31 +1,31 @@
 #;
 (
-unboxed-let.rkt line 38 col 14 - t1 - unbox inexact-complex
+unboxed-let.rkt line 38 col 14 - t1 - unbox float-complex
 unboxed-let.rkt line 38 col 17 - 3.0+6.0i - unboxed literal
-unboxed-let.rkt line 38 col 12 - - - unboxed binary inexact complex
-unboxed-let.rkt line 38 col 11 - (#%app - t1 (quote 3.0+6.0i)) - unboxed inexact complex
+unboxed-let.rkt line 38 col 12 - - - unboxed binary float complex
+unboxed-let.rkt line 38 col 11 - (#%app - t1 (quote 3.0+6.0i)) - unboxed float complex
 unboxed-let.rkt line 37 col 14 - 1.0+2.0i - unboxed literal
 unboxed-let.rkt line 37 col 23 - 2.0+4.0i - unboxed literal
-unboxed-let.rkt line 37 col 12 - + - unboxed binary inexact complex
+unboxed-let.rkt line 37 col 12 - + - unboxed binary float complex
 unboxed-let.rkt line 37 col 0 - (let-values (((t1) (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)))) (let-values (((t2) (#%app - t1 (quote 3.0+6.0i)))) (let-values (((t3) (quote 4.0+8.0i))) (#%app + t2 t3)))) - unboxed let bindings
-unboxed-let.rkt line 40 col 5 - t2 - unbox inexact-complex
-unboxed-let.rkt line 40 col 8 - t3 - unbox inexact-complex
-unboxed-let.rkt line 40 col 3 - + - unboxed binary inexact complex
-unboxed-let.rkt line 40 col 2 - (#%app + t2 t3) - unboxed inexact complex
+unboxed-let.rkt line 40 col 5 - t2 - unbox float-complex
+unboxed-let.rkt line 40 col 8 - t3 - unbox float-complex
+unboxed-let.rkt line 40 col 3 - + - unboxed binary float complex
+unboxed-let.rkt line 40 col 2 - (#%app + t2 t3) - unboxed float complex
 unboxed-let.rkt line 38 col 14 - t1 - leave var unboxed
 unboxed-let.rkt line 38 col 17 - 3.0+6.0i - unboxed literal
-unboxed-let.rkt line 38 col 12 - - - unboxed binary inexact complex
+unboxed-let.rkt line 38 col 12 - - - unboxed binary float complex
 unboxed-let.rkt line 37 col 0 - (let-values (((t2) (#%app - t1 (quote 3.0+6.0i)))) (let-values (((t3) (quote 4.0+8.0i))) (#%app + t2 t3))) - unboxed let bindings
 unboxed-let.rkt line 40 col 5 - t2 - leave var unboxed
-unboxed-let.rkt line 40 col 8 - t3 - unbox inexact-complex
-unboxed-let.rkt line 40 col 3 - + - unboxed binary inexact complex
-unboxed-let.rkt line 40 col 2 - (#%app + t2 t3) - unboxed inexact complex
+unboxed-let.rkt line 40 col 8 - t3 - unbox float-complex
+unboxed-let.rkt line 40 col 3 - + - unboxed binary float complex
+unboxed-let.rkt line 40 col 2 - (#%app + t2 t3) - unboxed float complex
 unboxed-let.rkt line 39 col 11 - 4.0+8.0i - unboxed literal
 unboxed-let.rkt line 37 col 0 - (let-values (((t3) (quote 4.0+8.0i))) (#%app + t2 t3)) - unboxed let bindings
 unboxed-let.rkt line 40 col 5 - t2 - leave var unboxed
 unboxed-let.rkt line 40 col 8 - t3 - leave var unboxed
-unboxed-let.rkt line 40 col 3 - + - unboxed binary inexact complex
-unboxed-let.rkt line 40 col 2 - (#%app + t2 t3) - unboxed inexact complex
+unboxed-let.rkt line 40 col 3 - + - unboxed binary float complex
+unboxed-let.rkt line 40 col 2 - (#%app + t2 t3) - unboxed float complex
 4.0+8.0i
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let2.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let2.rkt
index b80bab26..55f51c6b 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let2.rkt
@@ -1,24 +1,24 @@
 #;
 (
-unboxed-let2.rkt line 32 col 5 - t1 - unbox inexact-complex
-unboxed-let2.rkt line 32 col 8 - t2 - unbox inexact-complex
-unboxed-let2.rkt line 32 col 3 - + - unboxed binary inexact complex
-unboxed-let2.rkt line 32 col 2 - (#%app + t1 t2) - unboxed inexact complex
-unboxed-let2.rkt line 32 col 5 - t1 - unbox inexact-complex
-unboxed-let2.rkt line 32 col 8 - t2 - unbox inexact-complex
-unboxed-let2.rkt line 32 col 3 - + - unboxed binary inexact complex
-unboxed-let2.rkt line 32 col 2 - (#%app + t1 t2) - unboxed inexact complex
+unboxed-let2.rkt line 32 col 5 - t1 - unbox float-complex
+unboxed-let2.rkt line 32 col 8 - t2 - unbox float-complex
+unboxed-let2.rkt line 32 col 3 - + - unboxed binary float complex
+unboxed-let2.rkt line 32 col 2 - (#%app + t1 t2) - unboxed float complex
+unboxed-let2.rkt line 32 col 5 - t1 - unbox float-complex
+unboxed-let2.rkt line 32 col 8 - t2 - unbox float-complex
+unboxed-let2.rkt line 32 col 3 - + - unboxed binary float complex
+unboxed-let2.rkt line 32 col 2 - (#%app + t1 t2) - unboxed float complex
 unboxed-let2.rkt line 30 col 13 - 1.0+2.0i - unboxed literal
 unboxed-let2.rkt line 30 col 22 - 2.0+4.0i - unboxed literal
-unboxed-let2.rkt line 30 col 11 - + - unboxed binary inexact complex
+unboxed-let2.rkt line 30 col 11 - + - unboxed binary float complex
 unboxed-let2.rkt line 31 col 13 - 3.0+6.0i - unboxed literal
 unboxed-let2.rkt line 31 col 22 - 4.0+8.0i - unboxed literal
-unboxed-let2.rkt line 31 col 11 - + - unboxed binary inexact complex
+unboxed-let2.rkt line 31 col 11 - + - unboxed binary float complex
 unboxed-let2.rkt line 30 col 0 - (let-values (((t1) (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i))) ((t2) (#%app + (quote 3.0+6.0i) (quote 4.0+8.0i)))) (#%app + t1 t2)) - unboxed let bindings
 unboxed-let2.rkt line 32 col 5 - t1 - leave var unboxed
 unboxed-let2.rkt line 32 col 8 - t2 - leave var unboxed
-unboxed-let2.rkt line 32 col 3 - + - unboxed binary inexact complex
-unboxed-let2.rkt line 32 col 2 - (#%app + t1 t2) - unboxed inexact complex
+unboxed-let2.rkt line 32 col 3 - + - unboxed binary float complex
+unboxed-let2.rkt line 32 col 2 - (#%app + t1 t2) - unboxed float complex
 10.0+20.0i
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let3.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let3.rkt
index d55d7e95..d323037d 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let3.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let3.rkt
@@ -1,18 +1,18 @@
 #;
 (
-unboxed-let3.rkt line 34 col 9 - x - unbox inexact-complex
+unboxed-let3.rkt line 34 col 9 - x - unbox float-complex
 unboxed-let3.rkt line 34 col 11 - 2.0+4.0i - unboxed literal
-unboxed-let3.rkt line 34 col 7 - + - unboxed binary inexact complex
-unboxed-let3.rkt line 34 col 6 - (#%app + x (quote 2.0+4.0i)) - unboxed inexact complex
+unboxed-let3.rkt line 34 col 7 - + - unboxed binary float complex
+unboxed-let3.rkt line 34 col 6 - (#%app + x (quote 2.0+4.0i)) - unboxed float complex
 unboxed-let3.rkt line 31 col 12 - 1.0+2.0i - unboxed literal
 unboxed-let3.rkt line 31 col 21 - 2.0+4.0i - unboxed literal
-unboxed-let3.rkt line 31 col 10 - + - unboxed binary inexact complex
+unboxed-let3.rkt line 31 col 10 - + - unboxed binary float complex
 unboxed-let3.rkt line 31 col 0 - (let-values (((x) (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)))) (if (#%app even? (quote 2)) x (#%app + x (quote 2.0+4.0i)))) - unboxed let bindings
 unboxed-let3.rkt line 33 col 6 - x - unboxed complex variable
 unboxed-let3.rkt line 34 col 9 - x - leave var unboxed
 unboxed-let3.rkt line 34 col 11 - 2.0+4.0i - unboxed literal
-unboxed-let3.rkt line 34 col 7 - + - unboxed binary inexact complex
-unboxed-let3.rkt line 34 col 6 - (#%app + x (quote 2.0+4.0i)) - unboxed inexact complex
+unboxed-let3.rkt line 34 col 7 - + - unboxed binary float complex
+unboxed-let3.rkt line 34 col 6 - (#%app + x (quote 2.0+4.0i)) - unboxed float complex
 3.0+6.0i
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec-syntaxes+values.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec-syntaxes+values.rkt
index 5c4dfd1b..582ee688 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec-syntaxes+values.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec-syntaxes+values.rkt
@@ -1,17 +1,17 @@
 #;
 (
-unboxed-letrec-syntaxes+values.rkt line 25 col 27 - x - unbox inexact-complex
+unboxed-letrec-syntaxes+values.rkt line 25 col 27 - x - unbox float-complex
 unboxed-letrec-syntaxes+values.rkt line 25 col 29 - 2.0+4.0i - unboxed literal
-unboxed-letrec-syntaxes+values.rkt line 25 col 25 - + - unboxed binary inexact complex
-unboxed-letrec-syntaxes+values.rkt line 25 col 24 - (#%app + x (quote 2.0+4.0i)) - unboxed inexact complex
+unboxed-letrec-syntaxes+values.rkt line 25 col 25 - + - unboxed binary float complex
+unboxed-letrec-syntaxes+values.rkt line 25 col 24 - (#%app + x (quote 2.0+4.0i)) - unboxed float complex
 unboxed-letrec-syntaxes+values.rkt line 24 col 33 - 1.0+2.0i - unboxed literal
 unboxed-letrec-syntaxes+values.rkt line 24 col 42 - 2.0+4.0i - unboxed literal
-unboxed-letrec-syntaxes+values.rkt line 24 col 31 - + - unboxed binary inexact complex
+unboxed-letrec-syntaxes+values.rkt line 24 col 31 - + - unboxed binary float complex
 unboxed-letrec-syntaxes+values.rkt line 23 col 0 - (letrec-syntaxes+values (((s) (syntax-rules () ((_ x) x)))) (((x) (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)))) (#%app + x (quote 2.0+4.0i))) - unboxed let bindings
 unboxed-letrec-syntaxes+values.rkt line 25 col 27 - x - leave var unboxed
 unboxed-letrec-syntaxes+values.rkt line 25 col 29 - 2.0+4.0i - unboxed literal
-unboxed-letrec-syntaxes+values.rkt line 25 col 25 - + - unboxed binary inexact complex
-unboxed-letrec-syntaxes+values.rkt line 25 col 24 - (#%app + x (quote 2.0+4.0i)) - unboxed inexact complex
+unboxed-letrec-syntaxes+values.rkt line 25 col 25 - + - unboxed binary float complex
+unboxed-letrec-syntaxes+values.rkt line 25 col 24 - (#%app + x (quote 2.0+4.0i)) - unboxed float complex
 5.0+10.0i
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec.rkt
index 8e41a8bf..0b67b172 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-letrec.rkt
@@ -1,22 +1,22 @@
 #;
 (
-unboxed-letrec.rkt line 31 col 5 - x - unbox inexact-complex
-unboxed-letrec.rkt line 31 col 7 - y - unbox inexact-complex
-unboxed-letrec.rkt line 31 col 3 - + - unboxed binary inexact complex
-unboxed-letrec.rkt line 31 col 2 - (#%app + x y) - unboxed inexact complex
-unboxed-letrec.rkt line 31 col 5 - x - unbox inexact-complex
-unboxed-letrec.rkt line 31 col 7 - y - unbox inexact-complex
-unboxed-letrec.rkt line 31 col 3 - + - unboxed binary inexact complex
-unboxed-letrec.rkt line 31 col 2 - (#%app + x y) - unboxed inexact complex
+unboxed-letrec.rkt line 31 col 5 - x - unbox float-complex
+unboxed-letrec.rkt line 31 col 7 - y - unbox float-complex
+unboxed-letrec.rkt line 31 col 3 - + - unboxed binary float complex
+unboxed-letrec.rkt line 31 col 2 - (#%app + x y) - unboxed float complex
+unboxed-letrec.rkt line 31 col 5 - x - unbox float-complex
+unboxed-letrec.rkt line 31 col 7 - y - unbox float-complex
+unboxed-letrec.rkt line 31 col 3 - + - unboxed binary float complex
+unboxed-letrec.rkt line 31 col 2 - (#%app + x y) - unboxed float complex
 unboxed-letrec.rkt line 29 col 31 - 1.0+2.0i - unboxed literal
 unboxed-letrec.rkt line 30 col 34 - 2.0+4.0i - unboxed literal
 unboxed-letrec.rkt line 30 col 43 - 3.0+6.0i - unboxed literal
-unboxed-letrec.rkt line 30 col 32 - + - unboxed binary inexact complex
+unboxed-letrec.rkt line 30 col 32 - + - unboxed binary float complex
 unboxed-letrec.rkt line 28 col 0 - (letrec-values (((f) (lambda (x) (#%app f x))) ((x) (quote 1.0+2.0i)) ((y) (#%app + (quote 2.0+4.0i) (quote 3.0+6.0i)))) (#%app + x y)) - unboxed let bindings
 unboxed-letrec.rkt line 31 col 5 - x - leave var unboxed
 unboxed-letrec.rkt line 31 col 7 - y - leave var unboxed
-unboxed-letrec.rkt line 31 col 3 - + - unboxed binary inexact complex
-unboxed-letrec.rkt line 31 col 2 - (#%app + x y) - unboxed inexact complex
+unboxed-letrec.rkt line 31 col 3 - + - unboxed binary float complex
+unboxed-letrec.rkt line 31 col 2 - (#%app + x y) - unboxed float complex
 6.0+12.0i
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-make-rectangular.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-make-rectangular.rkt
index 6cd9a776..344a6519 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-make-rectangular.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-make-rectangular.rkt
@@ -1,25 +1,25 @@
 #;
 (
-unboxed-make-rectangular.rkt line 33 col 5 - x - unbox inexact-complex
+unboxed-make-rectangular.rkt line 33 col 5 - x - unbox float-complex
 unboxed-make-rectangular.rkt line 33 col 7 - 2.0+4.0i - unboxed literal
-unboxed-make-rectangular.rkt line 33 col 3 - + - unboxed binary inexact complex
-unboxed-make-rectangular.rkt line 33 col 2 - (#%app + x (quote 2.0+4.0i)) - unboxed inexact complex
+unboxed-make-rectangular.rkt line 33 col 3 - + - unboxed binary float complex
+unboxed-make-rectangular.rkt line 33 col 2 - (#%app + x (quote 2.0+4.0i)) - unboxed float complex
 unboxed-make-rectangular.rkt line 32 col 10 - make-rectangular - make-rectangular elimination
 unboxed-make-rectangular.rkt line 32 col 0 - (let-values (((x) (#%app make-rectangular (quote 1.0) (quote 2.0)))) (#%app + x (quote 2.0+4.0i))) - unboxed let bindings
 unboxed-make-rectangular.rkt line 33 col 5 - x - leave var unboxed
 unboxed-make-rectangular.rkt line 33 col 7 - 2.0+4.0i - unboxed literal
-unboxed-make-rectangular.rkt line 33 col 3 - + - unboxed binary inexact complex
-unboxed-make-rectangular.rkt line 33 col 2 - (#%app + x (quote 2.0+4.0i)) - unboxed inexact complex
-unboxed-make-rectangular.rkt line 35 col 5 - x - unbox inexact-complex
+unboxed-make-rectangular.rkt line 33 col 3 - + - unboxed binary float complex
+unboxed-make-rectangular.rkt line 33 col 2 - (#%app + x (quote 2.0+4.0i)) - unboxed float complex
+unboxed-make-rectangular.rkt line 35 col 5 - x - unbox float-complex
 unboxed-make-rectangular.rkt line 35 col 7 - 2.0+4.0i - unboxed literal
-unboxed-make-rectangular.rkt line 35 col 3 - + - unboxed binary inexact complex
-unboxed-make-rectangular.rkt line 35 col 2 - (#%app + x (quote 2.0+4.0i)) - unboxed inexact complex
+unboxed-make-rectangular.rkt line 35 col 3 - + - unboxed binary float complex
+unboxed-make-rectangular.rkt line 35 col 2 - (#%app + x (quote 2.0+4.0i)) - unboxed float complex
 unboxed-make-rectangular.rkt line 34 col 10 - unsafe-make-flrectangular - make-rectangular elimination
 unboxed-make-rectangular.rkt line 34 col 0 - (let-values (((x) (#%app unsafe-make-flrectangular (quote 1.0) (quote 2.0)))) (#%app + x (quote 2.0+4.0i))) - unboxed let bindings
 unboxed-make-rectangular.rkt line 35 col 5 - x - leave var unboxed
 unboxed-make-rectangular.rkt line 35 col 7 - 2.0+4.0i - unboxed literal
-unboxed-make-rectangular.rkt line 35 col 3 - + - unboxed binary inexact complex
-unboxed-make-rectangular.rkt line 35 col 2 - (#%app + x (quote 2.0+4.0i)) - unboxed inexact complex
+unboxed-make-rectangular.rkt line 35 col 3 - + - unboxed binary float complex
+unboxed-make-rectangular.rkt line 35 col 2 - (#%app + x (quote 2.0+4.0i)) - unboxed float complex
 3.0+6.0i
 3.0+6.0i
 )
diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
index ec6c555c..55120943 100644
--- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
+++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
@@ -855,9 +855,9 @@
    (tc-l -5.0 -Flonum)
    (tc-l -5.1 -Flonum)
    (tc-l 1+1i N)
-   (tc-l 1+1.0i -InexactComplex)
-   (tc-l 1.0+1i -InexactComplex)
-   (tc-l 1.0+1.1i -InexactComplex)
+   (tc-l 1+1.0i -FloatComplex)
+   (tc-l 1.0+1i -FloatComplex)
+   (tc-l 1.0+1.1i -FloatComplex)
    (tc-l #t (-val #t))
    (tc-l "foo" -String)
    (tc-l foo (-val 'foo))
diff --git a/collects/typed-scheme/optimizer/float-complex.rkt b/collects/typed-scheme/optimizer/float-complex.rkt
index 31bc734b..7c74f889 100644
--- a/collects/typed-scheme/optimizer/float-complex.rkt
+++ b/collects/typed-scheme/optimizer/float-complex.rkt
@@ -6,10 +6,10 @@
          (types abbrev)
          (optimizer utils float))
 
-(provide inexact-complex-opt-expr
-         inexact-complex-arith-opt-expr
-         unboxed-inexact-complex-opt-expr
-         inexact-complex-call-site-opt-expr
+(provide float-complex-opt-expr
+         float-complex-arith-opt-expr
+         unboxed-float-complex-opt-expr
+         float-complex-call-site-opt-expr
          unboxed-vars-table unboxed-funs-table)
 
 
@@ -30,18 +30,18 @@
 ;; its parts than it is to use generic operations
 ;; we keep the real and imaginary parts unboxed as long as we stay within
 ;; complex operations
-(define-syntax-class unboxed-inexact-complex-opt-expr
+(define-syntax-class unboxed-float-complex-opt-expr
   #:commit
 
   (pattern (#%plain-app (~and op (~literal +))
-                        c1:unboxed-inexact-complex-opt-expr
-                        c2:unboxed-inexact-complex-opt-expr
-                        cs:unboxed-inexact-complex-opt-expr ...)
-           #:when (isoftype? this-syntax -InexactComplex)
+                        c1:unboxed-float-complex-opt-expr
+                        c2:unboxed-float-complex-opt-expr
+                        cs:unboxed-float-complex-opt-expr ...)
+           #:when (isoftype? this-syntax -FloatComplex)
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with (bindings ...)
-           (begin (log-optimization "unboxed binary inexact complex" #'op)
+           (begin (log-optimization "unboxed binary float complex" #'op)
                   #`(#,@(append (syntax->list #'(c1.bindings ... c2.bindings ... cs.bindings ... ...))
                                 (let ()
                                    ;; we can skip the real parts of imaginaries (#f) and vice versa
@@ -59,14 +59,14 @@
                                     #`((imag-binding) #,(skip-0s #'(c1.imag-binding c2.imag-binding cs.imag-binding ...)))))))))
   
   (pattern (#%plain-app (~and op (~literal -))
-                        c1:unboxed-inexact-complex-opt-expr
-                        c2:unboxed-inexact-complex-opt-expr
-                        cs:unboxed-inexact-complex-opt-expr ...)
-           #:when (isoftype? this-syntax -InexactComplex)
+                        c1:unboxed-float-complex-opt-expr
+                        c2:unboxed-float-complex-opt-expr
+                        cs:unboxed-float-complex-opt-expr ...)
+           #:when (isoftype? this-syntax -FloatComplex)
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with (bindings ...)
-           (begin (log-optimization "unboxed binary inexact complex" #'op)
+           (begin (log-optimization "unboxed binary float complex" #'op)
                   #`(#,@(append (syntax->list #'(c1.bindings ... c2.bindings ... cs.bindings ... ...))
                                 (let ()
                                   ;; unlike addition, we simply can't skip real parts of imaginaries
@@ -87,14 +87,14 @@
                                    #`((imag-binding) #,(skip-0s #'(c1.imag-binding c2.imag-binding cs.imag-binding ...)))))))))
   
   (pattern (#%plain-app (~and op (~literal *))
-                        c1:unboxed-inexact-complex-opt-expr
-                        c2:unboxed-inexact-complex-opt-expr
-                        cs:unboxed-inexact-complex-opt-expr ...)
-           #:when (or (isoftype? this-syntax -InexactComplex) (isoftype? this-syntax -Number))
+                        c1:unboxed-float-complex-opt-expr
+                        c2:unboxed-float-complex-opt-expr
+                        cs:unboxed-float-complex-opt-expr ...)
+           #:when (or (isoftype? this-syntax -FloatComplex) (isoftype? this-syntax -Number))
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with (bindings ...)
-           (begin (log-optimization "unboxed binary inexact complex" #'op)
+           (begin (log-optimization "unboxed binary float complex" #'op)
                   #`(c1.bindings ... c2.bindings ... cs.bindings ... ...
                      ;; we want to bind the intermediate results to reuse them
                      ;; the final results are bound to real-binding and imag-binding
@@ -136,10 +136,10 @@
                                              res)))))))))
   
   (pattern (#%plain-app (~and op (~literal /))
-                        c1:unboxed-inexact-complex-opt-expr
-                        c2:unboxed-inexact-complex-opt-expr
-                        cs:unboxed-inexact-complex-opt-expr ...)
-           #:when (or (isoftype? this-syntax -InexactComplex) (isoftype? this-syntax -Number))
+                        c1:unboxed-float-complex-opt-expr
+                        c2:unboxed-float-complex-opt-expr
+                        cs:unboxed-float-complex-opt-expr ...)
+           #:when (or (isoftype? this-syntax -FloatComplex) (isoftype? this-syntax -Number))
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with reals (map (lambda (x) (if (syntax->datum x) x #'0.0))
@@ -147,7 +147,7 @@
            #:with imags (map (lambda (x) (if (syntax->datum x) x #'0.0))
                              (syntax->list #'(c1.imag-binding c2.imag-binding cs.imag-binding ...)))
            #:with (bindings ...)
-           (begin (log-optimization "unboxed binary inexact complex" #'op)
+           (begin (log-optimization "unboxed binary float complex" #'op)
                   #`(c1.bindings ... c2.bindings ... cs.bindings ... ...
                      ;; we want to bind the intermediate results to reuse them
                      ;; the final results are bound to real-binding and imag-binding
@@ -206,38 +206,38 @@
                                                              (unsafe-fl* #,(car e2) #,(car e2))))
                                               res)]))))))))
 
-  (pattern (#%plain-app (~and op (~literal conjugate)) c:unboxed-inexact-complex-opt-expr)
-           #:when (isoftype? this-syntax -InexactComplex)
+  (pattern (#%plain-app (~and op (~literal conjugate)) c:unboxed-float-complex-opt-expr)
+           #:when (isoftype? this-syntax -FloatComplex)
            #:with real-binding #'c.real-binding
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with (bindings ...)
-           (begin (log-optimization "unboxed unary inexact complex" #'op)
+           (begin (log-optimization "unboxed unary float complex" #'op)
                   #`(#,@(append (syntax->list #'(c.bindings ...))
                                 (list #'((imag-binding) (unsafe-fl- 0.0 c.imag-binding)))))))
   
-  (pattern (#%plain-app (~and op (~literal magnitude)) c:unboxed-inexact-complex-opt-expr)
+  (pattern (#%plain-app (~and op (~literal magnitude)) c:unboxed-float-complex-opt-expr)
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding #f
            #:with (bindings ...)
-           (begin (log-optimization "unboxed unary inexact complex" #'op)
+           (begin (log-optimization "unboxed unary float complex" #'op)
                   #`(c.bindings ...
                      ((real-binding) (unsafe-flsqrt 
                                       (unsafe-fl+ (unsafe-fl* c.real-binding c.real-binding) 
                                                   (unsafe-fl* c.imag-binding c.imag-binding)))))))
   
   (pattern (#%plain-app (~and op (~or (~literal real-part) (~literal unsafe-flreal-part)))
-                        c:unboxed-inexact-complex-opt-expr)
+                        c:unboxed-float-complex-opt-expr)
            #:with real-binding #'c.real-binding
            #:with imag-binding #f
            #:with (bindings ...)
-           (begin (log-optimization "unboxed unary inexact complex" #'op)
+           (begin (log-optimization "unboxed unary float complex" #'op)
                   #'(c.bindings ...)))
   (pattern (#%plain-app (~and op (~or (~literal imag-part) (~literal unsafe-flimag-part)))
-                        c:unboxed-inexact-complex-opt-expr)
+                        c:unboxed-float-complex-opt-expr)
            #:with real-binding #'c.imag-binding
            #:with imag-binding #f
            #:with (bindings ...)
-           (begin (log-optimization "unboxed unary inexact complex" #'op)
+           (begin (log-optimization "unboxed unary float complex" #'op)
                   #'(c.bindings ...)))
   
   ;; special handling of reals inside complex operations
@@ -312,12 +312,12 @@
                                         (exact->inexact (syntax->datum #'n)))))))
   
   (pattern e:expr
-           #:when (isoftype? #'e -InexactComplex)
+           #:when (isoftype? #'e -FloatComplex)
            #:with e* (unboxed-gensym)
            #:with real-binding (unboxed-gensym "unboxed-real-")
            #:with imag-binding (unboxed-gensym "unboxed-imag-")
            #:with (bindings ...)
-           (begin (log-optimization "unbox inexact-complex" #'e)
+           (begin (log-optimization "unbox float-complex" #'e)
                   #`(((e*) #,((optimize) #'e))
                      ((real-binding) (unsafe-flreal-part e*))
                      ((imag-binding) (unsafe-flimag-part e*)))))
@@ -337,38 +337,38 @@
            #:with real-binding #f
            #:with imag-binding #f))
 
-(define-syntax-class inexact-complex-unary-op
+(define-syntax-class float-complex-unary-op
   #:commit
   (pattern (~or (~literal real-part) (~literal flreal-part)) #:with unsafe #'unsafe-flreal-part)
   (pattern (~or (~literal imag-part) (~literal flimag-part)) #:with unsafe #'unsafe-flimag-part))
 
-(define-syntax-class inexact-complex-op
+(define-syntax-class float-complex-op
   #:commit
   (pattern (~or (~literal +) (~literal -) (~literal *) (~literal /) (~literal conjugate))))
 
-(define-syntax-class inexact-complex->float-op
+(define-syntax-class float-complex->float-op
   #:commit
   (pattern (~or (~literal magnitude)
                 (~literal real-part) (~literal flreal-part) (~literal unsafe-flreal-part)
                 (~literal imag-part) (~literal flimag-part) (~literal unsafe-flimag-part))))
 
-(define-syntax-class inexact-complex-expr
+(define-syntax-class float-complex-expr
   #:commit
   (pattern e:expr
-           #:when (isoftype? #'e -InexactComplex)
+           #:when (isoftype? #'e -FloatComplex)
            #:with opt ((optimize) #'e)))
 
-(define-syntax-class inexact-complex-opt-expr
+(define-syntax-class float-complex-opt-expr
   #:commit
 
   ;; we can optimize taking the real of imag part of an unboxed complex
   ;; hopefully, the compiler can eliminate unused bindings for the other part if it's not used
   (pattern (#%plain-app (~and op (~or (~literal real-part) (~literal flreal-part) (~literal unsafe-flreal-part)
                                       (~literal imag-part) (~literal flimag-part) (~literal unsafe-flimag-part)))
-                        c:inexact-complex-expr)
-           #:with c*:unboxed-inexact-complex-opt-expr #'c
+                        c:float-complex-expr)
+           #:with c*:unboxed-float-complex-opt-expr #'c
            #:with opt
-           (begin (log-optimization "unboxed inexact complex" #'op)
+           (begin (log-optimization "unboxed float complex" #'op)
                   (reset-unboxed-gensym)
                   #`(let*-values (c*.bindings ...)
                       #,(if (or (free-identifier=? #'op #'real-part)
@@ -377,14 +377,14 @@
                             #'c*.real-binding
                             #'c*.imag-binding))))
   
-  (pattern (#%plain-app op:inexact-complex-unary-op n:inexact-complex-expr)
+  (pattern (#%plain-app op:float-complex-unary-op n:float-complex-expr)
            #:with opt
-           (begin (log-optimization "unary inexact complex" #'op)
+           (begin (log-optimization "unary float complex" #'op)
                   #'(op.unsafe n.opt)))
 
   (pattern (#%plain-app (~and op (~literal make-polar)) r theta)
-           #:when (isoftype? this-syntax -InexactComplex)
-           #:with exp*:unboxed-inexact-complex-opt-expr this-syntax
+           #:when (isoftype? this-syntax -FloatComplex)
+           #:with exp*:unboxed-float-complex-opt-expr this-syntax
            #:with opt
            (begin (log-optimization "make-polar" #'op)
                   (reset-unboxed-gensym)
@@ -395,39 +395,39 @@
   (pattern (#%plain-app op:id args:expr ...)
            #:with unboxed-info (dict-ref unboxed-funs-table #'op #f)
            #:when (syntax->datum #'unboxed-info)
-           #:with (~var e* (inexact-complex-call-site-opt-expr
+           #:with (~var e* (float-complex-call-site-opt-expr
                             #'unboxed-info #'op)) ; no need to optimize op
            this-syntax
            #:with opt
            (begin (log-optimization "call to fun with unboxed args" #'op)
                   #'e*.opt))
   
-  (pattern e:inexact-complex-arith-opt-expr
+  (pattern e:float-complex-arith-opt-expr
            #:with opt #'e.opt))
 
-(define-syntax-class inexact-complex-arith-opt-expr
+(define-syntax-class float-complex-arith-opt-expr
   #:commit
   
-  (pattern (#%plain-app op:inexact-complex->float-op e:expr ...)
+  (pattern (#%plain-app op:float-complex->float-op e:expr ...)
            #:when (subtypeof? this-syntax -Flonum)
-           #:with exp*:unboxed-inexact-complex-opt-expr this-syntax
+           #:with exp*:unboxed-float-complex-opt-expr this-syntax
            #:with real-binding #'exp*.real-binding
            #:with imag-binding #f
            #:with (bindings ...) #'(exp*.bindings ...)
            #:with opt
-           (begin (log-optimization "unboxed inexact complex->float" this-syntax)
+           (begin (log-optimization "unboxed float complex->float" this-syntax)
                   (reset-unboxed-gensym)
                   #'(let*-values (exp*.bindings ...)
                       real-binding)))
 
-  (pattern (#%plain-app op:inexact-complex-op e:expr ...)
-           #:when (isoftype? this-syntax -InexactComplex)
-           #:with exp*:unboxed-inexact-complex-opt-expr this-syntax
+  (pattern (#%plain-app op:float-complex-op e:expr ...)
+           #:when (isoftype? this-syntax -FloatComplex)
+           #:with exp*:unboxed-float-complex-opt-expr this-syntax
            #:with real-binding #'exp*.real-binding
            #:with imag-binding #'exp*.imag-binding
            #:with (bindings ...) #'(exp*.bindings ...)
            #:with opt
-           (begin (log-optimization "unboxed inexact complex" this-syntax)
+           (begin (log-optimization "unboxed float complex" this-syntax)
                   (reset-unboxed-gensym)
                   #'(let*-values (exp*.bindings ...)
                       (unsafe-make-flrectangular exp*.real-binding exp*.imag-binding))))
@@ -435,7 +435,7 @@
   (pattern v:id
            #:with unboxed-info (dict-ref unboxed-vars-table #'v #f)
            #:when (syntax->datum #'unboxed-info)
-           #:when (subtypeof? #'v -InexactComplex)
+           #:when (subtypeof? #'v -FloatComplex)
            #:with real-binding (car  (syntax->list #'unboxed-info))
            #:with imag-binding (cadr (syntax->list #'unboxed-info))
            #:with (bindings ...) #'()
@@ -448,7 +448,7 @@
 ;; takes as argument a structure describing which arguments will be unboxed
 ;; and the optimized version of the operator. operators are optimized elsewhere
 ;; to benefit from local information
-(define-syntax-class (inexact-complex-call-site-opt-expr unboxed-info opt-operator)
+(define-syntax-class (float-complex-call-site-opt-expr unboxed-info opt-operator)
   #:commit
   ;; call site of a function with unboxed parameters
   ;; the calling convention is: real parts of unboxed, imag parts, boxed
@@ -460,7 +460,7 @@
                  (boxed   (syntax->datum #'(boxed ...))))
              (define (get-arg i) (list-ref args i))
              (syntax-parse (map get-arg unboxed)
-               [(e:unboxed-inexact-complex-opt-expr ...)
+               [(e:unboxed-float-complex-opt-expr ...)
                 (log-optimization "unboxed call site" #'op)
                 (reset-unboxed-gensym)
                 #`(let*-values (e.bindings ... ...)
diff --git a/collects/typed-scheme/optimizer/float.rkt b/collects/typed-scheme/optimizer/float.rkt
index f91ec25a..058ec28b 100644
--- a/collects/typed-scheme/optimizer/float.rkt
+++ b/collects/typed-scheme/optimizer/float.rkt
@@ -115,7 +115,7 @@
            #:with opt
            (begin (log-optimization "int to float" #'op)
                   #'(->fl n.opt)))
-  ;; we can get rid of it altogether if we're giving it an inexact number
+  ;; we can get rid of it altogether if we're giving it a float
   (pattern (#%plain-app (~and op (~literal exact->inexact)) f:float-expr)
            #:with opt
            (begin (log-optimization "float to float" #'op)
diff --git a/collects/typed-scheme/optimizer/optimizer.rkt b/collects/typed-scheme/optimizer/optimizer.rkt
index ac792fe0..8de8b5b0 100644
--- a/collects/typed-scheme/optimizer/optimizer.rkt
+++ b/collects/typed-scheme/optimizer/optimizer.rkt
@@ -4,7 +4,7 @@
          racket/pretty
          (for-template scheme/base)
          "../utils/utils.rkt"
-         (optimizer utils number fixnum float inexact-complex vector string
+         (optimizer utils number fixnum float float-complex vector string
                     pair sequence box struct dead-code apply unboxed-let))
 
 (provide optimize-top)
@@ -26,7 +26,7 @@
   (pattern e:number-opt-expr          #:with opt #'e.opt)
   (pattern e:fixnum-opt-expr          #:with opt #'e.opt)
   (pattern e:float-opt-expr           #:with opt #'e.opt)
-  (pattern e:inexact-complex-opt-expr #:with opt #'e.opt)
+  (pattern e:float-complex-opt-expr   #:with opt #'e.opt)
   (pattern e:vector-opt-expr          #:with opt #'e.opt)
   (pattern e:string-opt-expr          #:with opt #'e.opt)
   (pattern e:pair-opt-expr            #:with opt #'e.opt)
diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index c8baa000..16764d85 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -7,7 +7,7 @@
          (for-template scheme/base)
          (types abbrev utils type-table)
          (rep type-rep)
-         (optimizer utils inexact-complex))
+         (optimizer utils float-complex))
 
 (provide unboxed-let-opt-expr)
 
@@ -35,7 +35,7 @@
            #:with (~var operator (unboxed-let-opt-expr-internal #t)) #'let-e
            #:with unboxed-info (dict-ref unboxed-funs-table #'loop-fun #f)
            #:when (syntax->datum #'unboxed-info)
-           #:with (~var e* (inexact-complex-call-site-opt-expr
+           #:with (~var e* (float-complex-call-site-opt-expr
                             #'unboxed-info #'operator.opt))
            this-syntax
            #:with opt
@@ -59,12 +59,12 @@
                  ;; clauses of form ((v) rhs), currently only supports 1 lhs var
                  (partition
                   (lambda (p)
-                    (and (isoftype? (cadr p) -InexactComplex)
+                    (and (isoftype? (cadr p) -FloatComplex)
                          (could-be-unboxed-in? (car (syntax-e (car p)))
                                                #'(begin body ...))))
                   (map syntax->list (syntax->list #'(clause ...)))))
                 ((function-candidates others)
-                 ;; extract function bindings that have inexact-complex arguments
+                 ;; extract function bindings that have float-complex arguments
                  ;; we may be able to pass arguments unboxed
                  ;; this covers loop variables
                  (partition
@@ -84,7 +84,7 @@
                                                                (and rests #f)
                                                                (and drests #f)
                                                                (and kws '())))))
-                           ;; at least 1 argument has to be of type inexact-complex
+                           ;; at least 1 argument has to be of type float-complex
                            ;; and can be unboxed
                            (syntax-parse (cadr p)
                              [((~literal #%plain-lambda) params body ...)
@@ -107,7 +107,7 @@
                                             (dict-set! unboxed-funs-table fun-name
                                                        (list (reverse unboxed)
                                                              (reverse boxed))))]
-                                      [(and (equal? (car doms) -InexactComplex)
+                                      [(and (equal? (car doms) -FloatComplex)
                                             (could-be-unboxed-in?
                                              (car params) #'(begin body ...)))
                                        ;; we can unbox
@@ -169,7 +169,7 @@
       #:literal-sets (kernel-literals)
       
       ;; can be used in a complex arithmetic expr, can be a direct child
-      [exp:inexact-complex-arith-opt-expr
+      [exp:float-complex-arith-opt-expr
        #:when (not (identifier? #'exp))
        (or (direct-child-of? v #'exp)
            (ormap rec (syntax->list #'exp)))]
@@ -212,7 +212,7 @@
 
 ;; very simple escape analysis for functions
 ;; if a function is ever used in a non-operator position, we consider it escapes
-;; if it doesn't escape, we may be able to pass its inexact complex args unboxed
+;; if it doesn't escape, we may be able to pass its float complex args unboxed
 ;; if we are in a let loop, don't consider functions that escape by being the
 ;; sole thing in the let's body as escaping, since they would only escape to
 ;; a call site that we control, which is fine
@@ -266,13 +266,13 @@
 ;; let clause whose rhs is going to be unboxed (turned into multiple bindings)
 (define-syntax-class unboxed-let-clause
   #:commit
-  (pattern ((v:id) rhs:unboxed-inexact-complex-opt-expr)
+  (pattern ((v:id) rhs:unboxed-float-complex-opt-expr)
            #:with id #'v
            #:with real-binding #'rhs.real-binding
            #:with imag-binding #'rhs.imag-binding
            #:with (bindings ...) #'(rhs.bindings ...)))
 
-;; let clause whose rhs is a function with some inexact complex arguments
+;; let clause whose rhs is a function with some float complex arguments
 ;; these arguments may be unboxed
 ;; the new function will have all the unboxed arguments first, then all the boxed
 (define-syntax-class unboxed-fun-clause
diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt
index d40cccca..b6f30e81 100644
--- a/collects/typed-scheme/private/base-env-numeric.rkt
+++ b/collects/typed-scheme/private/base-env-numeric.rkt
@@ -143,7 +143,7 @@
 [complex? (make-pred-ty N)]
 [rational? (make-pred-ty -Real)]
 [exact? (asym-pred N B (-FS -top (-not-filter -ExactRational 0)))]
-[inexact? (asym-pred N B  (-FS -top (-not-filter (Un -InexactReal -InexactComplex) 0)))]
+[inexact? (asym-pred N B  (-FS -top (-not-filter (Un -InexactReal -FloatComplex) 0)))]
 [fixnum? (make-pred-ty -Fixnum)]
 [positive? (cl->* (-> -Fixnum B : (-FS (-filter -PositiveFixnum 0) -top))
                   (-> -Integer B : (-FS (-filter -ExactPositiveInteger 0) -top))
@@ -234,7 +234,7 @@
                   (list (->* (list -InexactReal -Flonum) (Un -InexactReal -Flonum) -Flonum))
                   (list (->* (list) -InexactReal -InexactReal))
                   (list (->* (list) -Real -Real))
-                  (list (->* (list) (Un -InexactComplex -Flonum) -InexactComplex))
+                  (list (->* (list) (Un -FloatComplex -Flonum) -FloatComplex))
                   (list (->* (list) N N))))]
 [+ (apply cl->*
           (append (list (->* (list -Pos) -Nat -Pos))
@@ -247,9 +247,9 @@
                   (list (->* (list -Real -Flonum) -Real -Flonum))
                   (list (->* (list) -InexactReal -InexactReal))
                   (list (->* (list) -Real -Real))
-                  (list (->* (list) (Un -Real -InexactComplex) -InexactComplex))
-                  (list (->* (list -InexactComplex) N -InexactComplex))
-                  (list (->* (list N -InexactComplex) N -InexactComplex))
+                  (list (->* (list) (Un -Real -FloatComplex) -FloatComplex))
+                  (list (->* (list -FloatComplex) N -FloatComplex))
+                  (list (->* (list N -FloatComplex) N -FloatComplex))
                   (list (->* (list) N N))))]
 
 [- (apply cl->*
@@ -259,9 +259,9 @@
                   (list (->* (list -Real -Flonum) -Real -Flonum))
                   (list (->* (list -InexactReal) -InexactReal -InexactReal))
                   (list (->* (list -Real) -Real -Real))
-                  (list (->* (list) (Un -Real -InexactComplex) -InexactComplex))
-                  (list (->* (list -InexactComplex) N -InexactComplex))
-                  (list (->* (list N -InexactComplex) N -InexactComplex))
+                  (list (->* (list) (Un -Real -FloatComplex) -FloatComplex))
+                  (list (->* (list -FloatComplex) N -FloatComplex))
+                  (list (->* (list N -FloatComplex) N -FloatComplex))
                   (list (->* (list N) N N))))]
 [/ (apply cl->*
           (append (list (->* (list -Integer) -Integer -ExactRational))
@@ -272,8 +272,8 @@
                   (list (->* (list -InexactReal -Flonum) -InexactReal -Flonum))
                   (list (->* (list -InexactReal) -InexactReal -InexactReal))
                   (list (->* (list -Real) -Real -Real))
-                  (list (->* (list (Un -Flonum -InexactComplex)) (Un -Real -InexactComplex) -InexactComplex))
-                  (list (->* (list -InexactComplex) -InexactComplex -InexactComplex))
+                  (list (->* (list (Un -Flonum -FloatComplex)) (Un -Real -FloatComplex) -FloatComplex))
+                  (list (->* (list -FloatComplex) -FloatComplex -FloatComplex))
                   (list (->* (list N) N N))))]
 
 [max (cl->* (->* (list -PositiveFixnum) -Fixnum -PositiveFixnum)
@@ -311,7 +311,7 @@
              (-> -Flonum -Flonum)
              (-> -InexactReal -InexactReal)
              (-> -Real -Real)
-             (-> -InexactComplex -InexactComplex)
+             (-> -FloatComplex -FloatComplex)
              (-> N N))]
 
 [sub1 (cl->* (-> -Pos -Nat)
@@ -320,7 +320,7 @@
              (-> -Flonum -Flonum)
              (-> -InexactReal -InexactReal)
              (-> -Real -Real)
-             (-> -InexactComplex -InexactComplex)
+             (-> -FloatComplex -FloatComplex)
              (-> N N))]
 
 [quotient (cl->* (-NonnegativeFixnum -NonnegativeFixnum . -> . -NonnegativeFixnum)
@@ -374,7 +374,7 @@
                  (-Flonum . -> . -Flonum)           ; no conversion
                  (-InexactReal . -> . -InexactReal) ; no conversion
                  (-Real . -> . -Flonum)
-                 (N . -> . -InexactComplex))]
+                 (N . -> . -FloatComplex))]
 [inexact->exact (cl->*
                  (-Real . -> . -ExactRational)
                  (N . -> . N))]
@@ -383,17 +383,17 @@
 [ceiling rounder]
 [truncate rounder]
 [round rounder]
-[make-rectangular (cl->* (-Flonum -Flonum . -> . -InexactComplex)
+[make-rectangular (cl->* (-Flonum -Flonum . -> . -FloatComplex)
                          (-Real -Real . -> . N))]
-[make-polar (cl->* (-Flonum -Flonum . -> . -InexactComplex)
+[make-polar (cl->* (-Flonum -Flonum . -> . -FloatComplex)
                    (-Real -Real . -> . N))]
-[real-part (cl->* (-InexactComplex . -> . -Flonum)
+[real-part (cl->* (-FloatComplex . -> . -Flonum)
                   (N . -> . -Real))]
-[imag-part (cl->* (-InexactComplex . -> . -Flonum)
+[imag-part (cl->* (-FloatComplex . -> . -Flonum)
                   (N . -> . -Real))]
-[magnitude (cl->* (-InexactComplex . -> . -Flonum)
+[magnitude (cl->* (-FloatComplex . -> . -Flonum)
                   (N . -> . -Real))]
-[angle     (cl->* (-InexactComplex . -> . -Flonum)
+[angle     (cl->* (-FloatComplex . -> . -Flonum)
                   (N . -> . -Real))]
 [numerator   (cl->* (-ExactRational . -> . -Integer)
                     (-Real . -> . -Real))]
@@ -407,28 +407,28 @@
              (-Integer -Nat . -> . -Integer)
              (-Integer -Integer . -> . -ExactRational)
              (-Real -Integer . -> . -Real)
-             (-InexactComplex -InexactComplex . -> . -InexactComplex)
+             (-FloatComplex -FloatComplex . -> . -FloatComplex)
              (N N . -> . N))]
 [sqrt (cl->*
        (-Nat . -> . -Real)
        (-NonnegativeFlonum . -> . -NonnegativeFlonum)
-       (-InexactComplex . -> . -InexactComplex)
+       (-FloatComplex . -> . -FloatComplex)
        (N . -> . N))]
 [log (cl->*
       (-Pos . -> . -Real)
-      (-InexactComplex . -> . -InexactComplex)
+      (-FloatComplex . -> . -FloatComplex)
       (N . -> . N))]
 [exp  (cl->* (-Flonum . -> . -Flonum)
              (-InexactReal . -> . -InexactReal)
              (-Real . -> . -Real)
-             (-InexactComplex . -> . -InexactComplex)
+             (-FloatComplex . -> . -FloatComplex)
              (N . -> . N))]
-[cos  (cl->* (-Flonum . -> . -Flonum) (-InexactReal . -> . -InexactReal) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N))]
-[sin  (cl->* (-Flonum . -> . -Flonum) (-InexactReal . -> . -InexactReal) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N))]
-[tan  (cl->* (-Flonum . -> . -Flonum) (-InexactReal . -> . -InexactReal) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N))]
-[acos (cl->* (-Flonum . -> . -Flonum) (-InexactReal . -> . -InexactReal) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N))]
-[asin (cl->* (-Flonum . -> . -Flonum) (-InexactReal . -> . -InexactReal) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N))]
-[atan (cl->* (-Flonum . -> . -Flonum) (-InexactReal . -> . -InexactReal) (-Real . -> . -Real) (-InexactComplex . -> . -InexactComplex) (N . -> . N) (-Real -Real . -> . N))]
+[cos  (cl->* (-Flonum . -> . -Flonum) (-InexactReal . -> . -InexactReal) (-Real . -> . -Real) (-FloatComplex . -> . -FloatComplex) (N . -> . N))]
+[sin  (cl->* (-Flonum . -> . -Flonum) (-InexactReal . -> . -InexactReal) (-Real . -> . -Real) (-FloatComplex . -> . -FloatComplex) (N . -> . N))]
+[tan  (cl->* (-Flonum . -> . -Flonum) (-InexactReal . -> . -InexactReal) (-Real . -> . -Real) (-FloatComplex . -> . -FloatComplex) (N . -> . N))]
+[acos (cl->* (-Flonum . -> . -Flonum) (-InexactReal . -> . -InexactReal) (-Real . -> . -Real) (-FloatComplex . -> . -FloatComplex) (N . -> . N))]
+[asin (cl->* (-Flonum . -> . -Flonum) (-InexactReal . -> . -InexactReal) (-Real . -> . -Real) (-FloatComplex . -> . -FloatComplex) (N . -> . N))]
+[atan (cl->* (-Flonum . -> . -Flonum) (-InexactReal . -> . -InexactReal) (-Real . -> . -Real) (-FloatComplex . -> . -FloatComplex) (N . -> . N) (-Real -Real . -> . N))]
 [gcd  (cl->* (null -Fixnum . ->* . -Fixnum) (null -Integer . ->* . -Integer))]
 [lcm  (null -Integer . ->* . -Integer)]
 
@@ -442,15 +442,15 @@
             (-> -Flonum -NonnegativeFlonum)
             (-> -InexactReal -InexactReal)
             (-> -Real -Real)
-            (-> -InexactComplex -InexactComplex)
+            (-> -FloatComplex -FloatComplex)
             (-> N N))]
-[conjugate (cl->* (-InexactComplex . -> . -InexactComplex)
+[conjugate (cl->* (-FloatComplex . -> . -FloatComplex)
                   (N . -> . N))]
-[sinh (cl->* (-InexactComplex . -> . -InexactComplex)
+[sinh (cl->* (-FloatComplex . -> . -FloatComplex)
              (N . -> . N))]
-[cosh (cl->* (-InexactComplex . -> . -InexactComplex)
+[cosh (cl->* (-FloatComplex . -> . -FloatComplex)
              (N . -> . N))]
-[tanh (cl->* (-InexactComplex . -> . -InexactComplex)
+[tanh (cl->* (-FloatComplex . -> . -FloatComplex)
              (N . -> . N))]
 
 ;; unsafe numeric ops
@@ -480,9 +480,9 @@
 [unsafe-flexp fl-rounder]
 [unsafe-flsqrt fl-rounder]
 [unsafe-fx->fl (cl->* (-Nat . -> . -NonnegativeFlonum) (-Integer . -> . -Flonum))]
-[unsafe-make-flrectangular (-Flonum -Flonum . -> . -InexactComplex)]
-[unsafe-flreal-part (-InexactComplex . -> . -Flonum)]
-[unsafe-flimag-part (-InexactComplex . -> . -Flonum)]
+[unsafe-make-flrectangular (-Flonum -Flonum . -> . -FloatComplex)]
+[unsafe-flreal-part (-FloatComplex . -> . -Flonum)]
+[unsafe-flimag-part (-FloatComplex . -> . -Flonum)]
 
 [unsafe-fx+ fx+-type]
 [unsafe-fx- fx--type]
@@ -560,9 +560,9 @@
 [flexp fl-unop]
 [flsqrt fl-unop]
 [->fl (-Integer . -> . -Flonum)]
-[make-flrectangular (-Flonum -Flonum . -> . -InexactComplex)]
-[flreal-part (-InexactComplex . -> . -Flonum)]
-[flimag-part (-InexactComplex . -> . -Flonum)]
+[make-flrectangular (-Flonum -Flonum . -> . -FloatComplex)]
+[flreal-part (-FloatComplex . -> . -Flonum)]
+[flimag-part (-FloatComplex . -> . -Flonum)]
 
 ;; safe flvector ops
 
diff --git a/collects/typed-scheme/private/base-types.rkt b/collects/typed-scheme/private/base-types.rkt
index f7818966..eceb61ec 100644
--- a/collects/typed-scheme/private/base-types.rkt
+++ b/collects/typed-scheme/private/base-types.rkt
@@ -1,8 +1,8 @@
 #lang s-exp "type-env-lang.rkt"
 
 [Complex -Number]
-[Float-Complex -InexactComplex] ; for consistency with float vs inexact-real
-[Inexact-Complex -InexactComplex] ; for backward compatiblity
+[Float-Complex -FloatComplex] ; for consistency with float vs inexact-real
+[Inexact-Complex -FloatComplex] ; for backward compatiblity
 [Number -Number]
 [Integer -Integer]
 [Real -Real]
diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.rkt b/collects/typed-scheme/typecheck/tc-expr-unit.rkt
index 2bd1285d..d0788b9a 100644
--- a/collects/typed-scheme/typecheck/tc-expr-unit.rkt
+++ b/collects/typed-scheme/typecheck/tc-expr-unit.rkt
@@ -47,10 +47,10 @@
      -NonnegativeFlonum]
     [(~var i (3d flonum?)) -Flonum]
     [(~var i (3d real?)) -Real]
-    ;; a complex number can't have an inexact imaginary part and an exact real part
+    ;; a complex number can't have a float imaginary part and an exact real part
     [(~var i (3d (conjoin number? (lambda (x) (and (flonum? (imag-part x))
                                                    (flonum? (real-part x)))))))
-     -InexactComplex]
+     -FloatComplex]
     [(~var i (3d number?)) -Number]
     [i:str -String]
     [i:char -Char]
diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt
index 6603b592..e69967b3 100644
--- a/collects/typed-scheme/types/abbrev.rkt
+++ b/collects/typed-scheme/types/abbrev.rkt
@@ -153,11 +153,11 @@
 ;; Numeric hierarchy
 (define -Number (make-Base 'Number #'number?))
 
-(define -InexactComplex (make-Base 'Inexact-Complex
-                                   #'(and/c number?
-                                            (lambda (x)
-                                              (and (flonum? (imag-part x))
-                                                   (flonum? (real-part x)))))))
+(define -FloatComplex (make-Base 'Float-Complex
+                                 #'(and/c number?
+                                          (lambda (x)
+                                            (and (flonum? (imag-part x))
+                                                 (flonum? (real-part x)))))))
 
 ;; default 64-bit floats
 (define -Flonum (make-Base 'Flonum #'flonum?))
diff --git a/collects/typed-scheme/types/subtype.rkt b/collects/typed-scheme/types/subtype.rkt
index 16918d20..a13328e3 100644
--- a/collects/typed-scheme/types/subtype.rkt
+++ b/collects/typed-scheme/types/subtype.rkt
@@ -270,7 +270,7 @@
               [((Base: 'Inexact-Real _) (== -Real =t)) A0]
               [((Base: 'Inexact-Real _) (Base: 'Number _)) A0]
 
-              [((Base: 'Inexact-Complex _) (Base: 'Number _)) A0]
+              [((Base: 'Float-Complex _) (Base: 'Number _)) A0]
 
               
               ;; values are subtypes of their "type"

From 759a3707c86be1ca19eceff49e77f45e54bd7bf9 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 14 Oct 2010 10:53:43 -0400
Subject: [PATCH 166/198] Fixed a test to reflect implicit let in cond instead
 of implicit begin.

original commit: 3f5ea8a5be1da62f4766585f891e7c5340c52588
---
 .../tests/typed-scheme/optimizer/tests/dead-substructs.rkt     | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/collects/tests/typed-scheme/optimizer/tests/dead-substructs.rkt b/collects/tests/typed-scheme/optimizer/tests/dead-substructs.rkt
index 638a5cf0..3e644029 100644
--- a/collects/tests/typed-scheme/optimizer/tests/dead-substructs.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/dead-substructs.rkt
@@ -1,5 +1,8 @@
 #;
 (
+dead-substructs.rkt line 22 col 2 - (let-values () (quote 1)) - unboxed let bindings
+dead-substructs.rkt line 22 col 2 - (let-values () (quote 2)) - unboxed let bindings
+dead-substructs.rkt line 22 col 2 - (let-values () (#%app error (quote eh?))) - unboxed let bindings
 1
 2
 )

From f0fad4383ad3a7df7aa8666074b31697f95cec2e Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Thu, 14 Oct 2010 11:44:00 -0400
Subject: [PATCH 167/198] Add type for `compose'

original commit: 24bddafa82e28a3eee675c1ad99ae1dcde59d46a
---
 collects/typed-scheme/private/base-env.rkt | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/collects/typed-scheme/private/base-env.rkt b/collects/typed-scheme/private/base-env.rkt
index c6e6b4aa..9cb5e841 100644
--- a/collects/typed-scheme/private/base-env.rkt
+++ b/collects/typed-scheme/private/base-env.rkt
@@ -15,6 +15,7 @@
   (only-in '#%kernel [apply kernel:apply])
   (only-in racket/private/pre-base new-apply-proc) 
   scheme/promise scheme/system
+  racket/function
   racket/mpair
   racket/base
   (only-in string-constants/private/only-once maybe-print-message)
@@ -1020,3 +1021,5 @@
 [module-compiled-language-info
  (-> -Compiled-Module-Expression
      (-opt (make-HeterogenousVector (list -Module-Path -Symbol Univ))))]
+
+[compose (-poly (a b c) (-> (-> b c) (-> a b) (-> a c)))]
\ No newline at end of file

From 4a6b3b2b5700466cae86b27db020feee068f827d Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 14 Oct 2010 11:35:12 -0400
Subject: [PATCH 168/198] Removed logging when no optimization actually
 happens.

original commit: 12a5454b147468df59e92cb7057e0e9515ad5abd
---
 .../optimizer/tests/dead-substructs.rkt       |  3 -
 .../typed-scheme/optimizer/tests/in-bytes.rkt | 13 ----
 .../typed-scheme/optimizer/tests/in-list.rkt  | 13 ----
 .../optimizer/tests/in-string.rkt             | 13 ----
 .../optimizer/tests/in-vector.rkt             | 13 ----
 .../optimizer/tests/invalid-unboxed-let2.rkt  | 25 ++++---
 .../optimizer/tests/let-float.rkt             |  5 +-
 .../typed-scheme/optimizer/tests/let-rhs.rkt  |  3 +-
 .../optimizer/tests/nested-let-loop.rkt       | 70 +++++++++----------
 .../optimizer/tests/real-part-loop.rkt        | 37 +++++-----
 .../optimizer/tests/sqrt-segfault.rkt         |  8 +--
 .../optimizer/tests/unboxed-for.rkt           | 66 ++++++++---------
 .../tests/unboxed-let-functions1.rkt          | 33 +++++----
 .../tests/unboxed-let-functions2.rkt          | 45 ++++++------
 .../tests/unboxed-let-functions3.rkt          | 33 +++++----
 .../tests/unboxed-let-functions4.rkt          | 33 +++++----
 .../tests/unboxed-let-functions5.rkt          | 10 ++-
 .../tests/unboxed-let-functions6.rkt          | 41 ++++++-----
 .../tests/unboxed-let-functions7.rkt          | 37 +++++-----
 .../tests/unboxed-let-functions8.rkt          |  9 ++-
 .../typed-scheme/optimizer/unboxed-let.rkt    |  7 +-
 21 files changed, 222 insertions(+), 295 deletions(-)

diff --git a/collects/tests/typed-scheme/optimizer/tests/dead-substructs.rkt b/collects/tests/typed-scheme/optimizer/tests/dead-substructs.rkt
index 3e644029..638a5cf0 100644
--- a/collects/tests/typed-scheme/optimizer/tests/dead-substructs.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/dead-substructs.rkt
@@ -1,8 +1,5 @@
 #;
 (
-dead-substructs.rkt line 22 col 2 - (let-values () (quote 1)) - unboxed let bindings
-dead-substructs.rkt line 22 col 2 - (let-values () (quote 2)) - unboxed let bindings
-dead-substructs.rkt line 22 col 2 - (let-values () (#%app error (quote eh?))) - unboxed let bindings
 1
 2
 )
diff --git a/collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt b/collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt
index 8508fde9..1835fe3f 100644
--- a/collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/in-bytes.rkt
@@ -1,19 +1,6 @@
 #;
 (
 #f line #f col #f - make-sequence - in-bytes
-#f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (quote 123)))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) (#%app void) init)) - unboxed let bindings
-#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
-#f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
-#f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
-in-bytes.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
-#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
-#f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
-#f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
-in-bytes.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
 495051)
 
 #lang typed/scheme
diff --git a/collects/tests/typed-scheme/optimizer/tests/in-list.rkt b/collects/tests/typed-scheme/optimizer/tests/in-list.rkt
index a53f90c6..d32781de 100644
--- a/collects/tests/typed-scheme/optimizer/tests/in-list.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/in-list.rkt
@@ -1,19 +1,6 @@
 #;
 (
 #f line #f col #f - make-sequence - in-list
-#f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (quote (1 2 3))))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) (#%app void) init)) - unboxed let bindings
-#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
-#f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
-#f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
-in-list.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
-#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
-#f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
-#f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
-in-list.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
 123)
 
 #lang typed/scheme
diff --git a/collects/tests/typed-scheme/optimizer/tests/in-string.rkt b/collects/tests/typed-scheme/optimizer/tests/in-string.rkt
index 9f311c48..869316f4 100644
--- a/collects/tests/typed-scheme/optimizer/tests/in-string.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/in-string.rkt
@@ -1,19 +1,6 @@
 #;
 (
 #f line #f col #f - make-sequence - in-string
-#f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (quote 123)))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) (#%app void) init)) - unboxed let bindings
-#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
-#f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
-#f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
-in-string.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
-#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
-#f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
-#f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
-in-string.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
 123)
 
 #lang typed/scheme
diff --git a/collects/tests/typed-scheme/optimizer/tests/in-vector.rkt b/collects/tests/typed-scheme/optimizer/tests/in-vector.rkt
index 5554babd..cabc9474 100644
--- a/collects/tests/typed-scheme/optimizer/tests/in-vector.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/in-vector.rkt
@@ -1,19 +1,6 @@
 #;
 (
 #f line #f col #f - make-sequence - in-vector
-#f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (#%app vector (quote 1) (quote 2) (quote 3))))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) (#%app void) init)) - unboxed let bindings
-#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
-#f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
-#f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
-in-vector.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
-#f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))) - unboxed let bindings
-#f line #f col #f - (let-values () (let-values () (#%app display i)) (#%app void)) - unboxed let bindings
-#f line #f col #f - (let-values () (#%app display i)) - unboxed let bindings
-#f line #f col #f - (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) - unboxed let bindings
-in-vector.rkt line 22 col 0 - (letrec-values (((for-loop) (lambda (fold-var pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((fold-var) (let-values (((fold-var) fold-var)) (let-values () (let-values () (#%app display i)) (#%app void))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop fold-var (#%app pos-next pos)) fold-var)) fold-var)) fold-var)))) for-loop) - unboxed let bindings
 123)
 
 #lang typed/scheme
diff --git a/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt b/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt
index 79a58dab..ff2dd31f 100644
--- a/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/invalid-unboxed-let2.rkt
@@ -1,18 +1,17 @@
 #;
 (
-invalid-unboxed-let2.rkt line 25 col 33 - 1.0+2.0i - unboxed literal
-invalid-unboxed-let2.rkt line 25 col 42 - 2.0+4.0i - unboxed literal
-invalid-unboxed-let2.rkt line 25 col 31 - + - unboxed binary float complex
-invalid-unboxed-let2.rkt line 25 col 30 - (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) - unboxed float complex
-invalid-unboxed-let2.rkt line 25 col 55 - 3.0+6.0i - unboxed literal
-invalid-unboxed-let2.rkt line 25 col 64 - 4.0+8.0i - unboxed literal
-invalid-unboxed-let2.rkt line 25 col 53 - + - unboxed binary float complex
-invalid-unboxed-let2.rkt line 25 col 52 - (#%app + (quote 3.0+6.0i) (quote 4.0+8.0i)) - unboxed float complex
-invalid-unboxed-let2.rkt line 25 col 0 - (let-values (((t1 t2) (#%app values (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) (#%app + (quote 3.0+6.0i) (quote 4.0+8.0i))))) (#%app + t1 t2)) - unboxed let bindings
-invalid-unboxed-let2.rkt line 26 col 5 - t1 - unbox float-complex
-invalid-unboxed-let2.rkt line 26 col 8 - t2 - unbox float-complex
-invalid-unboxed-let2.rkt line 26 col 3 - + - unboxed binary float complex
-invalid-unboxed-let2.rkt line 26 col 2 - (#%app + t1 t2) - unboxed float complex
+invalid-unboxed-let2.rkt line 24 col 33 - 1.0+2.0i - unboxed literal
+invalid-unboxed-let2.rkt line 24 col 42 - 2.0+4.0i - unboxed literal
+invalid-unboxed-let2.rkt line 24 col 31 - + - unboxed binary float complex
+invalid-unboxed-let2.rkt line 24 col 30 - (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) - unboxed float complex
+invalid-unboxed-let2.rkt line 24 col 55 - 3.0+6.0i - unboxed literal
+invalid-unboxed-let2.rkt line 24 col 64 - 4.0+8.0i - unboxed literal
+invalid-unboxed-let2.rkt line 24 col 53 - + - unboxed binary float complex
+invalid-unboxed-let2.rkt line 24 col 52 - (#%app + (quote 3.0+6.0i) (quote 4.0+8.0i)) - unboxed float complex
+invalid-unboxed-let2.rkt line 25 col 5 - t1 - unbox float-complex
+invalid-unboxed-let2.rkt line 25 col 8 - t2 - unbox float-complex
+invalid-unboxed-let2.rkt line 25 col 3 - + - unboxed binary float complex
+invalid-unboxed-let2.rkt line 25 col 2 - (#%app + t1 t2) - unboxed float complex
 10.0+20.0i
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/let-float.rkt b/collects/tests/typed-scheme/optimizer/tests/let-float.rkt
index 09f4ca14..a7e6d6fa 100644
--- a/collects/tests/typed-scheme/optimizer/tests/let-float.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/let-float.rkt
@@ -1,8 +1,7 @@
 #;
 (
-let-float.rkt line 12 col 10 - + - binary float
-let-float.rkt line 12 col 0 - (let-values (((x) (#%app + (quote 3.0) (quote 2.0)))) (#%app * (quote 9.0) x)) - unboxed let bindings
-let-float.rkt line 13 col 3 - * - binary float
+let-float.rkt line 11 col 10 - + - binary float
+let-float.rkt line 12 col 3 - * - binary float
 45.0
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/let-rhs.rkt b/collects/tests/typed-scheme/optimizer/tests/let-rhs.rkt
index b6994657..4ffc7ce5 100644
--- a/collects/tests/typed-scheme/optimizer/tests/let-rhs.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/let-rhs.rkt
@@ -1,7 +1,6 @@
 #;
 (
-let-rhs.rkt line 13 col 10 - + - binary float
-let-rhs.rkt line 13 col 0 - (let-values (((x) (#%app + (quote 1.0) (quote 2.0)))) x) - unboxed let bindings
+let-rhs.rkt line 12 col 10 - + - binary float
 3.0
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt b/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt
index 4d55b2e0..8a44e45b 100644
--- a/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/nested-let-loop.rkt
@@ -1,43 +1,41 @@
 #;
 (
-nested-let-loop.rkt line 58 col 38 - r - unbox float-complex
-nested-let-loop.rkt line 58 col 40 - s - unbox float-complex
-nested-let-loop.rkt line 58 col 36 - + - unboxed binary float complex
-nested-let-loop.rkt line 58 col 35 - (#%app + r s) - unboxed float complex
-nested-let-loop.rkt line 51 col 8 - r - unboxed var -> table
-nested-let-loop.rkt line 49 col 6 - loop1 - unboxed function -> table
-nested-let-loop.rkt line 49 col 6 - loop1 - fun -> unboxed fun
-nested-let-loop.rkt line 53 col 10 - r - unboxed complex variable
-nested-let-loop.rkt line 58 col 38 - r - leave var unboxed
-nested-let-loop.rkt line 58 col 40 - s - unbox float-complex
-nested-let-loop.rkt line 58 col 36 - + - unboxed binary float complex
-nested-let-loop.rkt line 58 col 35 - (#%app + r s) - unboxed float complex
-nested-let-loop.rkt line 56 col 18 - s - unboxed var -> table
-nested-let-loop.rkt line 54 col 16 - loop2 - unboxed function -> table
-nested-let-loop.rkt line 54 col 16 - loop2 - fun -> unboxed fun
-nested-let-loop.rkt line 58 col 38 - r - leave var unboxed
-nested-let-loop.rkt line 58 col 40 - s - leave var unboxed
-nested-let-loop.rkt line 58 col 36 - + - unboxed binary float complex
-nested-let-loop.rkt line 58 col 21 - loop1 - unboxed call site
-nested-let-loop.rkt line 58 col 28 - cdr - pair
-nested-let-loop.rkt line 58 col 21 - loop1 - call to fun with unboxed args
-nested-let-loop.rkt line 59 col 38 - s - leave var unboxed
-nested-let-loop.rkt line 59 col 40 - (#%app car x) - unbox float-complex
-nested-let-loop.rkt line 59 col 41 - car - pair
-nested-let-loop.rkt line 59 col 48 - (#%app car y) - unbox float-complex
-nested-let-loop.rkt line 59 col 49 - car - pair
-nested-let-loop.rkt line 59 col 36 - + - unboxed binary float complex
-nested-let-loop.rkt line 59 col 21 - loop2 - unboxed call site
-nested-let-loop.rkt line 59 col 28 - cdr - pair
-nested-let-loop.rkt line 59 col 21 - loop2 - call to fun with unboxed args
-#f line #f col #f - (letrec-values (((loop2) (lambda (y s) (if (#%app null? y) (#%app loop1 (#%app cdr x) (#%app + r s)) (#%app loop2 (#%app cdr y) (#%app + s (#%app car x) (#%app car y))))))) loop2) - unboxed let bindings
-nested-let-loop.rkt line 56 col 38 - 0.0+0.0i - unboxed literal
+nested-let-loop.rkt line 56 col 38 - r - unbox float-complex
+nested-let-loop.rkt line 56 col 40 - s - unbox float-complex
+nested-let-loop.rkt line 56 col 36 - + - unboxed binary float complex
+nested-let-loop.rkt line 56 col 35 - (#%app + r s) - unboxed float complex
+nested-let-loop.rkt line 49 col 8 - r - unboxed var -> table
+nested-let-loop.rkt line 47 col 6 - loop1 - unboxed function -> table
+nested-let-loop.rkt line 47 col 6 - loop1 - fun -> unboxed fun
+nested-let-loop.rkt line 51 col 10 - r - unboxed complex variable
+nested-let-loop.rkt line 56 col 38 - r - leave var unboxed
+nested-let-loop.rkt line 56 col 40 - s - unbox float-complex
+nested-let-loop.rkt line 56 col 36 - + - unboxed binary float complex
+nested-let-loop.rkt line 56 col 35 - (#%app + r s) - unboxed float complex
+nested-let-loop.rkt line 54 col 18 - s - unboxed var -> table
+nested-let-loop.rkt line 52 col 16 - loop2 - unboxed function -> table
+nested-let-loop.rkt line 52 col 16 - loop2 - fun -> unboxed fun
+nested-let-loop.rkt line 56 col 38 - r - leave var unboxed
+nested-let-loop.rkt line 56 col 40 - s - leave var unboxed
+nested-let-loop.rkt line 56 col 36 - + - unboxed binary float complex
+nested-let-loop.rkt line 56 col 21 - loop1 - unboxed call site
+nested-let-loop.rkt line 56 col 28 - cdr - pair
+nested-let-loop.rkt line 56 col 21 - loop1 - call to fun with unboxed args
+nested-let-loop.rkt line 57 col 38 - s - leave var unboxed
+nested-let-loop.rkt line 57 col 40 - (#%app car x) - unbox float-complex
+nested-let-loop.rkt line 57 col 41 - car - pair
+nested-let-loop.rkt line 57 col 48 - (#%app car y) - unbox float-complex
+nested-let-loop.rkt line 57 col 49 - car - pair
+nested-let-loop.rkt line 57 col 36 - + - unboxed binary float complex
+nested-let-loop.rkt line 57 col 21 - loop2 - unboxed call site
+nested-let-loop.rkt line 57 col 28 - cdr - pair
+nested-let-loop.rkt line 57 col 21 - loop2 - call to fun with unboxed args
+nested-let-loop.rkt line 54 col 38 - 0.0+0.0i - unboxed literal
 #f line #f col #f - (letrec-values (((loop2) (lambda (y s) (if (#%app null? y) (#%app loop1 (#%app cdr x) (#%app + r s)) (#%app loop2 (#%app cdr y) (#%app + s (#%app car x) (#%app car y))))))) loop2) - unboxed call site
-nested-let-loop.rkt line 54 col 16 - loop2 - unboxed let loop
-#f line #f col #f - (letrec-values (((loop1) (lambda (x r) (if (#%app null? x) r (#%app (letrec-values (((loop2) (lambda (y s) (if (#%app null? y) (#%app loop1 (#%app cdr x) (#%app + r s)) (#%app loop2 (#%app cdr y) (#%app + s (#%app car x) (#%app car y))))))) loop2) (quote (3.0+6.0i 4.0+8.0i)) (quote 0.0+0.0i)))))) loop1) - unboxed let bindings
-nested-let-loop.rkt line 51 col 28 - 0.0+0.0i - unboxed literal
+nested-let-loop.rkt line 52 col 16 - loop2 - unboxed let loop
+nested-let-loop.rkt line 49 col 28 - 0.0+0.0i - unboxed literal
 #f line #f col #f - (letrec-values (((loop1) (lambda (x r) (if (#%app null? x) r (#%app (letrec-values (((loop2) (lambda (y s) (if (#%app null? y) (#%app loop1 (#%app cdr x) (#%app + r s)) (#%app loop2 (#%app cdr y) (#%app + s (#%app car x) (#%app car y))))))) loop2) (quote (3.0+6.0i 4.0+8.0i)) (quote 0.0+0.0i)))))) loop1) - unboxed call site
-nested-let-loop.rkt line 49 col 6 - loop1 - unboxed let loop
+nested-let-loop.rkt line 47 col 6 - loop1 - unboxed let loop
 20.0+40.0i
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt b/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt
index 45637a4d..b6bb0384 100644
--- a/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/real-part-loop.rkt
@@ -1,24 +1,23 @@
 #;
 (
-real-part-loop.rkt line 32 col 20 - v - unbox float-complex
-real-part-loop.rkt line 32 col 10 - real-part - unboxed unary float complex
-real-part-loop.rkt line 32 col 9 - (#%app real-part v) - unboxed float complex->float
-real-part-loop.rkt line 31 col 13 - v - unboxed var -> table
-real-part-loop.rkt line 31 col 6 - loop - unboxed function -> table
-real-part-loop.rkt line 31 col 6 - loop - fun -> unboxed fun
-real-part-loop.rkt line 32 col 20 - v - unboxed complex variable
-real-part-loop.rkt line 32 col 20 - v - leave var unboxed
-real-part-loop.rkt line 32 col 10 - real-part - unboxed float complex
-real-part-loop.rkt line 32 col 7 - > - binary float comp
-real-part-loop.rkt line 34 col 15 - v - leave var unboxed
-real-part-loop.rkt line 34 col 17 - (quote 3.6) - float-coerce-expr in complex ops
-real-part-loop.rkt line 34 col 13 - + - unboxed binary float complex
-real-part-loop.rkt line 34 col 7 - loop - unboxed call site
-real-part-loop.rkt line 34 col 7 - loop - call to fun with unboxed args
-real-part-loop.rkt line 31 col 1 - (letrec-values (((loop) (lambda (v) (if (#%app > (#%app real-part v) (quote 70000.2)) (quote 0) (#%app loop (#%app + v (quote 3.6))))))) loop) - unboxed let bindings
-real-part-loop.rkt line 31 col 15 - 0.0+1.0i - unboxed literal
-real-part-loop.rkt line 31 col 1 - (letrec-values (((loop) (lambda (v) (if (#%app > (#%app real-part v) (quote 70000.2)) (quote 0) (#%app loop (#%app + v (quote 3.6))))))) loop) - unboxed call site
-real-part-loop.rkt line 31 col 6 - loop - unboxed let loop
+real-part-loop.rkt line 31 col 20 - v - unbox float-complex
+real-part-loop.rkt line 31 col 10 - real-part - unboxed unary float complex
+real-part-loop.rkt line 31 col 9 - (#%app real-part v) - unboxed float complex->float
+real-part-loop.rkt line 30 col 13 - v - unboxed var -> table
+real-part-loop.rkt line 30 col 6 - loop - unboxed function -> table
+real-part-loop.rkt line 30 col 6 - loop - fun -> unboxed fun
+real-part-loop.rkt line 31 col 20 - v - unboxed complex variable
+real-part-loop.rkt line 31 col 20 - v - leave var unboxed
+real-part-loop.rkt line 31 col 10 - real-part - unboxed float complex
+real-part-loop.rkt line 31 col 7 - > - binary float comp
+real-part-loop.rkt line 33 col 15 - v - leave var unboxed
+real-part-loop.rkt line 33 col 17 - (quote 3.6) - float-coerce-expr in complex ops
+real-part-loop.rkt line 33 col 13 - + - unboxed binary float complex
+real-part-loop.rkt line 33 col 7 - loop - unboxed call site
+real-part-loop.rkt line 33 col 7 - loop - call to fun with unboxed args
+real-part-loop.rkt line 30 col 15 - 0.0+1.0i - unboxed literal
+real-part-loop.rkt line 30 col 1 - (letrec-values (((loop) (lambda (v) (if (#%app > (#%app real-part v) (quote 70000.2)) (quote 0) (#%app loop (#%app + v (quote 3.6))))))) loop) - unboxed call site
+real-part-loop.rkt line 30 col 6 - loop - unboxed let loop
 0
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt b/collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt
index b3886761..a72b5155 100644
--- a/collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/sqrt-segfault.rkt
@@ -1,11 +1,7 @@
 #;
 (
-sqrt-segfault.rkt line 22 col 15 - - - binary float
-sqrt-segfault.rkt line 22 col 0 - (let-values (((dx) (#%app - (quote 0.0) (quote 0.0)))) (let-values (((dist2) (#%app * dx dx))) (let-values (((mag) (let-values (((val) (#%app * dist2 (#%app sqrt dist2)))) (if (#%app flonum? val) val (#%app error (quote Assertion failed)))))) (#%app void)))) - unboxed let bindings
-sqrt-segfault.rkt line 23 col 15 - * - binary float
-sqrt-segfault.rkt line 22 col 0 - (let-values (((dist2) (#%app * dx dx))) (let-values (((mag) (let-values (((val) (#%app * dist2 (#%app sqrt dist2)))) (if (#%app flonum? val) val (#%app error (quote Assertion failed)))))) (#%app void))) - unboxed let bindings
-sqrt-segfault.rkt line 24 col 14 - (let-values (((val) (#%app * dist2 (#%app sqrt dist2)))) (if (#%app flonum? val) val (#%app error (quote Assertion failed)))) - unboxed let bindings
-sqrt-segfault.rkt line 22 col 0 - (let-values (((mag) (let-values (((val) (#%app * dist2 (#%app sqrt dist2)))) (if (#%app flonum? val) val (#%app error (quote Assertion failed)))))) (#%app void)) - unboxed let bindings
+sqrt-segfault.rkt line 18 col 15 - - - binary float
+sqrt-segfault.rkt line 19 col 15 - * - binary float
 )
 
 #lang typed/scheme
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt
index 63045602..bf7dffc8 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-for.rkt
@@ -1,48 +1,44 @@
 #;
 (
 #f line #f col #f - make-sequence - in-list
-#f line #f col #f - (let-values (((pos->vals pos-next init pos-cont? val-cont? all-cont?) (#%app make-sequence (quote (i)) (quote (1.0+2.0i 2.0+4.0i))))) (#%app void) (#%app (letrec-values (((for-loop) (lambda (sum pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop sum (#%app pos-next pos)) sum)) sum)) sum)))) for-loop) (quote 0.0+0.0i) init)) - unboxed let bindings
-unboxed-for.rkt line 57 col 9 - i - unbox float-complex
-unboxed-for.rkt line 57 col 11 - sum - unbox float-complex
-unboxed-for.rkt line 57 col 7 - + - unboxed binary float complex
-unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed float complex
-unboxed-for.rkt line 57 col 9 - i - unbox float-complex
-unboxed-for.rkt line 57 col 11 - sum - unbox float-complex
-unboxed-for.rkt line 57 col 7 - + - unboxed binary float complex
-unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed float complex
-unboxed-for.rkt line 55 col 31 - sum - unboxed var -> table
+unboxed-for.rkt line 53 col 9 - i - unbox float-complex
+unboxed-for.rkt line 53 col 11 - sum - unbox float-complex
+unboxed-for.rkt line 53 col 7 - + - unboxed binary float complex
+unboxed-for.rkt line 53 col 6 - (#%app + i sum) - unboxed float complex
+unboxed-for.rkt line 53 col 9 - i - unbox float-complex
+unboxed-for.rkt line 53 col 11 - sum - unbox float-complex
+unboxed-for.rkt line 53 col 7 - + - unboxed binary float complex
+unboxed-for.rkt line 53 col 6 - (#%app + i sum) - unboxed float complex
+unboxed-for.rkt line 51 col 31 - sum - unboxed var -> table
 #f line #f col #f - for-loop - unboxed function -> table
 #f line #f col #f - for-loop - fun -> unboxed fun
-unboxed-for.rkt line 55 col 31 - sum - unboxed complex variable
-unboxed-for.rkt line 57 col 9 - i - unbox float-complex
-unboxed-for.rkt line 57 col 11 - sum - unbox float-complex
-unboxed-for.rkt line 57 col 7 - + - unboxed binary float complex
-unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed float complex
+unboxed-for.rkt line 51 col 31 - sum - unboxed complex variable
+unboxed-for.rkt line 53 col 9 - i - unbox float-complex
+unboxed-for.rkt line 53 col 11 - sum - unbox float-complex
+unboxed-for.rkt line 53 col 7 - + - unboxed binary float complex
+unboxed-for.rkt line 53 col 6 - (#%app + i sum) - unboxed float complex
 #f line #f col #f - (#%app pos->vals pos) - unbox float-complex
 #f line #f col #f - (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop sum (#%app pos-next pos)) sum)) sum)) - unboxed let bindings
-unboxed-for.rkt line 56 col 13 - i - unboxed complex variable
-unboxed-for.rkt line 56 col 13 - i - unboxed complex variable
-unboxed-for.rkt line 57 col 9 - i - leave var unboxed
-unboxed-for.rkt line 57 col 11 - sum - unbox float-complex
-unboxed-for.rkt line 57 col 7 - + - unboxed binary float complex
-unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed float complex
-unboxed-for.rkt line 55 col 31 - sum - leave var unboxed
+unboxed-for.rkt line 52 col 13 - i - unboxed complex variable
+unboxed-for.rkt line 52 col 13 - i - unboxed complex variable
+unboxed-for.rkt line 53 col 9 - i - leave var unboxed
+unboxed-for.rkt line 53 col 11 - sum - unbox float-complex
+unboxed-for.rkt line 53 col 7 - + - unboxed binary float complex
+unboxed-for.rkt line 53 col 6 - (#%app + i sum) - unboxed float complex
+unboxed-for.rkt line 51 col 31 - sum - leave var unboxed
 #f line #f col #f - (let-values (((sum) sum)) (let-values () (#%app + i sum))) - unboxed let bindings
-#f line #f col #f - (let-values () (#%app + i sum)) - unboxed let bindings
-unboxed-for.rkt line 57 col 9 - i - leave var unboxed
-unboxed-for.rkt line 57 col 11 - sum - leave var unboxed
-unboxed-for.rkt line 57 col 7 - + - unboxed binary float complex
-unboxed-for.rkt line 57 col 6 - (#%app + i sum) - unboxed float complex
-#f line #f col #f - (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop sum (#%app pos-next pos)) sum)) - unboxed let bindings
-unboxed-for.rkt line 56 col 13 - i - unboxed complex variable
-unboxed-for.rkt line 55 col 31 - sum - unbox float-complex
+unboxed-for.rkt line 53 col 9 - i - leave var unboxed
+unboxed-for.rkt line 53 col 11 - sum - leave var unboxed
+unboxed-for.rkt line 53 col 7 - + - unboxed binary float complex
+unboxed-for.rkt line 53 col 6 - (#%app + i sum) - unboxed float complex
+unboxed-for.rkt line 52 col 13 - i - unboxed complex variable
+unboxed-for.rkt line 51 col 31 - sum - unbox float-complex
 #f line #f col #f - for-loop - unboxed call site
 #f line #f col #f - for-loop - call to fun with unboxed args
-unboxed-for.rkt line 55 col 31 - sum - unboxed complex variable
-unboxed-for.rkt line 55 col 31 - sum - unboxed complex variable
-unboxed-for.rkt line 55 col 0 - (letrec-values (((for-loop) (lambda (sum pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop sum (#%app pos-next pos)) sum)) sum)) sum)))) for-loop) - unboxed let bindings
-unboxed-for.rkt line 55 col 53 - 0.0+0.0i - unboxed literal
-unboxed-for.rkt line 55 col 0 - (letrec-values (((for-loop) (lambda (sum pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop sum (#%app pos-next pos)) sum)) sum)) sum)))) for-loop) - unboxed call site
+unboxed-for.rkt line 51 col 31 - sum - unboxed complex variable
+unboxed-for.rkt line 51 col 31 - sum - unboxed complex variable
+unboxed-for.rkt line 51 col 53 - 0.0+0.0i - unboxed literal
+unboxed-for.rkt line 51 col 0 - (letrec-values (((for-loop) (lambda (sum pos) (if (#%expression (#%app pos-cont? pos)) (let-values (((i) (#%app pos->vals pos))) (if (#%expression (#%app val-cont? i)) (let-values (((sum) (let-values (((sum) sum)) (let-values () (#%app + i sum))))) (if (#%expression (#%app all-cont? pos i)) (#%app for-loop sum (#%app pos-next pos)) sum)) sum)) sum)))) for-loop) - unboxed call site
 #f line #f col #f - for-loop - unboxed let loop
 3.0+6.0i
 )
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions1.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions1.rkt
index 13859b9b..991ee793 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions1.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions1.rkt
@@ -1,22 +1,21 @@
 #;
 (
-unboxed-let-functions1.rkt line 29 col 45 - x - unbox float-complex
-unboxed-let-functions1.rkt line 29 col 47 - 3.0+6.0i - unboxed literal
-unboxed-let-functions1.rkt line 29 col 43 - + - unboxed binary float complex
-unboxed-let-functions1.rkt line 29 col 42 - (#%app + x (quote 3.0+6.0i)) - unboxed float complex
-unboxed-let-functions1.rkt line 29 col 20 - x - unboxed var -> table
-unboxed-let-functions1.rkt line 29 col 7 - f - unboxed function -> table
-unboxed-let-functions1.rkt line 29 col 7 - f - fun -> unboxed fun
-unboxed-let-functions1.rkt line 29 col 45 - x - leave var unboxed
-unboxed-let-functions1.rkt line 29 col 47 - 3.0+6.0i - unboxed literal
-unboxed-let-functions1.rkt line 29 col 43 - + - unboxed binary float complex
-unboxed-let-functions1.rkt line 29 col 42 - (#%app + x (quote 3.0+6.0i)) - unboxed float complex
-unboxed-let-functions1.rkt line 29 col 0 - (let-values (((f) (lambda (x) (#%app + x (quote 3.0+6.0i))))) (#%app f (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)))) - unboxed let bindings
-unboxed-let-functions1.rkt line 30 col 8 - 1.0+2.0i - unboxed literal
-unboxed-let-functions1.rkt line 30 col 17 - 2.0+4.0i - unboxed literal
-unboxed-let-functions1.rkt line 30 col 6 - + - unboxed binary float complex
-unboxed-let-functions1.rkt line 30 col 3 - f - unboxed call site
-unboxed-let-functions1.rkt line 30 col 3 - f - call to fun with unboxed args
+unboxed-let-functions1.rkt line 28 col 45 - x - unbox float-complex
+unboxed-let-functions1.rkt line 28 col 47 - 3.0+6.0i - unboxed literal
+unboxed-let-functions1.rkt line 28 col 43 - + - unboxed binary float complex
+unboxed-let-functions1.rkt line 28 col 42 - (#%app + x (quote 3.0+6.0i)) - unboxed float complex
+unboxed-let-functions1.rkt line 28 col 20 - x - unboxed var -> table
+unboxed-let-functions1.rkt line 28 col 7 - f - unboxed function -> table
+unboxed-let-functions1.rkt line 28 col 7 - f - fun -> unboxed fun
+unboxed-let-functions1.rkt line 28 col 45 - x - leave var unboxed
+unboxed-let-functions1.rkt line 28 col 47 - 3.0+6.0i - unboxed literal
+unboxed-let-functions1.rkt line 28 col 43 - + - unboxed binary float complex
+unboxed-let-functions1.rkt line 28 col 42 - (#%app + x (quote 3.0+6.0i)) - unboxed float complex
+unboxed-let-functions1.rkt line 29 col 8 - 1.0+2.0i - unboxed literal
+unboxed-let-functions1.rkt line 29 col 17 - 2.0+4.0i - unboxed literal
+unboxed-let-functions1.rkt line 29 col 6 - + - unboxed binary float complex
+unboxed-let-functions1.rkt line 29 col 3 - f - unboxed call site
+unboxed-let-functions1.rkt line 29 col 3 - f - call to fun with unboxed args
 6.0+12.0i
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions2.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions2.rkt
index 3dd599be..4282f227 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions2.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions2.rkt
@@ -1,28 +1,27 @@
 #;
 (
-unboxed-let-functions2.rkt line 36 col 21 - x - unbox float-complex
-unboxed-let-functions2.rkt line 36 col 23 - y - unbox float-complex
-unboxed-let-functions2.rkt line 36 col 19 - + - unboxed binary float complex
-unboxed-let-functions2.rkt line 36 col 18 - (#%app + x y) - unboxed float complex
-unboxed-let-functions2.rkt line 35 col 20 - x - unboxed var -> table
-unboxed-let-functions2.rkt line 36 col 21 - x - unbox float-complex
-unboxed-let-functions2.rkt line 36 col 23 - y - unbox float-complex
-unboxed-let-functions2.rkt line 36 col 19 - + - unboxed binary float complex
-unboxed-let-functions2.rkt line 36 col 18 - (#%app + x y) - unboxed float complex
-unboxed-let-functions2.rkt line 35 col 42 - y - unboxed var -> table
-unboxed-let-functions2.rkt line 35 col 7 - f - unboxed function -> table
-unboxed-let-functions2.rkt line 35 col 7 - f - fun -> unboxed fun
-unboxed-let-functions2.rkt line 36 col 21 - x - leave var unboxed
-unboxed-let-functions2.rkt line 36 col 23 - y - leave var unboxed
-unboxed-let-functions2.rkt line 36 col 19 - + - unboxed binary float complex
-unboxed-let-functions2.rkt line 36 col 18 - (#%app + x y) - unboxed float complex
-unboxed-let-functions2.rkt line 35 col 0 - (let-values (((f) (lambda (x y) (#%app + x y)))) (#%app f (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) (quote 3.0+6.0i))) - unboxed let bindings
-unboxed-let-functions2.rkt line 37 col 8 - 1.0+2.0i - unboxed literal
-unboxed-let-functions2.rkt line 37 col 17 - 2.0+4.0i - unboxed literal
-unboxed-let-functions2.rkt line 37 col 6 - + - unboxed binary float complex
-unboxed-let-functions2.rkt line 38 col 5 - 3.0+6.0i - unboxed literal
-unboxed-let-functions2.rkt line 37 col 3 - f - unboxed call site
-unboxed-let-functions2.rkt line 37 col 3 - f - call to fun with unboxed args
+unboxed-let-functions2.rkt line 35 col 21 - x - unbox float-complex
+unboxed-let-functions2.rkt line 35 col 23 - y - unbox float-complex
+unboxed-let-functions2.rkt line 35 col 19 - + - unboxed binary float complex
+unboxed-let-functions2.rkt line 35 col 18 - (#%app + x y) - unboxed float complex
+unboxed-let-functions2.rkt line 34 col 20 - x - unboxed var -> table
+unboxed-let-functions2.rkt line 35 col 21 - x - unbox float-complex
+unboxed-let-functions2.rkt line 35 col 23 - y - unbox float-complex
+unboxed-let-functions2.rkt line 35 col 19 - + - unboxed binary float complex
+unboxed-let-functions2.rkt line 35 col 18 - (#%app + x y) - unboxed float complex
+unboxed-let-functions2.rkt line 34 col 42 - y - unboxed var -> table
+unboxed-let-functions2.rkt line 34 col 7 - f - unboxed function -> table
+unboxed-let-functions2.rkt line 34 col 7 - f - fun -> unboxed fun
+unboxed-let-functions2.rkt line 35 col 21 - x - leave var unboxed
+unboxed-let-functions2.rkt line 35 col 23 - y - leave var unboxed
+unboxed-let-functions2.rkt line 35 col 19 - + - unboxed binary float complex
+unboxed-let-functions2.rkt line 35 col 18 - (#%app + x y) - unboxed float complex
+unboxed-let-functions2.rkt line 36 col 8 - 1.0+2.0i - unboxed literal
+unboxed-let-functions2.rkt line 36 col 17 - 2.0+4.0i - unboxed literal
+unboxed-let-functions2.rkt line 36 col 6 - + - unboxed binary float complex
+unboxed-let-functions2.rkt line 37 col 5 - 3.0+6.0i - unboxed literal
+unboxed-let-functions2.rkt line 36 col 3 - f - unboxed call site
+unboxed-let-functions2.rkt line 36 col 3 - f - call to fun with unboxed args
 6.0+12.0i
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions3.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions3.rkt
index 74298a16..737a2068 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions3.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions3.rkt
@@ -1,22 +1,21 @@
 #;
 (
-unboxed-let-functions3.rkt line 30 col 21 - x - unbox float-complex
-unboxed-let-functions3.rkt line 30 col 23 - y - float-coerce-expr in complex ops
-unboxed-let-functions3.rkt line 30 col 19 - + - unboxed binary float complex
-unboxed-let-functions3.rkt line 30 col 18 - (#%app + x y) - unboxed float complex
-unboxed-let-functions3.rkt line 29 col 20 - x - unboxed var -> table
-unboxed-let-functions3.rkt line 29 col 7 - f - unboxed function -> table
-unboxed-let-functions3.rkt line 29 col 7 - f - fun -> unboxed fun
-unboxed-let-functions3.rkt line 30 col 21 - x - leave var unboxed
-unboxed-let-functions3.rkt line 30 col 23 - y - float-coerce-expr in complex ops
-unboxed-let-functions3.rkt line 30 col 19 - + - unboxed binary float complex
-unboxed-let-functions3.rkt line 30 col 18 - (#%app + x y) - unboxed float complex
-unboxed-let-functions3.rkt line 29 col 0 - (let-values (((f) (lambda (x y) (#%app + x y)))) (#%app f (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) (quote 3.0))) - unboxed let bindings
-unboxed-let-functions3.rkt line 31 col 8 - 1.0+2.0i - unboxed literal
-unboxed-let-functions3.rkt line 31 col 17 - 2.0+4.0i - unboxed literal
-unboxed-let-functions3.rkt line 31 col 6 - + - unboxed binary float complex
-unboxed-let-functions3.rkt line 31 col 3 - f - unboxed call site
-unboxed-let-functions3.rkt line 31 col 3 - f - call to fun with unboxed args
+unboxed-let-functions3.rkt line 29 col 21 - x - unbox float-complex
+unboxed-let-functions3.rkt line 29 col 23 - y - float-coerce-expr in complex ops
+unboxed-let-functions3.rkt line 29 col 19 - + - unboxed binary float complex
+unboxed-let-functions3.rkt line 29 col 18 - (#%app + x y) - unboxed float complex
+unboxed-let-functions3.rkt line 28 col 20 - x - unboxed var -> table
+unboxed-let-functions3.rkt line 28 col 7 - f - unboxed function -> table
+unboxed-let-functions3.rkt line 28 col 7 - f - fun -> unboxed fun
+unboxed-let-functions3.rkt line 29 col 21 - x - leave var unboxed
+unboxed-let-functions3.rkt line 29 col 23 - y - float-coerce-expr in complex ops
+unboxed-let-functions3.rkt line 29 col 19 - + - unboxed binary float complex
+unboxed-let-functions3.rkt line 29 col 18 - (#%app + x y) - unboxed float complex
+unboxed-let-functions3.rkt line 30 col 8 - 1.0+2.0i - unboxed literal
+unboxed-let-functions3.rkt line 30 col 17 - 2.0+4.0i - unboxed literal
+unboxed-let-functions3.rkt line 30 col 6 - + - unboxed binary float complex
+unboxed-let-functions3.rkt line 30 col 3 - f - unboxed call site
+unboxed-let-functions3.rkt line 30 col 3 - f - call to fun with unboxed args
 6.0+6.0i
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions4.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions4.rkt
index eab9b166..12f4d0a0 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions4.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions4.rkt
@@ -1,22 +1,21 @@
 #;
 (
-unboxed-let-functions4.rkt line 30 col 21 - x - unbox float-complex
-unboxed-let-functions4.rkt line 30 col 23 - y - float-coerce-expr in complex ops
-unboxed-let-functions4.rkt line 30 col 19 - + - unboxed binary float complex
-unboxed-let-functions4.rkt line 30 col 18 - (#%app + x y) - unboxed float complex
-unboxed-let-functions4.rkt line 29 col 32 - x - unboxed var -> table
-unboxed-let-functions4.rkt line 29 col 7 - f - unboxed function -> table
-unboxed-let-functions4.rkt line 29 col 7 - f - fun -> unboxed fun
-unboxed-let-functions4.rkt line 30 col 21 - x - leave var unboxed
-unboxed-let-functions4.rkt line 30 col 23 - y - float-coerce-expr in complex ops
-unboxed-let-functions4.rkt line 30 col 19 - + - unboxed binary float complex
-unboxed-let-functions4.rkt line 30 col 18 - (#%app + x y) - unboxed float complex
-unboxed-let-functions4.rkt line 29 col 0 - (let-values (((f) (lambda (y x) (#%app + x y)))) (#%app f (quote 3.0) (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)))) - unboxed let bindings
-unboxed-let-functions4.rkt line 32 col 8 - 1.0+2.0i - unboxed literal
-unboxed-let-functions4.rkt line 32 col 17 - 2.0+4.0i - unboxed literal
-unboxed-let-functions4.rkt line 32 col 6 - + - unboxed binary float complex
-unboxed-let-functions4.rkt line 31 col 3 - f - unboxed call site
-unboxed-let-functions4.rkt line 31 col 3 - f - call to fun with unboxed args
+unboxed-let-functions4.rkt line 29 col 21 - x - unbox float-complex
+unboxed-let-functions4.rkt line 29 col 23 - y - float-coerce-expr in complex ops
+unboxed-let-functions4.rkt line 29 col 19 - + - unboxed binary float complex
+unboxed-let-functions4.rkt line 29 col 18 - (#%app + x y) - unboxed float complex
+unboxed-let-functions4.rkt line 28 col 32 - x - unboxed var -> table
+unboxed-let-functions4.rkt line 28 col 7 - f - unboxed function -> table
+unboxed-let-functions4.rkt line 28 col 7 - f - fun -> unboxed fun
+unboxed-let-functions4.rkt line 29 col 21 - x - leave var unboxed
+unboxed-let-functions4.rkt line 29 col 23 - y - float-coerce-expr in complex ops
+unboxed-let-functions4.rkt line 29 col 19 - + - unboxed binary float complex
+unboxed-let-functions4.rkt line 29 col 18 - (#%app + x y) - unboxed float complex
+unboxed-let-functions4.rkt line 31 col 8 - 1.0+2.0i - unboxed literal
+unboxed-let-functions4.rkt line 31 col 17 - 2.0+4.0i - unboxed literal
+unboxed-let-functions4.rkt line 31 col 6 - + - unboxed binary float complex
+unboxed-let-functions4.rkt line 30 col 3 - f - unboxed call site
+unboxed-let-functions4.rkt line 30 col 3 - f - call to fun with unboxed args
 6.0+6.0i
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions5.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions5.rkt
index 6ba6003f..0505dea8 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions5.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions5.rkt
@@ -1,11 +1,9 @@
 #;
 (
-unboxed-let-functions5.rkt line 20 col 22 - (let-values (((y) f)) x) - unboxed let bindings
-unboxed-let-functions5.rkt line 18 col 0 - (letrec-values (((f) (lambda (x) (let-values (((y) f)) x)))) (#%app f (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)))) - unboxed let bindings
-unboxed-let-functions5.rkt line 22 col 15 - 1.0+2.0i - unboxed literal
-unboxed-let-functions5.rkt line 22 col 24 - 2.0+4.0i - unboxed literal
-unboxed-let-functions5.rkt line 22 col 13 - + - unboxed binary float complex
-unboxed-let-functions5.rkt line 22 col 12 - (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) - unboxed float complex
+unboxed-let-functions5.rkt line 20 col 15 - 1.0+2.0i - unboxed literal
+unboxed-let-functions5.rkt line 20 col 24 - 2.0+4.0i - unboxed literal
+unboxed-let-functions5.rkt line 20 col 13 - + - unboxed binary float complex
+unboxed-let-functions5.rkt line 20 col 12 - (#%app + (quote 1.0+2.0i) (quote 2.0+4.0i)) - unboxed float complex
 3.0+6.0i
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt
index be9b6c72..8f52c88d 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions6.rkt
@@ -1,27 +1,26 @@
 #;
 (
-unboxed-let-functions6.rkt line 36 col 13 - z - unbox float-complex
-unboxed-let-functions6.rkt line 36 col 15 - 0.0+1.0i - unboxed literal
-unboxed-let-functions6.rkt line 36 col 11 - + - unboxed binary float complex
-unboxed-let-functions6.rkt line 36 col 10 - (#%app + z (quote 0.0+1.0i)) - unboxed float complex
-unboxed-let-functions6.rkt line 33 col 31 - z - unboxed var -> table
-unboxed-let-functions6.rkt line 33 col 6 - loop - unboxed function -> table
-unboxed-let-functions6.rkt line 33 col 6 - loop - fun -> unboxed fun
-unboxed-let-functions6.rkt line 36 col 13 - z - leave var unboxed
-unboxed-let-functions6.rkt line 36 col 15 - 0.0+1.0i - unboxed literal
-unboxed-let-functions6.rkt line 36 col 11 - + - unboxed binary float complex
-unboxed-let-functions6.rkt line 36 col 10 - (#%app + z (quote 0.0+1.0i)) - unboxed float complex
-unboxed-let-functions6.rkt line 37 col 19 - z - leave var unboxed
-unboxed-let-functions6.rkt line 37 col 22 - car - pair
-unboxed-let-functions6.rkt line 37 col 21 - (#%app car l) - float-coerce-expr in complex ops
-unboxed-let-functions6.rkt line 37 col 17 - + - unboxed binary float complex
-unboxed-let-functions6.rkt line 37 col 11 - loop - unboxed call site
-unboxed-let-functions6.rkt line 38 col 17 - cdr - pair
-unboxed-let-functions6.rkt line 37 col 11 - loop - call to fun with unboxed args
-#f line #f col #f - (letrec-values (((loop) (lambda (z l) (if (#%app null? l) (#%app + z (quote 0.0+1.0i)) (#%app loop (#%app + z (#%app car l)) (#%app cdr l)))))) loop) - unboxed let bindings
-unboxed-let-functions6.rkt line 33 col 51 - 0.0+0.0i - unboxed literal
+unboxed-let-functions6.rkt line 35 col 13 - z - unbox float-complex
+unboxed-let-functions6.rkt line 35 col 15 - 0.0+1.0i - unboxed literal
+unboxed-let-functions6.rkt line 35 col 11 - + - unboxed binary float complex
+unboxed-let-functions6.rkt line 35 col 10 - (#%app + z (quote 0.0+1.0i)) - unboxed float complex
+unboxed-let-functions6.rkt line 32 col 31 - z - unboxed var -> table
+unboxed-let-functions6.rkt line 32 col 6 - loop - unboxed function -> table
+unboxed-let-functions6.rkt line 32 col 6 - loop - fun -> unboxed fun
+unboxed-let-functions6.rkt line 35 col 13 - z - leave var unboxed
+unboxed-let-functions6.rkt line 35 col 15 - 0.0+1.0i - unboxed literal
+unboxed-let-functions6.rkt line 35 col 11 - + - unboxed binary float complex
+unboxed-let-functions6.rkt line 35 col 10 - (#%app + z (quote 0.0+1.0i)) - unboxed float complex
+unboxed-let-functions6.rkt line 36 col 19 - z - leave var unboxed
+unboxed-let-functions6.rkt line 36 col 22 - car - pair
+unboxed-let-functions6.rkt line 36 col 21 - (#%app car l) - float-coerce-expr in complex ops
+unboxed-let-functions6.rkt line 36 col 17 - + - unboxed binary float complex
+unboxed-let-functions6.rkt line 36 col 11 - loop - unboxed call site
+unboxed-let-functions6.rkt line 37 col 17 - cdr - pair
+unboxed-let-functions6.rkt line 36 col 11 - loop - call to fun with unboxed args
+unboxed-let-functions6.rkt line 32 col 51 - 0.0+0.0i - unboxed literal
 #f line #f col #f - (letrec-values (((loop) (lambda (z l) (if (#%app null? l) (#%app + z (quote 0.0+1.0i)) (#%app loop (#%app + z (#%app car l)) (#%app cdr l)))))) loop) - unboxed call site
-unboxed-let-functions6.rkt line 33 col 6 - loop - unboxed let loop
+unboxed-let-functions6.rkt line 32 col 6 - loop - unboxed let loop
 6.0+1.0i
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt
index b6bf4de4..96e07c09 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions7.rkt
@@ -1,25 +1,24 @@
 #;
 (
-unboxed-let-functions7.rkt line 35 col 15 - z - unbox float-complex
-unboxed-let-functions7.rkt line 35 col 18 - car - pair
-unboxed-let-functions7.rkt line 35 col 17 - (#%app car l) - float-coerce-expr in complex ops
-unboxed-let-functions7.rkt line 35 col 13 - + - unboxed binary float complex
-unboxed-let-functions7.rkt line 35 col 12 - (#%app + z (#%app car l)) - unboxed float complex
-unboxed-let-functions7.rkt line 31 col 31 - z - unboxed var -> table
-unboxed-let-functions7.rkt line 31 col 6 - loop - unboxed function -> table
-unboxed-let-functions7.rkt line 31 col 6 - loop - fun -> unboxed fun
-unboxed-let-functions7.rkt line 34 col 6 - z - unboxed complex variable
-unboxed-let-functions7.rkt line 35 col 15 - z - leave var unboxed
-unboxed-let-functions7.rkt line 35 col 18 - car - pair
-unboxed-let-functions7.rkt line 35 col 17 - (#%app car l) - float-coerce-expr in complex ops
-unboxed-let-functions7.rkt line 35 col 13 - + - unboxed binary float complex
-unboxed-let-functions7.rkt line 35 col 7 - loop - unboxed call site
-unboxed-let-functions7.rkt line 36 col 13 - cdr - pair
-unboxed-let-functions7.rkt line 35 col 7 - loop - call to fun with unboxed args
-#f line #f col #f - (letrec-values (((loop) (lambda (z l) (if (#%app null? l) z (#%app loop (#%app + z (#%app car l)) (#%app cdr l)))))) loop) - unboxed let bindings
-unboxed-let-functions7.rkt line 31 col 51 - 0.0+0.0i - unboxed literal
+unboxed-let-functions7.rkt line 34 col 15 - z - unbox float-complex
+unboxed-let-functions7.rkt line 34 col 18 - car - pair
+unboxed-let-functions7.rkt line 34 col 17 - (#%app car l) - float-coerce-expr in complex ops
+unboxed-let-functions7.rkt line 34 col 13 - + - unboxed binary float complex
+unboxed-let-functions7.rkt line 34 col 12 - (#%app + z (#%app car l)) - unboxed float complex
+unboxed-let-functions7.rkt line 30 col 31 - z - unboxed var -> table
+unboxed-let-functions7.rkt line 30 col 6 - loop - unboxed function -> table
+unboxed-let-functions7.rkt line 30 col 6 - loop - fun -> unboxed fun
+unboxed-let-functions7.rkt line 33 col 6 - z - unboxed complex variable
+unboxed-let-functions7.rkt line 34 col 15 - z - leave var unboxed
+unboxed-let-functions7.rkt line 34 col 18 - car - pair
+unboxed-let-functions7.rkt line 34 col 17 - (#%app car l) - float-coerce-expr in complex ops
+unboxed-let-functions7.rkt line 34 col 13 - + - unboxed binary float complex
+unboxed-let-functions7.rkt line 34 col 7 - loop - unboxed call site
+unboxed-let-functions7.rkt line 35 col 13 - cdr - pair
+unboxed-let-functions7.rkt line 34 col 7 - loop - call to fun with unboxed args
+unboxed-let-functions7.rkt line 30 col 51 - 0.0+0.0i - unboxed literal
 #f line #f col #f - (letrec-values (((loop) (lambda (z l) (if (#%app null? l) z (#%app loop (#%app + z (#%app car l)) (#%app cdr l)))))) loop) - unboxed call site
-unboxed-let-functions7.rkt line 31 col 6 - loop - unboxed let loop
+unboxed-let-functions7.rkt line 30 col 6 - loop - unboxed let loop
 6.0+0.0i
 )
 
diff --git a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions8.rkt b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions8.rkt
index ad38880b..73f41df3 100644
--- a/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions8.rkt
+++ b/collects/tests/typed-scheme/optimizer/tests/unboxed-let-functions8.rkt
@@ -1,10 +1,9 @@
 #;
 (
-unboxed-let-functions8.rkt line 16 col 67 - x - unbox float-complex
-unboxed-let-functions8.rkt line 16 col 69 - 2.0+4.0i - unboxed literal
-unboxed-let-functions8.rkt line 16 col 65 - + - unboxed binary float complex
-unboxed-let-functions8.rkt line 16 col 64 - (#%app + x (quote 2.0+4.0i)) - unboxed float complex
-unboxed-let-functions8.rkt line 16 col 0 - (letrec-values (((f) (lambda (x) (#%app + x (quote 2.0+4.0i)))) ((g) f)) (#%app f (quote 1.0+2.0i))) - unboxed let bindings
+unboxed-let-functions8.rkt line 15 col 67 - x - unbox float-complex
+unboxed-let-functions8.rkt line 15 col 69 - 2.0+4.0i - unboxed literal
+unboxed-let-functions8.rkt line 15 col 65 - + - unboxed binary float complex
+unboxed-let-functions8.rkt line 15 col 64 - (#%app + x (quote 2.0+4.0i)) - unboxed float complex
 3.0+6.0i
 )
 
diff --git a/collects/typed-scheme/optimizer/unboxed-let.rkt b/collects/typed-scheme/optimizer/unboxed-let.rkt
index 16764d85..7ef2dc0a 100644
--- a/collects/typed-scheme/optimizer/unboxed-let.rkt
+++ b/collects/typed-scheme/optimizer/unboxed-let.rkt
@@ -126,13 +126,18 @@
            #:with (opt-functions:unboxed-fun-clause ...) #'(function-candidates ...)
            #:with (opt-others:opt-let-clause ...) #'(others ...)
            #:with opt
-           (begin (log-optimization "unboxed let bindings" this-syntax)
+           (begin (when (not (null? (syntax->list #'(opt-candidates.id ...))))
+                    ;; only log when we actually optimize
+                    (log-optimization "unboxed let bindings" this-syntax))
                   ;; add the unboxed bindings to the table, for them to be used by
                   ;; further optimizations
                   (for ((v (in-list (syntax->list #'(opt-candidates.id ...))))
                         (r (in-list (syntax->list #'(opt-candidates.real-binding ...))))
                         (i (in-list (syntax->list #'(opt-candidates.imag-binding ...)))))
                        (dict-set! unboxed-vars-table v (list r i)))
+                  ;; in the case where no bindings are unboxed, we create a let
+                  ;; that is equivalent to the original, but with all parts
+                  ;; optimized
                   #`(letk.key ...
                         (opt-candidates.bindings ... ...
                          opt-functions.res ...

From 9b5a5a6bb5889bcb99fdfeb05e8db30432f97019 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 20 Oct 2010 14:31:52 -0400
Subject: [PATCH 169/198] Fix opt-lambda:. Merge to 5.0.2.

original commit: a15236ea4f1ba84c9351632e9469e1cd34b5375b
---
 collects/tests/typed-scheme/succeed/opt-lambda.rkt | 9 +++++++++
 collects/typed-scheme/private/prims.rkt            | 1 +
 2 files changed, 10 insertions(+)
 create mode 100644 collects/tests/typed-scheme/succeed/opt-lambda.rkt

diff --git a/collects/tests/typed-scheme/succeed/opt-lambda.rkt b/collects/tests/typed-scheme/succeed/opt-lambda.rkt
new file mode 100644
index 00000000..5a55dd7b
--- /dev/null
+++ b/collects/tests/typed-scheme/succeed/opt-lambda.rkt
@@ -0,0 +1,9 @@
+#lang typed/racket
+
+(: opt (case-lambda ( -> Void)
+                    (Integer -> Void)))
+(define opt
+  (opt-lambda: ((n : Integer 0))
+    (display n)))
+(opt)
+(opt 1)
diff --git a/collects/typed-scheme/private/prims.rkt b/collects/typed-scheme/private/prims.rkt
index 92e9247f..2f0a636b 100644
--- a/collects/typed-scheme/private/prims.rkt
+++ b/collects/typed-scheme/private/prims.rkt
@@ -34,6 +34,7 @@ This file defines two sorts of primitives. All of them are provided into any mod
          "base-types.rkt"
          "base-types-extra.rkt"
          racket/flonum ; for for/flvector and for*/flvector
+         mzlib/etc
          (for-syntax 
           syntax/parse
 	  syntax/private/util

From 28406c50937f8fdd1de3688d2f6d0ed7833d4f8b Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Mon, 25 Oct 2010 10:51:35 -0600
Subject: [PATCH 170/198] swap `vector*-ref' and `vector-ref', etc.  Merge to
 5.0.2

original commit: 5d8e000d6d37cb9a032f4bcf4d82c63d8e51bae1
---
 collects/typed-scheme/optimizer/box.rkt      | 4 ++--
 collects/typed-scheme/optimizer/sequence.rkt | 4 ++--
 collects/typed-scheme/optimizer/vector.rkt   | 6 +++---
 3 files changed, 7 insertions(+), 7 deletions(-)

diff --git a/collects/typed-scheme/optimizer/box.rkt b/collects/typed-scheme/optimizer/box.rkt
index 7ad707e7..8642c368 100644
--- a/collects/typed-scheme/optimizer/box.rkt
+++ b/collects/typed-scheme/optimizer/box.rkt
@@ -21,8 +21,8 @@
 (define-syntax-class box-op
   #:commit
   ;; we need the * versions of these unsafe operations to be chaperone-safe
-  (pattern (~literal unbox)    #:with unsafe #'unsafe-unbox*)
-  (pattern (~literal set-box!) #:with unsafe #'unsafe-set-box*!))
+  (pattern (~literal unbox)    #:with unsafe #'unsafe-unbox)
+  (pattern (~literal set-box!) #:with unsafe #'unsafe-set-box!))
 
 (define-syntax-class box-opt-expr
   #:commit
diff --git a/collects/typed-scheme/optimizer/sequence.rkt b/collects/typed-scheme/optimizer/sequence.rkt
index f050e91e..2ca95990 100644
--- a/collects/typed-scheme/optimizer/sequence.rkt
+++ b/collects/typed-scheme/optimizer/sequence.rkt
@@ -51,8 +51,8 @@
            #:with opt
            (begin (log-optimization "in-vector" #'op)
                   #'(let* ((i   v*.opt)
-                           (len (unsafe-vector*-length i)))
-                      (values (lambda (x) (unsafe-vector*-ref i x))
+                           (len (unsafe-vector-length i)))
+                      (values (lambda (x) (unsafe-vector-ref i x))
                               (lambda (x) (unsafe-fx+ 1 x))
                               0
                               (lambda (x) (unsafe-fx< x len))
diff --git a/collects/typed-scheme/optimizer/vector.rkt b/collects/typed-scheme/optimizer/vector.rkt
index 6e3195d9..776a796f 100644
--- a/collects/typed-scheme/optimizer/vector.rkt
+++ b/collects/typed-scheme/optimizer/vector.rkt
@@ -14,8 +14,8 @@
 (define-syntax-class vector-op
   #:commit
   ;; we need the * versions of these unsafe operations to be chaperone-safe
-  (pattern (~literal vector-ref)  #:with unsafe #'unsafe-vector*-ref)
-  (pattern (~literal vector-set!) #:with unsafe #'unsafe-vector*-set!))
+  (pattern (~literal vector-ref)  #:with unsafe #'unsafe-vector-ref)
+  (pattern (~literal vector-set!) #:with unsafe #'unsafe-vector-set!))
 
 (define-syntax-class vector-expr
   #:commit
@@ -43,7 +43,7 @@
   (pattern (#%plain-app (~and op (~literal vector-length)) v:expr)
            #:with opt
            (begin (log-optimization "vector-length" #'op)
-                  #`(unsafe-vector*-length #,((optimize) #'v))))
+                  #`(unsafe-vector-length #,((optimize) #'v))))
   ;; same for flvector-length
   (pattern (#%plain-app (~and op (~literal flvector-length)) v:expr)
            #:with opt

From db3c6bbbe0131f387b8b0740901519c6f0a027e1 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Tue, 26 Oct 2010 16:37:52 -0400
Subject: [PATCH 171/198] Avoid dumb parsing bugs in require/typed.

original commit: 561fdc8db580c828a45dc27c4ca61b21dccad311
---
 .../typed-scheme/succeed/require-typed-parse.rkt | 16 ++++++++++++++++
 collects/typed-scheme/private/prims.rkt          |  6 +++++-
 2 files changed, 21 insertions(+), 1 deletion(-)
 create mode 100644 collects/tests/typed-scheme/succeed/require-typed-parse.rkt

diff --git a/collects/tests/typed-scheme/succeed/require-typed-parse.rkt b/collects/tests/typed-scheme/succeed/require-typed-parse.rkt
new file mode 100644
index 00000000..faa11648
--- /dev/null
+++ b/collects/tests/typed-scheme/succeed/require-typed-parse.rkt
@@ -0,0 +1,16 @@
+#lang racket/load
+
+(module m1 racket
+  (define x (make-parameter 1))
+  (define y 1)
+  (provide y)
+  (provide/contract [x (parameter/c number?)]))
+
+(module m2 typed/racket
+  (require/typed 'm1
+                 [y Number]
+                 [x (Parameterof Number)])
+  (x 1)
+  (x))
+
+(require 'm2)
diff --git a/collects/typed-scheme/private/prims.rkt b/collects/typed-scheme/private/prims.rkt
index 2f0a636b..46475ac2 100644
--- a/collects/typed-scheme/private/prims.rkt
+++ b/collects/typed-scheme/private/prims.rkt
@@ -84,9 +84,13 @@ This file defines two sorts of primitives. All of them are provided into any mod
        (raise-syntax-error #f "at least one specification is required" stx))
      #'(begin 
 	 (require/opaque-type oc.ty oc.pred lib . oc.opt) ...
-	 (require/typed sc.nm sc.ty lib) ... 
+	 (require/typed #:internal sc.nm sc.ty lib) ... 
 	 (require-typed-struct strc.nm (strc.body ...) lib) ...)]
     [(_ nm:opt-rename ty lib (~optional [~seq #:struct-maker parent]) ...)
+     #`(require/typed #:internal nm ty lib #,@(if (attribute parent)
+                                                  #'(#:struct-maker parent)
+                                                  #'()))]
+    [(_ #:internal nm:opt-rename ty lib (~optional [~seq #:struct-maker parent]) ...)
      (with-syntax ([cnt* (generate-temporary #'nm.nm)]
 		   [sm (if (attribute parent)
                            #'(#:struct-maker parent)

From b5d29776df7c01ede7bc6c1ff1210f394fdacd41 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 20 Oct 2010 15:15:14 -0400
Subject: [PATCH 172/198] Add optional argument to make-hash and co.

original commit: c633913b9484c623ca6e56c7b485613c9d60716b
---
 collects/typed-scheme/private/base-env.rkt | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/collects/typed-scheme/private/base-env.rkt b/collects/typed-scheme/private/base-env.rkt
index 9cb5e841..58f09fd2 100644
--- a/collects/typed-scheme/private/base-env.rkt
+++ b/collects/typed-scheme/private/base-env.rkt
@@ -548,12 +548,12 @@
 [hash-eq? (-> (make-HashtableTop) B)]
 [hash-eqv? (-> (make-HashtableTop) B)]
 [hash-weak? (-> (make-HashtableTop) B)]
-[make-hash (-poly (a b) (-> (-HT a b)))]
-[make-hasheq (-poly (a b) (-> (-HT a b)))]
-[make-hasheqv (-poly (a b) (-> (-HT a b)))]
-[make-weak-hash (-poly (a b) (-> (-HT a b)))]
-[make-weak-hasheq (-poly (a b) (-> (-HT a b)))]
-[make-weak-hasheqv (-poly (a b) (-> (-HT a b)))]
+[make-hash (-poly (a b) (->opt [(-lst (-pair a b))] (-HT a b)))]
+[make-hasheq (-poly (a b) (->opt [(-lst (-pair a b))] (-HT a b)))]
+[make-hasheqv (-poly (a b) (->opt [(-lst (-pair a b))] (-HT a b)))]
+[make-weak-hash (-poly (a b) (->opt [(-lst (-pair a b))] (-HT a b)))]
+[make-weak-hasheq (-poly (a b) (->opt [(-lst (-pair a b))] (-HT a b)))]
+[make-weak-hasheqv (-poly (a b) (->opt [(-lst (-pair a b))] (-HT a b)))]
 [make-immutable-hash (-poly (a b) (-> (-lst (-pair a b)) (-HT a b)))]
 [make-immutable-hasheq (-poly (a b) (-> (-lst (-pair a b)) (-HT a b)))]
 [make-immutable-hasheqv (-poly (a b) (-> (-lst (-pair a b)) (-HT a b)))]

From 26aafa3ea65b7f5bc7c32e5d5cf37889a69643f9 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 4 Nov 2010 11:21:40 -0400
Subject: [PATCH 173/198] Fixed potential danger with fixnum optimizations.

original commit: c0a6137c67228933ad94d88409ffd86e30e922ae
---
 .../typed-scheme/typecheck/tc-expr-unit.rkt     | 17 ++++++++++++++---
 collects/typed-scheme/types/abbrev.rkt          |  3 +++
 2 files changed, 17 insertions(+), 3 deletions(-)

diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.rkt b/collects/typed-scheme/typecheck/tc-expr-unit.rkt
index d0788b9a..0fd0402a 100644
--- a/collects/typed-scheme/typecheck/tc-expr-unit.rkt
+++ b/collects/typed-scheme/typecheck/tc-expr-unit.rkt
@@ -21,6 +21,17 @@
 (import tc-if^ tc-lambda^ tc-app^ tc-let^ check-subforms^)
 (export tc-expr^)
 
+;; Is the number a fixnum on all the platforms Racket supports?
+;; This check is done at compile time to typecheck literals.
+;; Since a zo file compiled on a 64-bit system can be used on 32-bit
+;; systems, we can't use the host fixnum? predicate, or large 64-bit
+;; fixnums will typecheck as fixnums but not be actual fixnums on the
+;; target system. In combination with fixnum typed optimizations, bad
+;; things could happen.
+(define (portable-fixnum? n)
+  (and (exact-integer? n)
+       (< n (expt 2 31))))
+
 ;; return the type of a literal value
 ;; scheme-value -> type
 (define (tc-literal v-stx [expected #f])
@@ -34,9 +45,9 @@
     [i:boolean (-val (syntax-e #'i))]
     [i:identifier (-val (syntax-e #'i))]
     [0 -Zero]
-    [(~var i (3d (conjoin number? fixnum? positive?))) -PositiveFixnum]
-    [(~var i (3d (conjoin number? fixnum? negative?))) -NegativeFixnum]
-    [(~var i (3d (conjoin number? fixnum?))) -Fixnum]
+    [(~var i (3d (conjoin number? portable-fixnum? positive?))) -PositiveFixnum]
+    [(~var i (3d (conjoin number? portable-fixnum? negative?))) -NegativeFixnum]
+    [(~var i (3d (conjoin number? portable-fixnum?))) -Fixnum]
     [(~var i (3d exact-positive-integer?)) -ExactPositiveInteger]
     [(~var i (3d exact-nonnegative-integer?)) -ExactNonnegativeInteger]
     [(~var i (3d exact-integer?)) -Integer]
diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt
index e69967b3..68bbdbfc 100644
--- a/collects/typed-scheme/types/abbrev.rkt
+++ b/collects/typed-scheme/types/abbrev.rkt
@@ -174,6 +174,9 @@
 (define -ExactPositiveInteger
   (make-Base 'Exact-Positive-Integer #'exact-positive-integer?))
 
+;; We can safely use the fixnum? prediate here, unlike in tc-expr-unit.
+;; The fixnum? here will be part of the generated contracts, which run
+;; on the target system, so we're safe.
 (define -PositiveFixnum
   (make-Base 'Positive-Fixnum #'(and/c number? fixnum? positive?)))
 (define -NegativeFixnum

From 9c5a1e0086547c9b1ca17140cb2441bdc1d438f4 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Thu, 4 Nov 2010 16:03:06 -0400
Subject: [PATCH 174/198] Fixed a fixnum typechecking issue.

original commit: 4c081c127ab91067c3a69568175d7274b090f986
---
 .../typed-scheme/unit-tests/typecheck-tests.rkt   |  6 ++++++
 collects/typed-scheme/typecheck/tc-expr-unit.rkt  | 15 ++++++---------
 collects/typed-scheme/types/abbrev.rkt            |  9 ++++-----
 3 files changed, 16 insertions(+), 14 deletions(-)

diff --git a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
index 55120943..6c82cc3c 100644
--- a/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
+++ b/collects/tests/typed-scheme/unit-tests/typecheck-tests.rkt
@@ -146,6 +146,12 @@
          N]
         (tc-e/t (if (let ([y 12]) y) 3 4) -PositiveFixnum)
         (tc-e/t 3 -PositiveFixnum)
+        (tc-e/t 100 -PositiveFixnum)
+        (tc-e/t -100 -NegativeFixnum)
+        (tc-e/t 2147483647 -PositiveFixnum)
+        (tc-e/t -2147483647 -NegativeFixnum)
+        (tc-e/t 2147483648 -Pos)
+        (tc-e/t -2147483648 -Integer)
         (tc-e/t "foo" -String)
         (tc-e (+ 3 4) -Pos)
         [tc-e/t (lambda: () 3) (t:-> -PositiveFixnum : -true-lfilter)]
diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.rkt b/collects/typed-scheme/typecheck/tc-expr-unit.rkt
index 0fd0402a..6932cf09 100644
--- a/collects/typed-scheme/typecheck/tc-expr-unit.rkt
+++ b/collects/typed-scheme/typecheck/tc-expr-unit.rkt
@@ -22,15 +22,12 @@
 (export tc-expr^)
 
 ;; Is the number a fixnum on all the platforms Racket supports?
+;; This relies on Racket being compiled only on 32+ bit systems.
 ;; This check is done at compile time to typecheck literals.
-;; Since a zo file compiled on a 64-bit system can be used on 32-bit
-;; systems, we can't use the host fixnum? predicate, or large 64-bit
-;; fixnums will typecheck as fixnums but not be actual fixnums on the
-;; target system. In combination with fixnum typed optimizations, bad
-;; things could happen.
 (define (portable-fixnum? n)
   (and (exact-integer? n)
-       (< n (expt 2 31))))
+       (< n (expt 2 31))
+       (> n (- (expt 2 31)))))
 
 ;; return the type of a literal value
 ;; scheme-value -> type
@@ -45,9 +42,9 @@
     [i:boolean (-val (syntax-e #'i))]
     [i:identifier (-val (syntax-e #'i))]
     [0 -Zero]
-    [(~var i (3d (conjoin number? portable-fixnum? positive?))) -PositiveFixnum]
-    [(~var i (3d (conjoin number? portable-fixnum? negative?))) -NegativeFixnum]
-    [(~var i (3d (conjoin number? portable-fixnum?))) -Fixnum]
+    [(~var i (3d (conjoin portable-fixnum? positive?))) -PositiveFixnum]
+    [(~var i (3d (conjoin portable-fixnum? negative?))) -NegativeFixnum]
+    [(~var i (3d (conjoin portable-fixnum?))) -Fixnum]
     [(~var i (3d exact-positive-integer?)) -ExactPositiveInteger]
     [(~var i (3d exact-nonnegative-integer?)) -ExactNonnegativeInteger]
     [(~var i (3d exact-integer?)) -Integer]
diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt
index 68bbdbfc..fa0711a3 100644
--- a/collects/typed-scheme/types/abbrev.rkt
+++ b/collects/typed-scheme/types/abbrev.rkt
@@ -174,13 +174,12 @@
 (define -ExactPositiveInteger
   (make-Base 'Exact-Positive-Integer #'exact-positive-integer?))
 
-;; We can safely use the fixnum? prediate here, unlike in tc-expr-unit.
-;; The fixnum? here will be part of the generated contracts, which run
-;; on the target system, so we're safe.
+;; We're generating a reference to fixnum? rather than calling it, so
+;; we're safe from fixnum size issues on different platforms.
 (define -PositiveFixnum
-  (make-Base 'Positive-Fixnum #'(and/c number? fixnum? positive?)))
+  (make-Base 'Positive-Fixnum #'(and/c fixnum? positive?)))
 (define -NegativeFixnum
-  (make-Base 'Negative-Fixnum #'(and/c number? fixnum? negative?)))
+  (make-Base 'Negative-Fixnum #'(and/c fixnum? negative?)))
 
 (define -Zero (-val 0))
 (define -Real (*Un -InexactReal -ExactRational))

From 46cbe83ff39b06ff31a02d19f433253f9dd46bed Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@barzilay.org>
Date: Fri, 5 Nov 2010 01:46:01 -0400
Subject: [PATCH 175/198] Clarify comment re `fixnum?' non-use at the syntax
 level, and add a note to the `fixnum?' documentation.

original commit: 9a485064ed81366579f2a5c7cebf591de7e07be2
---
 collects/typed-scheme/typecheck/tc-expr-unit.rkt | 7 ++++---
 1 file changed, 4 insertions(+), 3 deletions(-)

diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.rkt b/collects/typed-scheme/typecheck/tc-expr-unit.rkt
index 6932cf09..b5153d39 100644
--- a/collects/typed-scheme/typecheck/tc-expr-unit.rkt
+++ b/collects/typed-scheme/typecheck/tc-expr-unit.rkt
@@ -21,9 +21,10 @@
 (import tc-if^ tc-lambda^ tc-app^ tc-let^ check-subforms^)
 (export tc-expr^)
 
-;; Is the number a fixnum on all the platforms Racket supports?
-;; This relies on Racket being compiled only on 32+ bit systems.
-;; This check is done at compile time to typecheck literals.
+;; Is the number a fixnum on *all* the platforms Racket supports?  This
+;; works because Racket compiles only on 32+ bit systems.  This check is
+;; done at compile time to typecheck literals -- so use it instead of
+;; `fixnum?' to avoid creating platform-dependent .zo files.
 (define (portable-fixnum? n)
   (and (exact-integer? n)
        (< n (expt 2 31))

From 44e1994364a4271b679b2a9990b91e9fcb7a514b Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 22 Nov 2010 17:16:36 -0500
Subject: [PATCH 176/198] More precise type for sgn. Closes PR 11424.

original commit: 2c74984fcd442fd73802244801946e2d4dd8ba8c
---
 collects/typed-scheme/private/base-env-numeric.rkt | 9 ++++++++-
 1 file changed, 8 insertions(+), 1 deletion(-)

diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt
index b6f30e81..210b2f6d 100644
--- a/collects/typed-scheme/private/base-env-numeric.rkt
+++ b/collects/typed-scheme/private/base-env-numeric.rkt
@@ -434,7 +434,14 @@
 
 ;; scheme/math
 
-[sgn (-Real . -> . -Real)]
+[sgn (cl->* (-Zero . -> . -Zero)
+            (-ExactPositiveInteger . -> . -PositiveFixnum)
+            (-ExactNonnegativeInteger . -> . -NonnegativeFixnum)
+            (-ExactRational . -> . -Fixnum)
+            (-Flonum . -> . -Flonum)
+            (-InexactReal . -> . -InexactReal)
+            (-Real . -> . -Real))]
+
 [pi -NonnegativeFlonum]
 [sqr (cl->* (-> -Pos -Pos)
             (-> -Integer -Nat)

From b9303a1f4b09695bbd4e387692483156556e9fde Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 22 Nov 2010 17:21:26 -0500
Subject: [PATCH 177/198] Fix type for raise-type-error. Closes PR 11426.

original commit: e10f139ad82748ee5d6b959c1f6225886b41084d
---
 collects/typed-scheme/private/base-env-indexing-abs.rkt | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/collects/typed-scheme/private/base-env-indexing-abs.rkt b/collects/typed-scheme/private/base-env-indexing-abs.rkt
index c99ba38f..48150e6d 100644
--- a/collects/typed-scheme/private/base-env-indexing-abs.rkt
+++ b/collects/typed-scheme/private/base-env-indexing-abs.rkt
@@ -173,9 +173,9 @@
    [random (cl-> [(index-type) -Nat] [() -Real])]
    
    [raise-type-error
-    (cl->
-     [(Sym -String Univ) (Un)]
-     [(Sym -String index-type (-lst Univ)) (Un)])]
+    (cl->*
+     [-> Sym -String Univ (Un)]
+     [->* (list Sym -String index-type) Univ (Un)])]
    
    ))
  

From 67eb57c52685b3ba70f54f104db457cae0517b3c Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 22 Nov 2010 17:24:53 -0500
Subject: [PATCH 178/198] Add type for integer-sqrt. Closes PR 11427.

original commit: 7a7fe577cd464c80b4b344aef4a072c25c7652fa
---
 collects/typed-scheme/private/base-env-numeric.rkt | 6 ++++++
 1 file changed, 6 insertions(+)

diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt
index 210b2f6d..b840276b 100644
--- a/collects/typed-scheme/private/base-env-numeric.rkt
+++ b/collects/typed-scheme/private/base-env-numeric.rkt
@@ -414,6 +414,12 @@
        (-NonnegativeFlonum . -> . -NonnegativeFlonum)
        (-FloatComplex . -> . -FloatComplex)
        (N . -> . N))]
+[integer-sqrt (cl->*
+               (-Zero . -> . -Zero)
+               (-NonnegativeFixnum . -> . -NonnegativeFixnum)
+               (-Nat . -> . -Nat)
+               (-NonnegativeFlonum . -> . -NonnegativeFlonum)
+               (-Real . -> . N))]
 [log (cl->*
       (-Pos . -> . -Real)
       (-FloatComplex . -> . -FloatComplex)

From 8d3499453f81ac47f88f5948f8323ee6128a9a24 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 22 Nov 2010 17:33:53 -0500
Subject: [PATCH 179/198] Fix type for arithmetic-shift. Closes PR 11428.

original commit: 58d1f75dc1b1e2d9c17427641fa6f295aec96706
---
 collects/typed-scheme/private/base-env-numeric.rkt | 7 +++++--
 1 file changed, 5 insertions(+), 2 deletions(-)

diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt
index b840276b..b5ebab7b 100644
--- a/collects/typed-scheme/private/base-env-numeric.rkt
+++ b/collects/typed-scheme/private/base-env-numeric.rkt
@@ -338,9 +338,12 @@
                            (-Nat -Nat . -> . (-values (list -Nat -Nat)))
                            (-Integer -Integer . -> . (-values (list -Integer -Integer))))]
 
-[arithmetic-shift (cl->* (-Fixnum (Un -NegativeFixnum (-val 0)) . -> . -Fixnum)
-                         (-Nat -Nat . -> . -Nat)
+[arithmetic-shift (cl->* ((-val 0) (Un -NegativeFixnum (-val 0)) . -> . (-val 0))
+                         (-NonnegativeFixnum (Un -NegativeFixnum (-val 0)) . -> . -NonnegativeFixnum)
+                         (-Fixnum (Un -NegativeFixnum (-val 0)) . -> . -Fixnum)
+                         (-Nat -Integer . -> . -Nat)
                          (-Integer -Integer . -> . -Integer))]
+
 [bitwise-and (cl->* (null -NonnegativeFixnum . ->* . -NonnegativeFixnum)
                     ((list -Integer) -NonnegativeFixnum . ->* . -NonnegativeFixnum)
                     (null -Fixnum . ->* . -Fixnum)

From 26a2fd0163c1446ec84897cc4ad0f286d453afcb Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 22 Nov 2010 17:36:15 -0500
Subject: [PATCH 180/198] Add type for fl->exact-integer. Closes PR 11429.

original commit: 54991835d603a81ddaee6845e4930bfe0ab9de24
---
 collects/typed-scheme/private/base-env-numeric.rkt | 3 +++
 1 file changed, 3 insertions(+)

diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt
index b5ebab7b..88cab603 100644
--- a/collects/typed-scheme/private/base-env-numeric.rkt
+++ b/collects/typed-scheme/private/base-env-numeric.rkt
@@ -381,6 +381,9 @@
 [inexact->exact (cl->*
                  (-Real . -> . -ExactRational)
                  (N . -> . N))]
+[fl->exact-integer (cl->*
+                    (-NonnegativeFlonum . -> . -Nat)
+                    (-Flonum . -> . -Integer))]
 
 [floor rounder]
 [ceiling rounder]

From d7a8f14636c3f549d31251cd94ff7d4211236a7c Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Mon, 22 Nov 2010 17:37:40 -0500
Subject: [PATCH 181/198] Fix type for abs. Closes PR 11430.

original commit: e7c252739ddab37973cf3c013660d6c2244c44b8
---
 collects/typed-scheme/private/base-env-numeric.rkt | 1 +
 1 file changed, 1 insertion(+)

diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt
index 88cab603..045282ef 100644
--- a/collects/typed-scheme/private/base-env-numeric.rkt
+++ b/collects/typed-scheme/private/base-env-numeric.rkt
@@ -368,6 +368,7 @@
             (-Fixnum . -> . -NonnegativeFixnum)
             (-Pos . -> . -Pos)
             (-Integer . -> . -Nat)
+            (-ExactRational . -> . -ExactRational)
             (-Flonum . -> . -NonnegativeFlonum)
             (-InexactReal . -> . -InexactReal)
             (-Real . -> . -Real))]

From f844b4ed00d42ae450079b4fb979c49ea4fe52a1 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Sat, 27 Nov 2010 19:01:17 -0700
Subject: [PATCH 182/198] move Typed Racket manuals to the Languages section

original commit: 94e2d46a8eea69ea3705c3747152e9c578d0fff2
---
 collects/typed-scheme/info.rkt | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/collects/typed-scheme/info.rkt b/collects/typed-scheme/info.rkt
index c18cc35e..30046e05 100644
--- a/collects/typed-scheme/info.rkt
+++ b/collects/typed-scheme/info.rkt
@@ -1,4 +1,4 @@
 #lang setup/infotab
 
-(define scribblings '(("scribblings/ts-reference.scrbl" ())
-		      ("scribblings/ts-guide.scrbl" (multi-page))))
+(define scribblings '(("scribblings/ts-reference.scrbl" () (language -1))
+		      ("scribblings/ts-guide.scrbl" (multi-page) (language))))

From 5acfe5b67d4aeab13b11a9e3973445051d34ae7b Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 8 Dec 2010 17:49:42 -0500
Subject: [PATCH 183/198] Take into account potentially undefined values in
 letrec. Closes PR11511.

original commit: dc2df4882b6abca46839ace724924df5ab0d7707
---
 .../tests/typed-scheme/fail/safe-letrec.rkt   | 18 +++++
 .../typed-scheme/succeed/safe-letrec.rkt      | 23 ++++++
 collects/typed-scheme/private/base-types.rkt  |  1 +
 .../typed-scheme/typecheck/tc-let-unit.rkt    | 73 +++++++++++++++++--
 collects/typed-scheme/types/abbrev.rkt        |  1 +
 5 files changed, 109 insertions(+), 7 deletions(-)
 create mode 100644 collects/tests/typed-scheme/fail/safe-letrec.rkt
 create mode 100644 collects/tests/typed-scheme/succeed/safe-letrec.rkt

diff --git a/collects/tests/typed-scheme/fail/safe-letrec.rkt b/collects/tests/typed-scheme/fail/safe-letrec.rkt
new file mode 100644
index 00000000..febfb833
--- /dev/null
+++ b/collects/tests/typed-scheme/fail/safe-letrec.rkt
@@ -0,0 +1,18 @@
+#;
+(exn-pred 3)
+#lang typed/racket
+
+;; make sure letrec takes into account that some bidings may be undefined
+
+(+ (letrec: ([x : Float x]) x) 1) ; PR 11511
+
+(letrec: ([x : Number 3]
+          [y : Number z] ; bad
+          [z : Number x])
+         z)
+
+(letrec: ([x : Number 3]
+          [y : (Number -> Number) (lambda (x) z)] ; bad
+          [z : Number x]
+          [w : (Number -> Number) (lambda (x) (y x))]) ; bad too
+         z)
diff --git a/collects/tests/typed-scheme/succeed/safe-letrec.rkt b/collects/tests/typed-scheme/succeed/safe-letrec.rkt
new file mode 100644
index 00000000..c71b4203
--- /dev/null
+++ b/collects/tests/typed-scheme/succeed/safe-letrec.rkt
@@ -0,0 +1,23 @@
+#lang typed/racket
+
+;; make sure letrec takes into account that some bidings may be undefined
+
+(letrec: ([x : Number 3])
+  x)
+(letrec: ([x : Number 3]
+          [y : (-> Number) (lambda () x)]) ; lambdas are safe
+  y)
+(letrec: ([a : (-> Void) (lambda () (b))]
+          [b : (-> Void) (lambda () (a))])
+  a)
+(letrec: ([x : (Number -> Number) (lambda (y) (+ y 3))]
+          [y : Number (x 4)])
+  y)
+(letrec-values: ([([a : (-> Number)]) (lambda () 3)]
+                 [([b : (-> Number)]) (lambda () (a))]
+                 [([x : Number] [y : Number])  (values (b) (b))])
+  x)
+(letrec: ([x : Number 3]
+          [y : (Number -> Number) (lambda (x) (if z 0 1))] ; not transitively safe, but safe
+          [z : Number x])
+  z)
diff --git a/collects/typed-scheme/private/base-types.rkt b/collects/typed-scheme/private/base-types.rkt
index eceb61ec..8d3e658a 100644
--- a/collects/typed-scheme/private/base-types.rkt
+++ b/collects/typed-scheme/private/base-types.rkt
@@ -20,6 +20,7 @@
 [Zero (-val 0)]
 
 [Void -Void]
+[Undefined -Undefined] ; initial value of letrec bindings
 [Boolean -Boolean]
 [Symbol -Symbol]
 [String -String]
diff --git a/collects/typed-scheme/typecheck/tc-let-unit.rkt b/collects/typed-scheme/typecheck/tc-let-unit.rkt
index 5506bb2f..447dba5a 100644
--- a/collects/typed-scheme/typecheck/tc-let-unit.rkt
+++ b/collects/typed-scheme/typecheck/tc-let-unit.rkt
@@ -11,7 +11,7 @@
          ;racket/trace unstable/debug
          racket/match (prefix-in c: racket/contract)
          (except-in racket/contract -> ->* one-of/c)
-         syntax/kerncase syntax/parse
+         syntax/kerncase syntax/parse unstable/syntax
          unstable/debug
          (for-template 
           racket/base
@@ -115,12 +115,12 @@
     (let loop ([names names] [exprs exprs] [flat-names orig-flat-names] [clauses clauses])
       (cond 
         ;; after everything, check the body expressions
-        [(null? names) 
-         (do-check void null null form null body null expected #:abstract orig-flat-names)
-         #;
-         (if expected (tc-exprs/check (syntax->list body) expected) (tc-exprs (syntax->list body)))]
+        [(null? names)
+         ;(if expected (tc-exprs/check (syntax->list body) expected) (tc-exprs (syntax->list body)))
+         (do-check void null null form null body null expected #:abstract orig-flat-names)]
         ;; if none of the names bound in the letrec are free vars of this rhs
-        [(not (ormap (lambda (n) (s:member n flat-names bound-identifier=?)) (free-vars (car exprs))))
+        [(not (ormap (lambda (n) (s:member n flat-names bound-identifier=?))
+                     (free-vars (car exprs))))
          ;; then check this expression separately
          (with-lexical-env/extend
           (list (car names))
@@ -131,7 +131,66 @@
         [else
          ;(for-each (lambda (vs) (for-each (lambda (v) (printf/log "Letrec Var: ~a\n" (syntax-e v))) vs)) names)
          (do-check (lambda (stx e t) (tc-expr/check e t))
-                   names (map (λ (l) (ret (map get-type l))) names) form exprs body clauses expected)]))))
+                   names
+                   ;; compute set of variables that can't be undefined. see below.
+                   (let-values
+                    ([(safe-bindings _)
+                      (for/fold ([safe-bindings              '()] ; includes transitively-safe
+                                 [transitively-safe-bindings '()])
+                          ([names  names]
+                           [clause clauses])
+                        (case (safe-letrec-values-clause? clause transitively-safe-bindings)
+                          ;; transitively safe -> safe to mention in a subsequent rhs
+                          [(transitively-safe) (values (append names safe-bindings)
+                                                       (append names transitively-safe-bindings))]
+                          ;; safe -> safe by itself, but may not be safe to use in a subsequent rhs
+                          [(safe)              (values (append names safe-bindings)
+                                                       transitively-safe-bindings)]
+                          ;; unsafe -> could be undefined
+                          [(unsafe)            (values safe-bindings transitively-safe-bindings)]))])
+                    (map (λ (l) (let ([types-from-user (map get-type l)])
+                                  (ret (if (andmap (λ (x) ; are all the lhs vars safe?
+                                                      (s:member x safe-bindings bound-identifier=?))
+                                                   l)
+                                           types-from-user
+                                           (map (λ (x) (make-Union (list x -Undefined)))
+                                                types-from-user)))))
+                         names))
+                   form exprs body clauses expected)]))))
+
+;; determines whether any of the variables bound in the given clause can have an undefined value
+;; in this case, we cannot trust the type the user gave us and must union it with undefined
+;; for example, the following code:
+;;  (letrec: ([x : Float x]) x)
+;; should not typecheck with type Float, even though the user said so, because the actual value
+;; is undefined.
+;; this implements a conservative analysis.
+;; we identify 3 kinds of bindings:
+;;  - safe bindings cannot be undefined
+;;  - transitively safe bindings are safe and can safely be used in subsequent rhss
+;;  - unsafe bindings may be undefined
+;; x is transitively safe if for all its free variables, they are either transitively safe and
+;; earlier in the letrec or they are bound outside the letrec
+;; x is safe if it is transitively safe or if its rhs is a lambda
+;; otherwise, x is unsafe
+;; this function returns either 'transitively-safe, 'safe or 'unsafe
+;; Note: In some cases (such as the example on the bottom of page 6 of Ghuloum and Dybvig's
+;;  Fixing Letrec (reloaded) paper), we are more conservative than a fully-connected component
+;;  based approach. On the other hand, our algorithm should cover most interesting cases and
+;;  is much simpler than Tarjan's.
+(define (safe-letrec-values-clause? clause transitively-safe-bindings)
+  (define clause-rhs
+    (syntax-parse clause
+      [(bindings . rhs) #'rhs]))
+  (cond [(andmap (lambda (fv) (s:member fv transitively-safe-bindings bound-identifier=?))
+                 (apply append
+                        (syntax-map (lambda (x) (free-vars x))
+                                    clause-rhs)))
+         'transitively-safe]
+        [else
+         (syntax-parse clause-rhs #:literal-sets (kernel-literals)
+           [((#%plain-lambda _ ...)) 'safe]
+           [else                     'unsafe])]))
 
 ;; this is so match can provide us with a syntax property to
 ;; say that this binding is only called in tail position
diff --git a/collects/typed-scheme/types/abbrev.rkt b/collects/typed-scheme/types/abbrev.rkt
index fa0711a3..c76aa1ce 100644
--- a/collects/typed-scheme/types/abbrev.rkt
+++ b/collects/typed-scheme/types/abbrev.rkt
@@ -97,6 +97,7 @@
 (define -Boolean (make-Base 'Boolean #'boolean?))
 (define -Symbol (make-Base 'Symbol #'symbol?))
 (define -Void (make-Base 'Void #'void?))
+(define -Undefined (make-Base 'Undefined #'(lambda (x) (equal? (letrec ([y y]) y) x)))) ; initial value of letrec bindings
 (define -Bytes (make-Base 'Bytes #'bytes?))
 (define -Regexp (make-Base 'Regexp #'(and/c regexp? (not/c pregexp?) (not/c byte-regexp?))))
 (define -PRegexp (make-Base 'PRegexp #'(and/c pregexp? (not/c byte-pregexp?))))

From 05e1489dfb3573422057ea9cdcafd14842a20ef5 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Tue, 7 Dec 2010 17:26:43 -0500
Subject: [PATCH 184/198] Better handling of `hash-*' functions, and hashes as
 sequences.

original commit: 73dbf42e0e6fb750d871060d6ed34adf6e207eec
---
 .../typed-scheme/succeed/for-over-hash.rkt    |  5 +++++
 collects/typed-scheme/private/base-env.rkt    |  4 ++++
 .../typed-scheme/private/base-special-env.rkt | 20 ++++++++-----------
 collects/typed-scheme/rep/type-rep.rkt        |  3 ++-
 collects/typed-scheme/typecheck/tc-app.rkt    | 10 ++++++----
 5 files changed, 25 insertions(+), 17 deletions(-)
 create mode 100644 collects/tests/typed-scheme/succeed/for-over-hash.rkt

diff --git a/collects/tests/typed-scheme/succeed/for-over-hash.rkt b/collects/tests/typed-scheme/succeed/for-over-hash.rkt
new file mode 100644
index 00000000..be9e007b
--- /dev/null
+++ b/collects/tests/typed-scheme/succeed/for-over-hash.rkt
@@ -0,0 +1,5 @@
+#lang typed/racket
+
+(: v : (Listof Number))
+(define v (for/list ([(k v) (make-hash (list (cons 1 2) (cons 3 4)))])
+            (+ k v)))
diff --git a/collects/typed-scheme/private/base-env.rkt b/collects/typed-scheme/private/base-env.rkt
index 58f09fd2..a8e248cd 100644
--- a/collects/typed-scheme/private/base-env.rkt
+++ b/collects/typed-scheme/private/base-env.rkt
@@ -579,6 +579,10 @@
 [hash-map (-poly (a b c) ((-HT a b) (a b . -> . c) . -> . (-lst c)))]
 [hash-for-each (-poly (a b c) (-> (-HT a b) (-> a b c) -Void))]
 [hash-count (-poly (a b) (-> (-HT a b) -NonnegativeFixnum))]
+[hash-keys (-poly (a b) ((-HT a b) . -> . (-lst a)))]
+[hash-values (-poly (a b) ((-HT a b) . -> . (-lst b)))]
+[hash->list (-poly (a b) ((-HT a b) . -> . (-lst (-pair a b))))]
+
 [hash-copy (-poly (a b) (-> (-HT a b) (-HT a b)))]
 [eq-hash-code (-poly (a) (-> a -Integer))]
 [eqv-hash-code (-poly (a) (-> a -Integer))]
diff --git a/collects/typed-scheme/private/base-special-env.rkt b/collects/typed-scheme/private/base-special-env.rkt
index 2140c4fa..2c9c5a7f 100644
--- a/collects/typed-scheme/private/base-special-env.rkt
+++ b/collects/typed-scheme/private/base-special-env.rkt
@@ -52,23 +52,19 @@
      #:literals (let-values quote)
      [(let-values ([_ (m-s '(_) '())]) . _)
       #'m-s])
-   (-poly (a) 
+   (-poly (a b)
           (let ([seq-vals 
-                 (lambda ([a a])
+                 (lambda (a)
                    (-values (list 
-                             (-> Univ a)
+                             (-> Univ (-values a))
                              (-> Univ Univ)
                              Univ
                              (-> Univ Univ)
-                             (-> a Univ)
-                             (-> Univ a Univ))))])
-            (-> Univ (-seq a) (seq-vals))
-            #;
-            (cl->* (-> Univ (-lst a) (seq-vals))
-                   (-> Univ (-vec a) (seq-vals))
-                   (-> Univ -String (seq-vals -Char))
-                   (-> Univ -Bytes (seq-vals -Nat))
-                   (-> Univ -Input-Port (seq-vals -Nat)))))]
+                             (->* a Univ)
+                             (->* (cons Univ a) Univ))))])
+            (cl->*
+             (-> Univ (-seq a) (seq-vals (list a)))
+             (-> Univ (-seq a b) (seq-vals (list a b))))))]
   ;; in-range
   [(syntax-parse (local-expand #'(in-range 1) 'expression #f)
      [(i-n _ ...)
diff --git a/collects/typed-scheme/rep/type-rep.rkt b/collects/typed-scheme/rep/type-rep.rkt
index 4a7ca8b7..4cddd134 100644
--- a/collects/typed-scheme/rep/type-rep.rkt
+++ b/collects/typed-scheme/rep/type-rep.rkt
@@ -196,7 +196,8 @@
                  (hash-remove (combine-frees (map free-vars* (cons dty rs))) dbound)
                  (combine-frees (map free-vars* (cons dty rs))))
              (if (symbol? dbound)
-                 (combine-frees (cons (make-immutable-hasheq (list (cons dbound Covariant))) (map free-idxs* (cons dty rs))))
+                 (combine-frees (cons (make-immutable-hasheq (list (cons dbound Covariant))) 
+                                      (map free-idxs* (cons dty rs))))
                  (combine-frees (map free-idxs* (cons dty rs))))]
     [#:fold-rhs (*ValuesDots (map type-rec-id rs) (type-rec-id dty) dbound)])
 
diff --git a/collects/typed-scheme/typecheck/tc-app.rkt b/collects/typed-scheme/typecheck/tc-app.rkt
index 96d546e7..a2a6b1df 100644
--- a/collects/typed-scheme/typecheck/tc-app.rkt
+++ b/collects/typed-scheme/typecheck/tc-app.rkt
@@ -5,7 +5,7 @@
          "tc-app-helper.rkt" "find-annotation.rkt" "tc-funapp.rkt"
          "tc-subst.rkt" (prefix-in c: racket/contract)
          syntax/parse racket/match racket/trace scheme/list 
-	 unstable/sequence unstable/debug
+	 unstable/sequence unstable/debug unstable/list
          ;; fixme - don't need to be bound in this phase - only to make tests work
          scheme/bool
          racket/unsafe/ops
@@ -281,13 +281,15 @@
                 (tc-error/expr #:return (or expected (ret Univ)) "expected Parameter, but got ~a" t)
                 (loop (cddr args))]))))]
     ;; use the additional but normally ignored first argument to make-sequence to provide a better instantiation
-    [(#%plain-app (~var op (id-from 'make-sequence 'racket/private/for)) (~and quo ((~literal quote) (i:id))) arg:expr)
-     #:when (type-annotation #'i)     
+    [(#%plain-app (~var op (id-from 'make-sequence 'racket/private/for)) (~and quo ((~literal quote) (i:id ...))) arg:expr)
+     #:when (andmap type-annotation (syntax->list #'(i ...)))
      (match (single-value #'op)
          [(tc-result1: (and t Poly?))
           (tc-expr/check #'quo (ret Univ))
           (tc/funapp #'op #'(quo arg) 
-                     (ret (instantiate-poly t (list (type-annotation #'i))))
+                     (ret (instantiate-poly t (extend (list Univ Univ)
+                                                      (map type-annotation (syntax->list #'(i ...)))
+                                                      Univ)))
                      (list (ret Univ) (single-value #'arg))
                      expected)])]
     ;; unsafe struct operations

From 1527fba4b3332c57aec792ae79418527d37dadc4 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 8 Dec 2010 12:47:19 -0500
Subject: [PATCH 185/198] Allow arbitrary filter specification in function
 types. Allow (A -> B -> C) for curried function types.

original commit: 87eab889d68dd46bfd5b0f4d79942bc104cb3da2
---
 collects/tests/typed-scheme/run.rkt           |  2 +-
 .../{fail => succeed}/multi-arr-parse.rkt     |  4 +-
 .../unit-tests/parse-type-tests.rkt           | 10 ++-
 collects/typed-scheme/private/parse-type.rkt  | 67 ++++++++++++++++---
 .../typecheck/tc-metafunctions.rkt            | 16 ++---
 collects/typed-scheme/typecheck/tc-subst.rkt  |  4 +-
 collects/typed-scheme/types/filter-ops.rkt    |  7 ++
 7 files changed, 80 insertions(+), 30 deletions(-)
 rename collects/tests/typed-scheme/{fail => succeed}/multi-arr-parse.rkt (53%)

diff --git a/collects/tests/typed-scheme/run.rkt b/collects/tests/typed-scheme/run.rkt
index b848d7ae..8b83e039 100644
--- a/collects/tests/typed-scheme/run.rkt
+++ b/collects/tests/typed-scheme/run.rkt
@@ -36,7 +36,7 @@
        (printf "Skipping Typed Racket tests.\n")]
       [(when (the-tests)
          (unless (= 0 ((exec) (the-tests)))
-           (eprintf "Typed Racket Tests did not pass.")))
+           (eprintf "Typed Racket Tests did not pass.\n")))
        (when (opt?)
          (parameterize ([current-command-line-arguments #()])
            (dynamic-require '(file "optimizer/run.rkt") #f))
diff --git a/collects/tests/typed-scheme/fail/multi-arr-parse.rkt b/collects/tests/typed-scheme/succeed/multi-arr-parse.rkt
similarity index 53%
rename from collects/tests/typed-scheme/fail/multi-arr-parse.rkt
rename to collects/tests/typed-scheme/succeed/multi-arr-parse.rkt
index 10e1171c..9e045421 100644
--- a/collects/tests/typed-scheme/fail/multi-arr-parse.rkt
+++ b/collects/tests/typed-scheme/succeed/multi-arr-parse.rkt
@@ -1,6 +1,4 @@
-#;
-(exn-pred #rx".*once in a form.*")
 #lang typed/scheme
 
 (: foo : (Integer -> Integer -> Integer))
-(define foo 1)
+(define ((foo x) y) 1)
diff --git a/collects/tests/typed-scheme/unit-tests/parse-type-tests.rkt b/collects/tests/typed-scheme/unit-tests/parse-type-tests.rkt
index ac32ab7e..02995dd4 100644
--- a/collects/tests/typed-scheme/unit-tests/parse-type-tests.rkt
+++ b/collects/tests/typed-scheme/unit-tests/parse-type-tests.rkt
@@ -5,7 +5,7 @@
 	 (env type-alias-env type-env-structs tvar-env type-name-env init-envs)
 	 (rep type-rep)
 	 (rename-in (types comparison subtype union utils convenience)
-                    [Un t:Un] [-> t:->])
+                    [Un t:Un] [-> t:->] [->* t:->*])
          (private base-types base-types-extra colon)
          (for-template (private base-types base-types-extra base-env colon))
          (private parse-type)
@@ -83,7 +83,7 @@
    ;; requires transformer time stuff that doesn't work
    #;[(Refinement even?) (make-Refinement #'even?)]
    [(Number Number Number Boolean -> Number) (N N N B . t:-> . N)]
-   [(Number Number Number * -> Boolean) ((list N N) N . ->* . B)]
+   [(Number Number Number * -> Boolean) ((list N N) N . t:->* . B)]
    ;[((. Number) -> Number) (->* (list) N N)] ;; not legal syntax
    [(U Number Boolean) (t:Un N B)]
    [(U Number Boolean Number) (t:Un N B)]
@@ -111,6 +111,12 @@
     (-polydots (a) ((list) [a a] . ->... . N))]
    
    [(Any -> Boolean : Number) (make-pred-ty -Number)]
+   [(Any -> Boolean : #:+ (Number @ 0) #:- (! Number @ 0))
+    (make-pred-ty -Number)]
+   [(Any -> Boolean : #:+ (! Number @ 0) #:- (Number @ 0))
+    (t:->* (list Univ) -Boolean : (-FS (-not-filter -Number 0 null) (-filter -Number 0 null)))]
+   [(Number -> Number -> Number)
+    (t:-> -Number (t:-> -Number -Number))]
    [(Integer -> (All (X) (X -> X)))
     (t:-> -Integer (-poly (x) (t:-> x x)))]
    
diff --git a/collects/typed-scheme/private/parse-type.rkt b/collects/typed-scheme/private/parse-type.rkt
index b86a1104..6e59d204 100644
--- a/collects/typed-scheme/private/parse-type.rkt
+++ b/collects/typed-scheme/private/parse-type.rkt
@@ -2,7 +2,7 @@
 
 (require "../utils/utils.rkt"
 	 (except-in (rep type-rep) make-arr)
-         (rename-in (types convenience union utils) [make-arr* make-arr])
+         (rename-in (types convenience union utils printer filter-ops) [make-arr* make-arr])
          (utils tc-utils stxclass-util)
          syntax/stx (prefix-in c: scheme/contract)
          syntax/parse
@@ -22,6 +22,7 @@
 
 (provide star ddd/bound)
 (define enable-mu-parsing (make-parameter #t))
+(print-complex-filters? #t)
 
 (define ((parse/id p) loc datum)
   #;(printf "parse-type/id id : ~a\n ty: ~a\n" (syntax-object->datum loc) (syntax-object->datum stx))
@@ -103,7 +104,7 @@
   (pattern cdr
            #:attr pe (make-CdrPE)))
 
-(define-splicing-syntax-class latent-filter
+(define-splicing-syntax-class simple-latent-filter
   #:description "latent filter"  
   (pattern (~seq t:expr (~describe "@" (~datum @)) pe:path-elem ...)
            #:attr type (parse-type #'t)
@@ -112,6 +113,41 @@
            #:attr type (parse-type #'t)
            #:attr path '()))
 
+(define-syntax-class prop
+  #:attributes (prop)
+  (pattern (~literal Top) #:attr prop -top)
+  (pattern (~literal Bot) #:attr prop -bot)
+  (pattern (t:expr (~describe "@" (~datum @)) pe:path-elem ... i:nat)
+           #:attr prop (-filter (parse-type #'t) (syntax-e #'i) (attribute pe.pe)))
+  (pattern ((~datum !) t:expr (~describe "@" (~datum @)) pe:path-elem ... i:nat)
+           #:attr prop (-not-filter (parse-type #'t) (syntax-e #'i) (attribute pe.pe)))
+  (pattern ((~literal and) p:prop ...)
+           #:attr prop (apply -and (attribute p.prop)))
+  (pattern ((~literal or) p:prop ...)
+           #:attr prop (apply -or (attribute p.prop)))
+  (pattern ((~literal implies) p1:prop p2:prop)
+           #:attr prop (-imp (attribute p1.prop) (attribute p2.prop))))
+
+(define-syntax-class object
+  #:attributes (object)
+  (pattern e:expr
+           #:attr object -no-obj))
+
+(define-splicing-syntax-class full-latent
+  #:description "latent propositions and object"
+  (pattern (~seq (~optional (~seq #:+ p+:prop ...))
+                 (~optional (~seq #:- p-:prop ...))
+                 (~optional (~seq #:object o:object)))
+           #:attr positive (if (attribute p+.prop)
+                               (apply -and (attribute p+.prop))
+                               -top)
+           #:attr negative (if (attribute p-.prop)
+                               (apply -and (attribute p-.prop))
+                               -top)
+           #:attr object (if (attribute o.object)
+                             (attribute o.object)
+                             -no-obj)))
+
 (define (parse-type stx)    
   (parameterize ([current-orig-stx stx])    
     (syntax-parse
@@ -210,14 +246,25 @@
       [((~and kw t:Parameter) t1 t2)      
        (add-type-name-reference #'kw)
        (-Param (parse-type #'t1) (parse-type #'t2))]
-      ;; function types
-      ;; handle this error first:
-      [((~or dom (~between (~and kw t:->) 2 +inf.0)) ...)
-       (for ([k (syntax->list #'(kw ...))]) (add-type-name-reference k))
-       (tc-error/stx (syntax->list #'(kw ...))
-                     "The -> type constructor may be used only once in a form")
-       Err]
-      [(dom (~and kw t:->) rng : ~! latent:latent-filter)
+      ;; curried function notation
+      [((~and dom:non-keyword-ty (~not t:->)) ...
+        (~and kw t:->) 
+        (~and (~seq rest-dom ...) (~seq (~or _ (~between t:-> 1 +inf.0)) ...)))
+       (add-type-name-reference #'kw)
+       (let ([doms (for/list ([d (syntax->list #'(dom ...))])
+                    (parse-type d))])
+         (make-Function
+          (list (make-arr
+                 doms
+                 (parse-type (syntax/loc stx (rest-dom ...)))))))]
+      [(dom ... (~and kw t:->) rng : latent:full-latent)
+       (add-type-name-reference #'kw)
+       ;; use parse-type instead of parse-values-type because we need to add the filters from the pred-ty
+       (->* (map parse-type (syntax->list #'(dom ...)))
+            (parse-type #'rng)
+            : (-FS (attribute latent.positive) (attribute latent.negative))
+            : (attribute latent.object))]
+      [(dom (~and kw t:->) rng : ~! latent:simple-latent-filter)
        (add-type-name-reference #'kw)
        ;; use parse-type instead of parse-values-type because we need to add the filters from the pred-ty
        (make-pred-ty (list (parse-type #'dom)) (parse-type #'rng) (attribute latent.type) 0 (attribute latent.path))]
diff --git a/collects/typed-scheme/typecheck/tc-metafunctions.rkt b/collects/typed-scheme/typecheck/tc-metafunctions.rkt
index 3b6977e8..e1fe75d9 100644
--- a/collects/typed-scheme/typecheck/tc-metafunctions.rkt
+++ b/collects/typed-scheme/typecheck/tc-metafunctions.rkt
@@ -9,15 +9,7 @@
          racket/contract racket/match unstable/match
          (for-syntax racket/base))
 
-;; this implements the sequence invariant described on the first page relating to Bot
-
-(define (combine l1 l2)
-  (match* (l1 l2) 
-          [(_ (Bot:)) (-FS -top -bot)]
-          [((Bot:) _) (-FS -bot -top)]
-          [(_ _) (-FS l1 l2)]))
-
-(provide combine abstract-results)
+(provide abstract-results)
 
 
 (d/c (abstract-results results arg-names)
@@ -51,8 +43,8 @@
   (-> (listof identifier?) (listof name-ref/c) FilterSet/c FilterSet/c)
   (match fs
     [(FilterSet: f+ f-)
-     (combine (abo ids keys f+) (abo ids keys f-))]
-    [(NoFilter:) (combine -top -top)]))
+     (-FS (abo ids keys f+) (abo ids keys f-))]
+    [(NoFilter:) (-FS -top -top)]))
 
 (d/c (abo xs idxs f)
   ((listof identifier?) (listof name-ref/c) Filter/c . -> . Filter/c)
@@ -76,7 +68,7 @@
 (define (merge-filter-sets fs)
   (match fs
     [(list (FilterSet: f+ f-) ...)
-     (make-FilterSet (make-AndFilter f+) (make-AndFilter f-))]))
+     (-FS (make-AndFilter f+) (make-AndFilter f-))]))
 
 (define (tc-results->values tc)
   (match tc
diff --git a/collects/typed-scheme/typecheck/tc-subst.rkt b/collects/typed-scheme/typecheck/tc-subst.rkt
index 30f65678..f784ba05 100644
--- a/collects/typed-scheme/typecheck/tc-subst.rkt
+++ b/collects/typed-scheme/typecheck/tc-subst.rkt
@@ -33,8 +33,8 @@
            [_ f]))
   (match fs
     [(FilterSet: f+ f-)
-     (combine (subst-filter (add-extra-filter f+) k o polarity)
-	      (subst-filter (add-extra-filter f-) k o polarity))]
+     (-FS (subst-filter (add-extra-filter f+) k o polarity)
+          (subst-filter (add-extra-filter f-) k o polarity))]
     [_ (-FS -top -top)]))
 
 (d/c (subst-type t k o polarity)
diff --git a/collects/typed-scheme/types/filter-ops.rkt b/collects/typed-scheme/types/filter-ops.rkt
index 0acb8666..d20a32f4 100644
--- a/collects/typed-scheme/types/filter-ops.rkt
+++ b/collects/typed-scheme/types/filter-ops.rkt
@@ -96,6 +96,13 @@
            (loop (cdr props) others)]
           [p (loop (cdr props) (cons p others))]))))
 
+
+(define (-imp p1 p2)
+  (match* (p1 p2)
+    [((Bot:) _) -top]
+    [((Top:) _) p2]
+    [(_ _) (make-ImpFilter p1 p2)]))
+
 (define (-or . args)
   (define mk
     (case-lambda [() -bot]

From eacda65291b46d1f3c23601360476d341089305f Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 8 Dec 2010 18:53:56 -0500
Subject: [PATCH 186/198] Add `defined?' assertions to fix DrRacket.

original commit: e70ccafd7b591df218a1ae036f599c671eb57824
---
 collects/typed-scheme/main.rkt                | 2 +-
 collects/typed-scheme/private/base-env.rkt    | 1 +
 collects/typed-scheme/private/extra-procs.rkt | 5 ++++-
 collects/typed/racket/base.rkt                | 2 +-
 collects/typed/scheme/base.rkt                | 2 +-
 5 files changed, 8 insertions(+), 4 deletions(-)

diff --git a/collects/typed-scheme/main.rkt b/collects/typed-scheme/main.rkt
index 2082ac80..016cdebf 100644
--- a/collects/typed-scheme/main.rkt
+++ b/collects/typed-scheme/main.rkt
@@ -14,4 +14,4 @@
          (for-syntax "private/base-types-extra.rkt"))
 (provide (rename-out [with-handlers: with-handlers])
          (for-syntax (all-from-out "private/base-types-extra.rkt"))
-	 assert with-type for for*)
+	 assert defined? with-type for for*)
diff --git a/collects/typed-scheme/private/base-env.rkt b/collects/typed-scheme/private/base-env.rkt
index a8e248cd..4eccedf0 100644
--- a/collects/typed-scheme/private/base-env.rkt
+++ b/collects/typed-scheme/private/base-env.rkt
@@ -186,6 +186,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 null) (-filter -Undefined 0 null)))]
 [gensym (->opt [Sym] Sym)]
 [string-append (->* null -String -String)]
 [open-input-string (-> -String -Input-Port)]
diff --git a/collects/typed-scheme/private/extra-procs.rkt b/collects/typed-scheme/private/extra-procs.rkt
index b4a74b03..5b90512b 100644
--- a/collects/typed-scheme/private/extra-procs.rkt
+++ b/collects/typed-scheme/private/extra-procs.rkt
@@ -1,5 +1,5 @@
 #lang scheme/base
-(provide assert)
+(provide assert defined?)
 
 (define-syntax assert
   (syntax-rules ()
@@ -8,3 +8,6 @@
     ((assert v pred)
      (let ((val v))
        (if (pred val) val (error "Assertion failed"))))))
+
+(define (defined? v)
+  (not (equal? v (letrec ([x x]) x))))
\ No newline at end of file
diff --git a/collects/typed/racket/base.rkt b/collects/typed/racket/base.rkt
index 9d0942a2..65d54324 100644
--- a/collects/typed/racket/base.rkt
+++ b/collects/typed/racket/base.rkt
@@ -14,5 +14,5 @@
 	 (for-syntax typed-scheme/private/base-types-extra))
 (provide (rename-out [with-handlers: with-handlers]
                      [define-type-alias define-type])
-	 assert with-type for for*
+	 assert defined? with-type for for*
          (for-syntax (all-from-out typed-scheme/private/base-types-extra)))
diff --git a/collects/typed/scheme/base.rkt b/collects/typed/scheme/base.rkt
index abbf0ebf..4c184c21 100644
--- a/collects/typed/scheme/base.rkt
+++ b/collects/typed/scheme/base.rkt
@@ -14,5 +14,5 @@
 	 (for-syntax typed-scheme/private/base-types-extra))
 (provide (rename-out [with-handlers: with-handlers]
                      [define-type-alias define-type])
-	 assert with-type for for*
+	 assert defined? with-type for for*
          (for-syntax (all-from-out typed-scheme/private/base-types-extra)))

From bcb395b98678f8cc856eebeeaaae4b16e5d75d3a Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Wed, 8 Dec 2010 19:28:56 -0500
Subject: [PATCH 187/198] Fix type of `-'

original commit: 463ab0d30943f5453eaac16e1d966dd9dae093eb
---
 collects/typed-scheme/private/base-env-numeric.rkt | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/typed-scheme/private/base-env-numeric.rkt b/collects/typed-scheme/private/base-env-numeric.rkt
index 045282ef..111e2484 100644
--- a/collects/typed-scheme/private/base-env-numeric.rkt
+++ b/collects/typed-scheme/private/base-env-numeric.rkt
@@ -259,7 +259,7 @@
                   (list (->* (list -Real -Flonum) -Real -Flonum))
                   (list (->* (list -InexactReal) -InexactReal -InexactReal))
                   (list (->* (list -Real) -Real -Real))
-                  (list (->* (list) (Un -Real -FloatComplex) -FloatComplex))
+                  (list (->* (list (Un -Real -FloatComplex)) (Un -Real -FloatComplex) -FloatComplex))
                   (list (->* (list -FloatComplex) N -FloatComplex))
                   (list (->* (list N -FloatComplex) N -FloatComplex))
                   (list (->* (list N) N N))))]

From 2865f2801f60c63e73eb781b5cea8815fb694cc4 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 8 Dec 2010 19:25:02 -0500
Subject: [PATCH 188/198] letrec: consider outside bindings safe.

original commit: b045153177afe8aaebdbf179dbe27670b1cf577d
---
 collects/tests/typed-scheme/fail/safe-letrec.rkt | 11 -----------
 collects/typed-scheme/typecheck/tc-let-unit.rkt  |  8 +++++---
 2 files changed, 5 insertions(+), 14 deletions(-)

diff --git a/collects/tests/typed-scheme/fail/safe-letrec.rkt b/collects/tests/typed-scheme/fail/safe-letrec.rkt
index febfb833..5e04f490 100644
--- a/collects/tests/typed-scheme/fail/safe-letrec.rkt
+++ b/collects/tests/typed-scheme/fail/safe-letrec.rkt
@@ -5,14 +5,3 @@
 ;; make sure letrec takes into account that some bidings may be undefined
 
 (+ (letrec: ([x : Float x]) x) 1) ; PR 11511
-
-(letrec: ([x : Number 3]
-          [y : Number z] ; bad
-          [z : Number x])
-         z)
-
-(letrec: ([x : Number 3]
-          [y : (Number -> Number) (lambda (x) z)] ; bad
-          [z : Number x]
-          [w : (Number -> Number) (lambda (x) (y x))]) ; bad too
-         z)
diff --git a/collects/typed-scheme/typecheck/tc-let-unit.rkt b/collects/typed-scheme/typecheck/tc-let-unit.rkt
index 447dba5a..2d8f6da3 100644
--- a/collects/typed-scheme/typecheck/tc-let-unit.rkt
+++ b/collects/typed-scheme/typecheck/tc-let-unit.rkt
@@ -139,7 +139,7 @@
                                  [transitively-safe-bindings '()])
                           ([names  names]
                            [clause clauses])
-                        (case (safe-letrec-values-clause? clause transitively-safe-bindings)
+                        (case (safe-letrec-values-clause? clause transitively-safe-bindings flat-names)
                           ;; transitively safe -> safe to mention in a subsequent rhs
                           [(transitively-safe) (values (append names safe-bindings)
                                                        (append names transitively-safe-bindings))]
@@ -178,11 +178,13 @@
 ;;  Fixing Letrec (reloaded) paper), we are more conservative than a fully-connected component
 ;;  based approach. On the other hand, our algorithm should cover most interesting cases and
 ;;  is much simpler than Tarjan's.
-(define (safe-letrec-values-clause? clause transitively-safe-bindings)
+(define (safe-letrec-values-clause? clause transitively-safe-bindings letrec-bound-ids)
   (define clause-rhs
     (syntax-parse clause
       [(bindings . rhs) #'rhs]))
-  (cond [(andmap (lambda (fv) (s:member fv transitively-safe-bindings bound-identifier=?))
+  (cond [(andmap (lambda (fv)
+                   (or (not (s:member fv letrec-bound-ids bound-identifier=?)) ; from outside
+                       (s:member fv transitively-safe-bindings bound-identifier=?)))
                  (apply append
                         (syntax-map (lambda (x) (free-vars x))
                                     clause-rhs)))

From 0ccef7d4bc4dfbae9e0a28993090ef399cc439c2 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 8 Dec 2010 19:47:27 -0500
Subject: [PATCH 189/198] Error if we get a type that may be undefined and we
 don't expect it.

original commit: 53719600d8de6c504c126a316eb87deb2c49ebdd
---
 collects/typed-scheme/typecheck/tc-let-unit.rkt | 12 ++++++------
 1 file changed, 6 insertions(+), 6 deletions(-)

diff --git a/collects/typed-scheme/typecheck/tc-let-unit.rkt b/collects/typed-scheme/typecheck/tc-let-unit.rkt
index 2d8f6da3..4817b0c4 100644
--- a/collects/typed-scheme/typecheck/tc-let-unit.rkt
+++ b/collects/typed-scheme/typecheck/tc-let-unit.rkt
@@ -27,7 +27,7 @@
     [(tc-results: ts _ _)
      (ret ts (for/list ([f ts]) (make-NoFilter)) (for/list ([f ts]) (make-NoObject)))]))
 
-(d/c (do-check expr->type namess results form exprs body clauses expected #:abstract [abstract null])
+(d/c (do-check expr->type namess results expected-results form exprs body clauses expected #:abstract [abstract null])
      (((syntax? syntax? tc-results? . c:-> . any/c)
        (listof (listof identifier?)) (listof tc-results?)
        syntax? (listof syntax?) syntax? (listof syntax?) (or/c #f tc-results?))
@@ -66,7 +66,7 @@
    (for-each expr->type
              clauses
              exprs 
-             results)
+             expected-results)
    (let ([subber (lambda (proc lst)
                    (for/list ([i (in-list lst)])
                      (for/fold ([s i])
@@ -117,7 +117,7 @@
         ;; after everything, check the body expressions
         [(null? names)
          ;(if expected (tc-exprs/check (syntax->list body) expected) (tc-exprs (syntax->list body)))
-         (do-check void null null form null body null expected #:abstract orig-flat-names)]
+         (do-check void null null null form null body null expected #:abstract orig-flat-names)]
         ;; if none of the names bound in the letrec are free vars of this rhs
         [(not (ormap (lambda (n) (s:member n flat-names bound-identifier=?))
                      (free-vars (car exprs))))
@@ -156,6 +156,8 @@
                                            (map (λ (x) (make-Union (list x -Undefined)))
                                                 types-from-user)))))
                          names))
+                   ;; types the user gave. check against that to error if we could get undefined
+                   (map (λ (l) (ret (map get-type l))) names)
                    form exprs body clauses expected)]))))
 
 ;; determines whether any of the variables bound in the given clause can have an undefined value
@@ -219,6 +221,4 @@
                                          tc-expr/check))]
          ;; the clauses for error reporting
          [clauses (syntax-case form () [(lv cl . b) (syntax->list #'cl)])])
-    (do-check void names types form exprs body clauses expected)))
-
-
+    (do-check void names types types form exprs body clauses expected)))

From f4a1a31f61e056b544cf80c18bcf8d31807667bd Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 8 Dec 2010 20:07:09 -0500
Subject: [PATCH 190/198] Typecheck body of letrec using original types instead
 of potentially undefined type.

original commit: 81ef5f9418b0011daa980d438c0eed451b37d578
---
 .../tests/typed-scheme/fail/safe-letrec.rkt   |  2 +-
 .../typed-scheme/typecheck/tc-let-unit.rkt    | 49 ++++++++++++-------
 2 files changed, 32 insertions(+), 19 deletions(-)

diff --git a/collects/tests/typed-scheme/fail/safe-letrec.rkt b/collects/tests/typed-scheme/fail/safe-letrec.rkt
index 5e04f490..3bf6dffb 100644
--- a/collects/tests/typed-scheme/fail/safe-letrec.rkt
+++ b/collects/tests/typed-scheme/fail/safe-letrec.rkt
@@ -1,5 +1,5 @@
 #;
-(exn-pred 3)
+(exn-pred 1)
 #lang typed/racket
 
 ;; make sure letrec takes into account that some bidings may be undefined
diff --git a/collects/typed-scheme/typecheck/tc-let-unit.rkt b/collects/typed-scheme/typecheck/tc-let-unit.rkt
index 4817b0c4..b2d2a7ff 100644
--- a/collects/typed-scheme/typecheck/tc-let-unit.rkt
+++ b/collects/typed-scheme/typecheck/tc-let-unit.rkt
@@ -34,35 +34,39 @@
       (#:abstract any/c)
       . c:->* . 
       tc-results?)
-     (w/c t/p ([types (listof (listof Type/c))]
-               [props (listof (listof Filter?))])
-          (define-values (types props)
-            (for/lists (t p) 
-              ([r (in-list results)]
+     (w/c t/p ([types          (listof (listof Type/c))] ; types that may contain undefined (letrec)
+               [expected-types (listof (listof Type/c))] ; types that may not contain undefined (what we got from the user)
+               [props          (listof (listof Filter?))])
+          (define-values (types expected-types props)
+            (for/lists (t e p) 
+              ([r     (in-list results)]
+               [e-r   (in-list expected-results)]
                [names (in-list namess)])
-              (match r 
-                [(tc-results: ts (FilterSet: fs+ fs-) os)
+              (match* (r e-r)
+                [((tc-results: ts (FilterSet: fs+ fs-) os) (tc-results: e-ts _ _)) ; rest should be the same
                  ;(printf "f+: ~a\n" fs+)
                  ;(printf "f-: ~a\n" fs-)
                  (values ts
+                         e-ts
                          (apply append
                                 (for/list ([n names]
                                            [f+ fs+]
                                            [f- fs-])
                                   (list (make-ImpFilter (-not-filter (-val #f) n) f+)
                                         (make-ImpFilter (-filter (-val #f) n) f-)))))]
-                [(tc-results: ts (NoFilter:) _) (values ts null)]))))
+                [((tc-results: ts (NoFilter:) _) (tc-results: e-ts (NoFilter:) _))
+                 (values ts e-ts null)]))))
+     (w/c append-region ([p1 (listof Filter?)]
+                         [p2 (listof Filter?)])
+          (define-values (p1 p2)
+            (combine-props (apply append props) (env-props (lexical-env)) (box #t))))
      ;; extend the lexical environment for checking the body
   (with-lexical-env/extend/props
    ;; the list of lists of name
    namess
    ;; the types
    types
-   (w/c append-region
-    #:result (listof Filter?)
-    (define-values (p1 p2)
-      (combine-props (apply append props) (env-props (lexical-env)) (box #t)))
-    (append p1 p2))
+   (append p1 p2)
    (for-each expr->type
              clauses
              exprs 
@@ -78,11 +82,20 @@
           (ret (subber subst-type ts) (subber subst-filter-set fs) (subber subst-object os))]
          [(tc-results: ts fs os dt db)
           (ret (subber subst-type ts) (subber subst-filter-set fs) (subber subst-object os) dt db)]))
-     (if expected 
-         (check-below 
-          (run (tc-exprs/check (syntax->list body) (erase-filter expected)))
-          expected)
-         (run (tc-exprs (syntax->list body)))))))
+     (with-lexical-env/extend/props
+      ;; we typechecked the rhss with the lhss having types that potentially contain undefined
+      ;; if undefined can actually show up, a type error will have been triggered
+      ;; it is therefore safe to typecheck the body with the original types the user gave us
+      ;; any undefined-related problems have been caught already
+      namess
+      expected-types ; types w/o undefined
+      (append p1 p2)
+      ;; typecheck the body
+      (if expected 
+          (check-below 
+           (run (tc-exprs/check (syntax->list body) (erase-filter expected)))
+           expected)
+          (run (tc-exprs (syntax->list body))))))))
 
 (define (tc-expr/maybe-expected/t e name)
   (define expecteds

From a650c59fb3a87564f2dad3259aaa88b6d23e5a3e Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Wed, 8 Dec 2010 20:09:31 -0500
Subject: [PATCH 191/198] Test for errors in rhs.

original commit: 365d2726660ab9342f229789f268e2461cdd2063
---
 collects/tests/typed-scheme/fail/safe-letrec.rkt | 4 +++-
 1 file changed, 3 insertions(+), 1 deletion(-)

diff --git a/collects/tests/typed-scheme/fail/safe-letrec.rkt b/collects/tests/typed-scheme/fail/safe-letrec.rkt
index 3bf6dffb..32acee2c 100644
--- a/collects/tests/typed-scheme/fail/safe-letrec.rkt
+++ b/collects/tests/typed-scheme/fail/safe-letrec.rkt
@@ -1,7 +1,9 @@
 #;
-(exn-pred 1)
+(exn-pred 2)
 #lang typed/racket
 
 ;; make sure letrec takes into account that some bidings may be undefined
 
 (+ (letrec: ([x : Float x]) x) 1) ; PR 11511
+
+(letrec: ([x : Float (+ x 1)]) 0) ; error in rhs

From a00e49839932aa72e9f68b865d21b3b033f6d432 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 10 Dec 2010 13:44:16 -0500
Subject: [PATCH 192/198] Error when running TR's test harness with no tests.

original commit: 407d9b5f0792ff94438a7e5f5448f54dddb8f7d9
---
 collects/tests/typed-scheme/run.rkt | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/collects/tests/typed-scheme/run.rkt b/collects/tests/typed-scheme/run.rkt
index 8b83e039..7981d6bc 100644
--- a/collects/tests/typed-scheme/run.rkt
+++ b/collects/tests/typed-scheme/run.rkt
@@ -30,7 +30,8 @@
  (cond [(and (unit?) (int?)) tests]
        [(unit?)              unit-tests]
        [(int?)               int-tests]
-       [else                 #f]))
+       [else
+        (error "You must specify which tests should be run. See --help for more info.\n")]))
 
 (cond [(and (nightly?) (eq? 'cgc (system-type 'gc)))
        (printf "Skipping Typed Racket tests.\n")]

From 8e569511e84a6d5bdb81c1b8ce156976dac64aa7 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 10 Dec 2010 16:54:27 -0500
Subject: [PATCH 193/198] Fix double application of format. Closes PR 11524.

original commit: f8c01299f971c65509877e22feaaa4f2ccb79227
---
 collects/typed-scheme/types/utils.rkt | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/typed-scheme/types/utils.rkt b/collects/typed-scheme/types/utils.rkt
index 466ae18c..f81288a1 100644
--- a/collects/typed-scheme/types/utils.rkt
+++ b/collects/typed-scheme/types/utils.rkt
@@ -171,7 +171,7 @@
 (define (fv/list ts) (hash-map (combine-frees (map free-vars* ts)) (lambda (k v) k)))
 
 (define (tc-error/expr msg #:return [return (make-Union null)] #:stx [stx (current-orig-stx)] . rest)
-  (tc-error/delayed #:stx stx (apply format msg rest))
+  (apply tc-error/delayed #:stx stx msg rest)
   return)
 
 ;; error for unbound variables

From 73046316e622bd35827aca1ad0575fe2d4da6b62 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 10 Dec 2010 16:55:37 -0500
Subject: [PATCH 194/198] Allow running individual TR tests.

original commit: b9d67eea2f08e5eed8a5d28539aa749e2a64f790
---
 collects/tests/typed-scheme/run.rkt | 1 +
 1 file changed, 1 insertion(+)

diff --git a/collects/tests/typed-scheme/run.rkt b/collects/tests/typed-scheme/run.rkt
index 7981d6bc..a9b16f90 100644
--- a/collects/tests/typed-scheme/run.rkt
+++ b/collects/tests/typed-scheme/run.rkt
@@ -30,6 +30,7 @@
  (cond [(and (unit?) (int?)) tests]
        [(unit?)              unit-tests]
        [(int?)               int-tests]
+       [(the-tests)          (the-tests)]
        [else
         (error "You must specify which tests should be run. See --help for more info.\n")]))
 

From 432b1040dcf484f0a04ab1bda5610f746d2341a1 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 10 Dec 2010 16:58:42 -0500
Subject: [PATCH 195/198] Update TR tests to reflect new contract error
 messages.

original commit: 09ffb7049288731040aa33c41b5c13952d9ab285
---
 collects/tests/typed-scheme/fail/back-and-forth.rkt | 2 +-
 collects/tests/typed-scheme/fail/pr10594.rkt        | 2 +-
 2 files changed, 2 insertions(+), 2 deletions(-)

diff --git a/collects/tests/typed-scheme/fail/back-and-forth.rkt b/collects/tests/typed-scheme/fail/back-and-forth.rkt
index eac8be7d..cde56481 100644
--- a/collects/tests/typed-scheme/fail/back-and-forth.rkt
+++ b/collects/tests/typed-scheme/fail/back-and-forth.rkt
@@ -1,5 +1,5 @@
 #;
-(exn-pred exn:fail:contract? #rx".*violator.*contract.*\\(-> Number Number\\).*f.*")
+(exn-pred exn:fail:contract? #rx".*contradiction.*contract.*\\(-> Number Number\\).*f.*")
 
 #lang scheme/load
 
diff --git a/collects/tests/typed-scheme/fail/pr10594.rkt b/collects/tests/typed-scheme/fail/pr10594.rkt
index 41eb8501..c411152f 100644
--- a/collects/tests/typed-scheme/fail/pr10594.rkt
+++ b/collects/tests/typed-scheme/fail/pr10594.rkt
@@ -1,5 +1,5 @@
 #;
-(exn-pred exn:fail:contract? #rx".*U broke the contract.*")
+(exn-pred exn:fail:contract? #rx".*contradiction.*implementation of 'U.*")
 #lang scheme/load
 
 (module T typed-scheme

From ee11638bc6cf8f66bd6c208f976bfcfd9b1c8a22 Mon Sep 17 00:00:00 2001
From: Vincent St-Amour <stamourv@racket-lang.org>
Date: Fri, 10 Dec 2010 17:17:02 -0500
Subject: [PATCH 196/198] Scheme -> Racket

original commit: 740b8308d7d52c1b4b9f00282d1b1c5187cd81e3
---
 collects/typed-scheme/typecheck/tc-expr-unit.rkt | 6 +++---
 collects/typed-scheme/typecheck/tc-toplevel.rkt  | 2 +-
 collects/typed-scheme/utils/tc-utils.rkt         | 4 ++--
 3 files changed, 6 insertions(+), 6 deletions(-)

diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.rkt b/collects/typed-scheme/typecheck/tc-expr-unit.rkt
index b5153d39..e09a06d9 100644
--- a/collects/typed-scheme/typecheck/tc-expr-unit.rkt
+++ b/collects/typed-scheme/typecheck/tc-expr-unit.rkt
@@ -260,7 +260,7 @@
         [(#%top . id) (check-below (tc-id #'id) expected)]
         ;; weird
         [(#%variable-reference . _)
-         (tc-error/expr #:return (ret expected) "#%variable-reference is not supported by Typed Scheme")]
+         (tc-error/expr #:return (ret expected) "#%variable-reference is not supported by Typed Racket")]
         ;; identifiers
         [x:identifier
            (check-below (tc-id #'x) expected)]
@@ -375,7 +375,7 @@
       [(#%expression e) (tc-expr #'e)]
       ;; weird
       [(#%variable-reference . _)
-       (tc-error/expr #:return (ret (Un)) "#%variable-reference is not supported by Typed Scheme")]
+       (tc-error/expr #:return (ret (Un)) "#%variable-reference is not supported by Typed Racket")]
       ;; identifiers
       [x:identifier (tc-id #'x)]
       ;; application        
@@ -428,7 +428,7 @@
                            ret-ty)])
           (add-typeof-expr form retval)
           retval)]
-       [(tc-result1: t) (int-err "non-symbol methods not supported by Typed Scheme: ~a" t)])]
+       [(tc-result1: t) (int-err "non-symbol methods not supported by Typed Racket: ~a" t)])]
     [(tc-result1: t) (tc-error/expr #:return (or expected (ret (Un))) "send: expected a class instance, got ~a" t)]))
 
 (define (single-value form [expected #f])  
diff --git a/collects/typed-scheme/typecheck/tc-toplevel.rkt b/collects/typed-scheme/typecheck/tc-toplevel.rkt
index 8d4787e6..13f5e842 100644
--- a/collects/typed-scheme/typecheck/tc-toplevel.rkt
+++ b/collects/typed-scheme/typecheck/tc-toplevel.rkt
@@ -308,7 +308,7 @@
                     (set! syntax-provide? #t))
                   (dict-set h #'in #'out)]
                  [((~datum protect) . _)
-                  (tc-error "provide: protect not supported by Typed Scheme")]
+                  (tc-error "provide: protect not supported by Typed Racket")]
                  [_ (int-err "unknown provide form")])))]
           [_ (int-err "non-provide form! ~a" (syntax->datum p))])))
     ;; compute the new provides
diff --git a/collects/typed-scheme/utils/tc-utils.rkt b/collects/typed-scheme/utils/tc-utils.rkt
index 04b8e729..97ddb2d3 100644
--- a/collects/typed-scheme/utils/tc-utils.rkt
+++ b/collects/typed-scheme/utils/tc-utils.rkt
@@ -1,7 +1,7 @@
 #lang scheme/base
 
 #|
-This file is for utilities that are only useful for Typed Scheme, but
+This file is for utilities that are only useful for Typed Racket, but
 don't depend on any other portion of the system
 |#
 
@@ -52,7 +52,7 @@ don't depend on any other portion of the system
                (and (syntax-transforming?) (syntax-original? (syntax-local-introduce e)))
                #;(and (orig-module-stx) (eq? (debugf syntax-source-module e) (debugf syntax-source-module (orig-module-stx))))
 	       #;(syntax-source-module stx))
-      (log-message l 'warning (format "Typed Scheme has detected unreachable code: ~.s" (syntax->datum (locate-stx e)))
+      (log-message l 'warning (format "Typed Racket has detected unreachable code: ~.s" (syntax->datum (locate-stx e)))
                    e))))
 
 (define (locate-stx stx)

From 034c06a30e2b656213ba60e52555c9e205657667 Mon Sep 17 00:00:00 2001
From: Carl Eastlund <cce@racket-lang.org>
Date: Fri, 10 Dec 2010 15:03:18 -0500
Subject: [PATCH 197/198] New test case for formatting bug in TR error
 messages.

original commit: 5b18305e11b1f2bcba0e6d6e4ebfd7d51fb6ccba
---
 collects/tests/typed-scheme/fail/tc-error-format.rkt | 2 ++
 1 file changed, 2 insertions(+)
 create mode 100644 collects/tests/typed-scheme/fail/tc-error-format.rkt

diff --git a/collects/tests/typed-scheme/fail/tc-error-format.rkt b/collects/tests/typed-scheme/fail/tc-error-format.rkt
new file mode 100644
index 00000000..f328fd5c
--- /dev/null
+++ b/collects/tests/typed-scheme/fail/tc-error-format.rkt
@@ -0,0 +1,2 @@
+#lang typed/racket
+(ann '~s Nothing)

From 84a380295241c5d3f858bc7da31cfde37be575f2 Mon Sep 17 00:00:00 2001
From: Sam Tobin-Hochstadt <samth@racket-lang.org>
Date: Sun, 7 Nov 2010 17:54:00 -0500
Subject: [PATCH 198/198] Document ordering in `case-lambda' types.

 Closes PR 11394.

original commit: 25d2827d0dbf25e797c20aa6ec24cd3b7794554d
---
 collects/typed-scheme/scribblings/ts-reference.scrbl | 3 ++-
 1 file changed, 2 insertions(+), 1 deletion(-)

diff --git a/collects/typed-scheme/scribblings/ts-reference.scrbl b/collects/typed-scheme/scribblings/ts-reference.scrbl
index 0e711b09..84cb9545 100644
--- a/collects/typed-scheme/scribblings/ts-reference.scrbl
+++ b/collects/typed-scheme/scribblings/ts-reference.scrbl
@@ -216,7 +216,8 @@ by @racket[read].}
 @defform[(U t ...)]{is the union of the types @racket[t ...].
  @ex[(λ: ([x : Real])(if (> 0 x) "yes" 'no))]}
 @defform[(case-lambda fun-ty ...)]{is a function that behaves like all of
-  the @racket[fun-ty]s.  The @racket[fun-ty]s must all be function
+  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[->].}
 @defform/none[(t t1 t2 ...)]{is the instantiation of the parametric type
   @racket[t] at types @racket[t1 t2 ...]}