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

@@ -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
+(define-syntax-rule (delay exp)
-  (syntax-rules ()
+  (make-promise (lambda () exp)))
-    ((_ 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
+(define-syntax-rule (define-once sym val)
-  (syntax-rules ()
-    ((_ sym val)
   (define sym
-       (if (module-locally-bound? (current-module) 'sym) sym val)))))
+    (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
+(define-syntax-rule (false-if-exception expr)
-  (syntax-rules ()
-    ((_ expr)
   (catch #t
     (lambda () expr)
-       (lambda (k . args) #f)))))
+    (lambda (k . args) #f)))
 
 
 
@@ -877,12 +872,10 @@ VALUE."
 ;; properties within the object itself.
 
 (define (make-object-property)
-  (define-syntax with-mutex
+  (define-syntax-rule (with-mutex lock exp)
-    (syntax-rules ()
-      ((_ lock exp)
     (dynamic-wind (lambda () (lock-mutex lock))
                   (lambda () exp)
-                     (lambda () (unlock-mutex lock))))))
+                  (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 ()
+(define-syntax-rule (start-stack tag exp)
-    ((_ tag exp)
+  (%start-stack tag (lambda () 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!
+       (define-syntax-rule (option-set! opt val)
-         (syntax-rules ()
-           ((_ opt val)
          (eval-when (eval load compile expand)
-              (options (append (options) (list 'opt val)))))))))))
+           (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
+(define-syntax-rule (use-syntax spec ...)
-  (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 ...)))))
+    (use-modules spec ...)))
 
 (include-from-path "ice-9/r6rs-libraries")
 
-(define-syntax define-private
+(define-syntax-rule (define-private foo bar)
-  (syntax-rules ()
+  (define foo bar))
-    ((_ 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
+(define-syntax-rule (defmacro-public name args body ...)
-  (syntax-rules ()
-    ((_ name args . body)
   (begin
-       (defmacro name args . body)
+    (defmacro name args body ...)
-       (export-syntax name)))))
+    (export-syntax name)))
 
 ;; And now for the most important macro.
-(define-syntax λ
+(define-syntax-rule (λ formals body ...)
-  (syntax-rules ()
+  (lambda formals body ...))
-    ((_ 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
+(define-syntax-rule (export name ...)
-  (syntax-rules ()
-    ((_ name ...)
   (eval-when (eval load compile expand)
     (call-with-deferred-observers
      (lambda ()
-          (module-export! (current-module) '(name ...))))))))
+       (module-export! (current-module) '(name ...))))))
 
-(define-syntax re-export
+(define-syntax-rule (re-export name ...)
-  (syntax-rules ()
-    ((_ name ...)
   (eval-when (eval load compile expand)
     (call-with-deferred-observers
      (lambda ()
-          (module-re-export! (current-module) '(name ...))))))))
+       (module-re-export! (current-module) '(name ...))))))
 
-(define-syntax export!
+(define-syntax-rule (export! name ...)
-  (syntax-rules ()
-    ((_ name ...)
   (eval-when (eval load compile expand)
     (call-with-deferred-observers
      (lambda ()
-          (module-replace! (current-module) '(name ...))))))))
+       (module-replace! (current-module) '(name ...))))))
 
-(define-syntax export-syntax
+(define-syntax-rule (export-syntax name ...)
-  (syntax-rules ()
+  (export name ...))
-    ((_ name ...)
-     (export name ...))))
 
-(define-syntax re-export-syntax
+(define-syntax-rule (re-export-syntax name ...)
-  (syntax-rules ()
+  (re-export name ...))
-    ((_ name ...)
-     (re-export name ...))))
 
 
 

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
+(define-syntax-rule (reset . body)
-  (syntax-rules ()
-    ((_ . body)
   (call-with-prompt (default-prompt-tag)
                     (lambda () . body)
-                       (lambda (cont f) (f cont))))))
+                    (lambda (cont f) (f cont))))
 
-(define-syntax shift
+(define-syntax-rule (shift var . body)
-  (syntax-rules ()
-    ((_ var . body)
   (abort-to-prompt (default-prompt-tag)
                    (lambda (cont)
                      ((lambda (var) (reset . body))
-                         (lambda vals (reset (apply cont vals)))))))))
+                      (lambda vals (reset (apply cont vals)))))))
 
 (define (reset* thunk)
   (reset (thunk)))

module/ice-9/futures.scm

@@ -173,8 +173,6 @@ touched."
 ;;; Syntax.
 ;;;
 
-(define-syntax future
+(define-syntax-rule (future body)
-  (syntax-rules ()
   "Return a new future for BODY."
-    ((_ body)
+  (make-future (lambda () body)))
-     (make-future (lambda () body)))))

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
+(define-syntax-rule (defmacro*-public id args b0 b1 ...)
-  (syntax-rules ()
-    ((_ id args b0 b1 ...)
   (begin
     (defmacro* id args b0 b1 ...)
-       (export-syntax id)))))
+    (export-syntax id)))
 
 ;;; Support for optional & keyword args with the interpreter.
 (define *uninitialized* (list 'uninitialized))

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
+(define-syntax-rule (pollfd-offset n)
-  (syntax-rules ()
+  (* n 8))
-    ((_ n) (* n 8))))
 
 (define* (make-empty-poll-set #:optional (pre-allocated 4))
   (make-poll-set (make-bytevector (pollfd-offset pre-allocated) 0)

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)
+  #:export (receive))
-  :no-backtrace
-  )
 
-(define-syntax receive
+(define-syntax-rule (receive vars vals . body)
-  (syntax-rules ()
-    ((receive vars vals . body)
   (call-with-values (lambda () vals)
-       (lambda vars . body)))))
+    (lambda vars . body)))
 
 (cond-expand-provide (current-module) '(srfi-8))

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
+(define-syntax-rule (begin-thread e0 e1 ...)
-  (syntax-rules ()
-    ((_ e0 e1 ...)
   (call-with-new-thread
    (lambda () e0 e1 ...)
-      %thread-handler))))
+   %thread-handler))
 
 (define-syntax parallel
   (lambda (x)
@@ -67,35 +65,27 @@
                  ...)
              (values (touch tmp0) ...)))))))
 
-(define-syntax letpar
+(define-syntax-rule (letpar ((v e) ...) b0 b1 ...)
-  (syntax-rules ()
-    ((_ ((v e) ...) b0 b1 ...)
   (call-with-values
       (lambda () (parallel e ...))
     (lambda (v ...)
-         b0 b1 ...)))))
+      b0 b1 ...)))
 
-(define-syntax make-thread
+(define-syntax-rule (make-thread proc arg ...)
-  (syntax-rules ()
-    ((_ proc arg ...)
   (call-with-new-thread
    (lambda () (proc arg ...))
-      %thread-handler))))
+   %thread-handler))
 
-(define-syntax with-mutex
+(define-syntax-rule (with-mutex m e0 e1 ...)
-  (syntax-rules ()
-    ((_ m e0 e1 ...)
   (let ((x m))
     (dynamic-wind
       (lambda () (lock-mutex x))
       (lambda () (begin e0 e1 ...))
-         (lambda () (unlock-mutex x)))))))
+      (lambda () (unlock-mutex x)))))
 
-(define-syntax monitor
+(define-syntax-rule (monitor first rest ...)
-  (syntax-rules ()
-    ((_ first rest ...)
   (with-mutex (make-mutex)
-       first rest ...))))
+    first rest ...))
 
 (define (par-mapper mapper)
   (lambda (proc . arglists)

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 ...)))))))
+       (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
+(define-syntax-rule (define-block-accessor name index)
-  (syntax-rules ()
-    ((_ name index)
   (define-inline (name block)
-       (vector-ref block index)))))
+    (vector-ref block index)))
 
 (define-block-accessor block-content 0)
 (define-block-accessor block-base 1)

module/language/assembly/compile-bytecode.scm

@@ -28,16 +28,14 @@
   #:export (compile-bytecode))
 
 (define (compile-bytecode assembly env . opts)
-  (define-syntax define-inline1
+  (define-syntax-rule (define-inline1 (proc arg) body body* ...)
-    (syntax-rules ()
-      ((_ (proc arg) body body* ...)
     (define-syntax proc
       (syntax-rules ()
         ((_ (arg-expr (... ...)))
          (let ((x (arg-expr (... ...))))
            (proc x)))
         ((_ arg)
-            (begin body body* ...)))))))
+         (begin body body* ...)))))
        
   (define (fill-bytecode bv target-endianness)
     (let ((pos 0))

module/language/ecmascript/compile-tree-il.scm

@@ -25,20 +25,14 @@
   #:use-module (srfi srfi-1)
   #:export (compile-tree-il))
 
-(define-syntax ->
+(define-syntax-rule (-> (type arg ...))
-  (syntax-rules ()
+  `(type ,arg ...))
-    ((_ (type arg ...))
-     `(type ,arg ...))))
 
-(define-syntax @implv
+(define-syntax-rule (@implv sym)
-  (syntax-rules ()
+  (-> (@ '(language ecmascript impl) 'sym)))
-    ((_ sym)
-     (-> (@ '(language ecmascript impl) 'sym)))))
 
-(define-syntax @impl
+(define-syntax-rule (@impl sym arg ...)
-  (syntax-rules ()
+  (-> (apply (@implv sym) arg ...)))
-    ((_ 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
+(define-syntax-rule (pmatch/source x clause ...)
-  (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)))))
+      res)))
 
 (define (comp x e)
   (let ((l (location x)))

module/language/tree-il.scm

@@ -554,9 +554,7 @@ This is an implementation of `foldts' as described by Andy Wingo in
            (leaf tree result))))))
 
 
-(define-syntax make-tree-il-folder
+(define-syntax-rule (make-tree-il-folder seed ...)
-  (syntax-rules ()
-    ((_ seed ...)
   (lambda (tree down up seed ...)
     (define (fold-values proc exps seed ...)
       (if (null? exps)
@@ -628,7 +626,7 @@ This is an implementation of `foldts' as described by Andy Wingo in
                  (foldts tail seed ...)))
               (else
                (values seed ...)))))
-           (up tree seed ...)))))))
+        (up tree seed ...)))))
 
 (define (post-order! f x)
   (let lp ((x x))

module/oop/goops.scm

@@ -288,9 +288,7 @@
        #'(define-class-pre-definitions (rest ...) 
          out ... (define-class-pre-definition (slotopt ...)))))))
 
-(define-syntax define-class
+(define-syntax-rule (define-class name supers slot ...)
-  (syntax-rules ()
-    ((_ name supers slot ...)
   (begin
     (define-class-pre-definitions (slot ...))
     (if (and (defined? 'name)
@@ -298,11 +296,10 @@
              (memq <object> (class-precedence-list name)))
         (class-redefinition name
                             (class supers slot ... #:name 'name))
-           (toplevel-define! 'name (class supers slot ... #:name 'name)))))))
+        (toplevel-define! 'name (class supers slot ... #:name 'name)))))
        
-(define-syntax standard-define-class
+(define-syntax-rule (standard-define-class arg ...)
-  (syntax-rules ()
+  (define-class arg ...))
-    ((_ 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
+(define-syntax-rule (define-accessor name)
-  (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)))))))
+          (else                    (ensure-accessor name 'name)))))
 
 (define (make-setter-name name)
   (string->symbol (string-append "setter:" (symbol->string name))))

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
+(define-syntax-rule (define-class arg ...)
-  (syntax-rules ()
+  (define-class-with-accessors-keywords arg ...))
-    ((_ arg ...)
-     (define-class-with-accessors-keywords arg ...))))
 
 (module-use! (module-public-interface (current-module))
              (resolve-interface '(oop goops)))

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
+(define-syntax-rule (define-class name supers (slot ...) rest ...)
-  (syntax-rules ()
+  (standard-define-class name supers slot ... rest ...))
-    ((_ name supers (slot ...) rest ...)
-     (standard-define-class name supers slot ... rest ...))))
 
 (define (toplevel-define! name val)
   (module-define! (current-module) name val))

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
+(define-syntax-rule (check-arg pred arg caller)
-  (syntax-rules ()
-    ((_ pred arg caller)
   (if (not (pred arg))
-         (wrong-type-arg 'caller arg)))))
+      (wrong-type-arg 'caller arg)))
 
 (define (out-of-range proc arg)
   (scm-error 'out-of-range proc

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,9 +295,7 @@ by C."
 ;;; Syntax.
 ;;;
 
-(define-syntax define-condition-type
+(define-syntax-rule (define-condition-type name parent pred (field-name field-accessor) ...)
-  (syntax-rules ()
-    ((_ name parent pred (field-name field-accessor) ...)
   (begin
     (define name
       (make-condition-type 'name parent '(field-name ...)))
@@ -305,14 +303,12 @@ by C."
       (condition-has-type? c name))
     (define (field-accessor c)
       (condition-ref c 'field-name))
-       ...))))
+    ...))
 
-(define-syntax compound-condition
+(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 ...)))))
+              field ...)))
 
 (define-syntax condition-instantiation
   ;; Build the `(make-condition type ...)' call.

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
+(define-syntax-rule (parameterize ((?param ?value) ...) ?body ...)
-  (syntax-rules ()
-    ((_ ((?param ?value) ...) ?body ...)
   (with-parameters* (list ?param ...)
                     (list ?value ...)
-                       (lambda () ?body ...)))))
+                    (lambda () ?body ...)))
 
 (define (current-input-port . new-value)
   (if (null? new-value)

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
+(define-syntax-rule (lazy exp)
-  (syntax-rules ()
+  (make-promise (make-value 'lazy (lambda () exp))))
-    ((lazy exp)
-     (make-promise (make-value 'lazy (lambda () exp))))))
 
 (define (eager x)
   (make-promise (make-value 'eager x)))
 
-(define-syntax delay
+(define-syntax-rule (delay exp)
-  (syntax-rules ()
+  (lazy (eager exp)))
-    ((delay exp) (lazy (eager exp)))))
 
 (define (force promise)
   (let ((content (promise-val promise)))

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
+(define-syntax-rule (if3 c less equal greater)
-  (syntax-rules ()
-    ((if3 c less equal greater)
   (case c
     ((-1) less)
     (( 0) equal)
     (( 1) greater)
-       (else (error "comparison value not in {-1,0,1}"))))))
+    (else (error "comparison value not in {-1,0,1}"))))
 
 
 ; 2-sided conditionals for comparisons
@@ -110,42 +109,28 @@
        (a-cases alternate)
        (else    (error "comparison value not in {-1,0,1}"))))))
 
-(define-syntax if=?
+(define-syntax-rule (if=? arg ...)
-  (syntax-rules ()
+  (compare:if-rel? (0) (-1 1) arg ...))
-    ((if=? arg ...)
-     (compare:if-rel? (0) (-1 1) arg ...))))
 
-(define-syntax if<?
+(define-syntax-rule (if<? arg ...)
-  (syntax-rules ()
+  (compare:if-rel? (-1) (0 1) arg ...))
-    ((if<? arg ...)
-     (compare:if-rel? (-1) (0 1) arg ...))))
 
-(define-syntax if>?
+(define-syntax-rule (if>? arg ...)
-  (syntax-rules ()
+  (compare:if-rel? (1) (-1 0) arg ...))
-    ((if>? arg ...)
-     (compare:if-rel? (1) (-1 0) arg ...))))
 
-(define-syntax if<=?
+(define-syntax-rule (if<=? arg ...)
-  (syntax-rules ()
+  (compare:if-rel? (-1 0) (1) arg ...))
-    ((if<=? arg ...)
-     (compare:if-rel? (-1 0) (1) arg ...))))
 
-(define-syntax if>=?
+(define-syntax-rule (if>=? arg ...)
-  (syntax-rules ()
+  (compare:if-rel? (0 1) (-1) arg ...))
-    ((if>=? arg ...)
-     (compare:if-rel? (0 1) (-1) arg ...))))
 
-(define-syntax if-not=?
+(define-syntax-rule if- (not=? arg ...)
-  (syntax-rules ()
+  (compare:if-rel? (-1 1) (0) arg ...))
-    ((if-not=? arg ...)
-     (compare:if-rel? (-1 1) (0) arg ...))))
 
 
 ; predicates from compare procedures
 
-(define-syntax compare:define-rel?
+(define-syntax-rule compare:define- (rel? rel? if-rel?)
-  (syntax-rules ()
-    ((compare:define-rel? rel? if-rel?)
   (define rel?
     (case-lambda
       (()        (lambda (x y) (if-rel? (default-compare x y) #t #f)))
@@ -154,7 +139,7 @@
       ((compare x y)
        (if (procedure? compare)
            (if-rel? (compare x y) #t #f)
-	     (error "not a procedure (Did you mean rel/rel??): " compare))))))))
+           (error "not a procedure (Did you mean rel/rel??): " compare))))))
 
 (compare:define-rel? =?    if=?)
 (compare:define-rel? <?    if<?)
@@ -166,9 +151,7 @@
 
 ; chains of length 3
 
-(define-syntax compare:define-rel1/rel2?
+(define-syntax-rule compare:define-rel1/ (rel2? rel1/rel2? if-rel1? if-rel2?)
-  (syntax-rules ()
-    ((compare:define-rel1/rel2? rel1/rel2? if-rel1? if-rel2?)
   (define rel1/rel2?
     (case-lambda
       (()
@@ -188,7 +171,7 @@
       ((compare x y z)
        (if-rel1? (compare x y)
                  (if-rel2? (compare y z) #t #f)
-	       (compare:checked #f compare z))))))))
+                 (compare:checked #f compare z))))))
 
 (compare:define-rel1/rel2? </<?   if<?  if<?)
 (compare:define-rel1/rel2? </<=?  if<?  if<=?)
@@ -202,9 +185,7 @@
 
 ; chains of arbitrary length
 
-(define-syntax compare:define-chain-rel?
+(define-syntax-rule compare:define-chain- (rel? chain-rel? if-rel?)
-  (syntax-rules ()
-    ((compare:define-chain-rel? chain-rel? if-rel?)
   (define chain-rel?
     (case-lambda
       ((compare)
@@ -226,7 +207,7 @@
                                (chain? (car tail) (cdr tail))
                                (apply compare:checked #f 
                                       compare (cdr tail)))))
-		  (apply compare:checked #f compare x3+))))))))
+                (apply compare:checked #f compare x3+))))))
 
 (compare:define-chain-rel? chain=?  if=?)
 (compare:define-chain-rel? chain<?  if<?)
@@ -468,9 +449,7 @@
      (begin (compare:type-check type? type-name x)
             (compare:type-check type? type-name y)))))
 
-(define-syntax compare:define-by=/<
+(define-syntax-rule compare:define- (by=/< compare = < type? type-name)
-  (syntax-rules ()
-    ((compare:define-by=/< compare = < type? type-name)
   (define compare
     (let ((= =) (< <))
       (lambda (x y)
@@ -480,7 +459,7 @@
                 (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))))))))
+            (error (string-append "not " type-name ":") x))))))
 
 (define (boolean-compare x y)
   (compare:type-check boolean? "boolean" x y)

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
+(define-syntax-rule (syntax-object->datum stx)
-  (syntax-rules ()
+  (syntax->datum stx))
-    ((_ stx)
-     (syntax->datum stx))))
 
-(define-syntax void
+(define-syntax-rule (void)
-  (syntax-rules ()
+  *unspecified*)
-    ((_) *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))))))
+                      (apply values args))))
 
-(define-syntax let/ec
+(define-syntax-rule (let/ec cont body ...)
-  (syntax-rules ()
+  (call/ec (lambda (cont) body ...)))
-    ((_ cont body ...)
-     (call/ec (lambda (cont) body ...)))))
 
 (define (raise-syntax-error x msg obj sub)
   (throw 'sxml-match-error x msg obj sub))

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
+(define-syntax-rule (with-error-handling form)
-  (syntax-rules ()
+  (call-with-error-handling (lambda () form)))
-    ((_ form)
-     (call-with-error-handling (lambda () form)))))

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
+(define-syntax-rule (abort-on-error string exp)
-  (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))))))
+      (abort))))
 
 (define (run-repl repl)
   (define (with-stack-and-prompt thunk)

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
+  (define-syntax-rule (define-command ((mod cname alias ...) . args)
-    (syntax-rules ()
+                        body ...)
-      ((_ ((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)))))
+        c)))
 
   (let ((commands (make-module)))
     (define (prompt)

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
 

module/web/server.scm

@@ -118,11 +118,9 @@
   (write server-impl-write)
   (close server-impl-close))
 
-(define-syntax define-server-impl
+(define-syntax-rule (define-server-impl name open read write close)
-  (syntax-rules ()
-    ((_ name open read write close)
   (define name
-       (make-server-impl 'name open read write close)))))
+    (make-server-impl 'name open read write close)))
 
 (define (lookup-server-impl impl)
   "Look up a server implementation.  If @var{impl} is a server