From 450bafcde43da177eca72c8f53fc67d39ef282a8 Mon Sep 17 00:00:00 2001
From: Matthias Felleisen <matthias@racket-lang.org>
Date: Mon, 27 Apr 2009 19:09:37 +0000
Subject: [PATCH 01/11] improved error messge for register

svn: r14628
---
 collects/2htdp/private/syn-aux.ss | 8 ++++++--
 collects/2htdp/universe.ss        | 2 +-
 2 files changed, 7 insertions(+), 3 deletions(-)

diff --git a/collects/2htdp/private/syn-aux.ss b/collects/2htdp/private/syn-aux.ss
index 0c49229bec..4ec77bc47d 100644
--- a/collects/2htdp/private/syn-aux.ss
+++ b/collects/2htdp/private/syn-aux.ss
@@ -32,8 +32,12 @@
            extra
            [_ (err tag p)])))]))
 
-(define (err spec p)
-  (raise-syntax-error #f "illegal specification" #`(#,spec . #,p) p))
+(define (err spec p . extra-spec)
+  (raise-syntax-error (cadr spec)
+    (if (null? extra-spec)
+	"illegal specification"
+	(string-append "illegal specification: " (car extra-spec)))
+    #`(#,spec . #,p) p))
 
 ;; Symbol (Symbol X -> X) -> (X -> X)
 (define (check-flat-spec tag coerce>)
diff --git a/collects/2htdp/universe.ss b/collects/2htdp/universe.ss
index 4cbf53f8e8..de4f119734 100644
--- a/collects/2htdp/universe.ss
+++ b/collects/2htdp/universe.ss
@@ -117,7 +117,7 @@
               (lambda (p)
                 (syntax-case p ()
                   [(host) #`(ip> #,tag host)]
-                  [_ (err tag p)])))]
+                  [_ (err tag p "expected a host (ip address)")])))]
   [name (lambda (tag)
           (lambda (p)
             (syntax-case p ()

From 15701f0868b704c36ce83332efa7409848dc6cf3 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Tue, 28 Apr 2009 07:50:18 +0000
Subject: [PATCH 02/11] Welcome to a new PLT day.

svn: r14636
---
 collects/repos-time-stamp/stamp.ss | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/repos-time-stamp/stamp.ss b/collects/repos-time-stamp/stamp.ss
index c5fad359cb..2bf42a8e9d 100644
--- a/collects/repos-time-stamp/stamp.ss
+++ b/collects/repos-time-stamp/stamp.ss
@@ -1 +1 @@
-#lang scheme/base (provide stamp) (define stamp "27apr2009")
+#lang scheme/base (provide stamp) (define stamp "28apr2009")

From 39d405fe6e52329e802fb836324ac7b75e922de2 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 28 Apr 2009 13:13:22 +0000
Subject: [PATCH 03/11] zo-marshal supports module forms

svn: r14637
---
 collects/compiler/decompile.ss           |   5 +-
 collects/compiler/zo-marshal.ss          | 121 ++++++++++++++++++++---
 collects/compiler/zo-parse.ss            |  46 ++++++++-
 collects/scribblings/mzc/decompile.scrbl |   7 +-
 collects/scribblings/mzc/zo-parse.scrbl  |  94 +++++++++++++-----
 5 files changed, 226 insertions(+), 47 deletions(-)

diff --git a/collects/compiler/decompile.ss b/collects/compiler/decompile.ss
index 23a9b70652..819e86569b 100644
--- a/collects/compiler/decompile.ss
+++ b/collects/compiler/decompile.ss
@@ -90,7 +90,8 @@
 
 (define (decompile-module mod-form stack)
   (match mod-form
-    [(struct mod (name self-modidx prefix provides requires body syntax-body max-let-depth))
+    [(struct mod (name self-modidx prefix provides requires body syntax-body unexported 
+                       max-let-depth dummy lang-info internal-context))
      (let-values ([(globs defns) (decompile-prefix prefix)]
                   [(stack) (append '(#%modvars) stack)]
                   [(closed) (make-hasheq)])
@@ -135,6 +136,8 @@
      `(begin ,@(map (lambda (form)
                       (decompile-form form globs stack closed))
                     forms))]
+    [(struct req (reqs dummy))
+     `(#%require . (#%decode-syntax ,reqs))]
     [else
      (decompile-expr form globs stack closed)]))
 
diff --git a/collects/compiler/zo-marshal.ss b/collects/compiler/zo-marshal.ss
index 7a25602588..1bce9921d8 100644
--- a/collects/compiler/zo-marshal.ss
+++ b/collects/compiler/zo-marshal.ss
@@ -71,23 +71,26 @@
 (define (traverse-prefix a-prefix visit)
   (match a-prefix
     [(struct prefix (num-lifts toplevels stxs))
-     (for-each (lambda (stx) (traverse-toplevel stx visit)) stxs)
+     (for-each (lambda (stx) (traverse-toplevel stx visit)) toplevels)
      (for-each (lambda (stx) (traverse-stx stx visit)) stxs)]))
 
 (define (traverse-module mod-form visit)
   (match mod-form
-    [(struct mod (name self-modidx prefix provides requires body syntax-body max-let-depth))
-     (error "cannot handle modules, yet")
+    [(struct mod (name self-modidx prefix provides requires body syntax-body unexported 
+                       max-let-depth dummy lang-info internal-context))
      (traverse-data name visit)
      (traverse-data self-modidx visit)
      (traverse-prefix prefix visit)
+     (for-each (lambda (f) (map (lambda (v) (traverse-data v visit)) (cdr f))) requires)
      (for-each (lambda (f) (traverse-form f prefix)) body)
-     (for-each (lambda (f) (traverse-form f prefix)) syntax-body)]))
+     (for-each (lambda (f) (traverse-form f prefix)) syntax-body)
+     (traverse-data lang-info visit)
+     (traverse-data internal-context visit)]))
 
 (define (traverse-toplevel tl visit)
   (match tl
     [#f (void)]
-    [(? symbol?) (visit tl)]
+    [(? symbol?) (traverse-data tl visit)]
     [(struct global-bucket (name)) 
      (void)]
     [(struct module-variable (modidx sym pos phase))
@@ -180,9 +183,13 @@
         (keyword? expr)
         (string? expr)
         (bytes? expr)
-        (path? expr)
-        (module-path-index? expr))
+        (path? expr))
     (visit expr)]
+   [(module-path-index? expr)
+    (visit expr)
+    (let-values ([(name base) (module-path-index-split expr)])
+      (traverse-data name visit)
+      (traverse-data base visit))]
    [(pair? expr)
     (traverse-data (car expr) visit)
     (traverse-data (cdr expr) visit)]
@@ -213,6 +220,7 @@
 (define top-type-num 87)
 (define case-lambda-sequence-type-num 96)
 (define begin0-sequence-type-num 97)
+(define module-type-num 100)
 (define prefix-type-num 103)
 
 (define-syntax define-enum
@@ -363,10 +371,80 @@
                   (list->vector stxs)))
       out)]))
 
+(define-struct module-decl (content))
+
 (define (out-module mod-form out)
   (match mod-form
-    [(struct mod (name self-modidx prefix provides requires body syntax-body max-let-depth))
-     (error "cannot write modules, yet")]))
+    [(struct mod (name self-modidx prefix provides requires body syntax-body unexported 
+                       max-let-depth dummy lang-info internal-context))
+     (out-syntax MODULE_EXPD
+                 (let* ([lookup-req (lambda (phase)
+                                      (let ([a (assq phase requires)])
+                                        (if a
+                                            (cdr a)
+                                            null)))]
+                        [other-requires (filter (lambda (l)
+                                                  (not (memq (car l) '(#f -1 0 1))))
+                                                requires)]
+                        [extract-protects
+                         (lambda (phase)
+                           (let ([a (assq phase provides)])
+                             (and a
+                                  (let ([p (map provided-protected? (append (cadr a)
+                                                                            (caddr a)))])
+                                    (if (ormap values p)
+                                        (list->vector p)
+                                        #f)))))]
+                        [list->vector/#f (lambda (default l)
+                                           (if (andmap (lambda (x) (equal? x default)) l)
+                                               #f
+                                               (list->vector l)))]
+                        [l (map cdr other-requires)]
+                        [l (cons (length other-requires) l)]
+                        [l (cons (lookup-req #f) l)] ; dt-requires
+                        [l (cons (lookup-req -1) l)] ; tt-requires
+                        [l (cons (lookup-req 1) l)] ; et-requires
+                        [l (cons (lookup-req 0) l)] ; requires
+                        [l (cons (list->vector body) l)]
+                        [l (cons (list->vector syntax-body) l)]
+                        [l (append (apply
+                                    append
+                                    (map (lambda (l)
+                                           (let ([phase (car l)]
+                                                 [all (append (cadr l) (caddr l))])
+                                             (list phase
+                                                   (list->vector/#f #f (map provided-insp all))
+                                                   (list->vector/#f 0 (map (lambda (p) (= 1 (provided-src-phase p))) 
+                                                                           all))
+                                                   (list->vector/#f #f (map (lambda (p)
+                                                                              (if (eq? (provided-nom-src p)
+                                                                                       (provided-src p))
+                                                                                  #f ; #f means "same as src"
+                                                                                  (provided-nom-src p)))
+                                                                            all))
+                                                   (list->vector (map provided-src-name all))
+                                                   (list->vector (map provided-src all))
+                                                   (list->vector (map provided-name all))
+                                                   (length (cadr l))
+                                                   (length all))))
+                                         provides))
+                                   l)]
+                        [l (cons (length provides) l)] ; number of provide sets
+                        [l (cons (extract-protects 0) l)] ; protects
+                        [l (cons (extract-protects 1) l)] ; et protects
+                        [l (list* (list->vector (car unexported)) (length (car unexported)) l)] ; indirect-provides
+                        [l (list* (list->vector (cadr unexported)) (length (cadr unexported)) l)] ; indirect-syntax-provides
+                        [l (list* (list->vector (caddr unexported)) (length (caddr unexported)) l)] ; indirect-et-provides
+                        [l (cons prefix l)]
+                        [l (cons dummy l)]
+                        [l (cons max-let-depth l)]
+                        [l (cons internal-context l)] ; module->namespace syntax
+                        [l (list* #f #f l)] ; obsolete `functional?' info
+                        [l (cons lang-info l)] ; lang-info
+                        [l (cons self-modidx l)]
+                        [l (cons name l)])
+                   (make-module-decl l))
+                 out)]))
 
 (define (out-toplevel tl out)
   (match tl
@@ -422,6 +500,9 @@
      (out-marshaled sequence-type-num (map protect-quote forms) out)]
     [(struct splice (forms))
      (out-syntax SPLICE_EXPD (make-seq forms) out)]
+    [(struct req (reqs dummy))
+     (error "cannot handle top-level `require', yet")
+     (out-syntax REQUIRE_EXPD (cons dummy reqs) out)]
     [else
      (out-expr form out)]))
 
@@ -605,11 +686,12 @@
                        l)
                       out))]))
 
-(define (out-as-bytes expr ->bytes CPT out)
+(define (out-as-bytes expr ->bytes CPT len2 out)
   (out-shared expr out (lambda ()
                          (let ([s (->bytes expr)])
                            (out-byte CPT out)
                            (out-number (bytes-length s) out)
+                           (when len2 (out-number len2 out))
                            (out-bytes s out)))))
 
 (define (out-data expr out)
@@ -625,26 +707,31 @@
     (out-as-bytes expr 
                   (compose string->bytes/utf-8 symbol->string) 
                   CPT_SYMBOL
+                  #f
                   out)]
    [(keyword? expr)
     (out-as-bytes expr 
                   (compose string->bytes/utf-8 keyword->string) 
                   CPT_KEYWORD
+                  #f
                   out)]
    [(string? expr)
     (out-as-bytes expr 
                   string->bytes/utf-8
                   CPT_CHAR_STRING
+                  (string-length expr)
                   out)]
    [(bytes? expr)
     (out-as-bytes expr 
                   values
                   CPT_BYTE_STRING
+                  #f
                   out)]
    [(path? expr)
     (out-as-bytes expr 
                   path->bytes
                   CPT_PATH
+                  #f
                   out)]
    [(char? expr)
     (out-byte CPT_CHAR out)
@@ -690,10 +777,16 @@
       (for ([n (in-range (sub1 (vector-length vec)) -1 -1)])
         (out-number (vector-ref vec n) out)))]
    [(module-path-index? expr)
-    (out-byte CPT_MODULE_INDEX out)
-    (let-values ([(name base) (module-path-index-split expr)])
-      (out-data name out)
-      (out-data base out))]
+    (out-shared expr out 
+                (lambda ()
+                  (out-byte CPT_MODULE_INDEX out)
+                  (let-values ([(name base) (module-path-index-split expr)])
+                    (out-data name out)
+                    (out-data base out))))]
+   [(module-decl? expr)
+    (out-marshaled module-type-num
+                   (module-decl-content expr)
+                   out)]
    [else
     (out-byte CPT_QUOTE out)
     (let ([s (open-output-bytes)])
diff --git a/collects/compiler/zo-parse.ss b/collects/compiler/zo-parse.ss
index 6660c45300..1f04af58ec 100644
--- a/collects/compiler/zo-parse.ss
+++ b/collects/compiler/zo-parse.ss
@@ -34,7 +34,8 @@
 (define-form-struct form ())
 (define-form-struct (expr form) ())
 
-(define-form-struct (mod form) (name self-modidx prefix provides requires body syntax-body max-let-depth))
+(define-form-struct (mod form) (name self-modidx prefix provides requires body syntax-body unexported 
+                                     max-let-depth dummy lang-info internal-context))
 
 (define-form-struct (lam expr) (name flags num-params param-types rest? closure-map max-let-depth body)) ; `lambda'
 (define-form-struct (closure expr) (code gen-id)) ; a static closure (nothing to close over)
@@ -74,6 +75,9 @@
 (define-struct indirect ([v #:mutable]) #:prefab)
 (provide (struct-out indirect))
 
+;; A provided identifier
+(define-form-struct provided (name src src-name nom-src src-phase protected? insp))
+
 ;; ----------------------------------------
 ;; Bytecode unmarshalers for various forms
 
@@ -232,7 +236,37 @@
                          ,requires ,syntax-requires ,template-requires ,label-requires
                          ,more-requires-count . ,more-requires)
           (make-mod name self-modidx
-                    prefix phase-data
+                    prefix (let loop ([l phase-data])
+                             (if (null? l)
+                                 null
+                                 (let ([num-vars (list-ref l 7)]
+                                       [ps (for/list ([name (in-vector (list-ref l 6))]
+                                                      [src (in-vector (list-ref l 5))]
+                                                      [src-name (in-vector (list-ref l 4))]
+                                                      [nom-src (or (list-ref l 3)
+                                                                   (in-cycle (in-value #f)))]
+                                                      [src-phase (or (list-ref l 2)
+                                                                     (in-cycle (in-value #f)))]
+                                                      [protected? (or (case (car l)
+                                                                        [(0) protects]
+                                                                        [(1) et-protects]
+                                                                        [else #f])
+                                                                      (in-cycle (in-value #f)))]
+                                                      [insp (or (list-ref l 1)
+                                                                (in-cycle (in-value #f)))])
+                                             (make-provided name src src-name 
+                                                            (or nom-src src)
+                                                            (if src-phase 1 0)
+                                                            protected?
+                                                            insp))])
+                                   (if (null? ps)
+                                       (loop (list-tail l 9))
+                                       (cons
+                                        (list
+                                         (car l)
+                                         (take ps num-vars)
+                                         (drop ps num-vars))
+                                        (loop (list-tail l 9)))))))
                     (list*
                      (cons 0 requires)
                      (cons 1 syntax-requires)
@@ -248,7 +282,13 @@
                                    make-def-syntaxes)
                                ids expr prefix max-let-depth)]))
                          (vector->list syntax-body))
-                    max-let-depth)]))]))
+                    (list (vector->list indirect-provides)
+                          (vector->list indirect-syntax-provides)
+                          (vector->list indirect-et-provides))
+                    max-let-depth
+                    dummy
+                    lang-info
+                    rename)]))]))
 (define (read-module-wrap v)
   v)
 
diff --git a/collects/scribblings/mzc/decompile.scrbl b/collects/scribblings/mzc/decompile.scrbl
index a97c36e69d..787d5cf13e 100644
--- a/collects/scribblings/mzc/decompile.scrbl
+++ b/collects/scribblings/mzc/decompile.scrbl
@@ -3,7 +3,7 @@
           "common.ss"
           (for-label scheme/base
                      compiler/decompile
-                     (only-in compiler/zo-parse compilation-top?)
+                     (only-in compiler/zo-parse compilation-top? req)
                      compiler/zo-marshal))
 
 @title[#:tag "decompile"]{Decompiling Bytecode}
@@ -112,5 +112,6 @@ Consumes the result of parsing bytecode and returns an S-expression
 @defproc[(zo-marshal [top compilation-top?]) bytes?]{
 
 Consumes a representation of bytecode and generates a byte string for
-the marshaled bytecode. Currently, modules and quoted syntax objects
-with @scheme[top] are not supported.}
+the marshaled bytecode. Currently, syntax objects are not supported,
+including in @scheme[req] for a top-level @scheme[#%require].}
+
diff --git a/collects/scribblings/mzc/zo-parse.scrbl b/collects/scribblings/mzc/zo-parse.scrbl
index 60e53074a1..13f8e6f5bc 100644
--- a/collects/scribblings/mzc/zo-parse.scrbl
+++ b/collects/scribblings/mzc/zo-parse.scrbl
@@ -180,34 +180,13 @@ values. The @scheme[max-let-depth] field indicates the maximum size of
 the stack that will be created by @scheme[rhs] (not counting
 @scheme[prefix]).}
 
-@defstruct+[(req form) ([reqs (listof module-path?)]
+@defstruct+[(req form) ([reqs syntax?]
                         [dummy toplevel?])]{
 
-Represents a top-level @scheme[require] form (but not one in a
-@scheme[module] form). The @scheme[dummy] variable is used to access
-to the top-level namespace.}
-
-
-@defstruct+[(mod form) ([name symbol?]
-                        [self-modidx module-path-index?]
-                        [prefix prefix?]
-                        [provides (listof symbol?)]
-                        [requires (listof (cons/c (or/c exact-integer? #f) 
-                                                  (listof module-path-index?)))]
-                        [body (listof (or/c form? indirect? any/c))]
-                        [syntax-body (listof (or/c def-syntaxes? def-for-syntax?))]
-                        [max-let-depth exact-nonnegative-integer?])]{
-
-Represents a @scheme[module] declaration. The @scheme[body] forms use
-@scheme[prefix], rather than any prefix in place for the module
-declaration itself (and each @scheme[syntax-body] has its own
-prefix). The @scheme[body] field contains the module's run-time code,
-and @scheme[syntax-body] contains the module's compile-time code. The
-@scheme[max-let-depth] field indicates the maximum stack depth created
-by @scheme[body] forms (not counting the @scheme[prefix] array).
-
-After each form in @scheme[body] is evaluated, the stack is restored
-to its depth from before evaluating the form.}
+Represents a top-level @scheme[#%require] form (but not one in a
+@scheme[module] form) with a sequence of specifications
+@scheme[reqs]. The @scheme[dummy] variable is used to access to the
+top-level namespace.}
 
 
 @defstruct+[(seq form) ([forms (listof (or/c form? indirect? any/c))])]{
@@ -230,6 +209,69 @@ After each form in @scheme[forms] is evaluated, the stack is restored
 to its depth from before evaluating the form.}
 
 
+@defstruct+[(mod form) ([name symbol?]
+                        [self-modidx module-path-index?]
+                        [prefix prefix?]
+                        [provides (listof (list/c (or/c exact-integer? #f)
+                                                  (listof provided?)
+                                                  (listof provided?)))]
+                        [requires (listof (cons/c (or/c exact-integer? #f) 
+                                                  (listof module-path-index?)))]
+                        [body (listof (or/c form? indirect? any/c))]
+                        [syntax-body (listof (or/c def-syntaxes? def-for-syntax?))]
+                        [unexported (list/c (listof symbol?) (listof symbol?) 
+                                            (listof symbol?))]
+                        [max-let-depth exact-nonnegative-integer?]
+                        [dummy toplevel?]
+                        [lang-info (or/c #f (vector/c module-path? symbol? any/c))]
+                        [internal-context (or/c #f #t syntax?)])]{
+
+Represents a @scheme[module] declaration. The @scheme[body] forms use
+@scheme[prefix], rather than any prefix in place for the module
+declaration itself (and each @scheme[syntax-body] has its own
+prefix).
+
+The @scheme[provides] and @scheme[requires] lists are each an
+association list from phases to exports or imports. In the case of
+@scheme[provides], each phase maps to two lists: one for exported
+variables, and another for exported syntax. In the case of
+@scheme[requires], each phase maps to a list of imported module paths.
+
+The @scheme[body] field contains the module's run-time code, and
+@scheme[syntax-body] contains the module's compile-time code.  After
+each form in @scheme[body] or @scheme[syntax-body] is evaluated, the
+stack is restored to its depth from before evaluating the form.
+
+The @scheme[unexported] list contains lists of symbols for unexported
+definitions that can be accessed through macro expansion. The first
+list is phase-0 variables, the second is phase-0 syntax, and the last
+is phase-1 variables.
+
+The @scheme[max-let-depth] field indicates the maximum stack depth
+created by @scheme[body] forms (not counting the @scheme[prefix]
+array).  The @scheme[dummy] variable is used to access to the
+top-level namespace.
+
+The @scheme[lang-info] value specifies an optional module path that
+provides information about the module's implementation language.
+
+The @scheme[internal-module-context] value describes the lexical
+context of the body of the module. This value is used by
+@scheme[module->namespace]. A @scheme[#f] value means that the context
+is unavailable or empty. A @scheme[#t] value means that the context is
+computed by re-importing all required modules. A syntax-object value
+embeds an arbitrary lexical context.}
+
+@defstruct+[provided ([name symbol?]
+                      [src (or/c module-path-index? #f)]
+                      [src-name symbol?]
+                      [nom-mod (or/c module-path-index? #f)]
+                      [src-phase (or/c 0 1)]
+                      [protected? boolean?]
+                      [insp (or #t #f (void))])]{
+
+Describes an individual provided identifier within a @scheme[mod] instance.}
+
 @; --------------------------------------------------
 @section{Expressions}
 

From a42ba6075b7bb60c15f1ca401cc0efc57143e771 Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Tue, 28 Apr 2009 15:22:32 +0000
Subject: [PATCH 04/11] added better linking for the 'lw' struct

svn: r14641
---
 collects/redex/redex.scrbl | 39 +++++++++++++++++++-------------------
 1 file changed, 19 insertions(+), 20 deletions(-)

diff --git a/collects/redex/redex.scrbl b/collects/redex/redex.scrbl
index 122d6f7e88..91fd81ad86 100644
--- a/collects/redex/redex.scrbl
+++ b/collects/redex/redex.scrbl
@@ -1843,8 +1843,8 @@ evaluates expression. If that expression computes any picts,
 the unquote rewriter specified is used to remap them.
 
 The @scheme[proc] should be a function of one argument. It receives
-a lw struct as an argument and should return
-another lw that contains a rewritten version of the
+a @scheme[lw] struct as an argument and should return
+another @scheme[lw] that contains a rewritten version of the
 code.
 }
 
@@ -1867,41 +1867,40 @@ new one that rewrites the value of name-symbol via proc,
 during the evaluation of expression.
 
 @scheme[name-symbol] is expected to evaluate to a symbol. The value
-of proc is called with a (listof lw) -- see below
-for details on the shape of lw, and is expected to
-return a new (listof (union lw string pict)),
+of proc is called with a @scheme[(listof lw)], and is expected to
+return a new @scheme[(listof (or/c lw? string? pict?))],
 rewritten appropriately. 
 
 The list passed to the rewriter corresponds to the
-lw for the sequence that has name-symbol's value at
+@scheme[lw] for the sequence that has name-symbol's value at
 its head.
 
 The result list is constrained to have at most 2 adjacent
-non-lws. That list is then transformed by adding
-lw structs for each of the non-lws in the
-list (see the description of lw below for an
+non-@scheme[lw]s. That list is then transformed by adding
+@scheme[lw] structs for each of the non-@scheme[lw]s in the
+list (see the description of @scheme[lw] below for an
 explanation of logical-space):
 
 @itemize[
 @item{
-    If there are two adjacent lws, then the logical
+    If there are two adjacent @scheme[lw]s, then the logical
     space between them is filled with whitespace.}
 
 @item{
-    If there is a pair of lws with just a single
-    non-lw between them, a lw will be
-    created (containing the non-lw) that uses all
-    of the available logical space between the lws.
+    If there is a pair of @scheme[lw]s with just a single
+    non-@scheme[lw] between them, a @scheme[lw] will be
+    created (containing the non-@scheme[lw]) that uses all
+    of the available logical space between the @scheme[lw]s.
 }
 
 @item{
-    If there are two adjacent non-lws between two
-    lws, the first non-lw is rendered
-    right after the first lw with a logical space
+    If there are two adjacent non-@scheme[lw]s between two
+    @scheme[lw]s, the first non-@scheme[lw] is rendered
+    right after the first @scheme[lw] with a logical space
     of zero, and the second is rendered right before the
-    last lw also with a logical space of zero, and
-    the logical space between the two lws is
-    absorbed by a new lw that renders using no
+    last @scheme[lw] also with a logical space of zero, and
+    the logical space between the two @scheme[lw]s is
+    absorbed by a new @scheme[lw] that renders using no
     actual space in the typeset version.
 }]
 }

From b42f1b5d8bd8b7d9a15f7a0db6a5dcf73f4caac9 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Tue, 28 Apr 2009 16:37:16 +0000
Subject: [PATCH 05/11] zo-marshal patch from Jay

svn: r14642
---
 collects/compiler/zo-marshal.ss | 6 +++---
 1 file changed, 3 insertions(+), 3 deletions(-)

diff --git a/collects/compiler/zo-marshal.ss b/collects/compiler/zo-marshal.ss
index 1bce9921d8..5c0a17db8e 100644
--- a/collects/compiler/zo-marshal.ss
+++ b/collects/compiler/zo-marshal.ss
@@ -5,7 +5,7 @@
 (provide zo-marshal)
 
 ;; Doesn't write as compactly as MzScheme, since list and pair sequences
-;; are not compated, and symbols are not written in short form
+;; are not compacted, and symbols are not written in short form
 
 (define (zo-marshal top)
   (match top
@@ -82,8 +82,8 @@
      (traverse-data self-modidx visit)
      (traverse-prefix prefix visit)
      (for-each (lambda (f) (map (lambda (v) (traverse-data v visit)) (cdr f))) requires)
-     (for-each (lambda (f) (traverse-form f prefix)) body)
-     (for-each (lambda (f) (traverse-form f prefix)) syntax-body)
+     (for-each (lambda (f) (traverse-form f visit)) body)
+     (for-each (lambda (f) (traverse-form f visit)) syntax-body)
      (traverse-data lang-info visit)
      (traverse-data internal-context visit)]))
 

From 10e0e08143570091f270fad7e14f2836ec824a8e Mon Sep 17 00:00:00 2001
From: Matthias Felleisen <matthias@racket-lang.org>
Date: Wed, 29 Apr 2009 03:08:40 +0000
Subject: [PATCH 06/11] strings for Universe callbacks

svn: r14644
---
 collects/2htdp/private/check-aux.ss | 31 ++++++++++++++++++-----------
 collects/2htdp/private/world.ss     |  2 +-
 collects/2htdp/universe.ss          | 16 +++++++--------
 3 files changed, 28 insertions(+), 21 deletions(-)

diff --git a/collects/2htdp/private/check-aux.ss b/collects/2htdp/private/check-aux.ss
index 094849c8e2..0ff3e302f8 100644
--- a/collects/2htdp/private/check-aux.ss
+++ b/collects/2htdp/private/check-aux.ss
@@ -54,22 +54,29 @@
 
 ;; -----------------------------------------------------------------------------
 
-;; MouseEvent -> [List Nat Nat MouseEventType]
+;; MouseEvent% -> [List Nat Nat MouseEventType]
 ;; turn a mouse event into its pieces 
 (define (mouse-event->parts e)
   (define x (- (send e get-x) INSET))
   (define y (- (send e get-y) INSET))
-  (values x y (cond [(send e button-down?) 'button-down]
-                  [(send e button-up?)   'button-up]
-                  [(send e dragging?)    'drag]
-                  [(send e moving?)      'move]
-                  [(send e entering?)    'enter]
-                  [(send e leaving?)     'leave]
-                  [else ; (send e get-event-type)
-                   (error 'on-mouse-event
-                          (format 
-                           "Unknown event type: ~a"
-                           (send e get-event-type)))])))
+  (values x y 
+          (cond [(send e button-down?) "button-down"]
+                [(send e button-up?)   "button-up"]
+                [(send e dragging?)    "drag"]
+                [(send e moving?)      "move"]
+                [(send e entering?)    "enter"]
+                [(send e leaving?)     "leave"]
+                [else ; (send e get-event-type)
+                 (let ([m (send e get-event-type)])
+                   (error 'on-mouse (format "Unknown event: ~a" m)))])))
+
+;; KeyEvent% -> String
+(define (key-event->parts e)
+  (define x (send e get-key-code))
+  (cond
+    [(char? x) (string x)]
+    [(symbol? x) (symbol->string x)]
+    [else (error 'on-key (format "Unknown event: ~a" x))]))
 
 ;; -----------------------------------------------------------------------------
 ;; Any -> Symbol 
diff --git a/collects/2htdp/private/world.ss b/collects/2htdp/private/world.ss
index 94ceb20d58..15aae304fe 100644
--- a/collects/2htdp/private/world.ss
+++ b/collects/2htdp/private/world.ss
@@ -170,7 +170,7 @@
                  (super-new)
                  ;; deal with keyboard events 
                  (define/override (on-char e) 
-                   (when live (pkey (send e get-key-code))))
+                   (when live (pkey (key-event->parts e))))
                  ;; deal with mouse events if live and within range 
                  (define/override (on-event e)
                    (define-values (x y me) (mouse-event->parts e))
diff --git a/collects/2htdp/universe.ss b/collects/2htdp/universe.ss
index de4f119734..df548d3f93 100644
--- a/collects/2htdp/universe.ss
+++ b/collects/2htdp/universe.ss
@@ -122,12 +122,12 @@
           (lambda (p)
             (syntax-case p ()
               [(n) #`(symbol> #,tag n)]
-              [_ (err tag p)])))]
+              [_ (err tag p "expected a string for the current world")])))]
   [record? (lambda (tag)
              (lambda (p)
                (syntax-case p ()
                  [(b) #`(bool> #,tag b)]
-                 [_ (err tag p)])))])
+                 [_ (err tag p "expected a boolean (to record or not to record?")])))])
 
 (define-syntax (big-bang stx)
   (syntax-case stx ()
@@ -195,21 +195,21 @@
      (on-draw (lambda (m) (if (empty? m) (text "The End" 22 'red) (first m))))
      (stop-when empty?))))
 
-(define (mouse-event? a)
-  (pair? (member a '(button-down button-up drag move enter leave))))
+(define ME (map symbol->string '(button-down button-up drag move enter leave)))
+
+(define (mouse-event? a) (and (string? a) (pair? (member a ME))))
 
 (define (mouse=? k m)
   (check-arg 'mouse=? (mouse-event? k) 'MouseEvent "first" k)
   (check-arg 'mouse=? (mouse-event? m) 'MouseEvent "second" m)
-  (eq? k m))
+  (string=? k m))
 
-(define (key-event? k)
-  (or (char? k) (symbol? k)))
+(define (key-event? k) (string? k))
 
 (define (key=? k m)
   (check-arg 'key=? (key-event? k) 'KeyEvent "first" k)
   (check-arg 'key=? (key-event? m) 'KeyEvent "second" m)
-  (eqv? k m))
+  (string=? k m))
 
 (define LOCALHOST "127.0.0.1")
 

From 6cdf2ed97681199fafacb015d33a705fcf23758e Mon Sep 17 00:00:00 2001
From: Matthias Felleisen <matthias@racket-lang.org>
Date: Wed, 29 Apr 2009 03:09:06 +0000
Subject: [PATCH 07/11] strings for Universe callbacks

svn: r14645
---
 .../2htdp/scribblings/universe.scrbl          | 93 ++++++++++++++++---
 1 file changed, 81 insertions(+), 12 deletions(-)

diff --git a/collects/teachpack/2htdp/scribblings/universe.scrbl b/collects/teachpack/2htdp/scribblings/universe.scrbl
index 4a773a49ad..6da1ad7bbb 100644
--- a/collects/teachpack/2htdp/scribblings/universe.scrbl
+++ b/collects/teachpack/2htdp/scribblings/universe.scrbl
@@ -217,20 +217,89 @@ current world. The clock ticks at the rate of @scheme[rate-expr].}}
 
 @deftech{KeyEvent} : @scheme[(or/c char? symbol?)]
 
-A character is used to signal that the user has hit an alphanumeric
- key. A symbol denotes arrow keys or special events:
-
+A single-character string is used to signal that the user has hit an alphanumeric
+ key. Some of these one-character strings may look unusual: 
 @itemize[
+@item{@scheme[" "] stands for the space bar (@scheme[#\space]);}
+@item{@scheme["\r"] stands for the return key (@scheme[#\return]);}
+@item{@scheme["\t"] stands for the tab key (@scheme[#\tab]); and}
+@item{@scheme["\b"] stands for the backspace key (@scheme[#\backspace]).}
+]
+On rare occasions you may also encounter @scheme["\u007F"], which is the
+ string representing the delete key (aka rubout). 
 
-@item{@scheme['left] is the left arrow,}
-
-@item{@scheme['right] is the right arrow,}
-
-@item{@scheme['up] is the up arrow,}
-
-@item{@scheme['down] is the down arrow, and}
-
-@item{@scheme['release] is the event of releasing a key.}
+A string with more than one character denotes arrow keys or other special events,
+ starting with the most important: 
+@itemize[
+@item{@scheme["left"] is the left arrow;}
+@item{@scheme["right"] is the right arrow;}
+@item{@scheme["up"] is the up arrow;}
+@item{@scheme["down"] is the down arrow;}
+@item{@scheme["release"] is the event of releasing a key;}
+@item{@scheme["start"]}
+@item{@scheme["cancel"]}
+@item{@scheme["clear"]}
+@item{@scheme["shift"]}
+@item{@scheme["control"]}
+@item{@scheme["menu"]}
+@item{@scheme["pause"]}
+@item{@scheme["capital"]}
+@item{@scheme["prior"]}
+@item{@scheme["next"]}
+@item{@scheme["end"]}
+@item{@scheme["home"]}
+@item{@scheme["escape"]}
+@item{@scheme["select"]}
+@item{@scheme["print"]}
+@item{@scheme["execute"]}
+@item{@scheme["snapshot"]}
+@item{@scheme["insert"]}
+@item{@scheme["help"]}
+@item{@scheme["numpad0"], 
+ @scheme["numpad1"], 
+ @scheme["numpad2"], 
+ @scheme["numpad3"],
+ @scheme["numpad4"],
+ @scheme["numpad5"],
+ @scheme["numpad6"],
+ @scheme["numpad7"],
+ @scheme["numpad8"],
+ @scheme["numpad9"],
+ @scheme["numpad-enter"],
+ @scheme["multiply"],
+ @scheme["add"],
+ @scheme["separator"],
+ @scheme["subtract"],
+ @scheme["decimal"],
+ @scheme["divide"]}
+@item{@scheme["'f1"],
+ @scheme["f2"],
+ @scheme["f3"],
+ @scheme["f4"],
+ @scheme["f5"],
+ @scheme["f6"],
+ @scheme["f7"],
+ @scheme["f8"],
+ @scheme["f9"],
+ @scheme["f10"],
+ @scheme["f11"],
+ @scheme["f12"],
+ @scheme["f13"],
+ @scheme["f14"],
+ @scheme["f15"],
+ @scheme["f16"],
+ @scheme["f17"],
+ @scheme["f18"],
+ @scheme["f19"],
+ @scheme["f20"],
+ @scheme["f21"],
+ @scheme["f22"],
+ @scheme["f23"],
+ @scheme["f24"]}
+@item{@scheme["numlock"]}
+@item{@scheme["scroll"]}
+@item{@scheme["wheel-up"]}
+@item{@scheme["wheel-down"]}
 ]
 
 @defproc[(key-event? [x any]) boolean?]{

From 87c9aba9e011d07fe4ebba214790c2e235a7a38d Mon Sep 17 00:00:00 2001
From: Robby Findler <robby@racket-lang.org>
Date: Wed, 29 Apr 2009 03:48:45 +0000
Subject: [PATCH 08/11] added a little optimization to provide/contract

svn: r14646
---
 collects/scheme/private/contract.ss      | 11 +++++++++--
 collects/tests/mzscheme/contract-test.ss | 12 ++++++++++++
 2 files changed, 21 insertions(+), 2 deletions(-)

diff --git a/collects/scheme/private/contract.ss b/collects/scheme/private/contract.ss
index 5920e8a6e0..a9ea375649 100644
--- a/collects/scheme/private/contract.ss
+++ b/collects/scheme/private/contract.ss
@@ -1217,6 +1217,12 @@ improve method arity mismatch contract violation error messages?
                             [ctrct (syntax-property ctrct 'inferred-name id)]
                             [external-name (or user-rename-id id)]
                             [where-stx stx])
+                (with-syntax ([extra-test 
+                               (syntax-case #'ctrct (->)
+                                 [(-> dom ... arg)
+                                  #`(and (procedure? id)
+                                         (procedure-arity-includes? id #,(length (syntax->list #'(dom ...)))))]
+                                 [_ #f])])
                 (with-syntax ([code
                                (quasisyntax/loc stx
                                  (begin
@@ -1234,10 +1240,11 @@ improve method arity mismatch contract violation error messages?
                   
                   (syntax-local-lift-module-end-declaration
                    #`(begin 
-                       (-contract contract-id id pos-module-source 'ignored #,(id->contract-src-info #'id))
+                       (unless extra-test
+                         (-contract contract-id id pos-module-source 'ignored #,(id->contract-src-info #'id)))
                        (void)))
                   
-                  (syntax (code id-rename)))))]))
+                  (syntax (code id-rename))))))]))
        
        (with-syntax ([(bodies ...) (code-for-each-clause (syntax->list (syntax (p/c-ele ...))))])
          (signal-dup-syntax-error)
diff --git a/collects/tests/mzscheme/contract-test.ss b/collects/tests/mzscheme/contract-test.ss
index 917e07c2ae..3b299b5f8d 100644
--- a/collects/tests/mzscheme/contract-test.ss
+++ b/collects/tests/mzscheme/contract-test.ss
@@ -6560,6 +6560,18 @@ so that propagation occurs.
      (and (exn? x)
           (regexp-match #rx"cannot set!" (exn-message x)))))
   
+  (contract-error-test
+   #'(begin
+       (eval '(module pce8-bug1 scheme/base
+                (require scheme/contract)
+                (define (f x) x)
+                (provide/contract [f (-> integer? integer? integer?)])))
+       (eval '(require 'pce8-bug1)))
+   (λ (x)
+     (printf ">> ~s\n" (exn-message x))
+     (and (exn? x)
+          (regexp-match #rx"pce8-bug" (exn-message x)))))
+  
   (contract-eval `(,test 'pos guilty-party (with-handlers ((void values)) (contract not #t 'pos 'neg))))
   
   (report-errs)

From 8785850a3cba0616d7f26e003ca8497eca3d57a5 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Wed, 29 Apr 2009 07:13:55 +0000
Subject: [PATCH 09/11] svn: r14647

---
 collects/profile/render-text.ss | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/collects/profile/render-text.ss b/collects/profile/render-text.ss
index 010f731367..99dd3d4e45 100644
--- a/collects/profile/render-text.ss
+++ b/collects/profile/render-text.ss
@@ -49,8 +49,8 @@
             [(pair? x) (loop (car x)) (loop (cdr x))]
             [else (display x)]))
     (newline))
-  (define total-time    (profile-total-time    profile))
-  (define cpu-time      (profile-cpu-time      profile))
+  (define total-time    (profile-total-time    profile)) ;!! are these two
+  (define cpu-time      (profile-cpu-time      profile)) ;!! swapped?
   (define sample-number (profile-sample-number profile))
   (define granularity   (if (zero? sample-number) 0
                             (/ total-time sample-number)))

From fc7283c5a7ab5195eb0666fe21dd67f76ea03079 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Wed, 29 Apr 2009 07:14:39 +0000
Subject: [PATCH 10/11] svn: r14648

---
 collects/profile/render-text.ss | 4 ++--
 1 file changed, 2 insertions(+), 2 deletions(-)

diff --git a/collects/profile/render-text.ss b/collects/profile/render-text.ss
index 99dd3d4e45..60dcec01d7 100644
--- a/collects/profile/render-text.ss
+++ b/collects/profile/render-text.ss
@@ -52,8 +52,8 @@
   (define total-time    (profile-total-time    profile)) ;!! are these two
   (define cpu-time      (profile-cpu-time      profile)) ;!! swapped?
   (define sample-number (profile-sample-number profile))
-  (define granularity   (if (zero? sample-number) 0
-                            (/ total-time sample-number)))
+  (define granularity   (if (zero? sample-number) 0        ;!! this might
+                            (/ total-time sample-number))) ;!! be wrong
   (define threads+times (profile-thread-times  profile))
   (define *-node        (profile-*-node profile))
   (define hidden        (get-hidden profile hide-self% hide-subs%))

From 1157488b626b3f3e7db6b7a693b1a906d37e571f Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Wed, 29 Apr 2009 07:50:21 +0000
Subject: [PATCH 11/11] Welcome to a new PLT day.

svn: r14649
---
 collects/repos-time-stamp/stamp.ss | 2 +-
 1 file changed, 1 insertion(+), 1 deletion(-)

diff --git a/collects/repos-time-stamp/stamp.ss b/collects/repos-time-stamp/stamp.ss
index 2bf42a8e9d..fbde4bf6e1 100644
--- a/collects/repos-time-stamp/stamp.ss
+++ b/collects/repos-time-stamp/stamp.ss
@@ -1 +1 @@
-#lang scheme/base (provide stamp) (define stamp "28apr2009")
+#lang scheme/base (provide stamp) (define stamp "29apr2009")