From c1cd82d1520f8f15a13f33cdfe21a2fae0dd466b Mon Sep 17 00:00:00 2001
From: Matthew Flatt <mflatt@racket-lang.org>
Date: Fri, 2 Feb 2001 17:35:40 +0000
Subject: [PATCH] .

original commit: ed3c16a5375d0e52b313402cdf056d84225541bd
---
 collects/mzlib/etc.ss | 57 +++++++++++++++++++++++++++++++++++++++++--
 1 file changed, 55 insertions(+), 2 deletions(-)

diff --git a/collects/mzlib/etc.ss b/collects/mzlib/etc.ss
index a094172..d3cef21 100644
--- a/collects/mzlib/etc.ss
+++ b/collects/mzlib/etc.ss
@@ -20,7 +20,8 @@
 	  rec
 	  evcase
 	  nor
-	  nand)
+	  nand
+	  let+)
 
   (define true #t)
   (define false #f)
@@ -310,4 +311,56 @@
        [(_ expr ...)
 	(syntax/loc stx (not (and expr ...)))])))
 
- )
+ (define-syntax let+
+   (lambda (stx)
+     (syntax-case stx ()
+       [(_ [clause ...] body1 body ...)
+	(let ([clauses (syntax->list (syntax (clause ...)))]
+	      [bad (lambda (c n)
+		     (raise-syntax-error
+		      'let+
+		      (format "illegal use of ~a for a clause" n)
+		      stx
+		      c))])
+	  ;; syntax checks
+	  (for-each
+	   (lambda (clause)
+	     (syntax-case clause (val rec vals recs _)
+		  [(val var expr)
+		   (identifier? (syntax var))
+		   'ok]
+		  [(rec var expr)
+		   (identifier? (syntax var))
+		   'ok]
+		  [(vals (var expr) ...)
+		   (andmap identifier? (syntax->list (syntax (var ...))))
+		   'ok]
+		  [(recs (var expr) ...)
+		   (andmap identifier? (syntax->list (syntax (var ...))))
+		   'ok]
+		  [(_ expr)
+		   'ok]
+		  [(val . _) (bad clause "val")]
+		  [(rec . _) (bad clause "rec")]
+		  [(vals . _) (bad clause "vals")]
+		  [(recs . _) (bad  clause"recs")]
+		  [(_ . _) (bad clause "_")]
+		  [_else (raise-syntax-error 'let+ "bad clause" stx clause)]))
+	   clauses)
+	  ;; result
+	(let loop ([clauses clauses])
+	  (if (null? clauses)
+	      (syntax (let () body1 body ...))
+	      (with-syntax ([rest (loop (cdr clauses))])
+		(syntax-case (car clauses) (val rec vals recs _)
+		  [(val var expr)
+		   (syntax (let ([var expr]) rest))]
+		  [(rec var expr)
+		   (syntax (letrec ([var expr]) rest))]
+		  [(vals (var expr) ...)
+		   (syntax (let ([var expr] ...) rest))]
+		  [(recs (var expr) ...)
+		   (syntax (letrec ([var expr] ...) rest))]
+		  [(_ expr)
+		   (syntax (begin expr rest))])))))]))))
+