From e7350baf1e93d68eb7dc23fc16f711c066cb37ec Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Ludovic=20Court=C3=A8s?= <ludo@gnu.org>
Date: Tue, 11 Sep 2012 23:39:32 +0200
Subject: [PATCH] Rewrite SRFI-31 in terms of `syntax-rules'.

* module/srfi/srfi-31.scm: Use `#:export' instead of `#:export-syntax'.
  (rec): Rewrite using `syntax-rules'.

* test-suite/tests/srfi-31.test ("rec special form"): Change exception
  type to EXCEPTION:SYNTAX-PATTERN-UNMATCHED.
---
 module/srfi/srfi-31.scm       | 26 ++++++++++++--------------
 test-suite/tests/srfi-31.test |  7 ++++---
 2 files changed, 16 insertions(+), 17 deletions(-)

diff --git a/module/srfi/srfi-31.scm b/module/srfi/srfi-31.scm
index 4238dc269..cf67e8af5 100644
--- a/module/srfi/srfi-31.scm
+++ b/module/srfi/srfi-31.scm
@@ -1,6 +1,6 @@
 ;;; srfi-31.scm --- special form for recursive evaluation
 
-;; 	Copyright (C) 2004, 2006 Free Software Foundation, Inc.
+;; 	Copyright (C) 2004, 2006, 2012 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
@@ -19,17 +19,15 @@
 ;;; Original author: Rob Browning <rlb@defaultvalue.org>
 
 (define-module (srfi srfi-31)
-  :export-syntax (rec))
+  #:export (rec))
 
-(define-macro (rec arg-form . body)
-  (cond
-   ((and (symbol? arg-form) (= 1 (length body)))
-    ;; (rec S (cons 1 (delay S)))
-    `(letrec ((,arg-form ,(car body)))
-       ,arg-form))
-   ;; (rec (f x) (+ x 1))
-   ((list? arg-form)
-    `(letrec ((,(car arg-form) (lambda ,(cdr arg-form) ,@body)))
-       ,(car arg-form)))
-   (else
-    (error "syntax error in rec form" `(rec ,arg-form ,@body)))))
+(define-syntax rec
+  (syntax-rules ()
+    "Return the given object, defined in a lexical environment where
+NAME is bound to itself."
+    ((_ (name . formals) body ...)                ; procedure
+     (letrec ((name (lambda formals body ...)))
+       name))
+    ((_ name expr)                                ; arbitrary object
+     (letrec ((name expr))
+       name))))
diff --git a/test-suite/tests/srfi-31.test b/test-suite/tests/srfi-31.test
index 8537d49b6..62645d918 100644
--- a/test-suite/tests/srfi-31.test
+++ b/test-suite/tests/srfi-31.test
@@ -1,6 +1,6 @@
 ;;;; srfi-31.test --- Test suite for Guile's SRFI-31 functions. -*- scheme -*-
 ;;;;
-;;;; Copyright (C) 2004, 2006, 2010 Free Software Foundation, Inc.
+;;;; Copyright (C) 2004, 2006, 2010, 2012 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
@@ -22,9 +22,10 @@
 
 (with-test-prefix "rec special form"
 
-  (pass-if-exception "bogus variable" '(misc-error . ".*")
+  (pass-if-exception "bogus variable"
+    exception:syntax-pattern-unmatched
     (eval '(rec #:foo) (current-module)))
-  
+
   (pass-if "rec expressions"
     (let ((ones-list (rec ones (cons 1 (delay ones)))))
       (and (= 1 (car ones-list))