suzanne.soy/racket
1
0
Fork 0
Code Issues Pull Requests Actions Packages Projects Releases Wiki Activity

hack SRFI 42 to recognize if from scheme/base

Browse Source 
svn: r9854
This commit is contained in:
Matthew Flatt 2008-05-15 17:00:16 +00:00
parent 0d41afdb6d
commit 6ef3399174
2 changed files with 36 additions and 5 deletions
Show Stats Download Patch File Download Diff File Expand all files Collapse all files

27
collects/srfi/42/comprehensions.ss
View File

@ -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)

14
collects/srfi/srfi.scrbl
View File

@ -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}