chicken-hackers
[Top][All Lists]
Advanced

[Date Prev][Date Next][Thread Prev][Thread Next][Date Index][Thread Index]

[Chicken-hackers] [PATCH] warn if binding to keyword


From: Felix
Subject: [Chicken-hackers] [PATCH] warn if binding to keyword
Date: Sun, 23 Oct 2011 01:35:22 +0200 (CEST)

The attached patch adds a warning, if a keyword is used as a variable
name in a binding construct (let, letrec, let-syntax, letrec-syntax),
which can lead to nasty bugs that are hard to find.


cheers,
felix
>From fc4601e3fc36f2a6ab4580fb803e8b1dc7d906c8 Mon Sep 17 00:00:00 2001
From: felix <address@hidden>
Date: Sun, 23 Oct 2011 01:31:09 +0200
Subject: [PATCH] warn if using keyword as variable in binding form

---
 compiler.scm |   22 +++++++++++++++-------
 eval.scm     |   16 +++++++++++-----
 2 files changed, 26 insertions(+), 12 deletions(-)

diff --git a/compiler.scm b/compiler.scm
index cb9b247..d8c4306 100644
--- a/compiler.scm
+++ b/compiler.scm
@@ -501,6 +501,11 @@
                 (for-each pretty-print imps)
                 (print "\n;; END OF FILE"))))) ) )
 
+  (define (checkvar name form)
+    (when (keyword? name)
+      (warning "variable is keyword in binding form" `(,form (... (,name ...) 
...) ...)))
+    name)
+
   (define (walk x e se dest ldest h)
     (cond ((symbol? x)
           (cond ((keyword? x) `(quote ,x))
@@ -618,7 +623,7 @@
                        ((##core#let)
                         (let* ((bindings (cadr x))
                                (vars (unzip1 bindings))
-                               (aliases (map gensym vars))
+                               (aliases (map (o gensym (cut checkvar <> 'let)) 
vars))
                                (se2 (##sys#extend-se se vars aliases)))
                           (set-real-names! aliases vars)
                           `(let
@@ -636,7 +641,7 @@
                           (walk
                            `(##core#let
                              ,(map (lambda (b)
-                                     (list (car b) '(##core#undefined))) 
+                                     (list (checkvar (car b) 'letrec) 
'(##core#undefined))) 
                                    bindings)
                              ,@(map (lambda (b)
                                       `(##core#set! ,(car b) ,(cadr b))) 
@@ -655,7 +660,7 @@
                           (decompose-lambda-list
                            llist
                            (lambda (vars argc rest)
-                             (let* ((aliases (map gensym vars))
+                             (let* ((aliases (map (o gensym (cut checkvar <> 
'lambda)) vars))
                                     (se2 (##sys#extend-se se vars aliases))
                                     (body0 (##sys#canonicalize-body 
                                             obody se2 compiler-syntax-enabled))
@@ -686,7 +691,7 @@
                         (let ((se2 (append
                                     (map (lambda (b)
                                            (list
-                                            (car b)
+                                            (checkvar (car b) 'let-syntax)
                                             se
                                             (##sys#ensure-transformer
                                              (##sys#eval/meta (cadr b))
@@ -701,7 +706,7 @@
                       ((##core#letrec-syntax)
                        (let* ((ms (map (lambda (b)
                                          (list
-                                          (car b)
+                                          (checkvar (car b) 'letrec-syntax)
                                           #f
                                           (##sys#ensure-transformer
                                            (##sys#eval/meta (cadr b))
@@ -776,8 +781,11 @@
                       ((##core#let-compiler-syntax)
                        (let ((bs (map
                                   (lambda (b)
-                                    (##sys#check-syntax 'let-compiler-syntax b 
'(symbol . #(_ 0 1)))
-                                    (let ((name (lookup (car b) se)))
+                                    (##sys#check-syntax
+                                     'let-compiler-syntax b '(symbol . #(_ 0 
1)))
+                                    (let ((name (lookup
+                                                 (checkvar (car b) 
'let-compiler-syntax) 
+                                                 se)))
                                       (list 
                                        name 
                                        (and (pair? (cdr b))
diff --git a/eval.scm b/eval.scm
index 0ad85b4..5f4ced2 100644
--- a/eval.scm
+++ b/eval.scm
@@ -231,6 +231,11 @@
       (define (decorate p ll h cntr)
        (##sys#eval-decorator p ll h cntr) )
 
+      (define (checkvar name form)
+       (when (keyword? name)
+         (warning "variable is keyword in binding form" `(,form (... (,name 
...) ...) ...)))
+       name)
+
       (define (compile x e h tf cntr se)
        (cond ((keyword? x) (lambda v x))
              ((symbol? x)
@@ -372,7 +377,7 @@
                         [(##core#let)
                          (let* ([bindings (cadr x)]
                                 [n (length bindings)] 
-                                [vars (map (lambda (x) (car x)) bindings)] 
+                                [vars (map (lambda (x) (checkvar (car x) 
'let)) bindings)] 
                                 (aliases (map gensym vars))
                                 [e2 (cons aliases e)]
                                 (se2 (##sys#extend-se se vars aliases))
@@ -424,7 +429,8 @@
                            (compile
                             `(##core#let
                               ,(##sys#map (lambda (b)
-                                            (list (car b) 
'(##core#undefined))) 
+                                            (list (checkvar (car b) 'letrec)
+                                                  '(##core#undefined))) 
                                           bindings)
                               ,@(##sys#map (lambda (b)
                                              `(##core#set! ,(car b) ,(cadr 
b))) 
@@ -445,7 +451,7 @@
                            (##sys#decompose-lambda-list
                             llist
                             (lambda (vars argc rest)
-                              (let* ((aliases (map gensym vars))
+                              (let* ((aliases (map (o gensym (cut checkvar <> 
'lambda)) vars))
                                      (se2 (##sys#extend-se se vars aliases))
                                      (e2 (cons aliases e))
                                      (body 
@@ -529,7 +535,7 @@
                          (let ((se2 (append
                                      (map (lambda (b)
                                             (list
-                                             (car b)
+                                             (checkvar (car b) 'let-syntax)
                                              se
                                              (##sys#ensure-transformer
                                               (##sys#eval/meta (cadr b))
@@ -543,7 +549,7 @@
                         ((##core#letrec-syntax)
                          (let* ((ms (map (lambda (b)
                                            (list
-                                            (car b)
+                                            (checkvar (car b) 'letrec-syntax)
                                             #f
                                             (##sys#ensure-transformer
                                              (##sys#eval/meta (cadr b))
-- 
1.6.0.4


reply via email to

[Prev in Thread] Current Thread [Next in Thread]