From 6ef33991745fccfe6889dc1cb58b0835d02c72a2 Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Thu, 15 May 2008 17:00:16 +0000
Subject: [PATCH] hack SRFI 42 to recognize if from scheme/base

svn: r9854
---
 collects/srfi/42/comprehensions.ss | 27 +++++++++++++++++++++++----
 collects/srfi/srfi.scrbl           | 14 +++++++++++++-
 2 files changed, 36 insertions(+), 5 deletions(-)

diff --git a/collects/srfi/42/comprehensions.ss b/collects/srfi/42/comprehensions.ss
index 7deebef5ae..d2209d1e2a 100644
--- a/collects/srfi/42/comprehensions.ss
+++ b/collects/srfi/42/comprehensions.ss
@@ -7,7 +7,8 @@
 
 (module |comprehensions| mzscheme
 
- (require srfi/23)
+ (require srfi/23
+          (rename scheme/base base-if if))
 
  (provide 
     do-ec list-ec append-ec string-ec string-append-ec vector-ec 
@@ -104,7 +105,7 @@
 ;   The code generation for a :do is delegated to do-ec:do.
 
 (define-syntax-globally do-ec
-  (syntax-rules (nested if not and or begin :do let)
+  (syntax-rules (nested if base-if not and or begin :do let)
 
     ; explicit nesting -> implicit nesting
     ((do-ec (nested q ...) etc ...)
@@ -123,6 +124,8 @@
     ; filter -> make conditional
     ((do-ec (if test) cmd)
      (if test (do-ec cmd)) )
+    ((do-ec (base-if test) cmd)
+     (if test (do-ec cmd)) )
     ((do-ec (not test) cmd)
      (if (not test) (do-ec cmd)) )
     ((do-ec (and test ...) cmd)
@@ -180,7 +183,7 @@
 ;   and takes care of special cases.
 
 (define-syntax-globally ec-simplify
-  (syntax-rules (if not let begin)
+  (syntax-rules (if base-if not let begin)
 
 ; one- and two-sided if
 
@@ -200,6 +203,20 @@
     ((ec-simplify (if (not (not test)) consequent alternate))
      (ec-simplify (if test consequent alternate)) )
 
+    ; base-if variants:
+    ((ec-simplify (base-if #t consequent))
+     consequent )
+    ((ec-simplify (base-if #f consequent))
+     (if #f #f) )
+    ((ec-simplify (base-if #t consequent alternate))
+     consequent )
+    ((ec-simplify (base-if #f consequent alternate))
+     alternate )
+    ((ec-simplify (base-if (not (not test)) consequent))
+     (ec-simplify (if test consequent)) )
+    ((ec-simplify (base-if (not (not test)) consequent alternate))
+     (ec-simplify (if test consequent alternate)) )
+
 ; (let () <command>*) 
 
     ; empty <binding spec>*
@@ -977,13 +994,15 @@
 ;   replaced by (:until gen stop).
 
 (define-syntax-globally ec-guarded-do-ec
-  (syntax-rules (nested if not and or begin)
+  (syntax-rules (nested if base-if not and or begin)
 
     ((ec-guarded-do-ec stop (nested (nested q1 ...) q2 ...) cmd)
      (ec-guarded-do-ec stop (nested q1 ... q2 ...) cmd) )
 
     ((ec-guarded-do-ec stop (nested (if test) q ...) cmd)
      (if test (ec-guarded-do-ec stop (nested q ...) cmd)) )
+    ((ec-guarded-do-ec stop (nested (base-if test) q ...) cmd)
+     (if test (ec-guarded-do-ec stop (nested q ...) cmd)) )
     ((ec-guarded-do-ec stop (nested (not test) q ...) cmd)
      (if (not test) (ec-guarded-do-ec stop (nested q ...) cmd)) )
     ((ec-guarded-do-ec stop (nested (and test ...) q ...) cmd)
diff --git a/collects/srfi/srfi.scrbl b/collects/srfi/srfi.scrbl
index 46f108d36f..f0ec1e018d 100644
--- a/collects/srfi/srfi.scrbl
+++ b/collects/srfi/srfi.scrbl
@@ -1,6 +1,7 @@
 #lang scribble/doc
 @(require scribble/manual
-          (for-syntax scheme/base))
+          (for-syntax scheme/base)
+          (for-label scheme/base))
 
 @(define-syntax (srfi stx)
   (syntax-case stx ()
@@ -36,6 +37,13 @@
     [(k)
      @elem{This SRFI's bindings are also available in @schememodname[scheme/base]@|k|}]))
 
+@(begin
+  (define-syntax-rule (def-mz mz-if)
+    (begin
+      (require (for-label mzscheme))
+      (define mz-if (scheme if))))
+  (def-mz mz-if))
+
 @; ----------------------------------------------------------------------
 
 @title{@bold{SRFIs}: Libraries}
@@ -792,6 +800,10 @@ Superceded by @schememodname[srfi/41].
  (:until #t ":until")
 )]
 
+Forms that syntactically detect @scheme[if] recognize both @scheme[if]
+from @schememodname[scheme/base] and @mz-if from
+@schememodname[mzscheme].
+
 @; ----------------------------------------
 
 @srfi[43]{Vector Library}