[Chicken-hackers] [PATCH] warn if var is bound multiple times in the same binding form

[Felix]

The attached patch emits a warning at expansion time if the same variable
in a let[rec][-syntax] form is bound more than once.


cheers,
felix

>From 127859a3a1d8e013483da779101bfd0a89092d90 Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Fri, 1 Feb 2013 00:13:23 +0100
Subject: [PATCH] warn if the same variable is bound multiple times in a let, 
letrec, let-syntax or letrec-syntax form

---
 expand.scm |   43 ++++++++++++++++++-------------------------
 1 files changed, 18 insertions(+), 25 deletions(-)

diff --git a/expand.scm b/expand.scm
index 09d0c3d..bca979a 100644
--- a/expand.scm
+++ b/expand.scm
@@ -33,6 +33,7 @@
   (fixnum)
   (hide match-expression
        macro-alias
+       check-for-multiple-bindings
        d dd dm dx map-se
        lookup check-for-redef) 
   (not inline ##sys#syntax-error-hook ##sys#compiler-syntax-hook
@@ -1022,35 +1023,30 @@
                 ,(car head)
                 (##sys#er-transformer (##core#lambda ,(cdr head) 
,@body))))))))))
 
-(define (##sys#check-for-multiple-bindings bindings form loc)
+(define (check-for-multiple-bindings bindings form loc)
   ;; assumes correct syntax
   (let loop ((bs bindings) (done '()))
-    (cond ((null? bs) '())
+    (cond ((null? bs))
          ((memq (caar bs) done)
           (##sys#warn 
            (string-append "variable bound multiple times in " loc " construct")
            (caar bs)
            form)
-          (cons (car bs) (loop (cdr bs) done)))
-         (else 
-          (cons (car bs) (loop (cdr bs) (cons (caar bs) done)))))))
+          (loop (cdr bs) done))
+         (else (loop (cdr bs) (cons (caar bs) done))))))
 
 (##sys#extend-macro-environment
  'let
  '()
  (##sys#er-transformer
   (lambda (x r c)
-    (if (and (pair? (cdr x)) (symbol? (cadr x)))
-       (##sys#check-syntax 'let x '(_ symbol #((symbol _) 0) . #(_ 1)))
-       (##sys#check-syntax 'let x '(_ #((symbol _) 0) . #(_ 1))))
-    (if (symbol? (cadr x))
-        `(##core#let
-           ,(cadr x)
-           ,(##sys#check-for-multiple-bindings (caddr x) x "let")
-           ,@(cdddr x)))))
-        `(##core#let
-           ,(##sys#check-for-multiple-bindings (cadr x) x "let")
-           ,@(cddr x))))))
+    (cond ((and (pair? (cdr x)) (symbol? (cadr x)))
+          (##sys#check-syntax 'let x '(_ symbol #((symbol _) 0) . #(_ 1)))
+           (check-for-multiple-bindings (caddr x) x "let"))
+         (else
+          (##sys#check-syntax 'let x '(_ #((symbol _) 0) . #(_ 1)))
+           (check-for-multiple-bindings (cadr x) x "let")))
+    `(##core#let ,@(cdr x)))))
 
 (##sys#extend-macro-environment
  'letrec
@@ -1058,9 +1054,8 @@
  (##sys#er-transformer
   (lambda (x r c)
     (##sys#check-syntax 'letrec x '(_ #((symbol _) 0) . #(_ 1)))
-    `(##core#letrec
-      ,(##sys#check-for-multiple-bindings (cadr x) x "letrec")      
-      ,@(cddr x)))))
+    (check-for-multiple-bindings (cadr x) x "letrec")
+    `(##core#letrec ,@(cdr x)))))
 
 (##sys#extend-macro-environment
  'let-syntax
@@ -1068,9 +1063,8 @@
  (##sys#er-transformer
   (lambda (x r c)
     (##sys#check-syntax 'let-syntax x '(_ #((symbol _) 0) . #(_ 1)))
-    `(##core#let-syntax
-      ,(##sys#check-for-multiple-bindings (cadr x) x "let-syntax")
-      ,@(cddr x)))))
+    (check-for-multiple-bindings (cadr x) x "let-syntax")
+    `(##core#let-syntax ,@(cdr x)))))
 
 (##sys#extend-macro-environment
  'letrec-syntax
@@ -1078,9 +1072,8 @@
  (##sys#er-transformer
   (lambda (x r c)
     (##sys#check-syntax 'letrec-syntax x '(_ #((symbol _) 0) . #(_ 1)))
-    `(##core#letrec-syntax
-      ,(##sys#check-for-multiple-bindings (cadr x) x "letrec-syntax")
-      ,@(cddr x)))))
+    (check-for-multiple-bindings (cadr x) x "letrec-syntax")
+    `(##core#letrec-syntax ,@(cdr x)))))
 
 (##sys#extend-macro-environment
  'set!
-- 
1.7.0.4