[Guile-commits] GNU Guile branch, master, updated. de784acd87b8d567fb6433d8f531a7f28b91d635

[Ludovic Courtès]

This is an automated email from the git hooks/post-receive script. It was
generated because a ref change was pushed to the repository containing
the project "GNU Guile".

http://git.savannah.gnu.org/cgit/guile.git/commit/?id=de784acd87b8d567fb6433d8f531a7f28b91d635

The branch, master has been updated
       via  de784acd87b8d567fb6433d8f531a7f28b91d635 (commit)
      from  837b0ae0b5d530b0c254ebe331fb5ab1de3e7fe8 (commit)

Those revisions listed above that are new to this repository have
not appeared on any other notification email; so we list those
revisions in full, below.

- Log -----------------------------------------------------------------
commit de784acd87b8d567fb6433d8f531a7f28b91d635
Author: Ludovic Courtès <address@hidden>
Date:   Fri May 22 23:44:43 2009 +0200

    Rewrite SRFI-35 macros using `syntax-rules'.
    
    * module/srfi/srfi-35.scm: Use `(ice-9 syncase)'.
      (define-condition-type, condition): Rewritten using `syntax-rules'.
      (compound-condition, condition-instantiation): New helper internal
      macros.  Thanks to Andy Wingo for his help!

-----------------------------------------------------------------------

Summary of changes:
 module/srfi/srfi-35.scm |   67 ++++++++++++++++++++++++----------------------
 1 files changed, 35 insertions(+), 32 deletions(-)

diff --git a/module/srfi/srfi-35.scm b/module/srfi/srfi-35.scm
index 2035466..d7e6a4d 100644
--- a/module/srfi/srfi-35.scm
+++ b/module/srfi/srfi-35.scm
@@ -1,6 +1,6 @@
 ;;; srfi-35.scm --- Conditions
 
-;; Copyright (C) 2007, 2008 Free Software Foundation, Inc.
+;; Copyright (C) 2007, 2008, 2009 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
@@ -28,6 +28,7 @@
 
 (define-module (srfi srfi-35)
   #:use-module (srfi srfi-1)
+  #:use-module (ice-9 syncase)
   #:export (make-condition-type condition-type?
             make-condition condition? condition-has-type? condition-ref
             make-compound-condition extract-condition
@@ -274,37 +275,39 @@ by C."
 ;;; Syntax.
 ;;;
 
-(define-macro (define-condition-type name parent pred . field-specs)
-  `(begin
-     (define ,name
-       (make-condition-type ',name ,parent
-                           ',(map car field-specs)))
-     (define (,pred c)
-       (condition-has-type? c ,name))
-     ,@(map (lambda (field-spec)
-             (let ((field-name (car field-spec))
-                   (accessor   (cadr field-spec)))
-               `(define (,accessor c)
-                  (condition-ref c ',field-name))))
-           field-specs)))
-
-(define-macro (condition . type-field-bindings)
-  (cond ((null? type-field-bindings)
-        (error "`condition' syntax error" type-field-bindings))
-       (else
-        ;; the poor man's hygienic macro
-        (let ((mc   (gensym "mc"))
-              (mcct (gensym "mcct")))
-          `(let ((,mc   (@  (srfi srfi-35) make-condition))
-                 (,mcct (@@ (srfi srfi-35) make-compound-condition-type)))
-             (,mc (,mcct 'compound (list ,@(map car type-field-bindings)))
-                  ,@(append-map (lambda (type-field-binding)
-                                  (append-map (lambda (field+value)
-                                                (let ((f (car field+value))
-                                                      (v (cadr field+value)))
-                                                  `(',f ,v)))
-                                              (cdr type-field-binding)))
-                                type-field-bindings)))))))
+(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
+  ;; Create a compound condition using `make-compound-condition-type'.
+  (syntax-rules ()
+    ((_ (type ...) (field ...))
+     (condition ((make-compound-condition-type '%compound `(,type ...))
+                 field ...)))))
+
+(define-syntax condition-instantiation
+  ;; Build the `(make-condition type ...)' call.
+  (syntax-rules ()
+    ((_ type (out ...))
+     (make-condition type out ...))
+    ((_ type (out ...) (field-name field-value) rest ...)
+     (condition-instantiation type (out ... 'field-name field-value) rest 
...))))
+
+(define-syntax condition
+  (syntax-rules ()
+    ((_ (type field ...))
+     (condition-instantiation type () field ...))
+    ((_ (type field ...) ...)
+     (compound-condition (type ...) (field ... ...)))))
 
 
 ;;;


hooks/post-receive
-- 
GNU Guile