On Sun, Feb 03, 2013 at 11:33:09PM +0100, Felix wrote: > From: Peter Bex <[email protected]> > > > > Could you please generate a fresh patch against master? > > Attached.
How about this slightly improved version? The patch you posted warns multiple times per symbol seen. Usually this shouldn't be an issue, but consider a macro that erroneously generates the same identifier many times. Since it's the same name, it doesn't make much sense to warn more than once. The warning already says it's bound "multiple times". Before: #;1> (let ((a 1) (a 2) (a 3)) a) Warning: variable bound multiple times in let construct a (let ((a 1) (a 2) (a 3)) a) Warning: variable bound multiple times in let construct a (let ((a 1) (a 2) (a 3)) a) 1 #;2> After: #;1> (let ((a 1) (a 2) (a 3)) a) Warning: variable bound multiple times in let construct a (let ((a 1) (a 2) (a 3)) a) 1 #;2> Cheers, Peter -- http://sjamaan.ath.cx
>From 3b0a7f5ba2a6180882380d85b18a6514c1ae89d9 Mon Sep 17 00:00:00 2001 From: felix <[email protected]> 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. Signed-off-by: Peter Bex <[email protected]> --- expand.scm | 26 +++++++++++++++++++++++--- 1 file changed, 23 insertions(+), 3 deletions(-) diff --git a/expand.scm b/expand.scm index 49e3cc1..b278ec0 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,30 @@ ,(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) (seen '()) (warned '())) + (cond ((null? bs)) + ((and (memq (caar bs) seen) + (not (memq (caar bs) warned))) + (##sys#warn + (string-append "variable bound multiple times in " loc " construct") + (caar bs) + form) + (loop (cdr bs) seen (cons (caar bs) warned))) + (else (loop (cdr bs) (cons (caar bs) seen) warned))))) + (##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 +1055,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 +1064,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 +1073,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.8.0.1
_______________________________________________ Chicken-hackers mailing list [email protected] https://lists.nongnu.org/mailman/listinfo/chicken-hackers
