compiles without warnings - difflib

1 files changed, 46 insertions, 28 deletions

diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index e56ae7e..2cef86b 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -90,6 +90,17 @@
       (lambda x (pre)))
     #f))
 
+(define-syntax-rule  (with-warn code ...)
+  (with-fluids (((@@ (system base message) %dont-warn-list) '()))
+    code ...))
+
+(define-syntax-rule  (with-warn-data x code ...)
+  (with-fluids (((@@ (system base message) %dont-warn-list) x))
+    code ...))
+
+(define (get-warns)
+   (list 'quote (fluid-ref (@@ (system base message) %dont-warn-list))))
+
 (define (dont-warn v)
   (catch #t
     (lambda ()
@@ -1013,11 +1024,13 @@
                                        s))
                                      
                                     ((a . b)
-                                     (let ((s (exp vs a)))
+                                     (let ((s1 (exp vs a))
+					   (s2 (exp vs b)))
                                        (fluid-set! ignore
-                                                   (cons (exp vs b)
+                                                   (cons s2
                                                          (fluid-ref ignore)))
-                                       (cons s (exp vs b))))))
+				       (dont-warn s2)
+                                       (cons s1 s2)))))
                                 l))))
 					      
   
@@ -1696,40 +1709,43 @@
   (fluid-set! ignore '())
   (if (fluid-ref (@@ (system base compile) %in-compile))
       (begin
-        (if (fluid-ref (@@ (system base compile) %in-compile))
-            (set! s/d (C 'qset!))
-            (set! s/d (C 'define-)))
+	(if (fluid-ref (@@ (system base compile) %in-compile))
+	    (set! s/d (C 'qset!))
+	    (set! s/d (C 'define-)))
   
-        (if (pair? start)
-            (set! x (cdr x)))
-        
-        (let* ((globs (get-globals x))
-               (e     (map (g globs exp) x)))
-          `(begin
-             ,@start
-             ,(C 'clear-warning-data)
-             (fluid-set! (@@ (system base message) %dont-warn-list) '())
+	(if (pair? start)
+	    (set! x (cdr x)))
+
+	(clear-warning-data)
+	
+	(let* ((globs (get-globals x))
+	       (e     (map (g globs exp) x)))
+	  `(begin
+	     ,@start
+	     (fluid-set! (@@ (system base message) %dont-warn-list) '())
 	     (define ,fnm (make-hash-table))
-             ,@(map (lambda (s)
-                      (if (member s (fluid-ref ignore))
-                          `(,cvalues)
-                          `(,(C 'var) ,s))) globs)
-             ,@e
-             (,(C 'export-all)))))
+	     ,@(map (lambda (s)
+		      (if (member s (fluid-ref ignore))
+			  `(,cvalues)
+			  `(,(C 'var) ,s))) globs)
+	     ,@e
+	     (,(C 'export-all)))))
+
       (begin
-        (if (fluid-ref (@@ (system base compile) %in-compile))
-            (set! s/d 'set!)
-            (set! s/d (C 'define-)))
+	(if (fluid-ref (@@ (system base compile) %in-compile))
+	    (set! s/d 'set!)
+	    (set! s/d (C 'define-)))
   
         (if (pair? start)
             (set! x (cdr x)))
-        
+
+	(clear-warning-data)
+	
         (let* ((globs (get-globals x))
                (res   (gensym "res"))
                (e     (map (g globs exp) x)))
           `(begin
              ,@start
-             ,(C 'clear-warning-data)
              (fluid-set! (@@ (system base message) %dont-warn-list) '())
              ,@(map (lambda (s)
                       (if (member s (fluid-ref ignore))
@@ -2002,6 +2018,8 @@
     ((_ () () . code)
      (begin . code))))
 
+(define (mutewarn x y) (list x y))
+
 (define-syntax clambda
   (lambda (x)
     (syntax-case x ()
@@ -2016,8 +2034,8 @@
                     (if (pair? c)
                         (let ((cc (cdr c)))
                           (if (pair? cc)
-                              (apply f c)
-                              (f c cc)))
+                              (apply f c)			      
+                              (apply f (mutewarn c cc))))
                         (py-apply f (* c))))
                    (q (apply f q)))
                  f)))))))