new branch

original commit: 536b94c3052559ae51a63807d8190b01d97f7326

collects/typed-scheme/typecheck/tc-expr-unit.ss

@@ -5,7 +5,7 @@
 (require syntax/kerncase mzlib/trace
          scheme/match (prefix-in - scheme/contract)
          "signatures.ss" "tc-envops.ss" "tc-metafunctions.ss"
-         (types utils convenience union subtype remove-intersect)
+         (types utils convenience union subtype remove-intersect type-table)
          (private-in parse-type type-annotation)
          (rep type-rep)
          (only-in (infer infer) restrict)
@@ -231,6 +231,7 @@
              (lambda (ann)
                (let* ([r (tc-expr/check/internal form ann)]
                       [r* (check-below r expected)])
+                 (add-typeof-expr form expected)
                  ;; around again in case there is an instantiation
                  ;; remove the ascription so we don't loop infinitely
                  (loop (remove-ascription form) r* #t)))]
@@ -242,13 +243,16 @@
                 ;; do the instantiation on the old type
                 (let* ([ts* (do-inst form ts)]
                        [ts** (ret ts* fs os)])
+                  (add-typeof-expr form ts**)
                   ;; make sure the new type is ok
                   (check-below ts** expected))]
                ;; no annotations possible on dotted results
-               [ty ty])]
+               [ty (add-typeof-expr form ty) ty])]
             ;; nothing to see here
             [checked? expected]
-            [else (tc-expr/check/internal form expected)]))))
+            [else (let ([t (tc-expr/check/internal form expected)])
+                    (add-typeof-expr form t)
+                    t)]))))
 
 (define (tc-or e1 e2 or-part [expected #f])
   (match (single-value e1)
@@ -469,8 +473,10 @@
                     [else (internal-tc-expr form)])])
       (match ty
         [(tc-results: ts fs os)
-         (let ([ts* (do-inst form ts)])
-           (ret ts* fs os))]))))
+         (let* ([ts* (do-inst form ts)]
+                [r (ret ts* fs os)])
+           (add-typeof-expr form r)
+           r)]))))
 
 (define (tc/send rcvr method args [expected #f])
   (match (tc-expr rcvr)

collects/typed-scheme/typed-scheme.ss

@@ -6,7 +6,7 @@
          (for-syntax 
           (except-in syntax/parse id)
           scheme/base
-          (private type-contract)
+          (private type-contract optimize)
           (types utils convenience)
 	  (typecheck typechecker provide-handling)
 	  (env type-environments type-name-env type-alias-env)
@@ -79,7 +79,8 @@
                                        (type-check #'(body2 ...)))]
                          [check-syntax-help (syntax-property #'(void) 'disappeared-use (type-name-references))]
                          [(transformed-body ...) (remove-provides #'(body2 ...))])]
-           [with-syntax ([(transformed-body ...) (change-contract-fixups #'(transformed-body ...))])])
+           [with-syntax ([(transformed-body ...) (change-contract-fixups #'(transformed-body ...))])]
+           [with-syntax ([(transformed-body ...) (map optimize (syntax->list #'(transformed-body ...)))])])
         (do-time "Typechecked")
         #;(printf "checked ~a~n" module-name)
         #;(printf "created ~a types~n" (count!))

collects/typed-scheme/types/abbrev.ss

@@ -2,7 +2,7 @@
 
 (require "../utils/utils.ss")
 
-(require (rep type-rep object-rep filter-rep)
+(require (rep type-rep object-rep filter-rep rep-utils)
 	 "printer.ss" "utils.ss"
          (utils tc-utils)
          scheme/list

collects/typed-scheme/utils/utils.ss

@@ -160,7 +160,7 @@ at least theoretically.
 
 
 ;; turn contracts on and off - off by default for performance.
-(define-for-syntax enable-contracts? #f)
+(define-for-syntax enable-contracts? #t)
 (provide (for-syntax enable-contracts?) p/c w/c cnt d-s/c d/c)
 
 ;; these are versions of the contract forms conditionalized by `enable-contracts?'