diff --git a/collects/handin-server/checker.ss b/collects/handin-server/checker.ss
index b9337a2b05..754f1f329d 100644
--- a/collects/handin-server/checker.ss
+++ b/collects/handin-server/checker.ss
@@ -180,10 +180,10 @@
   (let-values ([(defs inters) (unpack-submission submission)])
     (parameterize ([current-input-port
                     (if textualize?
-                      (input-port->text-input-port (open-input-text-editor
-                                                    defs 0 'end snip->text))
+                      (input-port->text-input-port
+                       (open-input-text-editor defs 0 'end snip->text))
                       (open-input-text-editor defs))]
-                   [current-output-port (open-output-string)])
+                   [current-output-port (open-output-bytes)])
       (input->process->output maxwidth textualize? untabify? bad-re)
       (get-output-bytes (current-output-port)))))
 
@@ -345,14 +345,15 @@
              [keyvals '()]
              [got null])
     (define (get key . default)
-      (cond [(assq key keyvals) => (lambda (x) (set! got (cons x got)) (caddr x))]
+      (cond [(assq key keyvals)
+             => (lambda (x) (set! got (cons x got)) (caddr x))]
             [(pair? default) (car default)]
             [else #f]))
     (syntax-case stx ()
       [(key val x ...)
        (and (identifier? #'key)
             (regexp-match? #rx"^:" (symbol->string (syntax-e #'key))))
-       (loop #'(x ...) 
+       (loop #'(x ...)
              (cons (list (syntax-e #'key) #'key #'val) keyvals)
              (cons (syntax-e #'key) got))]
       [(body ...)
diff --git a/collects/handin-server/scribblings/checker.scrbl b/collects/handin-server/scribblings/checker.scrbl
index 3e36d3a304..8541676384 100644
--- a/collects/handin-server/scribblings/checker.scrbl
+++ b/collects/handin-server/scribblings/checker.scrbl
@@ -1,6 +1,9 @@
 #lang scribble/doc
 @(require "common.ss")
 
+@define[textoption]{(Effective only when saving a textual version of
+  the submission files: when @scheme[:create-text?] is on.)}
+
 @title{checker}
 
 @defmodulelang[handin-server/checker]{
@@ -28,10 +31,15 @@ language module---a typical checker that uses it looks like this:
                            (code:line :key val keys-n-vals)])]{
 
 Constructs (and provides) an appropriate checker function, using
-keywords for features that you want, the body of the checker can
-contain arbitrary code, using all utilities from
-@schememodname[handin-server/utils], as well as additional ones (see
-below).}
+keywords to customize features that you want it to have.  The body of
+the checker (following the keywords) can contain arbitrary code, using
+utility functions from @schememodname[handin-server/utils], as well as
+additional ones that are defined below.  Submission files are arriving
+to the handin server in binary form (in the MrEd format that is used
+to store text and other objects like images), and a number of these
+options involve genrating a textual version of this file.  The purpose
+of these options is to have these text files integrate easily into a
+course framework for grading, based on these text files.}
 
 Keywords for configuring @scheme[check:]:
 
@@ -71,29 +79,47 @@ Keywords for configuring @scheme[check:]:
   printouts and grading, and is in a subdirectory so students will not
   see it on the status web server.  Defaults to @scheme[#t].}
 
+@item{@indexed-scheme[:textualize?]---if true, then all submissions
+  are converted to text, trying to convert objects like images and
+  comment boxes to some form of text.  Defaults to @scheme[#f],
+  meaning that an exception is raised for submissions that are not all
+  text. @textoption
+
+  This flag is effective only when saving a textual version of the
+  submission files --- when @scheme[:create-text?] is on.  The
+  possible configurations are:
+  @itemize[
+  @item{@scheme[:create-text?] is on and @scheme[:textualize?] is off
+    (the default) --- in this case a text version of submissions is
+    created, and submissions must contain only plain text.  The text
+    file has the same semantics of the submission and can be used to
+    run student code.}
+  @item{@scheme[:create-text?] is off --- allowing submissions that
+    contain non-textual objects, but no text file is created so
+    grading and testing must be done using DrScheme (because the saved
+    submission is always in binary format).}
+  @item{Both flags are on --- allowing submission with non-textual
+    objects and generating text files, but these files will not be
+    usable as code since objects like images cannot be represented in
+    plain text.}]}
+
 @item{@indexed-scheme[:untabify?]---if true, then tabs are converted
   to spaces, assuming a standard tab width of 8 places.  This is
   needed for a correct computation of line lengths, but note that
   DrScheme does not insert tabs in Scheme mode.  Defaults to
-  @scheme[#t].}
-
-@item{@indexed-scheme[:textualize?]---if true, then all submissions
-  are converted to text, trying to convert objects like comment boxes
-  and test cases to some form of text.  Defaults to @scheme[#f],
-  meaning that an exception is raised for submissions that are not all
-  text.}
+  @scheme[#t].  @textoption}
 
 @item{@indexed-scheme[:maxwidth]---a number that specifies maximum
   line lengths for submissions (a helpful feature for reading student
   code).  Defaults to 79.  This feature can be disabled if set to
-  @scheme[#f].  (This is effective only when saving a textual version
-  of the submission files.)}
+  @scheme[#f].  @textoption}
 
 @item{@indexed-scheme[:output]---the name of the original handin file
   (unrelated to the text-converted files).  Defaults to
   @filepath{hw.scm}.  (The suffix changes the defaults of
   @scheme[:markup-prefix] and @scheme[:prefix-re].)  Can be
-  @scheme[#f] for removing the original file after processing.}
+  @scheme[#f] for removing the original file after processing.  The
+  file is always stored in MrEd's binary format.}
 
 @item{@indexed-scheme[:multi-file]---by default, this is set to
   @scheme[#f], which means that only DrScheme is used to send
@@ -106,13 +132,14 @@ Keywords for configuring @scheme[check:]:
 @item{@indexed-scheme[:markup-prefix]---used as the prefix for
   @scheme[:student-lines] and @scheme[:extra-lines] below.  The
   default is @scheme[";;> "] or @scheme["//> "], depending on the
-  suffix of @scheme[:output] above.  (Note: if you change this, make
-  sure to change @scheme[:prefix-re] too.)}
+  suffix of @scheme[:output] above.  Note: if you change this, make
+  sure to change @scheme[:prefix-re] too.  @textoption}
 
 @item{@indexed-scheme[:prefix-re]---used to identify lines with markup
   (@scheme[";>"] or @scheme["//>"] etc), so students cannot fool the
   system by writing marked-up code.  The default is @scheme[";>"] or
-  @scheme["//>"], depending on the suffix of :output above.}
+  @scheme["//>"], depending on the suffix of :output above.
+  @textoption}
 
 @item{@indexed-scheme[:student-line]---when a submission is converted
   to text, it begins with lines describing the students that have
@@ -122,14 +149,14 @@ Keywords for configuring @scheme[check:]:
   which requires @scheme["Full Name"] and @scheme["Email"] entries in
   the server's extra-fields configuration.  These lines are prefixed
   with @scheme[";;> "] or the prefix specified by
-  @scheme[:makup-prefix] above.}
+  @scheme[:makup-prefix] above.  @textoption}
 
 @item{@indexed-scheme[:extra-lines]---a list of lines to add after the
   student lines, all with a @scheme[";;> "] or :markup-prefix too.
   Defaults to a single line:
   @scheme["Maximum points for this assignment: <+100>"].  (Can use
   @scheme["{submission}"] for the submission directory.)  See also
-  @scheme[add-header-line!].}
+  @scheme[add-header-line!].  @textoption}
 
 @item{@indexed-scheme[:user-error-message]---a string that is used to
   report an error that occurred during evaluation of the submitted
diff --git a/collects/handin-server/scribblings/quick-start.scrbl b/collects/handin-server/scribblings/quick-start.scrbl
index 9d0e8855cd..5fb1855056 100644
--- a/collects/handin-server/scribblings/quick-start.scrbl
+++ b/collects/handin-server/scribblings/quick-start.scrbl
@@ -29,7 +29,7 @@
   @schemeblock[((active-dirs ("test"))
                 (https-port-number 9780))]}
 
-@item{In your new directory, run @commandline{mred -l handin-server}}
+@item{In your new directory, run @commandline{mred-text -l handin-server}}
 
 @item{In the @filepath{handin-client} collection, edit
   @filepath{info.ss} and uncomment the lines that define
diff --git a/collects/handin-server/utils.ss b/collects/handin-server/utils.ss
index 41153f73cd..27faef70e2 100644
--- a/collects/handin-server/utils.ss
+++ b/collects/handin-server/utils.ss
@@ -167,7 +167,7 @@
                                                      (eq? lang 'beginner-abbr)))])
     (reraise-exn-as-submission-problem
      (lambda ()
-       (let ([e (make-evaluator lang teachpacks program-port)])
+       (let ([e (make-evaluator lang #:requires teachpacks program-port)])
          (set-run-status "executing your code")
          (go e))))))
 
diff --git a/collects/mzlib/pconvert.ss b/collects/mzlib/pconvert.ss
index bf29dee7b5..d8b9d23aaa 100644
--- a/collects/mzlib/pconvert.ss
+++ b/collects/mzlib/pconvert.ss
@@ -363,6 +363,7 @@
                                                           `(,(recur k) ,(recur v)))))]
                                [(vector? expr) `(vector ,@(map recur (vector->list expr)))]
                                [(symbol? expr) `',expr]
+                               [(keyword? expr) `',expr]
                                [(string? expr) expr]
                                [(primitive? expr) (object-name expr)]
                                [(procedure? expr)
diff --git a/collects/repos-time-stamp/stamp.ss b/collects/repos-time-stamp/stamp.ss
index 2ad6836044..5c134e1b23 100644
--- a/collects/repos-time-stamp/stamp.ss
+++ b/collects/repos-time-stamp/stamp.ss
@@ -1 +1 @@
-#lang scheme/base (provide stamp) (define stamp "23sep2008")
+#lang scheme/base (provide stamp) (define stamp "24sep2008")
diff --git a/collects/scribble/text/syntax-utils.ss b/collects/scribble/text/syntax-utils.ss
index 50fc30bc5f..dd14c75dd7 100644
--- a/collects/scribble/text/syntax-utils.ss
+++ b/collects/scribble/text/syntax-utils.ss
@@ -163,7 +163,7 @@
 (define-syntax (begin/text stx)
   (syntax-case stx ()
     [(begin/text expr ...)
-     #'(process-begin/text begin/collect values expr ...)]))
+     #'(process-begin/text begin/collect begin expr ...)]))
 
 ;; include for templates
 (require (for-syntax scheme/base (prefix-in scribble: "../reader.ss"))
diff --git a/collects/tests/typed-scheme/fail/back-and-forth.ss b/collects/tests/typed-scheme/fail/back-and-forth.ss
index e8548984a9..f8c0093079 100644
--- a/collects/tests/typed-scheme/fail/back-and-forth.ss
+++ b/collects/tests/typed-scheme/fail/back-and-forth.ss
@@ -1,5 +1,5 @@
 #;
-(exn-pred exn:fail:contract? #rx".*contract \\(-> number\\? number\\?\\).*")
+(exn-pred exn:fail:contract? #rx".*contract.*\\(-> number\\? number\\?\\).*")
 
 #lang scheme/load
 
diff --git a/collects/tests/typed-scheme/fail/cnt-err1.ss b/collects/tests/typed-scheme/fail/cnt-err1.ss
index 40c3ca3bd8..71bf76eda9 100644
--- a/collects/tests/typed-scheme/fail/cnt-err1.ss
+++ b/collects/tests/typed-scheme/fail/cnt-err1.ss
@@ -1,5 +1,5 @@
 #;
-(exn-pred exn:fail:contract? ".*expected <T.*" #rx".*contract \\(->.*")
+(exn-pred exn:fail:contract? ".*expected <T.*" #rx".*contract.*\\(->.*")
 
 #lang scheme/load
 
diff --git a/collects/tests/typed-scheme/main.ss b/collects/tests/typed-scheme/main.ss
index 69622ae184..b4fe5d20c1 100644
--- a/collects/tests/typed-scheme/main.ss
+++ b/collects/tests/typed-scheme/main.ss
@@ -55,8 +55,7 @@
             (parameterize ([read-accept-reader #t]
                            [current-load-relative-directory path]
                            [current-directory path])
-              (with-output-to-file "/dev/null" #:exists 'append
-                (lambda () (loader p)))))))))
+              (loader p)))))))
     (apply test-suite dir
            tests)))
 
diff --git a/collects/tests/typed-scheme/succeed/kw.ss b/collects/tests/typed-scheme/succeed/kw.ss
new file mode 100644
index 0000000000..a964ddf13f
--- /dev/null
+++ b/collects/tests/typed-scheme/succeed/kw.ss
@@ -0,0 +1,8 @@
+#lang typed-scheme
+
+
+
+(lambda () 
+  (open-input-file "foo" #:mode 'binary)
+  (open-input-file "foo" #:mode 'text)
+  (open-input-file "foo"))
diff --git a/collects/typed-scheme/main.ss b/collects/typed-scheme/main.ss
index dde6b16ebc..f2bcf797f4 100644
--- a/collects/typed-scheme/main.ss
+++ b/collects/typed-scheme/main.ss
@@ -1,10 +1,12 @@
 #lang s-exp "minimal.ss"
            
+
+
 (providing (libs (except scheme/base #%module-begin #%top-interaction with-handlers lambda #%app)
                  (except "private/prims.ss"))
 	   (basics #%module-begin		   		   		   
 		   #%top-interaction
 		   lambda
 		   #%app))
-
+(require "private/base-env.ss" "private/base-special-env.ss")
 (provide (rename-out [with-handlers: with-handlers]))
diff --git a/collects/typed-scheme/minimal.ss b/collects/typed-scheme/minimal.ss
index 1ec695a20d..40bcc4c9f6 100644
--- a/collects/typed-scheme/minimal.ss
+++ b/collects/typed-scheme/minimal.ss
@@ -5,7 +5,7 @@
 
 (require (for-syntax scheme/base))
 
-(define-for-syntax ts-mod "typed-scheme.ss")
+(define-for-syntax ts-mod 'typed-scheme/typed-scheme)
 
 (define-syntax (providing stx)
   (syntax-case stx (libs from basics except)
diff --git a/collects/typed-scheme/private/base-env.ss b/collects/typed-scheme/private/base-env.ss
index 569e706358..aa4093b310 100644
--- a/collects/typed-scheme/private/base-env.ss
+++ b/collects/typed-scheme/private/base-env.ss
@@ -1,574 +1,483 @@
-#lang scheme/base
+#lang s-exp "env-lang.ss"
 
-;; these are libraries providing functions we add types to that are not in scheme/base
 (require
- "extra-procs.ss"
- "../utils/utils.ss"
  (only-in scheme/list cons? take drop add-between last filter-map)
  (only-in rnrs/lists-6 fold-left)
  '#%paramz
- (only-in scheme/match/runtime match:error)
  scheme/promise
- string-constants/string-constant)
+ (only-in scheme/match/runtime match:error))
+
+[raise (Univ . -> . (Un))]
+
+(car (-poly (a b) (cl-> [((-pair a b)) a]
+                        [((make-Listof a)) a])))
+[first (-poly (a b) (cl-> [((-pair a b)) a]
+                          [((make-Listof a)) a]))]
+[second (-poly (a b c)
+               (cl->                
+                [((-pair a (-pair b c))) b]
+                [((-lst a)) a]))]
+[third (-poly (a b c d)
+              (cl->                
+               [((-pair a (-pair b (-pair c d)))) c]
+               [((-lst a)) a]))]
+[fourth (-poly (a) ((-lst a) . -> .  a))]
+[fifth (-poly (a) ((-lst a) . -> .  a))]
+[sixth (-poly (a) ((-lst a) . -> .  a))]
+[rest (-poly (a) ((-lst a) . -> .  (-lst a)))]
+(cadr 
+ (-poly (a b c)
+        (cl->                
+         [((-pair a (-pair b c))) b]
+         [((-lst a)) a])))
+(caddr (-poly (a) (-> (-lst a) a)))
+(cadddr (-poly (a) (-> (-lst a) a)))
+(cdr (-poly (a b) (cl-> [((-pair a b)) b]
+                                   [((make-Listof a)) (make-Listof a)])))
+(cddr (-poly (a) (-> (make-Listof a) (make-Listof a))))
+(cdddr (-poly (a) (-> (make-Listof a) (make-Listof a))))
+(cons (-poly (a b) 
+             (cl-> [(a (-lst a)) (-lst a)]
+                   [(a b) (-pair a b)])))
+[*cons (-poly (a b) (cl-> 
+                     [(a b) (-pair a b)]
+                     [(a (-lst a)) (-lst a)]))]
+[*list? (make-pred-ty (-lst Univ))]
+
+(null? (make-pred-ty (-val null)))
+(eof-object? (make-pred-ty (-val eof)))
+[null (-val null)]
+(number? (make-pred-ty N))
+[char? (make-pred-ty -Char)]
+(integer? (make-pred-ty -Integer))
+(boolean? (make-pred-ty B))
+(add1 (cl->*
+       (-> -Integer -Integer)
+       (-> N N)))
+(sub1 (cl->*
+       #;(-> -Integer -Integer)
+       (-> N N)))
+(eq? (-> Univ Univ B))
+(eqv? (-> Univ Univ B))
+(equal? (-> Univ Univ B))
+(even? (-> N B))
+[assert (-poly (a) (-> (*Un a (-val #f)) a))]
+[gensym (cl-> [(Sym) Sym]
+              [() Sym])]
+[string-append (->* null -String -String)]
+[open-input-string (-> -String -Input-Port)]
+[open-output-file 
+ (->key -Pathlike
+        #:mode (one-of/c 'binary 'text) #f
+        #:exists (one-of/c 'error 'append 'update 'can-update                                
+                           'replace 'truncate                                
+                           'must-truncate 'truncate/replace) 
+        #f
+        -Output-Port)]
+[read (cl-> 
+       [(-Port) -Sexp]
+       [() -Sexp])]
+[ormap (-polydots (a c b) (->... (list (->... (list a) (b b) c) (-lst a)) ((-lst b) b) c))]
+[andmap (-polydots (a c b) (->... (list (->... (list a) (b b) c) (-lst a)) ((-lst b) b) c))]
+[newline (cl-> [() -Void]
+               [(-Port) -Void])]
+[not (-> Univ B)]
+[floor (-> N N)]
+[box (-poly (a) (a . -> . (-box a)))]
+[unbox (-poly (a) ((-box a) . -> . a))]
+[set-box! (-poly (a) ((-box a) a . -> . -Void))]
+[box? (make-pred-ty (-box Univ))]
+[cons? (make-pred-ty (-pair Univ Univ))]
+[pair? (make-pred-ty (-pair Univ Univ)) #;(-poly (a b) (make-pred-ty (-pair a b)))]
+[empty? (make-pred-ty (-val null))]
+[empty (-val null)]
+[string? (make-pred-ty -String)]
+[string (->* '() -Char -String)]
+[symbol? (make-pred-ty Sym)]
+[list? (make-pred-ty (-lst Univ))]
+[list (-poly (a) (->* '() a (-lst a)))]
+[procedure? (make-pred-ty (make-Function (list (make-top-arr))))]
+[map (-polydots (c a b) ((list ((list a) (b b) . ->... . c) (-lst a))
+                         ((-lst b) b) . ->... .(-lst c)))]
+[for-each (-polydots (c a b) ((list ((list a) (b b) . ->... . Univ) (-lst a))
+                              ((-lst b) b) . ->... . -Void))]
+[fold-left (-polydots (c a b) ((list ((list c a) (b b) . ->... . c) c (-lst a))
+                               ((-lst b) b) . ->... . c))]
+[fold-right (-polydots (c a b) ((list ((list c a) (b b) . ->... . c) c (-lst a))
+                                ((-lst b) b) . ->... . c))]
+[foldl
+ (-poly (a b c)
+        (cl-> [((a b . -> . b) b (make-Listof a)) b]
+              [((a b c . -> . c) c (make-Listof a) (make-Listof b)) c]))]
+[foldr  (-poly (a b c) ((a b . -> . b) b (-lst a) . -> . b))]
+[filter (-poly (a b) (cl->*
+                      ((a . -> . B
+                          :
+                          (list (make-Latent-Restrict-Effect b))
+                          (list (make-Latent-Remove-Effect b)))
+                       (-lst a)
+                       . -> .
+                       (-lst b))
+                      ((a . -> . B) (-lst a) . -> . (-lst a))))]
+[filter-map (-polydots (c a b)
+                       ((list
+                         ((list a) (b b) . ->... . (-opt c))
+                         (-lst a))
+                        ((-lst b) b) . ->... . (-lst c)))]
+[take   (-poly (a) ((-lst a) -Integer . -> . (-lst a)))]
+[drop   (-poly (a) ((-lst a) -Integer . -> . (-lst a)))]
+[last   (-poly (a) ((-lst a) . -> . a))]
+[add-between (-poly (a b) ((-lst a) b . -> . (-lst (Un a b))))]
+[remove* (-poly (a b)
+                (cl-> [((-lst a) (-lst a)) (-lst a)]
+                      [((-lst a) (-lst b) (a b . -> . B)) (-lst b)]))]
+
+(error 
+ (make-Function (list 
+                 (make-arr null (Un))
+                 (make-arr (list Sym -String) (Un) Univ)
+                 (make-arr (list -String) (Un) Univ)
+                 (make-arr (list Sym) (Un)))))
 
 
+[namespace-variable-value 
+ (cl-> 
+  [(Sym) Univ]
+  [(Sym B -Namespace (-> Univ)) Univ])]
 
-;; these are all for constructing the types given to variables
-(require (for-syntax
-          scheme/base
-          (env init-envs)          
-          (except-in (rep effect-rep type-rep) make-arr)
-          "type-effect-convenience.ss"
-          (only-in "type-effect-convenience.ss" [make-arr* make-arr])
-          "union.ss"
-          (typecheck tc-structs)))
+(match:error (Univ . -> . (Un)))
+(display 
+ (cl->
+  [(Univ) -Void]
+  [(Univ -Port) -Void]))
+[void (->* '() Univ -Void)]
+[void? (make-pred-ty -Void)]
+[printf (->* (list -String) Univ -Void)]
+[fprintf (->* (list -Output-Port -String) Univ -Void)]
+[format (->* (list -String) Univ -String)]   
+(fst (-poly (a b) (-> (-pair a b) a)))
+(snd (-poly (a b) (-> (-pair a b) b)))
 
-(define-for-syntax (initialize-others) 
-  (d-s date 
-       ([second : N] [minute : N] [hour : N] [day : N] [month : N] 
-        [year : N] [weekday : N] [year-day : N] [dst? : B] [time-zone-offset : N])
-       ())
-  (d-s exn ([message : -String] [continuation-marks : Univ]) ())
-  (d-s (exn:fail exn) () (-String Univ))
-  (d-s (exn:fail:read exn:fail) ([srclocs : (-lst Univ)]) (-String Univ))
-  )
+(= (->* (list N N) N B))
+(>= (->* (list N N) N B))
+(< (->* (list N N) N B))
+(<= (->* (list N N) N B))
+[> (->* (list N) N B)]
+(zero? (N . -> . B))
+(* (cl->* (->* '() -Integer -Integer) (->* '() N N)))
+(/ (cl->* (->* (list N) N N)))
+(+ (cl->* (->* '() -Integer -Integer) (->* '() N N)))
+(- (cl->* (->* (list -Integer) -Integer -Integer) (->* (list N) N N)))
+(max (->* (list N) N N))
+(min (->* (list N) N N))
+[vector-ref 
+ (-poly (a) ((-vec a) N . -> . a))]
+[build-vector (-poly (a) (-Integer (-Integer . -> . a) . -> . (-vec a)))]
+[build-list (-poly (a) (-Integer (-Integer . -> . a) . -> . (-lst a)))]
+[reverse (-poly (a) (-> (make-Listof a) (make-Listof a)))]
+[append (-poly (a) (->* (list) (-lst a) (-lst a)))]
+[length (-poly (a) (-> (make-Listof a) -Integer))]
+[memq (-poly (a) (-> a (make-Listof a) (-opt (make-Listof a))))]
+[memv (-poly (a) (-> a (make-Listof a) (-opt (make-Listof a))))]
+[memf (-poly (a) ((a . -> . B) (-lst a) . -> . (-opt (-lst a))))]
+[member 
+ (-poly (a) (a (-lst a) . -> . (-opt (-lst a))))]
+[findf (-poly (a) ((a . -> . B) (-lst a) . -> . (-opt a)))]
 
-(provide (for-syntax initial-env initialize-others))
+[string<? (->* (list -String -String) -String B)]
+[string>? (->* (list -String -String) -String B)]
+[string=? (->* (list -String -String) -String B)]
+[char=? (->* (list -Char -Char) -Char B)]
+[char<=? (->* (list -Char -Char) -Char B)]
+[char>=? (->* (list -Char -Char) -Char B)]
+[char<? (->* (list -Char -Char) -Char B)]
+[char>? (->* (list -Char -Char) -Char B)]
+[char-ci=? (->* (list -Char -Char) -Char B)]
+[char-ci<=? (->* (list -Char -Char) -Char B)]
+[char-ci>=? (->* (list -Char -Char) -Char B)]
+[char-ci>? (->* (list -Char -Char) -Char B)]
+[char-ci<? (->* (list -Char -Char) -Char B)]
+[string<=? (->* (list -String -String) -String B)]
+[string>=? (->* (list -String -String) -String B)]
 
-(define-syntax (define-initial-env stx)
-    (syntax-case stx ()
-      [(_ initial-env make-promise-ty language-ty qq-append-ty [id 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)])
-         #`(define-for-syntax initial-env
-             (make-env
-              [make-promise make-promise-ty]
-              [language language-ty]
-              [qq-append qq-append-ty]
-              [id ty] ...)))]))
+[string-ci<? (->* (list -String -String) -String B)]
+[string-ci>? (->* (list -String -String) -String B)]
+[string-ci=? (->* (list -String -String) -String B)]
+[string-ci<=? (->* (list -String -String) -String B)]
+[string-ci>=? (->* (list -String -String) -String B)]
 
-(define-for-syntax (one-of/c . args)
-  (apply Un (map -val args)))
+[string-upcase (-> -String -String)]
+[string-downcase (-> -String -String)]
+[string-titlecase (-> -String -String)]
+[string-foldcase (-> -String -String)]
 
+[string-normalize-nfd (-> -String -String)]
+[string-normalize-nfkd (-> -String -String)]
+[string-normalize-nfc (-> -String -String)]
+[string-normalize-nfkc (-> -String -String)]
 
-(define-initial-env initial-env
-  ;; make-promise
-  (-poly (a) (-> (-> a) (-Promise a)))
-  ;; language
-  Sym
-  ;; qq-append
-  (-poly (a b) 
-         (cl->*
-          (-> (-lst a) (-val '()) (-lst a))
-          (-> (-lst a) (-lst b) (-lst (*Un a b)))))
-  #|;; language
-     [(expand '(this-language))
-      Sym
-      string-constants/string-constant]
-     ;; make-promise      
-     [(cadr (syntax->list (expand '(delay 3))))
-      (-poly (a) (-> (-> a) (-Promise a)))
-      scheme/promise]
-     ;; qq-append     
-     [(cadr (syntax->list (expand '`(,@'() 1)))) 
-      (-poly (a b) 
-             (cl->*
-              (-> (-lst a) (-val '()) (-lst a))
-              (-> (-lst a) (-lst b) (-lst (*Un a b)))))]
-|#
-     
-     
-     
-     [raise (Univ . -> . (Un))]
-     
-     (car (make-Poly (list 'a 'b) (cl-> [((-pair (-v a) (-v b))) (-v a)]
-                                        [((make-Listof (-v a))) (-v a)])))
-     [first (make-Poly (list 'a 'b) (cl-> [((-pair (-v a) (-v b))) (-v a)]
-                                          [((make-Listof (-v a))) (-v a)]))]
-     [second (-poly (a b c)
-                    (cl->                
-                     [((-pair a (-pair b c))) b]
-                     [((-lst a)) a]))]
-     [third (-poly (a b c d)
-                   (cl->                
-                    [((-pair a (-pair b (-pair c d)))) c]
-                    [((-lst a)) a]))]
-     [fourth (-poly (a) ((-lst a) . -> .  a))]
-     [fifth (-poly (a) ((-lst a) . -> .  a))]
-     [sixth (-poly (a) ((-lst a) . -> .  a))]
-     [rest (-poly (a) ((-lst a) . -> .  (-lst a)))]
-     (cadr 
-      (-poly (a b c)
-             (cl->                
-              [((-pair a (-pair b c))) b]
-              [((-lst a)) a])))
-     (caddr (-poly (a) (-> (-lst a) a)))
-     (cadddr (-poly (a) (-> (-lst a) a)))
-     (cdr (make-Poly (list 'a 'b) (cl-> [((-pair (-v a) (-v b))) (-v b)]
-                                        [((make-Listof (-v a))) (make-Listof (-v a))])))
-     (cddr (make-Poly (list 'a) (-> (make-Listof (-v a)) (make-Listof (-v a)))))
-     (cdddr (make-Poly (list 'a) (-> (make-Listof (-v a)) (make-Listof (-v a)))))
-     (cons (-poly (a b) 
-                  (cl-> [(a (-lst a)) (-lst a)]
-                        [(a b) (-pair a b)])))
-     [*cons (-poly (a b) (cl-> 
-                               [(a b) (-pair a b)]
-                               [(a (-lst a)) (-lst a)]))]
-     [*list? (make-pred-ty (-lst Univ))]
-     
-     (null? (make-pred-ty (-val null)))
-     (eof-object? (make-pred-ty (-val eof)))
-     [null (-val null)]
-     (number? (make-pred-ty N))
-     [char? (make-pred-ty -Char)]
-     (integer? (make-pred-ty -Integer))
-     (boolean? (make-pred-ty B))
-     (add1 (cl->*
-            (-> -Integer -Integer)
-            (-> N N)))
-     (sub1 (cl->*
-            #;(-> -Integer -Integer)
-            (-> N N)))
-     (eq? (-> Univ Univ B))
-     (eqv? (-> Univ Univ B))
-     (equal? (-> Univ Univ B))
-     (even? (-> N B))
-     [assert (-poly (a) (-> (*Un a (-val #f)) a))]
-     [gensym (cl-> [(Sym) Sym]
-                   [() Sym])]
-     [string-append (->* null -String -String)]
-     [open-input-string (-> -String -Input-Port)]
-     [open-output-file 
-      (->key -Pathlike
-             #:mode (one-of/c 'binary 'text) #f
-             #:exists (one-of/c 'error 'append 'update 'can-update                                
-                                'replace 'truncate                                
-                                'must-truncate 'truncate/replace) 
-             #f
-             -Output-Port)]
-     [read (cl-> 
-            [(-Port) -Sexp]
-            [() -Sexp])]
-     [ormap (-polydots (a c b) (->... (list (->... (list a) (b b) c) (-lst a)) ((-lst b) b) c))]
-     [andmap (-polydots (a c b) (->... (list (->... (list a) (b b) c) (-lst a)) ((-lst b) b) c))]
-     [newline (cl-> [() -Void]
-                    [(-Port) -Void])]
-     [not (-> Univ B)]
-     [floor (-> N N)]
-     [box (-poly (a) (a . -> . (make-Box a)))]
-     [unbox (-poly (a) ((make-Box a) . -> . a))]
-     [set-box! (-poly (a) ((make-Box a) a . -> . -Void))]
-     [box? (make-pred-ty (make-Box Univ))]
-     [cons? (make-pred-ty (-pair Univ Univ))]
-     [pair? (make-pred-ty (-pair Univ Univ)) #;(-poly (a b) (make-pred-ty (-pair a b)))]
-     [empty? (make-pred-ty (-val null))]
-     [empty (-val null)]
-     [string? (make-pred-ty -String)]
-     [string (->* '() -Char -String)]
-     [symbol? (make-pred-ty Sym)]
-     [list? (make-pred-ty (-lst Univ))]
-     [list (-poly (a) (->* '() a (-lst a)))]
-     [procedure? (make-pred-ty (make-Function (list (make-top-arr))))]
-     [map (-polydots (c a b) ((list ((list a) (b b) . ->... . c) (-lst a))
-                              ((-lst b) b) . ->... .(-lst c)))]
-     [for-each (-polydots (c a b) ((list ((list a) (b b) . ->... . Univ) (-lst a))
-                                   ((-lst b) b) . ->... . -Void))]
-     [fold-left (-polydots (c a b) ((list ((list c a) (b b) . ->... . c) c (-lst a))
-                                    ((-lst b) b) . ->... . c))]
-     [fold-right (-polydots (c a b) ((list ((list c a) (b b) . ->... . c) c (-lst a))
-                                     ((-lst b) b) . ->... . c))]
-     [foldl
-      (-poly (a b c)
-             (cl-> [((a b . -> . b) b (make-Listof a)) b]
-                   [((a b c . -> . c) c (make-Listof a) (make-Listof b)) c]))]
-     [foldr  (-poly (a b c) ((a b . -> . b) b (-lst a) . -> . b))]
-     [filter (-poly (a b) (cl->*
-                           ((a . -> . B
-                               :
-                               (list (make-Latent-Restrict-Effect b))
-                               (list (make-Latent-Remove-Effect b)))
-                            (-lst a)
-                            . -> .
-                            (-lst b))
-                           ((a . -> . B) (-lst a) . -> . (-lst a))))]
-     [filter-map (-polydots (c a b)
-                            ((list
-                              ((list a) (b b) . ->... . (-opt c))
-                              (-lst a))
-                             ((-lst b) b) . ->... . (-lst c)))]
-     [take   (-poly (a) ((-lst a) -Integer . -> . (-lst a)))]
-     [drop   (-poly (a) ((-lst a) -Integer . -> . (-lst a)))]
-     [last   (-poly (a) ((-lst a) . -> . a))]
-     [add-between (-poly (a b) ((-lst a) b . -> . (-lst (Un a b))))]
-     [remove* (-poly (a b)
-                     (cl-> [((-lst a) (-lst a)) (-lst a)]
-                           [((-lst a) (-lst b) (a b . -> . B)) (-lst b)]))]
-          
-     (error 
-      (make-Function (list 
-                      (make-arr null (Un))
-                      (make-arr (list Sym -String) (Un) Univ)
-                      (make-arr (list -String) (Un) Univ)
-                      (make-arr (list Sym) (Un)))))
-     
-     
-     [namespace-variable-value 
-      (cl-> 
-       [(Sym) Univ]
-       [(Sym B -Namespace (-> Univ)) Univ])]
-     
-     (match:error (Univ . -> . (Un)))
-     (display 
-      (cl->
-       [(Univ) -Void]
-       [(Univ -Port) -Void]))
-     [void (->* '() Univ -Void)]
-     [void? (make-pred-ty -Void)]
-     [printf (->* (list -String) Univ -Void)]
-     [fprintf (->* (list -Output-Port -String) Univ -Void)]
-     [format (->* (list -String) Univ -String)]   
-     (fst (make-Poly (list 'a 'b) (-> (-pair (-v a) (-v b)) (-v a))))
-     (snd (make-Poly (list 'a 'b) (-> (-pair (-v a) (-v b)) (-v b))))
-     
-     (= (->* (list N N) N B))
-     (>= (->* (list N N) N B))
-     (< (->* (list N N) N B))
-     (<= (->* (list N N) N B))
-     [> (->* (list N) N B)]
-     (zero? (N . -> . B))
-     (* (cl->* (->* '() -Integer -Integer) (->* '() N N)))
-     (/ (cl->* (->* (list N) N N)))
-     (+ (cl->* (->* '() -Integer -Integer) (->* '() N N)))
-     (- (cl->* (->* (list -Integer) -Integer -Integer) (->* (list N) N N)))
-     (max (->* (list N) N N))
-     (min (->* (list N) N N))
-     [vector-ref 
-      (make-Poly (list 'a) ((make-Vector (-v a)) N . -> . (-v a)))]
-     [build-vector (-poly (a) (-Integer (-Integer . -> . a) . -> . (make-Vector a)))]
-     [build-list (-poly (a) (-Integer (-Integer . -> . a) . -> . (-lst a)))]
-     [reverse (make-Poly '(a) (-> (make-Listof (-v a)) (make-Listof (-v a))))]
-     [append (-poly (a) (->* (list) (-lst a) (-lst a)))]
-     [length (make-Poly '(a) (-> (make-Listof (-v a)) -Integer))]
-     [memq (make-Poly (list 'a) (-> (-v a) (make-Listof (-v a)) (-opt (make-Listof (-v a)))))]
-     [memv (make-Poly (list 'a) (-> (-v a) (make-Listof (-v a)) (-opt (make-Listof (-v a)))))]
-     [memf (-poly (a) ((a . -> . B) (-lst a) . -> . (-opt (-lst a))))]
-     [member 
-      (-poly (a) (a (-lst a) . -> . (-opt (-lst a))))]
-     [findf (-poly (a) ((a . -> . B) (-lst a) . -> . (-opt a)))]
-     
-     [string<? (->* (list -String -String) -String B)]
-     [string>? (->* (list -String -String) -String B)]
-     [string=? (->* (list -String -String) -String B)]
-     [char=? (->* (list -Char -Char) -Char B)]
-     [char<=? (->* (list -Char -Char) -Char B)]
-     [char>=? (->* (list -Char -Char) -Char B)]
-     [char<? (->* (list -Char -Char) -Char B)]
-     [char>? (->* (list -Char -Char) -Char B)]
-     [char-ci=? (->* (list -Char -Char) -Char B)]
-     [char-ci<=? (->* (list -Char -Char) -Char B)]
-     [char-ci>=? (->* (list -Char -Char) -Char B)]
-     [char-ci>? (->* (list -Char -Char) -Char B)]
-     [char-ci<? (->* (list -Char -Char) -Char B)]
-     [string<=? (->* (list -String -String) -String B)]
-     [string>=? (->* (list -String -String) -String B)]
-     
-     [string-ci<? (->* (list -String -String) -String B)]
-     [string-ci>? (->* (list -String -String) -String B)]
-     [string-ci=? (->* (list -String -String) -String B)]
-     [string-ci<=? (->* (list -String -String) -String B)]
-     [string-ci>=? (->* (list -String -String) -String B)]
-     
-     [string-upcase (-> -String -String)]
-     [string-downcase (-> -String -String)]
-     [string-titlecase (-> -String -String)]
-     [string-foldcase (-> -String -String)]
-     
-     [string-normalize-nfd (-> -String -String)]
-     [string-normalize-nfkd (-> -String -String)]
-     [string-normalize-nfc (-> -String -String)]
-     [string-normalize-nfkc (-> -String -String)]
-     
-     [string-ref (-> -String N -Char)]
-     [substring (cl->*
-                 (-> -String N -String)
-                 (-> -String N N -String))]
-     [string->path (-> -String -Path)]
-     [file-exists? (-> -Pathlike B)]
-     
-     [assq (-poly (a) (-> Univ (-lst (-pair Univ a)) a))]
-     
-     [build-path ((list -Pathlike*) -Pathlike* . ->* . -Path)]
-     [string->number (-> -String (-opt N))]
-     [with-input-from-file 
-         (-poly (a) 
-                (cl->
-                 [(-Pathlike  (-> a))  a]
-                 [(-Pathlike (-> a) Sym) a]))]
-     [with-output-to-file
-         (-poly (a) 
-                (cl->
-                 [(-Pathlike  (-> a))  a]
-                 [(-Pathlike (-> a) Sym) a]))]
-     
-     [random (cl->
-              [(-Integer) -Integer]
-              [() -Integer])]
-     
-     [assoc (-poly (a b) (a (-lst (-pair a b)) . -> . (-opt (-pair a b))))]
-     [assf  (-poly (a b)
+[string-ref (-> -String N -Char)]
+[substring (cl->*
+            (-> -String N -String)
+            (-> -String N N -String))]
+[string->path (-> -String -Path)]
+[file-exists? (-> -Pathlike B)]
+
+[assq (-poly (a) (-> Univ (-lst (-pair Univ a)) a))]
+
+[build-path ((list -Pathlike*) -Pathlike* . ->* . -Path)]
+[string->number (-> -String (-opt N))]
+[with-input-from-file 
+    (-poly (a) 
+           (cl->
+            [(-Pathlike  (-> a))  a]
+            [(-Pathlike (-> a) Sym) a]))]
+[with-output-to-file
+    (-poly (a) 
+           (cl->
+            [(-Pathlike  (-> a))  a]
+            [(-Pathlike (-> a) Sym) a]))]
+
+[random (cl->
+         [(-Integer) -Integer]
+         [() -Integer])]
+
+[assoc (-poly (a b) (a (-lst (-pair a b)) . -> . (-opt (-pair a b))))]
+[assf  (-poly (a b)
               ((a . -> . B) (-lst (-pair a b)) . -> . (-opt (-pair a b))))]
-     
-     [list-ref (-poly (a) ((-lst a) -Integer . -> . a))]
-     [positive? (-> N B)]
-     [negative? (-> N B)]
-     [odd? (-> N B)]
-     [even? (-> N B)]
-     
-     [apply (-poly (a b) (((list) a . ->* . b) (-lst a) . -> . b))]
-     
-     [call/cc (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (*Un a b)))]
-     [call/ec (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (*Un a b)))]
-     
-     [quotient (-Integer -Integer . -> . -Integer)]
-     [remainder (-Integer -Integer . -> . -Integer)]
-     [quotient/remainder (-Integer -Integer . -> . (-values (list -Integer -Integer)))]
-     
-     ;; parameter stuff
-     
-     [parameterization-key Sym]
-     [extend-parameterization (-poly (a b) (-> Univ (-Param a b) a Univ))]
-     [continuation-mark-set-first (-> (-opt -Cont-Mark-Set) Univ Univ)]
-     [make-parameter (-poly (a b) (cl-> [(a) (-Param a a)]
-                                        [(b (a . -> . b)) (-Param a b)]))]
-     [current-directory (-Param -Pathlike -Path)]
-     [current-namespace (-Param -Namespace -Namespace)]
-     [print-struct (-Param B B)]
-     [read-decimal-as-inexact (-Param B B)]
-     [current-command-line-arguments (-Param (make-Vector -String) (make-Vector -String))]
-     
-     ;; regexp stuff
-     [regexp-match 
-      (cl->
-       [((*Un -String -Regexp) -String) (-opt (-lst (-opt -String)))]
-       [(-Pattern -String) (-opt (-lst (-opt (*Un -Bytes -String))))]
-       [(-Pattern -String N) (-opt (-lst (-opt (*Un -Bytes -String))))]
-       [(-Pattern -String N (-opt N)) (-opt (-lst (-opt (*Un -Bytes -String))))]
-       [(-Pattern -String N (-opt N) (-opt -Output-Port)) (-lst (-opt (*Un -Bytes -String)))]
-       [(-Pattern -String (-opt N) (-opt -Output-Port)) (-lst (-opt (*Un -Bytes -String)))]
-       [(-Pattern -String (-opt -Output-Port)) (-lst (-opt (*Un -Bytes -String)))]
-       [(-Pattern (*Un -Input-Port -Bytes)) (-opt (-lst (-opt -Bytes)))]
-       [(-Pattern (*Un -Input-Port -Bytes) N) (-opt (-lst (-opt -Bytes)))]
-       [(-Pattern (*Un -Input-Port -Bytes) N (-opt N)) (-opt (-lst (-opt -Bytes)))]
-       [(-Pattern (*Un -Input-Port -Bytes) (-opt N)) (-opt (-lst (-opt -Bytes)))]
-       [(-Pattern (*Un -Input-Port -Bytes) N (-opt N) (-opt -Output-Port)) (-lst (-opt -Bytes))])]
-     
-     
-     [number->string (N . -> . -String)]
-     
-     [current-milliseconds (-> -Integer)]
-     [modulo (cl->* (-Integer -Integer . -> . -Integer))]
-     
-     ;; errors
-     
-     [raise-type-error
-      (cl->
-       [(Sym -String Univ) (Un)]
-       [(Sym -String N (-lst Univ)) (Un)])]
-     
-     ;; this is a hack
-     
-     [match:error ((list) Univ . ->* . (Un))]
-     
-     [vector-set! (-poly (a) (-> (make-Vector a) N a -Void))]
-     
-     [vector->list (-poly (a) (-> (make-Vector a) (-lst a)))]
-     [list->vector (-poly (a) (-> (-lst a) (make-Vector a)))]
-     [exact? (N . -> . B)]
-     [inexact? (N . -> . B)]
-     [expt (cl->* (-Integer -Integer . -> . -Integer) (N N . -> . N))]
-     [vector (-poly (a) (->* (list) a (make-Vector a)))]
-     [real? (Univ . -> . B)]
-     [real-part (N . -> . N)]
-     [imag-part (N . -> . N)]
-     [magnitude (N . -> . N)]
-     [angle (N . -> . N)]
-     [numerator (N . -> . -Integer)]
-     [denominator (N . -> . -Integer)]
-     [exact->inexact (N . -> . N)]
-     [inexact->exact (N . -> . N)]
-     [make-string
-      (cl->
-       [(N) -String]
-       [(N -Char) -String])]
-     [arithmetic-shift (-Integer -Integer . -> . -Integer)]
-     [abs (N . -> . N)]
-     [substring (cl-> [(-String N) -String]
-                      [(-String N N) -String])]
-     [string-length (-String . -> . N)]
-     [string-set! (-String N -Char . -> . -Void)]
-     [make-vector
-      (-poly (a)
-             (cl->
-              [(N) (make-Vector N)]
-              [(N a) (make-Vector a)]))]
-     
-     [file-exists? (-Pathlike . -> . B)]
-     [string->symbol (-String . -> . Sym)]
-     [symbol->string (Sym . -> . -String)]
-     [vector-length (-poly (a) ((make-Vector a) . -> . N))]
-     
-     [call-with-input-file (-poly (a) 
-                                  (cl->
-                                   [(-String (-Port . -> . a))  a]
-                                   [(-String (-Port . -> . a) Sym)  a]))]
-     
-     [call-with-output-file (-poly (a) 
-                                   (cl->
-                                    [(-String (-Port . -> . a))  a]
-                                    [(-String (-Port . -> . a) Sym)  a]))]
-     [current-output-port (-Param -Output-Port -Output-Port)]
-     [current-error-port (-Param -Output-Port -Output-Port)]
-     [current-input-port (-Param -Input-Port -Input-Port)]
-     [round (N . -> . N)]
-     [seconds->date (N . -> . (make-Name #'date))]
-     [current-seconds (-> N)]
-     [sqrt (-> N N)]
-     [path->string (-> -Path -String)]       
-     
-     [link-exists? (-> -Pathlike B)]
-     [directory-exists? (-> -Pathlike B)]
-     [file-exists? (-> -Pathlike B)]
-     [directory-list (cl-> [() (-lst -Path)]
-                           [(-Path) (-lst -Path)])]
-     
-     [make-hash (-poly (a b) (-> (-HT a b)))]
-     [make-hasheq (-poly (a b) (-> (-HT a b)))]
-     [make-weak-hash (-poly (a b) (-> (-HT a b)))]
-     [make-weak-hasheq (-poly (a b) (-> (-HT a b)))]
-     
-     [hash-set! (-poly (a b) ((-HT a b) a b . -> . -Void))]
-     [hash-map (-poly (a b c) ((-HT a b) (a b . -> . c) . -> . (-lst c)))]
-     [hash-ref (-poly (a b c)
-                      (cl->
-                       (((-HT a b) a) b)
-                       (((-HT a b) a (-> c)) (*Un b c))
-                       (((-HT a b) a c) (*Un b c))))]
-     #;[hash-table-index (-poly (a b) ((-HT a b) a b . -> . -Void))]
-     
-     [bytes (->* (list) N -Bytes)]
-     [bytes-ref (-> -Bytes N N)]
-     [bytes-append (->* (list -Bytes) -Bytes -Bytes)]
-     [subbytes (cl->
-                [(-Bytes N) -Bytes]
-                [(-Bytes N N) -Bytes])]
-     [bytes-length (-> -Bytes N)]
-     [open-input-file (->key -Pathlike #:mode (Un (-val 'binary) (-val 'text)) #f -Input-Port)]
-     [close-input-port (-> -Input-Port -Void)]
-     [close-output-port (-> -Output-Port -Void)]   
-     [read-line (cl->
-                 [() -String]
-                 [(-Input-Port) -String]
-                 [(-Input-Port Sym) -String])]
-     [copy-file (-> -Pathlike -Pathlike -Void)]  
-     [bytes->string/utf-8 (-> -Bytes -String)]
-     
-     [force (-poly (a) (-> (-Promise a) a))]
-     [bytes<? (->* (list -Bytes) -Bytes B)]
-     [regexp-replace* 
-      (cl->*
-       (-Pattern (*Un -Bytes -String) (*Un -Bytes -String) . -> . -Bytes)
-       (-Pattern -String -String . -> . -String))]
-     [peek-char
-      (cl->*
-       [-> -Char]
-       [-Input-Port . -> . -Char]
-       [-Input-Port N . -> . -Char]
-       [N . -> . -Char])]
-     [peek-byte
-      (cl->*
-       [-> -Byte]
-       [-Input-Port . -> . -Byte]
-       [-Input-Port N . -> . -Byte]
-       [N . -> . -Byte])]
-     [make-pipe
-      (cl->*
-       [-> (-values (list -Input-Port -Output-Port))]
-       [N . -> . (-values (list -Input-Port -Output-Port))])]
-     [open-output-bytes
-      (cl->*
-       [-> -Output-Port]
-       [Univ . -> . -Output-Port])]
-     [get-output-bytes
-      (cl->*
-       [-Output-Port . -> . -Bytes]
-       [-Output-Port Univ . -> . -Bytes]
-       [-Output-Port Univ N . -> . -Bytes]
-       [-Output-Port Univ N N . -> . -Bytes]
-       [-Output-Port N . -> . -Bytes]
-       [-Output-Port N N . -> . -Bytes])]
-     #;[exn:fail? (-> Univ B)]
-     #;[exn:fail:read? (-> Univ B)]
-     
-     [write (-> -Sexp -Void)]
-     [open-output-string (-> -Output-Port)]
-     ;; FIXME - wrong
-     [get-output-string (-> -Output-Port -String)]
-     
-     [make-directory (-> -Path -Void)]
-     
-     [hash-for-each (-poly (a b c)
-                           (-> (-HT a b) (-> a b c) -Void))]
-     
-     [delete-file (-> -Pathlike -Void)]
-     [make-namespace (cl->* (-> -Namespace)
-                            (-> (*Un (-val 'empty) (-val 'initial)) -Namespace))]
-     [make-base-namespace (-> -Namespace)]
-     [eval (-> -Sexp Univ)]
-     
-     [exit (-> (Un))]
-     
-     [module->namespace (-> -Sexp -Namespace)]
-     [current-namespace (-Param -Namespace -Namespace)]
-     
-     ;; syntax operations
-     
-     [expand (-> (-Syntax Univ) (-Syntax Univ))]
-     [expand-once (-> (-Syntax Univ) (-Syntax Univ))]
-     
-     [syntax-source (-poly (a) (-> (-Syntax a) Univ))]
-     [syntax-position (-poly (a) (-> (-Syntax a) (-opt N)))]
-     [datum->syntax (cl->* 
-                     (-> (-opt (-Syntax Univ)) Sym (-Syntax Sym))
-                     (-> (-opt (-Syntax Univ)) Univ (-Syntax Univ)))]
-     [syntax->datum (-poly (a) (-> (-Syntax a) Univ))]
-     [syntax-e (-poly (a) (-> (-Syntax a) a))]
-     [syntax-original? (-poly (a) (-> (-Syntax a) B))]
-     [identifier? (make-pred-ty (-Syntax Sym))]
-     [syntax? (make-pred-ty (-Syntax Univ))]
-     [syntax-property (-poly (a) (cl->* (-> (-Syntax a) Univ Univ (-Syntax a))
-                                        (-> (-Syntax Univ) Univ Univ)))]
-     
-     [values (-polydots (a) (null (a a) . ->... . (make-ValuesDots null a 'a)))]
-     [call-with-values (-polydots (b a) ((-> (make-ValuesDots null a 'a)) (null (a a) . ->... . b) . -> .  b))]
-  
-     [eof (-val eof)]
-     [read-accept-reader (-Param B B)]
-     )
 
-(begin-for-syntax 
-  #;(printf "running base-env~n")
-  (initialize-type-env initial-env)
-  (initialize-others))
+[list-ref (-poly (a) ((-lst a) -Integer . -> . a))]
+[positive? (-> N B)]
+[negative? (-> N B)]
+[odd? (-> N B)]
+[even? (-> N B)]
+
+[apply (-poly (a b) (((list) a . ->* . b) (-lst a) . -> . b))]
+
+[call/cc (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (*Un a b)))]
+[call/ec (-poly (a b) (((a . -> . (Un)) . -> . b) . -> . (*Un a b)))]
+
+[quotient (-Integer -Integer . -> . -Integer)]
+[remainder (-Integer -Integer . -> . -Integer)]
+[quotient/remainder (-Integer -Integer . -> . (-values (list -Integer -Integer)))]
+
+;; parameter stuff
+
+[parameterization-key Sym]
+[extend-parameterization (-poly (a b) (-> Univ (-Param a b) a Univ))]
+[continuation-mark-set-first (-> (-opt -Cont-Mark-Set) Univ Univ)]
+[make-parameter (-poly (a b) (cl-> [(a) (-Param a a)]
+                                   [(b (a . -> . b)) (-Param a b)]))]
+[current-directory (-Param -Pathlike -Path)]
+[current-namespace (-Param -Namespace -Namespace)]
+[print-struct (-Param B B)]
+[read-decimal-as-inexact (-Param B B)]
+[current-command-line-arguments (-Param (-vec -String) (-vec -String))]
+
+;; regexp stuff
+[regexp-match 
+ (cl->
+  [((*Un -String -Regexp) -String) (-opt (-lst (-opt -String)))]
+  [(-Pattern -String) (-opt (-lst (-opt (*Un -Bytes -String))))]
+  [(-Pattern -String N) (-opt (-lst (-opt (*Un -Bytes -String))))]
+  [(-Pattern -String N (-opt N)) (-opt (-lst (-opt (*Un -Bytes -String))))]
+  [(-Pattern -String N (-opt N) (-opt -Output-Port)) (-lst (-opt (*Un -Bytes -String)))]
+  [(-Pattern -String (-opt N) (-opt -Output-Port)) (-lst (-opt (*Un -Bytes -String)))]
+  [(-Pattern -String (-opt -Output-Port)) (-lst (-opt (*Un -Bytes -String)))]
+  [(-Pattern (*Un -Input-Port -Bytes)) (-opt (-lst (-opt -Bytes)))]
+  [(-Pattern (*Un -Input-Port -Bytes) N) (-opt (-lst (-opt -Bytes)))]
+  [(-Pattern (*Un -Input-Port -Bytes) N (-opt N)) (-opt (-lst (-opt -Bytes)))]
+  [(-Pattern (*Un -Input-Port -Bytes) (-opt N)) (-opt (-lst (-opt -Bytes)))]
+  [(-Pattern (*Un -Input-Port -Bytes) N (-opt N) (-opt -Output-Port)) (-lst (-opt -Bytes))])]
 
 
+[number->string (N . -> . -String)]
 
+[current-milliseconds (-> -Integer)]
+[modulo (cl->* (-Integer -Integer . -> . -Integer))]
+
+;; errors
+
+[raise-type-error
+ (cl->
+  [(Sym -String Univ) (Un)]
+  [(Sym -String N (-lst Univ)) (Un)])]
+
+;; this is a hack
+
+[match:error ((list) Univ . ->* . (Un))]
+
+[vector-set! (-poly (a) (-> (-vec a) N a -Void))]
+
+[vector->list (-poly (a) (-> (-vec a) (-lst a)))]
+[list->vector (-poly (a) (-> (-lst a) (-vec a)))]
+[exact? (N . -> . B)]
+[inexact? (N . -> . B)]
+[expt (cl->* (-Integer -Integer . -> . -Integer) (N N . -> . N))]
+[vector (-poly (a) (->* (list) a (-vec a)))]
+[real? (Univ . -> . B)]
+[real-part (N . -> . N)]
+[imag-part (N . -> . N)]
+[magnitude (N . -> . N)]
+[angle (N . -> . N)]
+[numerator (N . -> . -Integer)]
+[denominator (N . -> . -Integer)]
+[exact->inexact (N . -> . N)]
+[inexact->exact (N . -> . N)]
+[make-string
+ (cl->
+  [(N) -String]
+  [(N -Char) -String])]
+[arithmetic-shift (-Integer -Integer . -> . -Integer)]
+[abs (N . -> . N)]
+[substring (cl-> [(-String N) -String]
+                 [(-String N N) -String])]
+[string-length (-String . -> . N)]
+[string-set! (-String N -Char . -> . -Void)]
+[make-vector
+ (-poly (a)
+        (cl->
+         [(N) (-vec N)]
+         [(N a) (-vec a)]))]
+
+[file-exists? (-Pathlike . -> . B)]
+[string->symbol (-String . -> . Sym)]
+[symbol->string (Sym . -> . -String)]
+[vector-length (-poly (a) ((-vec a) . -> . N))]
+
+[call-with-input-file (-poly (a) 
+                             (cl->
+                              [(-String (-Port . -> . a))  a]
+                              [(-String (-Port . -> . a) Sym)  a]))]
+
+[call-with-output-file (-poly (a) 
+                              (cl->
+                               [(-String (-Port . -> . a))  a]
+                               [(-String (-Port . -> . a) Sym)  a]))]
+[current-output-port (-Param -Output-Port -Output-Port)]
+[current-error-port (-Param -Output-Port -Output-Port)]
+[current-input-port (-Param -Input-Port -Input-Port)]
+[round (N . -> . N)]
+[seconds->date (N . -> . (make-Name #'date))]
+[current-seconds (-> N)]
+[sqrt (-> N N)]
+[path->string (-> -Path -String)]       
+
+[link-exists? (-> -Pathlike B)]
+[directory-exists? (-> -Pathlike B)]
+[file-exists? (-> -Pathlike B)]
+[directory-list (cl-> [() (-lst -Path)]
+                      [(-Path) (-lst -Path)])]
+
+[make-hash (-poly (a b) (-> (-HT a b)))]
+[make-hasheq (-poly (a b) (-> (-HT a b)))]
+[make-weak-hash (-poly (a b) (-> (-HT a b)))]
+[make-weak-hasheq (-poly (a b) (-> (-HT a b)))]
+
+[hash-set! (-poly (a b) ((-HT a b) a b . -> . -Void))]
+[hash-map (-poly (a b c) ((-HT a b) (a b . -> . c) . -> . (-lst c)))]
+[hash-ref (-poly (a b c)
+                 (cl->
+                  (((-HT a b) a) b)
+                  (((-HT a b) a (-> c)) (*Un b c))
+                  (((-HT a b) a c) (*Un b c))))]
+#;[hash-table-index (-poly (a b) ((-HT a b) a b . -> . -Void))]
+
+[bytes (->* (list) N -Bytes)]
+[bytes-ref (-> -Bytes N N)]
+[bytes-append (->* (list -Bytes) -Bytes -Bytes)]
+[subbytes (cl->
+           [(-Bytes N) -Bytes]
+           [(-Bytes N N) -Bytes])]
+[bytes-length (-> -Bytes N)]
+[open-input-file (->key -Pathlike #:mode (Un (-val 'binary) (-val 'text)) #f -Input-Port)]
+[close-input-port (-> -Input-Port -Void)]
+[close-output-port (-> -Output-Port -Void)]   
+[read-line (cl->
+            [() -String]
+            [(-Input-Port) -String]
+            [(-Input-Port Sym) -String])]
+[copy-file (-> -Pathlike -Pathlike -Void)]  
+[bytes->string/utf-8 (-> -Bytes -String)]
+
+[force (-poly (a) (-> (-Promise a) a))]
+[bytes<? (->* (list -Bytes) -Bytes B)]
+[regexp-replace* 
+ (cl->*
+  (-Pattern (*Un -Bytes -String) (*Un -Bytes -String) . -> . -Bytes)
+  (-Pattern -String -String . -> . -String))]
+[peek-char
+ (cl->*
+  [-> -Char]
+  [-Input-Port . -> . -Char]
+  [-Input-Port N . -> . -Char]
+  [N . -> . -Char])]
+[peek-byte
+ (cl->*
+  [-> -Byte]
+  [-Input-Port . -> . -Byte]
+  [-Input-Port N . -> . -Byte]
+  [N . -> . -Byte])]
+[make-pipe
+ (cl->*
+  [-> (-values (list -Input-Port -Output-Port))]
+  [N . -> . (-values (list -Input-Port -Output-Port))])]
+[open-output-bytes
+ (cl->*
+  [-> -Output-Port]
+  [Univ . -> . -Output-Port])]
+[get-output-bytes
+ (cl->*
+  [-Output-Port . -> . -Bytes]
+  [-Output-Port Univ . -> . -Bytes]
+  [-Output-Port Univ N . -> . -Bytes]
+  [-Output-Port Univ N N . -> . -Bytes]
+  [-Output-Port N . -> . -Bytes]
+  [-Output-Port N N . -> . -Bytes])]
+#;[exn:fail? (-> Univ B)]
+#;[exn:fail:read? (-> Univ B)]
+
+[write (-> -Sexp -Void)]
+[open-output-string (-> -Output-Port)]
+;; FIXME - wrong
+[get-output-string (-> -Output-Port -String)]
+
+[make-directory (-> -Path -Void)]
+
+[hash-for-each (-poly (a b c)
+                      (-> (-HT a b) (-> a b c) -Void))]
+
+[delete-file (-> -Pathlike -Void)]
+[make-namespace (cl->* (-> -Namespace)
+                       (-> (*Un (-val 'empty) (-val 'initial)) -Namespace))]
+[make-base-namespace (-> -Namespace)]
+[eval (-> -Sexp Univ)]
+
+[exit (-> (Un))]
+
+[module->namespace (-> -Sexp -Namespace)]
+[current-namespace (-Param -Namespace -Namespace)]
+
+;; syntax operations
+
+[expand (-> (-Syntax Univ) (-Syntax Univ))]
+[expand-once (-> (-Syntax Univ) (-Syntax Univ))]
+
+[syntax-source (-poly (a) (-> (-Syntax a) Univ))]
+[syntax-position (-poly (a) (-> (-Syntax a) (-opt N)))]
+[datum->syntax (cl->* 
+                (-> (-opt (-Syntax Univ)) Sym (-Syntax Sym))
+                (-> (-opt (-Syntax Univ)) Univ (-Syntax Univ)))]
+[syntax->datum (-poly (a) (-> (-Syntax a) Univ))]
+[syntax-e (-poly (a) (-> (-Syntax a) a))]
+[syntax-original? (-poly (a) (-> (-Syntax a) B))]
+[identifier? (make-pred-ty (-Syntax Sym))]
+[syntax? (make-pred-ty (-Syntax Univ))]
+[syntax-property (-poly (a) (cl->* (-> (-Syntax a) Univ Univ (-Syntax a))
+                                   (-> (-Syntax Univ) Univ Univ)))]
+
+[values (-polydots (a) (null (a a) . ->... . (make-ValuesDots null a 'a)))]
+[call-with-values (-polydots (b a) ((-> (make-ValuesDots null a 'a)) (null (a a) . ->... . b) . -> .  b))]
+
+[eof (-val eof)]
+[read-accept-reader (-Param B B)]
diff --git a/collects/typed-scheme/private/base-special-env.ss b/collects/typed-scheme/private/base-special-env.ss
new file mode 100644
index 0000000000..321e04834e
--- /dev/null
+++ b/collects/typed-scheme/private/base-special-env.ss
@@ -0,0 +1,83 @@
+#lang scheme/base
+
+;; these are libraries providing functions we add types to that are not in scheme/base
+(require
+ "extra-procs.ss"
+ "../utils/utils.ss"
+ (only-in scheme/list cons? take drop add-between last filter-map)
+ (only-in rnrs/lists-6 fold-left)
+ '#%paramz
+ (only-in scheme/match/runtime match:error)
+ scheme/promise
+ string-constants/string-constant)
+
+
+
+;; these are all for constructing the types given to variables
+(require (for-syntax
+          scheme/base
+          (env init-envs)          
+          (except-in (rep effect-rep type-rep) make-arr)
+          "type-effect-convenience.ss"
+          (only-in "type-effect-convenience.ss" [make-arr* make-arr])
+          "union.ss"
+          (typecheck tc-structs)))
+
+(define-for-syntax (initialize-others) 
+  (d-s date 
+       ([second : N] [minute : N] [hour : N] [day : N] [month : N] 
+        [year : N] [weekday : N] [year-day : N] [dst? : B] [time-zone-offset : N])
+       ())
+  (d-s exn ([message : -String] [continuation-marks : Univ]) ())
+  (d-s (exn:fail exn) () (-String Univ))
+  (d-s (exn:fail:read exn:fail) ([srclocs : (-lst Univ)]) (-String Univ))
+  )
+
+(provide (for-syntax initial-env/special-case initialize-others initialize-type-env)
+         define-initial-env)
+
+(define-syntax (define-initial-env stx)
+    (syntax-case stx ()
+      [(_ initial-env make-promise-ty language-ty qq-append-ty [id 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)])
+         #`(define-for-syntax initial-env
+             (make-env
+              [make-promise make-promise-ty]
+              [language language-ty]
+              [qq-append qq-append-ty]
+              [id ty] ...)))]))
+
+
+
+
+(define-initial-env initial-env/special-case
+  ;; make-promise
+  (-poly (a) (-> (-> a) (-Promise a)))
+  ;; language
+  Sym
+  ;; qq-append
+  (-poly (a b) 
+         (cl->*
+          (-> (-lst a) (-val '()) (-lst a))
+          (-> (-lst a) (-lst b) (-lst (*Un a b))))))
+     
+     
+     
+
+(begin-for-syntax   
+  (initialize-type-env initial-env/special-case)
+  (initialize-others))
+
+
+
diff --git a/collects/typed-scheme/private/env-lang.ss b/collects/typed-scheme/private/env-lang.ss
new file mode 100644
index 0000000000..32ed0b229b
--- /dev/null
+++ b/collects/typed-scheme/private/env-lang.ss
@@ -0,0 +1,34 @@
+#lang scheme/base
+
+(require "../utils/utils.ss")
+
+(require (for-syntax (private type-effect-convenience)
+                     (env init-envs)
+                     scheme/base
+                     (except-in (rep effect-rep type-rep) make-arr)
+                     "type-effect-convenience.ss"
+                     (only-in "type-effect-convenience.ss" [make-arr* make-arr])
+                     "union.ss"))
+(define-syntax (#%module-begin stx)
+  (syntax-case stx (require)
+    [(mb (require . args) [id ty] ...)
+     (begin
+       (unless (andmap identifier? (syntax->list #'(id ...)))
+         (raise-syntax-error #f "not all ids"))
+       #'(#%plain-module-begin
+          (begin
+            (require . args)
+            (define-for-syntax e
+              (make-env [id ty] ...))
+            (begin-for-syntax
+              (initialize-type-env e)))))]
+    [(mb . rest)
+     #'(mb (require) . rest)]))
+
+(provide #%module-begin
+         require
+         (all-from-out scheme/base)
+         (for-syntax
+          (all-from-out scheme/base
+                        "type-effect-convenience.ss"
+                        "union.ss")))
\ No newline at end of file
diff --git a/collects/typed-scheme/private/type-effect-convenience.ss b/collects/typed-scheme/private/type-effect-convenience.ss
index e0af0bbacf..28db30a89a 100644
--- a/collects/typed-scheme/private/type-effect-convenience.ss
+++ b/collects/typed-scheme/private/type-effect-convenience.ss
@@ -13,7 +13,12 @@
          (for-syntax macro-debugger/stxclass/stxclass)
          (for-syntax scheme/base))
 
-(provide (all-defined-out))
+(provide (all-defined-out) 
+         ;; these should all eventually go away
+         make-Name make-ValuesDots make-Function make-top-arr make-Latent-Restrict-Effect make-Latent-Remove-Effect)
+
+(define (one-of/c . args)
+  (apply Un (map -val args)))
 
 (define (-vet id) (make-Var-True-Effect id))
 (define (-vef id) (make-Var-False-Effect id))
@@ -206,6 +211,8 @@
 
 (define (-Tuple l)
   (foldr -pair (-val '()) l))
+(define -box make-Box)
+(define -vec make-Vector)
 
 (define Any-Syntax 
   (-mu x
diff --git a/collects/typed-scheme/typed-scheme.ss b/collects/typed-scheme/typed-scheme.ss
index 0bcfc701b0..2fcddf542f 100644
--- a/collects/typed-scheme/typed-scheme.ss
+++ b/collects/typed-scheme/typed-scheme.ss
@@ -2,7 +2,7 @@
 
 (require (rename-in "utils/utils.ss" [infer r:infer]))
 
-(require (private base-env base-types)
+(require (private #;base-env base-types)
          (for-syntax 
           scheme/base
 	  (private type-utils type-contract type-effect-convenience)