compiles without warnings - difflib
[software/python-on-guile.git] / modules / language / python / compile.scm
index e56ae7ee5f0355105738fe40eb336b3b2ad740de..2cef86be750b40315d1624b3a530d31dff4fc266 100644 (file)
       (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 ()
                                        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))))
                                              
   
   (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))
     ((_ () () . code)
      (begin . code))))
 
+(define (mutewarn x y) (list x y))
+
 (define-syntax clambda
   (lambda (x)
     (syntax-case x ()
                     (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)))))))