summaryrefslogtreecommitdiff
path: root/module
diff options
context:
space:
mode:
Diffstat (limited to 'module')
-rw-r--r--module/ice-9/and-let-star.scm52
1 files changed, 39 insertions, 13 deletions
diff --git a/module/ice-9/and-let-star.scm b/module/ice-9/and-let-star.scm
index ff15a7a1e..2d53ff384 100644
--- a/module/ice-9/and-let-star.scm
+++ b/module/ice-9/and-let-star.scm
@@ -1,6 +1,7 @@
;;;; and-let-star.scm --- and-let* syntactic form (SRFI-2) for Guile
;;;;
-;;;; Copyright (C) 1999, 2001, 2004, 2006, 2013 Free Software Foundation, Inc.
+;;;; Copyright (C) 1999, 2001, 2004, 2006, 2013,
+;;;; 2015 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
@@ -22,20 +23,45 @@
(define-syntax %and-let*
(lambda (form)
(syntax-case form ()
- ((_ orig-form ())
- #'#t)
- ((_ orig-form () body bodies ...)
- #'(begin body bodies ...))
- ((_ orig-form ((var exp) c ...) body ...)
+
+ ;; Handle zero-clauses special-case.
+ ((_ orig-form () . body)
+ #'(begin #t . body))
+
+ ;; Reduce clauses down to one regardless of body.
+ ((_ orig-form ((var expr) rest . rest*) . body)
+ (identifier? #'var)
+ #'(let ((var expr))
+ (and var (%and-let* orig-form (rest . rest*) . body))))
+ ((_ orig-form ((expr) rest . rest*) . body)
+ #'(and expr (%and-let* orig-form (rest . rest*) . body)))
+ ((_ orig-form (var rest . rest*) . body)
+ (identifier? #'var)
+ #'(and var (%and-let* orig-form (rest . rest*) . body)))
+
+ ;; Handle 1-clause cases without a body.
+ ((_ orig-form ((var expr)))
(identifier? #'var)
- #'(let ((var exp))
- (and var (%and-let* orig-form (c ...) body ...))))
- ((_ orig-form ((exp) c ...) body ...)
- #'(and exp (%and-let* orig-form (c ...) body ...)))
- ((_ orig-form (var c ...) body ...)
+ #'expr)
+ ((_ orig-form ((expr)))
+ #'expr)
+ ((_ orig-form (var))
(identifier? #'var)
- #'(and var (%and-let* orig-form (c ...) body ...)))
- ((_ orig-form (bad-clause c ...) body ...)
+ #'var)
+
+ ;; Handle 1-clause cases with a body.
+ ((_ orig-form ((var expr)) . body)
+ (identifier? #'var)
+ #'(let ((var expr))
+ (and var (begin . body))))
+ ((_ orig-form ((expr)) . body)
+ #'(and expr (begin . body)))
+ ((_ orig-form (var) . body)
+ (identifier? #'var)
+ #'(and var (begin . body)))
+
+ ;; Handle bad clauses.
+ ((_ orig-form (bad-clause . rest) . body)
(syntax-violation 'and-let* "Bad clause" #'orig-form #'bad-clause)))))
(define-syntax and-let*