diff --git a/collects/2htdp/tests/test-image.ss b/collects/2htdp/tests/test-image.ss
index 0c645617c7..2372d1a0ec 100644
--- a/collects/2htdp/tests/test-image.ss
+++ b/collects/2htdp/tests/test-image.ss
@@ -1498,34 +1498,36 @@
 ;;    and that normalization doesn't introduce new structs
 ;;
 
-(define (random-image size)
-  (let loop ([size size])
-    (let ([val (random (if (zero? size) 4 8))])
-      (case val
-        [(0) (rectangle (random-size) (random-size) (random-mode) (random-color))]
-        [(1) (circle (random-size) (random-mode) (random-color))]
-        [(2) (line (random-coord) (random-coord) (random-color))]
-        [(3) (add-curve
-              (rectangle (random-size) (random-size) (random-mode) (random-color))
-              (random-coord) (random-coord) (random-pull) (random-angle)
-              (random-coord) (random-coord) (random-pull) (random-angle)
-              (random-color))]
-        [(4) (overlay (loop (floor (/ size 2)))
-                      (loop (ceiling (/ size 2))))]
-        [(5) (crop (random-coord) (random-coord) (random-size) (random-size)
-                   (loop (- size 1)))]
-        [(6) (scale/xy (random-size)
-                       (random-size)
-                       (loop (- size 1)))]
-        [(7) (rotate (random-angle) (loop (- size 1)))]))))
+(require redex/reduction-semantics)
 
-(define (random-pull) (/ (random 20) (+ 1 (random 10))))
-(define (random-angle) (random 360))
-(define (random-coord) (- (random 200) 100))
-(define (random-size) (random 100))
-(define (random-mode) (if (zero? (random 2)) 'outline 'solid))
-(define (random-color) (pick-from-list '("red" red "blue" "orange" "green" "black")))
-(define (pick-from-list l) (list-ref l (random (length l))))
+(define-language 2htdp/image
+  (image (rectangle size size mode color)
+         (line coord coord color)
+         (add-curve (rectangle size size mode color)
+                    coord coord pull angle
+                    coord coord pull angle
+                    color)
+         (overlay image image)
+         (overlay/xy image coord coord image)
+         (underlay image image)
+         (underlay/xy image coord coord image)
+         (crop coord coord size size image)
+         (scale/xy size size image)
+         (scale size image)
+         (rotate angle image))
+  
+  (size big-nat)
+  (mode 'outline 'solid "outline" "solid")
+  (color "red" 'red "blue" "orange" "green" "black")
+  (coord big-int)
+  (pull 0 1/2 1/3 2 (/ big-nat (+ 1 big-nat)))
+  (angle 0 90 45 30 180 natural (* 4 natural))
+  
+  ; Redex tends to choose small numbers.
+  (big-nat (+ (* 10 natural) natural))
+  (big-int (+ (* 10 integer) integer)))
+
+(define-namespace-anchor anchor)
 
 (define (image-struct-count obj)
   (let ([counts (make-hash)])
@@ -1535,21 +1537,25 @@
           (unless (member (car stuff) '(struct:translate struct:scale)) ;; skip these becuase normalization eliminates them
             (hash-set! counts (car stuff) (+ 1 (hash-ref counts (car stuff) 0))))
           (for-each loop (cdr stuff)))))
-    (sort (hash-map counts list) string<=? #:key (λ (x) (symbol->string (car x))))))       
+    (sort (hash-map counts list) string<=? #:key (λ (x) (symbol->string (car x))))))
+
+(define (check-image-properties img-sexp img)
+  (let* ([raw-size (image-struct-count (image-shape img))]
+         [normalized (normalize-shape (image-shape img) values)]
+         [norm-size (image-struct-count normalized)])
+    (unless (normalized-shape? normalized)
+      (error 'test-image.ss "found a non-normalized shape after normalization:\n~s" 
+             img-sexp))
+    (unless (equal? norm-size raw-size)
+      (error 'test-image.ss "found differing sizes for ~s:\n  ~s\n  ~s" 
+             img-sexp raw-size norm-size))))       
   
 (time
- (let ([seed (+ 1 (modulo (current-seconds) (- (expt 2 31) 1)))])
-   (random-seed seed)
-   (for ((i (in-range 0 20000)))
-     (let* ([img (random-image 10)]
-            [raw-size (image-struct-count (image-shape img))]
-            [normalized (normalize-shape (image-shape img) values)]
-            [norm-size (image-struct-count normalized)])
-       (unless (normalized-shape? normalized)
-         (error 'test-image.ss "found a non-normalized shape (seed ~a) after normalization ~s:" 
-                seed
-                img))
-       (unless (equal? norm-size raw-size)
-         (error 'test-image.ss "found differing sizes (seed ~a):\n  ~s\n  ~s" 
-                seed
-                raw-size norm-size))))))
+ (redex-check
+  2htdp/image
+  image
+  (check-image-properties 
+   (term image)
+   (eval (term image) (namespace-anchor->namespace anchor)))
+  #:attempts 1000))
+
diff --git a/collects/drscheme/private/auto-language.ss b/collects/drscheme/private/auto-language.ss
index f0bf4a4f4a..6c8072ac71 100644
--- a/collects/drscheme/private/auto-language.ss
+++ b/collects/drscheme/private/auto-language.ss
@@ -1,7 +1,7 @@
-#lang typed-scheme
+#lang typed-scheme/no-check
 
-(require typed/framework/framework 
-	 typed/mred/mred
+(require framework/framework 
+	 mred/mred
          scheme/class)
 
 (provide pick-new-language looks-like-module?)
diff --git a/collects/drscheme/private/drscheme-normal.ss b/collects/drscheme/private/drscheme-normal.ss
index 00f436a6af..b1a9386fb9 100644
--- a/collects/drscheme/private/drscheme-normal.ss
+++ b/collects/drscheme/private/drscheme-normal.ss
@@ -78,6 +78,9 @@
 (set-splash-char-observer
  (λ (evt)
    (let ([ch (send evt get-key-code)])
+     (when (and (eq? ch #\q)
+                (send evt get-control-down))
+       (exit))
      (when (char? ch)
        ;; as soon as something is typed, load the bitmaps
        (load-magic-images)
diff --git a/collects/drscheme/private/frame.ss b/collects/drscheme/private/frame.ss
index ff8c7ca4b0..30f5f6c471 100644
--- a/collects/drscheme/private/frame.ss
+++ b/collects/drscheme/private/frame.ss
@@ -300,108 +300,98 @@
   ;; asks the user for a .plt file, either from the web or from
   ;; a file on the disk and installs it.
   (define (install-plt-file parent)
+    (define pref (preferences:get 'drscheme:install-plt-dialog))
     (define dialog
-      (instantiate dialog% ()
-        (parent parent)
-        (alignment '(left center))
-        (label (string-constant install-plt-file-dialog-title))))
+      (new dialog% [parent parent]
+           [label (string-constant install-plt-file-dialog-title)]
+           [alignment '(left center)]))
     (define tab-panel
-      (instantiate tab-panel% ()
-        (parent dialog)
-        (callback (λ (x y) (update-panels)))
-        (choices (list (string-constant install-plt-web-tab)
-                       (string-constant install-plt-file-tab)))))
-    (define outer-swapping-panel (instantiate horizontal-panel% ()
-                                   (parent tab-panel)
-                                   (stretchable-height #f)))
-    (define spacing-panel (instantiate horizontal-panel% ()
-                            (stretchable-width #f)
-                            (parent outer-swapping-panel)
-                            (min-width 20)))
-    (define swapping-panel (instantiate panel:single% ()
-                             (parent outer-swapping-panel)
-                             (alignment '(left center))
-                             (stretchable-width #t)
-                             (stretchable-height #f)))
-    (define file-panel (instantiate horizontal-panel% ()
-                         (parent swapping-panel)
-                         (stretchable-width #t)
-                         (stretchable-height #f)))
-    (define url-panel (instantiate horizontal-panel% ()
-                        (parent swapping-panel)
-                        (stretchable-height #f)))
-    (define button-panel (instantiate horizontal-panel% ()
-                           (parent dialog)
-                           (stretchable-height #f)
-                           (alignment '(right center))))
-    (define file-text-field (instantiate text-field% ()
-                              (parent file-panel)
-                              (callback void)
-                              (min-width 300)
-                              (stretchable-width #t)
-                              (label (string-constant install-plt-filename))))
-    (define file-button (instantiate button% ()
-                          (parent file-panel)
-                          (label (string-constant browse...))
-                          (callback (λ (x y) (browse)))))
-    (define url-text-field (instantiate text-field% ()
-                             (parent url-panel)
-                             (label (string-constant install-plt-url))
-                             (min-width 300)
-                             (stretchable-width #t)
-                             (callback void)))
-    
+      (new tab-panel% [parent dialog]
+           [callback (λ (x y) (update-panels))]
+           [choices (list (string-constant install-plt-web-tab)
+                          (string-constant install-plt-file-tab))]))
+    (define outer-swapping-panel
+      (new horizontal-panel% [parent tab-panel]
+           [stretchable-height #f]))
+    (define spacing-panel
+      (new horizontal-panel% [parent outer-swapping-panel]
+           [stretchable-width #f]
+           [min-width 20]))
+    (define swapping-panel
+      (new panel:single% [parent outer-swapping-panel]
+           [alignment '(left center)]
+           [stretchable-width #t] [stretchable-height #f]))
+    (define file-panel
+      (new horizontal-panel% [parent swapping-panel]
+           [stretchable-width #t] [stretchable-height #f]))
+    (define url-panel
+      (new horizontal-panel% [parent swapping-panel]
+           [stretchable-height #f]))
+    (define button-panel
+      (new horizontal-panel% [parent dialog]
+           [stretchable-height #f] [alignment '(right center)]))
+    (define file-text-field
+      (new text-field% [parent file-panel]
+           [callback void] [min-width 300] [stretchable-width #t]
+           [init-value (caddr pref)]
+           [label (string-constant install-plt-filename)]))
+    (define file-button
+      (new button% [parent file-panel]
+           [callback (λ (x y) (browse))]
+           [label (string-constant browse...)]))
+    (define url-text-field
+      (new text-field% [parent url-panel]
+           [min-width 300] [stretchable-width #t] [callback void]
+           [init-value (cadr pref)]
+           [label (string-constant install-plt-url)]))
     (define-values (ok-button cancel-button)
       (gui-utils:ok/cancel-buttons
        button-panel
-       (λ (x y)
-         (set! cancel? #f)
-         (send dialog show #f))
-       (λ (x y)
-         (send dialog show #f))))
-    
+       (λ (x y) (set! cancel? #f) (send dialog show #f))
+       (λ (x y) (send dialog show #f))))
     ;; browse : -> void
-    ;; gets the name of a file from the user and
-    ;; updates file-text-field
+    ;; gets the name of a file from the user and updates file-text-field
     (define (browse)
       (let ([filename (finder:get-file #f "" #f "" dialog)])
         (when filename
           (send file-text-field set-value (path->string filename)))))
-    
     ;; from-web? : -> boolean
     ;; returns #t if the user has selected a web address
     (define (from-web?)
       (zero? (send tab-panel get-selection)))
-    
     (define cancel? #t)
-    
     (define (update-panels)
-      (send swapping-panel active-child
-            (if (from-web?)
-                url-panel
-                file-panel)))
-    
+      (define w? (from-web?))
+      (define t  (if w? url-text-field file-text-field))
+      (send swapping-panel active-child (if w? url-panel file-panel))
+      (send t focus)
+      (send (send t get-editor) set-position
+            0 (string-length (send t get-value))))
+    ;; initialize
+    (send tab-panel set-selection (if (car pref) 0 1))
     (update-panels)
     (send dialog show #t)
-    
+    (preferences:set 'drscheme:install-plt-dialog
+                     (list (from-web?)
+                           (send url-text-field get-value)
+                           (send file-text-field get-value)))
     (cond
       [cancel? (void)]
       [(from-web?)
-       (install-plt-from-url (trim-whitespace (send url-text-field get-value)) parent)]
-      [else 
-       (parameterize ([error-display-handler drscheme:init:original-error-display-handler])
-         (run-installer (string->path (send file-text-field get-value))))]))
-  
-  ;; trim-whitespace: string -> string
-  ;; Trims the whitespace surrounding a string.
-  (define (trim-whitespace a-str)
-    (cond
-      [(regexp-match #px"^\\s*(.*[^\\s])\\s*$"
-                     a-str)
-       => second]
-      [else
-       a-str]))
-  
+       (install-plt-from-url
+        (let* ([url (send url-text-field get-value)]
+               ;; trim whitespaces
+               [url (regexp-replace #rx"^ +" url "")]
+               [url (regexp-replace #rx" +$" url "")])
+          (if (regexp-match? #rx"^(?:[^/:]*://|$)" url)
+            url
+            (string-append "http://" url)))
+        parent)]
+      [else (parameterize ([error-display-handler
+                            drscheme:init:original-error-display-handler])
+              (run-installer
+               (string->path (send file-text-field get-value))))]))
+
   ;; install-plt-from-url : string (union #f dialog%) -> void
   ;; downloads and installs a .plt file from the given url
   (define (install-plt-from-url s-url parent)
diff --git a/collects/drscheme/private/insert-large-letters.ss b/collects/drscheme/private/insert-large-letters.ss
index 609d7ffa85..2d164e7404 100644
--- a/collects/drscheme/private/insert-large-letters.ss
+++ b/collects/drscheme/private/insert-large-letters.ss
@@ -1,7 +1,7 @@
-#lang typed-scheme
+#lang typed-scheme/no-check
 
-(require typed/mred/mred
-         typed/framework/framework
+(require mred/mred
+         framework/framework
          scheme/class
          string-constants/string-constant)
 
diff --git a/collects/drscheme/private/language-configuration.ss b/collects/drscheme/private/language-configuration.ss
index 0c4ffd5d82..d1ba66798e 100644
--- a/collects/drscheme/private/language-configuration.ss
+++ b/collects/drscheme/private/language-configuration.ss
@@ -19,6 +19,11 @@
   (define original-output (current-output-port))
   (define (printfo . args) (apply fprintf original-output args))
   
+  (define sc-use-language-in-source "Use the language declared in the source")
+  (define sc-choose-a-language "Choose a language")
+  (define sc-lang-in-source-discussion
+    "Typically, a #lang line at the start of a program declares its language. This is the default and preferred mode for DrScheme.")
+
   (provide language-configuration@)
   
   (define-unit language-configuration@
@@ -358,7 +363,42 @@
             (send this on-click-always #t)))
         
         (define outermost-panel (make-object horizontal-pane% parent))
-        (define languages-hier-list (make-object selectable-hierlist% outermost-panel))
+        (define languages-choice-panel (new vertical-panel%
+                                            [parent outermost-panel]
+                                            [alignment '(left top)]))
+        
+        (define use-language-in-source-rb
+          (new radio-box% 
+               [label #f]
+               [choices (list sc-use-language-in-source)]
+               [parent languages-choice-panel]
+               [callback
+                (λ (rb evt)
+                  (module-language-selected)
+                  (send use-chosen-language-rb set-selection #f))]))
+        (define in-source-discussion-panel (new horizontal-panel% 
+                                                [parent languages-choice-panel]
+                                                [stretchable-height #f]))
+        (define in-source-discussion-spacer (new horizontal-panel% 
+                                                 [parent in-source-discussion-panel]
+                                                 [stretchable-width #f]
+                                                 [min-width 24]))
+        (define stupid-internal-definition-syntax1 (add-discussion in-source-discussion-panel))
+        (define use-chosen-language-rb
+          (new radio-box%
+               [label #f]
+               [choices (list sc-choose-a-language)]
+               [parent languages-choice-panel]
+               [callback
+                (λ (this-rb evt)
+                  (send use-language-in-source-rb set-selection #f))]))
+        (define languages-hier-list-panel (new horizontal-panel% [parent languages-choice-panel]))
+        (define languages-hier-list-spacer (new horizontal-panel% 
+                                                [parent languages-hier-list-panel]
+                                                [stretchable-width #f]
+                                                [min-width 24]))
+        
+        (define languages-hier-list (make-object selectable-hierlist% languages-hier-list-panel))
         (define details-outer-panel (make-object vertical-pane% outermost-panel))
         (define details/manual-parent-panel (make-object vertical-panel% details-outer-panel))
         (define details-panel (make-object panel:single% details/manual-parent-panel))
@@ -395,15 +435,31 @@
               (init-rest args)
               (public selected)
               (define (selected)
-                (let ([ldp (get-language-details-panel)])
-                  (when ldp
-                    (send details-panel active-child ldp)))
-                (send one-line-summary-message set-label (send language get-one-line-summary))
-                (send revert-to-defaults-button enable #t)
-                (set! get/set-selected-language-settings get/set-settings)
-                (set! selected-language language))
+                (send use-chosen-language-rb set-selection 0)
+                (send use-language-in-source-rb set-selection #f)
+                (update-gui-based-on-selected-language language get-language-details-panel get/set-settings))
               (apply super-make-object args))))
         
+        (define (update-gui-based-on-selected-language language get-language-details-panel get/set-settings)
+          (let ([ldp (get-language-details-panel)])
+            (when ldp
+              (send details-panel active-child ldp)))
+          (send one-line-summary-message set-label (send language get-one-line-summary))
+          (send revert-to-defaults-button enable #t)
+          (set! get/set-selected-language-settings get/set-settings)
+          (set! selected-language language))
+        
+        (define (module-language-selected)
+          ;; need to deselect things in the languages-hier-list at this point.
+          ;(send languages-hier-list select #f)
+          (update-gui-based-on-selected-language module-language*language
+                                                 module-language*get-language-details-panel
+                                                 module-language*get/set-settings))
+        
+        (define module-language*language 'module-language*-not-yet-set)
+        (define module-language*get-language-details-panel 'module-language*-not-yet-set)
+        (define module-language*get/set-settings 'module-language*-not-yet-set)
+        
         ;; nothing-selected : -> void
         ;; updates the GUI and selected-language and get/set-selected-language-settings
         ;; for when no language is selected.
@@ -488,17 +544,7 @@
                           [get-language-details-panel (lambda () language-details-panel)]
                           [get/set-settings (lambda x (apply real-get/set-settings x))]
                           [position (car positions)]
-                          [number (car numbers)]
-                          [mixin (compose
-                                  number-mixin
-                                  (language-mixin language get-language-details-panel get/set-settings))]
-                          [item
-                           (send hier-list new-item
-                                 (if second-number
-                                     (compose second-number-mixin mixin)
-                                     mixin))]
-                          [text (send item get-editor)]
-                          [delta (send language get-style-delta)])
+                          [number (car numbers)])
                      
                      (set! construct-details
                            (let ([old construct-details])
@@ -529,24 +575,40 @@
                                    [else
                                     (get/set-settings (send language default-settings))])))))
                      
-                     (send item set-number number)
-                     (when second-number
-                       (send item set-second-number second-number))
-                     (send text insert position)
-                     (when delta
-                       (cond
-                         [(list? delta)
-                          (for-each (λ (x)
-                                      (send text change-style 
-                                            (car x)
-                                            (cadr x)
-                                            (caddr x)))
-                                    delta)]
-                         [(is-a? delta style-delta%)
-                          (send text change-style 
-                                (send language get-style-delta)
-                                0
-                                (send text last-position))])))]
+                     (cond
+                       [(equal? positions '("Module"))
+                        (set! module-language*language language)
+                        (set! module-language*get-language-details-panel get-language-details-panel)
+                        (set! module-language*get/set-settings get/set-settings)]
+                     [else
+                      (let* ([mixin (compose
+                                     number-mixin
+                                     (language-mixin language get-language-details-panel get/set-settings))]
+                             [item
+                              (send hier-list new-item
+                                    (if second-number
+                                        (compose second-number-mixin mixin)
+                                        mixin))]
+                             [text (send item get-editor)]
+                             [delta (send language get-style-delta)])
+                        (send item set-number number)
+                        (when second-number
+                          (send item set-second-number second-number))
+                        (send text insert position)
+                        (when delta
+                          (cond
+                            [(list? delta)
+                             (for-each (λ (x)
+                                         (send text change-style 
+                                               (car x)
+                                               (cadr x)
+                                               (caddr x)))
+                                       delta)]
+                            [(is-a? delta style-delta%)
+                             (send text change-style 
+                                   (send language get-style-delta)
+                                   0
+                                   (send text last-position))])))]))]
                   [else (let* ([position (car positions)]
                                [number (car numbers)]
                                [sub-ht/sub-hier-list
@@ -662,32 +724,39 @@
         ;; and selects the current language
         (define (open-current-language)
           (when (and language-to-show settings-to-show)
-            (let ([language-position (send language-to-show get-language-position)])
-              (cond
-                [(null? (cdr language-position))
-                 ;; nothing to open here
-                 ;; this should only be the module language
-                 (send (car (send languages-hier-list get-items)) select #t)
-                 (void)]
-                [else
-                 (let loop ([hi languages-hier-list]
-                            
-                            ;; skip the first position, since it is flattened into the dialog
-                            [first-pos (cadr language-position)]
-                            [position (cddr language-position)])
-                   (let ([child
-                          ;; know that this `car' is okay by construction of the dialog
-                          (car 
-                           (filter (λ (x)
-                                     (equal? (send (send x get-editor) get-text)
-                                             first-pos))
-                                   (send hi get-items)))])
-                     (cond
-                       [(null? position)
-                        (send child select #t)]
-                       [else
-                        (send child open)
-                        (loop child (car position) (cdr position))])))]))))
+            (cond
+              [(equal? language-to-show 
+                       module-language*language)
+               (send use-language-in-source-rb set-selection 0)
+               (send use-chosen-language-rb set-selection #f)]
+              [else
+               (send use-chosen-language-rb set-selection 0)
+               (send use-language-in-source-rb set-selection #f)
+               (let ([language-position (send language-to-show get-language-position)])
+                 (cond
+                   [(null? (cdr language-position))
+                    ;; nothing to open here
+                    (send (car (send languages-hier-list get-items)) select #t)
+                    (void)]
+                   [else
+                    (let loop ([hi languages-hier-list]
+                               
+                               ;; skip the first position, since it is flattened into the dialog
+                               [first-pos (cadr language-position)]
+                               [position (cddr language-position)])
+                      (let ([child
+                             ;; know that this `car' is okay by construction of the dialog
+                             (car 
+                              (filter (λ (x)
+                                        (equal? (send (send x get-editor) get-text)
+                                                first-pos))
+                                      (send hi get-items)))])
+                        (cond
+                          [(null? position)
+                           (send child select #t)]
+                          [else
+                           (send child open)
+                           (loop child (car position) (cdr position))])))]))])))
         
         ;; docs-callback : -> void
         (define (docs-callback)
@@ -826,6 +895,34 @@
            (and get/set-selected-language-settings
                 (get/set-selected-language-settings))))))
     
+    (define (add-discussion p)
+      (let* ([t (new text:standard-style-list%)]
+             [c (new editor-canvas%
+                     [stretchable-width #t]
+                     [horizontal-inset 0]
+                     [vertical-inset 0]
+                     [parent p]
+                     [style '(no-border auto-vscroll no-hscroll transparent)]
+                     [editor t])])
+        (send c set-line-count 3)
+        
+        (send t set-styles-sticky #f)
+        (send t set-autowrap-bitmap #f)
+        (let ([do-insert
+               (λ (str style)
+                 (let ([before (send t last-position)])
+                   (send t insert str before before)
+                   (send t change-style style before (send t last-position))))])
+          (let loop ([strs (regexp-split #rx"#lang" sc-lang-in-source-discussion)])
+            (do-insert (car strs) (send (send t get-style-list) basic-style))
+            (unless (null? (cdr strs))
+              (do-insert "#lang" (send (send t get-style-list) find-named-style "standard"))
+              (loop (cdr strs)))))
+        (send t hide-caret #t)
+        
+        (send t auto-wrap #t)
+        (send t lock #t)))
+    
     (define panel-background-editor-canvas% 
       (class editor-canvas%
         (inherit get-dc get-client-size)
diff --git a/collects/drscheme/private/main.ss b/collects/drscheme/private/main.ss
index 2e759a83d9..1f46e3d613 100644
--- a/collects/drscheme/private/main.ss
+++ b/collects/drscheme/private/main.ss
@@ -152,6 +152,11 @@
                          (λ (x) (and (list? x) 
                                      (andmap (λ (x) (or (path? x) (drscheme:frame:planet-spec? x)))
                                              x))))
+(preferences:set-default 'drscheme:install-plt-dialog
+                         '(#t "" "") ; url-selected?, url string, file string
+                         (λ (x) (and (list? x) (= 3 (length x))
+                                     (boolean? (car x))
+                                     (andmap string? (cdr x)))))
 
 (preferences:set-un/marshall 
  'drscheme:user-defined-keybindings
diff --git a/collects/drscheme/private/rep.ss b/collects/drscheme/private/rep.ss
index cf1f339e26..9e4d84d01d 100644
--- a/collects/drscheme/private/rep.ss
+++ b/collects/drscheme/private/rep.ss
@@ -1618,6 +1618,7 @@ TODO
         (reset-regions (list (list (last-position) (last-position))))
         (set-unread-start-point (last-position))
         (set-insertion-point (last-position))
+        (set! indenting-limit (last-position))
         (set-allow-edits #f)
         (set! repl-header-end #f)
         (end-edit-sequence))
@@ -1653,6 +1654,12 @@ TODO
         (end-edit-sequence)
         (clear-undos))
       
+      (define indenting-limit 0)
+      (define/override (get-limit n) 
+        (cond
+          [(< n indenting-limit) 0]
+          [else indenting-limit]))
+      
       ;; avoid calling paragraph-start-position very often.
       (define repl-header-end #f)
       (define/private (get-repl-header-end)
diff --git a/collects/honu/main.ss b/collects/honu/main.ss
index 276d7b890a..ae632c9d99 100644
--- a/collects/honu/main.ss
+++ b/collects/honu/main.ss
@@ -10,11 +10,15 @@
                      (honu-* *)
                      (honu-/ /)
                      (honu-- -)
+                     (honu-? ?)
+                     (honu-: :)
+                     (honu-comma |,|)
                      )
          #%datum
          true
          false
          display
+         display2
          newline
          else
          (rename-out
diff --git a/collects/honu/private/honu-typed-scheme.ss b/collects/honu/private/honu-typed-scheme.ss
index 1c767b9618..f82899e3f0 100644
--- a/collects/honu/private/honu-typed-scheme.ss
+++ b/collects/honu/private/honu-typed-scheme.ss
@@ -22,17 +22,18 @@
 ;; macro for defining literal tokens that can be used in macros
 (define-syntax-rule (define-literal name ...)
   (begin
-    (define-syntax name (lambda (stx)
-                        (raise-syntax-error 'name
-                                            "this is a literal and cannot be used outside a macro")))
-    ...))
+   (define-syntax name (lambda (stx)
+                         (raise-syntax-error 'name
+                                             "this is a literal and cannot be used outside a macro")))
+   ...))
 
 (define-literal honu-return)
 (define-literal semicolon)
 (define-literal honu-+ honu-* honu-/ honu-- honu-|| honu-%
                 honu-= honu-+= honu--= honu-*= honu-/= honu-%=
                 honu-&= honu-^= honu-\|= honu-<<= honu->>= honu->>>=
-                honu->> honu-<< honu->>> honu-< honu-> honu-<= honu->=)
+                honu->> honu-<< honu->>> honu-< honu-> honu-<= honu->=
+                honu-? honu-: honu-comma)
 
 ;; (define-syntax (\; stx) (raise-syntax-error '\; "out of context" stx))
 
@@ -43,9 +44,9 @@
 
 
 (define-values (struct:honu-trans make-honu-trans honu-trans? honu-trans-ref honu-trans-set!)
-               (make-struct-type 'honu-trans #f 1 0 #f 
-                                 (list (list prop:honu-transformer #t))
-                                 (current-inspector) 0))
+  (make-struct-type 'honu-trans #f 1 0 #f
+                    (list (list prop:honu-transformer #t))
+                    (current-inspector) 0))
 
 (define (make-honu-transformer proc)
   (unless (and (procedure? proc)
@@ -355,6 +356,7 @@
 x(2)
 |#
 
+
 (define (parse-block-one/2 stx context)
   (define (parse-one stx context)
     (define-syntax-class block
@@ -368,24 +370,29 @@ x(2)
                          [pattern f])
 
     (define-splicing-syntax-class call
-                         [pattern (~seq e:expr (#%parens arg:expression-1))
-                                  #:with call #'(e arg.result)])
+                                  #:literals (honu-comma)
+                         [pattern (~seq e:expr (#%parens (~seq arg:ternary (~optional honu-comma)) ...))
+                                  #:with call #'(e arg.result ...)])
     (define-splicing-syntax-class expression-last
                          [pattern (~seq call:call) #:with result #'call.call]
                          [pattern (~seq x:number) #:with result #'x]
                          )
 
     (define-syntax-rule (define-infix-operator name next [operator reducer] ...)
-      (define-splicing-syntax-class name
-                                    #:literals (operator ...)
-                                    [pattern (~seq (~var left next) operator (~var right name))
-                                             #:with result (reducer #'left.result #'right.result)]
-                                    ...
-                                    [pattern (~seq (~var exp next))
-                                             #:with result #'exp.result]
-                                    ))
+      (begin
+       (define-syntax-class operator-class
+         #:literals (operator ...)
+         (pattern operator #:attr func reducer)
+         ...)
+       (define-splicing-syntax-class name
+         (pattern (~seq (~var left next)
+                        (~optional (~seq (~var op operator-class) (~var right name))))
+                  #:with result
+                  (cond [(attribute right)
+                         ((attribute op.func) #'left.result #'right.result)]
+                        [else
+                         #'left.result])))))
 
-    ;; TODO: maybe just have a precedence macro that creates all these constructs
     ;;   (infix-operators ([honu-* ...]
     ;;                     [honu-- ...])
     ;;                    ([honu-+ ...]
@@ -414,23 +421,6 @@ x(2)
              #'(begin
                  result ...)))]))
 
-    #;
-    (infix-operators expression-1 expression-last
-                       ([honu-+ (syntax-lambda (left right)
-                                    #'(+ left right))]
-                        [honu-- (syntax-lambda (left right)
-                                               #'(- left right))])
-                       ([honu-* (syntax-lambda (left right)
-                                               #'(* left right))]
-                        [honu-/ (syntax-lambda (left right)
-                                               #'(/ left right))]))
-    
-
-    (define-syntax-class expression-top
-                         [pattern (e:expression-1 semicolon . rest)
-                                  #:with result #'e.result])
-
-
     ;; infix operators in the appropriate precedence level
     ;; things defined lower in the table have a higher precedence.
     ;; the first set of operators is `expression-1'
@@ -462,10 +452,25 @@ x(2)
          [honu-% (sl (left right) #'(modulo left right))]
          [honu-/ (sl (left right) #'(/ left right))])))
 
+    (define-splicing-syntax-class ternary
+      #:literals (honu-? honu-:)
+      [pattern (~seq condition:expression-1 (~optional (~seq honu-? on-true:ternary
+                                                             honu-: on-false:ternary)))
+               #:with result
+               (cond [(attribute on-true)
+                      #'(if condition.result on-true.result on-false.result)]
+                     [else #'condition.result])])
+
+    (define-syntax-class expression-top
+                         #:literals (semicolon)
+      [pattern (e:ternary semicolon . rest)
+               #:with result #'e.result])
+
     ;; (printf "~a\n" (syntax-class-parse function stx))
     (syntax-parse stx
       [function:function (values #'function.result #'function.rest)]
       [expr:expression-top (values #'expr.result #'expr.rest)]
+      #;
       [(x:number . rest) (values #'x #'rest)]
       ))
   (cond
@@ -643,6 +648,9 @@ if (foo){
 (define-syntax (honu-top stx)
   (raise-syntax-error #f "interactive use is not yet supported"))
 
+(define (display2 x y)
+  (printf "~a ~a" x y))
+
 (define-syntax (honu-unparsed-begin stx)
   ;; (printf "honu unparsed begin: ~a\n" (syntax->datum stx))
   (syntax-case stx ()
diff --git a/collects/macro-debugger/expand.ss b/collects/macro-debugger/expand.ss
index 29f6d772ef..48d4c22007 100644
--- a/collects/macro-debugger/expand.ss
+++ b/collects/macro-debugger/expand.ss
@@ -25,7 +25,7 @@
 (define (expand/show-predicate stx show?)
   (let-values ([(result deriv) (trace/result stx)])
     (when (exn? result) (raise result))
-    (let-values ([(_steps _uses stx exn2)
+    (let-values ([(_steps _defs _uses stx exn2)
                   (parameterize ((macro-policy show?))
                     (reductions+ deriv))])
       (when (exn? exn2) (raise exn2))
diff --git a/collects/macro-debugger/stepper-text.ss b/collects/macro-debugger/stepper-text.ss
index 3df8213c8b..327b52a72c 100644
--- a/collects/macro-debugger/stepper-text.ss
+++ b/collects/macro-debugger/stepper-text.ss
@@ -93,13 +93,6 @@
            ((if display-like? display write) (syntax-dummy-val obj) port)]
           [else 
            (error 'pretty-print-hook "unexpected special value: ~e" obj)]))
-  (define (pp-extend-style-table)
-    (let* ([ids identifier-list]
-           [syms (map (lambda (x) (hash-ref stx=>flat x)) ids)]
-           [like-syms (map syntax-e ids)])
-      (pretty-print-extend-style-table (pp-better-style-table)
-                                       syms
-                                       like-syms)))
   (define (pp-better-style-table)
     (pretty-print-extend-style-table (pretty-print-current-style-table)
                                      (map car extended-style-list)
@@ -107,7 +100,7 @@
   (parameterize 
    ([pretty-print-size-hook pp-size-hook]
     [pretty-print-print-hook pp-print-hook]
-    [pretty-print-current-style-table (pp-extend-style-table)])
+    [pretty-print-current-style-table (pp-better-style-table)])
    (pretty-print/defaults datum)))
 
 (define (->show-function show)
diff --git a/collects/meta/dist-specs.ss b/collects/meta/dist-specs.ss
index b96401b67b..0e0547c390 100644
--- a/collects/meta/dist-specs.ss
+++ b/collects/meta/dist-specs.ss
@@ -344,7 +344,7 @@ mz-manuals := (scribblings: "main/") ; generates main pages (next line)
               (notes: "COPYING.LIB" "COPYING-libscheme.txt")
               (doc: "doc-license.txt") ; needed (when docs are included)
               (doc+src: "reference/" "guide/" "quick/" "more/"
-                        "foreign/" "inside/" "futures/"
+                        "foreign/" "inside/" "futures/" "places/"
                         "honu/")
               (doc: "*.{html|css|js|sxref}")
               (scribblings: "{{info|icons}.ss|*.png}" "compiled")
diff --git a/collects/mred/private/check.ss b/collects/mred/private/check.ss
index 9872d3550e..d46c1996d1 100644
--- a/collects/mred/private/check.ss
+++ b/collects/mred/private/check.ss
@@ -117,7 +117,7 @@
       (unless (and (integer? i) (exact? i) (not (negative? i)))
 	(raise-type-error (who->name who) 
 			  (if false-ok?
-			      "non-negative exact integeror #f" 
+			      "non-negative exact integer or #f" 
 			      "non-negative exact integer" )
 			  i))))
 
diff --git a/collects/mred/private/mritem.ss b/collects/mred/private/mritem.ss
index 226d144d1a..31231d5c1e 100644
--- a/collects/mred/private/mritem.ss
+++ b/collects/mred/private/mritem.ss
@@ -264,40 +264,47 @@
 	  (check-container-parent cwho parent)
 	  (check-callback cwho callback)
 	  (check-orientation cwho style)
-	  (check-non-negative-integer cwho selection)))
+	  (check-non-negative-integer/false cwho selection)))
       (private-field
        [wx #f])
       (private
 	[check-button
-	 (lambda (method n)
-	   (check-non-negative-integer `(method radio-box% ,method) n)
-	   (unless (< n (length chcs))
-	     (raise-mismatch-error (who->name `(method radio-box% ,method)) "no such button: " n)))])
+	 (lambda (method n false-ok?)
+	   ((if false-ok?
+                check-non-negative-integer/false 
+                check-non-negative-integer)
+            `(method radio-box% ,method) n)
+           (when n
+             (unless (< n (length chcs))
+               (raise-mismatch-error (who->name `(method radio-box% ,method)) "no such button: " n))))])
       (override
 	[enable (entry-point
 		 (case-lambda
 		  [(on?) (send wx enable on?)]
-		  [(which on?) (check-button 'enable which)
+		  [(which on?) (check-button 'enable which #f)
 		   (send wx enable which on?)]))]
 	[is-enabled? (entry-point
 		      (case-lambda
 		       [() (send wx is-enabled?)]
-		       [(which) (check-button 'is-enabled? which)
+		       [(which) (check-button 'is-enabled? which #f)
 			(send wx is-enabled? which)]))])
       (public
 	[get-number (lambda () (length chcs))]
 	[get-item-label (lambda (n) 
-			  (check-button 'get-item-label n)
+			  (check-button 'get-item-label n #f)
 			  (list-ref chcs n))]
 	[get-item-plain-label (lambda (n) 
-				(check-button 'get-item-plain-label n)
+				(check-button 'get-item-plain-label n #f)
 				(wx:label->plain-label (list-ref chcs n)))]
 	
-	[get-selection (entry-point (lambda () (send wx get-selection)))]
+	[get-selection (entry-point (lambda () (let ([v (send wx get-selection)])
+                                                 (if (equal? v -1)
+                                                     #f
+                                                     v))))]
 	[set-selection (entry-point
 			(lambda (v) 
-			  (check-button 'set-selection v)
-			  (send wx set-selection v)))])
+			  (check-button 'set-selection v #t)
+			  (send wx set-selection (or v -1))))])
       (sequence
 	(as-entry
 	 (lambda ()
@@ -317,7 +324,7 @@
 							   (length choices))
 						   selection))))
 		       label parent callback #f)))
-	(when (positive? selection)
+	(when (or (not selection) (positive? selection))
 	  (set-selection selection)))))
 
   (define slider%
diff --git a/collects/redex/private/rg.ss b/collects/redex/private/rg.ss
index 573c7cecfb..04df780210 100644
--- a/collects/redex/private/rg.ss
+++ b/collects/redex/private/rg.ss
@@ -14,9 +14,6 @@
 
 (define (exotic-choice? [random random]) (= 0 (random 5)))
 (define (use-lang-literal? [random random]) (= 0 (random 20)))
-(define (preferred-production? attempt [random random]) 
-  (and (>= attempt preferred-production-threshold)
-       (zero? (random 2))))
 
 (define default-check-attempts 1000)
 
@@ -57,27 +54,8 @@
 (define (pick-string lang-lits attempt [random random])
   (random-string lang-lits (random-natural 1/5 random) attempt random))
 
-(define (pick-nt name cross? lang attempt pref-prods 
-                 [random random]
-                 [pref-prod? preferred-production?])
-  (let ([prods (nt-rhs (nt-by-name lang name cross?))])
-    (cond [(and pref-prods (pref-prod? attempt random))
-           (hash-ref 
-            ((if cross? pref-prods-cross pref-prods-non-cross)
-             pref-prods)
-            name)]
-          [else prods])))
-
-(define-struct pref-prods (cross non-cross))
-
-(define (pick-preferred-productions lang)
-  (let ([pick (λ (sel)
-                (for/hash ([nt (sel lang)])
-                          (values (nt-name nt)
-                                  (list (pick-from-list (nt-rhs nt))))))])
-    (make-pref-prods
-     (pick compiled-lang-cclang)
-     (pick compiled-lang-lang))))
+(define (pick-nts name cross? lang attempt)
+  (nt-rhs (nt-by-name lang name cross?)))
 
 (define (pick-from-list l [random random]) (list-ref l (random (length l))))
 
@@ -118,9 +96,6 @@
 (define proportion-at-size 1/10)
 (define post-threshold-incr 50)
 
-(define preferred-production-threshold
-  (+ retry-threshold 2000))
-
 ;; Determines the parameter p for which random-natural's expected value is E
 (define (expected-value->p E)
   ;; E = 0 => p = 1, which breaks random-natural
@@ -177,11 +152,11 @@
                      who what attempts (if (= attempts 1) "" "s"))])
     (raise (make-exn:fail:redex:generation-failure str (current-continuation-marks)))))
 
-(define (generate lang decisions@ user-gen retries what)
+(define (generate lang decisions@ what)
   (define-values/invoke-unit decisions@
     (import) (export decisions^))
   
-  (define ((generate-nt lang base-cases generate pref-prods)
+  (define ((generate-nt lang base-cases generate retries)
            name cross? size attempt in-hole env)
     (let*-values
         ([(term _)
@@ -193,10 +168,10 @@
                              (min-prods (nt-by-name lang name cross?) 
                                         ((if cross? base-cases-cross base-cases-non-cross)
                                          base-cases))
-                             ((next-non-terminal-decision) name cross? lang attempt pref-prods)))])
+                             ((next-non-terminal-decision) name cross? lang attempt)))])
                (generate (max 0 (sub1 size)) attempt empty-env in-hole (rhs-pattern rhs))))
            (λ (_ env) (mismatches-satisfied? env))
-           size attempt)])
+           size attempt retries)])
       term))
   
   (define (generate-sequence ellipsis generate env length)
@@ -222,18 +197,18 @@
                   (values (cons term terms) (cons env envs)))))])
       (values seq (merge-environments envs))))
   
-  (define (generate/pred name gen pred init-sz init-att)
+  (define (generate/pred name gen pred init-sz init-att retries)
     (let ([pre-threshold-incr 
            (ceiling
             (/ (- retry-threshold init-att)
-               (* proportion-before-threshold retries)))]
+               (* proportion-before-threshold (add1 retries))))]
           [incr-size? 
            (λ (remain)
              (zero? 
               (modulo (sub1 remain) 
                       (ceiling (* proportion-at-size 
                                   retries)))))])
-      (let retry ([remaining retries]
+      (let retry ([remaining (add1 retries)]
                   [size init-sz]
                   [attempt init-att])
         (if (zero? remaining)
@@ -279,120 +254,109 @@
                    (cons (make-bind (binder-name key) val) bindings)
                    bindings))))
   
-  (define (generate-pat lang sexp pref-prods user-gen user-acc size attempt env in-hole pat)
-    (define recur (curry generate-pat lang sexp pref-prods user-gen user-acc size attempt))
+  (define (generate-pat lang sexp retries size attempt env in-hole pat)
+    (define recur (curry generate-pat lang sexp retries size attempt))
     (define recur/pat (recur env in-hole))
     (define ((recur/pat/size-attempt pat) size attempt)
-      (generate-pat lang sexp pref-prods user-gen user-acc size attempt env in-hole pat))
+      (generate-pat lang sexp retries size attempt env in-hole pat))
     
     (define clang (rg-lang-clang lang))
     (define gen-nt 
       (generate-nt 
        clang 
        (rg-lang-base-cases lang)
-       (curry generate-pat lang sexp pref-prods user-gen user-acc)
-       pref-prods))
+       (curry generate-pat lang sexp retries)
+       retries))
     
-    (define (default-gen user-acc)
-      (match pat
-        [`number (values ((next-number-decision) attempt) env)]
-        [`natural (values ((next-natural-decision) attempt) env)]
-        [`integer (values ((next-integer-decision) attempt) env)]
-        [`real (values ((next-real-decision) attempt) env)]
-        [`(variable-except ,vars ...)
-         (generate/pred 'variable
-                        (recur/pat/size-attempt 'variable)
-                        (λ (var _) (not (memq var vars)))
-                        size attempt)]
-        [`variable 
-         (values ((next-variable-decision) (rg-lang-lits lang) attempt)
-                 env)]
-        [`variable-not-otherwise-mentioned
-         (generate/pred 'variable
-                        (recur/pat/size-attempt 'variable)
-                        (λ (var _) (not (memq var (compiled-lang-literals clang))))
-                        size attempt)]
-        [`(variable-prefix ,prefix) 
-         (define (symbol-append prefix suffix)
-           (string->symbol (string-append (symbol->string prefix) (symbol->string suffix))))
-         (let-values ([(term env) (recur/pat 'variable)])
-           (values (symbol-append prefix term) env))]
-        [`string 
-         (values ((next-string-decision) (rg-lang-lits lang) attempt)
-                 env)]
-        [`(side-condition ,pat ,(? procedure? condition) ,guard-src-loc)
-         (generate/pred `(side-condition ,(unparse-pattern pat) ,guard-src-loc) 
-                        (recur/pat/size-attempt pat)
-                        (λ (_ env) (condition (bindings env)))
-                        size attempt)]
-        [`(name ,(? symbol? id) ,p)
-         (let-values ([(term env) (recur/pat p)])
-           (values term (hash-set env (make-binder id) term)))]
-        [`hole (values in-hole env)]
-        [`(in-hole ,context ,contractum)
-         (let-values ([(term env) (recur/pat contractum)])
-           (recur env term context))]
-        [`(hide-hole ,pattern) (recur env the-hole pattern)]
-        [`any
-         (let*-values ([(new-lang nt) ((next-any-decision) lang sexp)]
-                       ; Don't use preferred productions for the sexp language.
-                       [(pref-prods) (if (eq? new-lang lang) pref-prods #f)]
-                       [(term _) (generate-pat new-lang
-                                               sexp
-                                               pref-prods
-                                               user-gen
-                                               user-acc
-                                               size
-                                               attempt
-                                               empty-env
-                                               the-hole
-                                               nt)])
-           (values term env))]
-        [(? (is-nt? clang))
-         (values (gen-nt pat #f size attempt in-hole env) env)]
-        [(struct binder ((or (? (is-nt? clang) nt) 
-                             (app (symbol-match named-nt-rx) (? (is-nt? clang) nt)))))
-         (generate/prior pat env (λ () (recur/pat nt)))]
-        [(struct binder ((or (? built-in? b) 
-                             (app (symbol-match named-nt-rx) (? built-in? b)))))
-         (generate/prior pat env (λ () (recur/pat b)))]
-        [(struct mismatch (name (app (symbol-match mismatch-nt-rx)
-                                     (? symbol? (? (is-nt? clang) nt)))))
-         (let-values ([(term _) (recur/pat nt)])
-           (values term (hash-set env pat term)))]
-        [(struct mismatch (name (app (symbol-match mismatch-nt-rx)
-                                     (? symbol? (? built-in? b)))))
-         (let-values ([(term _) (recur/pat b)])
-           (values term (hash-set env pat term)))]
-        [`(cross ,(? symbol? cross-nt))
-         (values (gen-nt cross-nt #t size attempt in-hole env) env)]
-        [(or (? symbol?) (? number?) (? string?) (? boolean?) (? null?)) (values pat env)]
-        [(list-rest (and (struct ellipsis (name sub-pat class vars)) ellipsis) rest)
-         (let*-values ([(length) (let ([prior (hash-ref env class #f)])
-                                   (if prior prior ((next-sequence-decision) attempt)))]
-                       [(seq env) (generate-sequence ellipsis recur env length)]
-                       [(rest env) (recur (hash-set (hash-set env class length) name length)
-                                     in-hole rest)])
-           (values (append seq rest) env))]
-        [(list-rest pat rest)
-         (let*-values 
-             ([(pat-term env) (recur/pat pat)]
-              [(rest-term env) (recur env in-hole rest)])
-           (values (cons pat-term rest-term) env))]
-        [else
-         (error what "unknown pattern ~s\n" pat)]))
-    
-    (user-gen 
-     pat size in-hole user-acc env attempt
-     (λ (pat #:size [size size] #:contractum [in-hole in-hole] #:acc [user-acc user-acc] #:env [env env])
-       (generate-pat lang sexp pref-prods user-gen user-acc size attempt env in-hole pat))
-     default-gen))
+    (match pat
+      [`number (values ((next-number-decision) attempt) env)]
+      [`natural (values ((next-natural-decision) attempt) env)]
+      [`integer (values ((next-integer-decision) attempt) env)]
+      [`real (values ((next-real-decision) attempt) env)]
+      [`(variable-except ,vars ...)
+       (generate/pred 'variable
+                      (recur/pat/size-attempt 'variable)
+                      (λ (var _) (not (memq var vars)))
+                      size attempt retries)]
+      [`variable 
+       (values ((next-variable-decision) (rg-lang-lits lang) attempt)
+               env)]
+      [`variable-not-otherwise-mentioned
+       (generate/pred 'variable
+                      (recur/pat/size-attempt 'variable)
+                      (λ (var _) (not (memq var (compiled-lang-literals clang))))
+                      size attempt retries)]
+      [`(variable-prefix ,prefix) 
+       (define (symbol-append prefix suffix)
+         (string->symbol (string-append (symbol->string prefix) (symbol->string suffix))))
+       (let-values ([(term env) (recur/pat 'variable)])
+         (values (symbol-append prefix term) env))]
+      [`string 
+       (values ((next-string-decision) (rg-lang-lits lang) attempt)
+               env)]
+      [`(side-condition ,pat ,(? procedure? condition) ,guard-src-loc)
+       (generate/pred `(side-condition ,(unparse-pattern pat) ,guard-src-loc) 
+                      (recur/pat/size-attempt pat)
+                      (λ (_ env) (condition (bindings env)))
+                      size attempt retries)]
+      [`(name ,(? symbol? id) ,p)
+       (let-values ([(term env) (recur/pat p)])
+         (values term (hash-set env (make-binder id) term)))]
+      [`hole (values in-hole env)]
+      [`(in-hole ,context ,contractum)
+       (let-values ([(term env) (recur/pat contractum)])
+         (recur env term context))]
+      [`(hide-hole ,pattern) (recur env the-hole pattern)]
+      [`any
+       (let*-values ([(new-lang nt) ((next-any-decision) lang sexp)]
+                     [(term _) (generate-pat new-lang
+                                             sexp
+                                             retries
+                                             size
+                                             attempt
+                                             empty-env
+                                             the-hole
+                                             nt)])
+         (values term env))]
+      [(? (is-nt? clang))
+       (values (gen-nt pat #f size attempt in-hole env) env)]
+      [(struct binder ((or (? (is-nt? clang) nt) 
+                           (app (symbol-match named-nt-rx) (? (is-nt? clang) nt)))))
+       (generate/prior pat env (λ () (recur/pat nt)))]
+      [(struct binder ((or (? built-in? b) 
+                           (app (symbol-match named-nt-rx) (? built-in? b)))))
+       (generate/prior pat env (λ () (recur/pat b)))]
+      [(struct mismatch (name (app (symbol-match mismatch-nt-rx)
+                                   (? symbol? (? (is-nt? clang) nt)))))
+       (let-values ([(term _) (recur/pat nt)])
+         (values term (hash-set env pat term)))]
+      [(struct mismatch (name (app (symbol-match mismatch-nt-rx)
+                                   (? symbol? (? built-in? b)))))
+       (let-values ([(term _) (recur/pat b)])
+         (values term (hash-set env pat term)))]
+      [`(cross ,(? symbol? cross-nt))
+       (values (gen-nt cross-nt #t size attempt in-hole env) env)]
+      [(or (? symbol?) (? number?) (? string?) (? boolean?) (? null?)) (values pat env)]
+      [(list-rest (and (struct ellipsis (name sub-pat class vars)) ellipsis) rest)
+       (let*-values ([(length) (let ([prior (hash-ref env class #f)])
+                                 (if prior prior ((next-sequence-decision) attempt)))]
+                     [(seq env) (generate-sequence ellipsis recur env length)]
+                     [(rest env) (recur (hash-set (hash-set env class length) name length)
+                                   in-hole rest)])
+         (values (append seq rest) env))]
+      [(list-rest pat rest)
+       (let*-values 
+           ([(pat-term env) (recur/pat pat)]
+            [(rest-term env) (recur env in-hole rest)])
+         (values (cons pat-term rest-term) env))]
+      [else
+       (error what "unknown pattern ~s\n" pat)]))
   
   (let ([rg-lang (prepare-lang lang)]
         [rg-sexp (prepare-lang sexp)])
     (λ (pat)
       (let ([parsed (reassign-classes (parse-pattern pat lang 'top-level))])
-        (λ (size attempt)
+        (λ (size attempt retries)
           (let-values ([(term env)
                         (generate/pred 
                          pat
@@ -400,16 +364,14 @@
                            (generate-pat 
                             rg-lang 
                             rg-sexp
-                            ((next-pref-prods-decision) (rg-lang-clang rg-lang))
-                            user-gen 
-                            #f
+                            retries
                             size
                             attempt
                             empty-env
                             the-hole
                             parsed))
                          (λ (_ env) (mismatches-satisfied? env))
-                         size attempt)])
+                         size attempt retries)])
             (values term (bindings env))))))))
 
 (define-struct base-cases (cross non-cross))
@@ -681,36 +643,35 @@
       x
       (raise-type-error 'redex-check "reduction-relation" x)))
 
-(define (defer-all pat size in-hole acc env att recur defer) 
-  (defer acc))
-
-(define-for-syntax (term-generator lang pat decisions@ custom retries what)
+(define-for-syntax (term-generator lang pat decisions@ what)
   (with-syntax ([pattern 
                  (rewrite-side-conditions/check-errs 
                   (language-id-nts lang what)
                   what #t pat)])
-    #`((generate #,lang #,decisions@ #,custom #,retries '#,what) `pattern)))
+    #`((generate #,lang #,decisions@ '#,what) `pattern)))
 
 (define-syntax (generate-term stx)
   (syntax-case stx ()
-    [(_ lang pat size . kw-args)
-     (with-syntax ([(attempt retries custom)
-                    (parse-kw-args `((#:attempt . 1)
-                                     (#:retries . ,#'default-retries)
-                                     (#:custom . ,#'defer-all))
+    [(name lang pat size . kw-args)
+     (with-syntax ([(attempt retries)
+                    (parse-kw-args `((#:attempt-num . 1)
+                                     (#:retries . ,#'default-retries))
                                    (syntax kw-args)
                                    stx)])
-       (with-syntax ([generate (term-generator #'lang 
-                                               #'pat
-                                               #'(generation-decisions)
-                                               #'custom
-                                               #'retries
-                                               'generate-term)])
-         (syntax/loc stx
-           (let-values ([(term _) (generate size attempt)])
-             term))))]
-    [(_ lang pat size)
-     (syntax/loc stx (generate-term lang pat size #:attempt 1))]))
+       (syntax/loc stx
+         ((generate-term lang pat) size #:attempt-num attempt #:retries retries)))]
+    [(name lang pat)
+     (with-syntax ([make-gen (term-generator #'lang
+                                             #'pat
+                                             #'(generation-decisions)
+                                             (syntax-e #'name))])
+       (syntax/loc stx
+         (let ([generate make-gen])
+           (λ (size #:attempt-num [attempt-num 1] #:retries [retries default-retries])
+             (let ([att (assert-nat 'name attempt-num)]
+                   [ret (assert-nat 'name retries)])
+               (let-values ([(term _) (generate size att ret)])
+                 term))))))]))
 
 (define-for-syntax (show-message stx)
   (syntax-case stx ()
@@ -734,12 +695,12 @@
      (let-values ([(names names/ellipses) 
                    (extract-names (language-id-nts #'lang 'redex-check)
                                   'redex-check #t #'pat)]
-                  [(attempts-stx source-stx retries-stx custom-stx)
+                  [(attempts-stx source-stx retries-stx print?-stx)
                    (apply values
                           (parse-kw-args `((#:attempts . ,#'default-check-attempts)
                                            (#:source . #f)
                                            (#:retries . ,#'default-retries)
-                                           (#:custom . ,#'defer-all))
+                                           (#:print? . #t))
                                          (syntax kw-args)
                                          stx))])
        (with-syntax ([(name ...) names]
@@ -752,17 +713,7 @@
            (quasisyntax/loc stx
              (let ([att (assert-nat 'redex-check #,attempts-stx)]
                    [ret (assert-nat 'redex-check #,retries-stx)]
-                   [custom (contract 
-                            (-> any/c natural-number/c any/c any/c hash? natural-number/c
-                                (->* (any/c)
-                                     (#:size natural-number/c
-                                             #:contractum any/c
-                                             #:acc any/c
-                                             #:env hash?)
-                                     (values any/c hash?))
-                                (-> any/c (values any/c hash?))
-                                (values any/c hash?))
-                            #,custom-stx '+ '-)])
+                   [print? #,print?-stx])
                (unsyntax
                 (if source-stx
                     #`(let-values ([(metafunc/red-rel num-cases) 
@@ -776,27 +727,32 @@
                          metafunc/red-rel
                          property
                          random-decisions@
-                         custom
                          (max 1 (floor (/ att num-cases)))
                          ret
                          'redex-check
-                         show
+                         (and print? show)
                          (test-match lang pat)
                          (λ (generated) (redex-error 'redex-check "~s does not match ~s" generated 'pat))))
                     #`(check-prop
-                       #,(term-generator #'lang #'pat #'random-decisions@ #'custom #'ret 'redex-check)
-                       property att show)))
-               (void))))))]))
+                       #,(term-generator #'lang #'pat #'random-decisions@ 'redex-check)
+                       property att ret (and print? show)))))))))]))
 
 (define (format-attempts a)
   (format "~a attempt~a" a (if (= 1 a) "" "s")))
 
-(define (check-prop generator property attempts show)
-  (when (check generator property attempts show)
-    (show (format "no counterexamples in ~a\n"
-                  (format-attempts attempts)))))
+(define (check-prop generator property attempts retries show) 
+  (let ([c (check generator property attempts retries show)])
+    (if (counterexample? c)
+        (unless show c) ; check printed it
+        (if show
+            (show (format "no counterexamples in ~a\n"
+                          (format-attempts attempts)))
+            #t))))
 
-(define (check generator property attempts show
+(define-struct (exn:fail:redex:test exn:fail:redex) (source term))
+(define-struct counterexample (term))
+
+(define (check generator property attempts retries show
                #:source [source #f]
                #:match [match #f]
                #:match-fail [match-fail #f])
@@ -804,14 +760,21 @@
     (if (zero? remaining)
         #t
         (let ([attempt (add1 (- attempts remaining))])
-          (let-values ([(term bindings) (generator (attempt->size attempt) attempt)])
+          (let-values ([(term bindings) (generator (attempt->size attempt) attempt retries)])
             (if (andmap (λ (bindings) 
                           (with-handlers 
                               ([exn:fail?
                                 (λ (exn) 
-                                  (show 
-                                   (format "checking ~s raises an exception\n" term))
-                                  (raise exn))])
+                                  (when show 
+                                    (show (format "checking ~s raises an exception\n" term)))
+                                  (raise 
+                                   (if show
+                                       exn
+                                       (make-exn:fail:redex:test
+                                        (format "checking ~s raises an exception:\n~a" term (exn-message exn))
+                                        (current-continuation-marks)
+                                        exn
+                                        term))))])
                             (property term bindings)))
                         (cond [(and match match-fail (match term)) 
                                => (curry map (compose make-bindings match-bindings))]
@@ -819,22 +782,22 @@
                               [else (list bindings)]))
                 (loop (sub1 remaining))
                 (begin
-                  (show
-                   (format "counterexample found after ~a~a:\n"
-                           (format-attempts attempt)
-                           (if source (format " with ~a" source) "")))
-                  (pretty-print term (current-output-port))
-                  #f)))))))
+                  (when show
+                    (show
+                     (format "counterexample found after ~a~a:\n"
+                             (format-attempts attempt)
+                             (if source (format " with ~a" source) "")))
+                    (pretty-print term (current-output-port)))
+                  (make-counterexample term))))))))
 
 (define-syntax (check-metafunction-contract stx)
   (syntax-case stx ()
     [(_ name . kw-args)
      (identifier? #'name)
      (with-syntax ([m (metafunc/err #'name stx)]
-                   [(attempts retries custom)
+                   [(attempts retries)
                     (parse-kw-args `((#:attempts . ,#'default-check-attempts)
-                                     (#:retries . ,#'default-retries)
-                                     (#:custom . ,#'defer-all))
+                                     (#:retries . ,#'default-retries))
                                    (syntax kw-args)
                                    stx)]
                    [show (show-message stx)])
@@ -844,18 +807,19 @@
               [decisions@ (generation-decisions)]
               [att (assert-nat 'check-metafunction-contract attempts)])
           (check-prop 
-           ((generate lang decisions@ custom retries 'check-metafunction-contract)
+           ((generate lang decisions@ 'check-metafunction-contract)
             (if dom dom '(any (... ...))))
            (λ (t _) 
              (with-handlers ([exn:fail:redex? (λ (_) #f)])
                (begin (term (name ,@t)) #t)))
            att
+           retries
            show))))]))
 
-(define (check-lhs-pats lang mf/rr prop decisions@ custom attempts retries what show
-                         [match #f]
-                         [match-fail #f])
-  (let ([lang-gen (generate lang decisions@ custom retries what)])
+(define (check-lhs-pats lang mf/rr prop decisions@ attempts retries what show
+                        [match #f]
+                        [match-fail #f])
+  (let ([lang-gen (generate lang decisions@ what)])
     (let-values ([(pats srcs)
                   (cond [(metafunc-proc? mf/rr)
                          (values (map metafunc-case-lhs-pat (metafunc-proc-cases mf/rr))
@@ -863,47 +827,53 @@
                         [(reduction-relation? mf/rr)
                          (values (map (λ (rwp) ((rewrite-proc-lhs rwp) lang)) (reduction-relation-make-procs mf/rr))
                                  (reduction-relation-srcs mf/rr))])])
-      (when (for/and ([pat pats] [src srcs])
-              (with-handlers ([exn:fail:redex:generation-failure?
-                               ; Produce an error message that blames the LHS as a whole.
-                               (λ (_)
-                                 (raise-gen-fail what (format "LHS of ~a" src) retries))])
-                (check
-                 (lang-gen pat)
-                 prop
-                 attempts
-                 show
-                 #:source src
-                 #:match match
-                 #:match-fail match-fail)))
-        (show
-         (format "no counterexamples in ~a (with each clause)\n"
-                 (format-attempts attempts)))))))
+      (let loop ([pats pats] [srcs srcs])
+        (if (and (null? pats) (null? srcs))
+            (if show
+                (show
+                 (format "no counterexamples in ~a (with each clause)\n"
+                         (format-attempts attempts)))
+                #t)
+            (let ([c (with-handlers ([exn:fail:redex:generation-failure?
+                                      ; Produce an error message that blames the LHS as a whole.
+                                      (λ (_)
+                                        (raise-gen-fail what (format "LHS of ~a" (car srcs)) retries))])
+                       (check
+                        (lang-gen (car pats))
+                        prop
+                        attempts
+                        retries
+                        show
+                        #:source (car srcs)
+                        #:match match
+                        #:match-fail match-fail))])
+              (if (counterexample? c)
+                  (unless show c)
+                  (loop (cdr pats) (cdr srcs)))))))))
 
 (define-syntax (check-metafunction stx)
   (syntax-case stx ()
     [(_ name property . kw-args)
      (with-syntax ([m (metafunc/err #'name stx)]
-                   [(attempts retries custom)
+                   [(attempts retries print?) 
                     (parse-kw-args `((#:attempts . , #'default-check-attempts)
                                      (#:retries . ,#'default-retries)
-                                     (#:custm . ,#'defer-all))
+                                     (#:print? . #t))
                                    (syntax kw-args)
-                                   stx)]
-                   [show (show-message stx)])
-       (syntax/loc stx
-         (let ([att (assert-nat 'check-metafunction attempts)]
-               [ret (assert-nat 'check-metafunction retries)])
-           (check-lhs-pats 
-            (metafunc-proc-lang m)
-            m
-            (λ (term _) (property term))
-            (generation-decisions)
-            custom
-            att
-            ret
-            'check-metafunction
-            show))))]))
+                                   stx)])
+       (with-syntax ([show (show-message stx)])
+         (syntax/loc stx
+           (let ([att (assert-nat 'check-metafunction attempts)]
+                 [ret (assert-nat 'check-metafunction retries)])
+             (check-lhs-pats 
+              (metafunc-proc-lang m)
+              m
+              (λ (term _) (property term))
+              (generation-decisions)
+              att
+              ret
+              'check-metafunction
+              (and print? show))))))]))
 
 (define (reduction-relation-srcs r)
   (map (λ (proc) (or (rewrite-proc-name proc)
@@ -917,11 +887,11 @@
 (define-syntax (check-reduction-relation stx)
   (syntax-case stx ()
     [(_ relation property . kw-args)
-     (with-syntax ([(attempts retries decisions@ custom)
+     (with-syntax ([(attempts retries decisions@ print?)
                     (parse-kw-args `((#:attempts . , #'default-check-attempts)
                                      (#:retries . ,#'default-retries)
                                      (#:decisions . ,#'random-decisions@)
-                                     (#:custom . ,#'defer-all))
+                                     (#:print? . #t))
                                    (syntax kw-args)
                                    stx)]
                    [show (show-message stx)])
@@ -934,11 +904,10 @@
             rel
             (λ (term _) (property term))
             decisions@
-            custom
             attempts
             retries
             'check-reduction-relation
-            show))))]))
+            (and print? show)))))]))
 
 (define-signature decisions^
   (next-variable-decision
@@ -949,8 +918,7 @@
    next-non-terminal-decision
    next-sequence-decision
    next-any-decision
-   next-string-decision
-   next-pref-prods-decision))
+   next-string-decision))
 
 (define random-decisions@
   (unit (import) (export decisions^)
@@ -959,11 +927,10 @@
         (define (next-natural-decision) pick-natural)
         (define (next-integer-decision) pick-integer)
         (define (next-real-decision) pick-real)
-        (define (next-non-terminal-decision) pick-nt)
+        (define (next-non-terminal-decision) pick-nts)
         (define (next-sequence-decision) pick-sequence-length)
         (define (next-any-decision) pick-any)
-        (define (next-string-decision) pick-string)
-        (define (next-pref-prods-decision) pick-preferred-productions)))
+        (define (next-string-decision) pick-string)))
 
 (define generation-decisions (make-parameter random-decisions@))
 
@@ -979,18 +946,17 @@
          (struct-out class)
          (struct-out binder)
          (struct-out base-cases)
-         (struct-out pref-prods))
+         (struct-out counterexample)
+         (struct-out exn:fail:redex:test))
 
-(provide pick-from-list pick-sequence-length
-         pick-char pick-var pick-string 
-         pick-nt pick-any pick-preferred-productions
+(provide pick-from-list pick-sequence-length pick-nts
+         pick-char pick-var pick-string pick-any
          pick-number pick-natural pick-integer pick-real
          parse-pattern unparse-pattern
          parse-language prepare-lang
          class-reassignments reassign-classes
          default-retries proportion-at-size
-         preferred-production-threshold retry-threshold 
-         proportion-before-threshold post-threshold-incr
+         retry-threshold proportion-before-threshold post-threshold-incr
          is-nt? nt-by-name min-prods
          generation-decisions decisions^ 
          random-string
diff --git a/collects/redex/redex.scrbl b/collects/redex/redex.scrbl
index a66ca1287a..9d062200fb 100644
--- a/collects/redex/redex.scrbl
+++ b/collects/redex/redex.scrbl
@@ -1127,30 +1127,37 @@ metafunctions or unnamed reduction-relation cases) to application counts.}
            (values (covered-cases equals-coverage)
                    (covered-cases plus-coverage))))]
 
-@defform/subs[(generate-term language @#,ttpattern size-exp kw-args ...)
-              ([kw-args (code:line #:attempts attempts-expr)
+@defform*/subs[[(generate-term language @#,ttpattern size-expr kw-args ...)
+                (generate-term language @#,ttpattern)]
+              ([kw-args (code:line #:attempt-num attempts-expr)
                         (code:line #:retries retries-expr)])
               #:contracts ([size-expr natural-number/c]
                            [attempt-num-expr natural-number/c]
                            [retries-expr natural-number/c])]{
-Generates a random term matching @scheme[pattern] (in the given language).
+                                                             
+In its first form, @scheme[generate-term] produces a random term matching
+the given pattern (according to the given language). In its second, 
+@scheme[generate-term] produces a procedure for constructing the same.
+This procedure expects @scheme[size-expr] (below) as its sole positional
+argument and allows the same optional keyword arguments as the first form.
+The second form may be more efficient when generating many terms.
 
 The argument @scheme[size-expr] bounds the height of the generated term
-(measured as the height of the derivation tree used to produce
-the term). 
+(measured as the height of its parse tree). 
          
 The optional keyword argument @scheme[attempt-num-expr] 
 (default @scheme[1]) provides coarse grained control over the random
-decisions made during generation. For example, the expected length of 
-@pattech[pattern-sequence]s increases with @scheme[attempt-num-expr].
+decisions made during generation; increasing @scheme[attempt-num-expr]
+tends to increase the complexity of the result. For example, the expected
+length of @pattech[pattern-sequence]s increases with @scheme[attempt-num-expr].
 
 The random generation process does not actively consider the constraints
-imposed by @pattech[side-condition] or @tt{_!_} @|pattern|s when 
-constructing a term; instead, it tests the satisfaction of
-such constraints after it freely generates the relevant portion of the 
-sub-term---regenerating the sub-term if necessary. The optional keyword 
-argument @scheme[retries-expr] (default @scheme[100]) bounds the number of times that 
-@scheme[generate-term] retries the generation of any sub-term. If 
+imposed by @pattech[side-condition] or @tt{_!_} @|pattern|s; instead, 
+it uses a ``guess and check'' strategy in which it freely generates 
+candidate terms then tests whether they happen to satisfy the constraints,
+repeating as necessary. The optional keyword argument @scheme[retries-expr]
+(default @scheme[100]) bounds the number of times that 
+@scheme[generate-term] retries the generation of any pattern. If 
 @scheme[generate-term] is unable to produce a satisfying term after 
 @scheme[retries-expr] attempts, it raises an exception recognized by
 @scheme[exn:fail:redex:generation-failure?].}
@@ -1159,11 +1166,13 @@ argument @scheme[retries-expr] (default @scheme[100]) bounds the number of times
               ([kw-arg (code:line #:attempts attempts-expr)
                        (code:line #:source metafunction)
                        (code:line #:source relation-expr)
-                       (code:line #:retries retries-expr)])
+                       (code:line #:retries retries-expr)
+                       (code:line #:print? print?-expr)])
               #:contracts ([property-expr any/c]
                            [attempts-expr natural-number/c]
                            [relation-expr reduction-relation?]
-                           [retries-expr natural-number/c])]{
+                           [retries-expr natural-number/c]
+                           [print?-expr any/c])]{
 Searches for a counterexample to @scheme[property-expr], interpreted
 as a predicate universally quantified over the pattern variables
 bound by @scheme[pattern]. @scheme[redex-check] constructs and tests 
@@ -1173,8 +1182,18 @@ using the @scheme[match-bindings] produced by @scheme[match]ing
 @math{t} against @scheme[pattern].
 
 @scheme[redex-check] generates at most @scheme[attempts-expr] (default @scheme[1000])
-random terms in its search. The size and complexity of terms it generates
-gradually increases with each failed attempt.
+random terms in its search. The size and complexity of these terms increase with 
+each failed attempt. 
+
+When @scheme[print?-expr] produces any non-@scheme[#f] value (the default), 
+@scheme[redex-check] prints the test outcome on @scheme[current-output-port].
+When @scheme[print?-expr] produces @scheme[#f], @scheme[redex-check] prints
+nothing, instead 
+@itemlist[
+  @item{returning a @scheme[counterexample] structure when the test reveals a counterexample,}
+  @item{returning @scheme[#t] when all tests pass, or}
+  @item{raising a @scheme[exn:fail:redex:test] when checking the property raises an exception.}
+]
 
 When passed a metafunction or reduction relation via the optional @scheme[#:source]
 argument, @scheme[redex-check] distributes its attempts across the left-hand sides
@@ -1221,6 +1240,16 @@ term that does not match @scheme[pattern].}
           #:attempts 3
           #:source R))]
 
+@defstruct[counterexample ([term any/c])]{
+Produced by @scheme[redex-check], @scheme[check-reduction-relation], and 
+@scheme[check-metafunction] when testing falsifies a property.}
+
+@defstruct[(exn:fail:redex:test exn:fail:redex) ([source exn:fail?] [term any/c])]{
+Raised by @scheme[redex-check], @scheme[check-reduction-relation], and 
+@scheme[check-metafunction] when testing a property raises an exception.
+The @scheme[exn:fail:redex:test-source] component contains the exception raised by the property,
+and the @scheme[exn:fail:redex:test-term] component contains the term that induced the exception.}
+
 @defform/subs[(check-reduction-relation relation property kw-args ...)
               ([kw-arg (code:line #:attempts attempts-expr)
                        (code:line #:retries retries-expr)])
diff --git a/collects/redex/reduction-semantics.ss b/collects/redex/reduction-semantics.ss
index fc8a9ff9d0..ad0c601b0e 100644
--- a/collects/redex/reduction-semantics.ss
+++ b/collects/redex/reduction-semantics.ss
@@ -50,7 +50,9 @@
          check-metafunction
          check-metafunction-contract
          check-reduction-relation
-         exn:fail:redex:generation-failure?)
+         exn:fail:redex:generation-failure?
+         (struct-out exn:fail:redex:test)
+         (struct-out counterexample))
 
 (provide/contract
  [current-traced-metafunctions (parameter/c (or/c 'all (listof symbol?)))]
diff --git a/collects/redex/private/bitmap-test-util.ss b/collects/redex/tests/bitmap-test-util.ss
similarity index 79%
rename from collects/redex/private/bitmap-test-util.ss
rename to collects/redex/tests/bitmap-test-util.ss
index cf2dcada8d..468149ea02 100644
--- a/collects/redex/private/bitmap-test-util.ss
+++ b/collects/redex/tests/bitmap-test-util.ss
@@ -20,16 +20,15 @@
     [(_ test-exp bitmap-filename)
      #`(test/proc
         #,(syntax-line stx)
-        test-exp
+        (λ () test-exp)
         bitmap-filename)]))
 
-(define (test/proc line-number pict raw-bitmap-filename)
+(define (test/proc line-number pict-thunk raw-bitmap-filename)
   (set! tests (+ tests 1))
-  (let* ([bitmap-filename 
+  (let* ([pict (set-fonts/call pict-thunk)]
+         [bitmap-filename 
           (build-path (format "bmps-~a" (system-type))
-                      (case (system-type)
-                        [(unix) (string-append "unix-" raw-bitmap-filename)]
-                        [else raw-bitmap-filename]))]
+                      raw-bitmap-filename)]
          [old-bitmap (if (file-exists? bitmap-filename)
                          (make-object bitmap% bitmap-filename)
                          (let* ([bm (make-object bitmap% 100 20)]
@@ -39,8 +38,8 @@
                            (send bdc set-bitmap #f)
                            bm))]
          [new-bitmap (make-object bitmap% 
-                       (inexact->exact (pict-width pict)) 
-                       (inexact->exact (pict-height pict)))]
+                       (ceiling (inexact->exact (pict-width pict))) 
+                       (ceiling (inexact->exact (pict-height pict))))]
          [bdc (make-object bitmap-dc% new-bitmap)])
     (send bdc clear)
     (draw-pict pict bdc 0 0)
@@ -50,6 +49,33 @@
         (let ([failed-panel (make-failed-panel line-number bitmap-filename old-bitmap new-bitmap diff-bitmap)])
           (set! failed (append failed (list failed-panel))))))))
 
+(define (set-fonts/call thunk)
+  (case (system-type)
+    [(unix)
+     (let ([rewrite-style 
+            (λ (s)
+              (let loop ([s s])
+                (cond
+                  [(pair? s) (cons (loop (car s)) (loop (cdr s)))]
+                  [(eq? s 'roman) (verify-face " DejaVu Serif")]
+                  [(eq? s 'swiss) (verify-face " DejaVu Sans")]
+                  [else s])))])
+       (parameterize ([label-style (rewrite-style (label-style))]
+                      [literal-style (rewrite-style (literal-style))]
+                      [metafunction-style (rewrite-style (metafunction-style))]
+                      [non-terminal-style (rewrite-style (non-terminal-style))]
+                      [non-terminal-subscript-style (rewrite-style (non-terminal-subscript-style))]
+                      [non-terminal-superscript-style (rewrite-style (non-terminal-superscript-style))]
+                      [default-style (rewrite-style (default-style))])
+         (thunk)))]
+    [else
+     (thunk)]))
+
+(define (verify-face face)
+  (unless (member face (get-face-list))
+    (error 'verify-face "unknown face: ~s" face))
+  face)
+  
 (define (compute-diffs old-bitmap new-bitmap)
   (let* ([w (max (send old-bitmap get-width)
                  (send new-bitmap get-width))]
diff --git a/collects/redex/private/bitmap-test.ss b/collects/redex/tests/bitmap-test.ss
similarity index 100%
rename from collects/redex/private/bitmap-test.ss
rename to collects/redex/tests/bitmap-test.ss
diff --git a/collects/redex/private/bmps-macosx/extended-language.png b/collects/redex/tests/bmps-macosx/extended-language.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/extended-language.png
rename to collects/redex/tests/bmps-macosx/extended-language.png
diff --git a/collects/redex/private/bmps-macosx/extended-reduction-relation.png b/collects/redex/tests/bmps-macosx/extended-reduction-relation.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/extended-reduction-relation.png
rename to collects/redex/tests/bmps-macosx/extended-reduction-relation.png
diff --git a/collects/redex/private/bmps-macosx/language-nox.png b/collects/redex/tests/bmps-macosx/language-nox.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/language-nox.png
rename to collects/redex/tests/bmps-macosx/language-nox.png
diff --git a/collects/redex/private/bmps-macosx/language.png b/collects/redex/tests/bmps-macosx/language.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/language.png
rename to collects/redex/tests/bmps-macosx/language.png
diff --git a/collects/redex/private/bmps-macosx/lw.png b/collects/redex/tests/bmps-macosx/lw.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/lw.png
rename to collects/redex/tests/bmps-macosx/lw.png
diff --git a/collects/redex/private/bmps-macosx/metafunction-Name-vertical.png b/collects/redex/tests/bmps-macosx/metafunction-Name-vertical.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/metafunction-Name-vertical.png
rename to collects/redex/tests/bmps-macosx/metafunction-Name-vertical.png
diff --git a/collects/redex/private/bmps-macosx/metafunction-Name.png b/collects/redex/tests/bmps-macosx/metafunction-Name.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/metafunction-Name.png
rename to collects/redex/tests/bmps-macosx/metafunction-Name.png
diff --git a/collects/redex/private/bmps-macosx/metafunction-T.png b/collects/redex/tests/bmps-macosx/metafunction-T.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/metafunction-T.png
rename to collects/redex/tests/bmps-macosx/metafunction-T.png
diff --git a/collects/redex/private/bmps-macosx/metafunction-TL.png b/collects/redex/tests/bmps-macosx/metafunction-TL.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/metafunction-TL.png
rename to collects/redex/tests/bmps-macosx/metafunction-TL.png
diff --git a/collects/redex/private/bmps-macosx/metafunction-multi-arg.png b/collects/redex/tests/bmps-macosx/metafunction-multi-arg.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/metafunction-multi-arg.png
rename to collects/redex/tests/bmps-macosx/metafunction-multi-arg.png
diff --git a/collects/redex/private/bmps-macosx/metafunction-subst.png b/collects/redex/tests/bmps-macosx/metafunction-subst.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/metafunction-subst.png
rename to collects/redex/tests/bmps-macosx/metafunction-subst.png
diff --git a/collects/redex/private/bmps-macosx/metafunction.png b/collects/redex/tests/bmps-macosx/metafunction.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/metafunction.png
rename to collects/redex/tests/bmps-macosx/metafunction.png
diff --git a/collects/redex/private/bmps-macosx/metafunctions-multiple.png b/collects/redex/tests/bmps-macosx/metafunctions-multiple.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/metafunctions-multiple.png
rename to collects/redex/tests/bmps-macosx/metafunctions-multiple.png
diff --git a/collects/redex/private/bmps-macosx/red2.png b/collects/redex/tests/bmps-macosx/red2.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/red2.png
rename to collects/redex/tests/bmps-macosx/red2.png
diff --git a/collects/redex/private/bmps-macosx/reduction-relation.png b/collects/redex/tests/bmps-macosx/reduction-relation.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/reduction-relation.png
rename to collects/redex/tests/bmps-macosx/reduction-relation.png
diff --git a/collects/redex/private/bmps-macosx/superscripts.png b/collects/redex/tests/bmps-macosx/superscripts.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/superscripts.png
rename to collects/redex/tests/bmps-macosx/superscripts.png
diff --git a/collects/redex/private/bmps-macosx/unix-extended-language.png b/collects/redex/tests/bmps-macosx/unix-extended-language.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/unix-extended-language.png
rename to collects/redex/tests/bmps-macosx/unix-extended-language.png
diff --git a/collects/redex/private/bmps-macosx/unix-extended-reduction-relation.png b/collects/redex/tests/bmps-macosx/unix-extended-reduction-relation.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/unix-extended-reduction-relation.png
rename to collects/redex/tests/bmps-macosx/unix-extended-reduction-relation.png
diff --git a/collects/redex/private/bmps-macosx/unix-language-nox.png b/collects/redex/tests/bmps-macosx/unix-language-nox.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/unix-language-nox.png
rename to collects/redex/tests/bmps-macosx/unix-language-nox.png
diff --git a/collects/redex/private/bmps-macosx/unix-language.png b/collects/redex/tests/bmps-macosx/unix-language.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/unix-language.png
rename to collects/redex/tests/bmps-macosx/unix-language.png
diff --git a/collects/redex/private/bmps-macosx/unix-lw.png b/collects/redex/tests/bmps-macosx/unix-lw.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/unix-lw.png
rename to collects/redex/tests/bmps-macosx/unix-lw.png
diff --git a/collects/redex/private/bmps-macosx/unix-metafunction-Name-vertical.png b/collects/redex/tests/bmps-macosx/unix-metafunction-Name-vertical.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/unix-metafunction-Name-vertical.png
rename to collects/redex/tests/bmps-macosx/unix-metafunction-Name-vertical.png
diff --git a/collects/redex/private/bmps-macosx/unix-metafunction-Name.png b/collects/redex/tests/bmps-macosx/unix-metafunction-Name.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/unix-metafunction-Name.png
rename to collects/redex/tests/bmps-macosx/unix-metafunction-Name.png
diff --git a/collects/redex/private/bmps-macosx/unix-metafunction-T.png b/collects/redex/tests/bmps-macosx/unix-metafunction-T.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/unix-metafunction-T.png
rename to collects/redex/tests/bmps-macosx/unix-metafunction-T.png
diff --git a/collects/redex/private/bmps-macosx/unix-metafunction-TL.png b/collects/redex/tests/bmps-macosx/unix-metafunction-TL.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/unix-metafunction-TL.png
rename to collects/redex/tests/bmps-macosx/unix-metafunction-TL.png
diff --git a/collects/redex/private/bmps-macosx/unix-metafunction-multi-arg.png b/collects/redex/tests/bmps-macosx/unix-metafunction-multi-arg.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/unix-metafunction-multi-arg.png
rename to collects/redex/tests/bmps-macosx/unix-metafunction-multi-arg.png
diff --git a/collects/redex/private/bmps-macosx/unix-metafunction-subst.png b/collects/redex/tests/bmps-macosx/unix-metafunction-subst.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/unix-metafunction-subst.png
rename to collects/redex/tests/bmps-macosx/unix-metafunction-subst.png
diff --git a/collects/redex/private/bmps-macosx/unix-metafunction.png b/collects/redex/tests/bmps-macosx/unix-metafunction.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/unix-metafunction.png
rename to collects/redex/tests/bmps-macosx/unix-metafunction.png
diff --git a/collects/redex/private/bmps-macosx/unix-metafunctions-multiple.png b/collects/redex/tests/bmps-macosx/unix-metafunctions-multiple.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/unix-metafunctions-multiple.png
rename to collects/redex/tests/bmps-macosx/unix-metafunctions-multiple.png
diff --git a/collects/redex/private/bmps-macosx/unix-reduction-relation.png b/collects/redex/tests/bmps-macosx/unix-reduction-relation.png
similarity index 100%
rename from collects/redex/private/bmps-macosx/unix-reduction-relation.png
rename to collects/redex/tests/bmps-macosx/unix-reduction-relation.png
diff --git a/collects/redex/tests/bmps-unix/extended-language.png b/collects/redex/tests/bmps-unix/extended-language.png
new file mode 100644
index 0000000000..26cbf6fb00
Binary files /dev/null and b/collects/redex/tests/bmps-unix/extended-language.png differ
diff --git a/collects/redex/tests/bmps-unix/extended-reduction-relation.png b/collects/redex/tests/bmps-unix/extended-reduction-relation.png
new file mode 100644
index 0000000000..4980d31457
Binary files /dev/null and b/collects/redex/tests/bmps-unix/extended-reduction-relation.png differ
diff --git a/collects/redex/tests/bmps-unix/language-nox.png b/collects/redex/tests/bmps-unix/language-nox.png
new file mode 100644
index 0000000000..67452ef86a
Binary files /dev/null and b/collects/redex/tests/bmps-unix/language-nox.png differ
diff --git a/collects/redex/tests/bmps-unix/language.png b/collects/redex/tests/bmps-unix/language.png
new file mode 100644
index 0000000000..add73ae87a
Binary files /dev/null and b/collects/redex/tests/bmps-unix/language.png differ
diff --git a/collects/redex/tests/bmps-unix/lw.png b/collects/redex/tests/bmps-unix/lw.png
new file mode 100644
index 0000000000..39ff404613
Binary files /dev/null and b/collects/redex/tests/bmps-unix/lw.png differ
diff --git a/collects/redex/tests/bmps-unix/metafunction-Name-vertical.png b/collects/redex/tests/bmps-unix/metafunction-Name-vertical.png
new file mode 100644
index 0000000000..3698cfbc26
Binary files /dev/null and b/collects/redex/tests/bmps-unix/metafunction-Name-vertical.png differ
diff --git a/collects/redex/tests/bmps-unix/metafunction-Name.png b/collects/redex/tests/bmps-unix/metafunction-Name.png
new file mode 100644
index 0000000000..0271369025
Binary files /dev/null and b/collects/redex/tests/bmps-unix/metafunction-Name.png differ
diff --git a/collects/redex/tests/bmps-unix/metafunction-T.png b/collects/redex/tests/bmps-unix/metafunction-T.png
new file mode 100644
index 0000000000..9cf60cd64f
Binary files /dev/null and b/collects/redex/tests/bmps-unix/metafunction-T.png differ
diff --git a/collects/redex/tests/bmps-unix/metafunction-TL.png b/collects/redex/tests/bmps-unix/metafunction-TL.png
new file mode 100644
index 0000000000..a2f6291b00
Binary files /dev/null and b/collects/redex/tests/bmps-unix/metafunction-TL.png differ
diff --git a/collects/redex/tests/bmps-unix/metafunction-multi-arg.png b/collects/redex/tests/bmps-unix/metafunction-multi-arg.png
new file mode 100644
index 0000000000..f83b42b9c7
Binary files /dev/null and b/collects/redex/tests/bmps-unix/metafunction-multi-arg.png differ
diff --git a/collects/redex/tests/bmps-unix/metafunction-subst.png b/collects/redex/tests/bmps-unix/metafunction-subst.png
new file mode 100644
index 0000000000..8eb9e665c7
Binary files /dev/null and b/collects/redex/tests/bmps-unix/metafunction-subst.png differ
diff --git a/collects/redex/tests/bmps-unix/metafunction.png b/collects/redex/tests/bmps-unix/metafunction.png
new file mode 100644
index 0000000000..4c607c9c5a
Binary files /dev/null and b/collects/redex/tests/bmps-unix/metafunction.png differ
diff --git a/collects/redex/tests/bmps-unix/metafunctions-multiple.png b/collects/redex/tests/bmps-unix/metafunctions-multiple.png
new file mode 100644
index 0000000000..f162300418
Binary files /dev/null and b/collects/redex/tests/bmps-unix/metafunctions-multiple.png differ
diff --git a/collects/redex/tests/bmps-unix/red2.png b/collects/redex/tests/bmps-unix/red2.png
new file mode 100644
index 0000000000..585640772b
Binary files /dev/null and b/collects/redex/tests/bmps-unix/red2.png differ
diff --git a/collects/redex/tests/bmps-unix/reduction-relation.png b/collects/redex/tests/bmps-unix/reduction-relation.png
new file mode 100644
index 0000000000..09f92469fb
Binary files /dev/null and b/collects/redex/tests/bmps-unix/reduction-relation.png differ
diff --git a/collects/redex/tests/bmps-unix/superscripts.png b/collects/redex/tests/bmps-unix/superscripts.png
new file mode 100644
index 0000000000..51887d799f
Binary files /dev/null and b/collects/redex/tests/bmps-unix/superscripts.png differ
diff --git a/collects/redex/private/color-test.ss b/collects/redex/tests/color-test.ss
similarity index 100%
rename from collects/redex/private/color-test.ss
rename to collects/redex/tests/color-test.ss
diff --git a/collects/redex/private/config.ss b/collects/redex/tests/config.ss
similarity index 100%
rename from collects/redex/private/config.ss
rename to collects/redex/tests/config.ss
diff --git a/collects/redex/private/core-layout-test.ss b/collects/redex/tests/core-layout-test.ss
similarity index 97%
rename from collects/redex/private/core-layout-test.ss
rename to collects/redex/tests/core-layout-test.ss
index b1edc2bc72..a184bc77c1 100644
--- a/collects/redex/private/core-layout-test.ss
+++ b/collects/redex/tests/core-layout-test.ss
@@ -1,7 +1,7 @@
 #lang scheme/base
 
-(require "core-layout.ss"
-         "loc-wrapper.ss"
+(require "../private/core-layout.ss"
+         "../private/loc-wrapper.ss"
          "lw-test-util.ss"
          "test-util.ss"
          (lib "struct.ss"))
diff --git a/collects/redex/private/hole-test.ss b/collects/redex/tests/hole-test.ss
similarity index 100%
rename from collects/redex/private/hole-test.ss
rename to collects/redex/tests/hole-test.ss
diff --git a/collects/redex/private/keyword-macros-test.ss b/collects/redex/tests/keyword-macros-test.ss
similarity index 97%
rename from collects/redex/private/keyword-macros-test.ss
rename to collects/redex/tests/keyword-macros-test.ss
index ab3ddc8dbb..97491d3e9f 100644
--- a/collects/redex/private/keyword-macros-test.ss
+++ b/collects/redex/tests/keyword-macros-test.ss
@@ -1,6 +1,6 @@
 #lang scheme
 
-(require "keyword-macros.ss"
+(require "../private/keyword-macros.ss"
          "test-util.ss")
 
 (reset-count)
diff --git a/collects/redex/private/lw-test-util.ss b/collects/redex/tests/lw-test-util.ss
similarity index 96%
rename from collects/redex/private/lw-test-util.ss
rename to collects/redex/tests/lw-test-util.ss
index fb6e335dc4..a1dd92c934 100644
--- a/collects/redex/private/lw-test-util.ss
+++ b/collects/redex/tests/lw-test-util.ss
@@ -1,5 +1,5 @@
 (module lw-test-util mzscheme
-  (require "loc-wrapper.ss")
+  (require "../private/loc-wrapper.ss")
   (provide normalize-lw)
   
   (define (normalize-lw lw)
diff --git a/collects/redex/private/lw-test.ss b/collects/redex/tests/lw-test.ss
similarity index 99%
rename from collects/redex/private/lw-test.ss
rename to collects/redex/tests/lw-test.ss
index 109b17c9a5..89dd8babc2 100644
--- a/collects/redex/private/lw-test.ss
+++ b/collects/redex/tests/lw-test.ss
@@ -51,7 +51,7 @@
 
 (module lw-test mzscheme
   (require "test-util.ss"
-           "loc-wrapper.ss"
+           "../private/loc-wrapper.ss"
            "lw-test-util.ss")
   
   (reset-count)
diff --git a/collects/redex/private/matcher-test.ss b/collects/redex/tests/matcher-test.ss
similarity index 99%
rename from collects/redex/private/matcher-test.ss
rename to collects/redex/tests/matcher-test.ss
index 6866eae34a..640f6b20d8 100644
--- a/collects/redex/private/matcher-test.ss
+++ b/collects/redex/tests/matcher-test.ss
@@ -1,5 +1,5 @@
 (module matcher-test mzscheme
-  (require "matcher.ss"
+  (require "../private/matcher.ss"
            (only "test-util.ss" equal/bindings?)
            (lib "list.ss"))
   
diff --git a/collects/redex/private/pict-test.ss b/collects/redex/tests/pict-test.ss
similarity index 100%
rename from collects/redex/private/pict-test.ss
rename to collects/redex/tests/pict-test.ss
diff --git a/collects/redex/private/rg-test.ss b/collects/redex/tests/rg-test.ss
similarity index 83%
rename from collects/redex/private/rg-test.ss
rename to collects/redex/tests/rg-test.ss
index 307b595aa0..12c8571c1b 100644
--- a/collects/redex/private/rg-test.ss
+++ b/collects/redex/tests/rg-test.ss
@@ -1,12 +1,15 @@
 #lang scheme
 
 (require "test-util.ss"
-         "reduction-semantics.ss"
-         "matcher.ss"
-         "term.ss"
-         "rg.ss"
-         "keyword-macros.ss"
-         "error.ss")
+         "../private/reduction-semantics.ss"
+         "../private/matcher.ss"
+         "../private/term.ss"
+         "../private/rg.ss"
+         "../private/keyword-macros.ss"
+         "../private/error.ss")
+
+(define-namespace-anchor nsa)
+(define ns (namespace-anchor->namespace nsa))
 
 (reset-count)
 
@@ -111,23 +114,6 @@
   (test (pick-string lits 0 (make-random .5 1 0 1 1 1 2 1)) "abc")
   (test (pick-var lits 0 (make-random .01 1 0 1 1 1 2 1)) 'abc))
 
-(let ()
-  (define-language L
-    (a 5 (x a))
-    (b 4))
-  (test (pick-nt 'a #f L 1 'dontcare)
-        (nt-rhs (car (compiled-lang-lang L))))
-  (test (pick-nt 'a #f L preferred-production-threshold 'dontcare (make-random 1))
-        (nt-rhs (car (compiled-lang-lang L))))
-  (let ([pref (car (nt-rhs (car (compiled-lang-lang L))))])
-    (test (pick-nt 'a #f L preferred-production-threshold
-                   (make-pref-prods 'dont-care
-                                    (make-immutable-hash `((a ,pref))))
-                   (make-random 0))
-          (list pref)))
-  (test (pick-nt 'b #f L preferred-production-threshold #f)
-        (nt-rhs (cadr (compiled-lang-lang L)))))
-
 (define-syntax raised-exn-msg
   (syntax-rules ()
     [(_ expr) (raised-exn-msg exn:fail? expr)]
@@ -141,7 +127,7 @@
 
 (define (patterns . selectors) 
   (map (λ (selector) 
-         (λ (name cross? lang size pref-prods)
+         (λ (name cross? lang sizes)
            (list (selector (nt-rhs (nt-by-name lang name cross?))))))
        selectors))
 
@@ -158,15 +144,14 @@
   (test (raised-exn-msg (iter)) #rx"empty"))
 
 (define (decisions #:var [var pick-var] 
-                   #:nt [nt pick-nt]
+                   #:nt [nt pick-nts]
                    #:str [str pick-string]
                    #:num [num pick-number]
                    #:nat [nat pick-natural]
                    #:int [int pick-integer]
                    #:real [real pick-real]
                    #:any [any pick-any]
-                   #:seq [seq pick-sequence-length]
-                   #:pref [pref pick-preferred-productions])
+                   #:seq [seq pick-sequence-length])
   (define-syntax decision
     (syntax-rules ()
       [(_ d) (if (procedure? d) (λ () d) (iterator (quote d) d))]))
@@ -179,14 +164,13 @@
         (define next-real-decision (decision real))
         (define next-string-decision (decision str))
         (define next-any-decision (decision any))
-        (define next-sequence-decision (decision seq))
-        (define next-pref-prods-decision (decision pref))))
+        (define next-sequence-decision (decision seq))))
 
 (define-syntax generate-term/decisions
   (syntax-rules ()
     [(_ lang pat size attempt decisions)
      (parameterize ([generation-decisions decisions])
-       (generate-term lang pat size #:attempt attempt))]))
+       (generate-term lang pat size #:attempt-num attempt))]))
 
 (let ()
   (define-language lc
@@ -216,6 +200,17 @@
                #:var (list (λ _ 'x) (λ _ 'y))))
    '(x y)))
 
+(let ()
+  (define-language L
+    (n 1))
+  (test ((generate-term L n) 0) 1)
+  (test ((generate-term L n) 0 #:retries 0) 1)
+  (test ((generate-term L n) 0 #:attempt-num 0) 1)
+  (test (with-handlers ([exn:fail:syntax? exn-message])
+          (parameterize ([current-namespace ns])
+            (expand #'(generate-term M n))))
+        #rx"generate-term: expected a identifier defined by define-language( in: M)?$"))
+
 ;; variable-except pattern
 (let ()
   (define-language var
@@ -231,17 +226,17 @@
     (n natural)
     (i integer)
     (r real))
-  (test (let ([n (generate-term L n 0 #:attempt 10000)])
+  (test (let ([n (generate-term L n 0 #:attempt-num 10000)])
           (and (integer? n)
                (exact? n)
                (not (negative? n))))
         #t)
   (test (generate-term/decisions L n 0 1 (decisions #:nat (λ (_) 42))) 42)
-  (test (let ([i (generate-term L i 0 #:attempt 10000)])
+  (test (let ([i (generate-term L i 0 #:attempt-num 10000)])
           (and (integer? i) (exact? i)))
         #t)
   (test (generate-term/decisions L i 0 1 (decisions #:int (λ (_) -42))) -42)
-  (test (real? (generate-term L r 0 #:attempt 10000)) #t)
+  (test (real? (generate-term L r 0 #:attempt-num 10000)) #t)
   (test (generate-term/decisions L r 0 1 (decisions #:real (λ (_) 4.2))) 4.2))
 
 (let ()
@@ -539,77 +534,22 @@
       (get-output-string p)
       (close-output-port p))))
 
-;; preferred productions
-(let ([make-pick-nt (λ opt (λ req (apply pick-nt (append req opt))))])
-  (define-language L
-    (e (+ e e) (* e e) 7))
-  (define-language M (e 0) (e-e 1))
-  
-  (let ([pats (λ (L) (nt-rhs (car (compiled-lang-lang L))))])
-    (test 
-     (generate-term/decisions
-      L e 2 preferred-production-threshold
-      (decisions #:pref (list (λ (L) (make-pref-prods
-                                      'dont-care
-                                      (make-immutable-hash `((e ,(car (pats L))))))))
-                 #:nt (make-pick-nt (make-random 0 0 0))))
-     '(+ (+ 7 7) (+ 7 7)))
-    (test
-     (generate-term/decisions
-      L any 2 preferred-production-threshold
-      (decisions #:nt (patterns first)
-                 #:var (list (λ _ 'x))
-                 #:any (list (λ (lang sexp) (values sexp 'sexp)))))
-     'x)
-    (test
-     (generate-term/decisions
-      L any 2 preferred-production-threshold
-      (decisions #:pref (list (λ (L) (make-pref-prods
-                                      'dont-care
-                                      (make-immutable-hash `((e ,(car (pats L))))))))
-                 #:nt (make-pick-nt (make-random 0 0 0))
-                 #:any (list (λ (lang sexp) (values lang 'e)))))
-     '(+ (+ 7 7) (+ 7 7)))
-    (test
-     (generate-term/decisions
-      M (cross e) 2 preferred-production-threshold
-      (decisions #:nt (make-pick-nt (make-random) (λ (att rand) #t))))
-     (term hole))
-    (test
-     (generate-term/decisions
-      M e-e 2 preferred-production-threshold
-      (decisions #:nt (make-pick-nt (make-random) (λ (att rand) #t))))
-     1)
-    
-    (test
-     (let ([generated null])
-       (output
-        (λ ()
-          (check-reduction-relation
-           (reduction-relation L (--> e e))
-           (λ (t) (set! generated (cons t generated)))
-           #:decisions (decisions #:nt (make-pick-nt (make-random)
-                                                     (λ (att rand) #t))
-                                  #:pref (list (λ (_) 'dontcare)
-                                               (λ (_) 'dontcare)
-                                               (λ (_) 'dontcare)
-                                               ; size 0 terms prior to this attempt
-                                               (λ (L) (make-pref-prods
-                                                       'dont-care
-                                                       (make-immutable-hash `((e ,(car (pats L)))))))
-                                               (λ (L) (make-pref-prods
-                                                       'dont-care
-                                                       (make-immutable-hash `((e ,(cadr (pats L)))))))))
-           #:attempts 5)))
-       generated)
-     '((* 7 7) (+ 7 7) 7 7 7))))
-
 ;; redex-check
 (let ()
   (define-language lang
     (d 5)
     (e e 4)
     (n number))
+  
+  (test (redex-check lang d #t #:attempts 1 #:print? (not #t)) #t)
+  (test (counterexample-term (redex-check lang d #f #:print? #f)) 5)
+  (let ([exn (with-handlers ([exn:fail:redex:test? values])
+               (redex-check lang d (error 'boom ":(") #:print? #f)
+               'not-an-exn)])
+    (test (exn-message exn) "checking 5 raises an exception:\nboom: :(")
+    (test (exn-message (exn:fail:redex:test-source exn)) "boom: :(")
+    (test (exn:fail:redex:test-term exn) 5))
+  
   (test (output (λ () (redex-check lang d #f)))
         #rx"redex-check: .*:.*\ncounterexample found after 1 attempt:\n5\n")
   (test (output (λ () (redex-check lang d #t))) 
@@ -644,17 +584,29 @@
                                   (--> 0 dontcare z)))))
         #rx"counterexample found after 1 attempt with z:\n0\n")
   
-  (let ([generated null])
+  (let ([generated null]
+        [R (reduction-relation 
+            lang 
+            (--> 1 dontcare)
+            (--> 2 dontcare))])
     (test (output
            (λ ()
              (redex-check lang n (set! generated (cons (term n) generated)) 
                           #:attempts 5
-                          #:source (reduction-relation 
-                                    lang 
-                                    (--> 1 dontcare)
-                                    (--> 2 dontcare)))))
+                          #:source R)))
           #rx"no counterexamples.*with each clause")
-    (test generated '(2 2 1 1)))
+    (test generated '(2 2 1 1))
+    
+    (test (redex-check lang any #t 
+                       #:attempts 1 
+                       #:source R
+                       #:print? (not #t))
+          #t)
+    (test (counterexample-term
+           (redex-check lang any (= (term any) 1)
+                        #:source R
+                        #:print? #f))
+          2))
   
   (let ()
     (define-metafunction lang
@@ -665,7 +617,17 @@
              (redex-check lang (n) (eq? 42 (term n)) 
                           #:attempts 1
                           #:source mf)))
-          #px"counterexample found after 1 attempt with clause at .*:\\d+:\\d+:\n\\(0\\)\n"))
+          #px"counterexample found after 1 attempt with clause at .*:\\d+:\\d+:\n\\(0\\)\n")
+    (test (redex-check lang any #t 
+                       #:attempts 1 
+                       #:source mf
+                       #:print? (not #t))
+          #t)
+    (test (counterexample-term
+           (redex-check lang any (= (car (term any)) 42)
+                        #:source mf
+                        #:print? #f))
+          '(0)))
   
   (let ()
     (define-metafunction lang
@@ -790,6 +752,14 @@
     (E* hole E*)
     (n 4))
   
+  (let ([R (reduction-relation
+            L
+            (--> 1 2)
+            (--> 2 3))])
+    (test (check-reduction-relation R (λ (_) #t) #:print? #f) #t)
+    (test (counterexample-term (check-reduction-relation R (curry = 1) #:print? #f))
+          2))
+  
   (let ([generated null]
         [R (reduction-relation
             L
@@ -857,6 +827,11 @@
   (define-metafunction empty
     [(n (side-condition any #f)) any])
   
+  (test (check-metafunction m (λ (_) #t) #:print? #f) #t)
+  (test (counterexample-term
+         (check-metafunction m (compose (curry = 1) car) #:print? #f))
+        '(2))
+  
   (let ([generated null])
     (test (begin
             (output 
@@ -890,89 +865,6 @@
          (check-metafunction n (λ (_) #t) #:retries 42))
         #rx"check-metafunction: unable .* in 42"))
 
-;; custom generators
-(let ()
-  (define-language L
-    (x variable))
-  
-  (test
-   (generate-term 
-    L x_1 0
-    #:custom (λ (pat sz i-h acc env att rec def)
-               (match pat
-                 ['x (values 'x env)]
-                 [_ (def acc)])))
-   'x)
-  (test
-   (let/ec k
-     (equal?
-      (generate-term 
-       L (x x) 0
-       #:custom (let ([once? #f])
-                  (λ (pat sz i-h acc env att rec def)
-                    (match pat
-                      ['x (if once?
-                              (k #f)
-                              (begin
-                                (set! once? #t)
-                                (values 'x env)))]
-                      [_ (def acc)]))))
-      '(x x)))
-   #t)
-  
-  (test
-   (hash-ref
-    (let/ec k
-      (generate-term 
-       L (x (x)) 0
-       #:custom (λ (pat sz i-h acc env att rec def)
-                  (match pat
-                    [(struct binder ('x))
-                     (values 'y (hash-set env pat 'y))]
-                    [(list (struct binder ('x))) (k env)]
-                    [_ (def acc)]))))
-    (make-binder 'x))
-   'y)
-  
-  (test
-   (generate-term
-    L (in-hole hole 7) 0
-    #:custom (λ (pat sz i-h acc env att rec def)
-               (match pat
-                 [`(in-hole hole 7)
-                  (rec 'hole #:contractum 7)]
-                 [_ (def acc)])))
-   7)
-  
-  (test
-   (let/ec k
-     (generate-term 
-      L any 10
-      #:attempt 42
-      #:custom (λ (pat sz i-h acc env att rec def) (k (list sz att)))))
-   '(10 42))
-  
-  (test
-   (let/ec k
-     (generate-term 
-      L x 10
-      #:custom (λ (pat sz i-h acc env att rec def) 
-                 (match pat
-                   ['x (rec 7 #:size 0)]
-                   [7 (k sz)]
-                   [_ (def att)]))))
-   0)
-  
-  (test
-   (generate-term
-    L (q 7) 0
-    #:custom (λ (pat sz i-h acc env att rec def) 
-               (match pat
-                 ['q (rec '(7 7) #:acc 8)]
-                 [7 (values (or acc 7) env)]
-                 [_ (def att)])))
-   '((8 8) 7)))
-
 ;; parse/unparse-pattern
 (let-syntax ([test-match (syntax-rules () [(_ p x) (test (match x [p #t] [_ #f]) #t)])])
       (define-language lang (x variable))
diff --git a/collects/redex/private/run-tests.ss b/collects/redex/tests/run-tests.ss
similarity index 97%
rename from collects/redex/private/run-tests.ss
rename to collects/redex/tests/run-tests.ss
index 4ec5971dc6..46fe598acd 100644
--- a/collects/redex/private/run-tests.ss
+++ b/collects/redex/tests/run-tests.ss
@@ -5,7 +5,7 @@
          "config.ss"
          "test-util.ss")
 
-(set-show-bitmaps? #t)
+(set-show-bitmaps? #f)
 
 (define test-files
   '("lw-test.ss" 
diff --git a/collects/redex/private/term-test.ss b/collects/redex/tests/term-test.ss
similarity index 98%
rename from collects/redex/private/term-test.ss
rename to collects/redex/tests/term-test.ss
index 25059c7bbf..ba09d15627 100644
--- a/collects/redex/private/term-test.ss
+++ b/collects/redex/tests/term-test.ss
@@ -1,6 +1,6 @@
 (module term-test scheme
-  (require "term.ss"
-           "matcher.ss"
+  (require "../private/term.ss"
+           "../private/matcher.ss"
            "test-util.ss")
   
   (reset-count)
diff --git a/collects/redex/private/test-util.ss b/collects/redex/tests/test-util.ss
similarity index 98%
rename from collects/redex/private/test-util.ss
rename to collects/redex/tests/test-util.ss
index 491f32af3c..8c88e0ecb6 100644
--- a/collects/redex/private/test-util.ss
+++ b/collects/redex/tests/test-util.ss
@@ -1,6 +1,6 @@
 #lang scheme
 
-(require "matcher.ss"
+(require "../private/matcher.ss"
          errortrace/errortrace-lib
          errortrace/errortrace-key)
 (provide test test-syn-err tests reset-count
@@ -129,4 +129,4 @@
     (let ([p (read-syntax src (open-input-string (format "~s" sexp)))])
       (with-handlers ((exn:srclocs? (λ (x) (map srcloc-source ((exn:srclocs-accessor x) x)))))
         (expand p)
-        null)))
\ No newline at end of file
+        null)))
diff --git a/collects/redex/private/tl-test.ss b/collects/redex/tests/tl-test.ss
similarity index 99%
rename from collects/redex/private/tl-test.ss
rename to collects/redex/tests/tl-test.ss
index 8dd90a3884..c45255a96b 100644
--- a/collects/redex/private/tl-test.ss
+++ b/collects/redex/tests/tl-test.ss
@@ -1,9 +1,9 @@
 (module tl-test scheme
   (require "../reduction-semantics.ss"
            "test-util.ss"
-           (only-in "matcher.ss" make-bindings make-bind)
+           (only-in "../private/matcher.ss" make-bindings make-bind)
            scheme/match
-           "struct.ss")
+           "../private/struct.ss")
   
   (reset-count)
   
diff --git a/collects/repos-time-stamp/stamp.ss b/collects/repos-time-stamp/stamp.ss
index de7a62a627..7c85c06189 100644
--- a/collects/repos-time-stamp/stamp.ss
+++ b/collects/repos-time-stamp/stamp.ss
@@ -1 +1 @@
-#lang scheme/base (provide stamp) (define stamp "25jan2010")
+#lang scheme/base (provide stamp) (define stamp "28jan2010")
diff --git a/collects/scheme/sandbox.ss b/collects/scheme/sandbox.ss
index 8336322b00..d958780c51 100644
--- a/collects/scheme/sandbox.ss
+++ b/collects/scheme/sandbox.ss
@@ -1,6 +1,7 @@
 #lang scheme/base
 
 (require scheme/port
+         scheme/path
          scheme/list
          scheme/string
          syntax/moddep
@@ -444,7 +445,7 @@
       (cond [(and p (null? (cdr inps)))
              (port-count-lines! p)
              (parameterize ([current-input-port p])
-               (begin0 ((sandbox-reader) source)
+               (begin0 ((sandbox-reader) (or (object-name p) source))
                  ;; close a port if we opened it
                  (unless (eq? p (car inps)) (close-input-port p))))]
             [p (error 'input->code "ambiguous inputs: ~e" inps)]
@@ -550,11 +551,17 @@
                    (module->namespace `(quote ,(syntax-e mod)))))]
               [_else #f])])
     ;; the actual evaluation happens under the specified limits
-    ((limit-thunk (lambda ()
-                    (if (and (pair? program) (eq? 'begin (car program)))
-                      (eval* (cdr program))
-                      (eval program))
-                    (when ns (set! ns (ns))))))
+    (parameterize ([current-load-relative-directory
+                    (let* ([d (and (syntax? program) (syntax-source program))]
+                           [d (and (path-string? d) (path-only d))])
+                      (if (and d (directory-exists? d))
+                        d
+                        (current-load-relative-directory)))])
+      ((limit-thunk (lambda ()
+                      (if (and (pair? program) (eq? 'begin (car program)))
+                        (eval* (cdr program))
+                        (eval program))
+                      (when ns (set! ns (ns)))))))
     (when uncovered!
       (let ([get (let ([ns (current-namespace)])
                    (lambda () (eval '(get-uncovered-expressions) ns)))])
diff --git a/collects/scribble/tools/drscheme-buttons.ss b/collects/scribble/tools/drscheme-buttons.ss
index 31bc41be41..a40503e06c 100644
--- a/collects/scribble/tools/drscheme-buttons.ss
+++ b/collects/scribble/tools/drscheme-buttons.ss
@@ -40,7 +40,6 @@
                (dynamic-require 'scribble/run #f)
                (cond
                  [(equal? label "HTML")
-                  (system (format "firefox ~a" (path-replace-suffix name suffix)))
                   (send-url/file (path-replace-suffix fn suffix))]
                  [else (system (format "open ~a" (path-replace-suffix name suffix)))]))
              (message-box "Scribble" (get-output-string p) drs-frame))
diff --git a/collects/scribblings/gui/blurbs.ss b/collects/scribblings/gui/blurbs.ss
index 72800aaa37..a9210b9460 100644
--- a/collects/scribblings/gui/blurbs.ss
+++ b/collects/scribblings/gui/blurbs.ss
@@ -203,7 +203,7 @@ information@|details|, even if the editor currently has delayed refreshing (see
           monitor @|whatsit| changes.})
 
   (define (MonitorCallbackX a b c d)
-    (MonitorMethod a b @elem{the @|d|callback procedure (provided as an initialization argument)} c))
+    (MonitorMethod a b @elem{the @|d| callback procedure (provided as an initialization argument)} c))
 
   (define (MonitorCallback a b c)
     (MonitorCallbackX a b c "control"))
diff --git a/collects/scribblings/gui/editor-overview.scrbl b/collects/scribblings/gui/editor-overview.scrbl
index b19728ba53..b6b6e253ad 100644
--- a/collects/scribblings/gui/editor-overview.scrbl
+++ b/collects/scribblings/gui/editor-overview.scrbl
@@ -530,7 +530,7 @@ When an editor is loaded and a header/footer record is encountered,
  be loaded.
 
 See also @method[editor<%> write-headers-to-file] and
- @method[editor<%> write-headers-to-file].
+ @method[editor<%> read-header-from-file].
 
 
 @section[#:tag "editoreol"]{End of Line Ambiguity}
diff --git a/collects/scribblings/gui/radio-box-class.scrbl b/collects/scribblings/gui/radio-box-class.scrbl
index a9bc3275b7..17958e7aa7 100644
--- a/collects/scribblings/gui/radio-box-class.scrbl
+++ b/collects/scribblings/gui/radio-box-class.scrbl
@@ -28,7 +28,7 @@ Whenever the user changes the selected radio button, the radio box's
                                           'vertical-label 'horizontal-label 
                                           'deleted)) 
                         '(vertical)]
-                 [selection exact-nonnegative-integer? 0]
+                 [selection (or/c exact-nonnegative-integer? #f) 0]
                  [font (is-a?/c font%) normal-control-font]
                  [enabled any/c #t]
                  [vert-margin (integer-in 0 1000) 2]
@@ -64,8 +64,9 @@ The @scheme[style] argument must include either @scheme['vertical] for a
  @HVLabelNote[@scheme[style]]{radio box} @DeletedStyleNote[@scheme[style] @scheme[parent]]{radio box}
 
 By default, the first radio button is initially selected. If
- @scheme[selection] is positive, it is passed to @method[radio-box%
- set-selection] to set the initial radio button selection.
+ @scheme[selection] is positive or @scheme[#f], it is passed to
+ @method[radio-box% set-selection] to set the initial radio button
+ selection.
 
 @FontKWs[@scheme[font]] @WindowKWs[@scheme[enabled]] @SubareaKWs[] @AreaKWs[]
 
@@ -115,10 +116,10 @@ Returns the number of radio buttons in the radio box.
 }
 
 @defmethod[(get-selection)
-           exact-nonnegative-integer?]{
+           (or/c exact-nonnegative-integer? #f)]{
 
-Gets the position of the selected radio button. Radio buttons are
-numbered from @scheme[0].
+Gets the position of the selected radio button, returning @scheme[#f]
+if no button is selected. Radio buttons are numbered from @scheme[0].
 
 }
 
@@ -139,10 +140,11 @@ box, @|MismatchExn|.
 
 }
 
-@defmethod[(set-selection [n exact-nonnegative-integer?])
+@defmethod[(set-selection [n (or/c exact-nonnegative-integer? #f)])
            void?]{
 
-Sets the selected radio button by position. (The control's callback
+Sets the selected radio button by position, or deselects all radio
+ buttons if @scheme[n] is @scheme[#f]. (The control's callback
  procedure is @italic{not} invoked.) Radio buttons are numbered from
  @scheme[0]. If @scheme[n] is equal to or larger than the number of
  radio buttons in the radio box, @|MismatchExn|.
diff --git a/collects/scribblings/places/info.ss b/collects/scribblings/places/info.ss
new file mode 100644
index 0000000000..22fe7bf873
--- /dev/null
+++ b/collects/scribblings/places/info.ss
@@ -0,0 +1,3 @@
+#lang setup/infotab
+
+(define scribblings '(("places.scrbl" ())))
diff --git a/collects/scribblings/places/places.scrbl b/collects/scribblings/places/places.scrbl
new file mode 100644
index 0000000000..7c518458e1
--- /dev/null
+++ b/collects/scribblings/places/places.scrbl
@@ -0,0 +1,90 @@
+#lang scribble/doc
+
+@title{@bold{Places}: Coarse-grained Parallelism}
+
+@; ----------------------------------------------------------------------
+
+@(require scribble/manual
+          scribble/urls
+          scribble/struct
+          (for-label scheme
+                     scheme/base
+                     scheme/contract
+                     scheme/place))
+
+@; ----------------------------------------------------------------------
+
+The PLT futures API enables the development of parallel programs which
+take advantage of machines with multiple processors, cores, or
+hardware threads.
+
+@defmodule[scheme/place]{}
+
+@defproc[(place [module-path module-path?] [start-proc proc?] [place-channel place-ch?]) place?]{
+  Starts running @scheme[start-proc] in parallel. scheme[start-proc] must
+  be a function defined in @scheme[module-path].  The @scheme[place]
+  procedure returns immediately with a place descriptor value.
+}
+
+@defproc[(place-wait [p place?]) exact-integer?]{
+  Returns the return value of a completed place @scheme[p], blocking until
+  the place completes (if it has not already completed).
+}
+
+@defproc[(place? [x any/c]) boolean?]{
+  Returns @scheme[#t] if @scheme[x] is a place.
+}
+
+@defproc[(place-ch-send [ch place-ch?] [x any/c]) void]{
+  Sends an immutable message @scheme[x] on channel @scheme[ch].
+}
+
+@defproc[(place-ch-recv [p place-ch?]) any/c]{
+  Returns an immutable message received on channel @scheme[ch].
+}
+
+@defproc[(place-ch? [x any/c]) boolean?]{
+  Returns @scheme[#t] if @scheme[x] is a place-ch.
+}
+
+@section[#:tag "example"]{How Do I Keep Those Cores Busy?}
+
+This code launches two places passing 1 and 2 as the initial channels 
+and then waits for the places to complete and return.
+
+@schemeblock[
+    (let ((pls (map (lambda (x) (place "place_worker.ss" 'place-main x))
+                  (list 1 2))))
+       (map place-wait pls))
+]
+
+This is the code for the place_worker.ss module that each place will execute.
+
+@schemeblock[
+(module place_worker scheme
+  (provide place-main)
+
+  (define (place-main x)
+   (printf "IN PLACE ~a~n" x)))
+]
+
+
+@section[#:tag "messagepassingparallelism"]{Message Passing Parallelism}
+
+Places can only communicate by passing immutable messages on place-channels.
+
+@section[#:tag "logging"]{Architecture and Garbage Collection}
+
+Immutable messages communicated on place-channels are first copied to a shared
+garbage collector called the master.  The master waits on a barrier until all places garbage
+collectors have collected.  Once the master is released it collects and resets
+the barrier.
+
+@section[#:tag "compiling"]{Enabling Places in MzScheme Builds}
+
+PLT's parallel-places support is only enabled if you pass
+@DFlag{enable-places} to @exec{configure} when you build PLT (and
+that build currently only works with @exec{mzscheme}, not with
+@exec{mred}). When parallel-future support is not enabled,
+@scheme[place] usage is a syntax error.
+@; @FIXME{use threads to emulate places maybe?}
diff --git a/collects/scribblings/reference/sandbox.scrbl b/collects/scribblings/reference/sandbox.scrbl
index e36db71e3b..7148aea2e2 100644
--- a/collects/scribblings/reference/sandbox.scrbl
+++ b/collects/scribblings/reference/sandbox.scrbl
@@ -811,7 +811,7 @@ in a way that depends on the setting of @scheme[(sandbox-output)] or
 
 Retrieves uncovered expression from an evaluator, as longs as the
 @scheme[sandbox-coverage-enabled] parameter had a true value when the
-evaluator was created. Otherwise, and exception is raised to indicate
+evaluator was created. Otherwise, an exception is raised to indicate
 that no coverage information is available.
 
 The @scheme[prog?] argument specifies whether to obtain expressions that
diff --git a/collects/setup/scribble.ss b/collects/setup/scribble.ss
index 1cb1e5ebe2..6f2baa92b3 100644
--- a/collects/setup/scribble.ss
+++ b/collects/setup/scribble.ss
@@ -427,10 +427,11 @@
                                  (memq 'depends-all-main (doc-flags doc)))
                             (and auto-user?
                                  (memq 'depends-all (doc-flags doc)))))])
-    (setup-printf 
-     (cond [up-to-date? "using"] [can-run? "running"] [else "skipping"])
-     "~a"
-     (path->name (doc-src-file doc)))
+    (when (or (not up-to-date?) (verbose))
+      (setup-printf 
+       (cond [up-to-date? "using"] [can-run? "running"] [else "skipping"])
+       "~a"
+       (path->name (doc-src-file doc))))
     (if up-to-date?
       ;; Load previously calculated info:
       (render-time
diff --git a/collects/syntax/parse/experimental.ss b/collects/syntax/parse/experimental.ss
new file mode 100644
index 0000000000..90ca5cdf76
--- /dev/null
+++ b/collects/syntax/parse/experimental.ss
@@ -0,0 +1,94 @@
+#lang scheme/base
+(require (for-syntax scheme/base
+                     syntax/parse
+                     syntax/private/stxparse/rep-data))
+(provide define-primitive-splicing-syntax-class)
+
+(define-syntax (define-primitive-splicing-syntax-class stx)
+
+  (define-syntax-class attr
+    (pattern name:id
+             #:with depth #'0)
+    (pattern [name:id depth:nat]))
+
+  (syntax-parse stx
+    [(dssp (name:id param:id ...)
+       (~or (~once (~seq #:attrs (a:attr ...))
+                   #:name "attributes declaration")
+            (~once (~seq #:description description)
+                   #:name "description declaration")) ...
+       proc:expr)
+     #'(begin
+         (define (get-description param ...)
+           description)
+         (define parser
+           (lambda (stx param ...)
+             (let/ec escape
+               ((mk-check-result 'name '(a.name ...) stx)
+                (proc stx
+                      (lambda ([msg #f])
+                        (escape
+                         (if msg
+                             `#s(expect:message ,msg)
+                             `#s(expect:thing
+                                 ,(get-description param ...) #f #f)))))))))
+         (define-syntax name
+           (make-stxclass 'name '(param ...)
+                          '(#s(attr a.name a.depth #f) ...)
+                          (quote-syntax parser)
+                          (quote-syntax get-description)
+                          #t)))]))
+
+
+(define (mk-check-result name attr-names stx)
+  (lambda (result)
+    (unless (list? result)
+      (error name "parser returned non-list"))
+    (let ([rlength (length result)])
+      (unless (= rlength (+ 2 (length attr-names)))
+        (error name "parser returned list of wrong length; expected length ~s, got ~e"
+               (+ 2 (length attr-names))
+               result))
+      (unless (exact-nonnegative-integer? (cadr result))
+        (error name "expected exact nonnegative integer for second element of result list, got ~e"
+               (cadr result)))
+      (list* (car result)
+             (nat->dfc (cadr result) stx)
+             (cddr result)))))
+
+(define (nat->dfc nat stx)
+  (if (zero? nat)
+      `#s(dfc:empty ,stx)
+      `#s(dfc:cdr #s(dfc:empty ,stx) ,nat)))
+
+
+#|
+
+(define-primitive-splicing-syntax-class (name param ...)
+  #:attrs (attr-decl ...)
+  #:description description-expr
+  proc)
+
+'proc' must take two arguments, 'stx' and 'fail', where 'fail' is an
+escaping procedure that indicates failure. 'fail' takes an optional
+argument, an error message to attach to the failure. If no message is
+given, the syntax class description is used.
+
+'proc' must return a list of 2+|attrs| elements. The first element is
+the rest of the input syntax. The second element is the number of
+elements consumed from the input. The rest are the attribute values,
+in the same order as given in the #:attrs directive.
+
+Example:
+
+(define-primitive-splicing-syntax-class (a-expr)
+  #:attrs (x)
+  #:description "a-expr"
+  (lambda (stx fail)
+    (syntax-case stx ()
+      [(a b c . rest)
+       (list #'rest 3 #'(printf "got an A\n"))]
+      [_
+       (fail)])))
+
+|#
diff --git a/collects/tests/mred/item.ss b/collects/tests/mred/item.ss
index 4dd6fd1bfb..f9ff3383b2 100644
--- a/collects/tests/mred/item.ss
+++ b/collects/tests/mred/item.ss
@@ -1299,6 +1299,7 @@
   (define mismatch-err (mk-err exn:fail:contract?))
 
   (define do-sel (lambda (sel n) (for-each (lambda (rb) (sel rb (n rb))) rbs)))
+  (define sel-false (lambda (sel) (do-sel sel (lambda (rb) #f))))
   (define sel-minus (lambda (sel) (do-sel (type-err sel) (lambda (rb) -1))))
   (define sel-first (lambda (sel) (do-sel sel (lambda (rb) 0))))
   (define sel-middle (lambda (sel) (do-sel sel (lambda (rb) (floor (/ (send rb get-number) 2))))))
@@ -1311,7 +1312,9 @@
     (make-object button% (format "Select First~a" title) hp2 (lambda (b e) (sel-first sel)))
     (make-object button% (format "Select Middle ~a" title) hp2 (lambda (b e) (sel-middle sel)))
     (make-object button% (format "Select Last~a" title) hp2 (lambda (b e) (sel-last sel)))
-    (make-object button% (format "Select N~a" title) hp2 (lambda (b e) (sel-N sel))))
+    (make-object button% (format "Select N~a" title) hp2 (lambda (b e) (sel-N sel)))
+    (when (equal? title "")
+      (make-object button% (format "Select #f~a" title) hp2 (lambda (b e) (sel-false sel)))))
   (make-selectors "" normal-sel)
   (make-selectors " by Simulate" simulate-sel)
   (make-object button% "Check" p
diff --git a/collects/tests/mzscheme/benchmarks/common/auto.ss b/collects/tests/mzscheme/benchmarks/common/auto.ss
index f3ad8439f5..a532255f51 100755
--- a/collects/tests/mzscheme/benchmarks/common/auto.ss
+++ b/collects/tests/mzscheme/benchmarks/common/auto.ss
@@ -3,6 +3,8 @@
 exec mzscheme -qu "$0" ${1+"$@"}
 |#
 
+;; See "tabulate.ss" for information on the output format
+
 (module auto scheme/base
   (require (for-syntax scheme/base)
            mzlib/process
@@ -11,6 +13,8 @@ exec mzscheme -qu "$0" ${1+"$@"}
            mzlib/compile
            mzlib/inflate
            mzlib/date
+           mzlib/port
+           mzlib/file
            dynext/file
            syntax/toplevel
            scheme/runtime-path)
@@ -34,10 +38,16 @@ exec mzscheme -qu "$0" ${1+"$@"}
     (delete-file (format "~a.o1" bm)))
 
   (define (mk-mzscheme bm)
-    ;; To get compilation time:
-    (parameterize ([current-namespace (make-base-namespace)])
-      (namespace-require 'scheme/base)
-      (load (format "~a.ss" bm))))
+    (unless (directory-exists? "compiled")
+      (make-directory "compiled"))
+    (parameterize ([current-namespace (make-base-namespace)]
+                   [read-accept-reader #t])
+      (let ([name (format "~a.ss" bm)])
+        (compile-file name
+                      (build-path "compiled" (path-add-suffix name #".zo"))))))
+
+  (define (clean-up-zo bm)
+    (delete-directory/files "compiled"))
 
   (define (clean-up-nothing bm)
     (void))
@@ -71,21 +81,24 @@ exec mzscheme -qu "$0" ${1+"$@"}
       (eval '(define null #f)) ; for dynamic.sch
       (compile-file (format "~a.sch" bm))))
 
-  (define (clean-up-zo bm)
-    (delete-file (build-path "compiled" (format "~a.zo" bm))))
+  (define (setup-larceny bm)
+    (setup-sps bm "(larceny benchmarking)"))
 
   (define (mk-larceny bm)
     (parameterize ([current-input-port 
 		    (open-input-string
 		     (format (string-append
-			      "(compiler-switches 'fast-safe)\n"
-			      "(compile-file \"~a.sch\")\n")
+			      "(import (larceny compiler))\n"
+			      "(compile-library \"~a.sls\")\n")
 			     bm))]
 		   [current-output-port (open-output-bytes)])
-      (system "larceny")))
+      (system "larceny -err5rs")
+      ;; Make sure compiled version is used:
+      (delete-file (format "~a.sls" bm))))
 
   (define (clean-up-fasl bm)
-    (delete-file (format "~a.fasl" bm)))
+    (clean-up-sps bm)
+    (delete-file (format "~a.slfasl" bm)))
 
   (define (mk-mzc bm)
     (parameterize ([current-output-port (open-output-bytes)])
@@ -104,16 +117,45 @@ exec mzscheme -qu "$0" ${1+"$@"}
     (system (format "gsi -:d-,m10000 ~a.o1" bm)))
 
   (define (run-larceny bm)
-    (parameterize ([current-input-port (open-input-string
-                                        (format "(load \"~a.fasl\")\n"
-                                                bm))])
-      (system "larceny")))
+    (system "larceny -r6rs -program prog.sps -path ."))
 
+  (define (setup-sps bm lib)
+    (with-output-to-file "prog.sps"
+      #:exists 'truncate
+      (lambda ()
+        (printf "(import (~a))\n" bm)
+        (printf "(bm-!-go)\n")))
+    (with-output-to-file (format "~a.sls" bm)
+      #:exists 'truncate
+      (lambda ()
+        (printf "(library (~a)\n" bm)
+        (printf " (export bm-!-go)\n")
+        (printf " (import (rnrs) (rnrs mutable-pairs) (rnrs mutable-strings) (rnrs r5rs) (rnrs eval) ~a)\n" lib)
+        (printf " (define (bm-!-go) 'ok)\n")
+        (call-with-input-file (format "~a.sch" bm)
+          (lambda (in)
+            (copy-port in (current-output-port))))
+        (printf ")\n"))))
+
+  (define (clean-up-sps bm)
+    (delete-file "prog.sps")
+    (let ([f (format "~a.sls" bm)])
+      (when (file-exists? f)
+        (delete-file f))))
+
+  (define (setup-ikarus bm)
+    (setup-sps bm "(ikarus)")
+    (system "rm -rf ~/.ikarus"))
+  
   (define (mk-ikarus bm)
-    (void))
+    (system "ikarus --compile-dependencies prog.sps"))
 
   (define (run-ikarus bm)
-    (system (format "ikarus ~a.sch < /dev/null" bm)))
+    (system "ikarus --r6rs-script prog.sps"))
+
+  (define (clean-up-ikarus bm)
+    (clean-up-sps bm)
+    (system "rm -rf ~/.ikarus"))
 
   (define (extract-times bm str)
     str)
@@ -134,6 +176,15 @@ exec mzscheme -qu "$0" ${1+"$@"}
     (let ([m (regexp-match #rx#"cpu time: ([0-9]+) real time: ([0-9]+) gc time: ([0-9]+)" str)])
       (map bytes->number (cdr m))))
 
+  (define (extract-bigloo-times bm str)
+    (let ([m (regexp-match #rx#"real: ([0-9]+) sys: ([0-9]+) user: ([0-9]+)" str)]
+          ;; `time' result is 10s of milliseconds? OS ticks, maybe?
+          [msec/tick 10])
+      (list (* msec/tick (+ (bytes->number (caddr m))
+                            (bytes->number (cadddr m))))
+            (* msec/tick (bytes->number (cadr m)))
+            0)))
+
   (define (extract-larceny-times bm str)
     (let ([m (regexp-match #rx#"Elapsed time...: ([0-9]+) ms.*Elapsed GC time: ([0-9]+) ms" str)])
       (list (bytes->number (cadr m))
@@ -162,14 +213,16 @@ exec mzscheme -qu "$0" ${1+"$@"}
                             #"([0-9]*) ms elapsed cpu time, including ([0-9]*) ms collecting\n"
                             #"[ \t]*([0-9]*) ms elapsed real time")
                            str)])
-      (list (string->number (bytes->string/utf-8 (cadr m)))
-            (string->number (bytes->string/utf-8 (cadddr m)))
-            (string->number (bytes->string/utf-8 (caddr m))))))
+      (if m
+          (list (string->number (bytes->string/utf-8 (cadr m)))
+                (string->number (bytes->string/utf-8 (cadddr m)))
+                (string->number (bytes->string/utf-8 (caddr m))))
+          (list #f #f #f))))
 
 
   ;; Table of implementatons and benchmarks ------------------------------
 
-  (define-struct impl (name make run extract-result clean-up skips))
+  (define-struct impl (name setup make run extract-result clean-up skips))
 
   (define mutable-pair-progs '(conform
                                destruct
@@ -183,34 +236,39 @@ exec mzscheme -qu "$0" ${1+"$@"}
   (define impls
     (list
      (make-impl 'mzscheme
+                void
                 mk-mzscheme
                 (lambda (bm)
                   (system (format "mzscheme -u ~a.ss" bm)))
                 extract-mzscheme-times
-                clean-up-nothing
+                clean-up-zo
                 mutable-pair-progs)
      (make-impl 'mz-old
+                void
                 mk-mzscheme
                 (lambda (bm)
                   (system (format "mz-old -u ~a.ss" bm)))
                 extract-mzscheme-times
-                clean-up-nothing
+                clean-up-zo
                 mutable-pair-progs)
      (make-impl 'mzschemecgc
+                void
                 mk-mzscheme
                 (lambda (bm)
                   (system (format "mzschemecgc -u ~a.ss" bm)))
                 extract-mzscheme-times
-                clean-up-nothing
+                clean-up-zo
                 mutable-pair-progs)
      (make-impl 'mzscheme3m
+                void
                 mk-mzscheme
                 (lambda (bm)
                   (system (format "mzscheme3m -u ~a.ss" bm)))
                 extract-mzscheme-times
-                clean-up-nothing
+                clean-up-zo
                 mutable-pair-progs)
      (make-impl 'plt-r5rs
+                void
                 mk-plt-r5rs
                 (lambda (bm)
                   (system (format "plt-r5rs ~a.scm" bm)))
@@ -218,6 +276,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
                 clean-up-plt-r5rs
                 null)
      (make-impl 'mzc
+                void
                 mk-mzc
                 (lambda (bm)
                   (system (format "mzscheme -mvqee '(load-extension \"~a\")' '(require ~a)'" 
@@ -228,20 +287,23 @@ exec mzscheme -qu "$0" ${1+"$@"}
                 (append '(takr takr2)
                         mutable-pair-progs))
      (make-impl 'mzscheme-j
+                void
                 mk-mzscheme
                 (lambda (bm)
                   (system (format "mzscheme -jqu ~a.ss" bm)))
                 extract-mzscheme-times
-                clean-up-nothing
+                clean-up-zo
                 mutable-pair-progs)
      (make-impl 'mzschemecgc-j
+                void
                 mk-mzscheme
                 (lambda (bm)
                   (system (format "mzschemecgc -jqu ~a.ss" bm)))
                 extract-mzscheme-times
-                clean-up-nothing
+                clean-up-zo
                 mutable-pair-progs)
      (make-impl 'mzschemecgc-tl
+                void
                 mk-mzscheme-tl
                 (lambda (bm)
                   (system (format "mzschemecgc -qr compiled/~a.zo" bm)))
@@ -250,37 +312,42 @@ exec mzscheme -qu "$0" ${1+"$@"}
                 (append '(nucleic2)
                         mutable-pair-progs))
      (make-impl 'chicken
+                void
                 (run-mk "mk-chicken.ss")
                 run-exe
                 extract-chicken-times
                 clean-up-bin
-                '(nucleic2))
+                '(scheme2 takr2))
      (make-impl 'bigloo
+                void
                 (run-mk "mk-bigloo.ss")
-                run-exe/time
-                extract-time-times
+                run-exe
+                extract-bigloo-times
                 clean-up-bin
-                '(cpstack maze maze2 puzzle triangle))
+                '(cpstack takr2))
      (make-impl 'gambit
+                void
                 (run-mk "mk-gambit.ss")
                 run-gambit-exe
                 extract-gambit-times
                 clean-up-o1
                 '(nucleic2))
      (make-impl 'larceny
+                setup-larceny
                 mk-larceny
                 run-larceny
                 extract-larceny-times
                 clean-up-fasl
                 '())
      (make-impl 'ikarus
+                setup-ikarus
                 mk-ikarus
                 run-ikarus
                 extract-ikarus-times
-                clean-up-nothing
-                '(fft))))
+                clean-up-ikarus
+                '(takr))))
 
-  (define obsolte-impls '(mzscheme mzscheme-j mzschemecgc-tl mzc mz-old))
+  (define obsolte-impls '(mzscheme3m mzschemecgc mzscheme-j mzschemecgc-j mzschemecgc-tl mzc mz-old))
 
   (define benchmarks
     '(conform
@@ -303,6 +370,7 @@ exec mzscheme -qu "$0" ${1+"$@"}
       nboyer
       nestedloop
       nfa
+      nothing
       nqueens
       nucleic2
       paraffins
@@ -329,23 +397,25 @@ exec mzscheme -qu "$0" ${1+"$@"}
                     impls)])
       (if (memq bm (impl-skips i))
           (rprintf "[~a ~a ~s #f]\n" impl bm '(#f #f #f))
-          (let ([start (current-inexact-milliseconds)])
-            ((impl-make i) bm)
-            (let ([end (current-inexact-milliseconds)])
-              (let loop ([n num-iterations])
-                (unless (zero? n)
-                  (let ([out (open-output-bytes)])
-                    (unless (parameterize ([current-output-port out]
-                                           [current-error-port out])
-                              ((impl-run i) bm))
-                      (error 'auto "~a\nrun failed ~a" (get-output-bytes out) bm))
-                    (rprintf "[~a ~a ~s ~a]\n"
-                            impl
-                            bm
-                            ((impl-extract-result i) bm (get-output-bytes out))
-                            (inexact->exact (round (- end start)))))
-                  (loop (sub1 n)))))
-            ((impl-clean-up i) bm)))
+          (begin
+            ((impl-setup i) bm)
+            (let ([start (current-inexact-milliseconds)])
+              ((impl-make i) bm)
+              (let ([end (current-inexact-milliseconds)])
+                (let loop ([n num-iterations])
+                  (unless (zero? n)
+                    (let ([out (open-output-bytes)])
+                      (unless (parameterize ([current-output-port out]
+                                             [current-error-port out])
+                                ((impl-run i) bm))
+                        (error 'auto "~a\nrun failed ~a" (get-output-bytes out) bm))
+                      (rprintf "[~a ~a ~s ~a]\n"
+                               impl
+                               bm
+                               ((impl-extract-result i) bm (get-output-bytes out))
+                               (inexact->exact (round (- end start)))))
+                    (loop (sub1 n)))))
+              ((impl-clean-up i) bm))))
       (flush-output)))
 
   ;; Extract command-line arguments --------------------
diff --git a/collects/tests/mzscheme/benchmarks/common/bigloo-prelude.sch b/collects/tests/mzscheme/benchmarks/common/bigloo-prelude.sch
index c0bc43003d..edb17f65ff 100644
--- a/collects/tests/mzscheme/benchmarks/common/bigloo-prelude.sch
+++ b/collects/tests/mzscheme/benchmarks/common/bigloo-prelude.sch
@@ -1,9 +1,16 @@
+(define orig-time time)
+
 (define-macro (time expr)
   `(time-it (lambda () ,expr)))
 
 (define (time-it thunk)
-  (thunk))
+  (multiple-value-bind (res rtime stime utime)
+   (orig-time thunk)
+   (print "real: " rtime " sys: " stime " user: " utime)
+   res))
 
 (define (error . x) #f)
 
-
+(define bitwise-or bit-or)
+(define bitwise-and bit-and)
+(define bitwise-not bit-not)
diff --git a/collects/tests/mzscheme/benchmarks/common/dderiv.sch b/collects/tests/mzscheme/benchmarks/common/dderiv.sch
index bc01d9cac7..5e47a0b037 100644
--- a/collects/tests/mzscheme/benchmarks/common/dderiv.sch
+++ b/collects/tests/mzscheme/benchmarks/common/dderiv.sch
@@ -46,19 +46,13 @@
 (define (f+dderiv a)
   (cons '+ (map dderiv a)))
  
-(put '+ 'dderiv f+dderiv)    ; install procedure on the property list
- 
 (define (f-dderiv a)
   (cons '- (map dderiv a)))
  
-(put '- 'dderiv f-dderiv)    ; install procedure on the property list
- 
 (define (*dderiv a)
   (list '* (cons '* a)
         (cons '+ (map dderiv-aux a))))
  
-(put '* 'dderiv *dderiv)    ; install procedure on the property list
- 
 (define (/dderiv a)
   (list '-
         (list '/
@@ -71,8 +65,6 @@
                     (cadr a)
                     (dderiv (cadr a))))))
  
-(put '/ 'dderiv /dderiv)    ; install procedure on the property list
- 
 (define (dderiv a)
   (cond
     ((not (pair? a))
@@ -90,6 +82,14 @@
     (dderiv '(+ (* 3 x x) (* a x x) (* b x) 5))
     (dderiv '(+ (* 3 x x) (* a x x) (* b x) 5))))
  
+(put '+ 'dderiv f+dderiv)    ; install procedure on the property list
+ 
+(put '- 'dderiv f-dderiv)    ; install procedure on the property list
+ 
+(put '* 'dderiv *dderiv)    ; install procedure on the property list
+ 
+(put '/ 'dderiv /dderiv)    ; install procedure on the property list
+ 
 ;;; call:  (run)
  
 (time (run))
diff --git a/collects/tests/mzscheme/benchmarks/common/gambit-prelude.sch b/collects/tests/mzscheme/benchmarks/common/gambit-prelude.sch
index 26f69d687a..bb9f3cc061 100644
--- a/collects/tests/mzscheme/benchmarks/common/gambit-prelude.sch
+++ b/collects/tests/mzscheme/benchmarks/common/gambit-prelude.sch
@@ -5,3 +5,4 @@
   (safe)
   (interrupts-enabled)
 )
+
diff --git a/collects/tests/mzscheme/benchmarks/common/index-template.html b/collects/tests/mzscheme/benchmarks/common/index-template.html
index ac12dd642c..65db9ac8d1 100644
--- a/collects/tests/mzscheme/benchmarks/common/index-template.html
+++ b/collects/tests/mzscheme/benchmarks/common/index-template.html
@@ -4,45 +4,55 @@
 
 <H1>About the Benchmarks</H1>
 
-<p>The pages linked below show some benchmark results on a collection of fairly standard
+<p>The <a href="Benchmarks.html">benchmark page</a> shows some benchmark results on a collection of fairly standard
    (mostly Gabriel) Scheme benchmarks.</p>
 
-<p>Tables show relative performance, with the actual time for the fastest
-   run shown on the left. So, by default, <font color=forestgreen><b>1</b></font> 
-   is the fastest, but select any implementation to normalize the table with
-   respect to that implementation's speed. A <tt>--</tt> appears when a benchmark
-   didn't run in an implementation (and you should assume a benchmark problem,
-   rather than an implementation problem).</p>
+<p>Tables show relative performance, with the actual time for the
+   fastest run shown on the left. So, by
+   default, <font color=forestgreen><b>1</b></font> is the fastest,
+   but select any implementation to normalize the table with respect
+   to that implementation's speed. A <tt>-</tt> appears when a
+   benchmark didn't run in an implementation for some reason (possibly
+   not a good one).</p>
 
-<p><font color="gray" size="-1">Small gray numbers are (relative) compile times.</font></p>
+<p><font color="gray" size="-1">Small gray numbers are (relative)
+compile times, where the compile time for the <tt>nothing</tt>
+benchmark is subtracted from every other benchmark's compile
+time.</font></p>
 
 <p>Run times are averaged over three runs. All reported times are CPU time (system plus user).
-   Where available, the times are based on the output of the implementation's <tt>time</tt> 
-   syntactic form, otherwise <tt>/usr/bin/time</tt> is used.</p>
+   The times are based on the output of the implementation's <tt>time</tt> 
+   syntactic form for function.</p>
 
-<p>Compiler configuration:
+<p>Machine:
 <ul>
-<li> Bigloo (2.8b): <tt>-06 -copt -O3 -copt -fomit-frame-pointer</tt></il>
-<li> Chicken (2 build 3): <tt>-no-trace -no-lambda-info -optimize-level 3 -block -lambda-lift</tt></il>
-<li> Gambit (4.0 beta 17): <tt>(declare (block) (standard-bindings) (extended-bindings) (safe) (interrupts-enabled))</tt>, 
-     installed with <tt>--enable-single-host</tt>, compiled with <tt>-dynamic</tt>, compiled and run with <tt>-:m10000</tt></li>
-<li> Larceny (0.92b): default mode &mdash; but should use <tt>(benchmark-block-mode #t)</tt> when it works</li>
-<li> MzScheme (352.5): in <tt>module</tt></li>
+  <li> MacBook Pro, 2.53 GHz, Mac OS X 10.6.2, compiling to 32-bit programs
+</ul></p>
+
+<p>Compiler configurations:
+<ul>
+<li> Bigloo (3.3a): <tt>-06 -call/cc -copt -O3 -copt -fomit-frame-pointer</tt></il>
+<li> Chicken (4.3.0): <tt>-no-trace -no-lambda-info -optimize-level 3 -block -lambda-lift</tt></il>
+<li> Gambit (4.6.0): <tt>(declare (block) (standard-bindings) (extended-bindings) (safe) (interrupts-enabled))</tt>, 
+     compiled and run with <tt>-:m10000</tt></li>
+<li> Ikarus (0.0.4-rc1+ rev 1870): in R6RS library</li>
+<li> Larceny (0.97): in R6RS library</li>
+<li> PLT (4.2.4): in <tt>module</tt>; for benchmarks that use <tt>set-car!</tt> and <tt>set-cdr!</tt>, 
+     PLT's R5RS support is used</li>
 </ul>
-These configurations are all "safe mode", but they allow the compiler
-to assume that built-in Scheme functions are not redefined and (except
-in the case of Larceny) that no top-level defintion is ever
+These configurations are all &ldquo;safe mode,&rdquo; but they allow the compiler
+to assume that built-in Scheme functions are not redefined and that no top-level defintion is ever
 changed. Such assumptions correspond to putting the benchmark in an
-R6RS library (we expect).</P>
+R6RS library.</P>
 
 <p>In general, we attempt to use the various implementations in a compentent way,
    but not in a sophisticated way. For example, we do not tweak
    inlining parameters or specify fixnum arithmetic (where appropriate),
    which could produce significant improvements from some compilers.</p>
 
-<p>For a larger set of benchmarks and a more sophisticated use of the compilers,
-   see Marc Feeley's page:
-   <a href="http://www.iro.umontreal.ca/~gambit/bench.html">http://www.iro.umontreal.ca/~gambit/bench.html</a>.
+<p>For more benchmarks and a more sophisticated use of a few compilers,
+   including fixnum- and flonum-specific arithmetic as well as unsafe modes,
+   see <a href="../log1/Gambit_20benchmarks.html">this other page</a>.</p>
 
 <p>For further details on the benchmarks here, see the benchmark source and
    infrastructure, which is available form the PLT SVN repository:</p>
@@ -50,8 +60,3 @@ R6RS library (we expect).</P>
 <p align=center>
    <a href="http://svn.plt-scheme.org/plt/trunk/collects/tests/mzscheme/benchmarks/common/">http://svn.plt-scheme.org/plt/trunk/collects/tests/mzscheme/benchmarks/common/</a></P>
 
-<H1>Results</H1>
-
-<ul>
-<li> <a href=machine1.html>machine1</a> ...
-</ul>
diff --git a/collects/tests/mzscheme/benchmarks/common/kanren.sch b/collects/tests/mzscheme/benchmarks/common/kanren.sch
index 6f28c2c4bf..8d46a91dd8 100644
--- a/collects/tests/mzscheme/benchmarks/common/kanren.sch
+++ b/collects/tests/mzscheme/benchmarks/common/kanren.sch
@@ -1,5 +1,5 @@
-(define error
-  (lambda args (/ args)))
+;; smashed into benchmark form by Matthew
+
 (define errorf error)
 
 ; like cout << arguments << args
@@ -14,7 +14,7 @@
 (define cerr cout)
 
 (define pntall (lambda v (write v) (newline)))
-(define (pretty-print v) (write v) (newline))
+(define (_pretty-print v) (write v) (newline))
 
 (define nl (string #\newline))
 
@@ -113,14 +113,15 @@
 (define-syntax test-check
   (syntax-rules ()
     ((_ title tested-expression expected-result)
-     (begin
-       (cout "Testing " title nl)
-       (let* ((expected expected-result)
-              (produced tested-expression))
-         (or (equal? expected produced)
-             (errorf 'test-check
-               "Failed: ~a~%Expected: ~a~%Computed: ~a~%"
-               'tested-expression expected produced)))))))
+       (begin
+         (cout "Testing " title nl)
+         (let* ((expected expected-result)
+                (produced tested-expression))
+           (or (equal? expected produced)
+               (errorf 'test-check
+                       "Failed: ~a~%Expected: ~a~%Computed: ~a~%"
+                       'tested-expression expected produced)))
+         #f))))
 
 (define symbol-append
   (lambda symbs
@@ -149,7 +150,7 @@
       (let ((id (logical-variable 'id)) ...) body))))
 
 ; The anonymous variable
-(define _ (let-lv (_) _))
+(define __ (let-lv (_) _))
 
 ; Another way to introduce logical variables: via distinguished pairs
 ; (define logical-var-tag (list '*logical-var-tag*)) ; unique for eq?
@@ -175,9 +176,14 @@
 ; the exclamation mark. The mark makes sure the symbol stands out when
 ; printed.
 
+(define counter 0)
+(define (jensym s)
+  (set! counter (+ counter 1))
+  (string->symbol (string-append "!$gen$!" s (number->string counter))))
+
 (define eigen-variable
   (lambda (id)
-    (symbol-append '! id '_ (gensym "x"))))
+    (symbol-append '! id '_ (jensym "x"))))
 
 (define eigen-var?
   (lambda (x)
@@ -195,6 +201,7 @@
     ((_ (id ...) body)
       (let ((id (eigen-variable 'id)) ...) body))))
 
+(define (eigen-test)
 (test-check 'eigen
   (and
     (eigen () #t)
@@ -202,7 +209,7 @@
     (eigen (x y)
       (begin (display "eigens: ") (display (list x y))
 	(newline) #t)))
-  #t)
+  #t))
 
 ;;; ------------------------------------------------------
 
@@ -437,7 +444,7 @@
 ;;;; This is Oleg's unifier
 
 ; Either t or u may be:
-; _
+; __
 ; free-var
 ; bound-var
 ; pair
@@ -461,8 +468,8 @@
   (lambda (t u subst)
     (cond
       ((eq? t u) subst)			; quick tests first
-      ((eq? t _) subst)
-      ((eq? u _) subst)
+      ((eq? t __) subst)
+      ((eq? u __) subst)
       ((var? t)
        (let*-and (unify-free/any t u subst) ((ct (assq t subst)))
 	 (if (var? u)			; ct is a bound var, u is a var
@@ -505,13 +512,13 @@
 
 
 ; Just like unify. However, the first term, t, comes from
-; an internalized term. We know it can't be _ and can't contain _
+; an internalized term. We know it can't be __ and can't contain __
 
 (define unify-internal/any
   (lambda (t u subst)
     (cond
       ((eq? t u) subst)			; quick tests first
-      ((eq? u _) subst)
+      ((eq? u __) subst)
       ((var? t)
        (let*-and (unify-free/any t u subst) ((ct (assq t subst)))
 	 (if (var? u)			; ct is a bound var, u is a var
@@ -537,8 +544,8 @@
 ; the other way around.
 ; Aside from the above, this function can take advantage of the following
 ; facts about (commitment->term cx) (where cx is an existing commitment):
-;   - it is never _
-;   - it never contains _
+;   - it is never __
+;   - it never contains __
 ; Most importantly, if, for example, (commitment->term ct) is a free variable,
 ; we enter its binding to (commitment->term cu) with fewer checks.
 ; in particular, we never need to call unify-free/list nor
@@ -583,7 +590,7 @@
 (define unify-free/any
   (lambda (t-var u subst)
     (cond
-      ((eq? u _) subst)
+      ((eq? u __) subst)
       ((var? u)
        (let*-and (extend-subst t-var u subst) ((cu (assq u subst)))
          (unify-free/bound t-var cu subst)))
@@ -631,13 +638,13 @@
 
 ; t-var is a free variable, u-value is a proper or improper
 ; list, which may be either fully or partially grounded (or not at all).
-; We scan the u-value for _, and if, found, replace them with fresh
+; We scan the u-value for __, and if, found, replace them with fresh
 ; variables. We then bind t-var to the term.
 ; This function is not recursive and always succeeds.
 ;
-; We assume that more often than not u-value does not contain _.
+; We assume that more often than not u-value does not contain __.
 ; Therefore, to avoid the wasteful rebuilding of u-value, we 
-; first scan it for the occurrence of _. If the scan returns negative,
+; first scan it for the occurrence of __. If the scan returns negative,
 ; we can use u-value as it is.
 
       ; Rebuild lst replacing all anonymous variables with some
@@ -647,7 +654,7 @@
 (define ufl-rebuild-without-anons
   (lambda (lst)
     (cond
-      ((eq? lst _) (logical-variable '*anon))
+      ((eq? lst __) (logical-variable '*anon))
       ((not (pair? lst)) #f)
       ((null? (cdr lst))
 	(let ((new-car (ufl-rebuild-without-anons (car lst))))
@@ -670,7 +677,7 @@
 
 (define (term-tests)
   
-  (cout nl "Compositions of substitutions" nl)
+  ; (cout nl "Compositions of substitutions" nl)
   ; (let-lv (x y)
   ;   (test-check 'test-compose-subst-0
   ;     (append (unit-subst x y) (unit-subst y 52))
@@ -857,7 +864,7 @@
     (list
         (let-lv (x0 x1 y0 y1)
   	(begin
-  	  (pretty-print
+  	  (_pretty-print
   	    (reify-subst '()
   	      (unify
   		`(h ,x1 (f ,y0 ,y0) ,y1)
@@ -867,7 +874,7 @@
   
         (let-lv (x0 x1 x2 y0 y1 y2)
   	(begin
-  	  (pretty-print
+  	  (_pretty-print
              (reify-subst '()
               (unify
                 `(h ,x1 ,x2 (f ,y0 ,y0) (f ,y1 ,y1) ,y2)
@@ -877,7 +884,7 @@
   
         (let-lv (x0 x1 x2 x3 x4 y0 y1 y2 y3 y4)
          (begin
-          (pretty-print
+          (_pretty-print
             (reify-subst '()
               (unify
                 `(h ,x1 ,x2 ,x3 ,x4 (f ,y0 ,y0) (f ,y1 ,y1) (f ,y2 ,y2) (f ,y3 ,y3) ,y4)
@@ -894,7 +901,8 @@
         (reify-subst '() subst)))
     '((z.0 42) (y.0 (2 3 4 5 42)) (x.0 (1 2 3 4 5 42))))
     ;'((z.0 . 42) (y.0 2 3 4 5 a*.0) (a*.0 . z.0) (x.0 1 2 3 4 5 a*.0)))
-  
+
+  10
   )
   
 
@@ -915,18 +923,18 @@
      (lambda (formal0)
        (lambda@ (formal1 formal2 ...) body0 body1 ...)))))
 
-(define-syntax @  
+(define-syntax at@
   (syntax-rules ()
     ((_ rator rand) (rator rand))
-    ((_ rator rand0 rand1 rand2 ...) (@ (rator rand0) rand1 rand2 ...))))
+    ((_ rator rand0 rand1 rand2 ...) (at@ (rator rand0) rand1 rand2 ...))))
 
-(test-check 'test-@-lambda@
-  (@ (lambda@ (x y z) (+ x (+ y z))) 1 2 3)
-  6)
+;(test-check 'test-@-lambda@
+;  (at@ (lambda@ (x y z) (+ x (+ y z))) 1 2 3)
+;  6)
 
-'(test-check 'test-@-lambda@
-  (@ (lambda@ (x y z) (+ x (+ y z))) 1 2 3)
-  42)
+;'(test-check 'test-@-lambda@
+;  (at@ (lambda@ (x y z) (+ x (+ y z))) 1 2 3)
+;  42)
 
 (define Y
   (lambda (f)
@@ -959,7 +967,7 @@
 
 
 ; Trivial goals
-(define succeed (lambda@ (s k) (@ k s)))  ; eta-reduced
+(define succeed (lambda@ (s k) (at@ k s)))  ; eta-reduced
 (define fail (lambda@ (s k f) (f)))
 (define sfail (lambda@ (k f) (f)))	; Failed SGoal
 
@@ -1085,16 +1093,16 @@
 ;     ((_ (ex-id) gl)
 ;      (let-lv (ex-id)
 ;        (lambda@ (sk fk in-subst)
-;          (@ gl
+;          (at@ gl
 ;            (lambda@ (fk out-subst)
-;              (@ sk fk (lv-elim-1 ex-id in-subst out-subst)))
+;              (at@ sk fk (lv-elim-1 ex-id in-subst out-subst)))
 ;            fk in-subst))))
 ;     ((_ (ex-id ...) gl)
 ;      (let-lv (ex-id ...) 
 ;        (lambda@ (sk fk in-subst)
-;          (@ gl
+;          (at@ gl
 ;            (lambda@ (fk out-subst)
-;              (@ sk fk (lv-elim (list ex-id ...) in-subst out-subst)))
+;              (at@ sk fk (lv-elim (list ex-id ...) in-subst out-subst)))
 ;            fk in-subst))))))
 
 ; For the unifier that doesn't introduce temp variables,
@@ -1117,7 +1125,7 @@
 ; So, to prune variables and preserve sharing, we have to topologically sort
 ; the bindings first!
 
-(define-syntax exists
+(define-syntax _exists
   (syntax-rules ()
     ((_ () gl) gl)
     ((_ (ex-id ...) gl)
@@ -1142,13 +1150,13 @@
     (let ((print-it
 	    (lambda (event subst)
 	      (display title) (display " ")
-	      (display event) (pretty-print subst) (newline))))
+	      (display event) (_pretty-print subst) (newline))))
       (lambda@ (subst sk fk)
 	(print-it "CALL:" subst)
-	(@ gl subst
+	(at@ gl subst
 	  (lambda@ (subst fk)
 	    (print-it "RETURN:" subst)
-	    (@ sk subst
+	    (at@ sk subst
 	      (lambda ()
 		(display title) (display " REDO") (newline)
 		(fk))
@@ -1182,9 +1190,9 @@
 
 (define-syntax splice-in-gls/all
   (syntax-rules ()
-    ((_ subst sk gl) (@ gl subst sk))
+    ((_ subst sk gl) (at@ gl subst sk))
     ((_ subst sk gl0 gl1 ...)
-     (@ gl0 subst (lambda (subst) (splice-in-gls/all subst sk gl1 ...))))))
+     (at@ gl0 subst (lambda (subst) (splice-in-gls/all subst sk gl1 ...))))))
 
 
 ; (promise-one-answer gl)
@@ -1226,9 +1234,9 @@
     ((_ gl0 gl1 ...)
      (promise-one-answer
        (lambda@ (subst sk fk)
-	 (@
+	 (at@
 	   (splice-in-gls/all subst
-	     (lambda@ (subst fk-ign) (@ sk subst fk)) gl0 gl1 ...)
+	     (lambda@ (subst fk-ign) (at@ sk subst fk)) gl0 gl1 ...)
 	   fk))))))
 
 ; (all!! gl1 gl2 ...)
@@ -1252,11 +1260,11 @@
 (define-syntax splice-in-gls/all!!
   (syntax-rules (promise-one-answer)
     ((_ subst sk fk)
-      (@ sk subst fk))
+      (at@ sk subst fk))
     ((_ subst sk fk (promise-one-answer gl))
-      (@ gl subst sk fk))
+      (at@ gl subst sk fk))
     ((_ subst sk fk gl0 gl1 ...)
-      (@ gl0 subst
+      (at@ gl0 subst
 	(lambda@ (subst fk-ign) (splice-in-gls/all!! subst sk fk gl1 ...))
 	fk))))
 
@@ -1288,16 +1296,16 @@
   (syntax-rules ()
     ((_ condition then)
      (lambda@ (subst sk fk)
-       (@ condition subst
+       (at@ condition subst
          ; sk from cond
-         (lambda@ (subst fk-ign) (@ then subst sk fk))
+         (lambda@ (subst fk-ign) (at@ then subst sk fk))
          ; failure from cond
          fk)))
     ((_ condition then else)
      (lambda@ (subst sk fk)
-       (@ condition subst
-         (lambda@ (subst fk-ign) (@ then subst sk fk))
-         (lambda () (@ else subst sk fk))
+       (at@ condition subst
+         (lambda@ (subst fk-ign) (at@ then subst sk fk))
+         (lambda () (at@ else subst sk fk))
          )))))
 
 ; (if-all! (COND1 ... CONDN) THEN)
@@ -1354,9 +1362,9 @@
 
 (define-syntax splice-in-gls/any
   (syntax-rules ()
-    ((_ subst sk fk gl1) (@ gl1 subst sk fk))
+    ((_ subst sk fk gl1) (at@ gl1 subst sk fk))
     ((_ subst sk fk gl1 gl2 ...)
-     (@ gl1 subst sk (lambda () (splice-in-gls/any subst sk fk gl2 ...))))))
+     (at@ gl1 subst sk (lambda () (splice-in-gls/any subst sk fk gl2 ...))))))
 
 
 ; Negation
@@ -1373,16 +1381,16 @@
 (define fails
   (lambda (gl)
     (lambda@ (subst sk fk)
-      (@ gl subst
+      (at@ gl subst
         (lambda@ (subst current-fk) (fk))
-        (lambda () (@ sk subst fk))
+        (lambda () (at@ sk subst fk))
         ))))
 
 ; Again, G-Rule must hold for this predicate to be logically sound
 (define succeeds
   (lambda (gl)
     (lambda@ (subst sk fk)
-      (@ gl subst (lambda@ (subst-ign fk-ign) (@ sk subst fk))
+      (at@ gl subst (lambda@ (subst-ign fk-ign) (at@ sk subst fk))
 	fk))))
 
 ; partially-eval-sgl: Partially evaluate a semi-goal. A
@@ -1396,7 +1404,7 @@
 ; be implemented with streams (lazy lists). The following is a purely
 ; combinational implementation.
 ;
-; (@ partially-eval-sgl sgl a b) =>
+; (at@ partially-eval-sgl sgl a b) =>
 ;   (b) if sgl has no answers
 ;   (a s residial-sgl) if sgl has a answer. That answer is delivered
 ;                       in s. 
@@ -1406,14 +1414,14 @@
 ; The following definition is eta-reduced.
 
 (define (partially-eval-sgl sgl)
-  (@ sgl
+  (at@ sgl
     (lambda@ (subst fk a b)
-      (@ a subst 
+      (at@ a subst 
 	(lambda@ (sk1 fk1)
-	  (@
+	  (at@
 	    (fk) 
 	    ; new a
-	    (lambda@ (sub11 x) (@ sk1 sub11 (lambda () (@ x sk1 fk1))))
+	    (lambda@ (sub11 x) (at@ sk1 sub11 (lambda () (at@ x sk1 fk1))))
 	    ; new b
 	    fk1))))
     (lambda () (lambda@ (a b) (b)))))
@@ -1444,16 +1452,16 @@
       ((null? sgls) (fk))		; all of the sgls are finished
       ((null? (cdr sgls))
        ; only one of sgls left -- run it through the end
-       (@ (car sgls) sk fk))
+       (at@ (car sgls) sk fk))
       (else
         (let loop ((curr sgls) (residuals '()))
 	  ; check if the current round is finished
 	  (if (null? curr) (interleave sk fk (reverse residuals))
-	    (@
+	    (at@
 	      partially-eval-sgl (car curr)
 	      ; (car curr) had an answer
 	      (lambda@ (subst residual)
-	        (@ sk subst
+	        (at@ sk subst
 	          ; re-entrance cont
 		  (lambda () (loop (cdr curr) (cons residual residuals)))))
 	    ; (car curr) is finished - drop it, and try next
@@ -1505,13 +1513,13 @@
       (cond
         ((null? sagls) (fk))  ; all of the sagls are finished
         ((null? (cdr sagls))  ; only one gl is left -- run it through the end
-	 (@ (caar sagls) sk fk))
+	 (at@ (caar sagls) sk fk))
         (else
 	  (let loop ((curr sagls)
                      (residuals '()))
             ; check if the current round is finished
 	    (if (null? curr) (outer (reverse residuals))
-                (@
+                (at@
                  partially-eval-sgl (caar curr)
                   ; (caar curr) had an answer
                  (lambda@ (subst residual)
@@ -1519,12 +1527,12 @@
                   ; gls down the curr.
                    (let check ((to-check (cdr curr)))
                      (if (null? to-check) ; OK, subst is unique,give it to user
-                         (@ sk subst
+                         (at@ sk subst
                            ; re-entrance cont
                            (lambda ()
                              (loop (cdr curr) 
                                (cons (cons residual (cdar curr)) residuals))))
-                         (@ (cdar to-check) subst
+                         (at@ (cdar to-check) subst
                             ; subst was the answer to some other gl:
 			    ; check failed
                             (lambda@ (subst1 fk1)
@@ -1575,13 +1583,13 @@
     ((_ condition then) (all condition then))
     ((_ condition then else)
      (lambda@ (subst sk fk)
-       (@ partially-eval-sgl (condition subst)
+       (at@ partially-eval-sgl (condition subst)
          (lambda@ (ans residual)
-           (@ then ans sk
+           (at@ then ans sk
              ; then failed. Check to see if condition has another answer
-             (lambda () (@ residual (lambda@ (subst) (@ then subst sk)) fk))))
+             (lambda () (at@ residual (lambda@ (subst) (at@ then subst sk)) fk))))
              ; condition failed
-         (lambda () (@ else subst sk fk)))))))
+         (lambda () (at@ else subst sk fk)))))))
 
 
 ; An interleaving conjunction: all-interleave
@@ -1675,11 +1683,11 @@
 (define all-interleave-bin
   (lambda (sgl1 gl2)
     (lambda@ (sk fk)
-      (@ partially-eval-sgl sgl1
+      (at@ partially-eval-sgl sgl1
 	(lambda@ (ans residual)
 	  (interleave sk fk
 	    (list 
-	      (@ gl2 ans)
+	      (at@ gl2 ans)
 	      (all-interleave-bin residual gl2)
 	    )))
 	  ;gl1 failed
@@ -1725,21 +1733,21 @@
 ; we notice that the logical variable 'x' occurs at the top-level. Normally we
 ; compile the relation like that into the following
 ;    (lambda (g1 g2)
-;      (exists (x y)
+;      (_exists (x y)
 ;        (lambda@ (subst)
 ; 	 (let*-and (fail subst) ((subst (unify g1 `(,x . ,y)  subst))
 ; 			         (subst (unify g2 x subst)))
-; 	     (@ body subst)))))
+; 	     (at@ body subst)))))
 ;
 ; However, that we may permute the order of 'unify g...' clauses
 ; to read
 ;    (lambda (g1 g2)
-;      (exists (x y)
+;      (_exists (x y)
 ;        (lambda@ (subst)
 ; 	 (let*-and (fail subst) ((subst (unify x g2 subst))
 ; 			         (subst (unify g1 `(,x . ,y)  subst))
 ; 			         )
-; 	     (@ body subst)))))
+; 	     (at@ body subst)))))
 ;
 ; We may further note that according to the properties of the unifier
 ; (see below), (unify x g2 subst) must always succeed, 
@@ -1751,7 +1759,7 @@
 ; to being lexical. Thus, we compile the relation as
 ;
 ;    (lambda (g1 g2)
-;      (exists (x y)
+;      (_exists (x y)
 ;        (lambda@ (subst)
 ; 	 (let* ((subst (unify-free/any x g2 subst))
 ; 	        (fast-path? (and (pair? subst)
@@ -1760,14 +1768,14 @@
 ; 	        (subst (if fast-path? (cdr subst) subst)))
 ; 	 (let*-and sfail ((subst (unify g1 `(,x . ,y)  subst))
 ; 			 )
-; 	     (@ body subst))))))
+; 	     (at@ body subst))))))
 ;
 ; The benefit of that approach is that we limit the growth of subst and avoid
 ; keeping commitments that had to be garbage-collected later.
 
 
 (define-syntax relation
-  (syntax-rules (to-show head-let once _)
+  (syntax-rules (to-show head-let once __)
     ((_ (head-let head-term ...) gl)
      (relation-head-let (head-term ...) gl))
     ((_ (head-let head-term ...))	; not particularly useful without body
@@ -1794,7 +1802,7 @@
     ; parameters, and forget them
     ; also, note and keep track of the first occurrence of a term
     ; that is just a var (bare-var) 
-    ((_ "g" vars once-vars (gs ...) gunis bvars bvar-cl (_ . terms) . gl)
+    ((_ "g" vars once-vars (gs ...) gunis bvars bvar-cl (__ . terms) . gl)
      (relation "g" vars once-vars (gs ... anon) gunis
        bvars bvar-cl terms . gl))
     ((_ "g" vars once-vars (gs ...) gunis bvars (subst . cls)
@@ -1830,20 +1838,20 @@
     ; Final: writing the code
     ((_ "f" vars () () () (subst) gl)   ; no arguments (no head-tests)
       (lambda ()
-	(exists vars gl)))
+	(_exists vars gl)))
                                     ; no tests but pure binding
     ((_ "f" (ex-id ...) once-vars (g ...) () (subst) gl)
      (lambda (g ...)
-       (exists (ex-id ...) gl)))
+       (_exists (ex-id ...) gl)))
 				    ; the most general
     ((_ "f" (ex-id ...) once-vars (g ...) ((gv . term) ...) 
        (subst let*-clause ...) gl) 
      (lambda (g ...)
-       (exists (ex-id ...)
+       (_exists (ex-id ...)
 	 (lambda (subst)
 	   (let* (let*-clause ...)
 	     (let*-and sfail ((subst (unify gv term subst)) ...)
-	       (@ gl subst)))))))))
+	       (at@ gl subst)))))))))
 
 ; A macro-expand-time memv function for identifiers
 ;	id-memv?? FORM (ID ...) KT KF
@@ -1948,14 +1956,14 @@
      (lambda gvs                                     ; don't bother bind vars
        (lambda@ (subst)
 	 (let*-and sfail ((subst (unify gv term subst)) ...)
-	   (@ succeed subst)))))
+	   (at@ succeed subst)))))
 
     ((_ "f" (var0 ...) ((gvo term) ...) gvs gl)
      (lambda gvs
        (lambda@ (subst)			; first unify the constants
 	 (let*-and sfail ((subst (unify gvo term subst)) ...)
-           (let ((var0 (if (eq? var0 _) (logical-variable '?) var0)) ...)
-             (@ gl subst))))))))
+           (let ((var0 (if (eq? var0 __) (logical-variable '?) var0)) ...)
+             (at@ gl subst))))))))
 
 ; (define-syntax relation/cut
 ;   (syntax-rules (to-show)
@@ -1965,11 +1973,11 @@
 ;      (relation/cut cut-id ex-ids (var ... g) (x1 ...) xs gl ...))
 ;     ((_ cut-id (ex-id ...) (g ...) () (x ...) gl ...)
 ;      (lambda (g ...)
-;        (exists (ex-id ...)
+;        (_exists (ex-id ...)
 ;          (all! (== g x) ...
 ;            (lambda@ (sk fk subst cutk)
 ;              (let ((cut-id (!! cutk)))
-;                (@ (all gl ...) sk fk subst cutk)))))))))
+;                (at@ (all gl ...) sk fk subst cutk)))))))))
 
 (define-syntax fact
   (syntax-rules ()
@@ -2043,9 +2051,9 @@
 
 ; Unify lifted to be a binary relation
 (define-syntax ==
-  (syntax-rules (_)
-    ((_ _ u) (lambda@ (subst sk) (@ sk subst)))
-    ((_ t _) (lambda@ (subst sk) (@ sk subst)))
+  (syntax-rules (__)
+    ((_ __ u) (lambda@ (subst sk) (at@ sk subst)))
+    ((_ t __) (lambda@ (subst sk) (at@ sk subst)))
     ((_ t u)
      (lambda@ (subst)
        (let*-and sfail ((subst (unify t u subst)))
@@ -2071,7 +2079,7 @@
   (syntax-rules ()
     ((_ (redo-k subst id ...) A SE ...)
       (let-lv (id ...)
-	(@ A empty-subst
+	(at@ A empty-subst
 	  (lambda@ (subst redo-k) SE ...)
 	  (lambda () '()))))))
 
@@ -2104,14 +2112,14 @@
     ((_ (var ...) gl)
      (lambda@ (subst)
        (let ((var (nonvar! (subst-in var subst))) ...)
-	 (@ gl subst))))))
+	 (at@ gl subst))))))
 
 (define-syntax project/no-check
   (syntax-rules ()
     ((_ (var ...) gl)
      (lambda@ (subst)
        (let ((var (subst-in var subst)) ...)
-	 (@ gl subst))))))
+	 (at@ gl subst))))))
 
 (define-syntax predicate
   (syntax-rules ()
@@ -2187,10 +2195,10 @@
 			   sfail
 			   (let ((s (extend-subst depth-counter-var
 				      (+ counter 1) subst)))
-			     (@ gl s))))))
+			     (at@ gl s))))))
 		(else
 		  (let ((s (extend-subst depth-counter-var 1 subst)))
-		    (@ gl s)))))))))
+		    (at@ gl s)))))))))
     ))
 
 ; ?- help(call_with_depth_limit/3).
@@ -2241,7 +2249,7 @@
          )
     (test-check 'test-father0
       (let ((result
-  	    (@ (father 'jon 'sam) empty-subst
+  	    (at@ (father 'jon 'sam) empty-subst
   	      initial-sk initial-fk)))
         (and
   	(equal? (car result) '())
@@ -2250,7 +2258,7 @@
   
     (test-check 'test-child-of-male-0
       (reify-subst '()
-        (car (@ (child-of-male 'sam 'jon) empty-subst
+        (car (at@ (child-of-male 'sam 'jon) empty-subst
   	     initial-sk initial-fk)))
     ;`(,(commitment 'child.0 'sam) ,(commitment 'dad.0 'jon)))
     '())  ; variables shouldn't leak
@@ -2259,7 +2267,7 @@
     ; The mark should be found here...
     (test-check 'test-child-of-male-1
     (reify-subst '()
-      (car (@ (child-of-male 'sam 'jon) empty-subst
+      (car (at@ (child-of-male 'sam 'jon) empty-subst
   	    initial-sk initial-fk)))
     ;`(,(commitment 'child.0 'sam) ,(commitment 'dad.0 'jon)))
     '())
@@ -2282,7 +2290,7 @@
   	)
     (test-check 'test-father-1
       (let ((result
-  	    (@ (new-father 'rob 'sal) empty-subst
+  	    (at@ (new-father 'rob 'sal) empty-subst
   	      initial-sk initial-fk)))
         (and
   	(equal? (car result) '())
@@ -2310,7 +2318,7 @@
     (test-check 'test-father-5
       (query (redok subst x)
         (newer-father 'rob x)
-        (pretty-print subst)
+        (_pretty-print subst)
         (cons
   	(reify-subst (list x) subst)
   	(redok)))
@@ -2394,7 +2402,7 @@
       ((grandpa-sam
          (relation (grandchild)
   	 (to-show grandchild)
-  	 (exists (parent)
+  	 (_exists (parent)
   	   (all (father 'sam parent)
   	        (father parent grandchild))))))
       (test-check 'test-grandpa-sam-1
@@ -2406,7 +2414,7 @@
       ((grandpa-sam
          (relation ((once grandchild))
   	 (to-show grandchild)
-  	 (exists (parent)
+  	 (_exists (parent)
   	   (all (father 'sam parent)
   	        (father parent grandchild))))))
       (test-check 'test-grandpa-sam-1
@@ -2429,7 +2437,7 @@
     (let ((grandpa
   	  (relation ((once grandad) (once grandchild))
   	    (to-show grandad grandchild)
-  	    (exists (parent)
+  	    (_exists (parent)
   	      (all
   		(father grandad parent)
   		(father parent grandchild))))))
@@ -2441,7 +2449,7 @@
   	  (lambda (guide* grandad*)
   	    (relation (grandchild)
   	      (to-show grandchild)
-  	      (exists (parent)
+  	      (_exists (parent)
   		(all
   		  (guide* grandad* parent)
   		  (guide* parent grandchild)))))))
@@ -2472,14 +2480,14 @@
       ((grandpa/father
          (relation (grandad grandchild)
   	 (to-show grandad grandchild)
-  	 (exists (parent)
+  	 (_exists (parent)
   	   (all
   	     (father grandad parent)
   	     (father parent grandchild)))))
        (grandpa/mother
          (relation (grandad grandchild)
   	 (to-show grandad grandchild)
-  	 (exists (parent)
+  	 (_exists (parent)
   	   (all
   	     (father grandad parent)
   	     (mother parent grandchild)))))
@@ -2496,7 +2504,7 @@
       ((grandpa-sam
          (let ((r (relation (child)
   		  (to-show child)
-  		  (exists (parent)
+  		  (_exists (parent)
   		    (all
   		      (father 'sam parent)
   		      (father parent child))))))
@@ -2513,7 +2521,7 @@
   ; (define grandpa/father
   ;   (relation/cut cut (grandad grandchild)
   ;     (to-show grandad grandchild)
-  ;     (exists (parent)
+  ;     (_exists (parent)
   ;       (all
   ;         (father grandad parent)
   ;         (father parent grandchild)
@@ -2522,7 +2530,7 @@
   ; (define grandpa/mother
   ;   (relation (grandad grandchild)
   ;     (to-show grandad grandchild)
-  ;     (exists (parent)
+  ;     (_exists (parent)
   ;       (all
   ;         (father grandad parent)
   ;         (mother parent grandchild)))))
@@ -2533,7 +2541,7 @@
       ((grandpa/father
          (relation (grandad grandchild)
   	 (to-show grandad grandchild)
-  	 (exists (parent)
+  	 (_exists (parent)
   	   (all!
   	     (father grandad parent)
   	     (father parent grandchild)))))
@@ -2541,7 +2549,7 @@
         (grandpa/mother
   	(relation (grandad grandchild)
   	  (to-show grandad grandchild)
-  	  (exists (parent)
+  	  (_exists (parent)
   	    (all
   	      (father grandad parent)
   	      (mother parent grandchild)))))
@@ -2560,21 +2568,21 @@
   ; (define grandpa/father
   ;   (relation/cut cut (grandad grandchild)
   ;     (to-show grandad grandchild)
-  ;     (exists (parent)
+  ;     (_exists (parent)
   ;       (all cut (father grandad parent) (father parent grandchild)))))
   
     (let
       ((grandpa/father
          (relation (grandad grandchild)
   	 (to-show grandad grandchild)
-  	 (exists (parent)
+  	 (_exists (parent)
   	   (all
   	     (father grandad parent) (father parent grandchild)))))
   
         (grandpa/mother
   	(relation (grandad grandchild)
   	  (to-show grandad grandchild)
-  	  (exists (parent)
+  	  (_exists (parent)
   	    (all
   	      (father grandad parent) (mother parent grandchild)))))
         )
@@ -2638,7 +2646,7 @@
         ((a-grandma
   	 (relation (grandad grandchild)
   	   (to-show grandad grandchild)
-  	   (exists (parent)
+  	   (_exists (parent)
   	     (all! (mother grandad parent)))))
   	(no-grandma-grandpa
   	  (let-gls (a1 a2) ((a-grandma a-grandma)
@@ -2671,14 +2679,14 @@
       (let* ((parents-of-scouts-sgl
   	     ((parents-of-scouts p1 p2) empty-subst))
              (cons@ (lambda@ (x y) (cons x y)))
-             (split1 (@ 
+             (split1 (at@ 
                       partially-eval-sgl parents-of-scouts-sgl
                       cons@ (lambda () '())))
              (a1 (car split1))
-             (split2 (@ partially-eval-sgl (cdr split1) cons@
+             (split2 (at@ partially-eval-sgl (cdr split1) cons@
                        (lambda () '())))
              (a2 (car split2))
-             (split3 (@ partially-eval-sgl (cdr split2) cons@
+             (split3 (at@ partially-eval-sgl (cdr split2) cons@
                        (lambda () '())))
              (a3 (car split3)))
         (map (lambda (subst)
@@ -2730,7 +2738,7 @@
              (lambda (old young)
                (any
                  (father old young)
-                 (exists (not-so-old)
+                 (_exists (not-so-old)
                    (all
                      (father old not-so-old)
                      (ancestor not-so-old young)))))))
@@ -2749,7 +2757,7 @@
     (letrec
         ((move
            (extend-relation (a1 a2 a3 a4)
-             (fact () 0 _ _ _)
+             (fact () 0 __ __ __)
              (relation (n a b c)
                (to-show n a b c)
                (project (n)
@@ -2788,7 +2796,7 @@
         (letrec
             ((move
                (extend-relation (a1 a2 a3 a4)
-                 (fact () 0 _ _ _)
+                 (fact () 0 __ __ __)
                  (relation (n a b c)
                    (to-show n a b c)
                    (project (n)
@@ -2841,7 +2849,7 @@
   
   (test-check 'unification-of-free-vars-4
     (solve 1 (x)
-      (exists (y)
+      (_exists (y)
         (all! (== y x) (== y 5) (== x y))))
     '(((x.0 5))))
   
@@ -2928,8 +2936,8 @@
   ; (test-check 'lv-elim-1
   ;   (reify
   ;     (let-lv (x z dummy)
-  ;       (@ 
-  ; 	(exists (y)
+  ;       (at@ 
+  ; 	(_exists (y)
   ; 	  (== `(,x ,z ,y) `(5 9 ,x)))
   ; 	(lambda@ (fk subst) subst)
   ; 	initial-fk
@@ -2940,8 +2948,8 @@
   ; (test-check 'lv-elim-2
   ;   (reify
   ;     (let-lv (x dummy)
-  ;       (@ 
-  ; 	(exists (y)
+  ;       (at@ 
+  ; 	(_exists (y)
   ; 	  (== `(,x ,y) `((5 ,y) ,7)))
   ; 	(lambda@ (fk subst) subst)
   ; 	initial-fk
@@ -2953,8 +2961,8 @@
   ; (test-check 'lv-elim-3
   ;   (reify
   ;     (let-lv (x v dummy)
-  ;       (@ 
-  ; 	(exists (y)
+  ;       (at@ 
+  ; 	(_exists (y)
   ; 	  (== x `(a b c ,v d)))
   ; 	(lambda@ (fk subst) subst)
   ; 	initial-fk
@@ -2966,7 +2974,7 @@
   ; (test-check 'lv-elim-4-1
   ;   (reify
   ;     (let-lv (x v b dummy)
-  ;       (@ 
+  ;       (at@ 
   ; 	(let-lv (y)
   ; 	  (== `(,b ,x ,y) `(,x ,y 1)))
   ; 	(lambda@ (fk subst) subst)
@@ -2977,9 +2985,9 @@
   ; ; (test-check 'lv-elim-4-2
   ; ;   (concretize
   ; ;     (let-lv (v b dummy)
-  ; ;       (@ 
-  ; ; 	(exists (x)
-  ; ; 	  (exists (y)
+  ; ;       (at@ 
+  ; ; 	(_exists (x)
+  ; ; 	  (_exists (y)
   ; ; 	    (== `(,b ,x ,y) `(,x ,y 1))))
   ; ; 	  (lambda@ (fk subst) subst)
   ; ; 	  initial-fk
@@ -2989,9 +2997,9 @@
   ; ; (test-check 'lv-elim-4-3
   ; ;   (concretize
   ; ;     (let-lv (v b dummy)
-  ; ;       (@ 
-  ; ; 	(exists (y)
-  ; ; 	  (exists (x)
+  ; ;       (at@ 
+  ; ; 	(_exists (y)
+  ; ; 	  (_exists (x)
   ; ; 	    (== `(,b ,x ,y) `(,x ,y 1))))
   ; ; 	  (lambda@ (fk subst) subst)
   ; ; 	  initial-fk
@@ -3001,8 +3009,8 @@
   ; (test-check 'lv-elim-4-4
   ;   (reify
   ;     (let-lv (v b dummy)
-  ;       (@ 
-  ; 	(exists (x y)
+  ;       (at@ 
+  ; 	(_exists (x y)
   ; 	    (== `(,b ,x ,y) `(,x ,y 1)))
   ; 	  (lambda@ (fk subst) subst)
   ; 	  initial-fk
@@ -3015,7 +3023,7 @@
   ; (test-check 'lv-elim-5-1
   ;   (reify
   ;     (let-lv (x v b dummy)
-  ;       (@ 
+  ;       (at@ 
   ; 	(let-lv (y)
   ; 	  (== `(,b ,y ,x) `(,x (1 ,x) ,y)))
   ; 	(lambda@ (fk subst) subst)
@@ -3027,9 +3035,9 @@
   ; ; (test-check 'lv-elim-5-2
   ; ;   (concretize
   ; ;     (let-lv (v b dummy)
-  ; ;       (@ 
-  ; ; 	(exists (x)
-  ; ; 	  (exists (y)
+  ; ;       (at@ 
+  ; ; 	(_exists (x)
+  ; ; 	  (_exists (y)
   ; ; 	  (== `(,b ,y ,x) `(,x (1 ,x) ,y))))
   ; ; 	(lambda@ (fk subst) subst)
   ; ; 	initial-fk
@@ -3039,9 +3047,9 @@
   ; ; (test-check 'lv-elim-5-3
   ; ;   (concretize
   ; ;     (let-lv (v b dummy)
-  ; ;       (@ 
-  ; ; 	(exists (y)
-  ; ; 	  (exists (x)
+  ; ;       (at@ 
+  ; ; 	(_exists (y)
+  ; ; 	  (_exists (x)
   ; ; 	  (== `(,b ,y ,x) `(,x (1 ,x) ,y))))
   ; ; 	(lambda@ (fk subst) subst)
   ; ; 	initial-fk
@@ -3051,8 +3059,8 @@
   ; (test-check 'lv-elim-5-4
   ;   (reify
   ;     (let-lv (v b dummy)
-  ;       (@ 
-  ; 	(exists (x y)
+  ;       (at@ 
+  ; 	(_exists (x y)
   ; 	  (== `(,b ,y ,x) `(,x (1 ,x) ,y)))
   ; 	(lambda@ (fk subst) subst)
   ; 	initial-fk
@@ -3094,19 +3102,19 @@
     )
   
     (cout nl "R1:" nl)
-    (pretty-print (solve 10 (x y) (R1 x y)))
+    (_pretty-print (solve 10 (x y) (R1 x y)))
     (cout nl "R2:" nl)
-    (pretty-print (solve 10 (x y) (R2 x y)))
+    (_pretty-print (solve 10 (x y) (R2 x y)))
     (cout nl "R1+R2:" nl)
-    (pretty-print 
+    (_pretty-print 
       (solve 10 (x y)
         ((extend-relation (a1 a2) R1 R2) x y)))
   
     (cout nl "Rinf:" nl)
-    (values (pretty-print (solve 5 (x y) (Rinf x y))))
+    (values (_pretty-print (solve 5 (x y) (Rinf x y))))
     (cout nl "Rinf+R1: Rinf starves R1:" nl)
     (values
-      (pretty-print 
+      (_pretty-print 
         (solve 5 (x y)
   	((extend-relation (a1 a2) Rinf R1) x y))))
   
@@ -3393,7 +3401,8 @@
          ((x.0 (succ (succ (succ (succ (succ zero)))))) (y.0 zero))))
   
     (newline)
-  ))
+  )
+10)
 
 ;; ========================================================================
 ;; type-inference example
@@ -3418,7 +3427,7 @@
 ;
 ; $Id: type-inference.scm,v 4.50 2005/02/12 00:05:01 oleg Exp $
 
-(display "Type inference") (newline)
+; (display "Type inference") (newline)
 
 ; Variation 1: use a subset of Scheme itself as the source language
 ; The following two functions translate between the source language
@@ -3529,12 +3538,12 @@
 
 (define env
   (relation (head-let g v t)
-    (exists (tq)
+    (_exists (tq)
       (all!!
 	(membero `(,v . ,tq) g)
 	(any
 	  (== tq `(non-generic ,t))
-	  (exists (type-gen)
+	  (_exists (type-gen)
 	    (all!!
 	      (== tq `(generic ,type-gen))
 	      (project (type-gen)
@@ -3584,7 +3593,7 @@
 (define app-rel
   (relation (g t rand rator)
     (to-show g `(app ,rator ,rand) t)
-    (exists (t-rand)
+    (_exists (t-rand)
       (all!! (!- g rator `(a--> ,t-rand ,t)) (!- g rand t-rand)))))
 
 (define fix-rel
@@ -3606,7 +3615,7 @@
   (relation (g v rand body t)
     (to-show g `(let ((,v ,rand)) ,body) t)
     (all!!
-      (exists (some-type) (!- g rand some-type))
+      (_exists (some-type) (!- g rand some-type))
       (!- `((,v generic ,(relation (head-let t-rand)
 			   (all!!
 			     (!- g rand t-rand)
@@ -3819,7 +3828,9 @@
         (t.0 a-->)
         (u.0 int)
         (v.0 int))))
-  #t))
+  #t)
+
+10)
 
 ;----------------------------------------------------------------------
 ; A different implementation of type environments
@@ -3834,7 +3845,7 @@
 ; !- as the argument. Actually, they will receive the 'self'-like
 ; argument. We need to explicitly find the fixpoint.
 
-(cout nl "Natural-deduction-like type inference" nl nl)
+; (cout nl "Natural-deduction-like type inference" nl nl)
 
 
 (define pint-rel
@@ -3893,7 +3904,7 @@
     (let ((!- (s!- s!-)))
       (relation (t rand rator)
 	(to-show `(app ,rator ,rand) t)
-	(exists (t-rand)
+	(_exists (t-rand)
 	  (all!! (!- rator `(a--> ,t-rand ,t)) (!- rand t-rand)))))))
 
 (define pfix-rel
@@ -3919,7 +3930,7 @@
       (relation (v rand body t)
 	(to-show `(let ((,v ,rand)) ,body) t)
 	(all!! 
-	  (exists (some-type) (!- rand some-type))
+	  (_exists (some-type) (!- rand some-type))
 	  (let* ((snew-!-
 		   (lambda (self)
 		     (extend-relation (v t)
@@ -4144,7 +4155,8 @@
         (t.0 a-->)
         (u.0 int)
         (v.0 int))))
-  #t))
+  #t)
+10)
 
 
 ; The code below uses the low-level function var? Every use of var?
@@ -4217,15 +4229,16 @@
     (equal?
       (solution (x) (name x '(115 108 101 101 112)))
       '((x.0 sleep))))
-  #t))
+  #t)
+10)
 
 ;; ========================================================================
 ;; typeclasses example
 ;; ========================================================================
 
-(newline)
-(display "Checking for dependency satisfaction in Haskell typeclasses")
-(newline)
+;(newline)
+;(display "Checking for dependency satisfaction in Haskell typeclasses")
+;(newline)
 ; Suppose we have the following Haskell class and instance declarations
 ;      class C a b c | a b -> c 
 ;      instance C a b c => C a (x,y,b) c
@@ -4261,10 +4274,10 @@
       (fails (project/no-check (c1 c2) (predicate (*equal? c1 c2)))))))
 
 ; This does loop
-'(define typeclass-C
-   (extend-relation (a b c) 
-     typeclass-C-instance-1
-     typeclass-C-instance-2))
+;'(define typeclass-C
+;   (extend-relation (a b c) 
+;     typeclass-C-instance-1
+;     typeclass-C-instance-2))
 
 (define typeclass-C/x
   (extend-relation-with-recur-limit 2 (a b c)
@@ -4359,13 +4372,15 @@
   (test-check "Typechecking (open world) f [x] int" 
               (solve 4 (a) (typeclass-F-instance-1 `(list ,a) 'int))
               '())					; meaning: does not typecheck!
+
+  10
   )
 
 ;; ========================================================================
 ;; zebra example
 ;; ========================================================================
 
-(display "Zebra") (newline)
+; (display "Zebra") (newline)
 
 ;   1. There are five houses in a row, each of a different color
 ;       and inhabited by men of different nationalities,
@@ -4392,9 +4407,9 @@
 
 (define memb 
   (relation (head-let item lst) 
-    (any (== lst `(,item . ,_))
-      (exists (rest)
-	(if-only (== lst `(,_ . ,rest)) (memb item rest))))))
+    (any (== lst `(,item . ,__))
+      (_exists (rest)
+	(if-only (== lst `(,__ . ,rest)) (memb item rest))))))
 
 
 (define next-to
@@ -4403,38 +4418,38 @@
 
 (define on-right
   (extend-relation (a0 a1 a2)
-    (fact (item1 item2) item1 item2 `(,item1 ,item2 . ,_))
+    (fact (item1 item2) item1 item2 `(,item1 ,item2 . ,__))
     (relation ((once item1) (once item2) rest)
-      (to-show item1 item2 `(,_ . ,rest))
+      (to-show item1 item2 `(,__ . ,rest))
       (on-right item1 item2 rest))))
         
 (define zebra
   (relation (head-let h)
     (if-only
       (all!
-        (== h `((norwegian ,_ ,_ ,_ ,_) ,_ (,_ ,_ milk ,_ ,_) ,_ ,_))
-        (memb `(englishman ,_ ,_ ,_ red) h)
-        (on-right `(,_ ,_ ,_ ,_ ivory) `(,_ ,_ ,_ ,_ green) h)
-        (next-to `(norwegian ,_ ,_ ,_ ,_) `(,_ ,_ ,_ ,_ blue) h)
-        (memb `(,_ kools ,_ ,_ yellow) h)
-        (memb `(spaniard ,_ ,_ dog ,_) h)
-        (memb `(,_ ,_ coffee ,_ green) h) 
-        (memb `(ukrainian ,_ tea ,_ ,_) h)
-        (memb `(,_ luckystrikes oj ,_ ,_) h)
-        (memb `(japanese parliaments ,_ ,_ ,_) h)
-        (memb `(,_ oldgolds ,_ snails ,_) h)
-        (next-to `(,_ ,_ ,_ horse ,_) `(,_ kools ,_ ,_ ,_) h)
-        (next-to `(,_ ,_ ,_ fox ,_) `(,_ chesterfields ,_ ,_ ,_) h)
+        (== h `((norwegian ,__ ,__ ,__ ,__) ,__ (,__ ,__ milk ,__ ,__) ,__ ,__))
+        (memb `(englishman ,__ ,__ ,__ red) h)
+        (on-right `(,__ ,__ ,__ ,__ ivory) `(,__ ,__ ,__ ,__ green) h)
+        (next-to `(norwegian ,__ ,__ ,__ ,__) `(,__ ,__ ,__ ,__ blue) h)
+        (memb `(,__ kools ,__ ,__ yellow) h)
+        (memb `(spaniard ,__ ,__ dog ,__) h)
+        (memb `(,__ ,__ coffee ,__ green) h) 
+        (memb `(ukrainian ,__ tea ,__ ,__) h)
+        (memb `(,__ luckystrikes oj ,__ ,__) h)
+        (memb `(japanese parliaments ,__ ,__ ,__) h)
+        (memb `(,__ oldgolds ,__ snails ,__) h)
+        (next-to `(,__ ,__ ,__ horse ,__) `(,__ kools ,__ ,__ ,__) h)
+        (next-to `(,__ ,__ ,__ fox ,__) `(,__ chesterfields ,__ ,__ ,__) h)
         )
-      (all (memb `(,_ ,_ water ,_ ,_) h)
-	(memb `(,_ ,_ ,_ zebra ,_) h)))))
+      (all (memb `(,__ ,__ water ,__ ,__) h)
+	(memb `(,__ ,__ ,__ zebra ,__) h)))))
 
-'(pretty-print
-  (time (let loop ((n 100000))
-              (cond
-                ((zero? n) 'done)
-                (else (solution (h) (zebra h))
-                  (loop (sub1 n)))))))
+;'(_pretty-print
+;  (time (let loop ((n 100000))
+;              (cond
+;                ((zero? n) 'done)
+;                (else (solution (h) (zebra h))
+;                  (loop (sub1 n)))))))
 
 (define (zebra-test)
 (test-check "Zebra"
@@ -4443,7 +4458,8 @@
           (ukrainian chesterfields tea horse blue)
           (englishman oldgolds milk snails red)
           (spaniard luckystrikes oj dog ivory)
-          (japanese parliaments coffee zebra green))))))
+          (japanese parliaments coffee zebra green)))))
+10)
 
 ; Sample timing (Pentium IV, 2GHz, 1GB RAM)
 ; (time (solution (h) ...))
@@ -4550,7 +4566,7 @@
 ; we need to check if terms  btree(T1) and  btree(T2) are consistent.
 ; Thus, to add btree(root(T1,T2)) to our database, we need to use
 ; the database itself to verify btree(T1) and btree(T2). Clearly,
-; we need a fixpoint. The need for the fixpoint exists no matter what is
+; we need a fixpoint. The need for the fixpoint _exists no matter what is
 ; the representation of the database -- a finite map or a relation.
 ; Prolog solves the fixpoint problem by making the database global
 ; and using mutations (similar to the way letrec is implemented in Scheme).
@@ -4884,7 +4900,9 @@
       (let ((kb1 (goal-fwd kb)))
 	(kb1 '(goal (root t1 t2)))))
     (cout (reify-subst '() subst) nl) #t)
-  #t))
+  #t)
+
+10)
 
 
 ; Again, we use Y because btree and mirror-axiom-eq-2 are recursive.
@@ -4921,7 +4939,7 @@
 	  (kb `(myeq ,b ,a))))
       (relation (a b)			; transitivity
 	(to-show `(myeq ,a ,b))
-	(exists (c)
+	(_exists (c)
 	  (all
 	    (kb `(myeq ,a ,c))
 	    (kb `(myeq ,c ,b)))))
@@ -4945,7 +4963,7 @@
 	(to-show `(myeq (mirror ,a) ,b))
 	(all
 	  (trace-vars 'mirror (a b))
-	  (exists (c)
+	  (_exists (c)
 	    (all (kb `(myeq ,b (mirror ,c)))
 	         (kb `(myeq ,a ,c)))))))))
 
@@ -5010,7 +5028,7 @@
 (define-syntax un@ ; uncurry 
   (syntax-rules ()
     ((_ proc arg1 ...)
-      (lambda (arg1 ...) (@ proc arg1 ...)))))
+      (lambda (arg1 ...) (at@ proc arg1 ...)))))
 
 ; The initial assumptions: just the btrii
 ;(define init-kb (Y btrii))
@@ -5091,7 +5109,8 @@
       ;(solve 1 (x) (kb `(myeq (root t1 t2)  (mirror ,x))))
       (solve 1 (x) (kb `(myeq ,x (mirror (root t1 t2)))))
       )))
-)
+
+10)
 
 ;; ========================================================================
 ;; pure bin arith example
@@ -5108,7 +5127,7 @@
 ; aka: division as relation.
 ; The function divo below is a KANREN relation between four binary numerals
 ; n, m, q, and r such that the following holds
-;	exists r. 0<=r<m, n = q*m + r
+;	_exists r. 0<=r<m, n = q*m + r
 ;
 ; The relation 'divo' encompasses all four operations of arithmetics:
 ; we can use (divo x y z zero) to multiply and divide and
@@ -5224,11 +5243,11 @@
 
 ; Not a zero
 (define pos
-  (fact () `(,_ . ,_)))
+  (fact () `(,__ . ,__)))
 
 ; At least two
 (define gt1
-  (fact () `(,_ ,_ . ,_)))
+  (fact () `(,__ ,__ . ,__)))
 
 ; compare the lengths of two numerals
 ; (<ol a b) 
@@ -5238,9 +5257,9 @@
 ; We also make sure that 'n' is a well-formed number.
 (define <ol
   (extend-relation (n m)
-    (fact () '() `(,_ . ,_))
-    (fact () '(1) `(,_ ,_ . ,_))
-    (relation (x y x1 y1) (to-show `(,_ ,x1 . ,x) `(,_ ,y1 . ,y))
+    (fact () '() `(,__ . ,__))
+    (fact () '(1) `(,__ ,__ . ,__))
+    (relation (x y x1 y1) (to-show `(,__ ,x1 . ,x) `(,__ ,y1 . ,y))
       (<ol `(,x1 . ,x) `(,y1 . ,y)))))
 
 ; holds if both a and b have the same number of bits, i.e., they are zero
@@ -5249,7 +5268,7 @@
   (extend-relation (n m)
     (fact () '() '())
     (fact () '(1) '(1))
-    (relation (x y x1 y1) (to-show `(,_ ,x1 . ,x) `(,_ ,y1 . ,y))
+    (relation (x y x1 y1) (to-show `(,__ ,x1 . ,x) `(,__ ,y1 . ,y))
       (=ol `(,x1 . ,x) `(,y1 . ,y)))))
 
 ; (<ol3 p1 p n m) holds iff
@@ -5259,16 +5278,16 @@
   (relation (head-let p1 p n m)
     (any
       (all (== p1 '()) (pos p))
-      (exists (p1r pr)
+      (_exists (p1r pr)
 	(all
-	  (== p1 `(,_ . ,p1r))
-	  (== p  `(,_ . ,pr))
+	  (== p1 `(,__ . ,p1r))
+	  (== p  `(,__ . ,pr))
 	  (any-interleave
-	    (exists (mr)
-	      (all (== n '()) (== m  `(,_ . ,mr)) 
+	    (_exists (mr)
+	      (all (== n '()) (== m  `(,__ . ,mr)) 
 		(<ol3 p1r pr n mr)))
-	    (exists (nr)
-	      (all (== n  `(,_ . ,nr)) 
+	    (_exists (nr)
+	      (all (== n  `(,__ . ,nr)) 
 		(<ol3 p1r pr nr m)))
 	    ))))))
 
@@ -5282,13 +5301,13 @@
       (all (== p '()) (== n '()) (== m '()))
       (all (== p '()) (== n '()) (== m '(1)))
       (all (== p '()) (== n '(1)) (== m '()))
-      (exists (pr mr)
+      (_exists (pr mr)
 	(all
-	  (== p `(,_ . ,pr)) (== n '()) (== m `(,_ . ,mr))
+	  (== p `(,__ . ,pr)) (== n '()) (== m `(,__ . ,mr))
 	  (<ol2 pr '() mr)))
-      (exists (pr nr)
+      (_exists (pr nr)
 	(all
-	  (== p `(,_ . ,pr)) (== n `(,_ . ,nr))
+	  (== p `(,__ . ,pr)) (== n `(,__ . ,nr))
 	  (<ol2 pr nr m)))
       )))
 
@@ -5319,57 +5338,56 @@
 ; one. So, we have already two cases to consider per each number: The
 ; number has no bits, and the number has some bits.
 
-'
-(define full-adder
-  (extend-relation (carry-in a b r)
-    (fact (a) 0 a '() a) 		; 0 + a + 0 = a
-    (relation (b)			; 0 + 0 + b = b
-      (to-show 0 '() b b)
-      (pos b))
-    (relation (head-let '1 a '() r)	; 1 + a + 0 = 0 + a + 1
-      (full-adder 0 a '(1) r))
-    (relation (head-let '1 '() b r)	; 1 + 0 + b = 0 + 1 + b
-      (all (pos b)
-	(full-adder 0 '(1) b r)))
-
-    ; The following three relations are needed
-    ; to make all numbers well-formed by construction,
-    ; that is, to make sure the higher-order bit is one.
-    (relation (head-let carry-in '(1) '(1) r)	; c + 1 + 1 >= 2
-      (exists (r1 r2)
-	(all (== r `(,r1 ,r2))
-	     (half-adder carry-in 1 1 r1 r2))))
-
-    ; cin + 1 + (2*br + bb) = (2*rr + rb) where br > 0 and so is rr > 0
-    (relation (carry-in bb br rb rr)
-      (to-show carry-in '(1) `(,bb . ,br) `(,rb . ,rr))
-      (all
-	(pos br) (pos rr)
-	(exists (carry-out)
-	  (all
-	    (half-adder carry-in 1 bb rb carry-out)
-	    (full-adder carry-out '() br rr)))))
-
-    ; symmetric case for the above
-    (relation (head-let carry-in a '(1) r)
-      (all
-	(gt1 a) (gt1 r)
-	(full-adder carry-in '(1) a r)))
-
-    ; carry-in + (2*ar + ab) + (2*br + bb) 
-    ; = (carry-in + ab + bb) (mod 2)
-    ; + 2*(ar + br + (carry-in + ab + bb)/2)
-    ; The cases of ar= 0 or br = 0 have already been handled.
-    ; So, now we require ar >0 and br>0. That implies that rr>0.
-    (relation (carry-in ab ar bb br rb rr)
-      (to-show carry-in `(,ab . ,ar) `(,bb . ,br) `(,rb . ,rr))
-      (all
-	(pos ar) (pos br) (pos rr)
-	(exists (carry-out)
-	  (all
-	    (half-adder carry-in ab bb rb carry-out)
-	    (full-adder carry-out ar br rr))))
-    )))
+; (define full-adder
+;   (extend-relation (carry-in a b r)
+;     (fact (a) 0 a '() a) 		; 0 + a + 0 = a
+;     (relation (b)			; 0 + 0 + b = b
+;       (to-show 0 '() b b)
+;       (pos b))
+;     (relation (head-let '1 a '() r)	; 1 + a + 0 = 0 + a + 1
+;       (full-adder 0 a '(1) r))
+;     (relation (head-let '1 '() b r)	; 1 + 0 + b = 0 + 1 + b
+;       (all (pos b)
+; 	(full-adder 0 '(1) b r)))
+; 
+;     ; The following three relations are needed
+;     ; to make all numbers well-formed by construction,
+;     ; that is, to make sure the higher-order bit is one.
+;     (relation (head-let carry-in '(1) '(1) r)	; c + 1 + 1 >= 2
+;       (_exists (r1 r2)
+; 	(all (== r `(,r1 ,r2))
+; 	     (half-adder carry-in 1 1 r1 r2))))
+; 
+;     ; cin + 1 + (2*br + bb) = (2*rr + rb) where br > 0 and so is rr > 0
+;     (relation (carry-in bb br rb rr)
+;       (to-show carry-in '(1) `(,bb . ,br) `(,rb . ,rr))
+;       (all
+; 	(pos br) (pos rr)
+; 	(_exists (carry-out)
+; 	  (all
+; 	    (half-adder carry-in 1 bb rb carry-out)
+; 	    (full-adder carry-out '() br rr)))))
+; 
+;     ; symmetric case for the above
+;     (relation (head-let carry-in a '(1) r)
+;       (all
+; 	(gt1 a) (gt1 r)
+; 	(full-adder carry-in '(1) a r)))
+; 
+;     ; carry-in + (2*ar + ab) + (2*br + bb) 
+;     ; = (carry-in + ab + bb) (mod 2)
+;     ; + 2*(ar + br + (carry-in + ab + bb)/2)
+;     ; The cases of ar= 0 or br = 0 have already been handled.
+;     ; So, now we require ar >0 and br>0. That implies that rr>0.
+;     (relation (carry-in ab ar bb br rb rr)
+;       (to-show carry-in `(,ab . ,ar) `(,bb . ,br) `(,rb . ,rr))
+;       (all
+; 	(pos ar) (pos br) (pos rr)
+; 	(_exists (carry-out)
+; 	  (all
+; 	    (half-adder carry-in ab bb rb carry-out)
+; 	    (full-adder carry-out ar br rr))))
+;     )))
 
 ; After we have checked that  both summands have some bits, and so we
 ; can decompose them the least-significant bit and the other ones, it appears
@@ -5384,7 +5402,7 @@
 ; uninstantiated variables. We don't know which are the input and which
 ; are the output. So, if we keep only the last relation for the
 ; case of positive summands, and try to
-;	(exists (x) (full-adder 0 (1 . ()) x (0 1 . ())))
+;	(_exists (x) (full-adder 0 (1 . ()) x (0 1 . ())))
 ; we will see x bound to (1 0) -- an invalid number. So, our adder, when
 ; asked to subtract numbers, gave a bad number. And it would give us
 ; a bad number in all the cases when we use it to subtract numbers and
@@ -5433,9 +5451,63 @@
 ; version would be minimal and without loss of speed.
 
 ; The following full-adder* is almost the same as full-adder above.
-'
-(define full-adder*
-  (extend-relation (carry-in a b r)
+; 
+; (define full-adder*
+;   (extend-relation (carry-in a b r)
+; ;     (fact (a) 0 a '() a) 		; 0 + a + 0 = a
+; ;     (relation (b)			; 0 + 0 + b = b
+; ;       (to-show 0 '() b b)
+; ;       (pos b))
+; ;     (relation (head-let '1 a '() r)	; 1 + a + 0 = 0 + a + 1
+; ;       (full-adder 0 a '(1) r))
+; ;     (relation (head-let '1 '() b r)	; 1 + 0 + b = 0 + 1 + b
+; ;       (all (pos b)
+; ; 	(full-adder 0 '(1) b r)))
+; 
+;     ; The following three relations are needed
+;     ; to make all numbers well-formed by construction,
+;     ; that is, to make sure the higher-order bit is one.
+;     (relation (head-let carry-in '(1) '(1) r)	; c + 1 + 1 >= 2
+;       (_exists (r1 r2)
+; 	(all (== r `(,r1 ,r2))
+; 	     (half-adder carry-in 1 1 r1 r2))))
+; 
+;     ; cin + 1 + (2*br + bb) = (2*rr + rb) where br > 0 and so is rr > 0
+;     (relation (carry-in bb br rb rr)
+;       (to-show carry-in '(1) `(,bb . ,br) `(,rb . ,rr))
+;       (all
+; 	(pos br) (pos rr)
+; 	(_exists (carry-out)
+; 	  (all
+; 	    (half-adder carry-in 1 bb rb carry-out)
+; 	    (full-adder carry-out '() br rr)))))
+; 
+;     ; symmetric case for the above
+;     (relation (head-let carry-in a '(1) r)
+;       (all
+; 	(gt1 a) (gt1 r)
+; 	(full-adder* carry-in '(1) a r)))
+; 
+;     ; carry-in + (2*ar + ab) + (2*br + bb) 
+;     ; = (carry-in + ab + bb) (mod 2)
+;     ; + 2*(ar + br + (carry-in + ab + bb)/2)
+;     ; The cases of ar= 0 or br = 0 have already been handled.
+;     ; So, now we require ar >0 and br>0. That implies that rr>0.
+;     (relation (carry-in ab ar bb br rb rr)
+;       (to-show carry-in `(,ab . ,ar) `(,bb . ,br) `(,rb . ,rr))
+;       (all
+; 	(pos ar) (pos br) (pos rr)
+; 	(_exists (carry-out)
+; 	  (all
+; 	    (half-adder carry-in ab bb rb carry-out)
+; 	    (full-adder* carry-out ar br rr))))
+;     )))
+
+; This driver handles the trivial cases and then invokes full-adder*
+; coupled with the recursively enumerating generator.
+
+; (define full-adder
+;   (extend-relation (carry-in a b r)
 ;     (fact (a) 0 a '() a) 		; 0 + a + 0 = a
 ;     (relation (b)			; 0 + 0 + b = b
 ;       (to-show 0 '() b b)
@@ -5445,73 +5517,18 @@
 ;     (relation (head-let '1 '() b r)	; 1 + 0 + b = 0 + 1 + b
 ;       (all (pos b)
 ; 	(full-adder 0 '(1) b r)))
-
-    ; The following three relations are needed
-    ; to make all numbers well-formed by construction,
-    ; that is, to make sure the higher-order bit is one.
-    (relation (head-let carry-in '(1) '(1) r)	; c + 1 + 1 >= 2
-      (exists (r1 r2)
-	(all (== r `(,r1 ,r2))
-	     (half-adder carry-in 1 1 r1 r2))))
-
-    ; cin + 1 + (2*br + bb) = (2*rr + rb) where br > 0 and so is rr > 0
-    (relation (carry-in bb br rb rr)
-      (to-show carry-in '(1) `(,bb . ,br) `(,rb . ,rr))
-      (all
-	(pos br) (pos rr)
-	(exists (carry-out)
-	  (all
-	    (half-adder carry-in 1 bb rb carry-out)
-	    (full-adder carry-out '() br rr)))))
-
-    ; symmetric case for the above
-    (relation (head-let carry-in a '(1) r)
-      (all
-	(gt1 a) (gt1 r)
-	(full-adder* carry-in '(1) a r)))
-
-    ; carry-in + (2*ar + ab) + (2*br + bb) 
-    ; = (carry-in + ab + bb) (mod 2)
-    ; + 2*(ar + br + (carry-in + ab + bb)/2)
-    ; The cases of ar= 0 or br = 0 have already been handled.
-    ; So, now we require ar >0 and br>0. That implies that rr>0.
-    (relation (carry-in ab ar bb br rb rr)
-      (to-show carry-in `(,ab . ,ar) `(,bb . ,br) `(,rb . ,rr))
-      (all
-	(pos ar) (pos br) (pos rr)
-	(exists (carry-out)
-	  (all
-	    (half-adder carry-in ab bb rb carry-out)
-	    (full-adder* carry-out ar br rr))))
-    )))
-
-; This driver handles the trivial cases and then invokes full-adder*
-; coupled with the recursively enumerating generator.
-
-'
-(define full-adder
-  (extend-relation (carry-in a b r)
-    (fact (a) 0 a '() a) 		; 0 + a + 0 = a
-    (relation (b)			; 0 + 0 + b = b
-      (to-show 0 '() b b)
-      (pos b))
-    (relation (head-let '1 a '() r)	; 1 + a + 0 = 0 + a + 1
-      (full-adder 0 a '(1) r))
-    (relation (head-let '1 '() b r)	; 1 + 0 + b = 0 + 1 + b
-      (all (pos b)
-	(full-adder 0 '(1) b r)))
-    (relation (head-let carry-in a b r)
-      (any-interleave
-	; Note that we take advantage of the fact that if
-	; a + b = r and length(b) <= length(a) then length(a) <= length(r)
-	(all (<ol a `(,_ . ,r))		; or, length(a) < length(2*r)
-	  (any (<ol b a) (=ol b a))
-	  (full-adder* carry-in a b r))
-	; commutative case, length(a) < length(b)
-	(all (<ol b `(,_ . ,r))
-	  (<ol a b)
-	  (full-adder* carry-in a b r))
-	))))
+;     (relation (head-let carry-in a b r)
+;       (any-interleave
+; 	; Note that we take advantage of the fact that if
+; 	; a + b = r and length(b) <= length(a) then length(a) <= length(r)
+; 	(all (<ol a `(,_ . ,r))		; or, length(a) < length(2*r)
+; 	  (any (<ol b a) (=ol b a))
+; 	  (full-adder* carry-in a b r))
+; 	; commutative case, length(a) < length(b)
+; 	(all (<ol b `(,_ . ,r))
+; 	  (<ol a b)
+; 	  (full-adder* carry-in a b r))
+; 	))))
 
 ; There is the third way of doing the addition, using
 ; all-interleave and any-interleave.
@@ -5548,7 +5565,7 @@
     ; to make all numbers well-formed by construction,
     ; that is, to make sure the higher-order bit is one.
     (relation (head-let carry-in '(1) '(1) r)	; c + 1 + 1 >= 2
-      (exists (r1 r2)
+      (_exists (r1 r2)
 	(all (== r `(,r1 ,r2))
 	     (half-adder carry-in 1 1 r1 r2))))
 
@@ -5557,7 +5574,7 @@
       (to-show carry-in '(1) `(,bb . ,br) `(,rb . ,rr))
       (all
 	(pos br) (pos rr)
-	(exists (carry-out)
+	(_exists (carry-out)
 	  (all-interleave
 	    (half-adder carry-in 1 bb rb carry-out)
 	    (full-adder carry-out '() br rr)))))
@@ -5577,7 +5594,7 @@
       (to-show carry-in `(,ab . ,ar) `(,bb . ,br) `(,rb . ,rr))
       (all
 	(pos ar) (pos br) (pos rr)
-	(exists (carry-out)
+	(_exists (carry-out)
 	  (all-interleave
 	    (half-adder carry-in ab bb rb carry-out)
 	    (full-adder carry-out ar br rr))))
@@ -5594,22 +5611,21 @@
     (a++o y out x)))
 
 
-' 
-(define <o  ; n < m iff exists x >0 such that n + x = m
-  (relation (head-let n m)
-    (exists (x) (all (pos x) (a++o n x m)))))
+;(define <o  ; n < m iff _exists x >0 such that n + x = m
+;  (relation (head-let n m)
+;    (_exists (x) (all (pos x) (a++o n x m)))))
 
 ; The following is an optimization: it is easier to test for the
 ; length of two numbers. If one number has fewer bits than the other number,
 ; the former is clearly shorter (provided that the numbers are well-formed,
 ; that is, the higher-order bit is one). So we don't need to go through
 ; the trouble of subtracting them.
-(define <o  ; n < m iff exists x >0 such that n + x = m
+(define <o  ; n < m iff _exists x >0 such that n + x = m
   (relation (head-let n m)
     (any-interleave
       (<ol n m)
       (all (=ol n m)
-	(exists (x) (all (pos x) (a++o n x m)))))))
+	(_exists (x) (all (pos x) (a++o n x m)))))))
 
 
 ; n * m = p
@@ -5623,7 +5639,7 @@
 
       ; (2*nr) * m = 2*(nr*m), m>0 (the case of m=0 is taken care of already)
       ; nr > 0, otherwise the number is ill-formed
-      (exists (nr pr)
+      (_exists (nr pr)
 	(all
 	  (gt1 m)
 	  (== n `(0 . ,nr))
@@ -5632,9 +5648,9 @@
 	  (**o nr m pr)))
 
       ; The symmetric case to the above: m is even, n is odd
-      (exists (mr pr)
+      (_exists (mr pr)
 	(all
-	  (== n `(1 ,_ . ,_))		; n is odd and n > 1
+	  (== n `(1 ,__ . ,__))		; n is odd and n > 1
 	  (== m `(0 . ,mr))
 	  (== p `(0 . ,pr))
 	  (pos mr) (pos pr)
@@ -5645,9 +5661,9 @@
       ; the result is certainly greater than 1.
       ; we note that m > 0 and so 2*(nr*m) < 2*(nr*m) + m
       ; and (floor (log2 (nr*m))) < (floor (log2 (2*(nr*m) + m)))
-      (exists (nr p1)
+      (_exists (nr p1)
 	(all
-	  (== m `(1 ,_ . ,_))		; m is odd and n > 1
+	  (== m `(1 ,__ . ,__))		; m is odd and n > 1
 	  (== n `(1 . ,nr))
 	  (pos nr) (gt1 p)
 	  (<ol3 p1 p n m)
@@ -5661,44 +5677,44 @@
 ; This is divo from pure-arithm.scm
 ; it still works -- but very slow for some operations
 ; because <o takes linear time...
-'
-(define divo
-  (relation (head-let n m q r)
-    (any-interleave
-      (all (== q '()) (== r n) (<o n m))      ; if n < m, then q=0, n=r
-      (all (== n m) (== q '(1)) (== r '()))  ; n = 1*n + 0
-      (exists (p)
-	(all (<o m n) (<o r m)  (a++o p r n) ;(trace-vars 1 (p r n))
-	  (**o q m p))))))
+
+;(define divo
+;  (relation (head-let n m q r)
+;    (any-interleave
+;      (all (== q '()) (== r n) (<o n m))      ; if n < m, then q=0, n=r
+;      (all (== n m) (== q '(1)) (== r '()))  ; n = 1*n + 0
+;      (_exists (p)
+;	(all (<o m n) (<o r m)  (a++o p r n) ;(trace-vars 1 (p r n))
+;	  (**o q m p))))))
 
 ; A faster divo algorithm
-'
-(define divo
-  (relation (head-let n m q r)
-    (any-interleave
-      (all (== r n) (== q '()) (<ol n m) (<o n m)) ; m has more digits than n: q=0,n=r
-      (all
-	(<ol m n)			; n has mode digits than m
-					; q is not zero, n>0, so q*m <= n,
-	(exists (p)			; definitely q*m < 2*n
-	  (all (<o r m) (<ol p `(0 . ,n))
-	    (a++o p r n) ;(trace-vars 1 (p r n))
-	    (**o q m p)))
-	)
-      ; n has the same number of digits than m
-      (all (== q '(1)) (=ol n m) (a++o r m n) (<o r m))
-      (all (== q '()) (== r n) (=ol n m) (<o n m))  ; if n < m, then q=0, n=r
-      )))
-; 	(any-interleave
-; 	  (all (== m '(1)) (== r '()) (== n q)) ; n = n*1 + 0
-; 	  ; For even divisors:
-; 	  ; n = (2*m)*q + r => (n - r) is even and (n-r)/2 = m*q
-; 	  (exists (p m1)
-; 	    (all (== m `(0 . ,m1))
-; 	         (== m1 `(_, . ,_))
-; 	         (**o m1 q p)
-; 	         (a--o n r `(0 . ,p))))
-
+; 
+; (define divo
+;   (relation (head-let n m q r)
+;     (any-interleave
+;       (all (== r n) (== q '()) (<ol n m) (<o n m)) ; m has more digits than n: q=0,n=r
+;       (all
+; 	(<ol m n)			; n has mode digits than m
+; 					; q is not zero, n>0, so q*m <= n,
+; 	(_exists (p)			; definitely q*m < 2*n
+; 	  (all (<o r m) (<ol p `(0 . ,n))
+; 	    (a++o p r n) ;(trace-vars 1 (p r n))
+; 	    (**o q m p)))
+; 	)
+;       ; n has the same number of digits than m
+;       (all (== q '(1)) (=ol n m) (a++o r m n) (<o r m))
+;       (all (== q '()) (== r n) (=ol n m) (<o n m))  ; if n < m, then q=0, n=r
+;       )))
+; ; 	(any-interleave
+; ; 	  (all (== m '(1)) (== r '()) (== n q)) ; n = n*1 + 0
+; ; 	  ; For even divisors:
+; ; 	  ; n = (2*m)*q + r => (n - r) is even and (n-r)/2 = m*q
+; ; 	  (_exists (p m1)
+; ; 	    (all (== m `(0 . ,m1))
+; ; 	         (== m1 `(__, . ,__))
+; ; 	         (**o m1 q p)
+; ; 	         (a--o n r `(0 . ,p))))
+; 
 
 ; A faster and more refutationally complete divo algorithm
 ; Again, divo n m q r 
@@ -5745,7 +5761,7 @@
 					; Note that m is L-instantiated here
 	(<o r m)			; r is L-instantiated
 	(pos q)				; q must be positive then
-	(exists (n1 n2 q1 q2 q2m q2mr rr r1)
+	(_exists (n1 n2 q1 q2 q2m q2mr rr r1)
 	  (all-interleave
 	    (split n r n1 n2)
 	    (split q r q1 q2)
@@ -5775,17 +5791,17 @@
 
 (define split
   (extend-relation-interleave (n r n1 n2)
-    (fact () '() _ '() '())
+    (fact () '() __ '() '())
     (fact (b n) `(0 ,b . ,n) '() `(,b . ,n) '())
     (fact (n) `(1 . ,n) '() n '(1))
     (relation (b n r n1)
-      (to-show `(0 ,b . ,n) `(,_ . ,r) n1 '())
+      (to-show `(0 ,b . ,n) `(,__ . ,r) n1 '())
       (split `(,b . ,n) r n1 '()))
     (relation (n r n1)
-      (to-show `(1 . ,n) `(,_ . ,r) n1 '(1))
+      (to-show `(1 . ,n) `(,__ . ,r) n1 '(1))
       (split n r n1 '()))
     (relation (b n r n1 n2)
-      (to-show `(,b . ,n) `(,_ . ,r) n1 `(,b . ,n2))
+      (to-show `(,b . ,n) `(,__ . ,r) n1 `(,b . ,n2))
       (all (pos n2)
 	(split n r n1 n2)))
 ))
@@ -5839,20 +5855,20 @@
   (relation (head-let n b q)
     (any-interleave
       (all (== n '(1)) (== q '()))  ; 1 = b^0
-      (all (gt1 n) (== q '(1)) (split n b '(1) _))
-      (exists (q1 b2)			; n = (2^k)^(2*q) + r
+      (all (gt1 n) (== q '(1)) (split n b '(1) __))
+      (_exists (q1 b2)			; n = (2^k)^(2*q) + r
 	(all-interleave                 ;   = (2^(2*k))^q + r
 	     (== q `(0 . ,q1))
 	     (pos q1)
 	     (<ol b n)
 	     (r-append b `(1 . ,b) b2)
 	     (exp2 n b2 q1)))
-      (exists (q1 n1 b2)		; n = (2^k)^(2*q+1) + r
+      (_exists (q1 n1 b2)		; n = (2^k)^(2*q+1) + r
 	(all-interleave 		; n/(2^k) = (2^(2*k))^q + r'
 	     (== q `(1 . ,q1))
 	     (pos q1)
 	     (pos n1)
-	     (split n b n1 _)
+	     (split n b n1 __)
 	     (r-append b `(1 . ,b) b2)
 	     (exp2 n1 b2 q1)))
       )))
@@ -5862,12 +5878,12 @@
 ; nq = n^q where n is L-instantiated and q is fully instantiated
 (define repeated-mul
   (extend-relation (n q nq)
-    (fact () `(,_ . ,_) '() '(1))
+    (fact () `(,__ . ,__) '() '(1))
     (fact (n) n '(1) n)
     (relation (head-let n q nq)
       (all
 	(gt1 q)
-	(exists (q1 nq1)
+	(_exists (q1 nq1)
 	  (all
 	    (a++o q1 '(1) q)
 	    (repeated-mul n q1 nq1)
@@ -5889,19 +5905,19 @@
       (all (== b '()) (pos q) (== r n))         ; n = 0^q + n, q>0
       ; in the rest, n is longer than b
       (all (== b '(0 1))		; b = 2
-	   (exists (n1)
+	   (_exists (n1)
 	     (all
 	       (pos n1)
-	       (== n `(,_ ,_ . ,n1))    ; n is at least 4
+	       (== n `(,__ ,__ . ,n1))    ; n is at least 4
 	       (exp2 n '() q)		; that will L-instantiate n and n1
-	       (split n n1 _ r))))
+	       (split n n1 __ r))))
       ; the general case
       (all
-	(any (== b '(1 1)) (== b `(,_ ,_ ,_ . ,_))) ; b >= 3
+	(any (== b '(1 1)) (== b `(,__ ,__ ,__ . ,__))) ; b >= 3
 	(<ol b n)			; b becomes L-instantiated
 	                                ; If b was L-instantiated, the previous
 					; goal had only *one* answer
-	(exists (bw nw nw1 bw1 ql1 ql qh qdh qd bql bqd bq bq1)
+	(_exists (bw nw nw1 bw1 ql1 ql qh qdh qd bql bqd bq bq1)
 	 (all
 	  (exp2 b '() bw1)
 	  (a++o bw1 '(1) bw)
@@ -5909,7 +5925,7 @@
 					; sure q will be L-instatiated
 					; Now, we can use b and q to bound n
 					; |n|-1 < |b|*(q+1)
-	  (exists (q1 bwq1)
+	  (_exists (q1 bwq1)
 	    (all
 	      (a++o q '(1) q1)
 	      (**o bw q1 bwq1)		; |b|*(q+1)
@@ -5917,11 +5933,11 @@
 	  (exp2 n '() nw1)		; n becomes L-instantiated
 					; Now we have only finite number of ans
 	  (a++o nw1 '(1) nw)
-	  (divo nw bw ql1 _)		; low boundary on q:
+	  (divo nw bw ql1 __)		; low boundary on q:
 	  (a++o ql '(1) ql1)		; |n| = |b|(ql+1) + c
 	  (any (== q ql) (<ol ql q))	; Tighten the estimate for q
 	  (repeated-mul b ql bql)	; bql = b^ql
-	  (divo nw bw1 qh _)		; upper boundary on q-1
+	  (divo nw bw1 qh __)		; upper boundary on q-1
 	  (a++o ql qdh qh)
 	  (a++o ql qd q)
 	  (any (== qd qdh) (<o qd qdh)) ; qd is bounded
@@ -5958,7 +5974,7 @@
 (test (x) (a++o x (build 3) (build 29)))
 (test-check "all numbers that sum to 4"
   (solve 10 (w)
-    (exists (y z)
+    (_exists (y z)
       (all (a++o y z (build 4))
 	(project (y z) (== `(,(trans y) ,(trans z)) w)))))
    '(((w.0 (4 0)))
@@ -5998,7 +6014,7 @@
 (test-check "strong commutativity"
   (solve 5 (a b c)
     (all (a++o a b c)
-    (exists (x y z)
+    (_exists (x y z)
       (all!
 	(a++o x y z)
 	(== x b)
@@ -6074,14 +6090,14 @@
   '())
 (test-check 'multiplication-all-1
   (solve 7 (w) 
-    (exists (y z) (all (**o y z (build 6))
+    (_exists (y z) (all (**o y z (build 6))
 		    (project (y z) (== `(,(trans y) ,(trans z)) w)))))
   '(((w.0 (1 6))) ((w.0 (6 1))) ((w.0 (2 3)))  ((w.0 (3 2)))))
 
 ; Only one answer
 (test-check 'multiplication-all-2
   (solve 7 (w) 
-    (exists (x)
+    (_exists (x)
       (all (**o (build 3) (build 2) x)
 	(project (x) (== (trans x) w)))))
   '(((w.0 6))))
@@ -6190,14 +6206,14 @@
 
 
 (test-check 'divo-1
-  (solution (x) (divo (build 4) (build 2) x _))
+  (solution (x) (divo (build 4) (build 2) x __))
   '((x.0 (0 1))))
-(test-check 'div-fail-1 (test (x) (divo (build 4) (build 0) x _)) '())
+(test-check 'div-fail-1 (test (x) (divo (build 4) (build 0) x __)) '())
 (test-check 'divo-2
-  (solution (x) (divo (build 4) (build 3) x _))
+  (solution (x) (divo (build 4) (build 3) x __))
   '((x.0 (1))))
 (test-check 'divo-3
-  (solution (x) (divo (build 4) (build 4) x _))
+  (solution (x) (divo (build 4) (build 4) x __))
   '((x.0 (1))))
 (test-check 'divo-4
   (solution (x y) (divo (build 4) (build 5) x y))
@@ -6205,13 +6221,13 @@
 
 
 (test-check 'divo-33-1
-  (solution (x) (divo (build 33) (build 3) x _))
+  (solution (x) (divo (build 33) (build 3) x __))
   `((x.0 ,(build 11))))
 (test-check 'divo-33-2
-  (solution (x) (divo (build 33) x (build 11) _))
+  (solution (x) (divo (build 33) x (build 11) __))
   `((x.0 ,(build 3))))
 (test-check 'divo-33-3
-  (solution (x) (divo x (build 3) (build 11) _))
+  (solution (x) (divo x (build 3) (build 11) __))
   `((x.0 ,(build 33))))
 (test-check 'divo-33-5
   (solution (x y) (divo (build 33) (build 5) x y))
@@ -6229,21 +6245,21 @@
   '())
 
 
-(test (x) (divo x (build 5) _ (build 4)))
+(test (x) (divo x (build 5) __ (build 4)))
 (test (x) (divo x (build 5) (build 3) (build 4)))
-(test (x) (divo x _ (build 3) (build 4)))
-(test-check 'div-fail-2 (test (x) (divo (build 5) x (build 7) _)) '())
+(test (x) (divo x __ (build 3) (build 4)))
+(test-check 'div-fail-2 (test (x) (divo (build 5) x (build 7) __)) '())
 
 (test-check "all numbers such as 5/Z = 1"
   (solve 7 (w) 
-    (exists (z) (all (divo (build 5) z (build 1) _)
+    (_exists (z) (all (divo (build 5) z (build 1) __)
 		    (project (z) (== `(,(trans z)) w)))))
   '(((w.0 (5))) ((w.0 (3))) ((w.0 (4)))))
 
 (test-check "all inexact factorizations of 12"
   (set-equal?
    (solve 100 (w) 
-    (exists (m q r n)
+    (_exists (m q r n)
       (all 
 	(== n (build 12))
 	(<o m n)
@@ -6451,11 +6467,13 @@
     ((n.0 (0 1)) (b.0 (1)) (r.0 (1)))
     ((n.0 (1 0 0 1)) (b.0 (0 1)) (r.0 (1)))
     ((n.0 (0 0 1 1 1)) (b.0 (1 1)) (r.0 (1))))
-))
+)
+10)
 
 ;; ========================================================================
 
 (define (all-tests)
+  (eigen-test)
   (term-tests)
   (kanren-tests)
   (ti-tests)
diff --git a/collects/tests/mzscheme/benchmarks/common/mk-bigloo.ss b/collects/tests/mzscheme/benchmarks/common/mk-bigloo.ss
index 1ae3523c47..700d34ae95 100644
--- a/collects/tests/mzscheme/benchmarks/common/mk-bigloo.ss
+++ b/collects/tests/mzscheme/benchmarks/common/mk-bigloo.ss
@@ -9,9 +9,9 @@
               (include "bigloo-prelude.sch")
               (include ,(format "~a.sch" name))))
     (newline))
-  'truncate/replace)
+  #:exists 'truncate/replace)
 
-(when (system (format "bigloo -w -o ~a -copt -O3 -copt -fomit-frame-pointer -O6 ~a~a.scm"
+(when (system (format "bigloo -w -o ~a -copt -m32 -call/cc -copt -O3 -copt -fomit-frame-pointer -O6 ~a~a.scm"
                       name 
                       (if (memq (string->symbol name)
                                 '(ctak))
diff --git a/collects/tests/mzscheme/benchmarks/common/nfa.sch b/collects/tests/mzscheme/benchmarks/common/nfa.sch
index 2b3aa06d3a..b00dcd076b 100644
--- a/collects/tests/mzscheme/benchmarks/common/nfa.sch
+++ b/collects/tests/mzscheme/benchmarks/common/nfa.sch
@@ -42,7 +42,7 @@
       'fail))
 
 (time (let ((input (string->list (string-append (make-string 133 #\a) "bc"))))
-        (let loop ((n 50000))
+        (let loop ((n 150000))
           (if (zero? n)
               'done
               (begin
diff --git a/collects/tests/mzscheme/benchmarks/common/nothing.sch b/collects/tests/mzscheme/benchmarks/common/nothing.sch
new file mode 100644
index 0000000000..d3cd072131
--- /dev/null
+++ b/collects/tests/mzscheme/benchmarks/common/nothing.sch
@@ -0,0 +1 @@
+(time 1)
diff --git a/collects/tests/mzscheme/benchmarks/common/nothing.ss b/collects/tests/mzscheme/benchmarks/common/nothing.ss
new file mode 100644
index 0000000000..1f7a80f8fe
--- /dev/null
+++ b/collects/tests/mzscheme/benchmarks/common/nothing.ss
@@ -0,0 +1,2 @@
+
+(module nothing "wrap.ss")
diff --git a/collects/tests/mzscheme/benchmarks/common/nucleic2.sch b/collects/tests/mzscheme/benchmarks/common/nucleic2.sch
index 24c0b04b7b..2e99c4119b 100644
--- a/collects/tests/mzscheme/benchmarks/common/nucleic2.sch
+++ b/collects/tests/mzscheme/benchmarks/common/nucleic2.sch
@@ -49,10 +49,6 @@
 (define-syntax FUTURE    (syntax-rules () ((FUTURE x) x)))
 (define-syntax TOUCH     (syntax-rules () ((TOUCH x)  x)))
 
-(define-syntax def-macro  (syntax-rules () ((def-macro stuff ...) #t)))
-(define-syntax def-struct (syntax-rules () ((def-macro stuff ...) #t)))
-(define-syntax def-nuc    (syntax-rules () ((def-nuc   stuff ...) #t)))
-
 (define-syntax define-structure
   (syntax-rules ()
     ((define-structure #f
@@ -320,204 +316,6 @@
 
 )
 
-; -- SYSTEM DEPENDENT CODE ----------------------------------------------------
-
-; The code in this section is not portable.  It must be adapted to
-; the Scheme system you are using.
-
-; ********** GAMBIT 2.2
-
-'; Add a single-quote at the start of this line if you are NOT using Gambit
-(begin
-
-(declare             ; Compiler declarations for fast code:
- (multilisp)         ; - Enable the FUTURE special-form
- (block)             ; - Assume this file contains the entire program
- (standard-bindings) ; - Assume standard bindings (this permits open-coding)
- (extended-bindings) ; - Same for extensions (such as "##flonum.+")
- (fixnum)            ; - Use fixnum arithmetic by default
- (not safe)          ; - Remove all runtime type checks
-)
-
-(define-macro (def-macro form . body)
-  `(DEFINE-MACRO ,form (LET () ,@body)))
-
-(def-macro (FLOAT+ x . l) `(,(string->symbol "##flonum.+") ,x ,@l))
-(def-macro (FLOAT- x . l) `(,(string->symbol "##flonum.-") ,x ,@l))
-(def-macro (FLOAT* x . l) `(,(string->symbol "##flonum.*") ,x ,@l))
-(def-macro (FLOAT/ x . l) `(,(string->symbol "##flonum./") ,x ,@l))
-(def-macro (FLOAT=   x y) `(,(string->symbol "##flonum.=") ,x ,y))
-(def-macro (FLOAT<   x y) `(,(string->symbol "##flonum.<") ,x ,y))
-(def-macro (FLOAT<=  x y) `(not (,(string->symbol "##flonum.<") ,y ,x)))
-(def-macro (FLOAT>   x y) `(,(string->symbol "##flonum.<") ,y ,x))
-(def-macro (FLOAT>=  x y) `(not (,(string->symbol "##flonum.<") ,x ,y)))
-(def-macro (FLOATsin   x) `(,(string->symbol "##flonum.sin")  ,x))
-(def-macro (FLOATcos   x) `(,(string->symbol "##flonum.cos")  ,x))
-(def-macro (FLOATatan  x) `(,(string->symbol "##flonum.atan") ,x))
-(def-macro (FLOATsqrt  x) `(,(string->symbol "##flonum.sqrt") ,x))
-)
-
-; ********** MIT-SCHEME
-
-'; Remove the single-quote from this line if you are using MIT-Scheme
-(begin
-
-(declare (usual-integrations))
-
-(define-macro (def-macro form . body)
-  `(DEFINE-MACRO ,form (LET () ,@body)))
-
-(def-macro (nary-function op1 op2 args)
-  (if (null? (cdr args))
-    `(,op1 ,@args)
-    (let loop ((args args))
-      (if (null? (cdr args))
-        (car args)
-        (loop (cons (list op2 (car args) (cadr args)) (cddr args)))))))
-
-(def-macro (FLOAT+ x . l) `(nary-function begin      flo:+ ,(cons x l)))
-(def-macro (FLOAT- x . l) `(nary-function flo:negate flo:- ,(cons x l)))
-(def-macro (FLOAT* x . l) `(nary-function begin      flo:* ,(cons x l)))
-(def-macro (FLOAT/ x . l) `(nary-function error      flo:/ ,(cons x l)))
-(def-macro (FLOAT=   x y) `(flo:= ,x ,y))
-(def-macro (FLOAT<   x y) `(flo:< ,x ,y))
-(def-macro (FLOAT<=  x y) `(not (flo:< ,y ,x)))
-(def-macro (FLOAT>   x y) `(flo:< ,y ,x))
-(def-macro (FLOAT>=  x y) `(not (flo:< ,x ,y)))
-(def-macro (FLOATsin   x) `(flo:sin  ,x))
-(def-macro (FLOATcos   x) `(flo:cos  ,x))
-(def-macro (FLOATatan  x) `(flo:atan ,x))
-(def-macro (FLOATsqrt  x) `(flo:sqrt ,x))
-
-(def-macro (FUTURE x) x)
-(def-macro (TOUCH x) x)
-)
-
-; ********** SCM
-
-'; Remove the single-quote from this line if you are using SCM
-(begin
-
-(defmacro def-macro (form . body)
-  `(DEFMACRO ,(car form) ,(cdr form) (LET () ,@body)))
-
-(def-macro (FLOAT+ x . l) `(+ ,x ,@l))
-(def-macro (FLOAT- x . l) `(- ,x ,@l))
-(def-macro (FLOAT* x . l) `(* ,x ,@l))
-(def-macro (FLOAT/ x . l) `(/ ,x ,@l))
-(def-macro (FLOAT=   x y) `(= ,x ,y))
-(def-macro (FLOAT<   x y) `(< ,x ,y))
-(def-macro (FLOAT<=  x y) `(not (< ,y ,x)))
-(def-macro (FLOAT>   x y) `(< ,y ,x))
-(def-macro (FLOAT>=  x y) `(not (< ,x ,y)))
-(def-macro (FLOATsin   x) `(sin  ,x))
-(def-macro (FLOATcos   x) `(cos  ,x))
-(def-macro (FLOATatan  x) `(atan ,x))
-(def-macro (FLOATsqrt  x) `(sqrt ,x))
-
-(def-macro (FUTURE x) x)
-(def-macro (TOUCH x) x)
-)
-
-; -- STRUCTURE DEFINITION MACRO -----------------------------------------------
-
-; The macro "def-struct" provides a simple mechanism to define record
-; structures out of vectors.  The first argument to "def-struct" is a boolean
-; indicating whether the vector should be tagged (to allow the type of the
-; structure to be tested).  The second argument is the name of the structure.
-; The remaining arguments are the names of the structure's fields.  A call
-; to "def-struct" defines macros to
-;
-;  1) construct a record object of this type
-;  2) fetch and store each field
-;  3) test a record to see if it is of this type (only if tags are used)
-;  4) define subclasses of this record with additional fields
-;
-; The call "(def-struct #t foo a b c)" will define the following macros:
-;
-;  (make-foo x y)                -- make a record
-;  (make-constant-foo x y)       -- make a record (args must be constants)
-;  (foo? x)                      -- test a record
-;  (foo-a x)                     -- get field "a"
-;  (foo-b x)                     -- get field "b"
-;  (foo-a-set! x y)              -- mutate field "a"
-;  (foo-b-set! x y)              -- mutate field "b"
-;  (def-foo tag? name fields...) -- define subclass of "foo"
-
-(def-macro (def-struct tag? name . fields)
-  `(DEF-SUBSTRUCT () () 0 ,tag? ,name ,@fields))
-
-(def-macro (def-substruct sup-fields sup-tags sup-length tag? name . fields)
-
-  (define (err)
-    (error "Ill-formed `def-substruct'") #f)
-
-  (define (sym . strings)
-    (string->symbol (apply string-append strings)))
-
-  (if (symbol? name)
-    (let* ((name-str (symbol->string name))
-           (tag (sym "." name-str "."))
-           (all-tags (append sup-tags
-                             (if tag?
-                               (list (cons tag sup-length))
-                               '()))))
-      (let loop ((l1 fields)
-                 (l2 '())
-                 (l3 '())
-                 (i (+ sup-length (if tag? 1 0))))
-        (if (pair? l1)
-          (let ((rest (cdr l1)) (field (car l1)))
-            (if (symbol? field)
-              (let* ((field-str (symbol->string field))
-                     (field-ref (sym name-str "-" field-str))
-                     (field-set! (sym name-str "-" field-str "-set!")))
-                (loop rest
-                      (cons `(DEF-MACRO (,field-set! X Y)
-                               `(VECTOR-SET! ,X ,,i ,Y))
-                            (cons `(DEF-MACRO (,field-ref X)
-                                     `(VECTOR-REF ,X ,,i))
-                                  l2))
-                      (cons (cons field i) l3)
-                      (+ i 1)))
-              (err)))
-          (let ((all-fields (append sup-fields (reverse l3))))
-            `(BEGIN
-               ,@l2
-               (DEFINE ,(sym "fields-of-" name-str)
-                 ',all-fields)
-               (DEF-MACRO (,(sym "def-" name-str) TAG? NAME . FIELDS)
-                 `(DEF-SUBSTRUCT ,',all-fields ,',all-tags ,',i
-                                 ,TAG? ,NAME ,@FIELDS))
-               (DEF-MACRO (,(sym "make-constant-" name-str) . REST)
-                 (DEFINE (ADD-TAGS I TAGS LST)
-                   (COND ((NULL? TAGS)
-                          LST)
-                         ((= I (CDAR TAGS))
-                          (CONS (CAAR TAGS)
-                                (ADD-TAGS (+ I 1) (CDR TAGS) LST)))
-                         (ELSE
-                          (CONS (CAR LST)
-                                (ADD-TAGS (+ I 1) TAGS (CDR LST))))))
-                 `'#(,@(ADD-TAGS 0 ',all-tags REST)))
-               (DEF-MACRO (,(sym "make-" name-str) . REST)
-                 (DEFINE (ADD-TAGS I TAGS LST)
-                   (COND ((NULL? TAGS)
-                          LST)
-                         ((= I (CDAR TAGS))
-                          (CONS `',(CAAR TAGS)
-                                (ADD-TAGS (+ I 1) (CDR TAGS) LST)))
-                         (ELSE
-                          (CONS (CAR LST)
-                                (ADD-TAGS (+ I 1) TAGS (CDR LST))))))
-                 `(VECTOR ,@(ADD-TAGS 0 ',all-tags REST)))
-               ,@(if tag?
-                   `((DEF-MACRO (,(sym name-str "?") X)
-                       `(EQ? (VECTOR-REF ,X ,,sup-length) ',',tag)))
-                   '())
-               ',name)))))
-    (err)))
-
 ; -- MATH UTILITIES -----------------------------------------------------------
 
 (define constant-pi          3.14159265358979323846)
@@ -539,8 +337,6 @@
 
 ; -- POINTS -------------------------------------------------------------------
 
-(def-struct #f pt x y z)
-
 (define (pt-sub p1 p2)
   (make-pt (FLOAT- (pt-x p1) (pt-x p2))
            (FLOAT- (pt-y p1) (pt-y p2))
@@ -579,8 +375,6 @@
 ;
 ; The components tx, ty, and tz are the translation vector.
 
-(def-struct #f tfo a b c d e f g h i tx ty tz)
-
 (define tfo-id  ; the identity transformation matrix
   '#(1.0 0.0 0.0
      0.0 1.0 0.0
@@ -742,21 +536,8 @@
 
 ; Define part common to all 4 nucleotide types.
 
-(def-struct #f nuc
-  dgf-base-tfo  ; defines the standard position for wc and wc-dumas
-  P-O3*-275-tfo ; defines the standard position for the connect function
-  P-O3*-180-tfo
-  P-O3*-60-tfo
-  P O1P O2P O5* C5* H5* H5** C4* H4* O4* C1* H1* C2* H2** O2* H2* C3*
-  H3* O3* N1 N3 C2 C4 C5 C6)
-
 ; Define remaining atoms for each nucleotide type.
 
-(def-nuc #t rA N6 N7 N9 C8 H2 H61 H62 H8)
-(def-nuc #t rC N4 O2 H41 H42 H5 H6)
-(def-nuc #t rG N2 N7 N9 C8 O6 H1 H21 H22 H8)
-(def-nuc #t rU O2 O4 H3 H5 H6)
-
 ; Database of nucleotide conformations:
 
 (define rA
@@ -3167,38 +2948,6 @@
 
 ; -- PARTIAL INSTANTIATIONS ---------------------------------------------------
 
-(def-struct #f var id tfo nuc)
-
-; Add a single-quote at the start of this line if you want lazy computation
-(begin
-
-(def-macro (mk-var i tfo nuc)
-  `(make-var ,i ,tfo ,nuc))
-
-(def-macro (absolute-pos var p)
-  `(tfo-apply (var-tfo ,var) ,p))
-
-(def-macro (lazy-computation-of expr)
-  expr)
-)
-
-'; Remove the single-quote from this line if you want lazy computation
-(begin
-
-(def-macro (mk-var i tfo nuc)
-  `(make-var ,i ,tfo (make-relative-nuc ,tfo ,nuc)))
-
-(def-macro (absolute-pos var p)
-  `(force ,p))
-
-(def-macro (lazy-computation-of expr)
-  `(delay ,expr))
-)
-
-(def-macro (atom-pos atom var)
-  `(let ((v ,var))
-     (absolute-pos v (,atom (var-nuc v)))))
-
 (define (get-var id lst)
   (let ((v (car lst)))
     (if (= id (var-id v))
diff --git a/collects/tests/mzscheme/benchmarks/common/peval.sch b/collects/tests/mzscheme/benchmarks/common/peval.sch
index dfa6ce3791..40d5047170 100644
--- a/collects/tests/mzscheme/benchmarks/common/peval.sch
+++ b/collects/tests/mzscheme/benchmarks/common/peval.sch
@@ -627,7 +627,7 @@
 
 (let ((input (with-input-from-file "input.txt" read)))
   (time
-   (let loop ((n 20) (v 0))
+   (let loop ((n 60) (v 0))
      (if (zero? n)
          v
          (loop (- n 1) (test (if input 0 17)))))))
diff --git a/collects/tests/mzscheme/benchmarks/common/psyntax-input.txt b/collects/tests/mzscheme/benchmarks/common/psyntax-input.txt
index 4c1e8e1c31..e9bce21e27 100644
--- a/collects/tests/mzscheme/benchmarks/common/psyntax-input.txt
+++ b/collects/tests/mzscheme/benchmarks/common/psyntax-input.txt
@@ -213,11 +213,11 @@
 ;;; The following nonstandard procedures must be provided by the
 ;;; implementation for this code to run.
 ;;;
-;;; (void)
+;;; (voide)
 ;;; returns the implementation's cannonical "unspecified value".  The
 ;;; following usually works:
 ;;;
-;;; (define void (lambda () (if #f #f))).
+;;; (define voide (lambda () (if #f #f))).
 ;;;
 ;;; (andmap proc list1 list2 ...)
 ;;; returns true if proc returns true when applied to each element of list1
@@ -729,7 +729,7 @@
       (if (null? (cdr exps))
           (car exps)
          ; weed out leading void calls, assuming ordinary list representation
-          (if (equal? (car exps) '(void))
+          (if (equal? (car exps) '(voide))
               (loop (cdr exps))
               `(begin ,@exps))))))
 
@@ -1804,7 +1804,7 @@
          (if meta?
              (let ((x (chi-expr type value e r r w ae #t)))
                (top-level-eval-hook x)
-               (ct-eval/residualize3 ctem void (lambda () x)))
+               (ct-eval/residualize3 ctem voide (lambda () x)))
              (rt-eval/residualize rtem
                (lambda ()
                  (chi-expr type value e r r w ae #f)))))))))
@@ -2146,7 +2146,7 @@
                               (define-top-level-value-hook sym (top-level-eval-hook exp))
                               (meta-residualize!
                                 (ct-eval/residualize3 ctem
-                                  void
+                                  voide
                                   (lambda () (build-global-definition no-source sym exp))))
                               (parse (cdr body) r mr
                                 (cons id ids)
@@ -2266,7 +2266,7 @@
                         ; expand and eval meta inits for effect only
                          (let ((x (chi-meta-frob (car body) mr)))
                            (top-level-eval-hook x)
-                           (meta-residualize! (ct-eval/residualize3 ctem void (lambda () x))))
+                           (meta-residualize! (ct-eval/residualize3 ctem voide (lambda () x))))
                          (f (cdr body)))))))))))))
 
 (define vmap
@@ -2770,7 +2770,7 @@
                empty-wrap))
       ((_ name)
        (id? (syntax name))
-       (values (wrap (syntax name) w) (syntax (void)) empty-wrap))
+       (values (wrap (syntax name) w) (syntax (voide)) empty-wrap))
       (_ (syntax-error (source-wrap e w ae))))))
 
 (define parse-define-syntax
@@ -2878,7 +2878,7 @@
 
 (define chi-void
   (lambda ()
-    (build-application no-source (build-primref no-source 'void) '())))
+    (build-application no-source (build-primref no-source 'voide) '())))
 
 (define ellipsis?
   (lambda (x)
@@ -2920,7 +2920,7 @@
             ((vector? x)
              (let ((old (vector->list x)))
                 (let ((new (map f old)))
-                   (if (andmap eq? old new) x (list->vector new)))))
+                   (if (andmap2 eq? old new) x (list->vector new)))))
             (else x))))))
 
 (define strip
@@ -3698,13 +3698,13 @@
     (let f ((ls orig-ls))
       (syntax-case ls ()
         (() '())
-        ((x . r) (cons #'x (f #'r)))
+        ((x . r) (cons (syntax x) (f (syntax r))))
         (_ (error 'syntax->list "invalid argument ~s" orig-ls))))))
 
 (set! syntax->vector
   (lambda (v)
     (syntax-case v ()
-      (#(x ...) (apply vector (syntax->list #'(x ...))))
+      (#(x ...) (apply vector (syntax->list (syntax (x ...)))))
       (_ (error 'syntax->vector "invalid argument ~s" v)))))
 
 (set! syntax-object->datum
@@ -4029,67 +4029,67 @@
       (syntax-case p (unquote quasiquote)
         ((unquote p)
          (if (= lev 0)
-             #'("value" p)
-             (quasicons #'("quote" unquote) (quasi #'(p) (- lev 1)))))
-        ((quasiquote p) (quasicons #'("quote" quasiquote) (quasi #'(p) (+ lev 1))))
+             (syntax ("value" p))
+             (quasicons (syntax ("quote" unquote)) (quasi (syntax (p)) (- lev 1)))))
+        ((quasiquote p) (quasicons (syntax ("quote" quasiquote)) (quasi (syntax (p)) (+ lev 1))))
         ((p . q)
-         (syntax-case #'p (unquote unquote-splicing)
+         (syntax-case (syntax p) (unquote unquote-splicing)
            ((unquote p ...)
             (if (= lev 0)
-                (quasilist* #'(("value" p) ...) (quasi #'q lev))
+                (quasilist* (syntax (("value" p) ...)) (quasi (syntax q) lev))
                 (quasicons
-                  (quasicons #'("quote" unquote) (quasi #'(p ...) (- lev 1)))
-                  (quasi #'q lev))))
+                  (quasicons (syntax ("quote" unquote)) (quasi (syntax (p ...)) (- lev 1)))
+                  (quasi (syntax q) lev))))
            ((unquote-splicing p ...)
             (if (= lev 0)
-                (quasiappend #'(("value" p) ...) (quasi #'q lev))
+                (quasiappend (syntax (("value" p) ...)) (quasi (syntax q) lev))
                 (quasicons
-                  (quasicons #'("quote" unquote-splicing) (quasi #'(p ...) (- lev 1)))
-                  (quasi #'q lev))))
-           (_ (quasicons (quasi #'p lev) (quasi #'q lev)))))
-        (#(x ...) (quasivector (vquasi #'(x ...) lev)))
-        (p #'("quote" p))))
+                  (quasicons (syntax ("quote" unquote-splicing)) (quasi (syntax (p ...)) (- lev 1)))
+                  (quasi (syntax q) lev))))
+           (_ (quasicons (quasi (syntax p) lev) (quasi (syntax q) lev)))))
+        (#(x ...) (quasivector (vquasi (syntax (x ...)) lev)))
+        (p (syntax ("quote" p)))))
     (define (vquasi p lev)
       (syntax-case p ()
         ((p . q)
-         (syntax-case #'p (unquote unquote-splicing)
+         (syntax-case (syntax p) (unquote unquote-splicing)
            ((unquote p ...)
             (if (= lev 0)
-                (quasilist* #'(("value" p) ...) (vquasi #'q lev))
+                (quasilist* (syntax (("value" p) ...)) (vquasi (syntax q) lev))
                 (quasicons
-                  (quasicons #'("quote" unquote) (quasi #'(p ...) (- lev 1)))
-                  (vquasi #'q lev))))
+                  (quasicons (syntax ("quote" unquote)) (quasi (syntax (p ...)) (- lev 1)))
+                  (vquasi (syntax q) lev))))
            ((unquote-splicing p ...)
             (if (= lev 0)
-                (quasiappend #'(("value" p) ...) (vquasi #'q lev))
+                (quasiappend (syntax (("value" p) ...)) (vquasi (syntax q) lev))
                 (quasicons
                   (quasicons
-                    #'("quote" unquote-splicing)
-                    (quasi #'(p ...) (- lev 1)))
-                  (vquasi #'q lev))))
-           (_ (quasicons (quasi #'p lev) (vquasi #'q lev)))))
-        (() #'("quote" ()))))
+                    (syntax ("quote" unquote-splicing))
+                    (quasi (syntax (p ...)) (- lev 1)))
+                  (vquasi (syntax q) lev))))
+           (_ (quasicons (quasi (syntax p) lev) (vquasi (syntax q) lev)))))
+        (() (syntax ("quote" ())))))
     (define (quasicons x y)
       (with-syntax ((x x) (y y))
-        (syntax-case #'y ()
+        (syntax-case (syntax y) ()
           (("quote" dy)
-           (syntax-case #'x ()
-             (("quote" dx) #'("quote" (dx . dy)))
-             (_ (if (null? #'dy) #'("list" x) #'("list*" x y)))))
-          (("list" . stuff) #'("list" x . stuff))
-          (("list*" . stuff) #'("list*" x . stuff))
-          (_ #'("list*" x y)))))
+           (syntax-case (syntax x) ()
+             (("quote" dx) (syntax ("quote" (dx . dy))))
+             (_ (if (null? (syntax dy)) (syntax ("list" x)) (syntax ("list*" x y))))))
+          (("list" . stuff) (syntax ("list" x . stuff)))
+          (("list*" . stuff) (syntax ("list*" x . stuff)))
+          (_ (syntax ("list*" x y))))))
     (define (quasiappend x y)
       (syntax-case y ()
         (("quote" ())
          (cond
-           ((null? x) #'("quote" ()))
+           ((null? x) (syntax ("quote" ())))
            ((null? (cdr x)) (car x))
-           (else (with-syntax (((p ...) x)) #'("append" p ...)))))
+           (else (with-syntax (((p ...) x)) (syntax ("append" p ...))))))
         (_
          (cond
            ((null? x) y)
-           (else (with-syntax (((p ...) x) (y y)) #'("append" p ... y)))))))
+           (else (with-syntax (((p ...) x) (y y)) (syntax ("append" p ... y))))))))
     (define (quasilist* x y)
       (let f ((x x))
         (if (null? x)
@@ -4097,35 +4097,35 @@
             (quasicons (car x) (f (cdr x))))))
     (define (quasivector x)
       (syntax-case x ()
-        (("quote" (x ...)) #'("quote" #(x ...)))
+        (("quote" (x ...)) (syntax ("quote" #(x ...))))
         (_
-         (let f ((y x) (k (lambda (ls) #`("vector" #,@ls))))
+         (let f ((y x) (k (lambda (ls) (quasisyntax ("vector" (unsyntax-splicing ls))))))
            (syntax-case y ()
-             (("quote" (y ...)) (k #'(("quote" y) ...)))
-             (("list" y ...) (k #'(y ...)))
-             (("list*" y ... z) (f #'z (lambda (ls) (k (append #'(y ...) ls)))))
-             (else #`("list->vector" #,x)))))))
+             (("quote" (y ...)) (k (syntax (("quote" y) ...))))
+             (("list" y ...) (k (syntax (y ...))))
+             (("list*" y ... z) (f (syntax z) (lambda (ls) (k (append (syntax (y ...)) ls)))))
+             (else (quasisyntax ("list->vector" (unsyntax-splicing x)))))))))
     (define (emit x)
       (syntax-case x ()
-        (("quote" x) #''x)
-        (("list" x ...) #`(list #,@(map emit #'(x ...))))
+        (("quote" x) (syntax 'x))
+        (("list" x ...) (quasisyntax (list (unsyntax-splicing (map emit (syntax (x ...)))))))
       ; could emit list* for 3+ arguments if implementation supports list*
        (("list*" x ... y)
-        (let f ((x* #'(x ...)))
+        (let f ((x* (syntax (x ...))))
           (if (null? x*)
-              (emit #'y)
-              #`(cons #,(emit (car x*)) #,(f (cdr x*))))))
-        (("append" x ...) #`(append #,@(map emit #'(x ...))))
-        (("vector" x ...) #`(vector #,@(map emit #'(x ...))))
-        (("list->vector" x) #`(list->vector #,(emit #'x)))
-        (("value" x) #'x)))
+              (emit (syntax y))
+              (quasisyntax (cons (unsyntax (emit (car x*))) (unsyntax (f (cdr x*))))))))
+        (("append" x ...) (quasisyntax (append (unsyntax-splicing (map emit (syntax (x ...)))))))
+        (("vector" x ...) (quasisyntax (vector (unsyntax-splicing (map emit (syntax (x ...)))))))
+        (("list->vector" x) (quasisyntax (list->vector (unsyntax (emit (syntax x))))))
+        (("value" x) (syntax x))))
     (lambda (x)
       (syntax-case x ()
        ; convert to intermediate language, combining introduced (but not
        ; unquoted source) quote expressions where possible and choosing
        ; optimal construction code otherwise, then emit Scheme code
        ; corresponding to the intermediate language forms.
-        ((_ e) (emit (quasi #'e 0)))))))
+        ((_ e) (emit (quasi (syntax e) 0)))))))
 
 (define-syntax unquote
   (lambda (x)
@@ -4140,68 +4140,68 @@
     (define (qs q n b* k)
       (syntax-case q (quasisyntax unsyntax unsyntax-splicing)
         ((quasisyntax . d)
-         (qs #'d (+ n 1) b*
+         (qs (syntax d) (+ n 1) b*
            (lambda (b* dnew)
              (k b*
-                (if (eq? dnew #'d)
+                (if (eq? dnew (syntax d))
                     q
-                    (with-syntax ((d dnew)) #'(quasisyntax . d)))))))
+                    (with-syntax ((d dnew)) (syntax (quasisyntax . d))))))))
         ((unsyntax . d)
          (not (= n 0))
-         (qs #'d (- n 1) b*
+         (qs (syntax d) (- n 1) b*
            (lambda (b* dnew)
              (k b*
-                (if (eq? dnew #'d)
+                (if (eq? dnew (syntax d))
                     q
-                    (with-syntax ((d dnew)) #'(unsyntax . d)))))))
+                    (with-syntax ((d dnew)) (syntax (unsyntax . d))))))))
         ((unsyntax-splicing . d)
          (not (= n 0))
-         (qs #'d (- n 1) b*
+         (qs (syntax d) (- n 1) b*
            (lambda (b* dnew)
              (k b*
-                (if (eq? dnew #'d)
+                (if (eq? dnew (syntax d))
                     q
-                    (with-syntax ((d dnew)) #'(unsyntax-splicing . d)))))))
+                    (with-syntax ((d dnew)) (syntax (unsyntax-splicing . d))))))))
         ((unsyntax q)
          (= n 0)
-         (with-syntax (((t) (generate-temporaries #'(q))))
-           (k (cons #'(t q) b*) #'t)))
+         (with-syntax (((t) (generate-temporaries (syntax (q)))))
+           (k (cons (syntax (t q)) b*) (syntax t))))
         (((unsyntax q ...) . d)
          (= n 0)
-         (qs #'d n b*
+         (qs (syntax d) n b*
            (lambda (b* dnew)
-             (with-syntax (((t ...) (generate-temporaries #'(q ...))))
-               (k (append #'((t q) ...) b*)
-                  (with-syntax ((d dnew)) #'(t ... . d)))))))
+             (with-syntax (((t ...) (generate-temporaries (syntax (q ...)))))
+               (k (append (syntax ((t q) ...)) b*)
+                  (with-syntax ((d dnew)) (syntax (t ... . d))))))))
         (((unsyntax-splicing q ...) . d)
          (= n 0)
-         (qs #'d n b*
+         (qs (syntax d) n b*
            (lambda (b* dnew)
-             (with-syntax (((t ...) (generate-temporaries #'(q ...))))
-               (k (append #'(((t (... ...)) q) ...) b*)
-                  (with-syntax ((((m ...) ...) #'((t (... ...)) ...)))
-                    (with-syntax ((d dnew)) #'(m ... ... . d))))))))
+             (with-syntax (((t ...) (generate-temporaries (syntax (q ...)))))
+               (k (append (syntax (((t (... ...)) q) ...)) b*)
+                  (with-syntax ((((m ...) ...) (syntax ((t (... ...)) ...))))
+                    (with-syntax ((d dnew)) (syntax (m ... ... . d)))))))))
         ((a . d)
-         (qs #'a n b*
+         (qs (syntax a) n b*
            (lambda (b* anew)
-             (qs #'d n b*
+             (qs (syntax d) n b*
                (lambda (b* dnew)
                  (k b*
-                    (if (and (eq? anew #'a) (eq? dnew #'d))
+                    (if (and (eq? anew (syntax a)) (eq? dnew (syntax d)))
                         q
-                        (with-syntax ((a anew) (d dnew)) #'(a . d)))))))))
+                        (with-syntax ((a anew) (d dnew)) (syntax (a . d))))))))))
         (#(x ...)
-         (vqs #'(x ...) n b*
+         (vqs (syntax (x ...)) n b*
            (lambda (b* xnew*)
              (k b*
-                (if (let same? ((x* #'(x ...)) (xnew* xnew*))
+                (if (let same? ((x* (syntax (x ...))) (xnew* xnew*))
                       (if (null? x*)
                           (null? xnew*)
                           (and (not (null? xnew*))
                                (eq? (car x*) (car xnew*))
                                (same? (cdr x*) (cdr xnew*)))))
                     q
-                    (with-syntax (((x ...) xnew*)) #'#(x ...)))))))
+                    (with-syntax (((x ...) xnew*)) (syntax #(x ...))))))))
         (_ (k b* q))))
     (define (vqs x* n b* k)
       (if (null? x*)
@@ -4211,26 +4211,26 @@
               (syntax-case (car x*) (unsyntax unsyntax-splicing)
                 ((unsyntax q ...)
                  (= n 0)
-                 (with-syntax (((t ...) (generate-temporaries #'(q ...))))
-                   (k (append #'((t q) ...) b*)
-                      (append #'(t ...) xnew*))))
+                 (with-syntax (((t ...) (generate-temporaries (syntax (q ...)))))
+                   (k (append (syntax ((t q) ...)) b*)
+                      (append (syntax (t ...)) xnew*))))
                 ((unsyntax-splicing q ...)
                  (= n 0)
-                 (with-syntax (((t ...) (generate-temporaries #'(q ...))))
-                   (k (append #'(((t (... ...)) q) ...) b*)
-                      (with-syntax ((((m ...) ...) #'((t (... ...)) ...)))
-                        (append #'(m ... ...) xnew*)))))
+                 (with-syntax (((t ...) (generate-temporaries (syntax (q ...)))))
+                   (k (append (syntax (((t (... ...)) q) ...)) b*)
+                      (with-syntax ((((m ...) ...) (syntax ((t (... ...)) ...))))
+                        (append (syntax (m ... ...)) xnew*)))))
                 (_ (qs (car x*) n b*
                      (lambda (b* xnew)
                        (k b* (cons xnew xnew*))))))))))
     (syntax-case x ()
       ((_ x)
-       (qs #'x 0 '()
+       (qs (syntax x) 0 '()
          (lambda (b* xnew)
-           (if (eq? xnew #'x)
-               #'(syntax x)
+           (if (eq? xnew (syntax x))
+               (syntax (syntax x))
                (with-syntax (((b ...) b*) (x xnew))
-                 #'(with-syntax (b ...) (syntax x))))))))))
+                 (syntax (with-syntax (b ...) (syntax x)))))))))))
 
 (define-syntax unsyntax
   (lambda (x)
diff --git a/collects/tests/mzscheme/benchmarks/common/psyntax.sch b/collects/tests/mzscheme/benchmarks/common/psyntax.sch
index 2e1fbd43b9..016f2199d0 100644
--- a/collects/tests/mzscheme/benchmarks/common/psyntax.sch
+++ b/collects/tests/mzscheme/benchmarks/common/psyntax.sch
@@ -1,3 +1,5 @@
+;; smashed into benchmark form by Matthew
+
 ;;; psyntax.pp
 ;;; automatically generated from psyntax.ss
 ;;; Mon Feb 26 23:22:05 EST 2007
@@ -8,13 +10,12 @@
 ;;; Mon Feb 26 23:22:05 EST 2007
 ;;; see copyright notice in psyntax.ss
 
-(define (error . args) (+ args))
-(define (void) (if #f #t))
-(define (annotation-expression e) #f)
-(define (annotation-stripped e) e)
+(define (voide) (if #f #t))
+(define (sc-annotation-expression e) #f)
+(define (sc-annotation-stripped e) e)
 
 (define props '())
-(define (getprop s k)
+(define (sc-getprop s k)
   (let loop ((props props))
     (if (null? props)
         #f
@@ -26,7 +27,7 @@
                       (cdar vals)
                       (loop (cdr vals)))))
              (loop (cdr props))))))
-(define (putprop s k v)
+(define (sc-putprop s k v)
   (set! props
         (let loop ((props props))
           (if (null? props)
@@ -42,7 +43,7 @@
                                    (cons (car vals) (loop (cdr vals)))))))
                    (cdr props))
                   (cons (car props) (loop (cdr props))))))))
-(define (remprop s k)
+(define (sc-remprop s k)
   (set! props
         (let loop ((props props))
           (if (null? props)
@@ -59,24 +60,29 @@
                    (cdr props))
                   (cons (car props) (loop (cdr props))))))))
 (define counter 0)
-(define (gensym)
+(define (jensym)
   (set! counter (+ counter 1))
   (string->symbol (string-append "!$gen$!" (number->string counter))))
-(define (gensym? s)
+(define (jensym? s)
   (and (symbol? s)
        (let ((s (symbol->string s)))
          (char=? (string-ref s 0) #\!))))
 
-(define (ormap proc l)
+(define (sc-ormap proc l)
   (if (null? l)
       #f
       (or (proc (car l))
-          (ormap proc (cdr l)))))
-(define (andmap proc l)
+          (sc-ormap proc (cdr l)))))
+(define (sc-andmap proc l)
   (if (null? l)
       #t
       (and (proc (car l))
-           (andmap proc (cdr l)))))
+           (sc-andmap proc (cdr l)))))
+(define (sc-andmap2 proc l l2)
+  (if (null? l)
+      #t
+      (and (proc (car l) (car l2))
+           (sc-andmap2 proc (cdr l) (cdr l2)))))
 
 (define $sc-put-cte #f)
 (define $syntax-dispatch #f)
@@ -87,14 +93,64 @@
 (define datum->syntax-object #f)
 (define syntax->list #f)
 (define syntax->vector #f)
-(define identifier? #f)
-(define free-identifier=? #f)
-(define bound-identifier=? #f)
+(define sc-identifier? #f)
+(define sc-free-identifier=? #f)
+(define sc-bound-identifier=? #f)
 (define literal-identifier=? #f)
-(define generate-temporaries #f)
-(define environment? #f)
+(define sc-generate-temporaries #f)
+(define sc-environment? #f)
 (define sc-interaction-environment #f)
-(define syntax-error #f)
+(define sc-syntax-error #f)
+
+(define env (scheme-report-environment 5))
+
+(define (sc-eval e)
+  ((eval `(lambda (syntax-object->datum
+                   datum->syntax-object
+                   syntax->list 
+                   syntax->vector 
+                   identifier? 
+                   free-identifier=? 
+                   bound-identifier=? 
+                   literal-identifier=? 
+                   generate-temporaries 
+                   environment? 
+                   syntax-error 
+                   $sc-put-cte 
+                   $syntax-dispatch 
+                   $make-environment 
+                   sc-expand 
+                   andmap 
+                   andmap2 
+                   ormap 
+                   gensym 
+                   gensym? 
+                   eval 
+                   interaction-environment)
+            ,(cadr e))
+         env)
+   syntax-object->datum
+   datum->syntax-object
+   syntax->list
+   syntax->vector
+   sc-identifier?
+   sc-free-identifier=?
+   sc-bound-identifier=?
+   literal-identifier=?
+   sc-generate-temporaries
+   sc-environment?
+   sc-syntax-error
+   $sc-put-cte
+   $syntax-dispatch
+   $make-environment
+   sc-expand
+   sc-andmap
+   sc-andmap2
+   sc-ormap
+   jensym
+   jensym?
+   sc-eval
+   sc-interaction-environment))
 
 ((lambda ()
    (letrec ((noexpand62 '"noexpand")
@@ -140,29 +196,29 @@
             (put-cte-hook137 (lambda (symbol2513 val2512)
                                ($sc-put-cte symbol2513 val2512 '*top*)))
             (get-global-definition-hook138 (lambda (symbol2511)
-                                             (getprop
+                                             (sc-getprop
                                                symbol2511
                                                '*sc-expander*)))
             (put-global-definition-hook139 (lambda (symbol2510 x2509)
                                              (if (not x2509)
-                                                 (remprop
+                                                 (sc-remprop
                                                    symbol2510
                                                    '*sc-expander*)
-                                                 (putprop
+                                                 (sc-putprop
                                                    symbol2510
                                                    '*sc-expander*
                                                    x2509))))
             (read-only-binding?140 (lambda (symbol2508) '#f))
             (get-import-binding141 (lambda (symbol2507 token2506)
-                                     (getprop symbol2507 token2506)))
+                                     (sc-getprop symbol2507 token2506)))
             (update-import-binding!142 (lambda (symbol2504 token2503
                                                 p2502)
                                          ((lambda (x2505)
                                             (if (not x2505)
-                                                (remprop
+                                                (sc-remprop
                                                   symbol2504
                                                   token2503)
-                                                (putprop
+                                                (sc-putprop
                                                   symbol2504
                                                   token2503
                                                   x2505)))
@@ -226,7 +282,7 @@
                                                            (car exps2486)
                                                            (if (equal?
                                                                  (car exps2486)
-                                                                 '(void))
+                                                                 '(voide))
                                                                (loop2485
                                                                  (cdr exps2486))
                                                                (cons
@@ -289,7 +345,7 @@
                                                                                   var2470
                                                                                   x2474)
                                                                                 sets2471)))
-                                                                           (gensym))
+                                                                           (jensym))
                                                                          (values
                                                                            (cons
                                                                              var2470
@@ -442,7 +498,7 @@
                                             '#f))
                                        (id-var-name434 id2442 '(())))))
             (displaced-lexical-error299 (lambda (id2440)
-                                          (syntax-error
+                                          (sc-syntax-error
                                             id2440
                                             (if (id-var-name434
                                                   id2440
@@ -481,14 +537,14 @@
                                       b2433
                                       (make-transformer-binding302
                                         ((binding-value282 b2433))))
-                                    (void))
+                                    (voide))
                                 b2433))
                              (lookup*300 x2431 r2430)))))
             (make-transformer-binding302 (lambda (b2428)
                                            ((lambda (t2429)
                                               (if t2429
                                                   t2429
-                                                  (syntax-error
+                                                  (sc-syntax-error
                                                     b2428
                                                     '"invalid transformer")))
                                              (sanitize-binding271 b2428))))
@@ -509,7 +565,7 @@
                                     (symbol?
                                       ((lambda (e2422)
                                          (if (annotation?132 e2422)
-                                             (annotation-expression e2422)
+                                             (sc-annotation-expression e2422)
                                              e2422))
                                         (syntax-object-expression65
                                           x2421)))
@@ -521,11 +577,11 @@
                               (symbol?
                                 ((lambda (e2420)
                                    (if (annotation?132 e2420)
-                                       (annotation-expression e2420)
+                                       (sc-annotation-expression e2420)
                                        e2420))
                                   (syntax-object-expression65 x2419)))
                               (if (annotation?132 x2419)
-                                  (symbol? (annotation-expression x2419))
+                                  (symbol? (sc-annotation-expression x2419))
                                   '#f)))))
             (id-marks312 (lambda (id2418)
                            (if (syntax-object?64 id2418)
@@ -542,7 +598,7 @@
                                         (values
                                           ((lambda (e2415)
                                              (if (annotation?132 e2415)
-                                                 (annotation-expression
+                                                 (sc-annotation-expression
                                                    e2415)
                                                  e2415))
                                             (syntax-object-expression65
@@ -555,7 +611,7 @@
                                         (values
                                           ((lambda (e2416)
                                              (if (annotation?132 e2416)
-                                                 (annotation-expression
+                                                 (sc-annotation-expression
                                                    e2416)
                                                  e2416))
                                             x2414)
@@ -703,7 +759,7 @@
                                       (cons
                                         ((lambda (e2359)
                                            (if (annotation?132 e2359)
-                                               (annotation-expression
+                                               (sc-annotation-expression
                                                  e2359)
                                                e2359))
                                           (syntax-object-expression65
@@ -731,7 +787,7 @@
                                                ((lambda (e2355)
                                                   (if (annotation?132
                                                         e2355)
-                                                      (annotation-expression
+                                                      (sc-annotation-expression
                                                         e2355)
                                                       e2355))
                                                  (syntax-object-expression65
@@ -880,12 +936,12 @@
                                                               marks2326
                                                               old-binding2327)))))
                                                      (id-marks312 id2324))
-                                                   (void)))
+                                                   (voide)))
                                               ((lambda (x2329)
                                                  ((lambda (e2330)
                                                     (if (annotation?132
                                                           e2330)
-                                                        (annotation-expression
+                                                        (sc-annotation-expression
                                                           e2330)
                                                         e2330))
                                                    (if (syntax-object?64
@@ -901,7 +957,7 @@
                                                     ((lambda (e2332)
                                                        (if (annotation?132
                                                              e2332)
-                                                           (annotation-expression
+                                                           (sc-annotation-expression
                                                              e2332)
                                                            e2332))
                                                       (if (syntax-object?64
@@ -951,7 +1007,7 @@
                                                                                       (cdr ids2316)
                                                                                       (+ i2315
                                                                                          '1)))))
-                                                                              (void)))))
+                                                                              (voide)))))
                                                           f2314)
                                                          ids2309
                                                          '0)
@@ -983,15 +1039,15 @@
                                     (lambda (tosym2301 marks2300)
                                       (begin
                                         (if (not tosym2301)
-                                            (syntax-error
+                                            (sc-syntax-error
                                               id2299
                                               '"identifier not visible for export")
-                                            (void))
+                                            (voide))
                                         (make-resolved-id418
                                           ((lambda (x2302)
                                              ((lambda (e2303)
                                                 (if (annotation?132 e2303)
-                                                    (annotation-expression
+                                                    (sc-annotation-expression
                                                       e2303)
                                                     e2303))
                                                (if (syntax-object?64 x2302)
@@ -1305,7 +1361,7 @@
                                                                                                                                                             ((lambda (e2250)
                                                                                                                                                                (if (annotation?132
                                                                                                                                                                      e2250)
-                                                                                                                                                                   (annotation-expression
+                                                                                                                                                                   (sc-annotation-expression
                                                                                                                                                                      e2250)
                                                                                                                                                                    e2250))
                                                                                                                                                               (if (syntax-object?64
@@ -1422,7 +1478,7 @@
                                                     ((lambda (e2217)
                                                        (if (annotation?132
                                                              e2217)
-                                                           (annotation-expression
+                                                           (sc-annotation-expression
                                                              e2217)
                                                            e2217))
                                                       (syntax-object-expression65
@@ -1435,7 +1491,7 @@
                                                         ((lambda (e2218)
                                                            (if (annotation?132
                                                                  e2218)
-                                                               (annotation-expression
+                                                               (sc-annotation-expression
                                                                  e2218)
                                                                e2218))
                                                           id2209)
@@ -1481,7 +1537,7 @@
                             (if (eq? ((lambda (x2194)
                                         ((lambda (e2195)
                                            (if (annotation?132 e2195)
-                                               (annotation-expression
+                                               (sc-annotation-expression
                                                  e2195)
                                                e2195))
                                           (if (syntax-object?64 x2194)
@@ -1492,7 +1548,7 @@
                                      ((lambda (x2192)
                                         ((lambda (e2193)
                                            (if (annotation?132 e2193)
-                                               (annotation-expression
+                                               (sc-annotation-expression
                                                  e2193)
                                                e2193))
                                           (if (syntax-object?64 x2192)
@@ -1507,7 +1563,7 @@
                                (if (eq? ((lambda (x2183)
                                            ((lambda (e2184)
                                               (if (annotation?132 e2184)
-                                                  (annotation-expression
+                                                  (sc-annotation-expression
                                                     e2184)
                                                   e2184))
                                              (if (syntax-object?64 x2183)
@@ -1518,7 +1574,7 @@
                                         ((lambda (x2181)
                                            ((lambda (e2182)
                                               (if (annotation?132 e2182)
-                                                  (annotation-expression
+                                                  (sc-annotation-expression
                                                     e2182)
                                                   e2182))
                                              (if (syntax-object?64 x2181)
@@ -1559,7 +1615,7 @@
                                ((lambda (x2173)
                                   ((lambda (e2174)
                                      (if (annotation?132 e2174)
-                                         (annotation-expression e2174)
+                                         (sc-annotation-expression e2174)
                                          e2174))
                                     (if (syntax-object?64 x2173)
                                         (syntax-object-expression65 x2173)
@@ -1569,7 +1625,7 @@
                                ((lambda (x2171)
                                   ((lambda (e2172)
                                      (if (annotation?132 e2172)
-                                         (annotation-expression e2172)
+                                         (sc-annotation-expression e2172)
                                          e2172))
                                     (if (syntax-object?64 x2171)
                                         (syntax-object-expression65 x2171)
@@ -1612,14 +1668,14 @@
                                                                  gooduns2159)
                                                           (if (null?
                                                                 ids2160)
-                                                              (syntax-error
+                                                              (sc-syntax-error
                                                                 exp2156)
                                                               (if (id?306
                                                                     (car ids2160))
                                                                   (if (bound-id-member?442
                                                                         (car ids2160)
                                                                         gooduns2159)
-                                                                      (syntax-error
+                                                                      (sc-syntax-error
                                                                         (car ids2160)
                                                                         '"duplicate "
                                                                         class2155)
@@ -1628,7 +1684,7 @@
                                                                         (cons
                                                                           (car ids2160)
                                                                           gooduns2159)))
-                                                                  (syntax-error
+                                                                  (sc-syntax-error
                                                                     (car ids2160)
                                                                     '"invalid "
                                                                     class2155))))))
@@ -1665,12 +1721,12 @@
                               (wrap443
                                 (if (annotation?132 ae2147)
                                     (begin
-                                      (if (not (eq? (annotation-expression
+                                      (if (not (eq? (sc-annotation-expression
                                                       ae2147)
                                                     x2149))
                                           (error 'sc-expand
                                             '"internal error in source-wrap: ae/x mismatch")
-                                          (void))
+                                          (voide))
                                       ae2147)
                                     x2149)
                                 w2148)))
@@ -1696,7 +1752,7 @@
                                                              x2146
                                                              '#(syntax-object eval ((top) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(when-list w) #((top) (top)) #("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) ("m" top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) ("m" top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t))))
                                                            'eval
-                                                           (syntax-error
+                                                           (sc-syntax-error
                                                              (wrap443
                                                                x2146
                                                                w2144)
@@ -1892,7 +1948,7 @@
                                             '#f rib2125)
                                           (if (annotation?132 e2129)
                                               (syntax-type446
-                                                (annotation-expression
+                                                (sc-annotation-expression
                                                   e2129)
                                                 r2128 w2127 e2129 rib2125)
                                               (if ((lambda (x2139)
@@ -2062,16 +2118,16 @@
                                                                     r2046)
                                                                   (displaced-lexical-error299
                                                                     id2067)
-                                                                  (void))
+                                                                  (voide))
                                                               (if (not (top-ribcage-mutable?376
                                                                          top-ribcage2041))
-                                                                  (syntax-error
+                                                                  (sc-syntax-error
                                                                     (source-wrap444
                                                                       e2050
                                                                       w2064
                                                                       ae2048)
                                                                     '"invalid definition in read-only environment")
-                                                                  (void))
+                                                                  (voide))
                                                               ((lambda (sym2068)
                                                                  (call-with-values
                                                                    (lambda ()
@@ -2088,22 +2144,22 @@
                                                                                        id2067
                                                                                        '(()))
                                                                                      valsym2070))
-                                                                           (syntax-error
+                                                                           (sc-syntax-error
                                                                              (source-wrap444
                                                                                e2050
                                                                                w2064
                                                                                ae2048)
                                                                              '"definition not permitted")
-                                                                           (void))
+                                                                           (voide))
                                                                        (if (read-only-binding?140
                                                                              valsym2070)
-                                                                           (syntax-error
+                                                                           (sc-syntax-error
                                                                              (source-wrap444
                                                                                e2050
                                                                                w2064
                                                                                ae2048)
                                                                              '"invalid definition of read-only identifier")
-                                                                           (void))
+                                                                           (voide))
                                                                        (ct-eval/residualize2493
                                                                          ctem2044
                                                                          (lambda ()
@@ -2126,7 +2182,7 @@
                                                                    ((lambda (e2072)
                                                                       (if (annotation?132
                                                                             e2072)
-                                                                          (annotation-expression
+                                                                          (sc-annotation-expression
                                                                             e2072)
                                                                           e2072))
                                                                      (if (syntax-object?64
@@ -2157,16 +2213,16 @@
                                                                         r2046)
                                                                       (displaced-lexical-error299
                                                                         id2076)
-                                                                      (void))
+                                                                      (voide))
                                                                   (if (not (top-ribcage-mutable?376
                                                                              top-ribcage2041))
-                                                                      (syntax-error
+                                                                      (sc-syntax-error
                                                                         (source-wrap444
                                                                           e2050
                                                                           w2073
                                                                           ae2048)
                                                                         '"invalid definition in read-only environment")
-                                                                      (void))
+                                                                      (voide))
                                                                   ((lambda (sym2077)
                                                                      (call-with-values
                                                                        (lambda ()
@@ -2183,22 +2239,22 @@
                                                                                            id2076
                                                                                            '(()))
                                                                                          valsym2079))
-                                                                               (syntax-error
+                                                                               (sc-syntax-error
                                                                                  (source-wrap444
                                                                                    e2050
                                                                                    w2073
                                                                                    ae2048)
                                                                                  '"definition not permitted")
-                                                                               (void))
+                                                                               (voide))
                                                                            (if (read-only-binding?140
                                                                                  valsym2079)
-                                                                               (syntax-error
+                                                                               (sc-syntax-error
                                                                                  (source-wrap444
                                                                                    e2050
                                                                                    w2073
                                                                                    ae2048)
                                                                                  '"invalid definition of read-only identifier")
-                                                                               (void))
+                                                                               (voide))
                                                                            (if meta?2042
                                                                                (ct-eval/residualize2493
                                                                                  ctem2044
@@ -2267,7 +2323,7 @@
                                                                        ((lambda (e2082)
                                                                           (if (annotation?132
                                                                                 e2082)
-                                                                              (annotation-expression
+                                                                              (sc-annotation-expression
                                                                                 e2082)
                                                                               e2082))
                                                                          (if (syntax-object?64
@@ -2308,13 +2364,13 @@
                                                                             (wrap443
                                                                               id2086
                                                                               w2049))
-                                                                          (void))
+                                                                          (voide))
                                                                       (if (not (top-ribcage-mutable?376
                                                                                  top-ribcage2041))
-                                                                          (syntax-error
+                                                                          (sc-syntax-error
                                                                             orig2087
                                                                             '"invalid definition in read-only environment")
-                                                                          (void))
+                                                                          (voide))
                                                                       (chi-top-module482
                                                                         orig2087
                                                                         r2046
@@ -2347,10 +2403,10 @@
                                                                      (begin
                                                                        (if (not (top-ribcage-mutable?376
                                                                                   top-ribcage2041))
-                                                                           (syntax-error
+                                                                           (sc-syntax-error
                                                                              orig2090
                                                                              '"invalid definition in read-only environment")
-                                                                           (void))
+                                                                           (voide))
                                                                        (ct-eval/residualize2493
                                                                          ctem2044
                                                                          (lambda ()
@@ -2371,7 +2427,7 @@
                                                                                            '(displaced-lexical))
                                                                                          (displaced-lexical-error299
                                                                                            mid2088)
-                                                                                         (syntax-error
+                                                                                         (sc-syntax-error
                                                                                            mid2088
                                                                                            '"unknown module"))))
                                                                                 (binding-type281
@@ -2399,16 +2455,16 @@
                                                                                     r2046)
                                                                                   (displaced-lexical-error299
                                                                                     new-id2095)
-                                                                                  (void))
+                                                                                  (voide))
                                                                               (if (not (top-ribcage-mutable?376
                                                                                          top-ribcage2041))
-                                                                                  (syntax-error
+                                                                                  (sc-syntax-error
                                                                                     (source-wrap444
                                                                                       e2050
                                                                                       w2049
                                                                                       ae2048)
                                                                                     '"invalid definition in read-only environment")
-                                                                                  (void))
+                                                                                  (voide))
                                                                               ((lambda (sym2096)
                                                                                  (call-with-values
                                                                                    (lambda ()
@@ -2425,22 +2481,22 @@
                                                                                                        new-id2095
                                                                                                        '(()))
                                                                                                      valsym2098))
-                                                                                           (syntax-error
+                                                                                           (sc-syntax-error
                                                                                              (source-wrap444
                                                                                                e2050
                                                                                                w2049
                                                                                                ae2048)
                                                                                              '"definition not permitted")
-                                                                                           (void))
+                                                                                           (voide))
                                                                                        (if (read-only-binding?140
                                                                                              valsym2098)
-                                                                                           (syntax-error
+                                                                                           (sc-syntax-error
                                                                                              (source-wrap444
                                                                                                e2050
                                                                                                w2049
                                                                                                ae2048)
                                                                                              '"invalid definition of read-only identifier")
-                                                                                           (void))
+                                                                                           (voide))
                                                                                        (ct-eval/residualize2493
                                                                                          ctem2044
                                                                                          (lambda ()
@@ -2469,7 +2525,7 @@
                                                                                    ((lambda (e2100)
                                                                                       (if (annotation?132
                                                                                             e2100)
-                                                                                          (annotation-expression
+                                                                                          (sc-annotation-expression
                                                                                             e2100)
                                                                                           e2100))
                                                                                      (if (syntax-object?64
@@ -2483,13 +2539,13 @@
                                                                              w2049))))
                                                                      (begin
                                                                        (if meta-seen?2039
-                                                                           (syntax-error
+                                                                           (sc-syntax-error
                                                                              (source-wrap444
                                                                                e2050
                                                                                w2049
                                                                                ae2048)
                                                                              '"invalid meta definition")
-                                                                           (void))
+                                                                           (voide))
                                                                        (if meta?2042
                                                                            ((lambda (x2101)
                                                                               (begin
@@ -2497,7 +2553,7 @@
                                                                                   x2101)
                                                                                 (ct-eval/residualize3494
                                                                                   ctem2044
-                                                                                  void
+                                                                                  voide
                                                                                   (lambda ()
                                                                                     x2101))))
                                                                              (chi-expr499
@@ -2725,16 +2781,16 @@
                                                                                                                                                                 id1909
                                                                                                                                                                 '(()))
                                                                                                                                                               valsym1938))
-                                                                                                                                                    (syntax-error
+                                                                                                                                                    (sc-syntax-error
                                                                                                                                                       orig1917
                                                                                                                                                       '"definition not permitted")
-                                                                                                                                                    (void))
+                                                                                                                                                    (voide))
                                                                                                                                                 (if (read-only-binding?140
                                                                                                                                                       valsym1938)
-                                                                                                                                                    (syntax-error
+                                                                                                                                                    (sc-syntax-error
                                                                                                                                                       orig1917
                                                                                                                                                       '"invalid definition of read-only identifier")
-                                                                                                                                                    (void))
+                                                                                                                                                    (voide))
                                                                                                                                                 (list
                                                                                                                                                   '$sc-put-cte
                                                                                                                                                   (list
@@ -2759,7 +2815,7 @@
                                                                                                                                    ((lambda (e1940)
                                                                                                                                       (if (annotation?132
                                                                                                                                             e1940)
-                                                                                                                                          (annotation-expression
+                                                                                                                                          (sc-annotation-expression
                                                                                                                                             e1940)
                                                                                                                                           e1940))
                                                                                                                                      (if (syntax-object?64
@@ -2918,7 +2974,7 @@
                                                                                                                                                     ((lambda (e1961)
                                                                                                                                                        (if (annotation?132
                                                                                                                                                              e1961)
-                                                                                                                                                           (annotation-expression
+                                                                                                                                                           (sc-annotation-expression
                                                                                                                                                              e1961)
                                                                                                                                                            e1961))
                                                                                                                                                       (if (syntax-object?64
@@ -3002,7 +3058,7 @@
                                                                                                                                                             ((lambda (e1967)
                                                                                                                                                                (if (annotation?132
                                                                                                                                                                      e1967)
-                                                                                                                                                                   (annotation-expression
+                                                                                                                                                                   (sc-annotation-expression
                                                                                                                                                                      e1967)
                                                                                                                                                                    e1967))
                                                                                                                                                               (if (syntax-object?64
@@ -3060,7 +3116,7 @@
                                                                                                                                                                 ((lambda (e1973)
                                                                                                                                                                    (if (annotation?132
                                                                                                                                                                          e1973)
-                                                                                                                                                                       (annotation-expression
+                                                                                                                                                                       (sc-annotation-expression
                                                                                                                                                                          e1973)
                                                                                                                                                                        e1973))
                                                                                                                                                                   (if (syntax-object?64
@@ -3084,12 +3140,12 @@
                                                                                                                                                                           (if (not (symbol?
                                                                                                                                                                                      (get-indirect-label360
                                                                                                                                                                                        label1955)))
-                                                                                                                                                                              (syntax-error
+                                                                                                                                                                              (sc-syntax-error
                                                                                                                                                                                 (module-binding-id464
                                                                                                                                                                                   b1953)
                                                                                                                                                                                 '"unexported target of alias")
-                                                                                                                                                                              (void))
-                                                                                                                                                                          (void))
+                                                                                                                                                                              (voide))
+                                                                                                                                                                          (voide))
                                                                                                                                                                       rest1974))
                                                                                                                                                                    (ctdefs1924))))
                                                                                                                                                              (error 'sc-expand-internal
@@ -3135,7 +3191,7 @@
                                               fexports1878 ids1877)
                                        (letrec ((defined?1880 (lambda (e1887
                                                                        ids1886)
-                                                                (ormap
+                                                                (sc-ormap
                                                                   (lambda (x1888)
                                                                     (if (import-interface?380
                                                                           x1888)
@@ -3149,7 +3205,7 @@
                                                                                           ((lambda (e1894)
                                                                                              (if (annotation?132
                                                                                                    e1894)
-                                                                                                 (annotation-expression
+                                                                                                 (sc-annotation-expression
                                                                                                    e1894)
                                                                                                  e1894))
                                                                                             (if (syntax-object?64
@@ -3179,7 +3235,7 @@
                                                                                                                        ((lambda (e1903)
                                                                                                                           (if (annotation?132
                                                                                                                                 e1903)
-                                                                                                                              (annotation-expression
+                                                                                                                              (sc-annotation-expression
                                                                                                                                 e1903)
                                                                                                                               e1903))
                                                                                                                          (if (syntax-object?64
@@ -3196,7 +3252,7 @@
                                                                                                                        ((lambda (e1901)
                                                                                                                           (if (annotation?132
                                                                                                                                 e1901)
-                                                                                                                              (annotation-expression
+                                                                                                                              (sc-annotation-expression
                                                                                                                                 e1901)
                                                                                                                               e1901))
                                                                                                                          (if (syntax-object?64
@@ -3233,14 +3289,14 @@
                                                                      fexports1883)
                                                                    (if (not (null?
                                                                               missing1882))
-                                                                       (syntax-error
+                                                                       (sc-syntax-error
                                                                          (car missing1882)
                                                                          (if (= (length
                                                                                   missing1882)
                                                                                 '1)
                                                                              '"missing definition for export"
                                                                              '"missing definition for multiple exports, including"))
-                                                                       (void))
+                                                                       (voide))
                                                                    ((lambda (e1885
                                                                              fexports1884)
                                                                       (if (defined?1880
@@ -3400,7 +3456,7 @@
                                                                                           ((lambda (e1852)
                                                                                              (if (annotation?132
                                                                                                    e1852)
-                                                                                                 (annotation-expression
+                                                                                                 (sc-annotation-expression
                                                                                                    e1852)
                                                                                                  e1852))
                                                                                             (if (syntax-object?64
@@ -3420,7 +3476,7 @@
                                                                             ((lambda (e1854)
                                                                                (if (annotation?132
                                                                                      e1854)
-                                                                                   (annotation-expression
+                                                                                   (sc-annotation-expression
                                                                                      e1854)
                                                                                    e1854))
                                                                               (if (syntax-object?64
@@ -3442,7 +3498,7 @@
                                                                   (if (not (null?
                                                                              cls1831))
                                                                       ((lambda (cls1834)
-                                                                         (syntax-error
+                                                                         (sc-syntax-error
                                                                            source-exp1826
                                                                            '"duplicate definition for "
                                                                            (symbol->string
@@ -3450,7 +3506,7 @@
                                                                            '" in"))
                                                                         (syntax-object->datum
                                                                           cls1831))
-                                                                      (void))
+                                                                      (voide))
                                                                   ((letrec ((lp21835 (lambda (ls21837
                                                                                               cls1836)
                                                                                        (if (null?
@@ -3472,7 +3528,7 @@
                                             (car ls1825)
                                             (cdr ls1825)
                                             '())
-                                          (void)))))
+                                          (voide)))))
             (chi-external486 (lambda (ribcage1721 source-exp1720
                                       body1719 r1718 mr1717 ctem1716
                                       exports1715 fexports1714
@@ -3610,7 +3666,7 @@
                                                                                                                           (meta-residualize!1713
                                                                                                                             (ct-eval/residualize3494
                                                                                                                               ctem1716
-                                                                                                                              void
+                                                                                                                              voide
                                                                                                                               (lambda ()
                                                                                                                                 (list
                                                                                                                                   'define
@@ -3652,7 +3708,7 @@
                                                                                                                 ((lambda (e1753)
                                                                                                                    (if (annotation?132
                                                                                                                          e1753)
-                                                                                                                       (annotation-expression
+                                                                                                                       (sc-annotation-expression
                                                                                                                          e1753)
                                                                                                                        e1753))
                                                                                                                   (if (syntax-object?64
@@ -3881,7 +3937,7 @@
                                                                                                                                (extend-ribcage-barrier!412
                                                                                                                                  ribcage1721
                                                                                                                                  mid1781)
-                                                                                                                               (void))
+                                                                                                                               (voide))
                                                                                                                            (do-import!507
                                                                                                                              import-iface1788
                                                                                                                              ribcage1721)
@@ -3911,7 +3967,7 @@
                                                                                                                       '(displaced-lexical))
                                                                                                                     (displaced-lexical-error299
                                                                                                                       mid1781)
-                                                                                                                    (syntax-error
+                                                                                                                    (sc-syntax-error
                                                                                                                       mid1781
                                                                                                                       '"unknown module"))))
                                                                                                            (binding-type281
@@ -4091,13 +4147,13 @@
                                                                                                                          '#f)))
                                                                                                                    (begin
                                                                                                                      (if meta-seen?1726
-                                                                                                                         (syntax-error
+                                                                                                                         (sc-syntax-error
                                                                                                                            (source-wrap444
                                                                                                                              e1738
                                                                                                                              w1737
                                                                                                                              ae1736)
                                                                                                                            '"invalid meta definition")
-                                                                                                                         (void))
+                                                                                                                         (voide))
                                                                                                                      ((letrec ((f1807 (lambda (body1808)
                                                                                                                                         (if ((lambda (t1809)
                                                                                                                                                (if t1809
@@ -4122,7 +4178,7 @@
                                                                                                                                                    (meta-residualize!1713
                                                                                                                                                      (ct-eval/residualize3494
                                                                                                                                                        ctem1716
-                                                                                                                                                       void
+                                                                                                                                                       voide
                                                                                                                                                        (lambda ()
                                                                                                                                                          x1810)))))
                                                                                                                                                 (chi-meta-frob496
@@ -4174,7 +4230,7 @@
                                                              i1707))
                                                          (do1706
                                                            (+ i1707 '1)))
-                                                       (void)))))
+                                                       (voide)))))
                                   do1706)
                                  '0))
                               (vector-length v1703))))
@@ -4305,7 +4361,7 @@
                                                 (if (not t1677)
                                                     (set! t1677
                                                       (thunk1675))
-                                                    (void))
+                                                    (voide))
                                                 (top-level-eval-hook133
                                                   t1677)))
                                             (lambda ()
@@ -4324,7 +4380,7 @@
                                            (begin
                                              (if (memq 'c ctem1672)
                                                  (eval-thunk1671)
-                                                 (void))
+                                                 (voide))
                                              (if (memq 'r ctem1672)
                                                  (if ((lambda (t1673)
                                                         (if t1673
@@ -4487,7 +4543,7 @@
                                                                       (if (memv
                                                                             t1629
                                                                             '(meta-form))
-                                                                          (syntax-error
+                                                                          (sc-syntax-error
                                                                             (source-wrap444
                                                                               e1626
                                                                               w1623
@@ -4501,7 +4557,7 @@
                                                                                   e1626
                                                                                   w1623
                                                                                   ae1622)
-                                                                                (syntax-error
+                                                                                (sc-syntax-error
                                                                                   (source-wrap444
                                                                                     e1626
                                                                                     w1623
@@ -4515,7 +4571,7 @@
                                                                                       e1626
                                                                                       w1623
                                                                                       ae1622)
-                                                                                    (syntax-error
+                                                                                    (sc-syntax-error
                                                                                       (source-wrap444
                                                                                         e1626
                                                                                         w1623
@@ -4535,7 +4591,7 @@
                                                                                                  id1639
                                                                                                  exports1638
                                                                                                  forms1637)
-                                                                                          (syntax-error
+                                                                                          (sc-syntax-error
                                                                                             orig1640
                                                                                             '"invalid context for definition")))
                                                                                       (if (memv
@@ -4550,7 +4606,7 @@
                                                                                             (lambda (orig1643
                                                                                                      only?1642
                                                                                                      mid1641)
-                                                                                              (syntax-error
+                                                                                              (sc-syntax-error
                                                                                                 orig1643
                                                                                                 '"invalid context for definition")))
                                                                                           (if (memv
@@ -4561,7 +4617,7 @@
                                                                                                   e1626
                                                                                                   w1623
                                                                                                   ae1622)
-                                                                                                (syntax-error
+                                                                                                (sc-syntax-error
                                                                                                   (source-wrap444
                                                                                                     e1626
                                                                                                     w1623
@@ -4570,7 +4626,7 @@
                                                                                               (if (memv
                                                                                                     t1629
                                                                                                     '(syntax))
-                                                                                                  (syntax-error
+                                                                                                  (sc-syntax-error
                                                                                                     (source-wrap444
                                                                                                       e1626
                                                                                                       w1623
@@ -4584,7 +4640,7 @@
                                                                                                           e1626
                                                                                                           w1623
                                                                                                           ae1622))
-                                                                                                      (syntax-error
+                                                                                                      (sc-syntax-error
                                                                                                         (source-wrap444
                                                                                                           e1626
                                                                                                           w1623
@@ -4606,7 +4662,7 @@
                                                        e11616)))
                                               tmp1615)
                                             ((lambda (_1620)
-                                               (syntax-error
+                                               (sc-syntax-error
                                                  (source-wrap444
                                                    e1612
                                                    w1609
@@ -4679,13 +4735,13 @@
                                                                               (begin
                                                                                 (if (read-only-binding?140
                                                                                       n1601)
-                                                                                    (syntax-error
+                                                                                    (sc-syntax-error
                                                                                       (source-wrap444
                                                                                         e1600
                                                                                         w1597
                                                                                         ae1596)
                                                                                       '"invalid assignment to read-only variable")
-                                                                                    (void))
+                                                                                    (voide))
                                                                                 (list
                                                                                   'set!
                                                                                   sym1605
@@ -4712,7 +4768,7 @@
                                                                                      (wrap443
                                                                                        id1588
                                                                                        w1597))
-                                                                                   (syntax-error
+                                                                                   (sc-syntax-error
                                                                                      (source-wrap444
                                                                                        e1600
                                                                                        w1597
@@ -4735,7 +4791,7 @@
                                            (id-var-name434 id1588 w1579)))
                                        tmp1583)
                                      ((lambda (_1606)
-                                        (syntax-error
+                                        (sc-syntax-error
                                           (source-wrap444
                                             e1581
                                             w1579
@@ -4820,7 +4876,7 @@
                                                                                  x1569))
                                                                              (if (symbol?
                                                                                    x1569)
-                                                                                 (syntax-error
+                                                                                 (sc-syntax-error
                                                                                    (source-wrap444
                                                                                      e1563
                                                                                      w1561
@@ -4836,11 +4892,11 @@
                                        (out1566
                                          (lambda (id1567)
                                            (begin
-                                             (if (not (identifier? id1567))
-                                                 (syntax-error
+                                             (if (not (sc-identifier? id1567))
+                                                 (sc-syntax-error
                                                    id1567
                                                    '"environment argument is not an identifier")
-                                                 (void))
+                                                 (voide))
                                              (lookup301
                                                (id-var-name434
                                                  id1567
@@ -4869,10 +4925,10 @@
                                                   inits1551)
                                            (begin
                                              (if (null? exprs1555)
-                                                 (syntax-error
+                                                 (sc-syntax-error
                                                    outer-form1546
                                                    '"no expressions in body")
-                                                 (void))
+                                                 (voide))
                                              (build-body237
                                                '#f
                                                (reverse vars1553)
@@ -5006,7 +5062,7 @@
                                                                                                      ((lambda (e1479)
                                                                                                         (if (annotation?132
                                                                                                               e1479)
-                                                                                                            (annotation-expression
+                                                                                                            (sc-annotation-expression
                                                                                                               e1479)
                                                                                                             e1479))
                                                                                                        (if (syntax-object?64
@@ -5228,7 +5284,7 @@
                                                                                                                                (extend-ribcage-barrier!412
                                                                                                                                  ribcage1451
                                                                                                                                  mid1508)
-                                                                                                                               (void))
+                                                                                                                               (voide))
                                                                                                                            (do-import!507
                                                                                                                              import-iface1515
                                                                                                                              ribcage1451)
@@ -5255,7 +5311,7 @@
                                                                                                                       '(displaced-lexical))
                                                                                                                     (displaced-lexical-error299
                                                                                                                       mid1508)
-                                                                                                                    (syntax-error
+                                                                                                                    (sc-syntax-error
                                                                                                                       mid1508
                                                                                                                       '"unknown module"))))
                                                                                                            (binding-type281
@@ -5427,13 +5483,13 @@
                                                                                                                          '#f)))
                                                                                                                    (begin
                                                                                                                      (if meta-seen?1454
-                                                                                                                         (syntax-error
+                                                                                                                         (sc-syntax-error
                                                                                                                            (source-wrap444
                                                                                                                              e1467
                                                                                                                              w1466
                                                                                                                              ae1465)
                                                                                                                            '"invalid meta definition")
-                                                                                                                         (void))
+                                                                                                                         (voide))
                                                                                                                      ((letrec ((f1532 (lambda (body1533)
                                                                                                                                         (if ((lambda (t1534)
                                                                                                                                                (if t1534
@@ -5482,10 +5538,10 @@
                                       ((lambda (label1443)
                                          (begin
                                            (if (not label1443)
-                                               (syntax-error
+                                               (sc-syntax-error
                                                  id1442
                                                  '"exported identifier not visible")
-                                               (void))
+                                               (voide))
                                            label1443))
                                         (id-var-name-loc433
                                           id1442
@@ -5531,7 +5587,7 @@
                                                                               (wrap443
                                                                                 x1436
                                                                                 *w1410)
-                                                                              (syntax-error
+                                                                              (sc-syntax-error
                                                                                 (source-wrap444
                                                                                   e1413
                                                                                   w1412
@@ -5569,7 +5625,7 @@
                                                       form1422)))
                                              tmp1416)
                                            ((lambda (_1430)
-                                              (syntax-error
+                                              (sc-syntax-error
                                                 (source-wrap444
                                                   e1413
                                                   w1412
@@ -5617,7 +5673,7 @@
                                                         w1392)))
                                                   tmp1402)
                                                 ((lambda (_1409)
-                                                   (syntax-error
+                                                   (sc-syntax-error
                                                      (source-wrap444
                                                        e1393
                                                        w1392
@@ -5698,11 +5754,11 @@
                                                              (wrap443
                                                                name1388
                                                                w1363)
-                                                             '#(syntax-object (void) ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(e w ae) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) ("m" top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) ("m" top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))
+                                                             '#(syntax-object (voide) ((top) #(ribcage #(_ name) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(e w ae) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) ("m" top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) ("m" top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))
                                                              '(())))
                                                          tmp1385)
                                                        ((lambda (_1390)
-                                                          (syntax-error
+                                                          (sc-syntax-error
                                                             (source-wrap444
                                                               e1364
                                                               w1363
@@ -5778,7 +5834,7 @@
                                                              w1339))
                                                          tmp1354)
                                                        ((lambda (_1361)
-                                                          (syntax-error
+                                                          (sc-syntax-error
                                                             (source-wrap444
                                                               e1340
                                                               w1339
@@ -5802,7 +5858,7 @@
                                          (lambda (_1336 form1335) form1335)
                                          tmp1334)
                                        ((lambda (_1337)
-                                          (syntax-error
+                                          (sc-syntax-error
                                             (source-wrap444
                                               e1332
                                               w1331
@@ -5824,7 +5880,7 @@
                                                   (cons e11324 e21323)))
                                               tmp1322)
                                             ((lambda (_1329)
-                                               (syntax-error
+                                               (sc-syntax-error
                                                  (source-wrap444
                                                    e1320
                                                    w1319
@@ -5852,7 +5908,7 @@
                                             (values new-id1315 old-id1314))
                                           tmp1310)
                                         ((lambda (_1317)
-                                           (syntax-error
+                                           (sc-syntax-error
                                              (source-wrap444
                                                e1308
                                                w1307
@@ -5882,7 +5938,7 @@
                                                    (cons e11302 e21301))
                                                  tmp1300)
                                                ((lambda (_1305)
-                                                  (syntax-error
+                                                  (sc-syntax-error
                                                     (source-wrap444
                                                       e1295
                                                       w1294
@@ -5904,7 +5960,7 @@
                                                   ((lambda (ids1275)
                                                      (if (not (valid-bound-ids?439
                                                                 ids1275))
-                                                         (syntax-error
+                                                         (sc-syntax-error
                                                            e1269
                                                            '"invalid parameter list in")
                                                          ((lambda (labels1277
@@ -5941,7 +5997,7 @@
                                                          ((lambda (old-ids1284)
                                                             (if (not (valid-bound-ids?439
                                                                        old-ids1284))
-                                                                (syntax-error
+                                                                (sc-syntax-error
                                                                   e1269
                                                                   '"invalid parameter list in")
                                                                 ((lambda (labels1286
@@ -5983,7 +6039,7 @@
                                                              ids1283)))
                                                        tmp1280)
                                                      ((lambda (_1291)
-                                                        (syntax-error
+                                                        (sc-syntax-error
                                                           e1269))
                                                        tmp1270)))
                                                 ($syntax-dispatch
@@ -6056,7 +6112,7 @@
                                                    id1251))
                                                tmp1247)
                                              ((lambda (_1263)
-                                                (syntax-error
+                                                (sc-syntax-error
                                                   (source-wrap444
                                                     e1244
                                                     w1241
@@ -6069,7 +6125,7 @@
                                                 .
                                                 each-any))))
                                      e1244)))
-            (chi-void518 (lambda () (cons 'void '())))
+            (chi-void518 (lambda () (cons 'voide '())))
             (ellipsis?519 (lambda (x1239)
                             (if (nonsymbol-id?305 x1239)
                                 (literal-id=?436
@@ -6082,7 +6138,7 @@
                                          (strip-annotation520 (car x1238))
                                          (strip-annotation520 (cdr x1238)))
                                        (if (annotation?132 x1238)
-                                           (annotation-stripped x1238)
+                                           (sc-annotation-stripped x1238)
                                            x1238))))
             (strip*521 (lambda (x1231 w1230 fn1229)
                          (if (memq 'top (wrap-marks316 w1230))
@@ -6115,7 +6171,7 @@
                                                         (if (vector? x1233)
                                                             ((lambda (old1236)
                                                                ((lambda (new1237)
-                                                                  (if (andmap
+                                                                  (if (sc-andmap2
                                                                         eq?
                                                                         old1236
                                                                         new1237)
@@ -6146,8 +6202,8 @@
             (gen-var523 (lambda (id1223)
                           ((lambda (id1224)
                              (if (annotation?132 id1224)
-                                 (gensym)
-                                 (gensym)))
+                                 (jensym)
+                                 (jensym)))
                             (if (syntax-object?64 id1223)
                                 (syntax-object-expression65 id1223)
                                 id1223))))
@@ -6186,7 +6242,7 @@
                                                                        (if (annotation?132
                                                                              vars1222)
                                                                            (lvl1219
-                                                                             (annotation-expression
+                                                                             (sc-annotation-expression
                                                                                vars1222)
                                                                              ls1221
                                                                              w1220)
@@ -6258,10 +6314,10 @@
                                                        (if (not (eq? (interface-token455
                                                                        iface1208)
                                                                      token1205))
-                                                           (syntax-error
+                                                           (sc-syntax-error
                                                              id1199
                                                              '"import mismatch for module")
-                                                           (void))
+                                                           (voide))
                                                        (sc-put-module1200
                                                          (interface-exports454
                                                            iface1208)
@@ -6272,7 +6328,7 @@
                                                  (interface-exports454
                                                    iface1208)))
                                               (binding-value282 b1206))
-                                            (syntax-error
+                                            (sc-syntax-error
                                               id1199
                                               '"unknown module")))
                                        (binding-type281 b1206)))
@@ -6310,7 +6366,7 @@
                                      (if (memv t1193 '(displaced-lexical))
                                          (displaced-lexical-error299
                                            (wrap443 id1192 w1168))
-                                         (void)))
+                                         (voide)))
                                     (binding-type281
                                       (lookup301 n1191 r1170))))
                                 var1183
@@ -6332,7 +6388,7 @@
                                 var1183)))
                        tmp1173)
                      ((lambda (_1196)
-                        (syntax-error (source-wrap444 e1171 w1168 ae1167)))
+                        (sc-syntax-error (source-wrap444 e1171 w1168 ae1167)))
                        tmp1172)))
                 ($syntax-dispatch
                   tmp1172
@@ -6350,7 +6406,7 @@
                          (list 'quote (strip522 e1163 w1157)))
                        tmp1162)
                      ((lambda (_1165)
-                        (syntax-error (source-wrap444 e1160 w1157 ae1156)))
+                        (sc-syntax-error (source-wrap444 e1160 w1157 ae1156)))
                        tmp1161)))
                 ($syntax-dispatch tmp1161 '(any any))))
              e1160)))
@@ -6386,7 +6442,7 @@
                                                            maps1103)))
                                                      (if (ellipsis?1096
                                                            e1099)
-                                                         (syntax-error
+                                                         (sc-syntax-error
                                                            src1100
                                                            '"misplaced ellipsis in syntax form")
                                                          (values
@@ -6412,7 +6468,7 @@
                                                        (lambda (dots1111
                                                                 e1110)
                                                          (if vec?1095
-                                                             (syntax-error
+                                                             (sc-syntax-error
                                                                src1100
                                                                '"misplaced ellipsis in syntax template")
                                                              (gen-syntax1039
@@ -6465,7 +6521,7 @@
                                                                                                                 maps1130)
                                                                                                          (if (null?
                                                                                                                (car maps1130))
-                                                                                                             (syntax-error
+                                                                                                             (sc-syntax-error
                                                                                                                src1100
                                                                                                                '"extra ellipsis in syntax form")
                                                                                                              (values
@@ -6521,7 +6577,7 @@
                                                                                maps1138)
                                                                         (if (null?
                                                                               (car maps1138))
-                                                                            (syntax-error
+                                                                            (sc-syntax-error
                                                                               src1100
                                                                               '"extra ellipsis in syntax form")
                                                                             (values
@@ -6623,7 +6679,7 @@
                                     (if (= level1088 '0)
                                         (values var1089 maps1087)
                                         (if (null? maps1087)
-                                            (syntax-error
+                                            (sc-syntax-error
                                               src1090
                                               '"missing ellipsis in syntax form")
                                             (call-with-values
@@ -6670,7 +6726,7 @@
                                     ((lambda (formals1078 actuals1077)
                                        (if (eq? (car e1076) 'ref)
                                            (car actuals1077)
-                                           (if (andmap
+                                           (if (sc-andmap
                                                  (lambda (x1079)
                                                    (if (eq? (car x1079)
                                                             'ref)
@@ -6807,7 +6863,7 @@
                                    (lambda (e1059 maps1058)
                                      (regen1046 e1059))))
                                tmp1055)
-                             ((lambda (_1060) (syntax-error e1053))
+                             ((lambda (_1060) (sc-syntax-error e1053))
                                tmp1054)))
                         ($syntax-dispatch tmp1054 '(any any))))
                      e1053))
@@ -6829,7 +6885,7 @@
                            (lambda (vars1038 body1037)
                              (list 'lambda vars1038 body1037))))
                        tmp1034)
-                     (syntax-error tmp1033)))
+                     (sc-syntax-error tmp1033)))
                 ($syntax-dispatch tmp1033 '(any . any))))
              e1032)))
        (global-extend304
@@ -6877,7 +6933,7 @@
                            id1014))
                        tmp1010)
                      ((lambda (_1026)
-                        (syntax-error (source-wrap444 e1008 w1005 ae1004)))
+                        (sc-syntax-error (source-wrap444 e1008 w1005 ae1004)))
                        tmp1009)))
                 ($syntax-dispatch
                   tmp1009
@@ -6909,7 +6965,7 @@
                                   (chi498 else998 r990 mr989 w988 m?986)))
                               tmp997)
                             ((lambda (_1002)
-                               (syntax-error
+                               (sc-syntax-error
                                  (source-wrap444 e991 w988 ae987)))
                               tmp992)))
                        ($syntax-dispatch tmp992 '(any any any any)))))
@@ -7197,12 +7253,12 @@
                                                 (map car pvars906)
                                                 pat899
                                                 '"pattern variable")
-                                              (if (not (andmap
+                                              (if (not (sc-andmap
                                                          (lambda (x908)
                                                            (not (ellipsis?519
                                                                   (car x908))))
                                                          pvars906))
-                                                  (syntax-error
+                                                  (sc-syntax-error
                                                     pat899
                                                     '"misplaced ellipsis in syntax-case pattern")
                                                   ((lambda (y909)
@@ -7344,7 +7400,7 @@
                                                                       exp893))
                                                                   tmp892)
                                                                 ((lambda (_896)
-                                                                   (syntax-error
+                                                                   (sc-syntax-error
                                                                      (car clauses883)
                                                                      '"invalid syntax-case clause"))
                                                                   tmp886)))
@@ -7363,7 +7419,7 @@
                          (if tmp870
                              (apply
                                (lambda (_874 val873 key872 m871)
-                                 (if (andmap
+                                 (if (sc-andmap
                                        (lambda (x876)
                                          (if (id?306 x876)
                                              (not (ellipsis?519 x876))
@@ -7380,11 +7436,11 @@
                                             (chi498 val873 r866 mr865 '(())
                                               m?862))))
                                        (gen-var523 'tmp))
-                                     (syntax-error
+                                     (sc-syntax-error
                                        e868
                                        '"invalid literals list in")))
                                tmp870)
-                             (syntax-error tmp869)))
+                             (sc-syntax-error tmp869)))
                         ($syntax-dispatch
                           tmp869
                           '(any any each-any . each-any))))
@@ -7399,15 +7455,15 @@
                                                (if tmp853
                                                    (apply
                                                      (lambda (id855 e854)
-                                                       (if (identifier?
+                                                       (if (sc-identifier?
                                                              id855)
-                                                           (andmap
+                                                           (sc-andmap
                                                              proper-export?828
                                                              e854)
                                                            '#f))
                                                      tmp853)
                                                    ((lambda (id857)
-                                                      (identifier? id857))
+                                                      (sc-identifier? id857))
                                                      tmp852)))
                                               ($syntax-dispatch
                                                 tmp852
@@ -7420,7 +7476,7 @@
                          (if tmp832
                              (apply
                                (lambda (_835 e834 d833)
-                                 (if (andmap proper-export?828 e834)
+                                 (if (sc-andmap proper-export?828 e834)
                                      (list
                                        '#(syntax-object begin ((top) #(ribcage #(_ e d) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(orig) #((top)) #("i")) #(ribcage (proper-export?) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) ("m" top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) ("m" top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))
                                        (cons
@@ -7435,7 +7491,7 @@
                                          (cons
                                            orig830
                                            '#(syntax-object (#f anon) ((top) #(ribcage #(_ e d) #((top) (top) (top)) #("i" "i" "i")) #(ribcage #(orig) #((top)) #("i")) #(ribcage (proper-export?) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) ("m" top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) ("m" top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t))))))
-                                     (syntax-error
+                                     (sc-syntax-error
                                        x827
                                        '"invalid exports list in")))
                                tmp832)
@@ -7443,12 +7499,12 @@
                                 (if (if tmp839
                                         (apply
                                           (lambda (_843 m842 e841 d840)
-                                            (identifier? m842))
+                                            (sc-identifier? m842))
                                           tmp839)
                                         '#f)
                                     (apply
                                       (lambda (_847 m846 e845 d844)
-                                        (if (andmap proper-export?828 e845)
+                                        (if (sc-andmap proper-export?828 e845)
                                             (cons
                                               '#(syntax-object $module ((top) #(ribcage #(_ m e d) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage #(orig) #((top)) #("i")) #(ribcage (proper-export?) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) ("m" top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) ("m" top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))
                                               (cons
@@ -7456,11 +7512,11 @@
                                                 (cons
                                                   m846
                                                   (cons e845 d844))))
-                                            (syntax-error
+                                            (sc-syntax-error
                                               x827
                                               '"invalid exports list in")))
                                       tmp839)
-                                    (syntax-error tmp831)))
+                                    (sc-syntax-error tmp831)))
                                ($syntax-dispatch
                                  tmp831
                                  '(any any each-any . each-any)))))
@@ -7516,7 +7572,7 @@
                                                          '(displaced-lexical))
                                                        (displaced-lexical-error299
                                                          m819)
-                                                       (syntax-error
+                                                       (sc-syntax-error
                                                          m819
                                                          '"unknown module"))))
                                               (binding-type281 b820)))
@@ -7569,12 +7625,12 @@
                                                                                                  np812)
                                                                                                prefix808)
                                                                                              '#f))
-                                                                                    (syntax-error
+                                                                                    (sc-syntax-error
                                                                                       id809
                                                                                       (string-append
                                                                                         '"missing expected prefix "
                                                                                         prefix808))
-                                                                                    (void))
+                                                                                    (voide))
                                                                                 (datum->syntax-object
                                                                                   id809
                                                                                   (string->symbol
@@ -7600,7 +7656,7 @@
                                                                       ((lambda (e806)
                                                                          (if (annotation?132
                                                                                e806)
-                                                                             (annotation-expression
+                                                                             (sc-annotation-expression
                                                                                e806)
                                                                              e806))
                                                                         (if (syntax-object?64
@@ -7623,8 +7679,8 @@
                                                                                            (apply
                                                                                              (lambda (m663
                                                                                                       id662)
-                                                                                               (andmap
-                                                                                                 identifier?
+                                                                                               (sc-andmap
+                                                                                                 sc-identifier?
                                                                                                  id662))
                                                                                              tmp661)
                                                                                            '#f)
@@ -7664,7 +7720,7 @@
                                                                                                                    id665
                                                                                                                    '#f)))
                                                                                                            tmp671)
-                                                                                                         (syntax-error
+                                                                                                         (sc-syntax-error
                                                                                                            tmp670)))
                                                                                                     ($syntax-dispatch
                                                                                                       tmp670
@@ -7679,8 +7735,8 @@
                                                                                                   (apply
                                                                                                     (lambda (m678
                                                                                                              id677)
-                                                                                                      (andmap
-                                                                                                        identifier?
+                                                                                                      (sc-andmap
+                                                                                                        sc-identifier?
                                                                                                         id677))
                                                                                                     tmp676)
                                                                                                   '#f)
@@ -7721,7 +7777,7 @@
                                                                                                                           id688
                                                                                                                           '#f)))
                                                                                                                   tmp687)
-                                                                                                                (syntax-error
+                                                                                                                (sc-syntax-error
                                                                                                                   tmp685)))
                                                                                                            ($syntax-dispatch
                                                                                                              tmp685
@@ -7740,7 +7796,7 @@
                                                                                                          (apply
                                                                                                            (lambda (m695
                                                                                                                     prefix-id694)
-                                                                                                             (identifier?
+                                                                                                             (sc-identifier?
                                                                                                                prefix-id694))
                                                                                                            tmp693)
                                                                                                          '#f)
@@ -7822,7 +7878,7 @@
                                                                                                                                  id703
                                                                                                                                  '#f)))
                                                                                                                          tmp702)
-                                                                                                                       (syntax-error
+                                                                                                                       (sc-syntax-error
                                                                                                                          tmp701)))
                                                                                                                   ($syntax-dispatch
                                                                                                                     tmp701
@@ -7835,7 +7891,7 @@
                                                                                                                  (gen-mid638
                                                                                                                    mid700)
                                                                                                                  exports698
-                                                                                                                 (generate-temporaries
+                                                                                                                 (sc-generate-temporaries
                                                                                                                    exports698)
                                                                                                                  (map (prefix-add636
                                                                                                                         prefix-id696)
@@ -7846,7 +7902,7 @@
                                                                                                                 (apply
                                                                                                                   (lambda (m719
                                                                                                                            prefix-id718)
-                                                                                                                    (identifier?
+                                                                                                                    (sc-identifier?
                                                                                                                       prefix-id718))
                                                                                                                   tmp717)
                                                                                                                 '#f)
@@ -7928,7 +7984,7 @@
                                                                                                                                         id727
                                                                                                                                         '#f)))
                                                                                                                                 tmp726)
-                                                                                                                              (syntax-error
+                                                                                                                              (sc-syntax-error
                                                                                                                                 tmp725)))
                                                                                                                          ($syntax-dispatch
                                                                                                                            tmp725
@@ -7941,7 +7997,7 @@
                                                                                                                         (gen-mid638
                                                                                                                           mid724)
                                                                                                                         exports722
-                                                                                                                        (generate-temporaries
+                                                                                                                        (sc-generate-temporaries
                                                                                                                           exports722)
                                                                                                                         (map (prefix-drop637
                                                                                                                                prefix-id720)
@@ -7953,11 +8009,11 @@
                                                                                                                          (lambda (m744
                                                                                                                                   new-id743
                                                                                                                                   old-id742)
-                                                                                                                           (if (andmap
-                                                                                                                                 identifier?
+                                                                                                                           (if (sc-andmap
+                                                                                                                                 sc-identifier?
                                                                                                                                  new-id743)
-                                                                                                                               (andmap
-                                                                                                                                 identifier?
+                                                                                                                               (sc-andmap
+                                                                                                                                 sc-identifier?
                                                                                                                                  old-id742)
                                                                                                                                '#f))
                                                                                                                          tmp741)
@@ -8046,7 +8102,7 @@
                                                                                                                                                  other-id757)
                                                                                                                                                '#f)))
                                                                                                                                        tmp756)
-                                                                                                                                     (syntax-error
+                                                                                                                                     (sc-syntax-error
                                                                                                                                        tmp753)))
                                                                                                                                 ($syntax-dispatch
                                                                                                                                   tmp753
@@ -8057,7 +8113,7 @@
                                                                                                                                d751
                                                                                                                                (gen-mid638
                                                                                                                                  mid752)
-                                                                                                                               (generate-temporaries
+                                                                                                                               (sc-generate-temporaries
                                                                                                                                  old-id747)
                                                                                                                                (difference635
                                                                                                                                  exports750
@@ -8069,11 +8125,11 @@
                                                                                                                                 (lambda (m776
                                                                                                                                          new-id775
                                                                                                                                          old-id774)
-                                                                                                                                  (if (andmap
-                                                                                                                                        identifier?
+                                                                                                                                  (if (sc-andmap
+                                                                                                                                        sc-identifier?
                                                                                                                                         new-id775)
-                                                                                                                                      (andmap
-                                                                                                                                        identifier?
+                                                                                                                                      (sc-andmap
+                                                                                                                                        sc-identifier?
                                                                                                                                         old-id774)
                                                                                                                                       '#f))
                                                                                                                                 tmp773)
@@ -8134,7 +8190,7 @@
                                                                                                                                                         other-id787)
                                                                                                                                                       '#f)))
                                                                                                                                               tmp786)
-                                                                                                                                            (syntax-error
+                                                                                                                                            (sc-syntax-error
                                                                                                                                               tmp785)))
                                                                                                                                        ($syntax-dispatch
                                                                                                                                          tmp785
@@ -8150,7 +8206,7 @@
                                                                                                                              (if (if tmp797
                                                                                                                                      (apply
                                                                                                                                        (lambda (mid798)
-                                                                                                                                         (identifier?
+                                                                                                                                         (sc-identifier?
                                                                                                                                            mid798))
                                                                                                                                        tmp797)
                                                                                                                                      '#f)
@@ -8173,7 +8229,7 @@
                                                                                                                                     (if (if tmp800
                                                                                                                                             (apply
                                                                                                                                               (lambda (mid801)
-                                                                                                                                                (identifier?
+                                                                                                                                                (sc-identifier?
                                                                                                                                                   mid801))
                                                                                                                                               tmp800)
                                                                                                                                             '#f)
@@ -8193,7 +8249,7 @@
                                                                                                                                                   '#f)))
                                                                                                                                           tmp800)
                                                                                                                                         ((lambda (_803)
-                                                                                                                                           (syntax-error
+                                                                                                                                           (sc-syntax-error
                                                                                                                                              m655
                                                                                                                                              '"invalid module specifier"))
                                                                                                                                           tmp660)))
@@ -8246,7 +8302,7 @@
                                                                                        each-any))))
                                                                                m655))
                                                                            tmp657)
-                                                                         (syntax-error
+                                                                         (sc-syntax-error
                                                                            tmp656)))
                                                                     ($syntax-dispatch
                                                                       tmp656
@@ -8278,7 +8334,7 @@
                                                                         '#(syntax-object begin ((top) #(ribcage #(d) #((top)) #("i")) #(ribcage #(_ m) #((top) (top)) #("i" "i")) #(ribcage (modspec* modspec gen-mid prefix-drop prefix-add difference) ((top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i")) #(ribcage #(r) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(orig import-only?) #((top) (top)) #("i" "i")) #(ribcage ($import-help $module-exports) ((top) (top)) ("i" "i")) #(ribcage (lambda-var-list gen-var strip strip* strip-annotation ellipsis? chi-void chi-local-syntax chi-lambda-clause parse-begin parse-alias parse-eval-when parse-meta parse-define-syntax parse-define parse-import parse-module do-import! lookup-import-label import-mark-delta chi-internal chi-body chi-macro chi-set! chi-application chi-expr chi chi-sequence chi-meta-frob chi-frobs ct-eval/residualize3 ct-eval/residualize2 rt-eval/residualize initial-mode-set update-mode-set do-top-import vfor-each vmap chi-external check-defined-ids check-module-exports id-set-diff chi-top-module set-frob-meta?! set-frob-e! frob-meta? frob-e frob? make-frob create-module-binding set-module-binding-exported! set-module-binding-val! set-module-binding-imps! set-module-binding-label! set-module-binding-id! set-module-binding-type! module-binding-exported module-binding-val module-binding-imps module-binding-label module-binding-id module-binding-type module-binding? make-module-binding make-resolved-interface make-unresolved-interface set-interface-token! set-interface-exports! set-interface-marks! interface-token interface-exports interface-marks interface? make-interface flatten-exports chi-top chi-top-sequence chi-top* syntax-type chi-when-list source-wrap wrap bound-id-member? invalid-ids-error distinct-bound-ids? valid-bound-ids? bound-id=? help-bound-id=? literal-id=? free-id=? id-var-name id-var-name-loc id-var-name&marks id-var-name-loc&marks top-id-free-var-name top-id-bound-var-name anon diff-marks same-marks? join-subst join-marks join-wraps smart-append resolved-id-var-name id->resolved-id make-resolved-id make-binding-wrap store-import-binding lookup-import-binding-name extend-ribcage-subst! extend-ribcage-barrier-help! extend-ribcage-barrier! import-extend-ribcage! extend-ribcage! make-empty-ribcage barrier-marker new-mark anti-mark the-anti-mark set-env-wrap! set-env-top-ribcage! env-wrap env-top-ribcage env? make-env set-import-interface-new-marks! set-import-interface-interface! import-interface-new-marks import-interface-interface import-interface? make-import-interface set-top-ribcage-mutable?! set-top-ribcage-key! top-ribcage-mutable? top-ribcage-key top-ribcage? make-top-ribcage set-ribcage-labels! set-ribcage-marks! set-ribcage-symnames! ribcage-labels ribcage-marks ribcage-symnames ribcage? make-ribcage gen-labels label? gen-label set-indirect-label! get-indirect-label indirect-label? gen-indirect-label anon only-top-marked? top-marked? tmp-wrap top-wrap empty-wrap wrap-subst wrap-marks make-wrap id-sym-name&marks id-subst id-marks id-sym-name id? nonsymbol-id? global-extend defer-or-eval-transformer make-transformer-binding lookup lookup* displaced-lexical-error displaced-lexical? extend-var-env* extend-env* extend-env null-env binding? set-binding-value! set-binding-type! binding-value binding-type make-binding sanitize-binding arg-check no-source unannotate self-evaluating? lexical-var? build-lexical-var build-top-module build-body build-letrec build-sequence build-data build-primref built-lambda? build-lambda build-revisit-only build-visit-only build-cte-install build-global-definition build-global-assignment build-global-reference build-lexical-assignment build-lexical-reference build-conditional build-application generate-id update-import-binding! get-import-binding read-only-binding? put-global-definition-hook get-global-definition-hook put-cte-hook error-hook define-top-level-value-hook local-eval-hook top-level-eval-hook annotation? fx>= fx<= fx> fx< fx= fx- fx+ set-syntax-object-wrap! set-syntax-object-expression! syntax-object-wrap syntax-object-expression syntax-object? make-syntax-object noexpand let-values define-structure unless when) ((top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) ("m" top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) ("m" top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))
                                                                         d648))
                                                                     tmp647)
-                                                                  (syntax-error
+                                                                  (sc-syntax-error
                                                                     tmp645)))
                                                              ($syntax-dispatch
                                                                tmp645
@@ -8286,7 +8342,7 @@
                                                           (map modspec*640
                                                                m643)))
                                                       tmp642)
-                                                    (syntax-error tmp641)))
+                                                    (sc-syntax-error tmp641)))
                                                ($syntax-dispatch
                                                  tmp641
                                                  '(any . each-any))))
@@ -8318,11 +8374,11 @@
                   (wrap-marks316 '((top)))
                   (cons top-ribcage623 (wrap-subst317 '((top)))))))
              (make-top-ribcage373 token622 mutable?621))))
-       (set! environment? (lambda (x620) (env?386 x620)))
+       (set! sc-environment? (lambda (x620) (env?386 x620)))
        (set! sc-interaction-environment
          ((lambda (e619) (lambda () e619))
            ($make-environment '*top* '#t)))
-       (set! identifier? (lambda (x618) (nonsymbol-id?305 x618)))
+       (set! sc-identifier? (lambda (x618) (nonsymbol-id?305 x618)))
        (set! datum->syntax-object
          (lambda (id616 datum615)
            (begin
@@ -8332,7 +8388,7 @@
                       'datum->syntax-object
                       '"invalid argument"
                       x617)
-                    (void)))
+                    (voide)))
                id616)
              (make-syntax-object63
                datum615
@@ -8379,7 +8435,7 @@
              v600)))
        (set! syntax-object->datum
          (lambda (x599) (strip522 x599 '(()))))
-       (set! generate-temporaries
+       (set! sc-generate-temporaries
          ((lambda (n595)
             (lambda (ls596)
               (begin
@@ -8389,7 +8445,7 @@
                          'generate-temporaries
                          '"invalid argument"
                          x598)
-                       (void)))
+                       (voide)))
                   ls596)
                 (map (lambda (x597)
                        (begin
@@ -8400,7 +8456,7 @@
                            '((tmp)))))
                      ls596))))
            '0))
-       (set! free-identifier=?
+       (set! sc-free-identifier=?
          (lambda (x592 y591)
            (begin
              ((lambda (x594)
@@ -8409,7 +8465,7 @@
                       'free-identifier=?
                       '"invalid argument"
                       x594)
-                    (void)))
+                    (voide)))
                x592)
              ((lambda (x593)
                 (if (not (nonsymbol-id?305 x593))
@@ -8417,10 +8473,10 @@
                       'free-identifier=?
                       '"invalid argument"
                       x593)
-                    (void)))
+                    (voide)))
                y591)
              (free-id=?435 x592 y591))))
-       (set! bound-identifier=?
+       (set! sc-bound-identifier=?
          (lambda (x588 y587)
            (begin
              ((lambda (x590)
@@ -8429,7 +8485,7 @@
                       'bound-identifier=?
                       '"invalid argument"
                       x590)
-                    (void)))
+                    (voide)))
                x588)
              ((lambda (x589)
                 (if (not (nonsymbol-id?305 x589))
@@ -8437,7 +8493,7 @@
                       'bound-identifier=?
                       '"invalid argument"
                       x589)
-                    (void)))
+                    (voide)))
                y587)
              (bound-id=?438 x588 y587))))
        (set! literal-identifier=?
@@ -8449,7 +8505,7 @@
                       'literal-identifier=?
                       '"invalid argument"
                       x586)
-                    (void)))
+                    (voide)))
                x584)
              ((lambda (x585)
                 (if (not (nonsymbol-id?305 x585))
@@ -8457,10 +8513,10 @@
                       'literal-identifier=?
                       '"invalid argument"
                       x585)
-                    (void)))
+                    (voide)))
                y583)
              (literal-id=?436 x584 y583))))
-       (set! syntax-error
+       (set! sc-syntax-error
          (lambda (object578 . messages579)
            (begin
              (for-each
@@ -8471,7 +8527,7 @@
                           'syntax-error
                           '"invalid argument"
                           x582)
-                        (void)))
+                        (voide)))
                    x581))
                messages579)
              ((lambda (message580)
@@ -8483,7 +8539,7 @@
           (letrec ((match-each525 (lambda (e575 p574 w573)
                                     (if (annotation?132 e575)
                                         (match-each525
-                                          (annotation-expression e575)
+                                          (sc-annotation-expression e575)
                                           p574
                                           w573)
                                         (if (pair? e575)
@@ -8564,7 +8620,7 @@
                                                            (if (annotation?132
                                                                  e568)
                                                                (f566
-                                                                 (annotation-expression
+                                                                 (sc-annotation-expression
                                                                    e568)
                                                                  w567)
                                                                (if (syntax-object?64
@@ -8590,7 +8646,7 @@
                    (match-each-any527 (lambda (e558 w557)
                                         (if (annotation?132 e558)
                                             (match-each-any527
-                                              (annotation-expression e558)
+                                              (sc-annotation-expression e558)
                                               w557)
                                             (if (pair? e558)
                                                 ((lambda (l559)
@@ -8668,7 +8724,7 @@
                                                                             p555
                                                                             '1)
                                                                           r554)
-                                                                        (void))))))
+                                                                        (voide))))))
                                                        (vector-ref
                                                          p555
                                                          '0))))))))
@@ -8799,7 +8855,7 @@
                                                                          w543
                                                                          r542)
                                                                        '#f)
-                                                                   (void)))))))
+                                                                   (voide)))))))
                                               (vector-ref p544 '0)))))))
                    (match531 (lambda (e539 p538 w537 r536)
                                (if (not r536)
@@ -8810,7 +8866,7 @@
                                            (match*530
                                              ((lambda (e540)
                                                 (if (annotation?132 e540)
-                                                    (annotation-expression
+                                                    (sc-annotation-expression
                                                       e540)
                                                     e540))
                                                (syntax-object-expression65
@@ -8823,7 +8879,7 @@
                                            (match*530
                                              ((lambda (e541)
                                                 (if (annotation?132 e541)
-                                                    (annotation-expression
+                                                    (sc-annotation-expression
                                                       e541)
                                                     e541))
                                                e539)
@@ -8838,7 +8894,7 @@
                         (match*530
                           ((lambda (e534)
                              (if (annotation?132 e534)
-                                 (annotation-expression e534)
+                                 (sc-annotation-expression e534)
                                  e534))
                             (syntax-object-expression65 e533))
                           p532
@@ -8847,7 +8903,7 @@
                         (match*530
                           ((lambda (e535)
                              (if (annotation?132 e535)
-                                 (annotation-expression e535)
+                                 (sc-annotation-expression e535)
                                  e535))
                             e533)
                           p532
@@ -8895,7 +8951,7 @@
                                       '#(syntax-object begin ((top) #(ribcage #(_ out in e1 e2) #((top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))
                                       (cons e12547 e22546)))))
                               tmp2545)
-                            (syntax-error tmp2532)))
+                            (sc-syntax-error tmp2532)))
                        ($syntax-dispatch
                          tmp2532
                          '(any #(each (any any)) any . each-any)))))
@@ -8913,7 +8969,7 @@
           (if (if tmp2556
                   (apply
                     (lambda (dummy2561 tid2560 id2559 e12558 e22557)
-                      (andmap identifier? (cons tid2560 id2559)))
+                      (sc-andmap sc-identifier? (cons tid2560 id2559)))
                     tmp2556)
                   '#f)
               (apply
@@ -8951,7 +9007,7 @@
                              id2565)
                         (cons e12564 e22563)))))
                 tmp2556)
-              (syntax-error tmp2555)))
+              (sc-syntax-error tmp2555)))
          ($syntax-dispatch
            tmp2555
            '(any (any . each-any) any . each-any))))
@@ -8971,7 +9027,7 @@
                       '#(syntax-object syntax ((top) #(ribcage #(dummy x) #(("m" top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))
                       x2573)))
                 tmp2572)
-              (syntax-error tmp2571)))
+              (sc-syntax-error tmp2571)))
          ($syntax-dispatch tmp2571 '(any any))))
       x2570))
   '*top*)
@@ -9010,7 +9066,7 @@
                                                     template2599)))
                                               tmp2598)
                                             ((lambda (_2603)
-                                               (syntax-error x2575))
+                                               (sc-syntax-error x2575))
                                               tmp2593)))
                                        ($syntax-dispatch
                                          tmp2593
@@ -9024,7 +9080,7 @@
             (if (if tmp2578
                     (apply
                       (lambda (_2581 k2580 cl2579)
-                        (andmap identifier? k2580))
+                        (sc-andmap sc-identifier? k2580))
                       tmp2578)
                     '#f)
                 (apply
@@ -9043,11 +9099,11 @@
                                         '#(syntax-object x ((top) #(ribcage #(cl) #((top)) #("i")) #(ribcage #(_ k cl) #((top) (top) (top)) #("i" "i" "i")) #(ribcage (clause) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))
                                         (cons k2584 cl2589)))))
                                 tmp2588)
-                              (syntax-error tmp2586)))
+                              (sc-syntax-error tmp2586)))
                          ($syntax-dispatch tmp2586 'each-any)))
                       (map clause2576 cl2583)))
                   tmp2578)
-                (syntax-error tmp2577)))
+                (sc-syntax-error tmp2577)))
            ($syntax-dispatch tmp2577 '(any each-any . each-any))))
         x2575)))
   '*top*)
@@ -9082,7 +9138,7 @@
                                       '#(syntax-object or ((top) #(ribcage #(_ e1 e2 e3) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))
                                       (cons e22613 e32612)))))
                               tmp2611)
-                            (syntax-error tmp2605)))
+                            (sc-syntax-error tmp2605)))
                        ($syntax-dispatch
                          tmp2605
                          '(any any any . each-any)))))
@@ -9117,7 +9173,7 @@
                               (lambda (_2629)
                                 '#(syntax-object #t ((top) #(ribcage #(_) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))
                               tmp2628)
-                            (syntax-error tmp2618)))
+                            (sc-syntax-error tmp2618)))
                        ($syntax-dispatch tmp2618 '(any)))))
                 ($syntax-dispatch tmp2618 '(any any)))))
          ($syntax-dispatch tmp2618 '(any any any . each-any))))
@@ -9131,7 +9187,7 @@
           (if (if tmp2632
                   (apply
                     (lambda (_2637 x2636 v2635 e12634 e22633)
-                      (andmap identifier? x2636))
+                      (sc-andmap sc-identifier? x2636))
                     tmp2632)
                   '#f)
               (apply
@@ -9146,7 +9202,7 @@
                  (if (if tmp2647
                          (apply
                            (lambda (_2653 f2652 x2651 v2650 e12649 e22648)
-                             (andmap identifier? (cons f2652 x2651)))
+                             (sc-andmap sc-identifier? (cons f2652 x2651)))
                            tmp2647)
                          '#f)
                      (apply
@@ -9163,7 +9219,7 @@
                              f2659)
                            v2657))
                        tmp2647)
-                     (syntax-error tmp2631)))
+                     (sc-syntax-error tmp2631)))
                 ($syntax-dispatch
                   tmp2631
                   '(any any #(each (any any)) any . each-any)))))
@@ -9180,7 +9236,7 @@
           (if (if tmp2666
                   (apply
                     (lambda (let*2671 x2670 v2669 e12668 e22667)
-                      (andmap identifier? x2670))
+                      (sc-andmap sc-identifier? x2670))
                     tmp2666)
                   '#f)
               (apply
@@ -9201,7 +9257,7 @@
                                                          (list binding2683)
                                                          body2684))
                                                      tmp2682)
-                                                   (syntax-error tmp2681)))
+                                                   (sc-syntax-error tmp2681)))
                                               ($syntax-dispatch
                                                 tmp2681
                                                 '(any any))))
@@ -9211,7 +9267,7 @@
                      f2678)
                     (map list x2676 v2675)))
                 tmp2666)
-              (syntax-error tmp2665)))
+              (sc-syntax-error tmp2665)))
          ($syntax-dispatch
            tmp2665
            '(any #(each (any any)) any . each-any))))
@@ -9286,7 +9342,7 @@
                                                                                   e22707))))
                                                                           tmp2706)
                                                                         ((lambda (_2711)
-                                                                           (syntax-error
+                                                                           (sc-syntax-error
                                                                              x2687))
                                                                           tmp2696)))
                                                                    ($syntax-dispatch
@@ -9365,7 +9421,7 @@
                                                                              rest2713))
                                                                          tmp2720)
                                                                        ((lambda (_2725)
-                                                                          (syntax-error
+                                                                          (sc-syntax-error
                                                                             x2687))
                                                                          tmp2714)))
                                                                   ($syntax-dispatch
@@ -9390,7 +9446,7 @@
                     m12691
                     m22690))
                 tmp2689)
-              (syntax-error tmp2688)))
+              (sc-syntax-error tmp2688)))
          ($syntax-dispatch tmp2688 '(any any . each-any))))
       x2687))
   '*top*)
@@ -9458,14 +9514,14 @@
                                                                  '#(syntax-object do ((top) #(ribcage #(e1 e2) #((top) (top)) #("i" "i")) #(ribcage #(step) #((top)) #("i")) #(ribcage #(_ var init step e0 e1 c) #((top) (top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(orig-x) #((top)) #("i")) #(top-ribcage *top* #t)))
                                                                  step2748)))))))
                                                    tmp2756)
-                                                 (syntax-error tmp2749)))
+                                                 (sc-syntax-error tmp2749)))
                                             ($syntax-dispatch
                                               tmp2749
                                               '(any . each-any)))))
                                      ($syntax-dispatch tmp2749 '())))
                                   e12731))
                               tmp2747)
-                            (syntax-error tmp2737)))
+                            (sc-syntax-error tmp2737)))
                        ($syntax-dispatch tmp2737 'each-any)))
                     (map (lambda (v2741 s2740)
                            ((lambda (tmp2742)
@@ -9478,7 +9534,7 @@
                                               (lambda (e2745) e2745)
                                               tmp2744)
                                             ((lambda (_2746)
-                                               (syntax-error orig-x2727))
+                                               (sc-syntax-error orig-x2727))
                                               tmp2742)))
                                        ($syntax-dispatch tmp2742 '(any)))))
                                 ($syntax-dispatch tmp2742 '())))
@@ -9486,7 +9542,7 @@
                          var2735
                          step2733)))
                 tmp2729)
-              (syntax-error tmp2728)))
+              (sc-syntax-error tmp2728)))
          ($syntax-dispatch
            tmp2728
            '(any #(each (any any . any))
@@ -9723,7 +9779,7 @@
                                                (lambda ()
                                                  '#(syntax-object ("quote" ()) ((top) #(ribcage () () ()) #(ribcage #(p lev) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t))))
                                                tmp2898)
-                                             (syntax-error tmp2884)))
+                                             (sc-syntax-error tmp2884)))
                                         ($syntax-dispatch tmp2884 '()))))
                                  ($syntax-dispatch tmp2884 '(any . any))))
                               p2883)))
@@ -9810,7 +9866,7 @@
                                                        any))))
                                                y2868))
                                            tmp2867)
-                                         (syntax-error tmp2866)))
+                                         (sc-syntax-error tmp2866)))
                                     ($syntax-dispatch tmp2866 '(any any))))
                                  (list x2865 y2864))))
               (quasiappend2767 (lambda (x2851 y2850)
@@ -9832,7 +9888,7 @@
                                                                        '#(syntax-object "append" ((top) #(ribcage #(p) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(x y) #((top) (top)) #("i" "i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))
                                                                        p2856))
                                                                    tmp2855)
-                                                                 (syntax-error
+                                                                 (sc-syntax-error
                                                                    tmp2854)))
                                                             ($syntax-dispatch
                                                               tmp2854
@@ -9855,7 +9911,7 @@
                                                                     (list
                                                                       y2861))))
                                                               tmp2860)
-                                                            (syntax-error
+                                                            (sc-syntax-error
                                                               tmp2859)))
                                                        ($syntax-dispatch
                                                          tmp2859
@@ -9963,7 +10019,7 @@
                                                                   '#(syntax-object "vector" ((top) #(ribcage #(t8) #(("m" tmp)) #("i")) #(ribcage () () ()) #(ribcage #(ls) #((top)) #("i")) #(ribcage #(_) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))
                                                                   t82844))
                                                               tmp2843)
-                                                            (syntax-error
+                                                            (sc-syntax-error
                                                               tmp2842)))
                                                        ($syntax-dispatch
                                                          tmp2842
@@ -9997,7 +10053,7 @@
                                                                '#(syntax-object list ((top) #(ribcage #(t1) #(("m" tmp)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))
                                                                t12785))
                                                            tmp2784)
-                                                         (syntax-error
+                                                         (sc-syntax-error
                                                            tmp2782)))
                                                     ($syntax-dispatch
                                                       tmp2782
@@ -10024,7 +10080,7 @@
                                                                                              t32795
                                                                                              t22794))
                                                                                          tmp2793)
-                                                                                       (syntax-error
+                                                                                       (sc-syntax-error
                                                                                          tmp2792)))
                                                                                   ($syntax-dispatch
                                                                                     tmp2792
@@ -10050,7 +10106,7 @@
                                                                              '#(syntax-object append ((top) #(ribcage #(t4) #(("m" tmp)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))
                                                                              t42802))
                                                                          tmp2801)
-                                                                       (syntax-error
+                                                                       (sc-syntax-error
                                                                          tmp2799)))
                                                                   ($syntax-dispatch
                                                                     tmp2799
@@ -10071,7 +10127,7 @@
                                                                                     '#(syntax-object vector ((top) #(ribcage #(t5) #(("m" tmp)) #("i")) #(ribcage #(x) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(x) #((top)) #("i")) #(ribcage (emit quasivector quasilist* quasiappend quasicons vquasi quasi) ((top) (top) (top) (top) (top) (top) (top)) ("i" "i" "i" "i" "i" "i" "i")) #(top-ribcage *top* #t)))
                                                                                     t52809))
                                                                                 tmp2808)
-                                                                              (syntax-error
+                                                                              (sc-syntax-error
                                                                                 tmp2806)))
                                                                          ($syntax-dispatch
                                                                            tmp2806
@@ -10098,7 +10154,7 @@
                                                                                 (lambda (x2816)
                                                                                   x2816)
                                                                                 tmp2815)
-                                                                              (syntax-error
+                                                                              (sc-syntax-error
                                                                                 tmp2777)))
                                                                          ($syntax-dispatch
                                                                            tmp2777
@@ -10141,17 +10197,17 @@
                    (apply
                      (lambda (_2775 e2774) (emit2770 (quasi2764 e2774 '0)))
                      tmp2773)
-                   (syntax-error tmp2772)))
+                   (sc-syntax-error tmp2772)))
               ($syntax-dispatch tmp2772 '(any any))))
            x2771)))))
   '*top*)
 ($sc-put-cte
   '#(syntax-object unquote ((top) #(ribcage #(unquote) #((top)) #(unquote))))
-  (lambda (x2923) (syntax-error x2923 '"misplaced"))
+  (lambda (x2923) (sc-syntax-error x2923 '"misplaced"))
   '*top*)
 ($sc-put-cte
   '#(syntax-object unquote-splicing ((top) #(ribcage #(unquote-splicing) #((top)) #(unquote-splicing))))
-  (lambda (x2924) (syntax-error x2924 '"misplaced"))
+  (lambda (x2924) (sc-syntax-error x2924 '"misplaced"))
   '*top*)
 ($sc-put-cte
   '#(syntax-object quasisyntax ((top) #(ribcage #(quasisyntax) #((top)) #(quasisyntax))))
@@ -10255,12 +10311,12 @@
                                                                             b*2975)
                                                                           t3004))
                                                                       tmp3003)
-                                                                    (syntax-error
+                                                                    (sc-syntax-error
                                                                       tmp3002)))
                                                                ($syntax-dispatch
                                                                  tmp3002
                                                                  '(any))))
-                                                            (generate-temporaries
+                                                            (sc-generate-temporaries
                                                               (list
                                                                 q3001))))
                                                         tmp2999)
@@ -10301,12 +10357,12 @@
                                                                                           tmp3016))
                                                                                        dnew3010)))
                                                                                  tmp3014)
-                                                                               (syntax-error
+                                                                               (sc-syntax-error
                                                                                  tmp3012)))
                                                                           ($syntax-dispatch
                                                                             tmp3012
                                                                             'each-any)))
-                                                                       (generate-temporaries
+                                                                       (sc-generate-temporaries
                                                                          q3009)))))
                                                                tmp3005)
                                                              ((lambda (tmp3021)
@@ -10359,7 +10415,7 @@
                                                                                                                tmp3036))
                                                                                                             dnew3026))
                                                                                                         tmp3034)
-                                                                                                      (syntax-error
+                                                                                                      (sc-syntax-error
                                                                                                         tmp3032)))
                                                                                                  ($syntax-dispatch
                                                                                                    tmp3032
@@ -10371,12 +10427,12 @@
                                                                                                        '(#(syntax-object ... ((top) #(ribcage #(t) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b* dnew) #((top) (top)) #("i" "i")) #(ribcage #(q d) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(q n b* k) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))))
                                                                                                    t3031))))
                                                                                         tmp3030)
-                                                                                      (syntax-error
+                                                                                      (sc-syntax-error
                                                                                         tmp3028)))
                                                                                  ($syntax-dispatch
                                                                                    tmp3028
                                                                                    'each-any)))
-                                                                              (generate-temporaries
+                                                                              (sc-generate-temporaries
                                                                                 q3025)))))
                                                                       tmp3021)
                                                                     ((lambda (tmp3042)
@@ -10414,7 +10470,7 @@
                                                                                                              a3052
                                                                                                              d3051))
                                                                                                          tmp3050)
-                                                                                                       (syntax-error
+                                                                                                       (sc-syntax-error
                                                                                                          tmp3049)))
                                                                                                   ($syntax-dispatch
                                                                                                     tmp3049
@@ -10462,7 +10518,7 @@
                                                                                                               (list->vector
                                                                                                                 x3063))
                                                                                                             tmp3062)
-                                                                                                          (syntax-error
+                                                                                                          (sc-syntax-error
                                                                                                             tmp3061)))
                                                                                                      ($syntax-dispatch
                                                                                                        tmp3061
@@ -10555,12 +10611,12 @@
                                                                 t2952
                                                                 xnew*2943)))
                                                           tmp2951)
-                                                        (syntax-error
+                                                        (sc-syntax-error
                                                           tmp2949)))
                                                    ($syntax-dispatch
                                                      tmp2949
                                                      'each-any)))
-                                                (generate-temporaries
+                                                (sc-generate-temporaries
                                                   q2948)))
                                             tmp2946)
                                           ((lambda (tmp2956)
@@ -10600,7 +10656,7 @@
                                                                                        m2966)
                                                                                      xnew*2943))
                                                                                  tmp2965)
-                                                                               (syntax-error
+                                                                               (sc-syntax-error
                                                                                  tmp2963)))
                                                                           ($syntax-dispatch
                                                                             tmp2963
@@ -10612,12 +10668,12 @@
                                                                                 '(#(syntax-object ... ((top) #(ribcage #(t) #((top)) #("i")) #(ribcage #(q) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(b* xnew*) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(x* n b* k) #((top) (top) (top) (top)) #("i" "i" "i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t))))))
                                                                             t2962))))
                                                                  tmp2961)
-                                                               (syntax-error
+                                                               (sc-syntax-error
                                                                  tmp2959)))
                                                           ($syntax-dispatch
                                                             tmp2959
                                                             'each-any)))
-                                                       (generate-temporaries
+                                                       (sc-generate-temporaries
                                                          q2958)))
                                                    tmp2956)
                                                  ((lambda (_2971)
@@ -10672,23 +10728,23 @@
                                               '#(syntax-object syntax ((top) #(ribcage #(b x) #((top) (top)) #("i" "i")) #(ribcage () () ()) #(ribcage #(b* xnew) #((top) (top)) #("i" "i")) #(ribcage #(_ x) #((top) (top)) #("i" "i")) #(ribcage (vqs qs) ((top) (top)) ("i" "i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))
                                               x2936)))
                                         tmp2935)
-                                      (syntax-error tmp2934)))
+                                      (sc-syntax-error tmp2934)))
                                  ($syntax-dispatch
                                    tmp2934
                                    '(each-any any))))
                               (list b*2933 xnew2932))))))
                   tmp2929)
-                (syntax-error tmp2928)))
+                (sc-syntax-error tmp2928)))
            ($syntax-dispatch tmp2928 '(any any))))
         x2925)))
   '*top*)
 ($sc-put-cte
   '#(syntax-object unsyntax ((top) #(ribcage #(unsyntax) #((top)) #(unsyntax))))
-  (lambda (x3067) (syntax-error x3067 '"misplaced"))
+  (lambda (x3067) (sc-syntax-error x3067 '"misplaced"))
   '*top*)
 ($sc-put-cte
   '#(syntax-object unsyntax-splicing ((top) #(ribcage #(unsyntax-splicing) #((top)) #(unsyntax-splicing))))
-  (lambda (x3068) (syntax-error x3068 '"misplaced"))
+  (lambda (x3068) (sc-syntax-error x3068 '"misplaced"))
   '*top*)
 ($sc-put-cte
   '#(syntax-object include ((top) #(ribcage #(include) #((top)) #(include))))
@@ -10726,12 +10782,12 @@
                                        '#(syntax-object begin ((top) #(ribcage #(exp) #((top)) #("i")) #(ribcage () () ()) #(ribcage #(fn) #((top)) #("i")) #(ribcage #(k filename) #((top) (top)) #("i" "i")) #(ribcage (read-file) ((top)) ("i")) #(ribcage #(x) #((top)) #("i")) #(top-ribcage *top* #t)))
                                        exp3078))
                                    tmp3077)
-                                 (syntax-error tmp3076)))
+                                 (sc-syntax-error tmp3076)))
                             ($syntax-dispatch tmp3076 'each-any)))
                          (read-file3070 fn3075 k3074)))
                       (syntax-object->datum filename3073)))
                   tmp3072)
-                (syntax-error tmp3071)))
+                (sc-syntax-error tmp3071)))
            ($syntax-dispatch tmp3071 '(any any))))
         x3069)))
   '*top*)
@@ -10788,7 +10844,7 @@
                                                                       e23102))))
                                                               tmp3101)
                                                             ((lambda (_3107)
-                                                               (syntax-error
+                                                               (sc-syntax-error
                                                                  x3085))
                                                               tmp3096)))
                                                        ($syntax-dispatch
@@ -10830,7 +10886,7 @@
                                                                  rest3109))
                                                              tmp3111)
                                                            ((lambda (_3117)
-                                                              (syntax-error
+                                                              (sc-syntax-error
                                                                 x3085))
                                                              tmp3110)))
                                                       ($syntax-dispatch
@@ -10848,7 +10904,7 @@
                       m13089
                       m23088)))
                 tmp3087)
-              (syntax-error tmp3086)))
+              (sc-syntax-error tmp3086)))
          ($syntax-dispatch tmp3086 '(any any any . each-any))))
       x3085))
   '*top*)
@@ -10889,8 +10945,8 @@
                          (apply
                            (lambda (dummy3131 id3130 exp13129 var3128
                                     val3127 exp23126)
-                             (if (identifier? id3130)
-                                 (identifier? var3128)
+                             (if (sc-identifier? id3130)
+                                 (sc-identifier? var3128)
                                  '#f))
                            tmp3125)
                          '#f)
@@ -10937,7 +10993,7 @@
                                    '#(syntax-object syntax ((top) #(ribcage #(dummy id exp1 var val exp2) #(("m" top) (top) (top) (top) (top) (top)) #("i" "i" "i" "i" "i" "i")) #(ribcage () () ()) #(ribcage #(x) #(("m" top)) #("i")) #(top-ribcage *top* #t)))
                                    exp13135))))))
                        tmp3125)
-                     (syntax-error tmp3121)))
+                     (sc-syntax-error tmp3121)))
                 ($syntax-dispatch
                   tmp3121
                   '(any (any any)
@@ -10950,34 +11006,6 @@
       x3120))
   '*top*)
 
-(define env (scheme-report-environment 5))
-
-(define (sc-eval e)
-  (eval (cadr e) env))
-
-(eval `(define syntax-object->datum ,syntax-object->datum) env)
-(eval `(define datum->syntax-object ,datum->syntax-object) env)
-(eval `(define syntax->list ,syntax->list) env)
-(eval `(define syntax->vector ,syntax->vector) env)
-(eval `(define identifier? ,identifier?) env)
-(eval `(define free-identifier=? ,free-identifier=?) env)
-(eval `(define bound-identifier=? ,bound-identifier=?) env)
-(eval `(define literal-identifier=? ,literal-identifier=?) env)
-(eval `(define generate-temporaries ,generate-temporaries) env)
-(eval `(define environment? ,environment?) env)
-(eval `(define syntax-error ,syntax-error) env)
-(eval `(define $sc-put-cte ,$sc-put-cte) env)
-(eval `(define $syntax-dispatch ,$syntax-dispatch) env)
-(eval `(define $make-environment ,$make-environment) env)
-(eval `(define sc-expand ,sc-expand) env)
-(eval `(define andmap ,andmap) env)
-(eval `(define ormap ,ormap) env)
-(eval `(define gensym ,gensym) env)
-(eval `(define gensym? ,gensym?) env)
-
-(eval `(define eval ,sc-eval) env)
-(eval `(define interaction-environment ,sc-interaction-environment) env)
-
 (time
  (with-input-from-file "psyntax-input.txt"
    (lambda ()
diff --git a/collects/tests/mzscheme/benchmarks/common/psyntax.ss b/collects/tests/mzscheme/benchmarks/common/psyntax.ss
index 2e6d5b82c2..e5d40e6426 100644
--- a/collects/tests/mzscheme/benchmarks/common/psyntax.ss
+++ b/collects/tests/mzscheme/benchmarks/common/psyntax.ss
@@ -1,6 +1,6 @@
 #lang r5rs
 (#%require scheme/include
-           (only scheme/base time current-directory)
+           (only scheme/base time current-directory error)
 	   (only mzlib/etc this-expression-source-directory))
 (current-directory (this-expression-source-directory))
 (include "psyntax.sch")
diff --git a/collects/tests/mzscheme/benchmarks/common/puzzle.sch b/collects/tests/mzscheme/benchmarks/common/puzzle.sch
index 9120df4e17..47cbc60208 100644
--- a/collects/tests/mzscheme/benchmarks/common/puzzle.sch
+++ b/collects/tests/mzscheme/benchmarks/common/puzzle.sch
@@ -30,8 +30,9 @@
 (define *piecemax* (make-vector (+ typemax 1) 0))
 (define *puzzle* (make-vector (+ size 1)))
 (define *p* (make-vector (+ typemax 1)))
-(for-each (lambda (i) (vector-set! *p* i (make-vector (+ size 1))))
-          (iota (+ typemax 1)))
+(define nothing
+  (for-each (lambda (i) (vector-set! *p* i (make-vector (+ size 1))))
+            (iota (+ typemax 1))))
 
 (define (fit i j)
   (let ((end (vector-ref *piecemax* i)))
diff --git a/collects/tests/mzscheme/benchmarks/common/scheme.sch b/collects/tests/mzscheme/benchmarks/common/scheme.sch
index 9761ad7df7..ac891d530d 100644
--- a/collects/tests/mzscheme/benchmarks/common/scheme.sch
+++ b/collects/tests/mzscheme/benchmarks/common/scheme.sch
@@ -856,6 +856,8 @@
     (scheme-global-var name)
     value))
 
+(define nothing
+  (begin
 (def-proc 'not                            (lambda (x) (not x)))
 (def-proc 'boolean?                       boolean?)
 (def-proc 'eqv?                           eqv?)
@@ -1032,7 +1034,7 @@
 (def-proc 'write                          write)
 (def-proc 'display                        display)
 (def-proc 'newline                        newline)
-(def-proc 'write-char                     write-char)
+(def-proc 'write-char                     write-char)))
 
 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
diff --git a/collects/tests/mzscheme/benchmarks/common/scheme2.sch b/collects/tests/mzscheme/benchmarks/common/scheme2.sch
index 9a307fbb85..934b5783ec 100644
--- a/collects/tests/mzscheme/benchmarks/common/scheme2.sch
+++ b/collects/tests/mzscheme/benchmarks/common/scheme2.sch
@@ -862,6 +862,8 @@
     (scheme-global-var name)
     value))
 
+(define nothing
+  (begin
 (def-proc 'not                            (lambda (x) (not x)))
 (def-proc 'boolean?                       boolean?)
 (def-proc 'eqv?                           eqv?)
@@ -1038,7 +1040,7 @@
 (def-proc 'write                          write)
 (def-proc 'display                        display)
 (def-proc 'newline                        newline)
-(def-proc 'write-char                     write-char)
+(def-proc 'write-char                     write-char)))
 
 ; - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - - -
 
diff --git a/collects/tests/mzscheme/benchmarks/common/tabulate.ss b/collects/tests/mzscheme/benchmarks/common/tabulate.ss
index 0b2d41d103..4675cf0c59 100755
--- a/collects/tests/mzscheme/benchmarks/common/tabulate.ss
+++ b/collects/tests/mzscheme/benchmarks/common/tabulate.ss
@@ -3,28 +3,46 @@
 exec mzscheme -qu "$0" ${1+"$@"}
 |#
 
+;; Input format is a sequence of S-expression forms:
+;;  (<impl> <benchmark> (<cpu-msec> <real-msec> <gc-cpu-msec>) <compile-msec>)
+;; where
+;;   * <impl> is a symbol for an implementation; it can optionally be of the form 
+;;     <sys>@<mode>, where each <sys> is tried in each <mode>
+;;   * <benchmark> is a symbol for the benchmark
+;;   * <cpu-msec> and <real-msec> are the run times (CPU and real) in milliseconds
+;;   * <gc-cpu-msec> can be #f, or it can be a portion of <cpu-msec> spent GCing
+;;   * <compile-msec> should be the same for each entry of a particular <impl>
+;;     and <benchmark> combination; it is the time to compile the benchmark
+
 (module tabulate mzscheme
   (require mzlib/list
            xml/xml
-           mzlib/cmdline)
+           mzlib/cmdline
+           (only scheme/list argmin))
 
   (define base-link-filename (make-parameter #f))
   (define full-page-mode (make-parameter #f))
   (define include-links (make-parameter #f))
   (define nongc (make-parameter #f))
+  (define subtract-nothing (make-parameter #f))
+  (define generate-graph (make-parameter #f))
 
   (command-line
    "tabulate"
    (current-command-line-arguments)
    (once-each
-    [("--no-links") "suppress benchmark links to SVN"
-     (include-links #f)]
+    [("--graph") "generate graphs instead of tables (unless --multi)"
+     (generate-graph #t)]
+    [("--links") "benchmark links to SVN"
+     (include-links #t)]
     [("--multi") name "generate multiple pages for different views of data"
      (base-link-filename name)]
     [("--nongc") "show times not including GC"
      (nongc #t)]
     [("--index") "generate full page with an index.html link"
-     (full-page-mode #t)]))
+     (full-page-mode #t)]
+    [("--nothing") "subtract compilation time of nothing benchmark"
+     (subtract-nothing #t)]))
   
   (define bm-table (make-hash-table))
   (define impls (make-hash-table))
@@ -54,21 +72,55 @@ exec mzscheme -qu "$0" ${1+"$@"}
   
   (define average-runs
     (map (lambda (bm-run)
-           (cons
-            (car bm-run)
-            (map (lambda (runs)
-                   (list (car runs)
-                         (list (average caar (cdr runs))
-                               (average cadar (cdr runs))
-                               (average caddar (cdr runs)))
-                         (cadadr runs)))
-                 (hash-table-map (cdr bm-run) cons))))
-         bm-runs))
+           (let* ([runss (hash-table-map (cdr bm-run) cons)])
+             (cons
+              (car bm-run)
+              (map (lambda (runs)
+                     (list (car runs)
+                           (list (average caar (cdr runs))
+                                 (average cadar (cdr runs))
+                                 (average caddar (cdr runs)))
+                           (let ([nothing-compile-time
+                                  (if (subtract-nothing)
+                                      (let ([a (hash-table-get
+                                                (hash-table-get bm-table 'nothing #hash())
+                                                (car runs)
+                                                #f)])
+                                        (if a
+                                            (cadadr a)
+                                            0))
+                                      0)])
+                             (max (- (or (cadadr runs) 0)
+                                     nothing-compile-time)
+                                  0))))
+                   runss))))
+         (if (subtract-nothing)
+             (filter (lambda (v)
+                       (not (eq? (car v) 'nothing)))
+                     bm-runs)
+             bm-runs)))
 
   (define (symbol<? a b)
     (string<? (symbol->string a)
               (symbol->string b)))
 
+  (define (mode<? a b)
+    (let ([am (extract-column a 'mode)]
+          [bm (extract-column b 'mode)])
+      (if (equal? am bm)
+          (symbol<? a b)
+          (string<? am bm))))
+
+  (define (extract-column impl grouping)
+    (let ([s (symbol->string impl)])
+      (cond
+       [(regexp-match #rx"^(.*)@(.*)" s)
+        => (lambda (m)
+             (if (eq? grouping 'impl)
+                 (cadr m)
+                 (caddr m)))]
+       [else s])))
+
   (define sorted-runs 
     (sort average-runs (lambda (a b)
                          (symbol<? (car a) (car b)))))
@@ -76,6 +128,15 @@ exec mzscheme -qu "$0" ${1+"$@"}
   (define sorted-impls
     (sort (hash-table-map impls (lambda (k v) k)) symbol<?))
 
+  (define mode-sorted-impls
+    (sort (hash-table-map impls (lambda (k v) k))
+          mode<?))
+
+  (define (opposite grouping)
+    (if (eq? grouping 'mode)
+        'impl
+        'mode))
+
   (define (ratio->string r)
     (if (integer? r)
         (number->string r)
@@ -87,147 +148,329 @@ exec mzscheme -qu "$0" ${1+"$@"}
             (size "-2"))
            ,s))
 
-  (define (lookup-color impl)
-    (let loop ([impls sorted-impls][odd? #f])
-      (if (eq? (car impls) impl)
-          (if odd?
-              "#EEEEFF"
-              "#DDFFDD")
-          (loop (cdr impls) (not odd?)))))
-
-  (define (wrap-page relative-to p)
+  (define (wrap-page relative-to . ps)
     (if (full-page-mode)
-        (let ([title (format "~a normalized to ~a"
+        (let ([title (format "~a normalized to ~a~a"
                              (or (base-link-filename)
                                  "results")
+                             (if (string? relative-to)
+                                 "fastest "
+                                 "")
                              (or relative-to
                                  "fastest"))])
           `(html
             (head (title ,title)
                   (body
-                   (h1 ,title) 
-                   (p "See also " (a ((href "index.html"))
-                                     "about the benchmarks")
-                      ".")
-                   (p ,p)))))
-        p))
+                   (p 
+                    (b ,title ".") 
+                    " See also " (a ((href "index.html"))
+                                   "about the benchmarks")
+                    ".")
+                   ,@(map (lambda (p) `(p ,p))
+                          ps)))))
+        `(html (nbody ,@ps))))
 
   (define forever 1000000000)
 
   (define (ntime v)
-    (and (caadr v) (- (caadr v) (caddr (cadr v)))))
+    (and (caadr v) (- (caadr v) (or (caddr (cadr v)) 0))))
 
-  (define (generate-page relative-to)
+  (define (grouping->suffix grouping)
+    (if (eq? grouping 'impl)
+        ""
+        (format "-~a" grouping)))
+
+  (define no-modes? (equal? mode-sorted-impls sorted-impls))
+
+  (define (fixup-filename s)
+    (regexp-replace* #rx"[^.a-zA-Z0-9-]" s (lambda (s)
+                                             (format "_~x" (char->integer (string-ref s 0))))))
+
+  (define (output-name impl grouping graph?)
+    (fixup-filename
+     (if impl
+         (format "~a-~a~a.html" 
+                 (base-link-filename)
+                 impl
+                 (grouping->suffix grouping))
+         (format "~a~a~a.html"
+                 (base-link-filename)
+                 (grouping->suffix grouping)
+                 (if graph? "-plot" "")))))
+
+  (define (resolve-relative-to relative-to grouping runs)
+    (if (string? relative-to)
+        ;; Find fastest among entries matching `relative-to':
+        (car (argmin (lambda (run)
+                       (or (caadr run) forever))
+                     (cons (list #f (list #f #f #f) #f)
+                           (filter (lambda (run)
+                                     (equal? relative-to (extract-column (car run) grouping)))
+                                   runs))))
+        ;; Nothing to resolve:
+        relative-to))
+
+  (define (extract-variants grouping impls)
+    (let ([ht (make-hash-table 'equal)])
+      (for-each (lambda (impl)
+                  (hash-table-put! ht (extract-column impl grouping) #t))
+                impls)
+      (hash-table-map ht (lambda (k v) k))))
+
+  (define just-impls (sort (extract-variants 'impl sorted-impls) string<?))
+  (define all-colors (list "#EEEEDD" "#EEEEFF" "#EEDDEE" "#FFEEEE"
+                           "#EEEEEE" "#DDEEEE"))
+
+  (define (lookup-color impl)
+    (let ([s (extract-column impl 'impl)])
+      (let loop ([impls just-impls]
+                 [colors all-colors])
+        (cond
+         [(null? colors) (loop impls all-colors)]
+         [(null? impls) (car colors)]
+         [(equal? (car impls) s) (car colors)]
+         [else (loop (cdr impls) (cdr colors))]))))
+
+  (define (darken c)
+    (regexp-replace*
+     #rx"F" 
+     (regexp-replace* 
+      #rx"E" 
+      (regexp-replace* 
+       #rx"D"
+       c
+       "A")
+      "B")
+     "F"))
+
+  (define (call-with-bm-info bm-run relative-to grouping proc)
+    (let ([fastest (apply min (map (lambda (run)
+                                     (or (caadr run) forever))
+                                   (cdr bm-run)))]
+          [n-fastest (apply min (map (lambda (run)
+                                       (or (ntime run) forever))
+                                     (cdr bm-run)))]
+          [c-fastest (apply min (map (lambda (run)
+                                       (let ([v (caddr run)])
+                                         (or (and v (positive? v) v)
+                                             forever)))
+                                     (cdr bm-run)))]
+          [relative-to (resolve-relative-to relative-to grouping (cdr bm-run))])
+      (let-values ([(base n-base c-base)
+                    (if relative-to
+                        (let ([a (assq relative-to (cdr bm-run))])
+                          (if a
+                              (values (caadr a) (ntime a) (caddr a))
+                              (values #f #f #f)))
+                        (values fastest n-fastest c-fastest))])
+        (proc fastest n-fastest c-fastest relative-to
+              base n-base c-base))))
+
+  (define (generate-page relative-to grouping graph? has-other?)
     (empty-tag-shorthand html-empty-tags)
     (write-xml/content 
      (xexpr->xml
       (wrap-page
        relative-to
-       `(table
-         (tr (td nbsp) 
-             (td ((colspan "2") (align "right")) 
-                 ,(if (and (base-link-filename)
-                           relative-to)
-                      `(a ((href ,(format "~a.html" (base-link-filename))))
-                          "fastest")
-                      "fastest"))
-             ,@(map (lambda (impl)
-                      `(td ((colspan "2") (align "right")) 
-                           (b ,(let ([s (symbol->string impl)])
-                                 (if (and (base-link-filename)
-                                          (not (eq? impl relative-to)))
-                                     `(a ((href ,(format "~a-~a.html"
-                                                         (base-link-filename)
-                                                         impl)))
-                                         ,s)
-                                     s)))
-                           nbsp))
-                    sorted-impls))
-         ,@(map (lambda (bm-run)
-                  (let ([fastest (apply min (map (lambda (run)
-                                                   (or (caadr run) forever))
-                                                 (cdr bm-run)))]
-                        [n-fastest (apply min (map (lambda (run)
-                                                     (or (ntime run) forever))
-                                                   (cdr bm-run)))]
-                        [c-fastest (apply min (map (lambda (run)
-                                                     (let ([v (caddr run)])
-                                                       (or (and v (positive? v) v)
-                                                           forever)))
-                                                   (cdr bm-run)))])
-                    (let-values ([(base n-base c-base)
-                                  (if relative-to
-                                      (let ([a (assq relative-to (cdr bm-run))])
-                                        (if a
-                                            (values (caadr a) (ntime a) (caddr a))
-                                            (values #f #f #f)))
-                                      (values fastest n-fastest c-fastest))])
-                      `(tr (td ,(if (include-links)
-				    `(a ((href ,(format (string-append "http://svn.plt-scheme.org/plt/trunk/collects/"
-								       "tests/mzscheme/benchmarks/common/~a.sch")
-							(car bm-run))))
-					,(symbol->string (car bm-run)))
-				    (symbol->string (car bm-run))))
-                           (td ((align "right"))
-                               nbsp
-                               ,(small (if (= c-fastest forever)
-                                           " "
-                                           (number->string c-fastest)))
-                               nbsp)
-                           (td ((align "right"))
-                               ,(format "~a ms" fastest)
-                               nbsp nbsp)
-                           ,@(apply
-                              append
-                              (map (lambda (impl)
-                                     (let* ([a (assq impl (cdr bm-run))]
-                                            [n (and a (caadr a))]
-                                            [n2 (and a (ntime a))])
-                                       `(,(if (= c-fastest forever)
-					      `(td)
-					      `(td ((align "right")
-						    (bgcolor ,(lookup-color impl)))
-						   ,(if (and (caddr a) c-base (positive? c-base))
-							(small (ratio->string (/ (caddr a) c-base)))
-							'"-")
-						   nbsp))
-                                         (td ((bgcolor ,(lookup-color impl)))
-                                             ,(if (and n base)
-                                                  (let ([s (if (= n base)
-                                                               "1"
-                                                               (if (zero? base)
-                                                                   "*"
-                                                                   (ratio->string (/ n base))))])
-                                                    (if (= n fastest)
-                                                        `(font ((color "forestgreen")) (b ,s))
-                                                        s))
-                                                  "-")
-                                             ,@(if (nongc)
-                                                   `(" / " 
-                                                     ,(if (and n2 n-base)
-                                                          (let ([s (if (zero? base)
+       (if (not graph?)
+           `(table
+             ,@(if no-modes?
+                   null
+                   (list
+                    `(tr 
+                      (td (i ,(if (eq? grouping 'mode)
+                                  "mode"
+                                  "impl")))
+                      (td nbsp)
+                      (td nbsp)
+                      ,@(let loop ([impls (if (eq? grouping 'mode)
+                                              mode-sorted-impls
+                                              sorted-impls)])
+                          (if (null? impls)
+                              null
+                              (let* ([impl (car impls)]
+                                     [s (extract-column impl grouping)]
+                                     [count (let loop ([impls (cdr impls)])
+                                              (cond
+                                               [(null? impls) 0]
+                                               [(not (equal? s (extract-column (car impls) grouping)))
+                                                0]
+                                               [else (add1 (loop (cdr impls)))]))])
+                                (cons
+                                 `(td ((colspan ,(number->string (* 2 (+ 1 count))))
+                                       (align "center")
+                                       (bgcolor "#DDDDFF"))
+                                      (b ,(if (equal? s relative-to)
+                                              s
+                                              `(a ([href ,(fixup-filename
+                                                           (format "~a-~a~a.html"
+                                                                   (base-link-filename)
+                                                                   s
+                                                                   (grouping->suffix grouping)))]) 
+                                                  ,s))))
+                                 (loop (list-tail impls (+ 1 count))))))))))
+             (tr (td ,(if no-modes?
+                          'nbsp
+                          `(i (a ([href ,(output-name #f (opposite grouping) #f)])
+                                 ,(if (eq? grouping 'mode)
+                                      "impl"
+                                      "mode")))))
+                 (td ((colspan "2") (align "right")) 
+                     ,(if (and (base-link-filename)
+                               relative-to)
+                          `(a ((href ,(fixup-filename
+                                       (format "~a~a.html" 
+                                               (base-link-filename)
+                                               (grouping->suffix grouping)))))
+                              "fastest")
+                          "fastest"))
+                 ,@(map (lambda (impl)
+                          `(td ((colspan "2") (align "right")) 
+                               (b ,(let ([s (extract-column impl (opposite grouping))])
+                                     (if (and (base-link-filename)
+                                              (not (eq? impl relative-to)))
+                                         `(a ((href ,(fixup-filename
+                                                      (format "~a-~a~a.html"
+                                                              (base-link-filename)
+                                                              impl
+                                                              (grouping->suffix grouping)))))
+                                             ,s)
+                                         s)))
+                               nbsp))
+                        (if (eq? grouping 'mode)
+                            mode-sorted-impls
+                            sorted-impls))
+                 ,@(if has-other?
+                       `((td nbsp nbsp (a ((href ,(output-name #f 'impl #t))) "To plots")))
+                       null))
+             ,@(map (lambda (bm-run)
+                      (define orig-relative-to relative-to)
+                      (call-with-bm-info
+                       bm-run
+                       relative-to
+                       grouping
+                       (lambda (fastest n-fastest c-fastest relative-to
+                                        base n-base c-base)
+                         `(tr (td ,(if (include-links)
+                                       `(a ((href ,(format (string-append "http://svn.plt-scheme.org/plt/trunk/collects/"
+                                                                          "tests/mzscheme/benchmarks/common/~a.sch")
+                                                           (car bm-run))))
+                                           ,(symbol->string (car bm-run)))
+                                       (symbol->string (car bm-run))))
+                              (td ((align "right"))
+                                  nbsp
+                                  ,(small (if (= c-fastest forever)
+                                              " "
+                                              (number->string c-fastest)))
+                                  nbsp)
+                              (td ((align "right"))
+                                  ,(format "~a ms" fastest)
+                                  nbsp nbsp)
+                              ,@(apply
+                                 append
+                                 (map (lambda (impl)
+                                        (let* ([a (assq impl (cdr bm-run))]
+                                               [n (and a (caadr a))]
+                                               [n2 (and a (ntime a))])
+                                          `(,(if (= c-fastest forever)
+                                                 `(td)
+                                                 `(td ((align "right")
+                                                       (bgcolor ,(lookup-color impl)))
+                                                      ,(if (and a (caddr a) c-base (positive? c-base))
+                                                           (small (ratio->string (/ (caddr a) c-base)))
+                                                           '"-")
+                                                      nbsp))
+                                            (td ((bgcolor ,(if (and n base (= n base)
+                                                                    (or (not orig-relative-to)
+                                                                        (and (string? orig-relative-to)
+                                                                             (equal? (extract-column impl grouping)
+                                                                                     orig-relative-to))))
+                                                               "white"
+                                                               (lookup-color impl)))
+                                                 (align "right"))
+                                                ,(if (and n base)
+                                                     (let ([s (if (= n base)
+                                                                  "1"
+                                                                  (if (zero? base)
+                                                                      "*"
+                                                                      (ratio->string (/ n base))))])
+                                                       (if (= n fastest)
+                                                           `(font ((color "forestgreen")) (b ,s))
+                                                           s))
+                                                     "-")
+                                                ,@(if (nongc)
+                                                      `(" / " 
+                                                        ,(if (and n2 n-base)
+                                                             (let ([s (if (zero? base)
                                                                           "*"
                                                                           (ratio->string (/ n2 base)))])
-                                                            (if (= n2 n-fastest)
-                                                                `(font ((color "forestgreen")) (b ,s))
-                                                                s))
-                                                          "-"))
-                                                   null)
-                                             nbsp))))
-                                   sorted-impls))))))
-                sorted-runs)))))
+                                                               (if (= n2 n-fastest)
+                                                                   `(font ((color "forestgreen")) (b ,s))
+                                                                   s))
+                                                             "-"))
+                                                      null)
+                                                nbsp))))
+                                      (if (eq? grouping 'mode)
+                                          mode-sorted-impls
+                                          sorted-impls)))))))
+                    sorted-runs))
+           `(table
+             ((style "border-spacing: 0px 3px;"))
+             (tr (td ((colspan "2"))
+                     "Longer is better."
+                     ,@(if has-other?
+                           `(nbsp nbsp (a ((href ,(output-name #f 'impl #f))) "Back to tables"))
+                           null)))
+             ,@(map (lambda (bm-run)
+                      (call-with-bm-info
+                       bm-run
+                       relative-to
+                       grouping
+                       (lambda (fastest n-fastest c-fastest relative-to
+                                        base n-base c-base)
+                         `(tr ((style "background-color: #eeeeee"))
+                              (td ((valign "top")) ,(symbol->string (car bm-run)))
+                              (td
+                               (table
+                                ((style "border-spacing: 0px;"))
+                                ,@(map (lambda (impl)
+                                         (let* ([a (assq impl (cdr bm-run))]
+                                                [n (and a (caadr a))]
+                                                [n2 (and a (ntime a))])
+                                           `(tr (td (span ((style "font-size: small;")) 
+                                                          ,(symbol->string impl))
+                                                    nbsp)
+                                                (td ((style "padding: 0em;"))
+                                                    ,(if (and n base)
+                                                         (let ([col (darken (lookup-color impl))])
+                                                           `(span ((style ,(format "background-color: ~a; color: ~a;" col col)))
+                                                                  ,(format (make-string (max (floor (* 60 (if (zero? n) 1 (/ base n))))
+                                                                                             1)
+                                                                                        #\x))))
+                                                         "")))))
+                                       sorted-impls)))))))
+                    sorted-runs))))))
     (newline))
-
+  
   (if (base-link-filename)
-      (for-each (lambda (impl)
-                  (with-output-to-file (if impl
-                                           (format "~a-~a.html" 
-                                                   (base-link-filename)
-                                                   impl)
-                                           (format "~a.html"
-                                                   (base-link-filename)))
-                    (lambda () (generate-page impl))
-                    'truncate))
-                (cons #f sorted-impls))
-      (generate-page #f)))
+      (begin
+        (for-each (lambda (grouping)
+                    (for-each 
+                     (lambda (impl)
+                       (let ([fn (output-name impl grouping #f)])
+                         (fprintf (current-error-port) "Generating ~a\n" fn)
+                         (with-output-to-file fn
+                           (lambda () (generate-page impl grouping #f #t))
+                           'truncate)))
+                     (append (cons #f sorted-impls)
+                             (if no-modes?
+                                 null
+                                 (extract-variants grouping sorted-impls)))))
+                  (if no-modes?
+                      '(impl)
+                      '(impl mode)))
+        (with-output-to-file (output-name #f 'impl #t)
+          (lambda () (generate-page #f 'impl #t #t))
+          'truncate))
+      (generate-page #f 'impl (generate-graph) #f)))
 
diff --git a/collects/tests/mzscheme/benchmarks/common/triangle.sch b/collects/tests/mzscheme/benchmarks/common/triangle.sch
index cceb17ed77..baeddd2704 100644
--- a/collects/tests/mzscheme/benchmarks/common/triangle.sch
+++ b/collects/tests/mzscheme/benchmarks/common/triangle.sch
@@ -15,38 +15,17 @@
 (define *board* (make-vector 16 1))
 (define *sequence* (make-vector 14 0))
 (define *a* (make-vector 37))
-(for-each (lambda (i x) (vector-set! *a* i x))
-          '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
-            21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36)
-          '(1 2 4 3 5 6 1 3 6 2 5 4 11 12
-            13 7 8 4 4 7 11 8 12 13 6 10
-            15 9 14 13 13 14 15 9 10
-             6 6))
 (define *b* (make-vector 37))
-(for-each (lambda (i x) (vector-set! *b* i x))
-          '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
-            21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36)
-          '(2 4 7 5 8 9 3 6 10 5 9 8
-            12 13 14 8 9 5 2 4 7 5 8
-            9 3 6 10 5 9 8 12 13 14
-            8 9 5 5))
 (define *c* (make-vector 37))
-(for-each (lambda (i x) (vector-set! *c* i x))
-          '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
-            21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36)
-          '(4 7 11 8 12 13 6 10 15 9 14 13
-            13 14 15 9 10 6 1 2 4 3 5 6 1
-            3 6 2 5 4 11 12 13 7 8 4 4))
 (define *answer* '())
 (define *final* '())
-(vector-set! *board* 5 0)
- 
+
 (define (last-position)
   (do ((i 1 (+ i 1)))
       ((or (= i 16) (= 1 (vector-ref *board* i)))
        (if (= i 16) 0 i))))
  
-(define (try i depth)
+(define (ttry i depth)
   (cond ((= depth 14)
          (let ((lp (last-position)))
            (if (not (member lp *final*))
@@ -63,7 +42,7 @@
          (vector-set! *sequence* depth i)
          (do ((j 0 (+ j 1))
               (depth (+ depth 1)))
-             ((or (= j 36) (try j depth)) #f))
+             ((or (= j 36) (ttry j depth)) #f))
          (vector-set! *board* (vector-ref *a* i) 1)
          (vector-set! *board* (vector-ref *b* i) 1)
          (vector-set! *board* (vector-ref *c* i) 0) '())
@@ -72,11 +51,33 @@
 (define (gogogo i)
   (let ((*answer* '())
         (*final* '()))
-    (try i 1)))
+    (ttry i 1)))
+ 
+(for-each (lambda (i x) (vector-set! *a* i x))
+          '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
+            21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36)
+          '(1 2 4 3 5 6 1 3 6 2 5 4 11 12
+            13 7 8 4 4 7 11 8 12 13 6 10
+            15 9 14 13 13 14 15 9 10
+             6 6))
+(for-each (lambda (i x) (vector-set! *b* i x))
+          '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
+            21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36)
+          '(2 4 7 5 8 9 3 6 10 5 9 8
+            12 13 14 8 9 5 2 4 7 5 8
+            9 3 6 10 5 9 8 12 13 14
+            8 9 5 5))
+(for-each (lambda (i x) (vector-set! *c* i x))
+          '(0 1 2 3 4 5 6 7 8 9 10 11 12 13 14 15 16 17 18 19 20
+            21 22 23 24 25 26 27 28 29 30 31 32 33 34 35 36)
+          '(4 7 11 8 12 13 6 10 15 9 14 13
+            13 14 15 9 10 6 1 2 4 3 5 6 1
+            3 6 2 5 4 11 12 13 7 8 4 4))
+(vector-set! *board* 5 0)
  
 ;;; call:  (gogogo 22))
  
-(time (let loop ((n 10000))
+(time (let loop ((n 100000))
         (if (zero? n)
             'done
             (begin
diff --git a/collects/tests/mzscheme/optimize.ss b/collects/tests/mzscheme/optimize.ss
index 7bc16202c1..4647044eb2 100644
--- a/collects/tests/mzscheme/optimize.ss
+++ b/collects/tests/mzscheme/optimize.ss
@@ -4,7 +4,8 @@
 (Section 'optimization)
 
 (require scheme/flonum
-         scheme/fixnum)
+         scheme/fixnum
+         compiler/zo-parse)
 
 ;; ;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;;
 
@@ -564,7 +565,9 @@
 	  [t2 (get-output-bytes s2)])
       (or (bytes=? t1 t2)
 	  (begin
-	    (printf "~s\n~s\n" t1 t2)
+	    (printf "~s\n~s\n" 
+                    (zo-parse (open-input-bytes t1))
+                    (zo-parse (open-input-bytes t2)))
 	    #f
 	    )))))
 
@@ -656,6 +659,17 @@
 	   '((lambda (x) x) 3))
 (test-comp '(let ([x 3][y 4]) (+ x y))
 	   '((lambda (x y) (+ x y)) 3 4))
+(test-comp '5
+	   '((lambda ignored 5) 3 4))
+(test-comp '5
+	   '(let ([f (lambda ignored 5)])
+              (f 3 4)))
+(test-comp '5
+	   '(let ([f (lambda (a . ignored) a)])
+              (f 5 3 4)))
+(test-comp '(let ([x (list 3 4)]) x)
+	   '(let ([f (lambda (a . b) b)])
+              (f 5 3 4)))
 
 (test-comp '(let ([x 1][y 2]) x)
 	   '1)
diff --git a/collects/typed-scheme/typecheck/check-subforms-unit.ss b/collects/typed-scheme/typecheck/check-subforms-unit.ss
index ea97a7f1fd..037822e2ee 100644
--- a/collects/typed-scheme/typecheck/check-subforms-unit.ss
+++ b/collects/typed-scheme/typecheck/check-subforms-unit.ss
@@ -2,6 +2,7 @@
 
 (require "../utils/utils.ss"
 	 syntax/kerncase
+	 syntax/parse
          scheme/match
          "signatures.ss" "tc-metafunctions.ss"
          (types utils convenience union subtype)
@@ -18,33 +19,40 @@
   (define body-ty #f)    
   (define (get-result-ty t)
     (match t
-      [(Function: (list (arr: _ (Values: (list (Result: rngs _ _))) #f _ '()) ...)) (apply Un rngs)]
-      [_ (tc-error "Internal error in get-result-ty: not a function type: ~n~a" t)]))
+      [(Function: 
+	(list 
+	 (arr: _ 
+	       (Values: (list (Result: rngs _ _) ...)) 
+	       _ _ (list (Keyword: _ _ #t) ...))))
+       (apply Un rngs)]
+      [_ (int-err "Internal error in get-result-ty: not a function type: ~n~a" t)]))
   (let loop ([form form])
     (parameterize ([current-orig-stx form])
-      (kernel-syntax-case* form #f (#%app)
+      (syntax-parse form
         [stx
          ;; if this needs to be checked
-         (syntax-property form 'typechecker:with-type)
+         #:when (syntax-property form 'typechecker:with-type)
          ;; the form should be already ascribed the relevant type
-         (void 
-          (tc-expr form))]
+	 (tc-expr form)]
         [stx
-         ;; this is a hander function
-         (syntax-property form 'typechecker:exn-handler)
-         (let ([t (tc-expr/t form)])
-           (unless (subtype t (-> (Un) Univ))
-             (tc-error "Exception handler must be a single-argument function, got ~n~a"))
-           (set! handler-tys (cons (get-result-ty t) handler-tys)))]
+         ;; this is a handler function
+         #:when (syntax-property form 'typechecker:exn-handler)
+         (let ([t (tc-expr form)])
+           (match t
+	     [(tc-result1: 
+	       (and t 
+		    (Function: (list (arr: (list _) _ _ _ (list (Keyword: _ _ #f) ...)) ...))))
+	      (set! handler-tys (cons (get-result-ty t) handler-tys))]
+	     [(tc-results: t)
+	      (tc-error "Exception handler must be a single-argument function, got ~n~a" t)]))]
         [stx
          ;; this is the body of the with-handlers
-         (syntax-property form 'typechecker:exn-body)
-         (let ([t (tc-expr/t form)])
-           (set! body-ty t))]
+         #:when (syntax-property form 'typechecker:exn-body)
+         (match-let ([(tc-results: ts) (tc-expr form)])
+           (set! body-ty (-values ts)))]
         [(a . b)
-         (begin
-           (loop #'a)
-           (loop #'b))]
+	 (loop #'a)
+	 (loop #'b)]
         [_ (void)])))
   (ret (apply Un body-ty handler-tys)))
 
diff --git a/collects/typed-scheme/typecheck/internal-forms.ss b/collects/typed-scheme/typecheck/internal-forms.ss
index a0ce6e9cb0..5c5b6387f1 100644
--- a/collects/typed-scheme/typecheck/internal-forms.ss
+++ b/collects/typed-scheme/typecheck/internal-forms.ss
@@ -1,16 +1,21 @@
 #lang scheme/base
 
-(require (for-syntax scheme/base))
+(require (for-syntax scheme/base)
+	 syntax/parse)
 
-(define-syntax-rule (internal-forms nms ...)
+(define-syntax-rule (internal-forms set-name nms ...)
   (begin
-    (provide nms ...)
+    (provide nms ... set-name)
+    (define-literal-set set-name (nms ...))
     (define-syntax (nms stx) (raise-syntax-error 'typecheck "Internal typechecker form used out of context" stx)) ...))
 
-(internal-forms require/typed-internal define-type-alias-internal
-                define-typed-struct-internal
-                define-typed-struct/exec-internal
-                assert-predicate-internal
-                declare-refinement-internal
-                :-internal)
+(internal-forms internal-literals
+ require/typed-internal
+ define-type-alias-internal
+ define-type-internal
+ define-typed-struct-internal
+ define-typed-struct/exec-internal
+ assert-predicate-internal
+ declare-refinement-internal
+ :-internal)
 
diff --git a/collects/typed-scheme/typecheck/tc-structs.ss b/collects/typed-scheme/typecheck/tc-structs.ss
index 99fd72e6f0..634d1dd950 100644
--- a/collects/typed-scheme/typecheck/tc-structs.ss
+++ b/collects/typed-scheme/typecheck/tc-structs.ss
@@ -90,6 +90,7 @@
                          #:mutable [setters? #f]
                          #:proc-ty [proc-ty #f]
                          #:maker [maker* #f]
+                         #:predicate [pred* #f]
                          #:constructor-return [cret #f]
                          #:poly? [poly? #f]
                          #:type-only [type-only #f])
@@ -107,6 +108,7 @@
                                #:type-wrapper type-wrapper
                                #:pred-wrapper pred-wrapper
                                #:maker (or maker* maker)
+                               #:predicate (or pred* pred)
                                #:constructor-return cret))))
 
 ;; generate names, and register the approriate types give field types and structure type
@@ -117,6 +119,7 @@
                                #:type-wrapper [type-wrapper values]
                                #:pred-wrapper [pred-wrapper values]
                                #:maker [maker* #f]
+                               #:predicate [pred* #f]
                                #:constructor-return [cret #f])
   ;; create the approriate names that define-struct will bind
   (define-values (maker pred getters setters) (struct-names nm flds setters?))
@@ -127,7 +130,7 @@
     (append 
      (list (cons (or maker* maker) 
                  (wrapper (->* external-fld-types (if cret cret name))))
-           (cons pred
+           (cons (or pred* pred)
                  (make-pred-ty (pred-wrapper name))))
      (for/list ([g (in-list getters)] [t (in-list external-fld-types/no-parent)] [i (in-naturals)])
        (let ([func (if setters? 
@@ -185,6 +188,7 @@
 ;; tc/struct : (U identifier (list identifier identifier)) Listof[identifier] Listof[syntax] -> void
 (define (tc/struct nm/par flds tys [proc-ty #f] 
                    #:maker [maker #f] #:constructor-return [cret #f] #:mutable [mutable #f]
+                   #:predicate [pred #f]
                    #:type-only [type-only #f])
   ;; get the parent info and create some types and type variables
   (define-values (nm parent-name parent name name-tvar) (parse-parent nm/par))
@@ -200,6 +204,7 @@
                    ;; procedure
                    #:proc-ty proc-ty-parsed
                    #:maker maker
+                   #:predicate pred
 		   #:constructor-return (and cret (parse-type cret))
                    #:mutable mutable
                    #:type-only type-only))
diff --git a/collects/typed-scheme/typecheck/tc-toplevel.ss b/collects/typed-scheme/typecheck/tc-toplevel.ss
index 328123f615..5d0a6532db 100644
--- a/collects/typed-scheme/typecheck/tc-toplevel.ss
+++ b/collects/typed-scheme/typecheck/tc-toplevel.ss
@@ -3,11 +3,13 @@
 
 (require (rename-in "../utils/utils.ss" [infer r:infer]))
 (require syntax/kerncase
-	 unstable/list unstable/syntax
+	 unstable/list unstable/syntax syntax/parse
          mzlib/etc
          scheme/match
          "signatures.ss"
          "tc-structs.ss"
+         ;; to appease syntax-parse
+         "internal-forms.ss"
          (rep type-rep)
          (types utils convenience)
          (private parse-type type-annotation type-contract)
@@ -29,13 +31,17 @@
   ;; first, find the mutated variables:
   (find-mutated-vars form)
   (parameterize ([current-orig-stx form])
-    (kernel-syntax-case* form #f (define-type-alias-internal define-typed-struct-internal define-type-internal 
-                                   define-typed-struct/exec-internal :-internal assert-predicate-internal
-                                   require/typed-internal values)
+    (syntax-parse form
+      #:literals (values define-type-alias-internal define-typed-struct-internal define-type-internal 
+			 define-typed-struct/exec-internal :-internal assert-predicate-internal
+			 require/typed-internal declare-refinement-internal
+			 define-values quote-syntax #%plain-app begin)
+      ;#:literal-sets (kernel-literals)
+      
       ;; forms that are handled in other ways
       [stx 
-       (or (syntax-property form 'typechecker:ignore) 
-           (syntax-property form 'typechecker:ignore-some))
+       #:when (or (syntax-property form 'typechecker:ignore) 
+                  (syntax-property form 'typechecker:ignore-some))
        (list)]
       
       ;; type aliases have already been handled by an earlier pass
@@ -72,9 +78,16 @@
        (tc/struct #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...)))]
       [(define-values () (begin (quote-syntax (define-typed-struct-internal nm ([fld : ty] ...) #:mutable)) (#%plain-app values)))
        (tc/struct #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...)) #:mutable #t)]
-      [(define-values () (begin (quote-syntax (define-typed-struct-internal nm ([fld : ty] ...) #:maker m #:constructor-return t)) 
+      [(define-values () (begin (quote-syntax (define-typed-struct-internal nm ([fld : ty] ...) 
+                                                #:maker m #:constructor-return t #:predicate p)) 
                                 (#%plain-app values)))
-       (tc/struct #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...)) #:maker #'m #:constructor-return #'t)]
+       (tc/struct #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...))
+		  #:maker #'m #:constructor-return #'t #:predicate #'p)]
+      [(define-values () (begin (quote-syntax (define-typed-struct-internal nm ([fld : ty] ...)
+						#:maker m #:constructor-return t)) 
+                                (#%plain-app values)))
+       (tc/struct #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...)) 
+		  #:maker #'m #:constructor-return #'t)]
       [(define-values () (begin (quote-syntax (define-typed-struct-internal nm ([fld : ty] ...) #:type-only))
                                 (#%plain-app values)))
        (tc/struct #'nm (syntax->list #'(fld ...)) (syntax->list #'(ty ...)) #:type-only #t)]
@@ -91,8 +104,7 @@
        (register-type #'pred (make-pred-ty (parse-type #'ty)))]
       
       ;; top-level type annotation
-      [(define-values () (begin (quote-syntax (:-internal id ty)) (#%plain-app values)))
-       (identifier? #'id)
+      [(define-values () (begin (quote-syntax (:-internal id:identifier ty)) (#%plain-app values)))
        (register-type/undefined #'id (parse-type #'ty))]
             
       
@@ -128,8 +140,7 @@
        (apply append (filter list? (map tc-toplevel/pass1 (syntax->list #'rest))))]
       
       ;; define-syntaxes just get noted
-      [(define-syntaxes (var ...) . rest)
-       (andmap identifier? (syntax->list #'(var ...)))
+      [(define-syntaxes (var:id ...) . rest)
        (map make-def-stx-binding (syntax->list #'(var ...)))]
       
       ;; otherwise, do nothing in this pass
diff --git a/collects/typed-scheme/utils/syntax-traversal.ss b/collects/typed-scheme/utils/syntax-traversal.ss
index cfdaf4178f..e56836e9a7 100644
--- a/collects/typed-scheme/utils/syntax-traversal.ss
+++ b/collects/typed-scheme/utils/syntax-traversal.ss
@@ -45,9 +45,7 @@
 ;; Look for (the outermost) syntax in `orig' that has the same
 ;; location as `lookfor' which is coming from the expanded `orig',
 ;; given in `expanded'.
-(define (look-for-in-orig orig expanded lookfor) lookfor)
-
-#|
+(define (look-for-in-orig orig expanded lookfor)
   (define src (syntax-source orig))
   ;(printf "orig : ~a~n" (unwind orig))
   ;(printf "expanded : ~a~n" expanded)
@@ -73,7 +71,4 @@
                    enclosing)
             #;(printf "chose branch two ~a~n" enclosing))))))
 
-;(trace look-for-in-orig)
-|#
-
 
diff --git a/collects/typed-scheme/utils/tc-utils.ss b/collects/typed-scheme/utils/tc-utils.ss
index 60f996ecee..69c990e80b 100644
--- a/collects/typed-scheme/utils/tc-utils.ss
+++ b/collects/typed-scheme/utils/tc-utils.ss
@@ -6,7 +6,9 @@ don't depend on any other portion of the system
 |#
 
 (provide (all-defined-out))
-(require "syntax-traversal.ss" syntax/parse (for-syntax scheme/base syntax/parse) scheme/match
+(require "syntax-traversal.ss"
+	 "utils.ss"
+	 syntax/parse (for-syntax scheme/base syntax/parse) scheme/match
          (for-syntax unstable/syntax))
 
 ;; a parameter representing the original location of the syntax being currently checked
@@ -127,11 +129,14 @@ don't depend on any other portion of the system
 (define-struct (exn:fail:tc exn:fail) ())
 
 ;; raise an internal error - typechecker bug!
-(define (int-err msg . args)  
-  (raise (make-exn:fail:tc (string-append "Internal Typechecker Error: "
-                                          (apply format msg args)
-                                          (format "\nwhile typechecking\n~a" (syntax->datum (current-orig-stx))))
-                           (current-continuation-marks))))
+(define (int-err msg . args) 
+  (parameterize ([custom-printer #t])
+    (raise (make-exn:fail:tc (string-append "Internal Typechecker Error: "
+					    (apply format msg args)
+					    (format "\nwhile typechecking\n~aoriginally\n~a"
+						    (syntax->datum (current-orig-stx))
+						    (syntax->datum (locate-stx (current-orig-stx)))))
+			     (current-continuation-marks)))))
 
 (define-syntax (nyi stx)
   (syntax-case stx ()
diff --git a/collects/web-server/lang/closure.ss b/collects/web-server/lang/closure.ss
index a2346d6550..2a030cb874 100644
--- a/collects/web-server/lang/closure.ss
+++ b/collects/web-server/lang/closure.ss
@@ -78,9 +78,12 @@
                           ; prop-vals:
                           (list (cons prop:serializable #,CLOSURE:serialize-info-id)
                                 (cons prop:procedure
-                                      (#%plain-lambda (clsr . args)
-                                                      (let-values ([#,fvars ((CLOSURE-ref clsr 0))])
-                                                        (apply #,stx args)))))
+                                      (make-keyword-procedure
+                                       (lambda (kws kw-vals clsr . rst)
+                                         (let-values ([#,fvars ((CLOSURE-ref clsr 0))])
+                                          (keyword-apply #,stx
+                                                         kws kw-vals
+                                                         rst))))))
                           
                           #f  ; inspector