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

[Felix]

From: Peter Bex <address@hidden>
Subject: Re: [Chicken-hackers] [PATCH] warn if var is bound multiple times in 
the same binding form
Date: Sun, 3 Feb 2013 15:46:31 +0100

> On Fri, Feb 01, 2013 at 12:14:33AM +0100, Felix wrote:
>> The attached patch emits a warning at expansion time if the same variable
>> in a let[rec][-syntax] form is bound more than once.
> 
> This patch doesn't apply.  It looks like this is a patch against some
> earlier version of itself: it changes ##sys#check-for-multiple-bindings
> to check-for-multiple-bindings, but neither is in master's expand.scm
> 
> Could you please generate a fresh patch against master?

Attached.


cheers,
felix

>From 125c520dbcd9a3bcfebc8ce312ea50938f13eda3 Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Sun, 3 Feb 2013 23:32:19 +0100
Subject: [PATCH] Warn if the same variable is bound multiple times in a let, 
letrec, let-syntax or letrec-syntax form.

---
 expand.scm |   25 ++++++++++++++++++++++---
 1 files changed, 22 insertions(+), 3 deletions(-)

diff --git a/expand.scm b/expand.scm
index 49e3cc1..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,14 +1023,29 @@
                 ,(car head)
                 (##sys#er-transformer (##core#lambda ,(cdr head) 
,@body))))))))))
 
+(define (check-for-multiple-bindings bindings form loc)
+  ;; assumes correct syntax
+  (let loop ((bs bindings) (done '()))
+    (cond ((null? bs))
+         ((memq (caar bs) done)
+          (##sys#warn 
+           (string-append "variable bound multiple times in " loc " construct")
+           (caar bs)
+           form)
+          (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))))
+    (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
@@ -1038,6 +1054,7 @@
  (##sys#er-transformer
   (lambda (x r c)
     (##sys#check-syntax 'letrec x '(_ #((symbol _) 0) . #(_ 1)))
+    (check-for-multiple-bindings (cadr x) x "letrec")
     `(##core#letrec ,@(cdr x)))))
 
 (##sys#extend-macro-environment
@@ -1046,6 +1063,7 @@
  (##sys#er-transformer
   (lambda (x r c)
     (##sys#check-syntax 'let-syntax x '(_ #((symbol _) 0) . #(_ 1)))
+    (check-for-multiple-bindings (cadr x) x "let-syntax")
     `(##core#let-syntax ,@(cdr x)))))
 
 (##sys#extend-macro-environment
@@ -1054,6 +1072,7 @@
  (##sys#er-transformer
   (lambda (x r c)
     (##sys#check-syntax 'letrec-syntax x '(_ #((symbol _) 0) . #(_ 1)))
+    (check-for-multiple-bindings (cadr x) x "letrec-syntax")
     `(##core#letrec-syntax ,@(cdr x)))))
 
 (##sys#extend-macro-environment
-- 
1.7.0.4