From 0c65f52c6d45f60e197fad7162d05c0fce89e817 Mon Sep 17 00:00:00 2001
From: Andy Wingo <wingo@pobox.com>
Date: Fri, 2 Sep 2011 11:36:14 +0200
Subject: [PATCH] more define-syntax-rule usage

* module/ice-9/boot-9.scm:
* module/ice-9/control.scm:
* module/ice-9/futures.scm:
* module/ice-9/optargs.scm:
* module/ice-9/poll.scm:
* module/ice-9/receive.scm:
* module/ice-9/threads.scm:
* module/ice-9/vlist.scm:
* module/language/assembly/compile-bytecode.scm:
* module/language/ecmascript/compile-tree-il.scm:
* module/language/tree-il.scm:
* module/oop/goops.scm:
* module/oop/goops/simple.scm:
* module/oop/goops/stklos.scm:
* module/srfi/srfi-1.scm:
* module/srfi/srfi-35.scm:
* module/srfi/srfi-39.scm:
* module/srfi/srfi-45.scm:
* module/srfi/srfi-67/compare.scm:
* module/sxml/match.scm:
* module/system/repl/error-handling.scm:
* module/system/repl/repl.scm:
* module/system/vm/inspect.scm:
* module/texinfo.scm:
* module/web/server.scm: Use define-syntax-rule, where it makes sense.
---
 module/ice-9/boot-9.scm                       | 132 +++++-------
 module/ice-9/control.scm                      |  22 +-
 module/ice-9/futures.scm                      |   8 +-
 module/ice-9/optargs.scm                      |  12 +-
 module/ice-9/poll.scm                         |   7 +-
 module/ice-9/receive.scm                      |  14 +-
 module/ice-9/threads.scm                      |  62 +++---
 module/ice-9/vlist.scm                        |  20 +-
 module/language/assembly/compile-bytecode.scm |  18 +-
 .../language/ecmascript/compile-tree-il.scm   |  36 ++--
 module/language/tree-il.scm                   | 148 +++++++-------
 module/oop/goops.scm                          |  37 ++--
 module/oop/goops/simple.scm                   |   8 +-
 module/oop/goops/stklos.scm                   |   8 +-
 module/srfi/srfi-1.scm                        |   8 +-
 module/srfi/srfi-35.scm                       |  32 ++-
 module/srfi/srfi-39.scm                       |  12 +-
 module/srfi/srfi-45.scm                       |  13 +-
 module/srfi/srfi-67/compare.scm               | 189 ++++++++----------
 module/sxml/match.scm                         |  37 ++--
 module/system/repl/error-handling.scm         |   6 +-
 module/system/repl/repl.scm                   |  16 +-
 module/system/vm/inspect.scm                  |  21 +-
 module/texinfo.scm                            |  20 +-
 module/web/server.scm                         |   8 +-
 25 files changed, 377 insertions(+), 517 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index b7e9f7f40..a1ec5cc31 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -504,9 +504,8 @@ If there is no handler at all, Guile prints an error and then exits."
     ((do "step" x y)
      y)))
 
-(define-syntax delay
-  (syntax-rules ()
-    ((_ exp) (make-promise (lambda () exp)))))
+(define-syntax-rule (delay exp)
+  (make-promise (lambda () exp)))
 
 (include-from-path "ice-9/quasisyntax")
 
@@ -517,11 +516,9 @@ If there is no handler at all, Guile prints an error and then exits."
        (with-syntax ((s (datum->syntax x (syntax-source x))))
          #''s)))))
 
-(define-syntax define-once
-  (syntax-rules ()
-    ((_ sym val)
-     (define sym
-       (if (module-locally-bound? (current-module) 'sym) sym val)))))
+(define-syntax-rule (define-once sym val)
+  (define sym
+    (if (module-locally-bound? (current-module) 'sym) sym val)))
 
 ;;; The real versions of `map' and `for-each', with cycle detection, and
 ;;; that use reverse! instead of recursion in the case of `map'.
@@ -853,12 +850,10 @@ VALUE."
 (define (and=> value procedure) (and value (procedure value)))
 (define call/cc call-with-current-continuation)
 
-(define-syntax false-if-exception
-  (syntax-rules ()
-    ((_ expr)
-     (catch #t
-       (lambda () expr)
-       (lambda (k . args) #f)))))
+(define-syntax-rule (false-if-exception expr)
+  (catch #t
+    (lambda () expr)
+    (lambda (k . args) #f)))
 
 
 
@@ -877,12 +872,10 @@ VALUE."
 ;; properties within the object itself.
 
 (define (make-object-property)
-  (define-syntax with-mutex
-    (syntax-rules ()
-      ((_ lock exp)
-       (dynamic-wind (lambda () (lock-mutex lock))
-                     (lambda () exp)
-                     (lambda () (unlock-mutex lock))))))
+  (define-syntax-rule (with-mutex lock exp)
+    (dynamic-wind (lambda () (lock-mutex lock))
+                  (lambda () exp)
+                  (lambda () (unlock-mutex lock))))
   (let ((prop (make-weak-key-hash-table))
         (lock (make-mutex)))
     (make-procedure-with-setter
@@ -1380,10 +1373,9 @@ VALUE."
          (thunk)))
      (lambda (k . args)
        (%start-stack tag (lambda () (apply k args)))))))
-(define-syntax start-stack
-  (syntax-rules ()
-    ((_ tag exp)
-     (%start-stack tag (lambda () exp)))))
+
+(define-syntax-rule (start-stack tag exp)
+  (%start-stack tag (lambda () exp)))
 
 
 
@@ -2846,11 +2838,9 @@ module '(ice-9 q) '(make-q q-length))}."
                      flags)
            (interface options)
            (interface)))
-       (define-syntax option-set!
-         (syntax-rules ()
-           ((_ opt val)
-            (eval-when (eval load compile expand)
-              (options (append (options) (list 'opt val)))))))))))
+       (define-syntax-rule (option-set! opt val)
+         (eval-when (eval load compile expand)
+           (options (append (options) (list 'opt val)))))))))
 
 (define-option-interface
   (debug-options-interface
@@ -3175,21 +3165,17 @@ module '(ice-9 q) '(make-q q-length))}."
              (process-use-modules (list quoted-args ...))
              *unspecified*))))))
 
-(define-syntax use-syntax
-  (syntax-rules ()
-    ((_ spec ...)
-     (begin
-       (eval-when (eval load compile expand)
-         (issue-deprecation-warning
-          "`use-syntax' is deprecated. Please contact guile-devel for more info."))
-       (use-modules spec ...)))))
+(define-syntax-rule (use-syntax spec ...)
+  (begin
+    (eval-when (eval load compile expand)
+      (issue-deprecation-warning
+       "`use-syntax' is deprecated. Please contact guile-devel for more info."))
+    (use-modules spec ...)))
 
 (include-from-path "ice-9/r6rs-libraries")
 
-(define-syntax define-private
-  (syntax-rules ()
-    ((_ foo bar)
-     (define foo bar))))
+(define-syntax-rule (define-private foo bar)
+  (define foo bar))
 
 (define-syntax define-public
   (syntax-rules ()
@@ -3200,18 +3186,14 @@ module '(ice-9 q) '(make-q q-length))}."
        (define name val)
        (export name)))))
 
-(define-syntax defmacro-public
-  (syntax-rules ()
-    ((_ name args . body)
-     (begin
-       (defmacro name args . body)
-       (export-syntax name)))))
+(define-syntax-rule (defmacro-public name args body ...)
+  (begin
+    (defmacro name args body ...)
+    (export-syntax name)))
 
 ;; And now for the most important macro.
-(define-syntax λ
-  (syntax-rules ()
-    ((_ formals body ...)
-     (lambda formals body ...))))
+(define-syntax-rule (λ formals body ...)
+  (lambda formals body ...))
 
 
 ;; Export a local variable
@@ -3270,39 +3252,29 @@ module '(ice-9 q) '(make-q q-length))}."
                          (module-add! public-i external-name var)))))
               names)))
 
