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

[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=f4bf64b4d422bb093a3e857380d99e4f08b9c8af

The branch, master has been updated
       via  f4bf64b4d422bb093a3e857380d99e4f08b9c8af (commit)
      from  23044464c2e26649329b422380a6850d53eec725 (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 f4bf64b4d422bb093a3e857380d99e4f08b9c8af
Author: Ludovic Courtès <address@hidden>
Date:   Fri Jun 19 22:46:07 2009 +0200

    Make `cond-expand' compilable.
    
    * module/ice-9/boot-9.scm (cond-expand): Changed into a `define-macro'
      macro.

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

Summary of changes:
 module/ice-9/boot-9.scm |  123 +++++++++++++++++++++++------------------------
 1 files changed, 60 insertions(+), 63 deletions(-)

diff --git a/module/ice-9/boot-9.scm b/module/ice-9/boot-9.scm
index ed561d2..36a463a 100644
--- a/module/ice-9/boot-9.scm
+++ b/module/ice-9/boot-9.scm
@@ -3192,69 +3192,66 @@ module '(ice-9 q) '(make-q q-length))}."
                     (append (hashq-ref %cond-expand-table mod '())
                             features)))))
 
-(define cond-expand
-  (procedure->memoizing-macro
-   (lambda (exp env)
-     (let ((clauses (cdr exp))
-          (syntax-error (lambda (cl)
-                          (error "invalid clause in `cond-expand'" cl))))
-       (letrec
-          ((test-clause
-            (lambda (clause)
-              (cond
-               ((symbol? clause)
-                (or (memq clause %cond-expand-features)
-                    (let lp ((uses (module-uses (env-module env))))
-                      (if (pair? uses)
-                          (or (memq clause
-                                    (hashq-ref %cond-expand-table
-                                               (car uses) '()))
-                              (lp (cdr uses)))
-                          #f))))
-               ((pair? clause)
-                (cond
-                 ((eq? 'and (car clause))
-                  (let lp ((l (cdr clause)))
-                    (cond ((null? l)
-                           #t)
-                          ((pair? l)
-                           (and (test-clause (car l)) (lp (cdr l))))
-                          (else
-                           (syntax-error clause)))))
-                 ((eq? 'or (car clause))
-                  (let lp ((l (cdr clause)))
-                    (cond ((null? l)
-                           #f)
-                          ((pair? l)
-                           (or (test-clause (car l)) (lp (cdr l))))
-                          (else
-                           (syntax-error clause)))))
-                 ((eq? 'not (car clause))
-                  (cond ((not (pair? (cdr clause)))
-                         (syntax-error clause))
-                        ((pair? (cddr clause))
-                         ((syntax-error clause))))
-                  (not (test-clause (cadr clause))))
-                 (else
-                  (syntax-error clause))))
-               (else
-                (syntax-error clause))))))
-        (let lp ((c clauses))
-          (cond
-           ((null? c)
-            (error "Unfulfilled `cond-expand'"))
-           ((not (pair? c))
-            (syntax-error c))
-           ((not (pair? (car c)))
-            (syntax-error (car c)))
-           ((test-clause (caar c))
-            `(begin ,@(cdar c)))
-           ((eq? (caar c) 'else)
-            (if (pair? (cdr c))
-                (syntax-error c))
-            `(begin ,@(cdar c)))
-           (else
-            (lp (cdr c))))))))))
+(define-macro (cond-expand . clauses)
+  (let ((syntax-error (lambda (cl)
+                        (error "invalid clause in `cond-expand'" cl))))
+    (letrec
+        ((test-clause
+          (lambda (clause)
+            (cond
+             ((symbol? clause)
+              (or (memq clause %cond-expand-features)
+                  (let lp ((uses (module-uses (current-module))))
+                    (if (pair? uses)
+                        (or (memq clause
+                                  (hashq-ref %cond-expand-table
+                                             (car uses) '()))
+                            (lp (cdr uses)))
+                        #f))))
+             ((pair? clause)
+              (cond
+               ((eq? 'and (car clause))
+                (let lp ((l (cdr clause)))
+                  (cond ((null? l)
+                         #t)
+                        ((pair? l)
+                         (and (test-clause (car l)) (lp (cdr l))))
+                        (else
+                         (syntax-error clause)))))
+               ((eq? 'or (car clause))
+                (let lp ((l (cdr clause)))
+                  (cond ((null? l)
+                         #f)
+                        ((pair? l)
+                         (or (test-clause (car l)) (lp (cdr l))))
+                        (else
+                         (syntax-error clause)))))
+               ((eq? 'not (car clause))
+                (cond ((not (pair? (cdr clause)))
+                       (syntax-error clause))
+                      ((pair? (cddr clause))
+                       ((syntax-error clause))))
+                (not (test-clause (cadr clause))))
+               (else
+                (syntax-error clause))))
+             (else
+              (syntax-error clause))))))
+      (let lp ((c clauses))
+        (cond
+         ((null? c)
+          (error "Unfulfilled `cond-expand'"))
+         ((not (pair? c))
+          (syntax-error c))
+         ((not (pair? (car c)))
+          (syntax-error (car c)))
+         ((test-clause (caar c))
+          `(begin ,@(cdar c)))
+         ((eq? (caar c) 'else)
+          (if (pair? (cdr c))
+              (syntax-error c))
+          `(begin ,@(cdar c)))
+         (else
+          (lp (cdr c))))))))
 
 ;; This procedure gets called from the startup code with a list of
 ;; numbers, which are the numbers of the SRFIs to be loaded on startup.


hooks/post-receive
-- 
GNU Guile