diff --git a/module/ice-9/psyntax.scm b/module/ice-9/psyntax.scm
index b1c09f86c..5d3291388 100644
--- a/module/ice-9/psyntax.scm
+++ b/module/ice-9/psyntax.scm
@@ -239,393 +239,393 @@
                         args))))))
     (syntax-case x ()
       ((_ (name id1 ...))
-       (and-map identifier? (syntax (name id1 ...)))
+       (and-map identifier? #'(name id1 ...))
        (with-syntax
-         ((constructor (construct-name (syntax name) "make-" (syntax name)))
-          (predicate (construct-name (syntax name) (syntax name) "?"))
-          ((access ...)
-           (map (lambda (x) (construct-name x (syntax name) "-" x))
-                (syntax (id1 ...))))
-          ((assign ...)
-           (map (lambda (x)
-                  (construct-name x "set-" (syntax name) "-" x "!"))
-                (syntax (id1 ...))))
-          (structure-length
-           (+ (length (syntax (id1 ...))) 1))
-          ((index ...)
-           (let f ((i 1) (ids (syntax (id1 ...))))
-              (if (null? ids)
-                  '()
-                  (cons i (f (+ i 1) (cdr ids)))))))
-         (syntax (begin
-                   (define constructor
-                     (lambda (id1 ...)
-                       (vector 'name id1 ... )))
-                   (define predicate
-                     (lambda (x)
-                       (and (vector? x)
-                            (= (vector-length x) structure-length)
-                            (eq? (vector-ref x 0) 'name))))
-                   (define access
-                     (lambda (x)
-                       (vector-ref x index)))
-                   ...
-                   (define assign
-                     (lambda (x update)
-                       (vector-set! x index update)))
-                   ...)))))))
+           ((constructor (construct-name #'name "make-" #'name))
+            (predicate (construct-name #'name #'name "?"))
+            ((access ...)
+             (map (lambda (x) (construct-name x #'name "-" x))
+                  #'(id1 ...)))
+            ((assign ...)
+             (map (lambda (x)
+                    (construct-name x "set-" #'name "-" x "!"))
+                  #'(id1 ...)))
+            (structure-length
+             (+ (length #'(id1 ...)) 1))
+            ((index ...)
+             (let f ((i 1) (ids #'(id1 ...)))
+               (if (null? ids)
+                   '()
+                   (cons i (f (+ i 1) (cdr ids)))))))
+         #'(begin
+             (define constructor
+               (lambda (id1 ...)
+                 (vector 'name id1 ... )))
+             (define predicate
+               (lambda (x)
+                 (and (vector? x)
+                      (= (vector-length x) structure-length)
+                      (eq? (vector-ref x 0) 'name))))
+             (define access
+               (lambda (x)
+                 (vector-ref x index)))
+             ...
+             (define assign
+               (lambda (x update)
+                 (vector-set! x index update)))
+             ...))))))
 
 (let ()
-(define noexpand "noexpand")
-(define *mode* (make-fluid))
+  (define noexpand "noexpand")
+  (define *mode* (make-fluid))
 
 ;;; hooks to nonportable run-time helpers
-(begin
-(define fx+ +)
-(define fx- -)
-(define fx= =)
-(define fx< <)
+  (begin
+    (define fx+ +)
+    (define fx- -)
+    (define fx= =)
+    (define fx< <)
 
-(define top-level-eval-hook
-  (lambda (x mod)
-    (primitive-eval
-     `(,noexpand
-       ,(case (fluid-ref *mode*)
-          ((c) ((@ (language tree-il) tree-il->scheme) x))
-          (else x))))))
+    (define top-level-eval-hook
+      (lambda (x mod)
+        (primitive-eval
+         `(,noexpand
+           ,(case (fluid-ref *mode*)
+              ((c) ((@ (language tree-il) tree-il->scheme) x))
+              (else x))))))
 
-(define local-eval-hook
-  (lambda (x mod)
-    (primitive-eval
-     `(,noexpand
-       ,(case (fluid-ref *mode*)
-          ((c) ((@ (language tree-il) tree-il->scheme) x))
-          (else x))))))
+    (define local-eval-hook
+      (lambda (x mod)
+        (primitive-eval
+         `(,noexpand
+           ,(case (fluid-ref *mode*)
+              ((c) ((@ (language tree-il) tree-il->scheme) x))
+              (else x))))))
 
-(define-syntax gensym-hook
-  (syntax-rules ()
-    ((_) (gensym))))
+    (define-syntax gensym-hook
+      (syntax-rules ()
+        ((_) (gensym))))
 
-(define put-global-definition-hook
-  (lambda (symbol type val)
-    (let ((existing (let ((v (module-variable (current-module) symbol)))
-                      (and v (variable-bound? v)
-                           (let ((val (variable-ref v)))
-                             (and (macro? val)
-                                  (not (syncase-macro-type val))
-                                  val))))))
-      (module-define! (current-module)
-                      symbol
-                      (if existing
-                          (make-extended-syncase-macro existing type val)
-                          (make-syncase-macro type val))))))
+    (define put-global-definition-hook
+      (lambda (symbol type val)
+        (let ((existing (let ((v (module-variable (current-module) symbol)))
+                          (and v (variable-bound? v)
+                               (let ((val (variable-ref v)))
+                                 (and (macro? val)
+                                      (not (syncase-macro-type val))
+                                      val))))))
+          (module-define! (current-module)
+                          symbol
+                          (if existing
+                              (make-extended-syncase-macro existing type val)
+                              (make-syncase-macro type val))))))
 
-(define get-global-definition-hook
-  (lambda (symbol module)
-    (if (and (not module) (current-module))
-        (warn "module system is booted, we should have a module" symbol))
-    (let ((v (module-variable (if module
-                                  (resolve-module (cdr module))
-                                  (current-module))
-                              symbol)))
-      (and v (variable-bound? v)
-           (let ((val (variable-ref v)))
-             (and (macro? val) (syncase-macro-type val)
-                  (cons (syncase-macro-type val)
-                        (syncase-macro-binding val))))))))
+    (define get-global-definition-hook
+      (lambda (symbol module)
+        (if (and (not module) (current-module))
+            (warn "module system is booted, we should have a module" symbol))
+        (let ((v (module-variable (if module
+                                      (resolve-module (cdr module))
+                                      (current-module))
+                                  symbol)))
+          (and v (variable-bound? v)
+               (let ((val (variable-ref v)))
+                 (and (macro? val) (syncase-macro-type val)
+                      (cons (syncase-macro-type val)
+                            (syncase-macro-binding val))))))))
 
-)
+    )
 
 
-(define (decorate-source e s)
-  (if (and (pair? e) s)
-      (set-source-properties! e s))
-  e)
+  (define (decorate-source e s)
+    (if (and (pair? e) s)
+        (set-source-properties! e s))
+    e)
 
 ;;; output constructors
-(define build-void
-  (lambda (source)
-    (case (fluid-ref *mode*)
-      ((c) ((@ (language tree-il) make-void) source))
-      (else (decorate-source '(if #f #f) source)))))
+  (define build-void
+    (lambda (source)
+      (case (fluid-ref *mode*)
+        ((c) ((@ (language tree-il) make-void) source))
+        (else (decorate-source '(if #f #f) source)))))
 
-(define build-application
-  (lambda (source fun-exp arg-exps)
-    (case (fluid-ref *mode*)
-      ((c) ((@ (language tree-il) make-application) source fun-exp arg-exps))
-      (else (decorate-source `(,fun-exp . ,arg-exps) source)))))
+  (define build-application
+    (lambda (source fun-exp arg-exps)
+      (case (fluid-ref *mode*)
+        ((c) ((@ (language tree-il) make-application) source fun-exp arg-exps))
+        (else (decorate-source `(,fun-exp . ,arg-exps) source)))))
 
-(define build-conditional
-  (lambda (source test-exp then-exp else-exp)
-    (case (fluid-ref *mode*)
-      ((c) ((@ (language tree-il) make-conditional)
-            source test-exp then-exp else-exp))
-      (else (decorate-source
-             (if (equal? else-exp '(if #f #f))
-                 `(if ,test-exp ,then-exp)
-                 `(if ,test-exp ,then-exp ,else-exp))
-             source)))))
+  (define build-conditional
+    (lambda (source test-exp then-exp else-exp)
+      (case (fluid-ref *mode*)
+        ((c) ((@ (language tree-il) make-conditional)
+              source test-exp then-exp else-exp))
+        (else (decorate-source
+               (if (equal? else-exp '(if #f #f))
+                   `(if ,test-exp ,then-exp)
+                   `(if ,test-exp ,then-exp ,else-exp))
+               source)))))
 
-(define build-lexical-reference
-  (lambda (type source name var)
-    (case (fluid-ref *mode*)
-      ((c) ((@ (language tree-il) make-lexical-ref) source name var))
-      (else (decorate-source var source)))))
+  (define build-lexical-reference
+    (lambda (type source name var)
+      (case (fluid-ref *mode*)
+        ((c) ((@ (language tree-il) make-lexical-ref) source name var))
+        (else (decorate-source var source)))))
 
-(define build-lexical-assignment
-  (lambda (source name var exp)
-    (case (fluid-ref *mode*)
-      ((c) ((@ (language tree-il) make-lexical-set) source name var exp))
-      (else (decorate-source `(set! ,var ,exp) source)))))
+  (define build-lexical-assignment
+    (lambda (source name var exp)
+      (case (fluid-ref *mode*)
+        ((c) ((@ (language tree-il) make-lexical-set) source name var exp))
+        (else (decorate-source `(set! ,var ,exp) source)))))
 
-;; Before modules are booted, we can't expand into data structures from
-;; (language tree-il) -- we need to give the evaluator the
-;; s-expressions that it understands natively. Actually the real truth
-;; of the matter is that the evaluator doesn't understand tree-il
-;; structures at all. So until we fix the evaluator, if ever, the
-;; conflation that we should use tree-il iff we are compiling
-;; holds true.
-;;
-(define (analyze-variable mod var modref-cont bare-cont)
-  (if (not mod)
-      (bare-cont var)
-      (let ((kind (car mod))
-            (mod (cdr mod)))
-        (case kind
-          ((public) (modref-cont mod var #t))
-          ((private) (if (not (equal? mod (module-name (current-module))))
-                         (modref-cont mod var #f)
-                         (bare-cont var)))
-          ((bare) (bare-cont var))
-          ((hygiene) (if (and (not (equal? mod (module-name (current-module))))
-                              (module-variable (resolve-module mod) var))
-                         (modref-cont mod var #f)
-                         (bare-cont var)))
-          (else (syntax-violation #f "bad module kind" var mod))))))
+  ;; Before modules are booted, we can't expand into data structures from
+  ;; (language tree-il) -- we need to give the evaluator the
+  ;; s-expressions that it understands natively. Actually the real truth
+  ;; of the matter is that the evaluator doesn't understand tree-il
+  ;; structures at all. So until we fix the evaluator, if ever, the
+  ;; conflation that we should use tree-il iff we are compiling
+  ;; holds true.
+  ;;
+  (define (analyze-variable mod var modref-cont bare-cont)
+    (if (not mod)
+        (bare-cont var)
+        (let ((kind (car mod))
+              (mod (cdr mod)))
+          (case kind
+            ((public) (modref-cont mod var #t))
+            ((private) (if (not (equal? mod (module-name (current-module))))
+                           (modref-cont mod var #f)
+                           (bare-cont var)))
+            ((bare) (bare-cont var))
+            ((hygiene) (if (and (not (equal? mod (module-name (current-module))))
+                                (module-variable (resolve-module mod) var))
+                           (modref-cont mod var #f)
+                           (bare-cont var)))
+            (else (syntax-violation #f "bad module kind" var mod))))))
 
-(define build-global-reference
-  (lambda (source var mod)
-    (analyze-variable
-     mod var
-     (lambda (mod var public?) 
-       (case (fluid-ref *mode*)
-         ((c) ((@ (language tree-il) make-module-ref) source mod var public?))
-         (else (decorate-source (list (if public? '@ '@@) mod var) source))))
-     (lambda (var)
-       (case (fluid-ref *mode*)
-         ((c) ((@ (language tree-il) make-toplevel-ref) source var))
-         (else (decorate-source var source)))))))
+  (define build-global-reference
+    (lambda (source var mod)
+      (analyze-variable
+       mod var
+       (lambda (mod var public?) 
+         (case (fluid-ref *mode*)
+           ((c) ((@ (language tree-il) make-module-ref) source mod var public?))
+           (else (decorate-source (list (if public? '@ '@@) mod var) source))))
+       (lambda (var)
+         (case (fluid-ref *mode*)
+           ((c) ((@ (language tree-il) make-toplevel-ref) source var))
+           (else (decorate-source var source)))))))
 
-(define build-global-assignment
-  (lambda (source var exp mod)
-    (analyze-variable
-     mod var
-     (lambda (mod var public?) 
-       (case (fluid-ref *mode*)
-         ((c) ((@ (language tree-il) make-module-set) source mod var public? exp))
-         (else (decorate-source `(set! ,(list (if public? '@ '@@) mod var) ,exp) source))))
-     (lambda (var)
-       (case (fluid-ref *mode*)
-         ((c) ((@ (language tree-il) make-toplevel-set) source var exp))
-         (else (decorate-source `(set! ,var ,exp) source)))))))
+  (define build-global-assignment
+    (lambda (source var exp mod)
+      (analyze-variable
+       mod var
+       (lambda (mod var public?) 
+         (case (fluid-ref *mode*)
+           ((c) ((@ (language tree-il) make-module-set) source mod var public? exp))
+           (else (decorate-source `(set! ,(list (if public? '@ '@@) mod var) ,exp) source))))
+       (lambda (var)
+         (case (fluid-ref *mode*)
+           ((c) ((@ (language tree-il) make-toplevel-set) source var exp))
+           (else (decorate-source `(set! ,var ,exp) source)))))))
 
-;; FIXME: there is a bug that prevents (set! ((@ (foo) bar) baz) quz)
-;; from working. Hack around it.
-(define (maybe-name-value! name val)
-  (cond
-   (((@ (language tree-il) lambda?) val)
-    (let ((meta ((@ (language tree-il) lambda-meta) val)))
-      (if (not (assq 'name meta))
-          ((setter (@ (language tree-il) lambda-meta))
-           val
-           (acons 'name name meta)))))))
+  ;; FIXME: there is a bug that prevents (set! ((@ (foo) bar) baz) quz)
+  ;; from working. Hack around it.
+  (define (maybe-name-value! name val)
+    (cond
+     (((@ (language tree-il) lambda?) val)
+      (let ((meta ((@ (language tree-il) lambda-meta) val)))
+        (if (not (assq 'name meta))
+            ((setter (@ (language tree-il) lambda-meta))
+             val
+             (acons 'name name meta)))))))
 
-(define build-global-definition
-  (lambda (source var exp)
-    (case (fluid-ref *mode*)
-      ((c)
-       (maybe-name-value! var exp)
-       ((@ (language tree-il) make-toplevel-define) source var exp))
-      (else (decorate-source `(define ,var ,exp) source)))))
-
-;; Ideally we would have all lambdas be case lambdas, but that would
-;; need special support in the interpreter for the full capabilities of
-;; case-lambda, with optional and keyword args, predicates, and else
-;; clauses. This will come with the new interpreter, but for now we
-;; separate the cases.
-(define build-simple-lambda
-  (lambda (src req rest vars docstring exp)
-    (case (fluid-ref *mode*)
-      ((c) ((@ (language tree-il) make-lambda) src
-            (if docstring `((documentation . ,docstring)) '())
-            ;; hah, a case in which kwargs would be nice.
-            ((@ (language tree-il) make-lambda-case)
-             ;; src req opt rest kw inits vars predicate body else
-             src req #f rest #f '() vars #f exp #f)))
-      (else (decorate-source
-             `(lambda ,(if rest (apply cons* vars) vars)
-                ,@(if docstring (list docstring) '())
-                ,exp)
-             src)))))
-
-(define build-case-lambda
-  (lambda (src docstring body)
-    (case (fluid-ref *mode*)
-      ((c) ((@ (language tree-il) make-lambda) src
-            (if docstring `((documentation . ,docstring)) '())
-            body))
-      (else (decorate-source
-             ;; really gross hack
-             `(lambda %%args 
-                ,@(if docstring (list docstring) '())
-                (cond ,@body))
-             src)))))
-
-(define build-lambda-case
-  ;; req := (name ...)
-  ;; opt := (name ...) | #f
-  ;; rest := name | #f
-  ;; kw := (allow-other-keys? (keyword name var [init]) ...) | #f
-  ;; inits: (init ...)
-  ;; vars: (sym ...)
-  ;; vars map to named arguments in the following order:
-  ;;  required, optional (positional), rest, keyword.
-  ;; predicate: something you can stuff in a (lambda ,vars ,pred), already expanded
-  ;; the body of a lambda: anything, already expanded
-  ;; else: lambda-case | #f
-  (lambda (src req opt rest kw inits vars predicate body else-case)
-    (case (fluid-ref *mode*)
-      ((c)
-       ((@ (language tree-il) make-lambda-case)
-        src req opt rest kw inits vars predicate body else-case))
-      (else
-       ;; Very much like the logic of (language tree-il compile-glil).
-       (let* ((nreq (length req))
-              (nopt (if opt (length opt) 0))
-              (rest-idx (and rest (+ nreq nopt)))
-              (allow-other-keys? (if kw (car kw) #f))
-              (kw-indices (map (lambda (x)
-                                 ;; (,key ,name ,var)
-                                 (cons (car x) (list-index vars (caddr x))))
-                               (if kw (cdr kw) '())))
-              (nargs (apply max (+ nreq nopt (if rest 1 0))
-                            (map 1+ (map cdr kw-indices)))))
-         (or (= nargs
-                (length vars)
-                (+ nreq (length inits) (if rest 1 0)))
-             (error "something went wrong"
-                    req opt rest kw inits vars nreq nopt kw-indices nargs))
-         (decorate-source
-          `((((@@ (ice-9 optargs) parse-lambda-case)
-              '(,nreq ,nopt ,rest-idx ,nargs ,allow-other-keys? ,kw-indices)
-              (list ,@(map (lambda (i) `(lambda ,vars ,i)) inits))
-              ,(if predicate `(lambda ,vars ,predicate) #f)
-              %%args)
-             ;; FIXME: This _ is here to work around a bug in the
-             ;; memoizer. The %%% makes it different from %%, also a
-             ;; memoizer workaround. See the "interesting bug" mail from
-             ;; 23 oct 2009. As soon as we change the evaluator, this
-             ;; can be removed.
-             => (lambda (%%%args . _) (apply (lambda ,vars ,body) %%%args)))
-            ,@(or else-case
-                  `((%%args (error "wrong number of arguments" %%args)))))
-          src))))))
-
-(define build-primref
-  (lambda (src name)
-    (if (equal? (module-name (current-module)) '(guile))
-        (case (fluid-ref *mode*)
-          ((c) ((@ (language tree-il) make-toplevel-ref) src name))
-          (else (decorate-source name src)))
-        (case (fluid-ref *mode*)
-          ((c) ((@ (language tree-il) make-module-ref) src '(guile) name #f))
-          (else (decorate-source `(@@ (guile) ,name) src))))))
-
-(define (build-data src exp)
-  (case (fluid-ref *mode*)
-    ((c) ((@ (language tree-il) make-const) src exp))
-    (else (decorate-source
-           (if (and (self-evaluating? exp) (not (vector? exp)))
-               exp
-               (list 'quote exp))
-           src))))
-
-(define build-sequence
-  (lambda (src exps)
-    (if (null? (cdr exps))
-        (car exps)
-        (case (fluid-ref *mode*)
-          ((c) ((@ (language tree-il) make-sequence) src exps))
-          (else (decorate-source `(begin ,@exps) src))))))
-
-(define build-let
-  (lambda (src ids vars val-exps body-exp)
-    (if (null? vars)
-	body-exp
-        (case (fluid-ref *mode*)
-          ((c)
-           (for-each maybe-name-value! ids val-exps)
-           ((@ (language tree-il) make-let) src ids vars val-exps body-exp))
-          (else (decorate-source
-                 `(let ,(map list vars val-exps) ,body-exp)
-                 src))))))
-
-(define build-named-let
-  (lambda (src ids vars val-exps body-exp)
-    (let ((f (car vars))
-          (f-name (car ids))
-          (vars (cdr vars))
-          (ids (cdr ids)))
+  (define build-global-definition
+    (lambda (source var exp)
       (case (fluid-ref *mode*)
         ((c)
-         (let ((proc (build-simple-lambda src ids #f vars #f body-exp)))
-           (maybe-name-value! f-name proc)
-           (for-each maybe-name-value! ids val-exps)
-           ((@ (language tree-il) make-letrec) src
-            (list f-name) (list f) (list proc)
-            (build-application src (build-lexical-reference 'fun src f-name f)
-                               val-exps))))
-        (else (decorate-source
-               `(let ,f ,(map list vars val-exps) ,body-exp)
-               src))))))
+         (maybe-name-value! var exp)
+         ((@ (language tree-il) make-toplevel-define) source var exp))
+        (else (decorate-source `(define ,var ,exp) source)))))
 
-(define build-letrec
-  (lambda (src ids vars val-exps body-exp)
-    (if (null? vars)
-        body-exp
+  ;; Ideally we would have all lambdas be case lambdas, but that would
+  ;; need special support in the interpreter for the full capabilities of
+  ;; case-lambda, with optional and keyword args, predicates, and else
+  ;; clauses. This will come with the new interpreter, but for now we
+  ;; separate the cases.
+  (define build-simple-lambda
+    (lambda (src req rest vars docstring exp)
+      (case (fluid-ref *mode*)
+        ((c) ((@ (language tree-il) make-lambda) src
+              (if docstring `((documentation . ,docstring)) '())
+              ;; hah, a case in which kwargs would be nice.
+              ((@ (language tree-il) make-lambda-case)
+               ;; src req opt rest kw inits vars predicate body else
+               src req #f rest #f '() vars #f exp #f)))
+        (else (decorate-source
+               `(lambda ,(if rest (apply cons* vars) vars)
+                  ,@(if docstring (list docstring) '())
+                  ,exp)
+               src)))))
+
+  (define build-case-lambda
+    (lambda (src docstring body)
+      (case (fluid-ref *mode*)
+        ((c) ((@ (language tree-il) make-lambda) src
+              (if docstring `((documentation . ,docstring)) '())
+              body))
+        (else (decorate-source
+               ;; really gross hack
+               `(lambda %%args 
+                  ,@(if docstring (list docstring) '())
+                  (cond ,@body))
+               src)))))
+
+  (define build-lambda-case
+    ;; req := (name ...)
+    ;; opt := (name ...) | #f
+    ;; rest := name | #f
+    ;; kw := (allow-other-keys? (keyword name var [init]) ...) | #f
+    ;; inits: (init ...)
+    ;; vars: (sym ...)
+    ;; vars map to named arguments in the following order:
+    ;;  required, optional (positional), rest, keyword.
+    ;; predicate: something you can stuff in a (lambda ,vars ,pred), already expanded
+    ;; the body of a lambda: anything, already expanded
+    ;; else: lambda-case | #f
+    (lambda (src req opt rest kw inits vars predicate body else-case)
+      (case (fluid-ref *mode*)
+        ((c)
+         ((@ (language tree-il) make-lambda-case)
+          src req opt rest kw inits vars predicate body else-case))
+        (else
+         ;; Very much like the logic of (language tree-il compile-glil).
+         (let* ((nreq (length req))
+                (nopt (if opt (length opt) 0))
+                (rest-idx (and rest (+ nreq nopt)))
+                (allow-other-keys? (if kw (car kw) #f))
+                (kw-indices (map (lambda (x)
+                                   ;; (,key ,name ,var)
+                                   (cons (car x) (list-index vars (caddr x))))
+                                 (if kw (cdr kw) '())))
+                (nargs (apply max (+ nreq nopt (if rest 1 0))
+                              (map 1+ (map cdr kw-indices)))))
+           (or (= nargs
+                  (length vars)
+                  (+ nreq (length inits) (if rest 1 0)))
+               (error "something went wrong"
+                      req opt rest kw inits vars nreq nopt kw-indices nargs))
+           (decorate-source
+            `((((@@ (ice-9 optargs) parse-lambda-case)
+                '(,nreq ,nopt ,rest-idx ,nargs ,allow-other-keys? ,kw-indices)
+                (list ,@(map (lambda (i) `(lambda ,vars ,i)) inits))
+                ,(if predicate `(lambda ,vars ,predicate) #f)
+                %%args)
+               ;; FIXME: This _ is here to work around a bug in the
+               ;; memoizer. The %%% makes it different from %%, also a
+               ;; memoizer workaround. See the "interesting bug" mail from
+               ;; 23 oct 2009. As soon as we change the evaluator, this
+               ;; can be removed.
+               => (lambda (%%%args . _) (apply (lambda ,vars ,body) %%%args)))
+              ,@(or else-case
+                    `((%%args (error "wrong number of arguments" %%args)))))
+            src))))))
+
+  (define build-primref
+    (lambda (src name)
+      (if (equal? (module-name (current-module)) '(guile))
+          (case (fluid-ref *mode*)
+            ((c) ((@ (language tree-il) make-toplevel-ref) src name))
+            (else (decorate-source name src)))
+          (case (fluid-ref *mode*)
+            ((c) ((@ (language tree-il) make-module-ref) src '(guile) name #f))
+            (else (decorate-source `(@@ (guile) ,name) src))))))
+
+  (define (build-data src exp)
+    (case (fluid-ref *mode*)
+      ((c) ((@ (language tree-il) make-const) src exp))
+      (else (decorate-source
+             (if (and (self-evaluating? exp) (not (vector? exp)))
+                 exp
+                 (list 'quote exp))
+             src))))
+
+  (define build-sequence
+    (lambda (src exps)
+      (if (null? (cdr exps))
+          (car exps)
+          (case (fluid-ref *mode*)
+            ((c) ((@ (language tree-il) make-sequence) src exps))
+            (else (decorate-source `(begin ,@exps) src))))))
+
+  (define build-let
+    (lambda (src ids vars val-exps body-exp)
+      (if (null? vars)
+          body-exp
+          (case (fluid-ref *mode*)
+            ((c)
+             (for-each maybe-name-value! ids val-exps)
+             ((@ (language tree-il) make-let) src ids vars val-exps body-exp))
+            (else (decorate-source
+                   `(let ,(map list vars val-exps) ,body-exp)
+                   src))))))
+
+  (define build-named-let
+    (lambda (src ids vars val-exps body-exp)
+      (let ((f (car vars))
+            (f-name (car ids))
+            (vars (cdr vars))
+            (ids (cdr ids)))
         (case (fluid-ref *mode*)
           ((c)
-           (for-each maybe-name-value! ids val-exps)
-           ((@ (language tree-il) make-letrec) src ids vars val-exps body-exp))
+           (let ((proc (build-simple-lambda src ids #f vars #f body-exp)))
+             (maybe-name-value! f-name proc)
+             (for-each maybe-name-value! ids val-exps)
+             ((@ (language tree-il) make-letrec) src
+              (list f-name) (list f) (list proc)
+              (build-application src (build-lexical-reference 'fun src f-name f)
+                                 val-exps))))
           (else (decorate-source
-                 `(letrec ,(map list vars val-exps) ,body-exp)
+                 `(let ,f ,(map list vars val-exps) ,body-exp)
                  src))))))
 
-;; FIXME: use a faster gensym
-(define-syntax build-lexical-var
-  (syntax-rules ()
-    ((_ src id) (gensym (string-append (symbol->string id) " ")))))
+  (define build-letrec
+    (lambda (src ids vars val-exps body-exp)
+      (if (null? vars)
+          body-exp
+          (case (fluid-ref *mode*)
+            ((c)
+             (for-each maybe-name-value! ids val-exps)
+             ((@ (language tree-il) make-letrec) src ids vars val-exps body-exp))
+            (else (decorate-source
+                   `(letrec ,(map list vars val-exps) ,body-exp)
+                   src))))))
 
-(define-structure (syntax-object expression wrap module))
+  ;; FIXME: use a faster gensym
+  (define-syntax build-lexical-var
+    (syntax-rules ()
+      ((_ src id) (gensym (string-append (symbol->string id) " ")))))
 
-(define-syntax no-source (identifier-syntax #f))
+  (define-structure (syntax-object expression wrap module))
 
-(define source-annotation
-  (lambda (x)
-     (cond
-      ((syntax-object? x)
-       (source-annotation (syntax-object-expression x)))
-      ((pair? x) (let ((props (source-properties x)))
-                   (if (pair? props)
-                       props
-                       #f)))
-      (else #f))))
+  (define-syntax no-source (identifier-syntax #f))
 
-(define-syntax arg-check
-  (syntax-rules ()
-    ((_ pred? e who)
-     (let ((x e))
-       (if (not (pred? x)) (syntax-violation who "invalid argument" x))))))
+  (define source-annotation
+    (lambda (x)
+      (cond
+       ((syntax-object? x)
+        (source-annotation (syntax-object-expression x)))
+       ((pair? x) (let ((props (source-properties x)))
+                    (if (pair? props)
+                        props
+                        #f)))
+       (else #f))))
+
+  (define-syntax arg-check
+    (syntax-rules ()
+      ((_ pred? e who)
+       (let ((x e))
+         (if (not (pred? x)) (syntax-violation who "invalid argument" x))))))
 
 ;;; compile-time environments
 
@@ -655,7 +655,7 @@
 ;;;               (define-syntax)                 define-syntax
 ;;;               (local-syntax . rec?)           let-syntax/letrec-syntax
 ;;;               (eval-when)                     eval-when
-;;;               (syntax . (<var> . <level>))    pattern variables
+;;;               #'. (<var> . <level>)    pattern variables
 ;;;               (global)                        assumed global variable
 ;;;               (lexical . <var>)               lexical variables
 ;;;               (displaced-lexical)             displaced lexicals
@@ -683,58 +683,58 @@
 ;;; keyword is referenced on the rhs of one of the letrec-syntax clauses.
 ;;; a displaced lexical should never occur with properly written macros.
 
-(define-syntax make-binding
-  (syntax-rules (quote)
-    ((_ type value) (cons type value))
-    ((_ 'type) '(type))
-    ((_ type) (cons type '()))))
-(define binding-type car)
-(define binding-value cdr)
+  (define-syntax make-binding
+    (syntax-rules (quote)
+      ((_ type value) (cons type value))
+      ((_ 'type) '(type))
+      ((_ type) (cons type '()))))
+  (define binding-type car)
+  (define binding-value cdr)
 
-(define-syntax null-env (identifier-syntax '()))
+  (define-syntax null-env (identifier-syntax '()))
 
-(define extend-env
-  (lambda (labels bindings r) 
-    (if (null? labels)
-        r
-        (extend-env (cdr labels) (cdr bindings)
-          (cons (cons (car labels) (car bindings)) r)))))
+  (define extend-env
+    (lambda (labels bindings r) 
+      (if (null? labels)
+          r
+          (extend-env (cdr labels) (cdr bindings)
+                      (cons (cons (car labels) (car bindings)) r)))))
 
-(define extend-var-env
-  ; variant of extend-env that forms "lexical" binding
-  (lambda (labels vars r)
-    (if (null? labels)
-        r
-        (extend-var-env (cdr labels) (cdr vars)
-          (cons (cons (car labels) (make-binding 'lexical (car vars))) r)))))
+  (define extend-var-env
+                                        ; variant of extend-env that forms "lexical" binding
+    (lambda (labels vars r)
+      (if (null? labels)
+          r
+          (extend-var-env (cdr labels) (cdr vars)
+                          (cons (cons (car labels) (make-binding 'lexical (car vars))) r)))))
 
 ;;; we use a "macros only" environment in expansion of local macro
 ;;; definitions so that their definitions can use local macros without
 ;;; attempting to use other lexical identifiers.
-(define macros-only-env
-  (lambda (r)
-    (if (null? r)
-        '()
-        (let ((a (car r)))
-          (if (eq? (cadr a) 'macro)
-              (cons a (macros-only-env (cdr r)))
-              (macros-only-env (cdr r)))))))
+  (define macros-only-env
+    (lambda (r)
+      (if (null? r)
+          '()
+          (let ((a (car r)))
+            (if (eq? (cadr a) 'macro)
+                (cons a (macros-only-env (cdr r)))
+                (macros-only-env (cdr r)))))))
 
-(define lookup
-  ; x may be a label or a symbol
-  ; although symbols are usually global, we check the environment first
-  ; anyway because a temporary binding may have been established by
-  ; fluid-let-syntax
-  (lambda (x r mod)
-    (cond
-      ((assq x r) => cdr)
-      ((symbol? x)
-       (or (get-global-definition-hook x mod) (make-binding 'global)))
-      (else (make-binding 'displaced-lexical)))))
+  (define lookup
+                                        ; x may be a label or a symbol
+                                        ; although symbols are usually global, we check the environment first
+                                        ; anyway because a temporary binding may have been established by
+                                        ; fluid-let-syntax
+    (lambda (x r mod)
+      (cond
+       ((assq x r) => cdr)
+       ((symbol? x)
+        (or (get-global-definition-hook x mod) (make-binding 'global)))
+       (else (make-binding 'displaced-lexical)))))
 
-(define global-extend
-  (lambda (type sym val)
-    (put-global-definition-hook sym type val)))
+  (define global-extend
+    (lambda (type sym val)
+      (put-global-definition-hook sym type val)))
 
 
 ;;; Conceptually, identifiers are always syntax objects.  Internally,
@@ -742,33 +742,33 @@
 ;;; efficiency and confusion), so that symbols are also considered
 ;;; identifiers by id?.  Externally, they are always wrapped.
 
-(define nonsymbol-id?
-  (lambda (x)
-    (and (syntax-object? x)
-         (symbol? (syntax-object-expression x)))))
+  (define nonsymbol-id?
+    (lambda (x)
+      (and (syntax-object? x)
+           (symbol? (syntax-object-expression x)))))
 
-(define id?
-  (lambda (x)
-    (cond
-      ((symbol? x) #t)
-      ((syntax-object? x) (symbol? (syntax-object-expression x)))
-      (else #f))))
+  (define id?
+    (lambda (x)
+      (cond
+       ((symbol? x) #t)
+       ((syntax-object? x) (symbol? (syntax-object-expression x)))
+       (else #f))))
 
-(define-syntax id-sym-name
-  (syntax-rules ()
-    ((_ e)
-     (let ((x e))
-       (if (syntax-object? x)
+  (define-syntax id-sym-name
+    (syntax-rules ()
+      ((_ e)
+       (let ((x e))
+         (if (syntax-object? x)
+             (syntax-object-expression x)
+             x)))))
+
+  (define id-sym-name&marks
+    (lambda (x w)
+      (if (syntax-object? x)
+          (values
            (syntax-object-expression x)
-           x)))))
-
-(define id-sym-name&marks
-  (lambda (x w)
-    (if (syntax-object? x)
-        (values
-         (syntax-object-expression x)
-         (join-marks (wrap-marks w) (wrap-marks (syntax-object-wrap x))))
-        (values x (wrap-marks w)))))
+           (join-marks (wrap-marks w) (wrap-marks (syntax-object-wrap x))))
+          (values x (wrap-marks w)))))
 
 ;;; syntax object wraps
 
@@ -777,86 +777,86 @@
 ;;;         <subs> ::= #(<old name> <label> (<mark> ...))
 ;;;        <shift> ::= positive fixnum
 
-(define make-wrap cons)
-(define wrap-marks car)
-(define wrap-subst cdr)
+  (define make-wrap cons)
+  (define wrap-marks car)
+  (define wrap-subst cdr)
 
-(define-syntax subst-rename? (identifier-syntax vector?))
-(define-syntax rename-old (syntax-rules () ((_ x) (vector-ref x 0))))
-(define-syntax rename-new (syntax-rules () ((_ x) (vector-ref x 1))))
-(define-syntax rename-marks (syntax-rules () ((_ x) (vector-ref x 2))))
-(define-syntax make-rename
-  (syntax-rules ()
-    ((_ old new marks) (vector old new marks))))
+  (define-syntax subst-rename? (identifier-syntax vector?))
+  (define-syntax rename-old (syntax-rules () ((_ x) (vector-ref x 0))))
+  (define-syntax rename-new (syntax-rules () ((_ x) (vector-ref x 1))))
+  (define-syntax rename-marks (syntax-rules () ((_ x) (vector-ref x 2))))
+  (define-syntax make-rename
+    (syntax-rules ()
+      ((_ old new marks) (vector old new marks))))
 
 ;;; labels must be comparable with "eq?" and distinct from symbols.
-(define gen-label
-  (lambda () (string #\i)))
+  (define gen-label
+    (lambda () (string #\i)))
 
-(define gen-labels
-  (lambda (ls)
-    (if (null? ls)
-        '()
-        (cons (gen-label) (gen-labels (cdr ls))))))
+  (define gen-labels
+    (lambda (ls)
+      (if (null? ls)
+          '()
+          (cons (gen-label) (gen-labels (cdr ls))))))
 
-(define-structure (ribcage symnames marks labels))
+  (define-structure (ribcage symnames marks labels))
 
-(define-syntax empty-wrap (identifier-syntax '(())))
+  (define-syntax empty-wrap (identifier-syntax '(())))
 
-(define-syntax top-wrap (identifier-syntax '((top))))
+  (define-syntax top-wrap (identifier-syntax '((top))))
 
-(define-syntax top-marked?
-  (syntax-rules ()
-    ((_ w) (memq 'top (wrap-marks w)))))
+  (define-syntax top-marked?
+    (syntax-rules ()
+      ((_ w) (memq 'top (wrap-marks w)))))
 
 ;;; Marks must be comparable with "eq?" and distinct from pairs and
 ;;; the symbol top.  We do not use integers so that marks will remain
 ;;; unique even across file compiles.
 
-(define-syntax the-anti-mark (identifier-syntax #f))
+  (define-syntax the-anti-mark (identifier-syntax #f))
 
-(define anti-mark
-  (lambda (w)
-    (make-wrap (cons the-anti-mark (wrap-marks w))
-               (cons 'shift (wrap-subst w)))))
+  (define anti-mark
+    (lambda (w)
+      (make-wrap (cons the-anti-mark (wrap-marks w))
+                 (cons 'shift (wrap-subst w)))))
 
-(define-syntax new-mark
-  (syntax-rules ()
-    ((_) (string #\m))))
+  (define-syntax new-mark
+    (syntax-rules ()
+      ((_) (string #\m))))
 
 ;;; make-empty-ribcage and extend-ribcage maintain list-based ribcages for
 ;;; internal definitions, in which the ribcages are built incrementally
-(define-syntax make-empty-ribcage
-  (syntax-rules ()
-    ((_) (make-ribcage '() '() '()))))
+  (define-syntax make-empty-ribcage
+    (syntax-rules ()
+      ((_) (make-ribcage '() '() '()))))
 
-(define extend-ribcage!
-  ; must receive ids with complete wraps
-  (lambda (ribcage id label)
-    (set-ribcage-symnames! ribcage
-      (cons (syntax-object-expression id)
-            (ribcage-symnames ribcage)))
-    (set-ribcage-marks! ribcage
-      (cons (wrap-marks (syntax-object-wrap id))
-            (ribcage-marks ribcage)))
-    (set-ribcage-labels! ribcage
-      (cons label (ribcage-labels ribcage)))))
+  (define extend-ribcage!
+                                        ; must receive ids with complete wraps
+    (lambda (ribcage id label)
+      (set-ribcage-symnames! ribcage
+                             (cons (syntax-object-expression id)
+                                   (ribcage-symnames ribcage)))
+      (set-ribcage-marks! ribcage
+                          (cons (wrap-marks (syntax-object-wrap id))
+                                (ribcage-marks ribcage)))
+      (set-ribcage-labels! ribcage
+                           (cons label (ribcage-labels ribcage)))))
 
 ;;; make-binding-wrap creates vector-based ribcages
-(define make-binding-wrap
-  (lambda (ids labels w)
-    (if (null? ids)
-        w
-        (make-wrap
-          (wrap-marks w)
-          (cons
+  (define make-binding-wrap
+    (lambda (ids labels w)
+      (if (null? ids)
+          w
+          (make-wrap
+           (wrap-marks w)
+           (cons
             (let ((labelvec (list->vector labels)))
               (let ((n (vector-length labelvec)))
                 (let ((symnamevec (make-vector n)) (marksvec (make-vector n)))
                   (let f ((ids ids) (i 0))
                     (if (not (null? ids))
                         (call-with-values
-                          (lambda () (id-sym-name&marks (car ids) w))
+                            (lambda () (id-sym-name&marks (car ids) w))
                           (lambda (symname marks)
                             (vector-set! symnamevec i symname)
                             (vector-set! marksvec i marks)
@@ -864,76 +864,76 @@
                   (make-ribcage symnamevec marksvec labelvec))))
             (wrap-subst w))))))
 
-(define smart-append
-  (lambda (m1 m2)
-    (if (null? m2)
-        m1
-        (append m1 m2))))
+  (define smart-append
+    (lambda (m1 m2)
+      (if (null? m2)
+          m1
+          (append m1 m2))))
 
-(define join-wraps
-  (lambda (w1 w2)
-    (let ((m1 (wrap-marks w1)) (s1 (wrap-subst w1)))
-      (if (null? m1)
-          (if (null? s1)
-              w2
-              (make-wrap
-                (wrap-marks w2)
-                (smart-append s1 (wrap-subst w2))))
-          (make-wrap
-            (smart-append m1 (wrap-marks w2))
-            (smart-append s1 (wrap-subst w2)))))))
+  (define join-wraps
+    (lambda (w1 w2)
+      (let ((m1 (wrap-marks w1)) (s1 (wrap-subst w1)))
+        (if (null? m1)
+            (if (null? s1)
+                w2
+                (make-wrap
+                 (wrap-marks w2)
+                 (smart-append s1 (wrap-subst w2))))
+            (make-wrap
+             (smart-append m1 (wrap-marks w2))
+             (smart-append s1 (wrap-subst w2)))))))
 
-(define join-marks
-  (lambda (m1 m2)
-    (smart-append m1 m2)))
+  (define join-marks
+    (lambda (m1 m2)
+      (smart-append m1 m2)))
 
-(define same-marks?
-  (lambda (x y)
-    (or (eq? x y)
-        (and (not (null? x))
-             (not (null? y))
-             (eq? (car x) (car y))
-             (same-marks? (cdr x) (cdr y))))))
+  (define same-marks?
+    (lambda (x y)
+      (or (eq? x y)
+          (and (not (null? x))
+               (not (null? y))
+               (eq? (car x) (car y))
+               (same-marks? (cdr x) (cdr y))))))
 
-(define id-var-name
-  (lambda (id w)
-    (define-syntax first
-      (syntax-rules ()
-        ((_ e) (call-with-values (lambda () e) (lambda (x . ignore) x)))))
-    (define search
-      (lambda (sym subst marks)
-        (if (null? subst)
-            (values #f marks)
-            (let ((fst (car subst)))
-              (if (eq? fst 'shift)
-                  (search sym (cdr subst) (cdr marks))
-                  (let ((symnames (ribcage-symnames fst)))
-                    (if (vector? symnames)
-                        (search-vector-rib sym subst marks symnames fst)
-                        (search-list-rib sym subst marks symnames fst))))))))
-    (define search-list-rib
-      (lambda (sym subst marks symnames ribcage)
-        (let f ((symnames symnames) (i 0))
-          (cond
-            ((null? symnames) (search sym (cdr subst) marks))
-            ((and (eq? (car symnames) sym)
-                  (same-marks? marks (list-ref (ribcage-marks ribcage) i)))
-             (values (list-ref (ribcage-labels ribcage) i) marks))
-            (else (f (cdr symnames) (fx+ i 1)))))))
-    (define search-vector-rib
-      (lambda (sym subst marks symnames ribcage)
-        (let ((n (vector-length symnames)))
-          (let f ((i 0))
+  (define id-var-name
+    (lambda (id w)
+      (define-syntax first
+        (syntax-rules ()
+          ((_ e) (call-with-values (lambda () e) (lambda (x . ignore) x)))))
+      (define search
+        (lambda (sym subst marks)
+          (if (null? subst)
+              (values #f marks)
+              (let ((fst (car subst)))
+                (if (eq? fst 'shift)
+                    (search sym (cdr subst) (cdr marks))
+                    (let ((symnames (ribcage-symnames fst)))
+                      (if (vector? symnames)
+                          (search-vector-rib sym subst marks symnames fst)
+                          (search-list-rib sym subst marks symnames fst))))))))
+      (define search-list-rib
+        (lambda (sym subst marks symnames ribcage)
+          (let f ((symnames symnames) (i 0))
             (cond
-              ((fx= i n) (search sym (cdr subst) marks))
-              ((and (eq? (vector-ref symnames i) sym)
-                    (same-marks? marks (vector-ref (ribcage-marks ribcage) i)))
-               (values (vector-ref (ribcage-labels ribcage) i) marks))
-              (else (f (fx+ i 1))))))))
-    (cond
-      ((symbol? id)
-       (or (first (search id (wrap-subst w) (wrap-marks w))) id))
-      ((syntax-object? id)
+             ((null? symnames) (search sym (cdr subst) marks))
+             ((and (eq? (car symnames) sym)
+                   (same-marks? marks (list-ref (ribcage-marks ribcage) i)))
+              (values (list-ref (ribcage-labels ribcage) i) marks))
+             (else (f (cdr symnames) (fx+ i 1)))))))
+      (define search-vector-rib
+        (lambda (sym subst marks symnames ribcage)
+          (let ((n (vector-length symnames)))
+            (let f ((i 0))
+              (cond
+               ((fx= i n) (search sym (cdr subst) marks))
+               ((and (eq? (vector-ref symnames i) sym)
+                     (same-marks? marks (vector-ref (ribcage-marks ribcage) i)))
+                (values (vector-ref (ribcage-labels ribcage) i) marks))
+               (else (f (fx+ i 1))))))))
+      (cond
+       ((symbol? id)
+        (or (first (search id (wrap-subst w) (wrap-marks w))) id))
+       ((syntax-object? id)
         (let ((id (syntax-object-expression id))
               (w1 (syntax-object-wrap id)))
           (let ((marks (join-marks (wrap-marks w) (wrap-marks w1))))
@@ -942,41 +942,41 @@
                 (or new-id
                     (first (search id (wrap-subst w1) marks))
                     id))))))
-      (else (syntax-violation 'id-var-name "invalid id" id)))))
+       (else (syntax-violation 'id-var-name "invalid id" id)))))
 
 ;;; free-id=? must be passed fully wrapped ids since (free-id=? x y)
 ;;; may be true even if (free-id=? (wrap x w) (wrap y w)) is not.
 
-(define free-id=?
-  (lambda (i j)
-    (and (eq? (id-sym-name i) (id-sym-name j)) ; accelerator
-         (eq? (id-var-name i empty-wrap) (id-var-name j empty-wrap)))))
+  (define free-id=?
+    (lambda (i j)
+      (and (eq? (id-sym-name i) (id-sym-name j)) ; accelerator
+           (eq? (id-var-name i empty-wrap) (id-var-name j empty-wrap)))))
 
 ;;; bound-id=? may be passed unwrapped (or partially wrapped) ids as
 ;;; long as the missing portion of the wrap is common to both of the ids
 ;;; since (bound-id=? x y) iff (bound-id=? (wrap x w) (wrap y w))
 
-(define bound-id=?
-  (lambda (i j)
-    (if (and (syntax-object? i) (syntax-object? j))
-        (and (eq? (syntax-object-expression i)
-                  (syntax-object-expression j))
-             (same-marks? (wrap-marks (syntax-object-wrap i))
-                  (wrap-marks (syntax-object-wrap j))))
-        (eq? i j))))
+  (define bound-id=?
+    (lambda (i j)
+      (if (and (syntax-object? i) (syntax-object? j))
+          (and (eq? (syntax-object-expression i)
+                    (syntax-object-expression j))
+               (same-marks? (wrap-marks (syntax-object-wrap i))
+                            (wrap-marks (syntax-object-wrap j))))
+          (eq? i j))))
 
 ;;; "valid-bound-ids?" returns #t if it receives a list of distinct ids.
 ;;; valid-bound-ids? may be passed unwrapped (or partially wrapped) ids
 ;;; as long as the missing portion of the wrap is common to all of the
 ;;; ids.
 
-(define valid-bound-ids?
-  (lambda (ids)
-     (and (let all-ids? ((ids ids))
-            (or (null? ids)
-                (and (id? (car ids))
-                     (all-ids? (cdr ids)))))
-          (distinct-bound-ids? ids))))
+  (define valid-bound-ids?
+    (lambda (ids)
+      (and (let all-ids? ((ids ids))
+             (or (null? ids)
+                 (and (id? (car ids))
+                      (all-ids? (cdr ids)))))
+           (distinct-bound-ids? ids))))
 
 ;;; distinct-bound-ids? expects a list of ids and returns #t if there are
 ;;; no duplicates.  It is quadratic on the length of the id list; long
@@ -984,101 +984,101 @@
 ;;; may be passed unwrapped (or partially wrapped) ids as long as the
 ;;; missing portion of the wrap is common to all of the ids.
 
-(define distinct-bound-ids?
-  (lambda (ids)
-    (let distinct? ((ids ids))
-      (or (null? ids)
-          (and (not (bound-id-member? (car ids) (cdr ids)))
-               (distinct? (cdr ids)))))))
+  (define distinct-bound-ids?
+    (lambda (ids)
+      (let distinct? ((ids ids))
+        (or (null? ids)
+            (and (not (bound-id-member? (car ids) (cdr ids)))
+                 (distinct? (cdr ids)))))))
 
-(define bound-id-member?
-   (lambda (x list)
+  (define bound-id-member?
+    (lambda (x list)
       (and (not (null? list))
            (or (bound-id=? x (car list))
                (bound-id-member? x (cdr list))))))
 
 ;;; wrapping expressions and identifiers
 
-(define wrap
-  (lambda (x w defmod)
-    (cond
-      ((and (null? (wrap-marks w)) (null? (wrap-subst w))) x)
-      ((syntax-object? x)
-       (make-syntax-object
+  (define wrap
+    (lambda (x w defmod)
+      (cond
+       ((and (null? (wrap-marks w)) (null? (wrap-subst w))) x)
+       ((syntax-object? x)
+        (make-syntax-object
          (syntax-object-expression x)
          (join-wraps w (syntax-object-wrap x))
          (syntax-object-module x)))
-      ((null? x) x)
-      (else (make-syntax-object x w defmod)))))
+       ((null? x) x)
+       (else (make-syntax-object x w defmod)))))
 
-(define source-wrap
-  (lambda (x w s defmod)
-    (wrap (decorate-source x s) w defmod)))
+  (define source-wrap
+    (lambda (x w s defmod)
+      (wrap (decorate-source x s) w defmod)))
 
 ;;; expanding
 
-(define chi-sequence
-  (lambda (body r w s mod)
-    (build-sequence s
-      (let dobody ((body body) (r r) (w w) (mod mod))
-        (if (null? body)
-            '()
-            (let ((first (chi (car body) r w mod)))
-              (cons first (dobody (cdr body) r w mod))))))))
+  (define chi-sequence
+    (lambda (body r w s mod)
+      (build-sequence s
+                      (let dobody ((body body) (r r) (w w) (mod mod))
+                        (if (null? body)
+                            '()
+                            (let ((first (chi (car body) r w mod)))
+                              (cons first (dobody (cdr body) r w mod))))))))
 
-(define chi-top-sequence
-  (lambda (body r w s m esew mod)
-    (build-sequence s
-      (let dobody ((body body) (r r) (w w) (m m) (esew esew) (mod mod))
-        (if (null? body)
-            '()
-            (let ((first (chi-top (car body) r w m esew mod)))
-              (cons first (dobody (cdr body) r w m esew mod))))))))
+  (define chi-top-sequence
+    (lambda (body r w s m esew mod)
+      (build-sequence s
+                      (let dobody ((body body) (r r) (w w) (m m) (esew esew) (mod mod))
+                        (if (null? body)
+                            '()
+                            (let ((first (chi-top (car body) r w m esew mod)))
+                              (cons first (dobody (cdr body) r w m esew mod))))))))
 
-(define chi-install-global
-  (lambda (name e)
-    (build-global-definition
-     no-source
-     name
-     ;; FIXME: seems nasty to call current-module here
-     (if (let ((v (module-variable (current-module) name)))
-           ;; FIXME use primitive-macro?
-           (and v (variable-bound? v) (macro? (variable-ref v))
-                (not (eq? (macro-type (variable-ref v)) 'syncase-macro))))
-         (build-application
-          no-source
-          (build-primref no-source 'make-extended-syncase-macro)
-          (list (build-application
-                 no-source
-                 (build-primref no-source 'module-ref)
-                 (list (build-application 
-                        no-source
-                        (build-primref no-source 'current-module)
-                        '())
-                       (build-data no-source name)))
-                (build-data no-source 'macro)
-                e))
-         (build-application
-          no-source
-          (build-primref no-source 'make-syncase-macro)
-          (list (build-data no-source 'macro) e))))))
+  (define chi-install-global
+    (lambda (name e)
+      (build-global-definition
+       no-source
+       name
+       ;; FIXME: seems nasty to call current-module here
+       (if (let ((v (module-variable (current-module) name)))
+             ;; FIXME use primitive-macro?
+             (and v (variable-bound? v) (macro? (variable-ref v))
+                  (not (eq? (macro-type (variable-ref v)) 'syncase-macro))))
+           (build-application
+            no-source
+            (build-primref no-source 'make-extended-syncase-macro)
+            (list (build-application
+                   no-source
+                   (build-primref no-source 'module-ref)
+                   (list (build-application 
+                          no-source
+                          (build-primref no-source 'current-module)
+                          '())
+                         (build-data no-source name)))
+                  (build-data no-source 'macro)
+                  e))
+           (build-application
+            no-source
+            (build-primref no-source 'make-syncase-macro)
+            (list (build-data no-source 'macro) e))))))
 
-(define chi-when-list
-  (lambda (e when-list w)
-    ; when-list is syntax'd version of list of situations
-    (let f ((when-list when-list) (situations '()))
-      (if (null? when-list)
-          situations
-          (f (cdr when-list)
-             (cons (let ((x (car when-list)))
-                     (cond
-                       ((free-id=? x (syntax compile)) 'compile)
-                       ((free-id=? x (syntax load)) 'load)
-                       ((free-id=? x (syntax eval)) 'eval)
-                       (else (syntax-violation 'eval-when
-                                               "invalid situation"
-                                               e (wrap x w #f)))))
-                   situations))))))
+  (define chi-when-list
+    (lambda (e when-list w)
+                                        ; when-list is syntax'd version of list of situations
+      (let f ((when-list when-list) (situations '()))
+        (if (null? when-list)
+            situations
+            (f (cdr when-list)
+               (cons (let ((x (car when-list)))
+                       (cond
+                        ((free-id=? x #'compile) 'compile)
+                        ((free-id=? x #'load) 'load)
+                        ((free-id=? x #'eval) 'eval)
+                        (else (syntax-violation 'eval-when
+                                                "invalid situation"
+                                                e (wrap x w #f)))))
+                     situations))))))
 
 ;;; syntax-type returns six values: type, value, e, w, s, and mod. The
 ;;; first two are described in the table below.
@@ -1116,684 +1116,684 @@
 ;;; one of the forms above.  It also parses define and define-syntax
 ;;; forms, although perhaps this should be done by the consumer.
 
-(define syntax-type
-  (lambda (e r w s rib mod for-car?)
-    (cond
-      ((symbol? e)
-       (let* ((n (id-var-name e w))
-              (b (lookup n r mod))
-              (type (binding-type b)))
-         (case type
-           ((lexical) (values type (binding-value b) e w s mod))
-           ((global) (values type n e w s mod))
-           ((macro)
-            (if for-car?
-                (values type (binding-value b) e w s mod)
-                (syntax-type (chi-macro (binding-value b) e r w rib mod)
-                             r empty-wrap s rib mod #f)))
-           (else (values type (binding-value b) e w s mod)))))
-      ((pair? e)
-       (let ((first (car e)))
-         (call-with-values
-             (lambda () (syntax-type first r w s rib mod #t))
-           (lambda (ftype fval fe fw fs fmod)
-             (case ftype
-               ((lexical)
-                (values 'lexical-call fval e w s mod))
-               ((global)
-                ;; If we got here via an (@@ ...) expansion, we need to
-                ;; make sure the fmod information is propagated back
-                ;; correctly -- hence this consing.
-                (values 'global-call (make-syntax-object fval w fmod)
-                        e w s mod))
-               ((macro)
-                (syntax-type (chi-macro fval e r w rib mod)
-                             r empty-wrap s rib mod for-car?))
-               ((module-ref)
-                (call-with-values (lambda () (fval e))
-                  (lambda (sym mod)
-                    (syntax-type sym r w s rib mod for-car?))))
-               ((core)
-                (values 'core-form fval e w s mod))
-               ((local-syntax)
-                (values 'local-syntax-form fval e w s mod))
-               ((begin)
-                (values 'begin-form #f e w s mod))
-               ((eval-when)
-                (values 'eval-when-form #f e w s mod))
-               ((define)
-                (syntax-case e ()
-                  ((_ name val)
-                   (id? (syntax name))
-                   (values 'define-form (syntax name) (syntax val) w s mod))
-                  ((_ (name . args) e1 e2 ...)
-                   (and (id? (syntax name))
-                        (valid-bound-ids? (lambda-var-list (syntax args))))
+  (define syntax-type
+    (lambda (e r w s rib mod for-car?)
+      (cond
+       ((symbol? e)
+        (let* ((n (id-var-name e w))
+               (b (lookup n r mod))
+               (type (binding-type b)))
+          (case type
+            ((lexical) (values type (binding-value b) e w s mod))
+            ((global) (values type n e w s mod))
+            ((macro)
+             (if for-car?
+                 (values type (binding-value b) e w s mod)
+                 (syntax-type (chi-macro (binding-value b) e r w rib mod)
+                              r empty-wrap s rib mod #f)))
+            (else (values type (binding-value b) e w s mod)))))
+       ((pair? e)
+        (let ((first (car e)))
+          (call-with-values
+              (lambda () (syntax-type first r w s rib mod #t))
+            (lambda (ftype fval fe fw fs fmod)
+              (case ftype
+                ((lexical)
+                 (values 'lexical-call fval e w s mod))
+                ((global)
+                 ;; If we got here via an (@@ ...) expansion, we need to
+                 ;; make sure the fmod information is propagated back
+                 ;; correctly -- hence this consing.
+                 (values 'global-call (make-syntax-object fval w fmod)
+                         e w s mod))
+                ((macro)
+                 (syntax-type (chi-macro fval e r w rib mod)
+                              r empty-wrap s rib mod for-car?))
+                ((module-ref)
+                 (call-with-values (lambda () (fval e))
+                   (lambda (sym mod)
+                     (syntax-type sym r w s rib mod for-car?))))
+                ((core)
+                 (values 'core-form fval e w s mod))
+                ((local-syntax)
+                 (values 'local-syntax-form fval e w s mod))
+                ((begin)
+                 (values 'begin-form #f e w s mod))
+                ((eval-when)
+                 (values 'eval-when-form #f e w s mod))
+                ((define)
+                 (syntax-case e ()
+                   ((_ name val)
+                    (id? #'name)
+                    (values 'define-form #'name #'val w s mod))
+                   ((_ (name . args) e1 e2 ...)
+                    (and (id? #'name)
+                         (valid-bound-ids? (lambda-var-list #'args)))
                                         ; need lambda here...
-                   (values 'define-form (wrap (syntax name) w mod)
-                           (decorate-source
-                            (cons (syntax lambda) (wrap (syntax (args e1 e2 ...)) w mod))
-                            s)
-                           empty-wrap s mod))
-                  ((_ name)
-                   (id? (syntax name))
-                   (values 'define-form (wrap (syntax name) w mod)
-                           (syntax (if #f #f))
-                           empty-wrap s mod))))
-               ((define-syntax)
-                (syntax-case e ()
-                  ((_ name val)
-                   (id? (syntax name))
-                   (values 'define-syntax-form (syntax name)
-                           (syntax val) w s mod))))
-               (else
-                (values 'call #f e w s mod)))))))
-      ((syntax-object? e)
-       (syntax-type (syntax-object-expression e)
-                    r
-                    (join-wraps w (syntax-object-wrap e))
-                    s rib (or (syntax-object-module e) mod) for-car?))
-      ((self-evaluating? e) (values 'constant #f e w s mod))
-      (else (values 'other #f e w s mod)))))
+                    (values 'define-form (wrap #'name w mod)
+                            (decorate-source
+                             (cons #'lambda (wrap #'(args e1 e2 ...) w mod))
+                             s)
+                            empty-wrap s mod))
+                   ((_ name)
+                    (id? #'name)
+                    (values 'define-form (wrap #'name w mod)
+                            #'(if #f #f)
+                            empty-wrap s mod))))
+                ((define-syntax)
+                 (syntax-case e ()
+                   ((_ name val)
+                    (id? #'name)
+                    (values 'define-syntax-form #'name
+                            #'val w s mod))))
+                (else
+                 (values 'call #f e w s mod)))))))
+       ((syntax-object? e)
+        (syntax-type (syntax-object-expression e)
+                     r
+                     (join-wraps w (syntax-object-wrap e))
+                     s rib (or (syntax-object-module e) mod) for-car?))
+       ((self-evaluating? e) (values 'constant #f e w s mod))
+       (else (values 'other #f e w s mod)))))
 
-(define chi-top
-  (lambda (e r w m esew mod)
-    (define-syntax eval-if-c&e
-      (syntax-rules ()
-        ((_ m e mod)
-         (let ((x e))
-           (if (eq? m 'c&e) (top-level-eval-hook x mod))
-           x))))
-    (call-with-values
-      (lambda () (syntax-type e r w (source-annotation e) #f mod #f))
-      (lambda (type value e w s mod)
-        (case type
-          ((begin-form)
-           (syntax-case e ()
-             ((_) (chi-void))
-             ((_ e1 e2 ...)
-              (chi-top-sequence (syntax (e1 e2 ...)) r w s m esew mod))))
-          ((local-syntax-form)
-           (chi-local-syntax value e r w s mod
-             (lambda (body r w s mod)
-               (chi-top-sequence body r w s m esew mod))))
-          ((eval-when-form)
-           (syntax-case e ()
-             ((_ (x ...) e1 e2 ...)
-              (let ((when-list (chi-when-list e (syntax (x ...)) w))
-                    (body (syntax (e1 e2 ...))))
-                (cond
-                  ((eq? m 'e)
-                   (if (memq 'eval when-list)
-                       (chi-top-sequence body r w s 'e '(eval) mod)
-                       (chi-void)))
-                  ((memq 'load when-list)
-                   (if (or (memq 'compile when-list)
-                           (and (eq? m 'c&e) (memq 'eval when-list)))
-                       (chi-top-sequence body r w s 'c&e '(compile load) mod)
-                       (if (memq m '(c c&e))
-                           (chi-top-sequence body r w s 'c '(load) mod)
-                           (chi-void))))
-                  ((or (memq 'compile when-list)
-                       (and (eq? m 'c&e) (memq 'eval when-list)))
-                   (top-level-eval-hook
+  (define chi-top
+    (lambda (e r w m esew mod)
+      (define-syntax eval-if-c&e
+        (syntax-rules ()
+          ((_ m e mod)
+           (let ((x e))
+             (if (eq? m 'c&e) (top-level-eval-hook x mod))
+             x))))
+      (call-with-values
+          (lambda () (syntax-type e r w (source-annotation e) #f mod #f))
+        (lambda (type value e w s mod)
+          (case type
+            ((begin-form)
+             (syntax-case e ()
+               ((_) (chi-void))
+               ((_ e1 e2 ...)
+                (chi-top-sequence #'(e1 e2 ...) r w s m esew mod))))
+            ((local-syntax-form)
+             (chi-local-syntax value e r w s mod
+                               (lambda (body r w s mod)
+                                 (chi-top-sequence body r w s m esew mod))))
+            ((eval-when-form)
+             (syntax-case e ()
+               ((_ (x ...) e1 e2 ...)
+                (let ((when-list (chi-when-list e #'(x ...) w))
+                      (body #'(e1 e2 ...)))
+                  (cond
+                   ((eq? m 'e)
+                    (if (memq 'eval when-list)
+                        (chi-top-sequence body r w s 'e '(eval) mod)
+                        (chi-void)))
+                   ((memq 'load when-list)
+                    (if (or (memq 'compile when-list)
+                            (and (eq? m 'c&e) (memq 'eval when-list)))
+                        (chi-top-sequence body r w s 'c&e '(compile load) mod)
+                        (if (memq m '(c c&e))
+                            (chi-top-sequence body r w s 'c '(load) mod)
+                            (chi-void))))
+                   ((or (memq 'compile when-list)
+                        (and (eq? m 'c&e) (memq 'eval when-list)))
+                    (top-level-eval-hook
                      (chi-top-sequence body r w s 'e '(eval) mod)
                      mod)
-                   (chi-void))
-                  (else (chi-void)))))))
-          ((define-syntax-form)
-           (let ((n (id-var-name value w)) (r (macros-only-env r)))
-             (case m
-               ((c)
-                (if (memq 'compile esew)
-                    (let ((e (chi-install-global n (chi e r w mod))))
-                      (top-level-eval-hook e mod)
-                      (if (memq 'load esew) e (chi-void)))
-                    (if (memq 'load esew)
-                        (chi-install-global n (chi e r w mod))
-                        (chi-void))))
-               ((c&e)
-                (let ((e (chi-install-global n (chi e r w mod))))
-                  (top-level-eval-hook e mod)
-                  e))
-               (else
-                (if (memq 'eval esew)
-                    (top-level-eval-hook
-                      (chi-install-global n (chi e r w mod))
-                      mod))
-                (chi-void)))))
-          ((define-form)
-           (let* ((n (id-var-name value w))
-		  (type (binding-type (lookup n r mod))))
-             (case type
-               ((global core macro module-ref)
-                ;; affect compile-time environment (once we have booted)
-                (if (and (not (module-local-variable (current-module) n))
-                         (current-module))
-                    (let ((old (module-variable (current-module) n)))
-                      ;; use value of the same-named imported variable, if
-                      ;; any
-                      (module-define! (current-module) n
-                                      (if (variable? old)
-                                          (variable-ref old)
-                                          #f))))
-                (eval-if-c&e m
-                  (build-global-definition s n (chi e r w mod))
-                  mod))
-               ((displaced-lexical)
-                (syntax-violation #f "identifier out of context"
-                                  e (wrap value w mod)))
-               (else
-                (syntax-violation #f "cannot define keyword at top level"
-                                  e (wrap value w mod))))))
-          (else (eval-if-c&e m (chi-expr type value e r w s mod) mod)))))))
+                    (chi-void))
+                   (else (chi-void)))))))
+            ((define-syntax-form)
+             (let ((n (id-var-name value w)) (r (macros-only-env r)))
+               (case m
+                 ((c)
+                  (if (memq 'compile esew)
+                      (let ((e (chi-install-global n (chi e r w mod))))
+                        (top-level-eval-hook e mod)
+                        (if (memq 'load esew) e (chi-void)))
+                      (if (memq 'load esew)
+                          (chi-install-global n (chi e r w mod))
+                          (chi-void))))
+                 ((c&e)
+                  (let ((e (chi-install-global n (chi e r w mod))))
+                    (top-level-eval-hook e mod)
+                    e))
+                 (else
+                  (if (memq 'eval esew)
+                      (top-level-eval-hook
+                       (chi-install-global n (chi e r w mod))
+                       mod))
+                  (chi-void)))))
+            ((define-form)
+             (let* ((n (id-var-name value w))
+                    (type (binding-type (lookup n r mod))))
+               (case type
+                 ((global core macro module-ref)
+                  ;; affect compile-time environment (once we have booted)
+                  (if (and (not (module-local-variable (current-module) n))
+                           (current-module))
+                      (let ((old (module-variable (current-module) n)))
+                        ;; use value of the same-named imported variable, if
+                        ;; any
+                        (module-define! (current-module) n
+                                        (if (variable? old)
+                                            (variable-ref old)
+                                            #f))))
+                  (eval-if-c&e m
+                               (build-global-definition s n (chi e r w mod))
+                               mod))
+                 ((displaced-lexical)
+                  (syntax-violation #f "identifier out of context"
+                                    e (wrap value w mod)))
+                 (else
+                  (syntax-violation #f "cannot define keyword at top level"
+                                    e (wrap value w mod))))))
+            (else (eval-if-c&e m (chi-expr type value e r w s mod) mod)))))))
 
-(define chi
-  (lambda (e r w mod)
-    (call-with-values
-      (lambda () (syntax-type e r w (source-annotation e) #f mod #f))
-      (lambda (type value e w s mod)
-        (chi-expr type value e r w s mod)))))
+  (define chi
+    (lambda (e r w mod)
+      (call-with-values
+          (lambda () (syntax-type e r w (source-annotation e) #f mod #f))
+        (lambda (type value e w s mod)
+          (chi-expr type value e r w s mod)))))
 
-(define chi-expr
-  (lambda (type value e r w s mod)
-    (case type
-      ((lexical)
-       (build-lexical-reference 'value s e value))
-      ((core core-form)
-       ;; apply transformer
-       (value e r w s mod))
-      ((module-ref)
-       (call-with-values (lambda () (value e))
-         ;; we could add a public? arg here
-         (lambda (id mod) (build-global-reference s id mod))))
-      ((lexical-call)
-       (chi-application
-         (build-lexical-reference 'fun (source-annotation (car e))
-                                  (car e) value)
-         e r w s mod))
-      ((global-call)
-       (chi-application
-         (build-global-reference (source-annotation (car e))
-                                 (if (syntax-object? value)
-                                     (syntax-object-expression value)
-                                     value)
-                                 (if (syntax-object? value)
-                                     (syntax-object-module value)
-                                     mod))
-         e r w s mod))
-      ((constant) (build-data s (strip (source-wrap e w s mod) empty-wrap)))
-      ((global) (build-global-reference s value mod))
-      ((call) (chi-application (chi (car e) r w mod) e r w s mod))
-      ((begin-form)
-       (syntax-case e ()
-         ((_ e1 e2 ...) (chi-sequence (syntax (e1 e2 ...)) r w s mod))))
-      ((local-syntax-form)
-       (chi-local-syntax value e r w s mod chi-sequence))
-      ((eval-when-form)
-       (syntax-case e ()
-         ((_ (x ...) e1 e2 ...)
-          (let ((when-list (chi-when-list e (syntax (x ...)) w)))
-            (if (memq 'eval when-list)
-                (chi-sequence (syntax (e1 e2 ...)) r w s mod)
-                (chi-void))))))
-      ((define-form define-syntax-form)
-       (syntax-violation #f "definition in expression context"
-                         e (wrap value w mod)))
-      ((syntax)
-       (syntax-violation #f "reference to pattern variable outside syntax form"
-                         (source-wrap e w s mod)))
-      ((displaced-lexical)
-       (syntax-violation #f "reference to identifier outside its scope"
-                          (source-wrap e w s mod)))
-      (else (syntax-violation #f "unexpected syntax"
-                              (source-wrap e w s mod))))))
+  (define chi-expr
+    (lambda (type value e r w s mod)
+      (case type
+        ((lexical)
+         (build-lexical-reference 'value s e value))
+        ((core core-form)
+         ;; apply transformer
+         (value e r w s mod))
+        ((module-ref)
+         (call-with-values (lambda () (value e))
+           ;; we could add a public? arg here
+           (lambda (id mod) (build-global-reference s id mod))))
+        ((lexical-call)
+         (chi-application
+          (build-lexical-reference 'fun (source-annotation (car e))
+                                   (car e) value)
+          e r w s mod))
+        ((global-call)
+         (chi-application
+          (build-global-reference (source-annotation (car e))
+                                  (if (syntax-object? value)
+                                      (syntax-object-expression value)
+                                      value)
+                                  (if (syntax-object? value)
+                                      (syntax-object-module value)
+                                      mod))
+          e r w s mod))
+        ((constant) (build-data s (strip (source-wrap e w s mod) empty-wrap)))
+        ((global) (build-global-reference s value mod))
+        ((call) (chi-application (chi (car e) r w mod) e r w s mod))
+        ((begin-form)
+         (syntax-case e ()
+           ((_ e1 e2 ...) (chi-sequence #'(e1 e2 ...) r w s mod))))
+        ((local-syntax-form)
+         (chi-local-syntax value e r w s mod chi-sequence))
+        ((eval-when-form)
+         (syntax-case e ()
+           ((_ (x ...) e1 e2 ...)
+            (let ((when-list (chi-when-list e #'(x ...) w)))
+              (if (memq 'eval when-list)
+                  (chi-sequence #'(e1 e2 ...) r w s mod)
+                  (chi-void))))))
+        ((define-form define-syntax-form)
+         (syntax-violation #f "definition in expression context"
+                           e (wrap value w mod)))
+        ((syntax)
+         (syntax-violation #f "reference to pattern variable outside syntax form"
+                           (source-wrap e w s mod)))
+        ((displaced-lexical)
+         (syntax-violation #f "reference to identifier outside its scope"
+                           (source-wrap e w s mod)))
+        (else (syntax-violation #f "unexpected syntax"
+                                (source-wrap e w s mod))))))
 
-(define chi-application
-  (lambda (x e r w s mod)
-    (syntax-case e ()
-      ((e0 e1 ...)
-       (build-application s x
-         (map (lambda (e) (chi e r w mod)) (syntax (e1 ...))))))))
+  (define chi-application
+    (lambda (x e r w s mod)
+      (syntax-case e ()
+        ((e0 e1 ...)
+         (build-application s x
+                            (map (lambda (e) (chi e r w mod)) #'(e1 ...)))))))
 
-(define chi-macro
-  (lambda (p e r w rib mod)
-    (define rebuild-macro-output
-      (lambda (x m)
-        (cond ((pair? x)
-               (cons (rebuild-macro-output (car x) m)
-                     (rebuild-macro-output (cdr x) m)))
-              ((syntax-object? x)
-               (let ((w (syntax-object-wrap x)))
-                 (let ((ms (wrap-marks w)) (s (wrap-subst w)))
-                   (if (and (pair? ms) (eq? (car ms) the-anti-mark))
-                       ;; output is from original text
-                       (make-syntax-object
-                        (syntax-object-expression x)
-                        (make-wrap (cdr ms) (if rib (cons rib (cdr s)) (cdr s)))
-                        (syntax-object-module x))
-                       ;; output introduced by macro
-                       (make-syntax-object
-                        (syntax-object-expression x)
-                        (make-wrap (cons m ms)
-                                   (if rib
-                                       (cons rib (cons 'shift s))
-                                       (cons 'shift s)))
-                        (let ((pmod (procedure-module p)))
-                          (if pmod
-                              ;; hither the hygiene
-                              (cons 'hygiene (module-name pmod))
-                              ;; but it's possible for the proc to have
-                              ;; no mod, if it was made before modules
-                              ;; were booted
-                              '(hygiene guile))))))))
-              ((vector? x)
-               (let* ((n (vector-length x)) (v (make-vector n)))
-                 (do ((i 0 (fx+ i 1)))
-                     ((fx= i n) v)
+  (define chi-macro
+    (lambda (p e r w rib mod)
+      (define rebuild-macro-output
+        (lambda (x m)
+          (cond ((pair? x)
+                 (cons (rebuild-macro-output (car x) m)
+                       (rebuild-macro-output (cdr x) m)))
+                ((syntax-object? x)
+                 (let ((w (syntax-object-wrap x)))
+                   (let ((ms (wrap-marks w)) (s (wrap-subst w)))
+                     (if (and (pair? ms) (eq? (car ms) the-anti-mark))
+                         ;; output is from original text
+                         (make-syntax-object
+                          (syntax-object-expression x)
+                          (make-wrap (cdr ms) (if rib (cons rib (cdr s)) (cdr s)))
+                          (syntax-object-module x))
+                         ;; output introduced by macro
+                         (make-syntax-object
+                          (syntax-object-expression x)
+                          (make-wrap (cons m ms)
+                                     (if rib
+                                         (cons rib (cons 'shift s))
+                                         (cons 'shift s)))
+                          (let ((pmod (procedure-module p)))
+                            (if pmod
+                                ;; hither the hygiene
+                                (cons 'hygiene (module-name pmod))
+                                ;; but it's possible for the proc to have
+                                ;; no mod, if it was made before modules
+                                ;; were booted
+                                '(hygiene guile))))))))
+                ((vector? x)
+                 (let* ((n (vector-length x)) (v (make-vector n)))
+                   (do ((i 0 (fx+ i 1)))
+                       ((fx= i n) v)
                      (vector-set! v i
-                       (rebuild-macro-output (vector-ref x i) m)))))
-              ((symbol? x)
-               (syntax-violation #f "encountered raw symbol in macro output"
-                                 (source-wrap e w (wrap-subst w) mod) x))
-              (else x))))
-    (rebuild-macro-output (p (wrap e (anti-mark w) mod)) (new-mark))))
+                                  (rebuild-macro-output (vector-ref x i) m)))))
+                ((symbol? x)
+                 (syntax-violation #f "encountered raw symbol in macro output"
+                                   (source-wrap e w (wrap-subst w) mod) x))
+                (else x))))
+      (rebuild-macro-output (p (wrap e (anti-mark w) mod)) (new-mark))))
 
-(define chi-body
-  ;; In processing the forms of the body, we create a new, empty wrap.
-  ;; This wrap is augmented (destructively) each time we discover that
-  ;; the next form is a definition.  This is done:
-  ;;
-  ;;   (1) to allow the first nondefinition form to be a call to
-  ;;       one of the defined ids even if the id previously denoted a
-  ;;       definition keyword or keyword for a macro expanding into a
-  ;;       definition;
-  ;;   (2) to prevent subsequent definition forms (but unfortunately
-  ;;       not earlier ones) and the first nondefinition form from
-  ;;       confusing one of the bound identifiers for an auxiliary
-  ;;       keyword; and
-  ;;   (3) so that we do not need to restart the expansion of the
-  ;;       first nondefinition form, which is problematic anyway
-  ;;       since it might be the first element of a begin that we
-  ;;       have just spliced into the body (meaning if we restarted,
-  ;;       we'd really need to restart with the begin or the macro
-  ;;       call that expanded into the begin, and we'd have to give
-  ;;       up allowing (begin <defn>+ <expr>+), which is itself
-  ;;       problematic since we don't know if a begin contains only
-  ;;       definitions until we've expanded it).
-  ;;
-  ;; Before processing the body, we also create a new environment
-  ;; containing a placeholder for the bindings we will add later and
-  ;; associate this environment with each form.  In processing a
-  ;; let-syntax or letrec-syntax, the associated environment may be
-  ;; augmented with local keyword bindings, so the environment may
-  ;; be different for different forms in the body.  Once we have
-  ;; gathered up all of the definitions, we evaluate the transformer
-  ;; expressions and splice into r at the placeholder the new variable
-  ;; and keyword bindings.  This allows let-syntax or letrec-syntax
-  ;; forms local to a portion or all of the body to shadow the
-  ;; definition bindings.
-  ;;
-  ;; Subforms of a begin, let-syntax, or letrec-syntax are spliced
-  ;; into the body.
-  ;;
-  ;; outer-form is fully wrapped w/source
-  (lambda (body outer-form r w mod)
-    (let* ((r (cons '("placeholder" . (placeholder)) r))
-           (ribcage (make-empty-ribcage))
-           (w (make-wrap (wrap-marks w) (cons ribcage (wrap-subst w)))))
-      (let parse ((body (map (lambda (x) (cons r (wrap x w mod))) body))
-                  (ids '()) (labels '())
-                  (var-ids '()) (vars '()) (vals '()) (bindings '()))
-        (if (null? body)
-            (syntax-violation #f "no expressions in body" outer-form)
-            (let ((e (cdar body)) (er (caar body)))
-              (call-with-values
-                (lambda () (syntax-type e er empty-wrap (source-annotation er) ribcage mod #f))
-                (lambda (type value e w s mod)
-                  (case type
-                    ((define-form)
-                     (let ((id (wrap value w mod)) (label (gen-label)))
-                       (let ((var (gen-var id)))
+  (define chi-body
+    ;; In processing the forms of the body, we create a new, empty wrap.
+    ;; This wrap is augmented (destructively) each time we discover that
+    ;; the next form is a definition.  This is done:
+    ;;
+    ;;   (1) to allow the first nondefinition form to be a call to
+    ;;       one of the defined ids even if the id previously denoted a
+    ;;       definition keyword or keyword for a macro expanding into a
+    ;;       definition;
+    ;;   (2) to prevent subsequent definition forms (but unfortunately
+    ;;       not earlier ones) and the first nondefinition form from
+    ;;       confusing one of the bound identifiers for an auxiliary
+    ;;       keyword; and
+    ;;   (3) so that we do not need to restart the expansion of the
+    ;;       first nondefinition form, which is problematic anyway
+    ;;       since it might be the first element of a begin that we
+    ;;       have just spliced into the body (meaning if we restarted,
+    ;;       we'd really need to restart with the begin or the macro
+    ;;       call that expanded into the begin, and we'd have to give
+    ;;       up allowing (begin <defn>+ <expr>+), which is itself
+    ;;       problematic since we don't know if a begin contains only
+    ;;       definitions until we've expanded it).
+    ;;
+    ;; Before processing the body, we also create a new environment
+    ;; containing a placeholder for the bindings we will add later and
+    ;; associate this environment with each form.  In processing a
+    ;; let-syntax or letrec-syntax, the associated environment may be
+    ;; augmented with local keyword bindings, so the environment may
+    ;; be different for different forms in the body.  Once we have
+    ;; gathered up all of the definitions, we evaluate the transformer
+    ;; expressions and splice into r at the placeholder the new variable
+    ;; and keyword bindings.  This allows let-syntax or letrec-syntax
+    ;; forms local to a portion or all of the body to shadow the
+    ;; definition bindings.
+    ;;
+    ;; Subforms of a begin, let-syntax, or letrec-syntax are spliced
+    ;; into the body.
+    ;;
+    ;; outer-form is fully wrapped w/source
+    (lambda (body outer-form r w mod)
+      (let* ((r (cons '("placeholder" . (placeholder)) r))
+             (ribcage (make-empty-ribcage))
+             (w (make-wrap (wrap-marks w) (cons ribcage (wrap-subst w)))))
+        (let parse ((body (map (lambda (x) (cons r (wrap x w mod))) body))
+                    (ids '()) (labels '())
+                    (var-ids '()) (vars '()) (vals '()) (bindings '()))
+          (if (null? body)
+              (syntax-violation #f "no expressions in body" outer-form)
+              (let ((e (cdar body)) (er (caar body)))
+                (call-with-values
+                    (lambda () (syntax-type e er empty-wrap (source-annotation er) ribcage mod #f))
+                  (lambda (type value e w s mod)
+                    (case type
+                      ((define-form)
+                       (let ((id (wrap value w mod)) (label (gen-label)))
+                         (let ((var (gen-var id)))
+                           (extend-ribcage! ribcage id label)
+                           (parse (cdr body)
+                                  (cons id ids) (cons label labels)
+                                  (cons id var-ids)
+                                  (cons var vars) (cons (cons er (wrap e w mod)) vals)
+                                  (cons (make-binding 'lexical var) bindings)))))
+                      ((define-syntax-form)
+                       (let ((id (wrap value w mod)) (label (gen-label)))
                          (extend-ribcage! ribcage id label)
                          (parse (cdr body)
-                           (cons id ids) (cons label labels)
-                           (cons id var-ids)
-                           (cons var vars) (cons (cons er (wrap e w mod)) vals)
-                           (cons (make-binding 'lexical var) bindings)))))
-                    ((define-syntax-form)
-                     (let ((id (wrap value w mod)) (label (gen-label)))
-                       (extend-ribcage! ribcage id label)
-                       (parse (cdr body)
-                         (cons id ids) (cons label labels)
-                         var-ids vars vals
-                         (cons (make-binding 'macro (cons er (wrap e w mod)))
-                               bindings))))
-                    ((begin-form)
-                     (syntax-case e ()
-                       ((_ e1 ...)
-                        (parse (let f ((forms (syntax (e1 ...))))
-                                 (if (null? forms)
-                                     (cdr body)
-                                     (cons (cons er (wrap (car forms) w mod))
-                                           (f (cdr forms)))))
-                          ids labels var-ids vars vals bindings))))
-                    ((local-syntax-form)
-                     (chi-local-syntax value e er w s mod
-                       (lambda (forms er w s mod)
-                         (parse (let f ((forms forms))
-                                  (if (null? forms)
-                                      (cdr body)
-                                      (cons (cons er (wrap (car forms) w mod))
-                                            (f (cdr forms)))))
-                           ids labels var-ids vars vals bindings))))
-                    (else ; found a non-definition
-                     (if (null? ids)
-                         (build-sequence no-source
-                           (map (lambda (x)
-                                  (chi (cdr x) (car x) empty-wrap mod))
-                                (cons (cons er (source-wrap e w s mod))
-                                      (cdr body))))
-                         (begin
-                           (if (not (valid-bound-ids? ids))
-                               (syntax-violation
-                                #f "invalid or duplicate identifier in definition"
-                                outer-form))
-                           (let loop ((bs bindings) (er-cache #f) (r-cache #f))
-                             (if (not (null? bs))
-                                 (let* ((b (car bs)))
-                                   (if (eq? (car b) 'macro)
-                                       (let* ((er (cadr b))
-                                              (r-cache
-                                                (if (eq? er er-cache)
-                                                    r-cache
-                                                    (macros-only-env er))))
-                                         (set-cdr! b
-                                           (eval-local-transformer
-                                             (chi (cddr b) r-cache empty-wrap mod)
-                                             mod))
-                                         (loop (cdr bs) er r-cache))
-                                       (loop (cdr bs) er-cache r-cache)))))
-                           (set-cdr! r (extend-env labels bindings (cdr r)))
-                           (build-letrec no-source
-                             (map syntax->datum var-ids)
-                             vars
-                             (map (lambda (x)
-                                    (chi (cdr x) (car x) empty-wrap mod))
-                                  vals)
-                             (build-sequence no-source
-                               (map (lambda (x)
-                                      (chi (cdr x) (car x) empty-wrap mod))
-                                    (cons (cons er (source-wrap e w s mod))
-                                          (cdr body)))))))))))))))))
+                                (cons id ids) (cons label labels)
+                                var-ids vars vals
+                                (cons (make-binding 'macro (cons er (wrap e w mod)))
+                                      bindings))))
+                      ((begin-form)
+                       (syntax-case e ()
+                         ((_ e1 ...)
+                          (parse (let f ((forms #'(e1 ...)))
+                                   (if (null? forms)
+                                       (cdr body)
+                                       (cons (cons er (wrap (car forms) w mod))
+                                             (f (cdr forms)))))
+                                 ids labels var-ids vars vals bindings))))
+                      ((local-syntax-form)
+                       (chi-local-syntax value e er w s mod
+                                         (lambda (forms er w s mod)
+                                           (parse (let f ((forms forms))
+                                                    (if (null? forms)
+                                                        (cdr body)
+                                                        (cons (cons er (wrap (car forms) w mod))
+                                                              (f (cdr forms)))))
+                                                  ids labels var-ids vars vals bindings))))
+                      (else             ; found a non-definition
+                       (if (null? ids)
+                           (build-sequence no-source
+                                           (map (lambda (x)
+                                                  (chi (cdr x) (car x) empty-wrap mod))
+                                                (cons (cons er (source-wrap e w s mod))
+                                                      (cdr body))))
+                           (begin
+                             (if (not (valid-bound-ids? ids))
+                                 (syntax-violation
+                                  #f "invalid or duplicate identifier in definition"
+                                  outer-form))
+                             (let loop ((bs bindings) (er-cache #f) (r-cache #f))
+                               (if (not (null? bs))
+                                   (let* ((b (car bs)))
+                                     (if (eq? (car b) 'macro)
+                                         (let* ((er (cadr b))
+                                                (r-cache
+                                                 (if (eq? er er-cache)
+                                                     r-cache
+                                                     (macros-only-env er))))
+                                           (set-cdr! b
+                                                     (eval-local-transformer
+                                                      (chi (cddr b) r-cache empty-wrap mod)
+                                                      mod))
+                                           (loop (cdr bs) er r-cache))
+                                         (loop (cdr bs) er-cache r-cache)))))
+                             (set-cdr! r (extend-env labels bindings (cdr r)))
+                             (build-letrec no-source
+                                           (map syntax->datum var-ids)
+                                           vars
+                                           (map (lambda (x)
+                                                  (chi (cdr x) (car x) empty-wrap mod))
+                                                vals)
+                                           (build-sequence no-source
+                                                           (map (lambda (x)
+                                                                  (chi (cdr x) (car x) empty-wrap mod))
+                                                                (cons (cons er (source-wrap e w s mod))
+                                                                      (cdr body)))))))))))))))))
 
-(define chi-local-syntax
-  (lambda (rec? e r w s mod k)
-    (syntax-case e ()
-      ((_ ((id val) ...) e1 e2 ...)
-       (let ((ids (syntax (id ...))))
-         (if (not (valid-bound-ids? ids))
-             (syntax-violation #f "duplicate bound keyword" e)
-             (let ((labels (gen-labels ids)))
-               (let ((new-w (make-binding-wrap ids labels w)))
-                 (k (syntax (e1 e2 ...))
-                    (extend-env
-                      labels
-                      (let ((w (if rec? new-w w))
-                            (trans-r (macros-only-env r)))
-                        (map (lambda (x)
-                               (make-binding 'macro
-                                 (eval-local-transformer
-                                  (chi x trans-r w mod)
-                                  mod)))
-                             (syntax (val ...))))
-                      r)
-                    new-w
-                    s
-                    mod))))))
-      (_ (syntax-violation #f "bad local syntax definition"
-                           (source-wrap e w s mod))))))
+  (define chi-local-syntax
+    (lambda (rec? e r w s mod k)
+      (syntax-case e ()
+        ((_ ((id val) ...) e1 e2 ...)
+         (let ((ids #'(id ...)))
+           (if (not (valid-bound-ids? ids))
+               (syntax-violation #f "duplicate bound keyword" e)
+               (let ((labels (gen-labels ids)))
+                 (let ((new-w (make-binding-wrap ids labels w)))
+                   (k #'(e1 e2 ...)
+                      (extend-env
+                       labels
+                       (let ((w (if rec? new-w w))
+                             (trans-r (macros-only-env r)))
+                         (map (lambda (x)
+                                (make-binding 'macro
+                                              (eval-local-transformer
+                                               (chi x trans-r w mod)
+                                               mod)))
+                              #'(val ...)))
+                       r)
+                      new-w
+                      s
+                      mod))))))
+        (_ (syntax-violation #f "bad local syntax definition"
+                             (source-wrap e w s mod))))))
 
-(define eval-local-transformer
-  (lambda (expanded mod)
-    (let ((p (local-eval-hook expanded mod)))
-      (if (procedure? p)
-          p
-          (syntax-violation #f "nonprocedure transformer" p)))))
+  (define eval-local-transformer
+    (lambda (expanded mod)
+      (let ((p (local-eval-hook expanded mod)))
+        (if (procedure? p)
+            p
+            (syntax-violation #f "nonprocedure transformer" p)))))
 
-(define chi-void
-  (lambda ()
-    (build-void no-source)))
+  (define chi-void
+    (lambda ()
+      (build-void no-source)))
 
-(define ellipsis?
-  (lambda (x)
-    (and (nonsymbol-id? x)
-         (free-id=? x (syntax (... ...))))))
+  (define ellipsis?
+    (lambda (x)
+      (and (nonsymbol-id? x)
+           (free-id=? x #'(... ...)))))
 
-(define lambda-formals
-  (lambda (orig-args)
-    (define (req args rreq)
-      (syntax-case args ()
-        (()
-         (check (reverse rreq) #f))
-        ((a . b) (id? #'a)
-         (req #'b (cons #'a rreq)))
-        (r (id? #'r)
-           (check (reverse rreq) #'r))
-        (else
-         (syntax-violation 'lambda "invalid argument list" orig-args args))))
-    (define (check req rest)
-      (cond
-       ((distinct-bound-ids? (if rest (cons rest req) req))
-        (values req #f rest #f #f))
-       (else
-        (syntax-violation 'lambda "duplicate identifier in argument list"
-                          orig-args))))
-    (req orig-args '())))
+  (define lambda-formals
+    (lambda (orig-args)
+      (define (req args rreq)
+        (syntax-case args ()
+          (()
+           (check (reverse rreq) #f))
+          ((a . b) (id? #'a)
+           (req #'b (cons #'a rreq)))
+          (r (id? #'r)
+             (check (reverse rreq) #'r))
+          (else
+           (syntax-violation 'lambda "invalid argument list" orig-args args))))
+      (define (check req rest)
+        (cond
+         ((distinct-bound-ids? (if rest (cons rest req) req))
+          (values req #f rest #f #f))
+         (else
+          (syntax-violation 'lambda "duplicate identifier in argument list"
+                            orig-args))))
+      (req orig-args '())))
 
-(define chi-simple-lambda
-  (lambda (e r w s mod req rest docstring body)
-    (let* ((ids (if rest (append req (list rest)) req))
-           (vars (map gen-var ids))
-           (labels (gen-labels ids)))
-      (build-simple-lambda
-       s
-       (map syntax->datum req) (and rest (syntax->datum rest)) vars
-       docstring
-       (chi-body body (source-wrap e w s mod)
-                 (extend-var-env labels vars r)
-                 (make-binding-wrap ids labels w)
-                 mod)))))
+  (define chi-simple-lambda
+    (lambda (e r w s mod req rest docstring body)
+      (let* ((ids (if rest (append req (list rest)) req))
+             (vars (map gen-var ids))
+             (labels (gen-labels ids)))
+        (build-simple-lambda
+         s
+         (map syntax->datum req) (and rest (syntax->datum rest)) vars
+         docstring
+         (chi-body body (source-wrap e w s mod)
+                   (extend-var-env labels vars r)
+                   (make-binding-wrap ids labels w)
+                   mod)))))
 
-(define lambda*-formals
-  (lambda (orig-args)
-    (define (req args rreq)
-      (syntax-case args ()
-        (()
-         (check (reverse rreq) '() #f '() #f))
-        ((a . b) (id? #'a)
-         (req #'b (cons #'a rreq)))
-        ((a . b) (eq? (syntax->datum #'a) #:optional)
-         (opt #'b (reverse rreq) '()))
-        ((a . b) (eq? (syntax->datum #'a) #:key)
-         (key #'b (reverse rreq) '() '()))
-        ((a . b) (eq? (syntax->datum #'a) #:predicate)
-         (pred #'b (reverse rreq) '() '()))
-        ((a b) (eq? (syntax->datum #'a) #:rest)
-         (rest #'b (reverse rreq) '() '() #f))
-        (r (id? #'r)
-           (rest #'r (reverse rreq) '() '() #f))
-        (else
-         (syntax-violation 'lambda* "invalid argument list" orig-args args))))
-    (define (opt args req ropt)
-      (syntax-case args ()
-        (()
-         (check req (reverse ropt) #f '() #f))
-        ((a . b) (id? #'a)
-         (opt #'b req (cons #'(a #f) ropt)))
-        (((a init) . b) (id? #'a)
-         (opt #'b req (cons #'(a init) ropt)))
-        ((a . b) (eq? (syntax->datum #'a) #:key)
-         (key #'b req (reverse ropt) '()))
-        ((a . b) (eq? (syntax->datum #'a) #:predicate)
-         (pred #'b req (reverse ropt) '()))
-        ((a b) (eq? (syntax->datum #'a) #:rest)
-         (rest #'b req (reverse ropt) '() #f))
-        (r (id? #'r)
-           (rest #'r req (reverse ropt) '() #f))
-        (else
-         (syntax-violation 'lambda* "invalid optional argument list"
-                           orig-args args))))
-    (define (key args req opt rkey)
-      (syntax-case args ()
-        (()
-         (check req opt #f (cons #f (reverse rkey)) #f))
-        ((a . b) (id? #'a)
-         (with-syntax ((k (symbol->keyword (syntax->datum #'a))))
-           (key #'b req opt (cons #'(k a #f) rkey))))
-        (((a init) . b) (id? #'a)
-         (with-syntax ((k (symbol->keyword (syntax->datum #'a))))
-           (key #'b req opt (cons #'(k a init) rkey))))
-        (((a init k) . b) (and (id? #'a)
-                               (keyword? (syntax->datum #'k)))
-         (key #'b req opt (cons #'(k a init) rkey)))
-        ((aok) (eq? (syntax->datum #'aok) #:allow-other-keys)
-         (check req opt #f (cons #t (reverse rkey)) #f))
-        ((aok a . b) (and (eq? (syntax->datum #'aok) #:allow-other-keys)
-                          (eq? (syntax->datum #'a) #:predicate))
-         (pred #'b req opt (cons #t (reverse rkey))))
-        ((aok a b) (and (eq? (syntax->datum #'aok) #:allow-other-keys)
-                        (eq? (syntax->datum #'a) #:rest))
-         (rest #'b req opt (cons #t (reverse rkey)) #f))
-        ((aok . r) (and (eq? (syntax->datum #'aok) #:allow-other-keys)
-                        (id? #'r))
-         (rest #'r req opt (cons #t (reverse rkey)) #f))
-        ((a . b) (eq? (syntax->datum #'a) #:predicate)
-         (pred #'b req opt (cons #f (reverse rkey))))
-        ((a b) (eq? (syntax->datum #'a) #:rest)
-         (rest #'b req opt (cons #f (reverse rkey)) #f))
-        (r (id? #'r)
-           (rest #'r req opt (cons #f (reverse rkey)) #f))
-        (else
-         (syntax-violation 'lambda* "invalid keyword argument list"
-                           orig-args args))))
-    (define (pred args req opt kw)
-      (syntax-case args ()
-        ((x) (check req opt #f kw #'x))
-        ((x a b) (eq? (syntax->datum #'a) #:rest)
-         (rest #'b req opt kw #f))
-        ((x . b) (id? #'b)
-         (rest #'b req opt kw #f))
-        (else
-         (syntax-violation 'lambda* "invalid argument list following #:predicate"
-                           orig-args args))))
-    (define (rest args req opt kw pred)
-      (syntax-case args ()
-        (r (id? #'r)
-           (check req opt #'r kw pred))
-        (else
-         (syntax-violation 'lambda* "invalid rest argument"
-                           orig-args args))))
-    (define (check req opt rest kw pred)
-      (cond
-       ((distinct-bound-ids?
-         (append req (map car opt) (if rest (list rest) '())
-                 (if (pair? kw) (map cadr (cdr kw)) '())))
-        (values req opt rest kw pred))
-       (else
-        (syntax-violation 'lambda* "duplicate identifier in argument list"
-                          orig-args))))
-    (req orig-args '())))
+  (define lambda*-formals
+    (lambda (orig-args)
+      (define (req args rreq)
+        (syntax-case args ()
+          (()
+           (check (reverse rreq) '() #f '() #f))
+          ((a . b) (id? #'a)
+           (req #'b (cons #'a rreq)))
+          ((a . b) (eq? (syntax->datum #'a) #:optional)
+           (opt #'b (reverse rreq) '()))
+          ((a . b) (eq? (syntax->datum #'a) #:key)
+           (key #'b (reverse rreq) '() '()))
+          ((a . b) (eq? (syntax->datum #'a) #:predicate)
+           (pred #'b (reverse rreq) '() '()))
+          ((a b) (eq? (syntax->datum #'a) #:rest)
+           (rest #'b (reverse rreq) '() '() #f))
+          (r (id? #'r)
+             (rest #'r (reverse rreq) '() '() #f))
+          (else
+           (syntax-violation 'lambda* "invalid argument list" orig-args args))))
+      (define (opt args req ropt)
+        (syntax-case args ()
+          (()
+           (check req (reverse ropt) #f '() #f))
+          ((a . b) (id? #'a)
+           (opt #'b req (cons #'(a #f) ropt)))
+          (((a init) . b) (id? #'a)
+           (opt #'b req (cons #'(a init) ropt)))
+          ((a . b) (eq? (syntax->datum #'a) #:key)
+           (key #'b req (reverse ropt) '()))
+          ((a . b) (eq? (syntax->datum #'a) #:predicate)
+           (pred #'b req (reverse ropt) '()))
+          ((a b) (eq? (syntax->datum #'a) #:rest)
+           (rest #'b req (reverse ropt) '() #f))
+          (r (id? #'r)
+             (rest #'r req (reverse ropt) '() #f))
+          (else
+           (syntax-violation 'lambda* "invalid optional argument list"
+                             orig-args args))))
+      (define (key args req opt rkey)
+        (syntax-case args ()
+          (()
+           (check req opt #f (cons #f (reverse rkey)) #f))
+          ((a . b) (id? #'a)
+           (with-syntax ((k (symbol->keyword (syntax->datum #'a))))
+             (key #'b req opt (cons #'(k a #f) rkey))))
+          (((a init) . b) (id? #'a)
+           (with-syntax ((k (symbol->keyword (syntax->datum #'a))))
+             (key #'b req opt (cons #'(k a init) rkey))))
+          (((a init k) . b) (and (id? #'a)
+                                 (keyword? (syntax->datum #'k)))
+           (key #'b req opt (cons #'(k a init) rkey)))
+          ((aok) (eq? (syntax->datum #'aok) #:allow-other-keys)
+           (check req opt #f (cons #t (reverse rkey)) #f))
+          ((aok a . b) (and (eq? (syntax->datum #'aok) #:allow-other-keys)
+                            (eq? (syntax->datum #'a) #:predicate))
+           (pred #'b req opt (cons #t (reverse rkey))))
+          ((aok a b) (and (eq? (syntax->datum #'aok) #:allow-other-keys)
+                          (eq? (syntax->datum #'a) #:rest))
+           (rest #'b req opt (cons #t (reverse rkey)) #f))
+          ((aok . r) (and (eq? (syntax->datum #'aok) #:allow-other-keys)
+                          (id? #'r))
+           (rest #'r req opt (cons #t (reverse rkey)) #f))
+          ((a . b) (eq? (syntax->datum #'a) #:predicate)
+           (pred #'b req opt (cons #f (reverse rkey))))
+          ((a b) (eq? (syntax->datum #'a) #:rest)
+           (rest #'b req opt (cons #f (reverse rkey)) #f))
+          (r (id? #'r)
+             (rest #'r req opt (cons #f (reverse rkey)) #f))
+          (else
+           (syntax-violation 'lambda* "invalid keyword argument list"
+                             orig-args args))))
+      (define (pred args req opt kw)
+        (syntax-case args ()
+          ((x) (check req opt #f kw #'x))
+          ((x a b) (eq? (syntax->datum #'a) #:rest)
+           (rest #'b req opt kw #f))
+          ((x . b) (id? #'b)
+           (rest #'b req opt kw #f))
+          (else
+           (syntax-violation 'lambda* "invalid argument list following #:predicate"
+                             orig-args args))))
+      (define (rest args req opt kw pred)
+        (syntax-case args ()
+          (r (id? #'r)
+             (check req opt #'r kw pred))
+          (else
+           (syntax-violation 'lambda* "invalid rest argument"
+                             orig-args args))))
+      (define (check req opt rest kw pred)
+        (cond
+         ((distinct-bound-ids?
+           (append req (map car opt) (if rest (list rest) '())
+                   (if (pair? kw) (map cadr (cdr kw)) '())))
+          (values req opt rest kw pred))
+         (else
+          (syntax-violation 'lambda* "duplicate identifier in argument list"
+                            orig-args))))
+      (req orig-args '())))
 
-(define chi-lambda-case
-  (lambda (e r w s mod get-formals clauses)
-    (define (expand-req req opt rest kw pred body)
-      (let ((vars (map gen-var req))
-            (labels (gen-labels req)))
-        (let ((r* (extend-var-env labels vars r))
-              (w* (make-binding-wrap req labels w)))
-          (expand-opt (map syntax->datum req)
-                      opt rest kw pred body (reverse vars) r* w* '() '()))))
-    (define (expand-opt req opt rest kw pred body vars r* w* out inits)
-      (cond
-       ((pair? opt)
-        (syntax-case (car opt) ()
-          ((id i)
-           (let* ((v (gen-var #'id))
-                  (l (gen-labels (list v)))
-                  (r** (extend-var-env l (list v) r*))
-                  (w** (make-binding-wrap (list #'id) l w*)))
-             (expand-opt req (cdr opt) rest kw pred body (cons v vars)
-                         r** w** (cons (syntax->datum #'id) out)
-                         (cons (chi #'i r* w* mod) inits))))))
-       (rest
-        (let* ((v (gen-var rest))
-               (l (gen-labels (list v)))
-               (r* (extend-var-env l (list v) r*))
-               (w* (make-binding-wrap (list rest) l w*)))
-          (expand-kw req (if (pair? out) (reverse out) #f)
-                     (syntax->datum rest)
+  (define chi-lambda-case
+    (lambda (e r w s mod get-formals clauses)
+      (define (expand-req req opt rest kw pred body)
+        (let ((vars (map gen-var req))
+              (labels (gen-labels req)))
+          (let ((r* (extend-var-env labels vars r))
+                (w* (make-binding-wrap req labels w)))
+            (expand-opt (map syntax->datum req)
+                        opt rest kw pred body (reverse vars) r* w* '() '()))))
+      (define (expand-opt req opt rest kw pred body vars r* w* out inits)
+        (cond
+         ((pair? opt)
+          (syntax-case (car opt) ()
+            ((id i)
+             (let* ((v (gen-var #'id))
+                    (l (gen-labels (list v)))
+                    (r** (extend-var-env l (list v) r*))
+                    (w** (make-binding-wrap (list #'id) l w*)))
+               (expand-opt req (cdr opt) rest kw pred body (cons v vars)
+                           r** w** (cons (syntax->datum #'id) out)
+                           (cons (chi #'i r* w* mod) inits))))))
+         (rest
+          (let* ((v (gen-var rest))
+                 (l (gen-labels (list v)))
+                 (r* (extend-var-env l (list v) r*))
+                 (w* (make-binding-wrap (list rest) l w*)))
+            (expand-kw req (if (pair? out) (reverse out) #f)
+                       (syntax->datum rest)
+                       (if (pair? kw) (cdr kw) kw)
+                       pred body (cons v vars) r* w* 
+                       (if (pair? kw) (car kw) #f)
+                       '() inits)))
+         (else
+          (expand-kw req (if (pair? out) (reverse out) #f) #f
                      (if (pair? kw) (cdr kw) kw)
-                     pred body (cons v vars) r* w* 
+                     pred body vars r* w*
                      (if (pair? kw) (car kw) #f)
-                     '() inits)))
-       (else
-        (expand-kw req (if (pair? out) (reverse out) #f) #f
-                   (if (pair? kw) (cdr kw) kw)
-                   pred body vars r* w*
-                   (if (pair? kw) (car kw) #f)
-                   '() inits))))
-    (define (expand-kw req opt rest kw pred body vars r* w* aok out inits)
-      (cond
-       ((pair? kw)
-        (syntax-case (car kw) ()
-          ((k id i)
-           (let* ((v (gen-var #'id))
-                  (l (gen-labels (list v)))
-                  (r** (extend-var-env l (list v) r*))
-                  (w** (make-binding-wrap (list #'id) l w*)))
-             (expand-kw req opt rest (cdr kw) pred body (cons v vars)
-                        r** w** aok
-                        (cons (list (syntax->datum #'k)
-                                    (syntax->datum #'id)
-                                    v)
-                              out)
-                        (cons (chi #'i r* w* mod) inits))))))
-       (else
-        (expand-pred req opt rest
-                     (if (or aok (pair? out)) (cons aok (reverse out)) #f)
-                     pred body (reverse vars) r* w* (reverse inits)))))
-    (define (expand-pred req opt rest kw pred body vars r* w* inits)
-      (expand-body req opt rest kw (and pred (chi pred r* w* mod))
-                   body vars r* w* inits))
-    (define (expand-body req opt rest kw pred body vars r* w* inits)
-      (syntax-case body ()
-        ((docstring e1 e2 ...) (string? (syntax->datum #'docstring))
-         (values (syntax->datum #'docstring) req opt rest kw inits vars pred
-                 (chi-body #'(e1 e2 ...) (source-wrap e w s mod)
-                           r* w* mod)))
-        ((e1 e2 ...)
-         (values #f req opt rest kw inits vars pred
-                 (chi-body #'(e1 e2 ...) (source-wrap e w s mod)
-                           r* w* mod)))))
+                     '() inits))))
+      (define (expand-kw req opt rest kw pred body vars r* w* aok out inits)
+        (cond
+         ((pair? kw)
+          (syntax-case (car kw) ()
+            ((k id i)
+             (let* ((v (gen-var #'id))
+                    (l (gen-labels (list v)))
+                    (r** (extend-var-env l (list v) r*))
+                    (w** (make-binding-wrap (list #'id) l w*)))
+               (expand-kw req opt rest (cdr kw) pred body (cons v vars)
+                          r** w** aok
+                          (cons (list (syntax->datum #'k)
+                                      (syntax->datum #'id)
+                                      v)
+                                out)
+                          (cons (chi #'i r* w* mod) inits))))))
+         (else
+          (expand-pred req opt rest
+                       (if (or aok (pair? out)) (cons aok (reverse out)) #f)
+                       pred body (reverse vars) r* w* (reverse inits)))))
+      (define (expand-pred req opt rest kw pred body vars r* w* inits)
+        (expand-body req opt rest kw (and pred (chi pred r* w* mod))
+                     body vars r* w* inits))
+      (define (expand-body req opt rest kw pred body vars r* w* inits)
+        (syntax-case body ()
+          ((docstring e1 e2 ...) (string? (syntax->datum #'docstring))
+           (values (syntax->datum #'docstring) req opt rest kw inits vars pred
+                   (chi-body #'(e1 e2 ...) (source-wrap e w s mod)
+                             r* w* mod)))
+          ((e1 e2 ...)
+           (values #f req opt rest kw inits vars pred
+                   (chi-body #'(e1 e2 ...) (source-wrap e w s mod)
+                             r* w* mod)))))
 
-    (syntax-case clauses ()
-      (() (values #f #f))
-      (((args e1 e2 ...) (args* e1* e2* ...) ...)
-       (call-with-values (lambda () (get-formals #'args))
-          (lambda (req opt rest kw pred)
-            (call-with-values (lambda ()
-                                (expand-req req opt rest kw pred #'(e1 e2 ...)))
-              (lambda (docstring req opt rest kw inits vars pred body)
-                (call-with-values
-                    (lambda ()
-                      (chi-lambda-case e r w s mod get-formals
-                                       #'((args* e1* e2* ...) ...)))
-                  (lambda (docstring* else*)
-                    (values
-                     (or docstring docstring*)
-                     (build-lambda-case s req opt rest kw inits vars
-                                        pred body else*))))))))))))
+      (syntax-case clauses ()
+        (() (values #f #f))
+        (((args e1 e2 ...) (args* e1* e2* ...) ...)
+         (call-with-values (lambda () (get-formals #'args))
+           (lambda (req opt rest kw pred)
+             (call-with-values (lambda ()
+                                 (expand-req req opt rest kw pred #'(e1 e2 ...)))
+               (lambda (docstring req opt rest kw inits vars pred body)
+                 (call-with-values
+                     (lambda ()
+                       (chi-lambda-case e r w s mod get-formals
+                                        #'((args* e1* e2* ...) ...)))
+                   (lambda (docstring* else*)
+                     (values
+                      (or docstring docstring*)
+                      (build-lambda-case s req opt rest kw inits vars
+                                         pred body else*))))))))))))
 
 ;;; data
 
@@ -1803,37 +1803,37 @@
 ;;; in the spine, we also check for pairs whose cars are annotated in case
 ;;; we've been passed the cdr of an annotated list
 
-(define strip
-  (lambda (x w)
-    (if (top-marked? w)
-        x
-        (let f ((x x))
-          (cond
-           ((syntax-object? x)
-            (strip (syntax-object-expression x) (syntax-object-wrap x)))
-           ((pair? x)
-            (let ((a (f (car x))) (d (f (cdr x))))
-              (if (and (eq? a (car x)) (eq? d (cdr x)))
-                  x
-                  (cons a d))))
-           ((vector? x)
-            (let ((old (vector->list x)))
-              (let ((new (map f old)))
-                (if (and-map* eq? old new) x (list->vector new)))))
-           (else x))))))
+  (define strip
+    (lambda (x w)
+      (if (top-marked? w)
+          x
+          (let f ((x x))
+            (cond
+             ((syntax-object? x)
+              (strip (syntax-object-expression x) (syntax-object-wrap x)))
+             ((pair? x)
+              (let ((a (f (car x))) (d (f (cdr x))))
+                (if (and (eq? a (car x)) (eq? d (cdr x)))
+                    x
+                    (cons a d))))
+             ((vector? x)
+              (let ((old (vector->list x)))
+                (let ((new (map f old)))
+                  (if (and-map* eq? old new) x (list->vector new)))))
+             (else x))))))
 
 ;;; lexical variables
 
-(define gen-var
-  (lambda (id)
-    (let ((id (if (syntax-object? id) (syntax-object-expression id) id)))
-      (build-lexical-var no-source id))))
+  (define gen-var
+    (lambda (id)
+      (let ((id (if (syntax-object? id) (syntax-object-expression id) id)))
+        (build-lexical-var no-source id))))
 
-;; appears to return a reversed list
-(define lambda-var-list
-  (lambda (vars)
-    (let lvl ((vars vars) (ls '()) (w empty-wrap))
-       (cond
+  ;; appears to return a reversed list
+  (define lambda-var-list
+    (lambda (vars)
+      (let lvl ((vars vars) (ls '()) (w empty-wrap))
+        (cond
          ((pair? vars) (lvl (cdr vars) (cons (wrap (car vars) w #f) ls) w))
          ((id? vars) (cons (wrap vars w #f) ls))
          ((null? vars) ls)
@@ -1841,541 +1841,541 @@
           (lvl (syntax-object-expression vars)
                ls
                (join-wraps w (syntax-object-wrap vars))))
-       ; include anything else to be caught by subsequent error
-       ; checking
+                                        ; include anything else to be caught by subsequent error
+                                        ; checking
          (else (cons vars ls))))))
 
 ;;; core transformers
 
-(global-extend 'local-syntax 'letrec-syntax #t)
-(global-extend 'local-syntax 'let-syntax #f)
+  (global-extend 'local-syntax 'letrec-syntax #t)
+  (global-extend 'local-syntax 'let-syntax #f)
 
-(global-extend 'core 'fluid-let-syntax
-  (lambda (e r w s mod)
-    (syntax-case e ()
-      ((_ ((var val) ...) e1 e2 ...)
-       (valid-bound-ids? (syntax (var ...)))
-       (let ((names (map (lambda (x) (id-var-name x w)) (syntax (var ...)))))
-         (for-each
-           (lambda (id n)
-             (case (binding-type (lookup n r mod))
-               ((displaced-lexical)
-                (syntax-violation 'fluid-let-syntax
-                                  "identifier out of context"
-                                  e
-                                  (source-wrap id w s mod)))))
-           (syntax (var ...))
-           names)
-         (chi-body
-           (syntax (e1 e2 ...))
-           (source-wrap e w s mod)
-           (extend-env
-             names
-             (let ((trans-r (macros-only-env r)))
-               (map (lambda (x)
-                      (make-binding 'macro
-                        (eval-local-transformer (chi x trans-r w mod)
-                                                mod)))
-                    (syntax (val ...))))
-             r)
-           w
-           mod)))
-      (_ (syntax-violation 'fluid-let-syntax "bad syntax"
-                           (source-wrap e w s mod))))))
+  (global-extend 'core 'fluid-let-syntax
+                 (lambda (e r w s mod)
+                   (syntax-case e ()
+                     ((_ ((var val) ...) e1 e2 ...)
+                      (valid-bound-ids? #'(var ...))
+                      (let ((names (map (lambda (x) (id-var-name x w)) #'(var ...))))
+                        (for-each
+                         (lambda (id n)
+                           (case (binding-type (lookup n r mod))
+                             ((displaced-lexical)
+                              (syntax-violation 'fluid-let-syntax
+                                                "identifier out of context"
+                                                e
+                                                (source-wrap id w s mod)))))
+                         #'(var ...)
+                         names)
+                        (chi-body
+                         #'(e1 e2 ...)
+                         (source-wrap e w s mod)
+                         (extend-env
+                          names
+                          (let ((trans-r (macros-only-env r)))
+                            (map (lambda (x)
+                                   (make-binding 'macro
+                                                 (eval-local-transformer (chi x trans-r w mod)
+                                                                         mod)))
+                                 #'(val ...)))
+                          r)
+                         w
+                         mod)))
+                     (_ (syntax-violation 'fluid-let-syntax "bad syntax"
+                                          (source-wrap e w s mod))))))
 
-(global-extend 'core 'quote
-   (lambda (e r w s mod)
-      (syntax-case e ()
-         ((_ e) (build-data s (strip (syntax e) w)))
-         (_ (syntax-violation 'quote "bad syntax"
-                              (source-wrap e w s mod))))))
+  (global-extend 'core 'quote
+                 (lambda (e r w s mod)
+                   (syntax-case e ()
+                     ((_ e) (build-data s (strip #'e w)))
+                     (_ (syntax-violation 'quote "bad syntax"
+                                          (source-wrap e w s mod))))))
 
-(global-extend 'core 'syntax
-  (let ()
-    (define gen-syntax
-      (lambda (src e r maps ellipsis? mod)
-        (if (id? e)
-            (let ((label (id-var-name e empty-wrap)))
-              (let ((b (lookup label r mod)))
-                (if (eq? (binding-type b) 'syntax)
-                    (call-with-values
-                      (lambda ()
-                        (let ((var.lev (binding-value b)))
-                          (gen-ref src (car var.lev) (cdr var.lev) maps)))
-                      (lambda (var maps) (values `(ref ,var) maps)))
-                    (if (ellipsis? e)
-                        (syntax-violation 'syntax "misplaced ellipsis" src)
-                        (values `(quote ,e) maps)))))
-            (syntax-case e ()
-              ((dots e)
-               (ellipsis? (syntax dots))
-               (gen-syntax src (syntax e) r maps (lambda (x) #f) mod))
-              ((x dots . y)
-               ; this could be about a dozen lines of code, except that we
-               ; choose to handle (syntax (x ... ...)) forms
-               (ellipsis? (syntax dots))
-               (let f ((y (syntax y))
-                       (k (lambda (maps)
-                            (call-with-values
-                              (lambda ()
-                                (gen-syntax src (syntax x) r
-                                  (cons '() maps) ellipsis? mod))
-                              (lambda (x maps)
-                                (if (null? (car maps))
-                                    (syntax-violation 'syntax "extra ellipsis"
-                                                      src)
-                                    (values (gen-map x (car maps))
-                                            (cdr maps))))))))
-                 (syntax-case y ()
-                   ((dots . y)
-                    (ellipsis? (syntax dots))
-                    (f (syntax y)
-                       (lambda (maps)
-                         (call-with-values
-                           (lambda () (k (cons '() maps)))
-                           (lambda (x maps)
-                             (if (null? (car maps))
-                                 (syntax-violation 'syntax "extra ellipsis" src)
-                                 (values (gen-mappend x (car maps))
-                                         (cdr maps))))))))
-                   (_ (call-with-values
-                        (lambda () (gen-syntax src y r maps ellipsis? mod))
-                        (lambda (y maps)
+  (global-extend 'core 'syntax
+                 (let ()
+                   (define gen-syntax
+                     (lambda (src e r maps ellipsis? mod)
+                       (if (id? e)
+                           (let ((label (id-var-name e empty-wrap)))
+                             (let ((b (lookup label r mod)))
+                               (if (eq? (binding-type b) 'syntax)
+                                   (call-with-values
+                                       (lambda ()
+                                         (let ((var.lev (binding-value b)))
+                                           (gen-ref src (car var.lev) (cdr var.lev) maps)))
+                                     (lambda (var maps) (values `(ref ,var) maps)))
+                                   (if (ellipsis? e)
+                                       (syntax-violation 'syntax "misplaced ellipsis" src)
+                                       (values `(quote ,e) maps)))))
+                           (syntax-case e ()
+                             ((dots e)
+                              (ellipsis? #'dots)
+                              (gen-syntax src #'e r maps (lambda (x) #f) mod))
+                             ((x dots . y)
+                                        ; this could be about a dozen lines of code, except that we
+                                        ; choose to handle #'(x ... ...) forms
+                              (ellipsis? #'dots)
+                              (let f ((y #'y)
+                                      (k (lambda (maps)
+                                           (call-with-values
+                                               (lambda ()
+                                                 (gen-syntax src #'x r
+                                                             (cons '() maps) ellipsis? mod))
+                                             (lambda (x maps)
+                                               (if (null? (car maps))
+                                                   (syntax-violation 'syntax "extra ellipsis"
+                                                                     src)
+                                                   (values (gen-map x (car maps))
+                                                           (cdr maps))))))))
+                                (syntax-case y ()
+                                  ((dots . y)
+                                   (ellipsis? #'dots)
+                                   (f #'y
+                                      (lambda (maps)
+                                        (call-with-values
+                                            (lambda () (k (cons '() maps)))
+                                          (lambda (x maps)
+                                            (if (null? (car maps))
+                                                (syntax-violation 'syntax "extra ellipsis" src)
+                                                (values (gen-mappend x (car maps))
+                                                        (cdr maps))))))))
+                                  (_ (call-with-values
+                                         (lambda () (gen-syntax src y r maps ellipsis? mod))
+                                       (lambda (y maps)
+                                         (call-with-values
+                                             (lambda () (k maps))
+                                           (lambda (x maps)
+                                             (values (gen-append x y) maps)))))))))
+                             ((x . y)
+                              (call-with-values
+                                  (lambda () (gen-syntax src #'x r maps ellipsis? mod))
+                                (lambda (x maps)
+                                  (call-with-values
+                                      (lambda () (gen-syntax src #'y r maps ellipsis? mod))
+                                    (lambda (y maps) (values (gen-cons x y) maps))))))
+                             (#(e1 e2 ...)
+                              (call-with-values
+                                  (lambda ()
+                                    (gen-syntax src #'(e1 e2 ...) r maps ellipsis? mod))
+                                (lambda (e maps) (values (gen-vector e) maps))))
+                             (_ (values `(quote ,e) maps))))))
+
+                   (define gen-ref
+                     (lambda (src var level maps)
+                       (if (fx= level 0)
+                           (values var maps)
+                           (if (null? maps)
+                               (syntax-violation 'syntax "missing ellipsis" src)
+                               (call-with-values
+                                   (lambda () (gen-ref src var (fx- level 1) (cdr maps)))
+                                 (lambda (outer-var outer-maps)
+                                   (let ((b (assq outer-var (car maps))))
+                                     (if b
+                                         (values (cdr b) maps)
+                                         (let ((inner-var (gen-var 'tmp)))
+                                           (values inner-var
+                                                   (cons (cons (cons outer-var inner-var)
+                                                               (car maps))
+                                                         outer-maps)))))))))))
+
+                   (define gen-mappend
+                     (lambda (e map-env)
+                       `(apply (primitive append) ,(gen-map e map-env))))
+
+                   (define gen-map
+                     (lambda (e map-env)
+                       (let ((formals (map cdr map-env))
+                             (actuals (map (lambda (x) `(ref ,(car x))) map-env)))
+                         (cond
+                          ((eq? (car e) 'ref)
+                                        ; identity map equivalence:
+                                        ; (map (lambda (x) x) y) == y
+                           (car actuals))
+                          ((and-map
+                            (lambda (x) (and (eq? (car x) 'ref) (memq (cadr x) formals)))
+                            (cdr e))
+                                        ; eta map equivalence:
+                                        ; (map (lambda (x ...) (f x ...)) y ...) == (map f y ...)
+                           `(map (primitive ,(car e))
+                                 ,@(map (let ((r (map cons formals actuals)))
+                                          (lambda (x) (cdr (assq (cadr x) r))))
+                                        (cdr e))))
+                          (else `(map (lambda ,formals ,e) ,@actuals))))))
+
+                   (define gen-cons
+                     (lambda (x y)
+                       (case (car y)
+                         ((quote)
+                          (if (eq? (car x) 'quote)
+                              `(quote (,(cadr x) . ,(cadr y)))
+                              (if (eq? (cadr y) '())
+                                  `(list ,x)
+                                  `(cons ,x ,y))))
+                         ((list) `(list ,x ,@(cdr y)))
+                         (else `(cons ,x ,y)))))
+
+                   (define gen-append
+                     (lambda (x y)
+                       (if (equal? y '(quote ()))
+                           x
+                           `(append ,x ,y))))
+
+                   (define gen-vector
+                     (lambda (x)
+                       (cond
+                        ((eq? (car x) 'list) `(vector ,@(cdr x)))
+                        ((eq? (car x) 'quote) `(quote #(,@(cadr x))))
+                        (else `(list->vector ,x)))))
+
+
+                   (define regen
+                     (lambda (x)
+                       (case (car x)
+                         ((ref) (build-lexical-reference 'value no-source (cadr x) (cadr x)))
+                         ((primitive) (build-primref no-source (cadr x)))
+                         ((quote) (build-data no-source (cadr x)))
+                         ((lambda)
+                          (if (list? (cadr x))
+                              (build-simple-lambda no-source (cadr x) #f (cadr x) #f (regen (caddr x)))
+                              (error "how did we get here" x)))
+                         (else (build-application no-source
+                                                  (build-primref no-source (car x))
+                                                  (map regen (cdr x)))))))
+
+                   (lambda (e r w s mod)
+                     (let ((e (source-wrap e w s mod)))
+                       (syntax-case e ()
+                         ((_ x)
                           (call-with-values
-                            (lambda () (k maps))
-                            (lambda (x maps)
-                              (values (gen-append x y) maps)))))))))
-              ((x . y)
-               (call-with-values
-                 (lambda () (gen-syntax src (syntax x) r maps ellipsis? mod))
-                 (lambda (x maps)
-                   (call-with-values
-                     (lambda () (gen-syntax src (syntax y) r maps ellipsis? mod))
-                     (lambda (y maps) (values (gen-cons x y) maps))))))
-              (#(e1 e2 ...)
-               (call-with-values
-                 (lambda ()
-                   (gen-syntax src (syntax (e1 e2 ...)) r maps ellipsis? mod))
-                 (lambda (e maps) (values (gen-vector e) maps))))
-              (_ (values `(quote ,e) maps))))))
+                              (lambda () (gen-syntax e #'x r '() ellipsis? mod))
+                            (lambda (e maps) (regen e))))
+                         (_ (syntax-violation 'syntax "bad `syntax' form" e)))))))
 
-    (define gen-ref
-      (lambda (src var level maps)
-        (if (fx= level 0)
-            (values var maps)
-            (if (null? maps)
-                (syntax-violation 'syntax "missing ellipsis" src)
-                (call-with-values
-                  (lambda () (gen-ref src var (fx- level 1) (cdr maps)))
-                  (lambda (outer-var outer-maps)
-                    (let ((b (assq outer-var (car maps))))
-                      (if b
-                          (values (cdr b) maps)
-                          (let ((inner-var (gen-var 'tmp)))
-                            (values inner-var
-                                    (cons (cons (cons outer-var inner-var)
-                                                (car maps))
-                                          outer-maps)))))))))))
+  (global-extend 'core 'lambda
+                 (lambda (e r w s mod)
+                   (syntax-case e ()
+                     ((_ args docstring e1 e2 ...) (string? (syntax->datum #'docstring))
+                      (call-with-values (lambda () (lambda-formals #'args))
+                        (lambda (req opt rest kw pred)
+                          (chi-simple-lambda e r w s mod req rest (syntax->datum #'docstring)
+                                             #'(e1 e2 ...)))))
+                     ((_ args e1 e2 ...)
+                      (call-with-values (lambda () (lambda-formals #'args))
+                        (lambda (req opt rest kw pred)
+                          (chi-simple-lambda e r w s mod req rest #f #'(e1 e2 ...)))))
+                     (_ (syntax-violation 'lambda "bad lambda" e)))))
 
-    (define gen-mappend
-      (lambda (e map-env)
-        `(apply (primitive append) ,(gen-map e map-env))))
+  (global-extend 'core 'lambda*
+                 (lambda (e r w s mod)
+                   (syntax-case e ()
+                     ((_ args e1 e2 ...)
+                      (call-with-values
+                          (lambda ()
+                            (chi-lambda-case e r w s mod
+                                             lambda*-formals #'((args e1 e2 ...))))
+                        (lambda (docstring lcase)
+                          (build-case-lambda s docstring lcase))))
+                     (_ (syntax-violation 'lambda "bad lambda*" e)))))
 
-    (define gen-map
-      (lambda (e map-env)
-        (let ((formals (map cdr map-env))
-              (actuals (map (lambda (x) `(ref ,(car x))) map-env)))
-          (cond
-            ((eq? (car e) 'ref)
-             ; identity map equivalence:
-             ; (map (lambda (x) x) y) == y
-             (car actuals))
-            ((and-map
-                (lambda (x) (and (eq? (car x) 'ref) (memq (cadr x) formals)))
-                (cdr e))
-             ; eta map equivalence:
-             ; (map (lambda (x ...) (f x ...)) y ...) == (map f y ...)
-             `(map (primitive ,(car e))
-                   ,@(map (let ((r (map cons formals actuals)))
-                            (lambda (x) (cdr (assq (cadr x) r))))
-                          (cdr e))))
-            (else `(map (lambda ,formals ,e) ,@actuals))))))
+  (global-extend 'core 'case-lambda
+                 (lambda (e r w s mod)
+                   (syntax-case e ()
+                     ((_ (args e1 e2 ...) (args* e1* e2* ...) ...)
+                      (call-with-values
+                          (lambda ()
+                            (chi-lambda-case e r w s mod
+                                             lambda-formals
+                                             #'((args e1 e2 ...) (args* e1* e2* ...) ...)))
+                        (lambda (docstring lcase)
+                          (build-case-lambda s docstring lcase))))
+                     (_ (syntax-violation 'case-lambda "bad case-lambda" e)))))
 
-    (define gen-cons
-      (lambda (x y)
-        (case (car y)
-          ((quote)
-           (if (eq? (car x) 'quote)
-               `(quote (,(cadr x) . ,(cadr y)))
-               (if (eq? (cadr y) '())
-                   `(list ,x)
-                   `(cons ,x ,y))))
-          ((list) `(list ,x ,@(cdr y)))
-          (else `(cons ,x ,y)))))
+  (global-extend 'core 'case-lambda*
+                 (lambda (e r w s mod)
+                   (syntax-case e ()
+                     ((_ (args e1 e2 ...) (args* e1* e2* ...) ...)
+                      (call-with-values
+                          (lambda ()
+                            (chi-lambda-case e r w s mod
+                                             lambda*-formals
+                                             #'((args e1 e2 ...) (args* e1* e2* ...) ...)))
+                        (lambda (docstring lcase)
+                          (build-case-lambda s docstring lcase))))
+                     (_ (syntax-violation 'case-lambda "bad case-lambda*" e)))))
 
-    (define gen-append
-      (lambda (x y)
-        (if (equal? y '(quote ()))
-            x
-            `(append ,x ,y))))
-
-    (define gen-vector
-      (lambda (x)
-        (cond
-          ((eq? (car x) 'list) `(vector ,@(cdr x)))
-          ((eq? (car x) 'quote) `(quote #(,@(cadr x))))
-          (else `(list->vector ,x)))))
+  (global-extend 'core 'let
+                 (let ()
+                   (define (chi-let e r w s mod constructor ids vals exps)
+                     (if (not (valid-bound-ids? ids))
+                         (syntax-violation 'let "duplicate bound variable" e)
+                         (let ((labels (gen-labels ids))
+                               (new-vars (map gen-var ids)))
+                           (let ((nw (make-binding-wrap ids labels w))
+                                 (nr (extend-var-env labels new-vars r)))
+                             (constructor s
+                                          (map syntax->datum ids)
+                                          new-vars
+                                          (map (lambda (x) (chi x r w mod)) vals)
+                                          (chi-body exps (source-wrap e nw s mod)
+                                                    nr nw mod))))))
+                   (lambda (e r w s mod)
+                     (syntax-case e ()
+                       ((_ ((id val) ...) e1 e2 ...)
+                        (and-map id? #'(id ...))
+                        (chi-let e r w s mod
+                                 build-let
+                                 #'(id ...)
+                                 #'(val ...)
+                                 #'(e1 e2 ...)))
+                       ((_ f ((id val) ...) e1 e2 ...)
+                        (and (id? #'f) (and-map id? #'(id ...)))
+                        (chi-let e r w s mod
+                                 build-named-let
+                                 #'(f id ...)
+                                 #'(val ...)
+                                 #'(e1 e2 ...)))
+                       (_ (syntax-violation 'let "bad let" (source-wrap e w s mod)))))))
 
 
-    (define regen
-      (lambda (x)
-        (case (car x)
-          ((ref) (build-lexical-reference 'value no-source (cadr x) (cadr x)))
-          ((primitive) (build-primref no-source (cadr x)))
-          ((quote) (build-data no-source (cadr x)))
-          ((lambda)
-           (if (list? (cadr x))
-               (build-simple-lambda no-source (cadr x) #f (cadr x) #f (regen (caddr x)))
-               (error "how did we get here" x)))
-          (else (build-application no-source
-                  (build-primref no-source (car x))
-                  (map regen (cdr x)))))))
-
-    (lambda (e r w s mod)
-      (let ((e (source-wrap e w s mod)))
-        (syntax-case e ()
-          ((_ x)
-           (call-with-values
-             (lambda () (gen-syntax e (syntax x) r '() ellipsis? mod))
-             (lambda (e maps) (regen e))))
-          (_ (syntax-violation 'syntax "bad `syntax' form" e)))))))
-
-(global-extend 'core 'lambda
-   (lambda (e r w s mod)
-     (syntax-case e ()
-       ((_ args docstring e1 e2 ...) (string? (syntax->datum #'docstring))
-        (call-with-values (lambda () (lambda-formals #'args))
-          (lambda (req opt rest kw pred)
-            (chi-simple-lambda e r w s mod req rest (syntax->datum #'docstring)
-                               #'(e1 e2 ...)))))
-       ((_ args e1 e2 ...)
-        (call-with-values (lambda () (lambda-formals #'args))
-          (lambda (req opt rest kw pred)
-            (chi-simple-lambda e r w s mod req rest #f #'(e1 e2 ...)))))
-       (_ (syntax-violation 'lambda "bad lambda" e)))))
-
-(global-extend 'core 'lambda*
-   (lambda (e r w s mod)
-     (syntax-case e ()
-       ((_ args e1 e2 ...)
-        (call-with-values
-            (lambda ()
-              (chi-lambda-case e r w s mod
-                               lambda*-formals #'((args e1 e2 ...))))
-          (lambda (docstring lcase)
-            (build-case-lambda s docstring lcase))))
-       (_ (syntax-violation 'lambda "bad lambda*" e)))))
-
-(global-extend 'core 'case-lambda
-   (lambda (e r w s mod)
-     (syntax-case e ()
-       ((_ (args e1 e2 ...) (args* e1* e2* ...) ...)
-        (call-with-values
-            (lambda ()
-              (chi-lambda-case e r w s mod
-                               lambda-formals
-                               #'((args e1 e2 ...) (args* e1* e2* ...) ...)))
-          (lambda (docstring lcase)
-            (build-case-lambda s docstring lcase))))
-       (_ (syntax-violation 'case-lambda "bad case-lambda" e)))))
-
-(global-extend 'core 'case-lambda*
-   (lambda (e r w s mod)
-     (syntax-case e ()
-       ((_ (args e1 e2 ...) (args* e1* e2* ...) ...)
-        (call-with-values
-            (lambda ()
-              (chi-lambda-case e r w s mod
-                               lambda*-formals
-                               #'((args e1 e2 ...) (args* e1* e2* ...) ...)))
-          (lambda (docstring lcase)
-            (build-case-lambda s docstring lcase))))
-       (_ (syntax-violation 'case-lambda "bad case-lambda*" e)))))
-
-(global-extend 'core 'let
-  (let ()
-    (define (chi-let e r w s mod constructor ids vals exps)
-      (if (not (valid-bound-ids? ids))
-	  (syntax-violation 'let "duplicate bound variable" e)
-	  (let ((labels (gen-labels ids))
-		(new-vars (map gen-var ids)))
-	    (let ((nw (make-binding-wrap ids labels w))
-		  (nr (extend-var-env labels new-vars r)))
-	      (constructor s
-                           (map syntax->datum ids)
-			   new-vars
-			   (map (lambda (x) (chi x r w mod)) vals)
-			   (chi-body exps (source-wrap e nw s mod)
-                                     nr nw mod))))))
-    (lambda (e r w s mod)
-      (syntax-case e ()
-	((_ ((id val) ...) e1 e2 ...)
-         (and-map id? (syntax (id ...)))
-	 (chi-let e r w s mod
-		  build-let
-		  (syntax (id ...))
-		  (syntax (val ...))
-		  (syntax (e1 e2 ...))))
-	((_ f ((id val) ...) e1 e2 ...)
-	 (and (id? (syntax f)) (and-map id? (syntax (id ...))))
-	 (chi-let e r w s mod
-		  build-named-let
-		  (syntax (f id ...))
-		  (syntax (val ...))
-		  (syntax (e1 e2 ...))))
-	(_ (syntax-violation 'let "bad let" (source-wrap e w s mod)))))))
+  (global-extend 'core 'letrec
+                 (lambda (e r w s mod)
+                   (syntax-case e ()
+                     ((_ ((id val) ...) e1 e2 ...)
+                      (and-map id? #'(id ...))
+                      (let ((ids #'(id ...)))
+                        (if (not (valid-bound-ids? ids))
+                            (syntax-violation 'letrec "duplicate bound variable" e)
+                            (let ((labels (gen-labels ids))
+                                  (new-vars (map gen-var ids)))
+                              (let ((w (make-binding-wrap ids labels w))
+                                    (r (extend-var-env labels new-vars r)))
+                                (build-letrec s
+                                              (map syntax->datum ids)
+                                              new-vars
+                                              (map (lambda (x) (chi x r w mod)) #'(val ...))
+                                              (chi-body #'(e1 e2 ...) 
+                                                        (source-wrap e w s mod) r w mod)))))))
+                     (_ (syntax-violation 'letrec "bad letrec" (source-wrap e w s mod))))))
 
 
-(global-extend 'core 'letrec
-  (lambda (e r w s mod)
-    (syntax-case e ()
-      ((_ ((id val) ...) e1 e2 ...)
-       (and-map id? (syntax (id ...)))
-       (let ((ids (syntax (id ...))))
-         (if (not (valid-bound-ids? ids))
-             (syntax-violation 'letrec "duplicate bound variable" e)
-             (let ((labels (gen-labels ids))
-                   (new-vars (map gen-var ids)))
-               (let ((w (make-binding-wrap ids labels w))
-                    (r (extend-var-env labels new-vars r)))
-                 (build-letrec s
-                   (map syntax->datum ids)
-                   new-vars
-                   (map (lambda (x) (chi x r w mod)) (syntax (val ...)))
-                   (chi-body (syntax (e1 e2 ...)) 
-                             (source-wrap e w s mod) r w mod)))))))
-      (_ (syntax-violation 'letrec "bad letrec" (source-wrap e w s mod))))))
+  (global-extend 'core 'set!
+                 (lambda (e r w s mod)
+                   (syntax-case e ()
+                     ((_ id val)
+                      (id? #'id)
+                      (let ((val (chi #'val r w mod))
+                            (n (id-var-name #'id w)))
+                        (let ((b (lookup n r mod)))
+                          (case (binding-type b)
+                            ((lexical)
+                             (build-lexical-assignment s
+                                                       (syntax->datum #'id)
+                                                       (binding-value b)
+                                                       val))
+                            ((global) (build-global-assignment s n val mod))
+                            ((displaced-lexical)
+                             (syntax-violation 'set! "identifier out of context"
+                                               (wrap #'id w mod)))
+                            (else (syntax-violation 'set! "bad set!"
+                                                    (source-wrap e w s mod)))))))
+                     ((_ (head tail ...) val)
+                      (call-with-values
+                          (lambda () (syntax-type #'head r empty-wrap no-source #f mod #t))
+                        (lambda (type value ee ww ss modmod)
+                          (case type
+                            ((module-ref)
+                             (let ((val (chi #'val r w mod)))
+                               (call-with-values (lambda () (value #'(head tail ...)))
+                                 (lambda (id mod)
+                                   (build-global-assignment s id val mod)))))
+                            (else
+                             (build-application s
+                                                (chi #'(setter head) r w mod)
+                                                (map (lambda (e) (chi e r w mod))
+                                                     #'(tail ... val))))))))
+                     (_ (syntax-violation 'set! "bad set!" (source-wrap e w s mod))))))
 
+  (global-extend 'module-ref '@
+                 (lambda (e)
+                   (syntax-case e ()
+                     ((_ (mod ...) id)
+                      (and (and-map id? #'(mod ...)) (id? #'id))
+                      (values (syntax->datum #'id)
+                              (syntax->datum
+                               #'(public mod ...)))))))
 
-(global-extend 'core 'set!
-  (lambda (e r w s mod)
-    (syntax-case e ()
-      ((_ id val)
-       (id? (syntax id))
-       (let ((val (chi (syntax val) r w mod))
-             (n (id-var-name (syntax id) w)))
-         (let ((b (lookup n r mod)))
-           (case (binding-type b)
-             ((lexical)
-              (build-lexical-assignment s
-                                        (syntax->datum (syntax id))
-                                        (binding-value b)
-                                        val))
-             ((global) (build-global-assignment s n val mod))
-             ((displaced-lexical)
-              (syntax-violation 'set! "identifier out of context"
-                                (wrap (syntax id) w mod)))
-             (else (syntax-violation 'set! "bad set!"
-                                     (source-wrap e w s mod)))))))
-      ((_ (head tail ...) val)
-       (call-with-values
-           (lambda () (syntax-type (syntax head) r empty-wrap no-source #f mod #t))
-         (lambda (type value ee ww ss modmod)
-           (case type
-             ((module-ref)
-              (let ((val (chi (syntax val) r w mod)))
-                (call-with-values (lambda () (value (syntax (head tail ...))))
-                  (lambda (id mod)
-                    (build-global-assignment s id val mod)))))
-             (else
-              (build-application s
-                                 (chi (syntax (setter head)) r w mod)
-                                 (map (lambda (e) (chi e r w mod))
-                                      (syntax (tail ... val)))))))))
-      (_ (syntax-violation 'set! "bad set!" (source-wrap e w s mod))))))
+  (global-extend 'module-ref '@@
+                 (lambda (e)
+                   (syntax-case e ()
+                     ((_ (mod ...) id)
+                      (and (and-map id? #'(mod ...)) (id? #'id))
+                      (values (syntax->datum #'id)
+                              (syntax->datum
+                               #'(private mod ...)))))))
 
-(global-extend 'module-ref '@
-   (lambda (e)
-     (syntax-case e ()
-        ((_ (mod ...) id)
-         (and (and-map id? (syntax (mod ...))) (id? (syntax id)))
-         (values (syntax->datum (syntax id))
-                 (syntax->datum
-                  (syntax (public mod ...))))))))
+  (global-extend 'core 'if
+                 (lambda (e r w s mod)
+                   (syntax-case e ()
+                     ((_ test then)
+                      (build-conditional
+                       s
+                       (chi #'test r w mod)
+                       (chi #'then r w mod)
+                       (build-void no-source)))
+                     ((_ test then else)
+                      (build-conditional
+                       s
+                       (chi #'test r w mod)
+                       (chi #'then r w mod)
+                       (chi #'else r w mod))))))
 
-(global-extend 'module-ref '@@
-   (lambda (e)
-     (syntax-case e ()
-        ((_ (mod ...) id)
-         (and (and-map id? (syntax (mod ...))) (id? (syntax id)))
-         (values (syntax->datum (syntax id))
-                 (syntax->datum
-                  (syntax (private mod ...))))))))
+  (global-extend 'begin 'begin '())
 
-(global-extend 'core 'if
-  (lambda (e r w s mod)
-    (syntax-case e ()
-      ((_ test then)
-       (build-conditional
-        s
-        (chi (syntax test) r w mod)
-        (chi (syntax then) r w mod)
-        (build-void no-source)))
-      ((_ test then else)
-       (build-conditional
-        s
-        (chi (syntax test) r w mod)
-        (chi (syntax then) r w mod)
-        (chi (syntax else) r w mod))))))
+  (global-extend 'define 'define '())
 
-(global-extend 'begin 'begin '())
+  (global-extend 'define-syntax 'define-syntax '())
 
-(global-extend 'define 'define '())
+  (global-extend 'eval-when 'eval-when '())
 
-(global-extend 'define-syntax 'define-syntax '())
+  (global-extend 'core 'syntax-case
+                 (let ()
+                   (define convert-pattern
+                                        ; accepts pattern & keys
+                                        ; returns $sc-dispatch pattern & ids
+                     (lambda (pattern keys)
+                       (let cvt ((p pattern) (n 0) (ids '()))
+                         (if (id? p)
+                             (if (bound-id-member? p keys)
+                                 (values (vector 'free-id p) ids)
+                                 (values 'any (cons (cons p n) ids)))
+                             (syntax-case p ()
+                               ((x dots)
+                                (ellipsis? #'dots)
+                                (call-with-values
+                                    (lambda () (cvt #'x (fx+ n 1) ids))
+                                  (lambda (p ids)
+                                    (values (if (eq? p 'any) 'each-any (vector 'each p))
+                                            ids))))
+                               ((x . y)
+                                (call-with-values
+                                    (lambda () (cvt #'y n ids))
+                                  (lambda (y ids)
+                                    (call-with-values
+                                        (lambda () (cvt #'x n ids))
+                                      (lambda (x ids)
+                                        (values (cons x y) ids))))))
+                               (() (values '() ids))
+                               (#(x ...)
+                                (call-with-values
+                                    (lambda () (cvt #'(x ...) n ids))
+                                  (lambda (p ids) (values (vector 'vector p) ids))))
+                               (x (values (vector 'atom (strip p empty-wrap)) ids)))))))
 
-(global-extend 'eval-when 'eval-when '())
+                   (define build-dispatch-call
+                     (lambda (pvars exp y r mod)
+                       (let ((ids (map car pvars)) (levels (map cdr pvars)))
+                         (let ((labels (gen-labels ids)) (new-vars (map gen-var ids)))
+                           (build-application no-source
+                                              (build-primref no-source 'apply)
+                                              (list (build-simple-lambda no-source (map syntax->datum ids) #f new-vars #f
+                                                                         (chi exp
+                                                                              (extend-env
+                                                                               labels
+                                                                               (map (lambda (var level)
+                                                                                      (make-binding 'syntax `(,var . ,level)))
+                                                                                    new-vars
+                                                                                    (map cdr pvars))
+                                                                               r)
+                                                                              (make-binding-wrap ids labels empty-wrap)
+                                                                              mod))
+                                                    y))))))
 
-(global-extend 'core 'syntax-case
-  (let ()
-    (define convert-pattern
-      ; accepts pattern & keys
-      ; returns $sc-dispatch pattern & ids
-      (lambda (pattern keys)
-        (let cvt ((p pattern) (n 0) (ids '()))
-          (if (id? p)
-              (if (bound-id-member? p keys)
-                  (values (vector 'free-id p) ids)
-                  (values 'any (cons (cons p n) ids)))
-              (syntax-case p ()
-                ((x dots)
-                 (ellipsis? (syntax dots))
-                 (call-with-values
-                   (lambda () (cvt (syntax x) (fx+ n 1) ids))
-                   (lambda (p ids)
-                     (values (if (eq? p 'any) 'each-any (vector 'each p))
-                             ids))))
-                ((x . y)
-                 (call-with-values
-                   (lambda () (cvt (syntax y) n ids))
-                   (lambda (y ids)
-                     (call-with-values
-                       (lambda () (cvt (syntax x) n ids))
-                       (lambda (x ids)
-                         (values (cons x y) ids))))))
-                (() (values '() ids))
-                (#(x ...)
-                 (call-with-values
-                   (lambda () (cvt (syntax (x ...)) n ids))
-                   (lambda (p ids) (values (vector 'vector p) ids))))
-                (x (values (vector 'atom (strip p empty-wrap)) ids)))))))
+                   (define gen-clause
+                     (lambda (x keys clauses r pat fender exp mod)
+                       (call-with-values
+                           (lambda () (convert-pattern pat keys))
+                         (lambda (p pvars)
+                           (cond
+                            ((not (distinct-bound-ids? (map car pvars)))
+                             (syntax-violation 'syntax-case "duplicate pattern variable" pat))
+                            ((not (and-map (lambda (x) (not (ellipsis? (car x)))) pvars))
+                             (syntax-violation 'syntax-case "misplaced ellipsis" pat))
+                            (else
+                             (let ((y (gen-var 'tmp)))
+                                        ; fat finger binding and references to temp variable y
+                               (build-application no-source
+                                                  (build-simple-lambda no-source (list 'tmp) #f (list y) #f
+                                                                       (let ((y (build-lexical-reference 'value no-source
+                                                                                                         'tmp y)))
+                                                                         (build-conditional no-source
+                                                                                            (syntax-case fender ()
+                                                                                              (#t y)
+                                                                                              (_ (build-conditional no-source
+                                                                                                                    y
+                                                                                                                    (build-dispatch-call pvars fender y r mod)
+                                                                                                                    (build-data no-source #f))))
+                                                                                            (build-dispatch-call pvars exp y r mod)
+                                                                                            (gen-syntax-case x keys clauses r mod))))
+                                                  (list (if (eq? p 'any)
+                                                            (build-application no-source
+                                                                               (build-primref no-source 'list)
+                                                                               (list x))
+                                                            (build-application no-source
+                                                                               (build-primref no-source '$sc-dispatch)
+                                                                               (list x (build-data no-source p)))))))))))))
 
-    (define build-dispatch-call
-      (lambda (pvars exp y r mod)
-        (let ((ids (map car pvars)) (levels (map cdr pvars)))
-          (let ((labels (gen-labels ids)) (new-vars (map gen-var ids)))
-            (build-application no-source
-              (build-primref no-source 'apply)
-              (list (build-simple-lambda no-source (map syntax->datum ids) #f new-vars #f
-                      (chi exp
-                           (extend-env
-                            labels
-                            (map (lambda (var level)
-                                   (make-binding 'syntax `(,var . ,level)))
-                                 new-vars
-                                 (map cdr pvars))
-                            r)
-                           (make-binding-wrap ids labels empty-wrap)
-                           mod))
-                    y))))))
+                   (define gen-syntax-case
+                     (lambda (x keys clauses r mod)
+                       (if (null? clauses)
+                           (build-application no-source
+                                              (build-primref no-source 'syntax-violation)
+                                              (list (build-data no-source #f)
+                                                    (build-data no-source
+                                                                "source expression failed to match any pattern")
+                                                    x))
+                           (syntax-case (car clauses) ()
+                             ((pat exp)
+                              (if (and (id? #'pat)
+                                       (and-map (lambda (x) (not (free-id=? #'pat x)))
+                                                (cons #'(... ...) keys)))
+                                  (let ((labels (list (gen-label)))
+                                        (var (gen-var #'pat)))
+                                    (build-application no-source
+                                                       (build-simple-lambda
+                                                        no-source (list (syntax->datum #'pat)) #f (list var)
+                                                        #f
+                                                        (chi #'exp
+                                                             (extend-env labels
+                                                                         (list (make-binding 'syntax `(,var . 0)))
+                                                                         r)
+                                                             (make-binding-wrap #'(pat)
+                                                                                labels empty-wrap)
+                                                             mod))
+                                                       (list x)))
+                                  (gen-clause x keys (cdr clauses) r
+                                              #'pat #t #'exp mod)))
+                             ((pat fender exp)
+                              (gen-clause x keys (cdr clauses) r
+                                          #'pat #'fender #'exp mod))
+                             (_ (syntax-violation 'syntax-case "invalid clause"
+                                                  (car clauses)))))))
 
-    (define gen-clause
-      (lambda (x keys clauses r pat fender exp mod)
-        (call-with-values
-          (lambda () (convert-pattern pat keys))
-          (lambda (p pvars)
-            (cond
-              ((not (distinct-bound-ids? (map car pvars)))
-               (syntax-violation 'syntax-case "duplicate pattern variable" pat))
-              ((not (and-map (lambda (x) (not (ellipsis? (car x)))) pvars))
-               (syntax-violation 'syntax-case "misplaced ellipsis" pat))
-              (else
-               (let ((y (gen-var 'tmp)))
-                 ; fat finger binding and references to temp variable y
-                 (build-application no-source
-                   (build-simple-lambda no-source (list 'tmp) #f (list y) #f
-                     (let ((y (build-lexical-reference 'value no-source
-                                                       'tmp y)))
-                       (build-conditional no-source
-                         (syntax-case fender ()
-                           (#t y)
-                           (_ (build-conditional no-source
-                                y
-                                (build-dispatch-call pvars fender y r mod)
-                                (build-data no-source #f))))
-                         (build-dispatch-call pvars exp y r mod)
-                         (gen-syntax-case x keys clauses r mod))))
-                   (list (if (eq? p 'any)
-                             (build-application no-source
-                               (build-primref no-source 'list)
-                               (list x))
-                             (build-application no-source
-                               (build-primref no-source '$sc-dispatch)
-                               (list x (build-data no-source p)))))))))))))
-
-    (define gen-syntax-case
-      (lambda (x keys clauses r mod)
-        (if (null? clauses)
-            (build-application no-source
-              (build-primref no-source 'syntax-violation)
-              (list (build-data no-source #f)
-                    (build-data no-source
-                                "source expression failed to match any pattern")
-                    x))
-            (syntax-case (car clauses) ()
-              ((pat exp)
-               (if (and (id? (syntax pat))
-                        (and-map (lambda (x) (not (free-id=? (syntax pat) x)))
-                                 (cons (syntax (... ...)) keys)))
-                   (let ((labels (list (gen-label)))
-                         (var (gen-var (syntax pat))))
-                     (build-application no-source
-                       (build-simple-lambda
-                        no-source (list (syntax->datum (syntax pat))) #f (list var)
-                        #f
-                        (chi (syntax exp)
-                             (extend-env labels
-                                         (list (make-binding 'syntax `(,var . 0)))
-                                         r)
-                             (make-binding-wrap (syntax (pat))
-                                                labels empty-wrap)
-                             mod))
-                       (list x)))
-                   (gen-clause x keys (cdr clauses) r
-                     (syntax pat) #t (syntax exp) mod)))
-              ((pat fender exp)
-               (gen-clause x keys (cdr clauses) r
-                 (syntax pat) (syntax fender) (syntax exp) mod))
-              (_ (syntax-violation 'syntax-case "invalid clause"
-                                   (car clauses)))))))
-
-    (lambda (e r w s mod)
-      (let ((e (source-wrap e w s mod)))
-        (syntax-case e ()
-          ((_ val (key ...) m ...)
-           (if (and-map (lambda (x) (and (id? x) (not (ellipsis? x))))
-                        (syntax (key ...)))
-               (let ((x (gen-var 'tmp)))
-                 ; fat finger binding and references to temp variable x
-                 (build-application s
-                   (build-simple-lambda no-source (list 'tmp) #f (list x) #f
-                     (gen-syntax-case (build-lexical-reference 'value no-source
-                                                               'tmp x)
-                       (syntax (key ...)) (syntax (m ...))
-                       r
-                       mod))
-                   (list (chi (syntax val) r empty-wrap mod))))
-               (syntax-violation 'syntax-case "invalid literals list" e))))))))
+                   (lambda (e r w s mod)
+                     (let ((e (source-wrap e w s mod)))
+                       (syntax-case e ()
+                         ((_ val (key ...) m ...)
+                          (if (and-map (lambda (x) (and (id? x) (not (ellipsis? x))))
+                                       #'(key ...))
+                              (let ((x (gen-var 'tmp)))
+                                        ; fat finger binding and references to temp variable x
+                                (build-application s
+                                                   (build-simple-lambda no-source (list 'tmp) #f (list x) #f
+                                                                        (gen-syntax-case (build-lexical-reference 'value no-source
+                                                                                                                  'tmp x)
+                                                                                         #'(key ...) #'(m ...)
+                                                                                         r
+                                                                                         mod))
+                                                   (list (chi #'val r empty-wrap mod))))
+                              (syntax-violation 'syntax-case "invalid literals list" e))))))))
 
 ;;; The portable sc-expand seeds chi-top's mode m with 'e (for
 ;;; evaluating) and esew (which stands for "eval syntax expanders
@@ -2386,65 +2386,65 @@
 ;;; syntactic definitions are evaluated immediately after they are
 ;;; expanded, and the expanded definitions are also residualized into
 ;;; the object file if we are compiling a file.
-(set! sc-expand
-      (lambda (x . rest)
-        (if (and (pair? x) (equal? (car x) noexpand))
-            (cadr x)
-            (let ((m (if (null? rest) 'e (car rest)))
-                  (esew (if (or (null? rest) (null? (cdr rest)))
-                            '(eval)
-                            (cadr rest))))
-              (with-fluid* *mode* m
-                (lambda ()
-                  (chi-top x null-env top-wrap m esew
-                           (cons 'hygiene (module-name (current-module))))))))))
+  (set! sc-expand
+        (lambda (x . rest)
+          (if (and (pair? x) (equal? (car x) noexpand))
+              (cadr x)
+              (let ((m (if (null? rest) 'e (car rest)))
+                    (esew (if (or (null? rest) (null? (cdr rest)))
+                              '(eval)
+                              (cadr rest))))
+                (with-fluid* *mode* m
+                             (lambda ()
+                               (chi-top x null-env top-wrap m esew
+                                        (cons 'hygiene (module-name (current-module))))))))))
 
-(set! identifier?
-  (lambda (x)
-    (nonsymbol-id? x)))
+  (set! identifier?
+        (lambda (x)
+          (nonsymbol-id? x)))
 
-(set! datum->syntax
-  (lambda (id datum)
-    (make-syntax-object datum (syntax-object-wrap id) #f)))
+  (set! datum->syntax
+        (lambda (id datum)
+          (make-syntax-object datum (syntax-object-wrap id) #f)))
 
-(set! syntax->datum
-  ; accepts any object, since syntax objects may consist partially
-  ; or entirely of unwrapped, nonsymbolic data
-  (lambda (x)
-    (strip x empty-wrap)))
+  (set! syntax->datum
+                                        ; accepts any object, since syntax objects may consist partially
+                                        ; or entirely of unwrapped, nonsymbolic data
+        (lambda (x)
+          (strip x empty-wrap)))
 
-(set! generate-temporaries
-  (lambda (ls)
-    (arg-check list? ls 'generate-temporaries)
-    (map (lambda (x) (wrap (gensym-hook) top-wrap #f)) ls)))
+  (set! generate-temporaries
+        (lambda (ls)
+          (arg-check list? ls 'generate-temporaries)
+          (map (lambda (x) (wrap (gensym-hook) top-wrap #f)) ls)))
 
-(set! free-identifier=?
-   (lambda (x y)
-      (arg-check nonsymbol-id? x 'free-identifier=?)
-      (arg-check nonsymbol-id? y 'free-identifier=?)
-      (free-id=? x y)))
+  (set! free-identifier=?
+        (lambda (x y)
+          (arg-check nonsymbol-id? x 'free-identifier=?)
+          (arg-check nonsymbol-id? y 'free-identifier=?)
+          (free-id=? x y)))
 
-(set! bound-identifier=?
-   (lambda (x y)
-      (arg-check nonsymbol-id? x 'bound-identifier=?)
-      (arg-check nonsymbol-id? y 'bound-identifier=?)
-      (bound-id=? x y)))
+  (set! bound-identifier=?
+        (lambda (x y)
+          (arg-check nonsymbol-id? x 'bound-identifier=?)
+          (arg-check nonsymbol-id? y 'bound-identifier=?)
+          (bound-id=? x y)))
 
-(set! syntax-violation
-  (lambda (who message form . subform)
-    (arg-check (lambda (x) (or (not x) (string? x) (symbol? x)))
-               who 'syntax-violation)
-    (arg-check string? message 'syntax-violation)
-    (scm-error 'syntax-error 'sc-expand
-               (string-append
-                (if who "~a: " "")
-                "~a "
-                (if (null? subform) "in ~a" "in subform `~s' of `~s'"))
-               (let ((tail (cons message
-                                 (map (lambda (x) (strip x empty-wrap))
-                                      (append subform (list form))))))
-                 (if who (cons who tail) tail))
-               #f)))
+  (set! syntax-violation
+        (lambda (who message form . subform)
+          (arg-check (lambda (x) (or (not x) (string? x) (symbol? x)))
+                     who 'syntax-violation)
+          (arg-check string? message 'syntax-violation)
+          (scm-error 'syntax-error 'sc-expand
+                     (string-append
+                      (if who "~a: " "")
+                      "~a "
+                      (if (null? subform) "in ~a" "in subform `~s' of `~s'"))
+                     (let ((tail (cons message
+                                       (map (lambda (x) (strip x empty-wrap))
+                                            (append subform (list form))))))
+                       (if who (cons who tail) tail))
+                     #f)))
 
 ;;; $sc-dispatch expects an expression and a pattern.  If the expression
 ;;; matches the pattern a list of the matching expressions for each
@@ -2468,134 +2468,134 @@
 ;;; not, should convert to:
 ;;;   #(vector <pattern>*)               #(<pattern>*)
 
-(let ()
+  (let ()
 
-(define match-each
-  (lambda (e p w mod)
-    (cond
-     ((pair? e)
-      (let ((first (match (car e) p w '() mod)))
-        (and first
-             (let ((rest (match-each (cdr e) p w mod)))
-               (and rest (cons first rest))))))
-     ((null? e) '())
-     ((syntax-object? e)
-      (match-each (syntax-object-expression e)
-                  p
-                  (join-wraps w (syntax-object-wrap e))
-                  (syntax-object-module e)))
-     (else #f))))
-
-(define match-each-any
-  (lambda (e w mod)
-    (cond
-     ((pair? e)
-      (let ((l (match-each-any (cdr e) w mod)))
-        (and l (cons (wrap (car e) w mod) l))))
-     ((null? e) '())
-     ((syntax-object? e)
-      (match-each-any (syntax-object-expression e)
+    (define match-each
+      (lambda (e p w mod)
+        (cond
+         ((pair? e)
+          (let ((first (match (car e) p w '() mod)))
+            (and first
+                 (let ((rest (match-each (cdr e) p w mod)))
+                   (and rest (cons first rest))))))
+         ((null? e) '())
+         ((syntax-object? e)
+          (match-each (syntax-object-expression e)
+                      p
                       (join-wraps w (syntax-object-wrap e))
-                      mod))
-     (else #f))))
+                      (syntax-object-module e)))
+         (else #f))))
 
-(define match-empty
-  (lambda (p r)
-    (cond
-      ((null? p) r)
-      ((eq? p 'any) (cons '() r))
-      ((pair? p) (match-empty (car p) (match-empty (cdr p) r)))
-      ((eq? p 'each-any) (cons '() r))
-      (else
-       (case (vector-ref p 0)
-         ((each) (match-empty (vector-ref p 1) r))
-         ((free-id atom) r)
-         ((vector) (match-empty (vector-ref p 1) r)))))))
+    (define match-each-any
+      (lambda (e w mod)
+        (cond
+         ((pair? e)
+          (let ((l (match-each-any (cdr e) w mod)))
+            (and l (cons (wrap (car e) w mod) l))))
+         ((null? e) '())
+         ((syntax-object? e)
+          (match-each-any (syntax-object-expression e)
+                          (join-wraps w (syntax-object-wrap e))
+                          mod))
+         (else #f))))
 
-(define match*
-  (lambda (e p w r mod)
-    (cond
-      ((null? p) (and (null? e) r))
-      ((pair? p)
-       (and (pair? e) (match (car e) (car p) w
-                        (match (cdr e) (cdr p) w r mod)
-                        mod)))
-      ((eq? p 'each-any)
-       (let ((l (match-each-any e w mod))) (and l (cons l r))))
-      (else
-       (case (vector-ref p 0)
-         ((each)
-          (if (null? e)
-              (match-empty (vector-ref p 1) r)
-              (let ((l (match-each e (vector-ref p 1) w mod)))
-                (and l
-                     (let collect ((l l))
-                       (if (null? (car l))
-                           r
-                           (cons (map car l) (collect (map cdr l)))))))))
-         ((free-id) (and (id? e) (free-id=? (wrap e w mod) (vector-ref p 1)) r))
-         ((atom) (and (equal? (vector-ref p 1) (strip e w)) r))
-         ((vector)
-          (and (vector? e)
-               (match (vector->list e) (vector-ref p 1) w r mod))))))))
+    (define match-empty
+      (lambda (p r)
+        (cond
+         ((null? p) r)
+         ((eq? p 'any) (cons '() r))
+         ((pair? p) (match-empty (car p) (match-empty (cdr p) r)))
+         ((eq? p 'each-any) (cons '() r))
+         (else
+          (case (vector-ref p 0)
+            ((each) (match-empty (vector-ref p 1) r))
+            ((free-id atom) r)
+            ((vector) (match-empty (vector-ref p 1) r)))))))
 
-(define match
-  (lambda (e p w r mod)
-    (cond
-      ((not r) #f)
-      ((eq? p 'any) (cons (wrap e w mod) r))
-      ((syntax-object? e)
-       (match*
-        (syntax-object-expression e)
-        p
-        (join-wraps w (syntax-object-wrap e))
-        r
-        (syntax-object-module e)))
-      (else (match* e p w r mod)))))
+    (define match*
+      (lambda (e p w r mod)
+        (cond
+         ((null? p) (and (null? e) r))
+         ((pair? p)
+          (and (pair? e) (match (car e) (car p) w
+                           (match (cdr e) (cdr p) w r mod)
+                           mod)))
+         ((eq? p 'each-any)
+          (let ((l (match-each-any e w mod))) (and l (cons l r))))
+         (else
+          (case (vector-ref p 0)
+            ((each)
+             (if (null? e)
+                 (match-empty (vector-ref p 1) r)
+                 (let ((l (match-each e (vector-ref p 1) w mod)))
+                   (and l
+                        (let collect ((l l))
+                          (if (null? (car l))
+                              r
+                              (cons (map car l) (collect (map cdr l)))))))))
+            ((free-id) (and (id? e) (free-id=? (wrap e w mod) (vector-ref p 1)) r))
+            ((atom) (and (equal? (vector-ref p 1) (strip e w)) r))
+            ((vector)
+             (and (vector? e)
+                  (match (vector->list e) (vector-ref p 1) w r mod))))))))
 
-(set! $sc-dispatch
-  (lambda (e p)
-    (cond
-      ((eq? p 'any) (list e))
-      ((syntax-object? e)
-       (match* (syntax-object-expression e)
-               p (syntax-object-wrap e) '() (syntax-object-module e)))
-      (else (match* e p empty-wrap '() #f)))))
+    (define match
+      (lambda (e p w r mod)
+        (cond
+         ((not r) #f)
+         ((eq? p 'any) (cons (wrap e w mod) r))
+         ((syntax-object? e)
+          (match*
+           (syntax-object-expression e)
+           p
+           (join-wraps w (syntax-object-wrap e))
+           r
+           (syntax-object-module e)))
+         (else (match* e p w r mod)))))
 
-))
+    (set! $sc-dispatch
+          (lambda (e p)
+            (cond
+             ((eq? p 'any) (list e))
+             ((syntax-object? e)
+              (match* (syntax-object-expression e)
+                      p (syntax-object-wrap e) '() (syntax-object-module e)))
+             (else (match* e p empty-wrap '() #f)))))
+
+    ))
 )
 
 (define-syntax with-syntax
    (lambda (x)
       (syntax-case x ()
          ((_ () e1 e2 ...)
-          (syntax (begin e1 e2 ...)))
+          #'(begin e1 e2 ...))
          ((_ ((out in)) e1 e2 ...)
-          (syntax (syntax-case in () (out (begin e1 e2 ...)))))
+          #'(syntax-case in () (out (begin e1 e2 ...))))
          ((_ ((out in) ...) e1 e2 ...)
-          (syntax (syntax-case (list in ...) ()
-                     ((out ...) (begin e1 e2 ...))))))))
+          #'(syntax-case (list in ...) ()
+              ((out ...) (begin e1 e2 ...)))))))
 
 (define-syntax syntax-rules
   (lambda (x)
     (syntax-case x ()
       ((_ (k ...) ((keyword . pattern) template) ...)
-       (syntax (lambda (x)
-                (syntax-case x (k ...)
-                  ((dummy . pattern) (syntax template))
-                  ...)))))))
+       #'(lambda (x)
+           (syntax-case x (k ...)
+             ((dummy . pattern) #'template)
+             ...))))))
 
 (define-syntax let*
   (lambda (x)
     (syntax-case x ()
       ((let* ((x v) ...) e1 e2 ...)
-       (and-map identifier? (syntax (x ...)))
-       (let f ((bindings (syntax ((x v)  ...))))
+       (and-map identifier? #'(x ...))
+       (let f ((bindings #'((x v)  ...)))
          (if (null? bindings)
-             (syntax (let () e1 e2 ...))
+             #'(let () e1 e2 ...)
              (with-syntax ((body (f (cdr bindings)))
                            (binding (car bindings)))
-               (syntax (let (binding) body)))))))))
+               #'(let (binding) body))))))))
 
 (define-syntax do
    (lambda (orig-x)
@@ -2603,85 +2603,85 @@
          ((_ ((var init . step) ...) (e0 e1 ...) c ...)
           (with-syntax (((step ...)
                          (map (lambda (v s)
-                                 (syntax-case s ()
-                                    (() v)
-                                    ((e) (syntax e))
-                                    (_ (syntax-violation
-                                        'do "bad step expression" 
-                                        orig-x s))))
-                              (syntax (var ...))
-                              (syntax (step ...)))))
-             (syntax-case (syntax (e1 ...)) ()
-                (() (syntax (let doloop ((var init) ...)
-                               (if (not e0)
-                                   (begin c ... (doloop step ...))))))
-                ((e1 e2 ...)
-                 (syntax (let doloop ((var init) ...)
-                            (if e0
-                                (begin e1 e2 ...)
-                                (begin c ... (doloop step ...))))))))))))
+                                (syntax-case s ()
+                                  (() v)
+                                  ((e) #'e)
+                                  (_ (syntax-violation
+                                      'do "bad step expression" 
+                                      orig-x s))))
+                              #'(var ...)
+                              #'(step ...))))
+             (syntax-case #'(e1 ...) ()
+               (() #'(let doloop ((var init) ...)
+                       (if (not e0)
+                           (begin c ... (doloop step ...)))))
+               ((e1 e2 ...)
+                #'(let doloop ((var init) ...)
+                    (if e0
+                        (begin e1 e2 ...)
+                        (begin c ... (doloop step ...)))))))))))
 
 (define-syntax quasiquote
    (letrec
       ((quasicons
         (lambda (x y)
           (with-syntax ((x x) (y y))
-            (syntax-case (syntax y) (quote list)
+            (syntax-case #'y (quote list)
               ((quote dy)
-               (syntax-case (syntax x) (quote)
-                 ((quote dx) (syntax (quote (dx . dy))))
-                 (_ (if (null? (syntax dy))
-                        (syntax (list x))
-                        (syntax (cons x y))))))
-              ((list . stuff) (syntax (list x . stuff)))
-              (else (syntax (cons x y)))))))
+               (syntax-case #'x (quote)
+                 ((quote dx) #'(quote (dx . dy)))
+                 (_ (if (null? #'dy)
+                        #'(list x)
+                        #'(cons x y)))))
+              ((list . stuff) #'(list x . stuff))
+              (else #'(cons x y))))))
        (quasiappend
         (lambda (x y)
           (with-syntax ((x x) (y y))
-            (syntax-case (syntax y) (quote)
-              ((quote ()) (syntax x))
-              (_ (syntax (append x y)))))))
+            (syntax-case #'y (quote)
+              ((quote ()) #'x)
+              (_ #'(append x y))))))
        (quasivector
         (lambda (x)
           (with-syntax ((x x))
-            (syntax-case (syntax x) (quote list)
-              ((quote (x ...)) (syntax (quote #(x ...))))
-              ((list x ...) (syntax (vector x ...)))
-              (_ (syntax (list->vector x)))))))
+            (syntax-case #'x (quote list)
+              ((quote (x ...)) #'(quote #(x ...)))
+              ((list x ...) #'(vector x ...))
+              (_ #'(list->vector x))))))
        (quasi
         (lambda (p lev)
            (syntax-case p (unquote unquote-splicing quasiquote)
               ((unquote p)
                (if (= lev 0)
-                   (syntax p)
-                   (quasicons (syntax (quote unquote))
-                              (quasi (syntax (p)) (- lev 1)))))
+                   #'p
+                   (quasicons #'(quote unquote)
+                              (quasi #'(p) (- lev 1)))))
               ((unquote . args)
                (= lev 0)
                (syntax-violation 'unquote
                                  "unquote takes exactly one argument"
-                                 p (syntax (unquote . args))))
+                                 p #'(unquote . args)))
               (((unquote-splicing p) . q)
                (if (= lev 0)
-                   (quasiappend (syntax p) (quasi (syntax q) lev))
-                   (quasicons (quasicons (syntax (quote unquote-splicing))
-                                         (quasi (syntax (p)) (- lev 1)))
-                              (quasi (syntax q) lev))))
+                   (quasiappend #'p (quasi #'q lev))
+                   (quasicons (quasicons #'(quote unquote-splicing)
+                                         (quasi #'(p) (- lev 1)))
+                              (quasi #'q lev))))
               (((unquote-splicing . args) . q)
                (= lev 0)
                (syntax-violation 'unquote-splicing
                                  "unquote-splicing takes exactly one argument"
-                                 p (syntax (unquote-splicing . args))))
+                                 p #'(unquote-splicing . args)))
               ((quasiquote p)
-               (quasicons (syntax (quote quasiquote))
-                          (quasi (syntax (p)) (+ lev 1))))
+               (quasicons #'(quote quasiquote)
+                          (quasi #'(p) (+ lev 1))))
               ((p . q)
-               (quasicons (quasi (syntax p) lev) (quasi (syntax q) lev)))
-              (#(x ...) (quasivector (quasi (syntax (x ...)) lev)))
-              (p (syntax (quote p)))))))
+               (quasicons (quasi #'p lev) (quasi #'q lev)))
+              (#(x ...) (quasivector (quasi #'(x ...) lev)))
+              (p #'(quote p))))))
     (lambda (x)
        (syntax-case x ()
-          ((_ e) (quasi (syntax e) 0))))))
+          ((_ e) (quasi #'e 0))))))
 
 (define-syntax include
   (lambda (x)
@@ -2695,9 +2695,9 @@
                       (f (read p))))))))
     (syntax-case x ()
       ((k filename)
-       (let ((fn (syntax->datum (syntax filename))))
-         (with-syntax (((exp ...) (read-file fn (syntax k))))
-           (syntax (begin exp ...))))))))
+       (let ((fn (syntax->datum #'filename)))
+         (with-syntax (((exp ...) (read-file fn #'k)))
+           #'(begin exp ...)))))))
 
 (define-syntax unquote
   (lambda (x)
@@ -2720,35 +2720,34 @@
     (syntax-case x ()
       ((_ e m1 m2 ...)
        (with-syntax
-         ((body (let f ((clause (syntax m1)) (clauses (syntax (m2 ...))))
-                  (if (null? clauses)
-                      (syntax-case clause (else)
-                        ((else e1 e2 ...) (syntax (begin e1 e2 ...)))
-                        (((k ...) e1 e2 ...)
-                         (syntax (if (memv t '(k ...)) (begin e1 e2 ...))))
-                        (_ (syntax-violation 'case "bad clause" x clause)))
-                      (with-syntax ((rest (f (car clauses) (cdr clauses))))
+           ((body (let f ((clause #'m1) (clauses #'(m2 ...)))
+                    (if (null? clauses)
                         (syntax-case clause (else)
+                          ((else e1 e2 ...) #'(begin e1 e2 ...))
                           (((k ...) e1 e2 ...)
-                           (syntax (if (memv t '(k ...))
-                                       (begin e1 e2 ...)
-                                       rest)))
-                          (_ (syntax-violation 'case "bad clause" x
-                                               clause))))))))
-         (syntax (let ((t e)) body)))))))
+                           #'(if (memv t '(k ...)) (begin e1 e2 ...)))
+                          (_ (syntax-violation 'case "bad clause" x clause)))
+                        (with-syntax ((rest (f (car clauses) (cdr clauses))))
+                          (syntax-case clause (else)
+                            (((k ...) e1 e2 ...)
+                             #'(if (memv t '(k ...))
+                                   (begin e1 e2 ...)
+                                   rest))
+                            (_ (syntax-violation 'case "bad clause" x
+                                                 clause))))))))
+         #'(let ((t e)) body))))))
 
 (define-syntax identifier-syntax
   (lambda (x)
     (syntax-case x ()
       ((_ e)
-       (syntax
-         (lambda (x)
+       #'(lambda (x)
            (syntax-case x ()
              (id
-              (identifier? (syntax id))
-              (syntax e))
+              (identifier? #'id)
+              #'e)
              ((_ x (... ...))
-              (syntax (e x (... ...)))))))))))
+              #'(e x (... ...)))))))))
 
 (define-syntax define*
   (syntax-rules ()