-(define-syntax export
-  (syntax-rules ()
-    ((_ name ...)
-     (eval-when (eval load compile expand)
-       (call-with-deferred-observers
-        (lambda ()
-          (module-export! (current-module) '(name ...))))))))
+(define-syntax-rule (export name ...)
+  (eval-when (eval load compile expand)
+    (call-with-deferred-observers
+     (lambda ()
+       (module-export! (current-module) '(name ...))))))
 
-(define-syntax re-export
-  (syntax-rules ()
-    ((_ name ...)
-     (eval-when (eval load compile expand)
-       (call-with-deferred-observers
-        (lambda ()
-          (module-re-export! (current-module) '(name ...))))))))
+(define-syntax-rule (re-export name ...)
+  (eval-when (eval load compile expand)
+    (call-with-deferred-observers
+     (lambda ()
+       (module-re-export! (current-module) '(name ...))))))
 
-(define-syntax export!
-  (syntax-rules ()
-    ((_ name ...)
-     (eval-when (eval load compile expand)
-       (call-with-deferred-observers
-        (lambda ()
-          (module-replace! (current-module) '(name ...))))))))
+(define-syntax-rule (export! name ...)
+  (eval-when (eval load compile expand)
+    (call-with-deferred-observers
+     (lambda ()
+       (module-replace! (current-module) '(name ...))))))
 
-(define-syntax export-syntax
-  (syntax-rules ()
-    ((_ name ...)
-     (export name ...))))
+(define-syntax-rule (export-syntax name ...)
+  (export name ...))
 
-(define-syntax re-export-syntax
-  (syntax-rules ()
-    ((_ name ...)
-     (re-export name ...))))
+(define-syntax-rule (re-export-syntax name ...)
+  (re-export name ...))
 
 
 
diff --git a/module/ice-9/control.scm b/module/ice-9/control.scm
index 908e0e938..5f25738fa 100644
--- a/module/ice-9/control.scm
+++ b/module/ice-9/control.scm
@@ -60,20 +60,16 @@
 ;; http://okmij.org/ftp/Scheme/delim-control-n.scm, which are in the
 ;; public domain, as noted at the top of http://okmij.org/ftp/.
 ;; 
-(define-syntax reset
-  (syntax-rules ()
-    ((_ . body)
-     (call-with-prompt (default-prompt-tag)
-                       (lambda () . body)
-                       (lambda (cont f) (f cont))))))
+(define-syntax-rule (reset . body)
+  (call-with-prompt (default-prompt-tag)
+                    (lambda () . body)
+                    (lambda (cont f) (f cont))))
 
-(define-syntax shift
-  (syntax-rules ()
-    ((_ var . body)
-     (abort-to-prompt (default-prompt-tag)
-                      (lambda (cont)
-                        ((lambda (var) (reset . body))
-                         (lambda vals (reset (apply cont vals)))))))))
+(define-syntax-rule (shift var . body)
+  (abort-to-prompt (default-prompt-tag)
+                   (lambda (cont)
+                     ((lambda (var) (reset . body))
+                      (lambda vals (reset (apply cont vals)))))))
 
 (define (reset* thunk)
   (reset (thunk)))
diff --git a/module/ice-9/futures.scm b/module/ice-9/futures.scm
index 012ebbf3f..3c4cd7d2c 100644
--- a/module/ice-9/futures.scm
+++ b/module/ice-9/futures.scm
@@ -173,8 +173,6 @@ touched."
 ;;; Syntax.
 ;;;
 
-(define-syntax future
-  (syntax-rules ()
-    "Return a new future for BODY."
-    ((_ body)
-     (make-future (lambda () body)))))
+(define-syntax-rule (future body)
+  "Return a new future for BODY."
+  (make-future (lambda () body)))
diff --git a/module/ice-9/optargs.scm b/module/ice-9/optargs.scm
index 50a829912..dc4ec9571 100644
--- a/module/ice-9/optargs.scm
+++ b/module/ice-9/optargs.scm
@@ -1,6 +1,6 @@
 ;;;; optargs.scm -- support for optional arguments
 ;;;;
-;;;; 	Copyright (C) 1997, 1998, 1999, 2001, 2002, 2004, 2006, 2009, 2010 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 1997, 1998, 1999, 2001, 2002, 2004, 2006, 2009, 2010, 2011 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -278,12 +278,10 @@
        #'(define-macro id doc (lambda* args b0 b1 ...)))
       ((_ id args b0 b1 ...) 
        #'(define-macro id #f (lambda* args b0 b1 ...))))))
-(define-syntax defmacro*-public
-  (syntax-rules ()
-    ((_ id args b0 b1 ...)
-     (begin
-       (defmacro* id args b0 b1 ...)
-       (export-syntax id)))))
+(define-syntax-rule (defmacro*-public id args b0 b1 ...)
+  (begin
+    (defmacro* id args b0 b1 ...)
+    (export-syntax id)))
 
 ;;; Support for optional & keyword args with the interpreter.
 (define *uninitialized* (list 'uninitialized))
diff --git a/module/ice-9/poll.scm b/module/ice-9/poll.scm
index 26b264b8e..cf61294d7 100644
--- a/module/ice-9/poll.scm
+++ b/module/ice-9/poll.scm
@@ -1,6 +1,6 @@
 ;; poll
 
-;;;; Copyright (C) 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -68,9 +68,8 @@
   (ports pset-ports set-pset-ports!)
   )
 
-(define-syntax pollfd-offset
-  (syntax-rules ()
-    ((_ n) (* n 8))))
+(define-syntax-rule (pollfd-offset n)
+  (* n 8))
 
 (define* (make-empty-poll-set #:optional (pre-allocated 4))
   (make-poll-set (make-bytevector (pollfd-offset pre-allocated) 0)
diff --git a/module/ice-9/receive.scm b/module/ice-9/receive.scm
index f4f4d81a9..c931b5936 100644
--- a/module/ice-9/receive.scm
+++ b/module/ice-9/receive.scm
@@ -1,6 +1,6 @@
 ;;;; SRFI-8
 
-;;; Copyright (C) 2000, 2001, 2004, 2006, 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2000, 2001, 2004, 2006, 2010, 2011 Free Software Foundation, Inc.
 ;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -17,14 +17,10 @@
 ;;;; Foundation, Inc., 51 Franklin Street, Fifth Floor, Boston, MA 02110-1301 USA
 
 (define-module (ice-9 receive)
-  :export (receive)
-  :no-backtrace
-  )
+  #:export (receive))
 
-(define-syntax receive
-  (syntax-rules ()
-    ((receive vars vals . body)
-     (call-with-values (lambda () vals)
-       (lambda vars . body)))))
+(define-syntax-rule (receive vars vals . body)
+  (call-with-values (lambda () vals)
+    (lambda vars . body)))
 
 (cond-expand-provide (current-module) '(srfi-8))
diff --git a/module/ice-9/threads.scm b/module/ice-9/threads.scm
index ee7ff267c..047a73373 100644
--- a/module/ice-9/threads.scm
+++ b/module/ice-9/threads.scm
@@ -1,4 +1,4 @@
-;;;; 	Copyright (C) 1996, 1998, 2001, 2002, 2003, 2006, 2010 Free Software Foundation, Inc.
+;;;; 	Copyright (C) 1996, 1998, 2001, 2002, 2003, 2006, 2010, 2011 Free Software Foundation, Inc.
 ;;;;
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -51,12 +51,10 @@
 
 ;;; Macros first, so that the procedures expand correctly.
 
-(define-syntax begin-thread
-  (syntax-rules ()
-    ((_ e0 e1 ...)
-     (call-with-new-thread
-      (lambda () e0 e1 ...)
-      %thread-handler))))
+(define-syntax-rule (begin-thread e0 e1 ...)
+  (call-with-new-thread
+   (lambda () e0 e1 ...)
+   %thread-handler))
 
 (define-syntax parallel
   (lambda (x)
@@ -67,35 +65,27 @@
                  ...)
              (values (touch tmp0) ...)))))))
 
-(define-syntax letpar
-  (syntax-rules ()
-    ((_ ((v e) ...) b0 b1 ...)
-     (call-with-values
-         (lambda () (parallel e ...))
-       (lambda (v ...)
-         b0 b1 ...)))))
-
-(define-syntax make-thread
-  (syntax-rules ()
-    ((_ proc arg ...)
-     (call-with-new-thread
-      (lambda () (proc arg ...))
-      %thread-handler))))
-
-(define-syntax with-mutex
-  (syntax-rules ()
-    ((_ m e0 e1 ...)
-     (let ((x m))
-       (dynamic-wind
-         (lambda () (lock-mutex x))
-         (lambda () (begin e0 e1 ...))
-         (lambda () (unlock-mutex x)))))))
-
-(define-syntax monitor
-  (syntax-rules ()
-    ((_ first rest ...)
-     (with-mutex (make-mutex)
-       first rest ...))))
+(define-syntax-rule (letpar ((v e) ...) b0 b1 ...)
+  (call-with-values
+      (lambda () (parallel e ...))
+    (lambda (v ...)
+      b0 b1 ...)))
+
+(define-syntax-rule (make-thread proc arg ...)
+  (call-with-new-thread
+   (lambda () (proc arg ...))
+   %thread-handler))
+
+(define-syntax-rule (with-mutex m e0 e1 ...)
+  (let ((x m))
+    (dynamic-wind
+      (lambda () (lock-mutex x))
+      (lambda () (begin e0 e1 ...))
+      (lambda () (unlock-mutex x)))))
+
+(define-syntax-rule (monitor first rest ...)
+  (with-mutex (make-mutex)
+    first rest ...))
 
 (define (par-mapper mapper)
   (lambda (proc . arglists)
diff --git a/module/ice-9/vlist.scm b/module/ice-9/vlist.scm
index d5e28d540..4b40b9932 100644
--- a/module/ice-9/vlist.scm
+++ b/module/ice-9/vlist.scm
@@ -70,14 +70,12 @@
     (fluid-set! f 2)
     f))
 
-(define-syntax define-inline
+(define-syntax-rule (define-inline (name formals ...) body ...)
   ;; Work around the lack of an inliner.
-  (syntax-rules ()
-    ((_ (name formals ...) body ...)
-     (define-syntax name
-       (syntax-rules ()
-         ((_ formals ...)
-          (begin body ...)))))))
+  (define-syntax name
+    (syntax-rules ()
+      ((_ formals ...)
+       (begin body ...)))))
 
 (define-inline (make-block base offset size hash-tab?)
   ;; Return a block (and block descriptor) of SIZE elements pointing to BASE
@@ -90,11 +88,9 @@
           base offset size 0
           (and hash-tab? (make-vector size #f))))
 
-(define-syntax define-block-accessor
-  (syntax-rules ()
-    ((_ name index)
-     (define-inline (name block)
-       (vector-ref block index)))))
+(define-syntax-rule (define-block-accessor name index)
+  (define-inline (name block)
+    (vector-ref block index)))
 
 (define-block-accessor block-content 0)
 (define-block-accessor block-base 1)
diff --git a/module/language/assembly/compile-bytecode.scm b/module/language/assembly/compile-bytecode.scm
index 163ffccdc..85805a523 100644
--- a/module/language/assembly/compile-bytecode.scm
+++ b/module/language/assembly/compile-bytecode.scm
@@ -28,16 +28,14 @@
   #:export (compile-bytecode))
 
 (define (compile-bytecode assembly env . opts)
-  (define-syntax define-inline1
-    (syntax-rules ()
-      ((_ (proc arg) body body* ...)
-       (define-syntax proc
-         (syntax-rules ()
-           ((_ (arg-expr (... ...)))
-            (let ((x (arg-expr (... ...))))
-              (proc x)))
-           ((_ arg)
-            (begin body body* ...)))))))
+  (define-syntax-rule (define-inline1 (proc arg) body body* ...)
+    (define-syntax proc
+      (syntax-rules ()
+        ((_ (arg-expr (... ...)))
+         (let ((x (arg-expr (... ...))))
+           (proc x)))
+        ((_ arg)
+         (begin body body* ...)))))
        
   (define (fill-bytecode bv target-endianness)
     (let ((pos 0))
diff --git a/module/language/ecmascript/compile-tree-il.scm b/module/language/ecmascript/compile-tree-il.scm
index c46fd621d..a2401f442 100644
--- a/module/language/ecmascript/compile-tree-il.scm
+++ b/module/language/ecmascript/compile-tree-il.scm
@@ -25,20 +25,14 @@
   #:use-module (srfi srfi-1)
   #:export (compile-tree-il))
 
-(define-syntax ->
-  (syntax-rules ()
-    ((_ (type arg ...))
-     `(type ,arg ...))))
+(define-syntax-rule (-> (type arg ...))
+  `(type ,arg ...))
 
-(define-syntax @implv
-  (syntax-rules ()
-    ((_ sym)
-     (-> (@ '(language ecmascript impl) 'sym)))))
+(define-syntax-rule (@implv sym)
+  (-> (@ '(language ecmascript impl) 'sym)))
 
-(define-syntax @impl
-  (syntax-rules ()
-    ((_ sym arg ...)
-     (-> (apply (@implv sym) arg ...)))))
+(define-syntax-rule (@impl sym arg ...)
+  (-> (apply (@implv sym) arg ...)))
 
 (define (empty-lexical-environment)
   '())
@@ -67,16 +61,14 @@
 ;; for emacs:
 ;; (put 'pmatch/source 'scheme-indent-function 1)
 
-(define-syntax pmatch/source
-  (syntax-rules ()
-    ((_ x clause ...)
-     (let ((x x))
-       (let ((res (pmatch x
-                    clause ...)))
-         (let ((loc (location x)))
-           (if loc
-               (set-source-properties! res (location x))))
-         res)))))
+(define-syntax-rule (pmatch/source x clause ...)
+  (let ((x x))
+    (let ((res (pmatch x
+                 clause ...)))
+      (let ((loc (location x)))
+        (if loc
+            (set-source-properties! res (location x))))
+      res)))
 
 (define (comp x e)
   (let ((l (location x)))
diff --git a/module/language/tree-il.scm b/module/language/tree-il.scm
index decd3637c..580ebdace 100644
--- a/module/language/tree-il.scm
+++ b/module/language/tree-il.scm
@@ -554,81 +554,79 @@ This is an implementation of `foldts' as described by Andy Wingo in
            (leaf tree result))))))
 
 
-(define-syntax make-tree-il-folder
-  (syntax-rules ()
-    ((_ seed ...)
-     (lambda (tree down up seed ...)
-       (define (fold-values proc exps seed ...)
-         (if (null? exps)
-             (values seed ...)
-             (let-values (((seed ...) (proc (car exps) seed ...)))
-               (fold-values proc (cdr exps) seed ...))))
-       (let foldts ((tree tree) (seed seed) ...)
-         (let*-values
-             (((seed ...) (down tree seed ...))
-              ((seed ...)
-               (record-case tree
-                 ((<lexical-set> exp)
-                  (foldts exp seed ...))
-                 ((<module-set> exp)
-                  (foldts exp seed ...))
-                 ((<toplevel-set> exp)
-                  (foldts exp seed ...))
-                 ((<toplevel-define> exp)
-                  (foldts exp seed ...))
-                 ((<conditional> test consequent alternate)
-                  (let*-values (((seed ...) (foldts test seed ...))
-                                ((seed ...) (foldts consequent seed ...)))
-                    (foldts alternate seed ...)))
-                 ((<application> proc args)
-                  (let-values (((seed ...) (foldts proc seed ...)))
-                    (fold-values foldts args seed ...)))
-                 ((<sequence> exps)
-                  (fold-values foldts exps seed ...))
-                 ((<lambda> body)
-                  (foldts body seed ...))
-                 ((<lambda-case> inits body alternate)
-                  (let-values (((seed ...) (fold-values foldts inits seed ...)))
-                    (if alternate
-                        (let-values (((seed ...) (foldts body seed ...)))
-                          (foldts alternate seed ...))
-                        (foldts body seed ...))))
-                 ((<let> vals body)
-                  (let*-values (((seed ...) (fold-values foldts vals seed ...)))
-                    (foldts body seed ...)))
-                 ((<letrec> vals body)
-                  (let*-values (((seed ...) (fold-values foldts vals seed ...)))
-                    (foldts body seed ...)))
-                 ((<fix> vals body)
-                  (let*-values (((seed ...) (fold-values foldts vals seed ...)))
-                    (foldts body seed ...)))
-                 ((<let-values> exp body)
-                  (let*-values (((seed ...) (foldts exp seed ...)))
-                    (foldts body seed ...)))
-                 ((<dynwind> body winder unwinder)
-                  (let*-values (((seed ...) (foldts body seed ...))
-                                ((seed ...) (foldts winder seed ...)))
-                    (foldts unwinder seed ...)))
-                 ((<dynlet> fluids vals body)
-                  (let*-values (((seed ...) (fold-values foldts fluids seed ...))
-                                ((seed ...) (fold-values foldts vals seed ...)))
-                    (foldts body seed ...)))
-                 ((<dynref> fluid)
-                  (foldts fluid seed ...))
-                 ((<dynset> fluid exp)
-                  (let*-values (((seed ...) (foldts fluid seed ...)))
-                    (foldts exp seed ...)))
-                 ((<prompt> tag body handler)
-                  (let*-values (((seed ...) (foldts tag seed ...))
-                                ((seed ...) (foldts body seed ...)))
-                    (foldts handler seed ...)))
-                 ((<abort> tag args tail)
-                  (let*-values (((seed ...) (foldts tag seed ...))
-                                ((seed ...) (fold-values foldts args seed ...)))
-                    (foldts tail seed ...)))
-                 (else
-                  (values seed ...)))))
-           (up tree seed ...)))))))
+(define-syntax-rule (make-tree-il-folder seed ...)
+  (lambda (tree down up seed ...)
+    (define (fold-values proc exps seed ...)
+      (if (null? exps)
+          (values seed ...)
+          (let-values (((seed ...) (proc (car exps) seed ...)))
+            (fold-values proc (cdr exps) seed ...))))
+    (let foldts ((tree tree) (seed seed) ...)
+      (let*-values
+          (((seed ...) (down tree seed ...))
+           ((seed ...)
+            (record-case tree
+              ((<lexical-set> exp)
+               (foldts exp seed ...))
+              ((<module-set> exp)
+               (foldts exp seed ...))
+              ((<toplevel-set> exp)
+               (foldts exp seed ...))
+              ((<toplevel-define> exp)
+               (foldts exp seed ...))
+              ((<conditional> test consequent alternate)
+               (let*-values (((seed ...) (foldts test seed ...))
+                             ((seed ...) (foldts consequent seed ...)))
+                 (foldts alternate seed ...)))
+              ((<application> proc args)
+               (let-values (((seed ...) (foldts proc seed ...)))
+                 (fold-values foldts args seed ...)))
+              ((<sequence> exps)
+               (fold-values foldts exps seed ...))
+              ((<lambda> body)
+               (foldts body seed ...))
+              ((<lambda-case> inits body alternate)
+               (let-values (((seed ...) (fold-values foldts inits seed ...)))
+                 (if alternate
+                     (let-values (((seed ...) (foldts body seed ...)))
+                       (foldts alternate seed ...))
+                     (foldts body seed ...))))
+              ((<let> vals body)
+               (let*-values (((seed ...) (fold-values foldts vals seed ...)))
+                 (foldts body seed ...)))
+              ((<letrec> vals body)
+               (let*-values (((seed ...) (fold-values foldts vals seed ...)))
+                 (foldts body seed ...)))
+              ((<fix> vals body)
+               (let*-values (((seed ...) (fold-values foldts vals seed ...)))
+                 (foldts body seed ...)))
+              ((<let-values> exp body)
+               (let*-values (((seed ...) (foldts exp seed ...)))
+                 (foldts body seed ...)))
+              ((<dynwind> body winder unwinder)
+               (let*-values (((seed ...) (foldts body seed ...))
+                             ((seed ...) (foldts winder seed ...)))
+                 (foldts unwinder seed ...)))
+              ((<dynlet> fluids vals body)
+               (let*-values (((seed ...) (fold-values foldts fluids seed ...))
+                             ((seed ...) (fold-values foldts vals seed ...)))
+                 (foldts body seed ...)))
+              ((<dynref> fluid)
+               (foldts fluid seed ...))
+              ((<dynset> fluid exp)
+               (let*-values (((seed ...) (foldts fluid seed ...)))
+                 (foldts exp seed ...)))
+              ((<prompt> tag body handler)
+               (let*-values (((seed ...) (foldts tag seed ...))
+                             ((seed ...) (foldts body seed ...)))
+                 (foldts handler seed ...)))
+              ((<abort> tag args tail)
+               (let*-values (((seed ...) (foldts tag seed ...))
+                             ((seed ...) (fold-values foldts args seed ...)))
+                 (foldts tail seed ...)))
+              (else
+               (values seed ...)))))
+        (up tree seed ...)))))
 
 (define (post-order! f x)
   (let lp ((x x))
diff --git a/module/oop/goops.scm b/module/oop/goops.scm
index 0845d29e9..e1908abf0 100644
--- a/module/oop/goops.scm
+++ b/module/oop/goops.scm
@@ -288,21 +288,18 @@
        #'(define-class-pre-definitions (rest ...) 
          out ... (define-class-pre-definition (slotopt ...)))))))
 
-(define-syntax define-class
-  (syntax-rules ()
-    ((_ name supers slot ...)
-     (begin
-       (define-class-pre-definitions (slot ...))
-       (if (and (defined? 'name)
-                (is-a? name <class>)
-                (memq <object> (class-precedence-list name)))
-           (class-redefinition name
-                               (class supers slot ... #:name 'name))
-           (toplevel-define! 'name (class supers slot ... #:name 'name)))))))
+(define-syntax-rule (define-class name supers slot ...)
+  (begin
+    (define-class-pre-definitions (slot ...))
+    (if (and (defined? 'name)
+             (is-a? name <class>)
+             (memq <object> (class-precedence-list name)))
+        (class-redefinition name
+                            (class supers slot ... #:name 'name))
+        (toplevel-define! 'name (class supers slot ... #:name 'name)))))
        
-(define-syntax standard-define-class
-  (syntax-rules ()
-    ((_ arg ...) (define-class arg ...))))
+(define-syntax-rule (standard-define-class arg ...)
+  (define-class arg ...))
 
 ;;;
 ;;; {Generic functions and accessors}
@@ -390,13 +387,11 @@
         (else (make <generic> #:name name))))
 
 ;; same semantics as <generic>
-(define-syntax define-accessor
-  (syntax-rules ()
-    ((_ name)
-     (define name
-       (cond ((not (defined? 'name))  (ensure-accessor #f 'name))
-             ((is-a? name <accessor>) (make <accessor> #:name 'name))
-             (else                    (ensure-accessor name 'name)))))))
+(define-syntax-rule (define-accessor name)
+  (define name
+    (cond ((not (defined? 'name))  (ensure-accessor #f 'name))
+          ((is-a? name <accessor>) (make <accessor> #:name 'name))
+          (else                    (ensure-accessor name 'name)))))
 
 (define (make-setter-name name)
   (string->symbol (string-append "setter:" (symbol->string name))))
diff --git a/module/oop/goops/simple.scm b/module/oop/goops/simple.scm
index 8f4d839c1..fba4d4192 100644
--- a/module/oop/goops/simple.scm
+++ b/module/oop/goops/simple.scm
@@ -1,6 +1,6 @@
 ;;; installed-scm-file
 
-;;;; Copyright (C) 2005, 2006, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2005, 2006, 2010, 2011 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -23,10 +23,8 @@
   :export (define-class)
   :no-backtrace)
 
-(define-syntax define-class
-  (syntax-rules ()
-    ((_ arg ...)
-     (define-class-with-accessors-keywords arg ...))))
+(define-syntax-rule (define-class arg ...)
+  (define-class-with-accessors-keywords arg ...))
 
 (module-use! (module-public-interface (current-module))
              (resolve-interface '(oop goops)))
diff --git a/module/oop/goops/stklos.scm b/module/oop/goops/stklos.scm
index 8a7ae1636..45272fa19 100644
--- a/module/oop/goops/stklos.scm
+++ b/module/oop/goops/stklos.scm
@@ -1,4 +1,4 @@
-;;;; Copyright (C) 1999,2002, 2006, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999,2002, 2006, 2010, 2011 Free Software Foundation, Inc.
 ;;;; 
 ;;;; This library is free software; you can redistribute it and/or
 ;;;; modify it under the terms of the GNU Lesser General Public
@@ -47,10 +47,8 @@
 ;;; Enable keyword support (*fixme*---currently this has global effect)
 (read-set! keywords 'prefix)
 
-(define-syntax define-class
-  (syntax-rules ()
-    ((_ name supers (slot ...) rest ...)
-     (standard-define-class name supers slot ... rest ...))))
+(define-syntax-rule (define-class name supers (slot ...) rest ...)
+  (standard-define-class name supers slot ... rest ...))
 
 (define (toplevel-define! name val)
   (module-define! (current-module) name val))
diff --git a/module/srfi/srfi-1.scm b/module/srfi/srfi-1.scm
index 765bd50e9..d2347b0d1 100644
--- a/module/srfi/srfi-1.scm
+++ b/module/srfi/srfi-1.scm
@@ -240,11 +240,9 @@ higher-order procedures."
   (scm-error 'wrong-type-arg (symbol->string caller)
              "Wrong type argument: ~S" (list arg) '()))
 
-(define-syntax check-arg
-  (syntax-rules ()
-    ((_ pred arg caller)
-     (if (not (pred arg))
-         (wrong-type-arg 'caller arg)))))
+(define-syntax-rule (check-arg pred arg caller)
+  (if (not (pred arg))
+      (wrong-type-arg 'caller arg)))
 
 (define (out-of-range proc arg)
   (scm-error 'out-of-range proc
diff --git a/module/srfi/srfi-35.scm b/module/srfi/srfi-35.scm
index 7f1ff7fc9..d2b9c9420 100644
--- a/module/srfi/srfi-35.scm
+++ b/module/srfi/srfi-35.scm
@@ -1,6 +1,6 @@
 ;;; srfi-35.scm --- Conditions                 -*- coding: utf-8 -*-
 
-;; Copyright (C) 2007, 2008, 2009, 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2007, 2008, 2009, 2010, 2011 Free Software Foundation, Inc.
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -295,24 +295,20 @@ by C."
 ;;; Syntax.
 ;;;
 
-(define-syntax define-condition-type
-  (syntax-rules ()
-    ((_ name parent pred (field-name field-accessor) ...)
-     (begin
-       (define name
-         (make-condition-type 'name parent '(field-name ...)))
-       (define (pred c)
-         (condition-has-type? c name))
-       (define (field-accessor c)
-         (condition-ref c 'field-name))
-       ...))))
-
-(define-syntax compound-condition
+(define-syntax-rule (define-condition-type name parent pred (field-name field-accessor) ...)
+  (begin
+    (define name
+      (make-condition-type 'name parent '(field-name ...)))
+    (define (pred c)
+      (condition-has-type? c name))
+    (define (field-accessor c)
+      (condition-ref c 'field-name))
+    ...))
+
+(define-syntax-rule (compound-condition (type ...) (field ...))
   ;; Create a compound condition using `make-compound-condition-type'.
-  (syntax-rules ()
-    ((_ (type ...) (field ...))
-     (condition ((make-compound-condition-type '%compound `(,type ...))
-                 field ...)))))
+  (condition ((make-compound-condition-type '%compound `(,type ...))
+              field ...)))
 
 (define-syntax condition-instantiation
   ;; Build the `(make-condition type ...)' call.
diff --git a/module/srfi/srfi-39.scm b/module/srfi/srfi-39.scm
index 61e67b820..dba86fdbb 100644
--- a/module/srfi/srfi-39.scm
+++ b/module/srfi/srfi-39.scm
@@ -1,6 +1,6 @@
 ;;; srfi-39.scm --- Parameter objects
 
-;; 	Copyright (C) 2004, 2005, 2006, 2008 Free Software Foundation, Inc.
+;; 	Copyright (C) 2004, 2005, 2006, 2008, 2011 Free Software Foundation, Inc.
 ;;
 ;; This library is free software; you can redistribute it and/or
 ;; modify it under the terms of the GNU Lesser General Public
@@ -69,12 +69,10 @@
          ((null? (cdr new-value)) (fluid-set! value (conv (car new-value))))
          (else (error "make-parameter expects 0 or 1 arguments" new-value)))))))
 
-(define-syntax parameterize
-  (syntax-rules ()
-    ((_ ((?param ?value) ...) ?body ...)
-     (with-parameters* (list ?param ...)
-                       (list ?value ...)
-                       (lambda () ?body ...)))))
+(define-syntax-rule (parameterize ((?param ?value) ...) ?body ...)
+  (with-parameters* (list ?param ...)
+                    (list ?value ...)
+                    (lambda () ?body ...)))
 
 (define (current-input-port . new-value)
   (if (null? new-value)
diff --git a/module/srfi/srfi-45.scm b/module/srfi/srfi-45.scm
index 1b912befc..29b0393ff 100644
--- a/module/srfi/srfi-45.scm
+++ b/module/srfi/srfi-45.scm
@@ -1,6 +1,6 @@
 ;;; srfi-45.scm -- Primitives for Expressing Iterative Lazy Algorithms
 
-;; Copyright (C) 2010 Free Software Foundation, Inc.
+;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
 ;; Copyright (C) 2003 André van Tonder. All Rights Reserved.
 
 ;; Permission is hereby granted, free of charge, to any person
@@ -47,17 +47,14 @@
   (tag value-tag value-tag-set!)
   (proc value-proc value-proc-set!))
 
-(define-syntax lazy
-  (syntax-rules ()
-    ((lazy exp)
-     (make-promise (make-value 'lazy (lambda () exp))))))
+(define-syntax-rule (lazy exp)
+  (make-promise (make-value 'lazy (lambda () exp))))
 
 (define (eager x)
   (make-promise (make-value 'eager x)))
 
-(define-syntax delay
-  (syntax-rules ()
-    ((delay exp) (lazy (eager exp)))))
+(define-syntax-rule (delay exp)
+  (lazy (eager exp)))
 
 (define (force promise)
   (let ((content (promise-val promise)))
diff --git a/module/srfi/srfi-67/compare.scm b/module/srfi/srfi-67/compare.scm
index 21b0e94c4..2ab947ece 100644
--- a/module/srfi/srfi-67/compare.scm
+++ b/module/srfi/srfi-67/compare.scm
@@ -1,3 +1,4 @@
+; Copyright (c) 2011 Free Software Foundation, Inc.
 ; Copyright (c) 2005 Sebastian Egner and Jens Axel S{\o}gaard.
 ; 
 ; Permission is hereby granted, free of charge, to any person obtaining
@@ -88,14 +89,12 @@
 
 ; 3-sided conditional
 
-(define-syntax if3
-  (syntax-rules ()
-    ((if3 c less equal greater)
-     (case c
-       ((-1) less)
-       (( 0) equal)
-       (( 1) greater)
-       (else (error "comparison value not in {-1,0,1}"))))))
+(define-syntax-rule (if3 c less equal greater)
+  (case c
+    ((-1) less)
+    (( 0) equal)
+    (( 1) greater)
+    (else (error "comparison value not in {-1,0,1}"))))
 
 
 ; 2-sided conditionals for comparisons
@@ -110,51 +109,37 @@
        (a-cases alternate)
        (else    (error "comparison value not in {-1,0,1}"))))))
 
-(define-syntax if=?
-  (syntax-rules ()
-    ((if=? arg ...)
-     (compare:if-rel? (0) (-1 1) arg ...))))
+(define-syntax-rule (if=? arg ...)
+  (compare:if-rel? (0) (-1 1) arg ...))
 
-(define-syntax if<?
-  (syntax-rules ()
-    ((if<? arg ...)
-     (compare:if-rel? (-1) (0 1) arg ...))))
+(define-syntax-rule (if<? arg ...)
+  (compare:if-rel? (-1) (0 1) arg ...))
 
-(define-syntax if>?
-  (syntax-rules ()
-    ((if>? arg ...)
-     (compare:if-rel? (1) (-1 0) arg ...))))
+(define-syntax-rule (if>? arg ...)
+  (compare:if-rel? (1) (-1 0) arg ...))
 
-(define-syntax if<=?
-  (syntax-rules ()
-    ((if<=? arg ...)
-     (compare:if-rel? (-1 0) (1) arg ...))))
+(define-syntax-rule (if<=? arg ...)
+  (compare:if-rel? (-1 0) (1) arg ...))
 
-(define-syntax if>=?
-  (syntax-rules ()
-    ((if>=? arg ...)
-     (compare:if-rel? (0 1) (-1) arg ...))))
+(define-syntax-rule (if>=? arg ...)
+  (compare:if-rel? (0 1) (-1) arg ...))
 
-(define-syntax if-not=?
-  (syntax-rules ()
-    ((if-not=? arg ...)
-     (compare:if-rel? (-1 1) (0) arg ...))))
+(define-syntax-rule if- (not=? arg ...)
+  (compare:if-rel? (-1 1) (0) arg ...))
 
 
 ; predicates from compare procedures
 
-(define-syntax compare:define-rel?
-  (syntax-rules ()
-    ((compare:define-rel? rel? if-rel?)
-     (define rel?
-       (case-lambda
-	(()        (lambda (x y) (if-rel? (default-compare x y) #t #f)))
-	((compare) (lambda (x y) (if-rel? (compare         x y) #t #f)))
-	((x y)                   (if-rel? (default-compare x y) #t #f))
-	((compare x y)
-	 (if (procedure? compare)
-	     (if-rel? (compare x y) #t #f)
-	     (error "not a procedure (Did you mean rel/rel??): " compare))))))))
+(define-syntax-rule compare:define- (rel? rel? if-rel?)
+  (define rel?
+    (case-lambda
+      (()        (lambda (x y) (if-rel? (default-compare x y) #t #f)))
+      ((compare) (lambda (x y) (if-rel? (compare         x y) #t #f)))
+      ((x y)                   (if-rel? (default-compare x y) #t #f))
+      ((compare x y)
+       (if (procedure? compare)
+           (if-rel? (compare x y) #t #f)
+           (error "not a procedure (Did you mean rel/rel??): " compare))))))
 
 (compare:define-rel? =?    if=?)
 (compare:define-rel? <?    if<?)
@@ -166,29 +151,27 @@
 
 ; chains of length 3
 
-(define-syntax compare:define-rel1/rel2?
-  (syntax-rules ()
-    ((compare:define-rel1/rel2? rel1/rel2? if-rel1? if-rel2?)
-     (define rel1/rel2?
-       (case-lambda
-	(()
-	 (lambda (x y z)
-	   (if-rel1? (default-compare x y)
-		     (if-rel2? (default-compare y z) #t #f)
-		     (compare:checked #f default-compare z))))
-	((compare)
-	 (lambda (x y z)
-	   (if-rel1? (compare x y)
-		(if-rel2? (compare y z) #t #f)
-		(compare:checked #f compare z))))
-	((x y z)
-	 (if-rel1? (default-compare x y)
-	       (if-rel2? (default-compare y z) #t #f)
-	       (compare:checked #f default-compare z)))
-	((compare x y z)
-	 (if-rel1? (compare x y)
-	       (if-rel2? (compare y z) #t #f)
-	       (compare:checked #f compare z))))))))
+(define-syntax-rule compare:define-rel1/ (rel2? rel1/rel2? if-rel1? if-rel2?)
+  (define rel1/rel2?
+    (case-lambda
+      (()
+       (lambda (x y z)
+         (if-rel1? (default-compare x y)
+                   (if-rel2? (default-compare y z) #t #f)
+                   (compare:checked #f default-compare z))))
+      ((compare)
+       (lambda (x y z)
+         (if-rel1? (compare x y)
+                   (if-rel2? (compare y z) #t #f)
+                   (compare:checked #f compare z))))
+      ((x y z)
+       (if-rel1? (default-compare x y)
+                 (if-rel2? (default-compare y z) #t #f)
+                 (compare:checked #f default-compare z)))
+      ((compare x y z)
+       (if-rel1? (compare x y)
+                 (if-rel2? (compare y z) #t #f)
+                 (compare:checked #f compare z))))))
 
 (compare:define-rel1/rel2? </<?   if<?  if<?)
 (compare:define-rel1/rel2? </<=?  if<?  if<=?)
@@ -202,31 +185,29 @@
 
 ; chains of arbitrary length
 
-(define-syntax compare:define-chain-rel?
-  (syntax-rules ()
-    ((compare:define-chain-rel? chain-rel? if-rel?)
-     (define chain-rel?
-       (case-lambda
-	((compare)
-	 #t)
-	((compare x1)
-	 (compare:checked #t compare x1))
-	((compare x1 x2)
-	 (if-rel? (compare x1 x2) #t #f))
-	((compare x1 x2 x3)
-	 (if-rel? (compare x1 x2)
-		  (if-rel? (compare x2 x3) #t #f)
-		  (compare:checked #f compare x3)))
-	((compare x1 x2 . x3+)
-	 (if-rel? (compare x1 x2)
-		  (let chain? ((head x2) (tail x3+))
-		    (if (null? tail)
-			#t
-			(if-rel? (compare head (car tail))
-				 (chain? (car tail) (cdr tail))
-				 (apply compare:checked #f 
-					compare (cdr tail)))))
-		  (apply compare:checked #f compare x3+))))))))
+(define-syntax-rule compare:define-chain- (rel? chain-rel? if-rel?)
+  (define chain-rel?
+    (case-lambda
+      ((compare)
+       #t)
+      ((compare x1)
+       (compare:checked #t compare x1))
+      ((compare x1 x2)
+       (if-rel? (compare x1 x2) #t #f))
+      ((compare x1 x2 x3)
+       (if-rel? (compare x1 x2)
+                (if-rel? (compare x2 x3) #t #f)
+                (compare:checked #f compare x3)))
+      ((compare x1 x2 . x3+)
+       (if-rel? (compare x1 x2)
+                (let chain? ((head x2) (tail x3+))
+                  (if (null? tail)
+                      #t
+                      (if-rel? (compare head (car tail))
+                               (chain? (car tail) (cdr tail))
+                               (apply compare:checked #f 
+                                      compare (cdr tail)))))
+                (apply compare:checked #f compare x3+))))))
 
 (compare:define-chain-rel? chain=?  if=?)
 (compare:define-chain-rel? chain<?  if<?)
@@ -468,19 +449,17 @@
      (begin (compare:type-check type? type-name x)
             (compare:type-check type? type-name y)))))
 
-(define-syntax compare:define-by=/<
-  (syntax-rules ()
-    ((compare:define-by=/< compare = < type? type-name)
-     (define compare
-       (let ((= =) (< <))
-	 (lambda (x y)
-	   (if (type? x)
-	       (if (eq? x y)
-		   0
-		   (if (type? y)
-		       (if (= x y) 0 (if (< x y) -1 1))
-		       (error (string-append "not " type-name ":") y)))
-	       (error (string-append "not " type-name ":") x))))))))
+(define-syntax-rule compare:define- (by=/< compare = < type? type-name)
+  (define compare
+    (let ((= =) (< <))
+      (lambda (x y)
+        (if (type? x)
+            (if (eq? x y)
+                0
+                (if (type? y)
+                    (if (= x y) 0 (if (< x y) -1 1))
+                    (error (string-append "not " type-name ":") y)))
+            (error (string-append "not " type-name ":") x))))))
 
 (define (boolean-compare x y)
   (compare:type-check boolean? "boolean" x y)
diff --git a/module/sxml/match.scm b/module/sxml/match.scm
index 9aebc019b..84cbce344 100644
--- a/module/sxml/match.scm
+++ b/module/sxml/match.scm
@@ -1,6 +1,6 @@
 ;;; -*- mode: scheme; coding: utf-8; -*-
 ;;;
-;;; Copyright (C) 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2010, 2011 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software; you can redistribute it and/or modify it
 ;;; under the terms of the GNU Lesser General Public License as published by
@@ -40,34 +40,27 @@
 ;;; PLT compatibility layer.
 ;;;
 
-(define-syntax syntax-object->datum
-  (syntax-rules ()
-    ((_ stx)
-     (syntax->datum stx))))
+(define-syntax-rule (syntax-object->datum stx)
+  (syntax->datum stx))
 
-(define-syntax void
-  (syntax-rules ()
-    ((_) *unspecified*)))
+(define-syntax-rule (void)
+  *unspecified*)
 
 (define %call/ec-prompt
   (make-prompt-tag))
 
-(define-syntax call/ec
+(define-syntax-rule (call/ec proc)
   ;; aka. `call-with-escape-continuation'
-  (syntax-rules ()
-    ((_ proc)
-     (call-with-prompt %call/ec-prompt
-                       (lambda ()
-                         (proc (lambda args
-                                 (apply abort-to-prompt
-                                        %call/ec-prompt args))))
-                       (lambda (_ . args)
-                         (apply values args))))))
+  (call-with-prompt %call/ec-prompt
+                    (lambda ()
+                      (proc (lambda args
+                              (apply abort-to-prompt
+                                     %call/ec-prompt args))))
+                    (lambda (_ . args)
+                      (apply values args))))
 
-(define-syntax let/ec
-  (syntax-rules ()
-    ((_ cont body ...)
-     (call/ec (lambda (cont) body ...)))))
+(define-syntax-rule (let/ec cont body ...)
+  (call/ec (lambda (cont) body ...)))
 
 (define (raise-syntax-error x msg obj sub)
   (throw 'sxml-match-error x msg obj sub))
diff --git a/module/system/repl/error-handling.scm b/module/system/repl/error-handling.scm
index c6c64cc73..2a585aaff 100644
--- a/module/system/repl/error-handling.scm
+++ b/module/system/repl/error-handling.scm
@@ -182,7 +182,5 @@
                (apply (if (memq k pass-keys) throw on-error) k args))
              (error "Unknown on-error strategy" on-error)))))))
 
-(define-syntax with-error-handling
-  (syntax-rules ()
-    ((_ form)
-     (call-with-error-handling (lambda () form)))))
+(define-syntax-rule (with-error-handling form)
+  (call-with-error-handling (lambda () form)))
diff --git a/module/system/repl/repl.scm b/module/system/repl/repl.scm
index 5bab7780e..1cffa7187 100644
--- a/module/system/repl/repl.scm
+++ b/module/system/repl/repl.scm
@@ -135,15 +135,13 @@
   (run-repl (make-repl lang debug)))
 
 ;; (put 'abort-on-error 'scheme-indent-function 1)
-(define-syntax abort-on-error
-  (syntax-rules ()
-    ((_ string exp)
-     (catch #t
-       (lambda () exp)
-       (lambda (key . args)
-         (format #t "While ~A:~%" string)
-         (print-exception (current-output-port) #f key args)
-         (abort))))))
+(define-syntax-rule (abort-on-error string exp)
+  (catch #t
+    (lambda () exp)
+    (lambda (key . args)
+      (format #t "While ~A:~%" string)
+      (print-exception (current-output-port) #f key args)
+      (abort))))
 
 (define (run-repl repl)
   (define (with-stack-and-prompt thunk)
diff --git a/module/system/vm/inspect.scm b/module/system/vm/inspect.scm
index aebf50d30..1023437bf 100644
--- a/module/system/vm/inspect.scm
+++ b/module/system/vm/inspect.scm
@@ -1,6 +1,6 @@
 ;;; Guile VM debugging facilities
 
-;;; Copyright (C) 2001, 2009, 2010 Free Software Foundation, Inc.
+;;; Copyright (C) 2001, 2009, 2010, 2011 Free Software Foundation, Inc.
 ;;;
 ;;; This library is free software; you can redistribute it and/or
 ;;; modify it under the terms of the GNU Lesser General Public
@@ -81,16 +81,15 @@
 ;;;
 
 (define (inspect x)
-  (define-syntax define-command
-    (syntax-rules ()
-      ((_ ((mod cname alias ...) . args) body ...)
-       (define cname
-         (let ((c (lambda* args body ...)))
-           (set-procedure-property! c 'name 'cname)
-           (module-define! mod 'cname c)
-           (module-add! mod 'alias (module-local-variable mod 'cname))
-           ...
-           c)))))
+  (define-syntax-rule (define-command ((mod cname alias ...) . args)
+                        body ...)
+    (define cname
+      (let ((c (lambda* args body ...)))
+        (set-procedure-property! c 'name 'cname)
+        (module-define! mod 'cname c)
+        (module-add! mod 'alias (module-local-variable mod 'cname))
+        ...
+        c)))
 
   (let ((commands (make-module)))
     (define (prompt)
diff --git a/module/texinfo.scm b/module/texinfo.scm
index 970895ff6..8798eb3c1 100644
--- a/module/texinfo.scm
+++ b/module/texinfo.scm
@@ -77,6 +77,7 @@
   #:use-module (sxml transform)
   #:use-module (sxml ssax input-parse)
   #:use-module (srfi srfi-1)
+  #:use-module (srfi srfi-11)
   #:use-module (srfi srfi-13)
   #:export (call-with-file-and-dir
             texi-command-specs
@@ -103,25 +104,6 @@ files by relative path name."
           (call-with-input-file (basename filename) proc))
         (lambda () (chdir current-dir)))))
 
-;; Define this version here, because (srfi srfi-11)'s definition uses
-;; syntax-rules, which is really damn slow
-(define-macro (let*-values bindings . body)
-  (if (null? bindings) (cons 'begin body)
-      (apply
-       (lambda (vars initializer)
-	 (let ((cont 
-		(cons 'let*-values
-		      (cons (cdr bindings) body))))
-	   (cond
-	    ((not (pair? vars))		; regular let case, a single var
-	     `(let ((,vars ,initializer)) ,cont))
-	    ((null? (cdr vars))		; single var, see the prev case
-	     `(let ((,(car vars) ,initializer)) ,cont))
-	   (else			; the most generic case
-	    `(call-with-values (lambda () ,initializer)
-	      (lambda ,vars ,cont))))))
-       (car bindings))))
-
 ;;========================================================================
 ;;            Reflection on the XML vocabulary
 
diff --git a/module/web/server.scm b/module/web/server.scm
index c5e623a19..ef6879ec3 100644
--- a/module/web/server.scm
+++ b/module/web/server.scm
@@ -118,11 +118,9 @@
   (write server-impl-write)
   (close server-impl-close))
 
-(define-syntax define-server-impl
-  (syntax-rules ()
-    ((_ name open read write close)
-     (define name
-       (make-server-impl 'name open read write close)))))
+(define-syntax-rule (define-server-impl name open read write close)
+  (define name
+    (make-server-impl 'name open read write close)))
 
 (define (lookup-server-impl impl)
   "Look up a server implementation.  If @var{impl} is a server
-- 
2.20.1