From 96075e97938b6b01cac043c7a76b366180e12801 Mon Sep 17 00:00:00 2001
From: Eli Barzilay <eli@racket-lang.org>
Date: Tue, 18 Nov 2008 14:49:31 +0000
Subject: [PATCH] bugfix commit from Jens Axel

svn: r12489
---
 collects/srfi/42/expansion.scm        | 68 ++++++++++++++++++---------
 collects/srfi/42/extra-generators.scm | 10 +++-
 2 files changed, 55 insertions(+), 23 deletions(-)

diff --git a/collects/srfi/42/expansion.scm b/collects/srfi/42/expansion.scm
index e06475b4b5..076ccbd1f8 100644
--- a/collects/srfi/42/expansion.scm
+++ b/collects/srfi/42/expansion.scm
@@ -27,15 +27,33 @@
             (generator? (syntax-local-value #'name (lambda () #f))))]
       [_ #f]))
   
-  (require (lib "stx.ss" "syntax"))  
-  (define (filter-clause? clause-stx)
-    (syntax-case* clause-stx (if not and or) module-or-top-identifier=?
-      [(if  . more) #t]
-      [(not . more) #t]
-      [(and . more) #t]
-      [(or  . more) #t]
-      [_            #f]))
+  (require (lib "stx.ss" "syntax"))
+  (require (prefix base: scheme)
+           (for-meta 1 (prefix base: scheme)))
   
+  (define (if-filter? stx)
+      (syntax-case stx ()
+        [(head expr)
+         (and (identifier? #'head)
+              (eq? 'if (syntax-e #'head)))]
+        [else #f]))
+  
+  (require (prefix new- scheme))
+  
+  #;(define (if-filter? stx)
+    (syntax-case* stx (if new-if) module-or-top-identifier=?
+      [(if expr) #t]
+      [(new-if expr) #t]
+      [_ #f]))
+  
+  (define (filter-clause? clause-stx)
+    (or (if-filter? clause-stx)
+        (syntax-case* clause-stx (if base:if not and or) module-or-top-identifier=?
+          [(not . more) #t]
+          [(and . more) #t]
+          [(or  . more) #t]
+          [_            #f])))
+      
   (define (begin-clause? clause-stx)
     (syntax-case clause-stx (begin)
       [(begin  . more) #t]
@@ -115,18 +133,26 @@
                             (loop2... body-stx)))]
            [(filter-clause? #'clause1)
             (let ([loop2... (expand-clauses #'(clause2 ...))])
-              (syntax-case* #'clause1 (if not and or) module-or-top-identifier=?  ; due to not
-                [(if expr)
-                 #`(if expr #,(loop2... body-stx))]
-                [(not expr)
-                 #`(if (not expr) #,(loop2... body-stx))]
-                [(or expr ...)
-                 #`(if (or expr ...) #,(loop2... body-stx))]
-                [(and expr ...)
-                 #`(if (and expr ...) #,(loop2... body-stx))]
-                [_
-                 (raise-syntax-error 'expand-clauses 
-                                     "unimplemented <filter>" #'clause1)]))]
+              (cond
+                [(if-filter? #'clause1)
+                 (syntax-case #'clause1 ()
+                   [(the-if expr)
+                    #`(if expr #,(loop2... body-stx))]
+                   [else (raise-syntax-error 'expand-clauses 
+                                             "internal error: <if-filter> expected" #'clause1)])] 
+                [else
+                 (syntax-case* #'clause1 (if not and or) module-or-top-identifier=?  ; due to not
+                   #;[(if expr)  
+                      #`(if expr #,(loop2... body-stx))]
+                   [(not expr)
+                    #`(if (not expr) #,(loop2... body-stx))]
+                   [(or expr ...)
+                    #`(if (or expr ...) #,(loop2... body-stx))]
+                   [(and expr ...)
+                    #`(if (and expr ...) #,(loop2... body-stx))]
+                   [_
+                    (raise-syntax-error 'expand-clauses 
+                                        "unimplemented <filter>" #'clause1)])]))]
            [(begin-clause? #'clause1)
             (let ([loop2... (expand-clauses #'(clause2 ...))])
               (syntax-case #'clause1 ()
@@ -192,4 +218,4 @@
         stx)]
       [_ 
        (raise-syntax-error 'add-index "think" stx)]))
-  )
\ No newline at end of file
+  )
diff --git a/collects/srfi/42/extra-generators.scm b/collects/srfi/42/extra-generators.scm
index 72fce3b42f..888fe66947 100644
--- a/collects/srfi/42/extra-generators.scm
+++ b/collects/srfi/42/extra-generators.scm
@@ -10,11 +10,17 @@
 	   :vector-combinations
 	   :do-until
 	   :pairs
+           :pairs-by
 	   :list-by
 	   :alist
 	   :hash-table
 	   :hash-table-keys
-	   :hash-table-values)
+	   :hash-table-values
+           indices->list
+           indices->vector
+           last-combination?
+           next-combination
+           first-combination)
   (require "ec-core.scm")
   (require-for-syntax "ec-core.scm")
   
@@ -367,4 +373,4 @@
         'match
         "expected (:match <pattern> <expr>)"
         stx)]))
-  )
\ No newline at end of file
+  )