diff --git a/collects/tests/typed-scheme/succeed/new-metrics.ss b/collects/tests/typed-scheme/succeed/new-metrics.ss
new file mode 100644
index 00000000..cb1218a5
--- /dev/null
+++ b/collects/tests/typed-scheme/succeed/new-metrics.ss
@@ -0,0 +1,508 @@
+#lang typed-scheme
+(provide results run-all-tests)
+
+(require (except-in scheme/list count) scheme/math scheme/path mzlib/match 
+         (prefix-in srfi13: srfi/13) scheme/file
+         (for-syntax scheme/base))
+
+
+(require/typed (prefix-in srfi48: srfi/48)
+               [srfi48:format ( Port String String Any * -> Any)] )
+
+(define-type-alias NumF (U Number #f))
+
+(define-type-alias (Unit C) ((C ->  (Listof NumF)) -> (Path -> (Listof (U #f (Listof NumF))))))  
+
+;; ============================================================
+;; CONFIG
+(define COLLECTS-PATH (make-parameter (build-path "/home/samth/Desktop/collects-tmp/")))
+(define PLANET-CODE-PATH (make-parameter (build-path "/home/samth/Desktop/most-recent-archives/")))
+
+; collects-path : a path to the collects directory to compare
+; planet-code-path : a path to the "other" code to compare (i.e. unpacked, most recent versions
+;   of all planet packages)
+
+;; ============================================================
+;; STATS
+
+(: t-test  ((Listof Number) (Listof Number) -> Number))
+;; computes t value for the given sequences. t-tests measure
+;; the extent to which difference in mean between two sets of
+;; _interval-valued_ samples (e.g. distances, times, weights, counts ...)
+;; can be explained by chance. Generally speaking, higher absolute
+;; values of t correspond to higher confidence that an observed difference
+;; in mean cannot be explained by chance.
+(define (t-test seqA seqB)
+  (manual-t-test
+   (avg seqA) (avg seqB) 
+   (variance seqA) (variance seqB)
+   (length seqA) (length seqB)))
+
+(: manual-t-test (Number Number Number Number Number Number -> Number))
+(define (manual-t-test avga avgb vara varb cta ctb)
+  (/ (- avga avgb)
+     (sqrt (+ (/ vara cta) (/ varb ctb)))))
+
+(: chi-square  ((Listof Number) (Listof Number) -> Number))
+;; chi-square is a simple measure of the extent to which the
+;; difference in the frequency of 0's and 1's in the first
+;; sequence and their frequency in the second sequence can
+;; be explained by chance. higher numbers means higher confidence
+;; that they cannot.
+(define (chi-square seqA seqB)
+  (with-handlers ([exn:fail? (λ (e) +nan.0)])
+    (let* ([ct-a (length seqA)]
+           [ct-b (length seqB)]
+           [total-subjects (+ ct-a ct-b)]
+           [a-hits (apply + seqA)]
+           [b-hits (apply + seqB)] ;; these assume that the data is coded as 1 = present, 0 = not present
+           [a-misses (- ct-a a-hits)]
+           [b-misses (- ct-b b-hits)]
+           [table
+            `((,a-hits ,b-hits)
+              (,a-misses ,b-misses))]
+           [expected (λ: ([i : Integer] [j : Integer])
+                         (/ (* (row-total i table) (col-total j table)) total-subjects))])
+      (exact->inexact 
+       (table-sum 
+        (λ (i j) (/ (sqr (- (expected i j) (table-ref i j table))) (expected i j)))
+        table)))))
+
+;; ============================================================
+;; UNITS OF MEASUREMENT IMPLEMENTATIONS
+
+(: per-module (All (X) (((Listof Any) ->  X) -> (Path -> (List (U #f X))))))
+(define (per-module f)  
+  (λ (path)
+    (with-handlers ([exn:fail:read? (λ (e) (list #f))])
+      (let ([initial-sexp (with-input-from-file path read)])
+        (match initial-sexp
+          [`(module ,_ ,_  ,bodies ...)
+           (list (f bodies))]
+          [_ (list #f)])))))
+
+(: per-module-top-level-expression ((Any -> (Listof NumF)) -> MetricFn))
+(define (per-module-top-level-expression f)
+  (let ([calc (per-module (λ: ([exprs : (Listof Any)]) (map f exprs)))])  
+    (λ (p) (let ([r  (calc p)]) (if (car r) (car r) r)))))
+
+;; ============================================================
+;; BASIC CALCULATIONS
+;; (for use with metric definitions below)
+
+;; ----------------------------------------
+;; depth
+
+(: sexp-depth (Any -> Number))
+(define (sexp-depth sexp)
+  (cond
+    [(pair? sexp)
+     (+ (max-sexp-depth sexp) 1)]
+    [else 0]))
+
+(: max-sexp-depth (Any -> Number))
+(define (max-sexp-depth losx)
+  (improper-foldr (λ: ([t : Any] [r : Number]) (max (sexp-depth t) r)) 0 losx))
+
+(: avg-sexp-depth ((Listof Any) -> Number))
+(define (avg-sexp-depth sexps)
+  (cond
+    [(null? sexps) 0]
+    [else (avg (map sexp-depth sexps))]))
+
+;; ----------------------------------------
+;; setbang counts
+
+(: count-setbangs/ilist (Any -> Number))
+(define (count-setbangs/ilist exprs)
+  (apply + (imap count-setbangs/expr exprs)))
+(: count-setbangs/expr (Any -> Number))
+(define (count-setbangs/expr expr)
+  (match expr
+    [`(,(? setbang?) ,rest ...) (+ 1 (count-setbangs/ilist rest))]
+    [('quote _) 0]
+    [('quasiquote _) 0] ; undercount potentially, but how many `,(set! ...)'s can there be?
+    [`(,e1 . ,e2) (count-setbangs/ilist expr)]
+    [_ 0]))
+
+(: setbang?  (Any -> Any))
+(define (setbang? v)
+  (and (symbol? v)
+       (regexp-match #rx"^set(-.*)?!" (symbol->string v))))
+
+;; count-fns
+(: count-fns-with-setbangs ((Listof Any) -> Number))
+(define (count-fns-with-setbangs exprs)
+  (apply + (map (λ (e) (if (= (count-setbangs/expr e) 0) 0 1)) exprs)))
+(: module-has-setbangs? ((Listof Any) -> Boolean))
+(define (module-has-setbangs? exprs) (ormap expr-uses-setbangs? exprs))
+(: expr-uses-setbangs? (Any -> Boolean))
+(define (expr-uses-setbangs? expr)
+  (not (= (count-setbangs/expr expr) 0)))
+
+(: setbangs-per-1000-atoms ((Listof Any) -> NumF))
+(define (setbangs-per-1000-atoms exprs)
+  (if (null? exprs)
+      #f
+      (let ([set!s (count-setbangs/ilist exprs)]
+            [atoms (atoms exprs)])
+        (* (/ set!s atoms) 1000.0))))
+
+;; ----------------------------------------
+;; contracts 
+
+(: uses-contracts ((Listof Any) -> Boolean))
+(define (uses-contracts exprs) 
+  (ormap (λ (e)
+           (ann
+            (match e
+              [`(provide/contract ,_ ...) #t]
+              [_ #f])
+            : Boolean))
+         exprs))
+
+(: contracted-provides ((Listof Any) -> Number))
+(define (contracted-provides exprs)
+  (foldl
+   (λ: ([t : Any] [r : Number])
+       (ann
+        (match t
+          [(provide/contract ,p ...) (+ (length p) r)]
+          [_ r]) : Number))
+   0
+   exprs))
+
+(: uncontracted-provides ((Listof Any) -> Number))
+(define (uncontracted-provides exprs) 
+  (foldl
+   (λ: ([t : Any] [r : Number])
+       (ann 
+        (match t
+          [`(provide ,p  ...) (+ (length p) r)] 
+          [_ r]) : Number))
+   0
+   exprs))
+
+;; ----------------------------------------
+;; macros
+
+(: number-of-macro-definitions (Any -> Number))
+(define (number-of-macro-definitions expr)
+  (match expr
+    [`(define-syntax ,_ ...) 1]
+    [`(define-syntaxes (,s ...) ,_ ...) (length s)]
+    [`(define-syntax-set (,s ...) ,_ ...) (length s)]
+    [_ 0]))
+
+(: num-of-define-syntax ((Listof Any) -> Number))
+(define (num-of-define-syntax exprs)
+  (foldl (λ: ([t : Any] [r : Number]) (+ (number-of-macro-definitions t) r)) 0 exprs))
+
+;; ----------------------------------------
+;; expression size
+
+(: atoms (Any -> Number))
+(define (atoms sexp)
+  (cond
+    [(null? sexp) 0]
+    [(not (pair? sexp)) 1]
+    [else (+ (atoms (car sexp)) (atoms (cdr sexp)))]))
+
+(: max-atoms ((Listof Any) -> NumF))
+(define (max-atoms exprs)
+  (let ([atom-counts (map atoms exprs)])
+    (if (null? atom-counts)
+        #f
+        (apply max atom-counts))))
+
+(: avg-atoms ((Listof Any) -> NumF))
+(define (avg-atoms exprs)
+  (let ([atom-counts (map atoms exprs)])
+    (if (null? atom-counts)
+        #f
+        (avg (map atoms exprs)))))
+
+(: total-atoms ((Listof Any) -> Number))
+(define (total-atoms exprs)
+  (apply + (map atoms exprs)))
+
+
+;; ============================================================
+;; METRIC DEFINITIONS
+;; 'a 'b metric : (string * (listof sexp -> 'a option) * ((listof 'a) (listof 'a) -> 'b)
+(define-typed-struct (b c d) metric ([analysis-unit : (Unit c)]
+                                     [computation : (c -> d)]
+                                     [>display : ((Listof d) (Listof d) -> b)]))
+
+(define-type-alias Table (Listof (Listof Number)))
+(define-type-alias Atom-display (cons Symbol (Listof Number)))
+
+(: standard-display (Symbol ((Listof Number) -> Number) ((Listof Number) (Listof Number) -> Number) 
+                     -> ((Listof NumF) (Listof NumF) -> Atom-display)))
+(define ((standard-display name summarize significance-test) seqA seqB)
+    (let ([clean-seqA (nonfalses seqA)]
+          [clean-seqB (nonfalses seqB)])
+      (list name (summarize clean-seqA) (summarize clean-seqB) (significance-test clean-seqA clean-seqB))))
+
+(: interval (All (c) ((Unit c) Symbol (c -> NumF) -> (metric Atom-display c NumF))))
+(define (interval u name compute) (make-metric u compute (standard-display name avg t-test)))
+
+(: count (All (c) ((Unit c) Symbol (c -> Boolean) -> (metric  Atom-display c NumF))))
+(define (count u name compute) (make-metric u (λ: ([es : c]) (if (compute es) 1 0)) (standard-display name avg chi-square)))
+
+(: combine-metrics (All (c) ((Listof (metric Atom-display c NumF)) -> (metric (Listof Atom-display) c (Listof NumF)))))
+(define (combine-metrics ms)
+  (let ([u (metric-analysis-unit (car ms))])      
+    ;; This test now redundant b/c of typechecking
+    (unless (andmap (λ: ([m : (metric Atom-display c NumF) ]) (eq? u (metric-analysis-unit m))) ms)
+      (error 'combine-metrics "all combined metrics must operate on the same unit of analysis"))
+    
+    (make-metric
+     u
+     (λ: ([exprs : c]) (map (λ: ([m : (metric Atom-display c NumF)]) ((metric-computation m) exprs)) ms))
+     (λ: ([seqA : (Listof (Listof NumF))] [seqB : (Listof (Listof NumF))])
+              (map (λ: ([m : (metric Atom-display c NumF)] 
+                             [sA : (Listof NumF)] 
+                             [sB : (Listof NumF)]) 
+                            ((metric->display m) sA sB)) ms (pivot seqA) (pivot seqB))))))
+
+;; FIXME - (filter (lambda (x) x) l)
+(: nonfalses (All (X) ((Listof (U #f X)) -> (Listof X))))
+(define (nonfalses l) 
+  (let loop ([lst l])
+    (if (null? lst)
+        '()
+        (let ([x (car lst)])
+          (if x 
+              (cons x (loop (cdr lst)))
+              (loop (cdr lst)))))))
+
+(: avg ((Listof Number) -> Number))
+(define (avg l) (/ (exact->inexact (apply + l)) (length l)))
+(: avg* ((Listof Number) -> Number))
+(define (avg* l) (avg (nonfalses l)))
+
+(define-syntax define-metrics
+  (syntax-rules ()
+    [(define-metrics all-metrics-id unit-of-analysis  (name kind fn) ...)
+     (begin
+       (define u unit-of-analysis)
+       (define name (kind u 'name fn )) ...
+       (define all-metrics-id (combine-metrics (list name ...))))]))
+
+(define-metrics module-metrics #{per-module @ (Listof NumF)} 
+  (maximum-sexp-depth        interval  max-sexp-depth)
+  (average-sexp-depth        interval  avg-sexp-depth)
+  (number-of-setbangs/mod    interval  count-setbangs/ilist)
+  (number-of-exprs           interval  #{length @ Any}) 
+  (uses-setbang?/mod         count     module-has-setbangs?)
+  (uses-contracts?           count     uses-contracts)
+  (number-of-contracts       interval  contracted-provides)
+  (num-uncontracted-provides interval  uncontracted-provides)  
+  (number-of-macro-defs      interval  num-of-define-syntax)
+  (maximum-num-atoms         interval  max-atoms) 
+  (average-num-atoms         interval  avg-atoms)
+  (total-num-atoms/mod       interval  total-atoms)
+  (set!s-per-1000-atoms      interval  setbangs-per-1000-atoms))
+
+(define-metrics tl-expr-metrics per-module-top-level-expression  
+  (uses-setbang?/fn          count     expr-uses-setbangs?)
+  (number-of-setbangs/fn     interval  count-setbangs/expr)
+  (total-num-atoms/fn        interval  atoms))
+
+(: all-metrics (List (metric (Listof Atom-display) (Listof Any) (Listof NumF))
+                     (metric (Listof Atom-display) Any (Listof NumF)) ))
+(define all-metrics (list module-metrics tl-expr-metrics))
+
+;; ============================================================
+;; EXPERIMENT RUNNING
+
+(define-syntax (define-excluder stx)
+  
+  (define (path->clause c)
+    (syntax-case c ()
+      [(item ...)
+       #`[`(#,@(reverse (syntax-e #'(item ...))) ,_ (... ...)) #t]]
+      [item
+       #`[`(item) #t]]))
+  
+  (syntax-case stx ()
+    [(_ name path ...)
+     (with-syntax ([(match-clause ...) (map path->clause (syntax-e #'(path ...)))])
+       #`(define (name p ) 
+           (let* ([dirnames (map path->string (filter path? (explode-path p)))])
+             (match (reverse dirnames) ; goofy backwards matching because ... matches greedily
+               match-clause ...
+               [_ #f]))))]))
+
+(: default-excluder (Path -> Boolean))
+(define-excluder default-excluder 
+  "compiled" ".svn" #;("collects" "drscheme") #;("collects" "framework"))
+
+(define exclude-directory? (make-parameter default-excluder))
+
+;; ----------------------------------------
+;; apply-to-scheme-files: (path[file] -> X) path[directory] -> (listof X)
+;; applies the given function to each .ss or .scm file in the given directory
+;; hierarchy; returns all results in a list
+(: apply-to-scheme-files (All (X) ((Path -> X) Path -> (Listof X))))
+(define  (apply-to-scheme-files f root)
+  (fold-files
+   (λ: ([path : Path] [kind : (U 'file 'dir 'link)] [acc : (Listof X)])
+     (case kind
+       [(file)
+        (let ([extension (filename-extension path)])
+          (cond
+            [(not extension) (values acc #t)]
+            [(regexp-match #rx"(ss|scm)$" extension)
+             (let ([resl (f path)])
+               (if resl
+                   (values (cons resl acc) #t)  
+                   (values acc #t)))]
+            [else (values acc #t)]))]
+       [(dir) 
+        (let* ([p (normalize-path path root)])
+          (if ((exclude-directory?) p)
+              (values acc #f)
+              (values acc #t)))]         
+       [(link) (values acc #t)]))  
+   '()
+   root)) 
+(define-typed-struct (a b c) result ([metric : (metric b c a)] [seqA : (Listof a)] [seqB : (Listof a)]))
+(define-type-alias MetricFn (Path -> (Listof (U #f (Listof NumF)))))
+
+(define-type-alias (M b c) (metric b c (Listof NumF)))
+(define-type-alias (M2 b c c*) (U (M b c) (M b c*)))
+
+;; get-sequences : (listof 'a metric) path -> (listof (listof 'a))
+(: get-sequences (All (b c C) ((List (M b c) (M b C)) Path -> (Listof (Listof (Listof NumF))))))
+(define (get-sequences metrics path)
+  (: selector (case-lambda [(M b c) -> MetricFn] [(M b C) -> MetricFn]))
+  (define (selector m) ((metric-analysis-unit m) (metric-computation m)))
+  (let* ([metric-fns (map #{selector :: ((M2 b c C) -> MetricFn)} metrics)]
+         [result-seqs (apply-to-scheme-files 
+                       (λ: ([file : Path]) 
+                           (map (λ: ([fn : MetricFn]) (fn file)) metric-fns)) path)])
+    (map 
+     (λ: ([l : (Listof (Listof (U #f (Listof NumF))))]) 
+         (nonfalses (apply append l)))
+     (pivot (nonfalses result-seqs)))))
+ 
+
+(: compare* 
+   (All (b c c*)
+        ((List (M b c) (M b c*))
+         ->
+         (List (result (Listof NumF) b c)
+               (result (Listof NumF) b c*)))))
+(define (compare* metrics)
+  (let* ([seqAs (get-sequences metrics (COLLECTS-PATH))]
+         [seqBs (get-sequences metrics (PLANET-CODE-PATH))])
+    (list
+     (make-result (car metrics) (car seqAs) (car seqBs))
+     (make-result (cadr metrics) (cadr seqAs) (cadr seqBs)))))
+
+(: show (All (a b c) ((result a b c) -> b)))
+(define (show result)
+  ((metric->display (result-metric result))
+   (result-seqA result)
+   (result-seqB result)))
+
+(: pretty-print-result 
+   (case-lambda
+     ((result (Listof NumF) (Listof Atom-display) (Listof Any)) -> Void)
+     ((result (Listof NumF) (Listof Atom-display) Any) -> Void)))
+(define (pretty-print-result result)
+  (for-each
+   (λ: ([l : (Listof Any)])
+            (apply srfi48:format
+                   (current-output-port)
+                   "~26F  | ~8,2F  | ~6,2F  | ~12,2F\n"
+                   (format "~a" (car l))
+                   (cdr l)))
+   (list* '("test name" "collects" "planet" "significance")
+          '("---------" "--------" "------" "------------")
+          (show result))))
+
+;; applies only to the combined metric [or more generally to listof-answer results]
+(: 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)))
+  (list (total/s (result-seqA result)) (total/s (result-seqB result))))
+
+;; ============================================================
+;; UTILITY
+
+(: imap (All (Y) ((Any -> Y) Any -> (Listof Y))))
+(define (imap f il) 
+  (cond
+    [(null? il) '()]
+    [(not (pair? il)) (list (f il))]
+    [else (cons (f (car il)) (imap f (cdr il)))]))
+
+(: pivot (All (X) ((Listof (Listof X)) -> (Listof (Listof X)))))
+(define (pivot l)
+  (cond
+    [(null? l) '()]
+    [else
+     (let ([n (length (car l))])
+       (build-list n (λ: ([i : Integer]) (map (λ: ([j : (Listof X)]) (list-ref j i)) l))))]))
+
+(: variance ((Listof Number) -> Number))
+(define (variance xs)
+  (let ([avg (/ (apply + xs) (length xs))])
+    (/ (apply + (map (λ: ([x : Number]) (sqr (- x avg))) xs))
+       (sub1 (length xs)))))
+
+(: table-ref (Integer Integer Table -> Number))
+(define (table-ref i j table)
+  (list-ref (list-ref table i) j))
+(: row-total (Integer Table -> Number))
+(define (row-total i table)
+  (apply + (list-ref table i)))
+(: col-total (Integer Table -> Number))
+(define (col-total j table)
+  (apply + (map (λ: ([x : (Listof Number)]) (list-ref x j)) table)))
+(: table-sum ((Integer Integer -> Number) Table -> Number))
+(define (table-sum f table)
+  (let ([rows (length table)]
+        [cols (length (car table))])
+    (let loop  ([i 0] [j 0] [#{sum : Number} 0])
+      (cond
+        [(>= j cols) sum]
+        [(>= i rows) (loop 0 (add1 j) sum)]
+        [else        (loop (add1 i) j (+ sum (f i j)))]))))
+
+(: improper-foldr (All (Y) ((Any Y -> Y) Y Any -> Y)))
+(define (improper-foldr f b l)
+  (cond
+    [(null? l) b]
+    [(not (pair? l))
+     (f l b)]
+    [else
+     (f (car l) (improper-foldr f b (cdr l)))]))
+
+(: /* (All (a ...) ((Listof Number) (Listof Number) ... a -> (Listof Number))))
+(define (/* arg . args)
+    (apply map (λ: ([n : Number] . [ns : Number ... a]) (apply / n ns)) arg args))
+
+
+;; ============================================================
+;; MAIN ENTRY POINT
+
+(: results (U #f (Listof (U (result (Listof NumF) (Listof Atom-display) (Listof Any)) 
+                            (result (Listof NumF) (Listof Atom-display) Any)))))
+(define results #f) ; just in case i want to do some more analysis on the results afterwards,
+; so i don't have to waste a minute if i forget to bind the return value to something
+
+(define (run-all-tests) 
+  (let ([rs (compare* all-metrics)])
+        (set! results rs)
+    (for-each
+     (ann pretty-print-result ((U (result (Listof NumF) (Listof Atom-display) (Listof Any)) 
+                                  (result (Listof NumF) (Listof Atom-display) Any))
+                               -> Any))
+     rs)
+    rs))
+
diff --git a/collects/typed-scheme/private/base-env.ss b/collects/typed-scheme/private/base-env.ss
index edd2bec2..954abe91 100644
--- a/collects/typed-scheme/private/base-env.ss
+++ b/collects/typed-scheme/private/base-env.ss
@@ -125,11 +125,11 @@
                      [((a b c . -> . c) c (-lst a) (-lst b)) c]
                      [((a b c d . -> . d) d (-lst a) (-lst b) (-lst d)) d]))]
 [filter (-poly (a b) (cl->*
-                      ((make-pred-ty (list a) B b)
+                      ((make-pred-ty (list a) Univ b)
                        (-lst a)
                        . -> .
                        (-lst b))
-                      ((a . -> . B) (-lst a) . -> . (-lst a))))]
+                      ((a . -> . Univ) (-lst a) . -> . (-lst a))))]
 [filter-map (-polydots (c a b)
                        ((list
                          ((list a) (b b) . ->... . (-opt c))
@@ -247,11 +247,15 @@
 
 [build-path ((list -Pathlike*) -Pathlike* . ->* . -Path)]
 [with-input-from-file
- (-poly (a) (cl-> [(-Pathlike  (-> a))  a]
-                  [(-Pathlike (-> a) Sym) a]))]
+ (-poly (a) (->key -Pathlike (-> a) #:mode (one-of/c 'binary 'text) #f a))]
 [with-output-to-file
- (-poly (a) (cl-> [(-Pathlike  (-> a))  a]
-                  [(-Pathlike (-> a) Sym) a]))]
+ (-poly (a) (->key -Pathlike (-> a) 
+                   #:exists (one-of/c 'error 'append 'update 'can-update
+                           'replace 'truncate
+                           'must-truncate 'truncate/replace)
+                   #f
+                   #:mode (one-of/c 'binary 'text) #f 
+                   a))]
 
 [random (cl-> [(-Integer) -Integer] [() N])]
 
@@ -690,6 +694,9 @@
 [symbol=? (Sym Sym . -> . B)]
 [false? (make-pred-ty (-val #f))]
 
+;; scheme/port
+[port->lines (-> -Input-Port (-lst -String))]
+
 ;; with-stx.ss
 [generate-temporaries ((Un (-Syntax Univ) (-lst Univ)) . -> . (-lst (-Syntax Sym)))]
 [check-duplicate-identifier ((-lst (-Syntax Sym)) . -> . (-opt (-Syntax Sym)))]
diff --git a/collects/typed-scheme/private/base-types.ss b/collects/typed-scheme/private/base-types.ss
index 6180b39b..32e03043 100644
--- a/collects/typed-scheme/private/base-types.ss
+++ b/collects/typed-scheme/private/base-types.ss
@@ -9,6 +9,7 @@
 [Any Univ]
 [Port -Port]
 [Path -Path]
+[Path-String -Pathlike]
 [Regexp -Regexp]
 [PRegexp -PRegexp]
 [Char -Char]
diff --git a/collects/typed-scheme/typecheck/tc-app.ss b/collects/typed-scheme/typecheck/tc-app.ss
index c076819b..dadb29ce 100644
--- a/collects/typed-scheme/typecheck/tc-app.ss
+++ b/collects/typed-scheme/typecheck/tc-app.ss
@@ -187,7 +187,7 @@
   (define-values (fixed-args tail) (split (syntax->list args)))
 
   (match f-ty
-    [(tc-result1: (Function: (list (arr: doms rngs rests drests '()) ...)))
+    [(tc-result1: (Function: (list (arr: doms rngs rests drests (list (Keyword: _ _ #f) ...)) ...)))
      (when (null? doms)
        (tc-error/expr #:return (ret (Un))
                       "empty case-lambda given as argument to apply"))
@@ -232,7 +232,7 @@
                 (printf/log "Non-poly apply, ... arg\n")
                 (do-ret (car rngs*))]
                [else (loop (cdr doms*) (cdr rngs*) (cdr rests*) (cdr drests*))])))]
-    [(tc-result1: (Poly: vars (Function: (list (arr: doms rngs rests drests '()) ..1))))
+    [(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)]
                    [(tail-ty tail-bound) (with-handlers ([exn:fail:syntax? (lambda _ (values (tc-expr/t tail) #f))])
                                            (tc/dots tail))])
@@ -431,6 +431,16 @@
      #:declare s-kp (id-from 'struct:keyword-procedure 'scheme/private/kw)
      #:declare kpe  (id-from 'keyword-procedure-extract 'scheme/private/kw)
      (match (tc-expr #'fn)
+       [(tc-result1: (Poly: vars 
+                            (Function: (list (and ar (arr: dom rng (and rest #f) (and drest #f) kw-formals))))))
+        (=> fail)
+        (unless (null? (fv/list kw-formals))
+          (fail))
+        (match (map single-value (syntax->list #'pos-args))
+          [(list (tc-result1: argtys-t) ...)
+           (let* ([subst (infer vars argtys-t dom rng (fv rng) (and expected (tc-results->values expected)))])
+             (tc-keywords form (list (subst-all subst ar))
+                          (type->list (tc-expr/t #'kws)) #'kw-arg-list #'pos-args expected))])]
        [(tc-result1: (Function: arities)) 
         (tc-keywords form arities (type->list (tc-expr/t #'kws)) #'kw-arg-list #'pos-args expected)]
        [(tc-result1: t) (tc-error/expr #:return (ret (Un))
@@ -590,11 +600,14 @@
        (string-append "No function domains matched in function application:\n"
                       (domain-mismatches t doms rests drests rngs argtys-t #f #f))))]
     ;; polymorphic functions without dotted rest
-    [((tc-result1: (and t
-                      (or (Poly: vars 
-                                 (Function: (list (and arrs (arr: doms rngs rests (and drests #f) '())) ...)))
-                          (PolyDots: vars
-                                     (Function: (list (and arrs (arr: doms rngs rests (and drests #f) '())) ...))))))
+    [((tc-result1: 
+       (and t
+            (or (Poly: 
+                 vars 
+                 (Function: (list (and arrs (arr: doms rngs rests (and drests #f) (list (Keyword: _ _ #f) ...))) ...)))
+                (PolyDots: 
+                 vars
+                 (Function: (list (and arrs (arr: doms rngs rests (and drests #f) (list (Keyword: _ _ #f) ...))) ...))))))
       (list (tc-result1: argtys-t) ...))
      (handle-clauses (doms rngs rests arrs) f-stx args-stx
                      ;; only try inference if the argument lengths are appropriate
diff --git a/collects/typed-scheme/typecheck/tc-envops.ss b/collects/typed-scheme/typecheck/tc-envops.ss
index 010f5f85..6ef796f0 100644
--- a/collects/typed-scheme/typecheck/tc-envops.ss
+++ b/collects/typed-scheme/typecheck/tc-envops.ss
@@ -49,6 +49,8 @@
      (restrict t u)]
     [(t (NotTypeFilter: u (list) _))
      (remove t u)]
+    [((Union: ts) lo)
+     (apply Un (map (lambda (t) (update t lo)) ts))]
     [(t* lo)
      (int-err "update along ill-typed path: ~a ~a ~a" t t* lo)]))
 
diff --git a/collects/typed-scheme/typecheck/tc-expr-unit.ss b/collects/typed-scheme/typecheck/tc-expr-unit.ss
index 52c32ba8..52e3fd79 100644
--- a/collects/typed-scheme/typecheck/tc-expr-unit.ss
+++ b/collects/typed-scheme/typecheck/tc-expr-unit.ss
@@ -306,8 +306,15 @@
         ;; 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*))
+         (match expected
+           [(tc-result1: t)
+            (with-lexical-env/extend (list #'name) (list t) (tc-expr/check/internal #'expr expected))]
+           [(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/check #'((name ...) ...) #'(expr ...) #'body form expected)]
+         (tc/letrec-values/check #'((name ...) ...) #'(expr ...) #'body form expected)]        
         ;; other
         [_ (tc-error/expr #:return (ret expected) "cannot typecheck unknown form : ~a~n" (syntax->datum form))]
         ))))
diff --git a/collects/typed-scheme/typecheck/tc-toplevel.ss b/collects/typed-scheme/typecheck/tc-toplevel.ss
index 24f16702..a14e0125 100644
--- a/collects/typed-scheme/typecheck/tc-toplevel.ss
+++ b/collects/typed-scheme/typecheck/tc-toplevel.ss
@@ -172,10 +172,10 @@
       
       ;; definitions just need to typecheck their bodies
       [(define-values (var ...) expr)
-       (let* ([vars (syntax->list #'(var ...))]
-              [ts (map lookup-type vars)])
-         (tc-expr/check #'expr (ret ts)))
-       (void)]
+       (begin (let* ([vars (syntax->list #'(var ...))]
+                     [ts (map lookup-type vars)])
+                (tc-expr/check #'expr (ret ts)))
+              (void))]
       
       ;; to handle the top-level, we have to recur into begins
       [(begin) (void)]
diff --git a/collects/typed/scheme/system.ss b/collects/typed/scheme/system.ss
new file mode 100644
index 00000000..a0fcddab
--- /dev/null
+++ b/collects/typed/scheme/system.ss
@@ -0,0 +1,10 @@
+#lang typed-scheme
+
+(require typed/private/utils)
+
+(require/typed/provide
+ scheme/system
+ [system (String -> Boolean)]
+ [system* (Path-String String * -> Boolean)]
+ [system/exit-code (String -> Integer)]
+ [system*/exit-code (Path-String String * -> Integer)])
\ No newline at end of file