difflib compiles with warnings
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Mon, 20 Aug 2018 11:06:16 +0000 (13:06 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Mon, 20 Aug 2018 11:06:16 +0000 (13:06 +0200)
modules/language/python/compile.scm
modules/language/python/module/collections.scm
modules/language/python/module/difflib.py

index 43db80f..e56ae7e 100644 (file)
   (pretty-print (syntax->datum x))
   x)
 
+(define (gv x)
+  (if (equal? x '_)
+      (gensym "_")
+      x))
+
 (define (gen-sel vs e item)
   (match e
     (#f item)
          (((#:power #f (#:tuple . l) . _))
           (lp l))
          (_
-          `(,(F 'for) ((,@(map (g vs exp) for-e) : ,(exp vs in-e))) ()
+          `(,(F 'for) ((,@(map (lambda (x) (gv ((g vs exp) x))) for-e)
+                       : ,(exp vs in-e))) ()
             ,(gen-sel vs cont item))))))
     ((#:cif cif cont)
      `(if ,(exp vs cif)          
     ((x ...) (map gen-temp #'(x ...)))
     (x       (car (generate-temporaries (list #'x))))))
 
+(define (replace_ stx l)
+  (let lp ((l l))
+    (syntax-case l ()
+      ((a . l) (cons (lp #'a) (lp #'l)))
+      (x
+       (if (equal? (syntax->datum #'x) '_)
+          (datum->syntax stx (gensym "_"))
+          #'x)))))
+
+(define-syntax with-syntax*
+  (syntax-rules ()
+    ((_ () code)     code)
+    ((_ () . code) (begin . code))
+    ((_ (x . l) . code)
+     (with-syntax (x) (with-syntax* l . code)))))
+
 (define-syntax cfor
-  (lambda (x)
-    (syntax-case x ()
+  (lambda (xx)
+    (syntax-case xx ()
       ((_ (x ...) in code next p)
        (or-map pair? #'(x ...))
        #'(for-adv  (x ...) in code next p))
      
       ((_ (x) (a) code #f #f)
-       #'(if (pair? a)
-             (let/ec break-ret
-               (let lp ((l a))
-                 (if (pair? l)
-                     (begin
-                       (set! x (car l))
-                       (with-sp ((continue (values))
-                                 (break    (break-ret)))
+       (with-syntax ((x (replace_ xx #'x)))
+         #'(if (pair? a)
+              (let/ec break-ret
+                (let lp ((l a))
+                  (if (pair? l)
+                      (begin
+                        (set! x (car l))
+                        (with-sp ((continue (values))
+                                  (break    (break-ret)))
                                 code)
-                       (lp (cdr l))))))
-             (for/adv1 (x) (a) code #f #f)))
-
-    ((_ (x) (a) code #f #t)
-     #'(if (pair? a)
-           (let/ec break-ret
-             (let lp ((l a))
-               (if (pair? l)
-                   (begin
-                     (let/ec continue-ret
-                       (set! x (car l))
-                       (with-sp ((continue (continue-ret))
-                                 (break    (break-ret)))                     
-                                code))
-                     (lp (cdr l))))))
-           (for/adv1 (x) (a) code #f #t)))
-
-    ((_ (x) (a) code next #f)
-     #'(if (pair? a)
-           (let/ec break-ret
-             (let lp ((l a))
-               (if (pair? l)
-                   (begin
-                     (set! x (car l))
-                     (with-sp ((continue (values))
-                               (break    (break-ret)))
-                              code))
-                   (lp (cdr l))))
-             next)
-           (for/adv1 (x) (a) code next #f)))
-
-    ((_ (x) (a) code next #t)
-     #'(if (pair? a)
-           (let/ec break-ret
-             (let lp ((l a))
-               (if (pair? l)
-                   (let/ec continue-ret
-                     (set! x (car l))
-                     (with-sp ((continue (continue-ret))
-                               (break    (break-ret)))
-                              code))
-                   (lp (cdr l))))
-             next)
-           (for/adv1 (x) (a) code next #f)))
+                        (lp (cdr l))))))
+              (for/adv1 (x) (a) code #f #f))))
+
+      ((_ (x) (a) code #f #t)
+       (with-syntax ((x (replace_ xx #'x)))
+          #'(if (pair? a)
+               (let/ec break-ret
+                   (let lp ((l a))
+                    (if (pair? l)
+                        (begin
+                          (let/ec continue-ret
+                            (set! x (car l))
+                            (with-sp ((continue (continue-ret))
+                                      (break    (break-ret)))                     
+                                  code))
+                          (lp (cdr l))))))
+               (for/adv1 (x) (a) code #f #t))))
+
+      ((_ (x) (a) code next #f)
+       (with-syntax ((x (replace_ xx #'x)))
+          #'(if (pair? a)
+               (let/ec break-ret
+                   (let lp ((l a))
+                     (if (pair? l)
+                         (begin
+                           (set! x (car l))
+                           (with-sp ((continue (values))
+                                     (break    (break-ret)))
+                               code))
+                         (lp (cdr l))))
+                   next)
+               (for/adv1 (x) (a) code next #f))))
+
+      ((_ (x) (a) code next #t)
+       (with-syntax ((x (replace_ xx #'x)))
+          #'(if (pair? a)
+               (let/ec break-ret
+                  (let lp ((l a))
+                    (if (pair? l)
+                        (let/ec continue-ret
+                            (set! x (car l))
+                           (with-sp ((continue (continue-ret))
+                                     (break    (break-ret)))
+                               code))
+                        (lp (cdr l))))
+                  next)
+               (for/adv1 (x) (a) code next #f))))
     
-    ((_ x a code next p)
-     #'(for/adv1 x a code next p)))))
+      ((_ x a code next p)
+       #'(for/adv1 x a code next p)))))
 
 (define-syntax for/adv1
-  (lambda (x)
-    (syntax-case x ()
-      ((_ (x ...) (in) code #f #f)
-       (with-syntax ((inv      (gentemp #'in))
-                     ((xx ...) (gen-temp #'(x ...))))
-         #'(let ((inv (wrap-in in)))
+  (lambda (zz)
+    (syntax-case zz ()
+      ((_ (xy ...) (in) code #f #f)
+       (with-syntax* ((inv      (gentemp #'in))
+                     ((yy ...) (replace_ zz #'(xy ...)))
+                     ((xx ...) (gen-temp #'(yy ...))))
+       #'(let ((inv (wrap-in in)))
+           (clet (yy ...)
              (catch StopIteration
                (lambda ()
                  (let lp ()
                    (call-with-values (lambda () (next inv))
                      (clambda (xx ...)
-                       (cset! x xx) ... 
+                       (cset! yy xx) ... 
                        (with-sp ((break    (values))
                                  (continue (values)))
                                 code
                                 (lp))))))
-               (lambda z (values))))))
+               (lambda z (values)))))))
 
-      ((_ (x ...) (in ...) code #f #f)
-       (with-syntax (((inv ...) (generate-temporaries #'(in ...)))
-                     ((xx  ...) (gen-temp #'(x ...))))
+      ((_ (xy ...) (in ...) code #f #f)
+       (with-syntax* (((inv ...) (generate-temporaries #'(in ...)))
+                     ((yy  ...) (replace_ zz #'(xy ...)))
+                     ((xx  ...) (gen-temp #'(yy ...))))
          #'(let ((inv (wrap-in in)) ...)
+            (clet (yy ...)
              (catch StopIteration
                (lambda ()
                  (let lp ()
                    (call-with-values (lambda () (values (next inv) ...))
                      (clambda (xx ...)
-                       (cset! x xx) ...
+                       (cset! yy xx) ...
                        (with-sp ((break    (values))
                                  (continue (values)))
                                 code
                                 (lp))))))
-               (lambda z (values))))))
-
-      ((_ (x ...) (in) code #f #t)
-       (with-syntax ((inv       (gentemp #'in))
-                     ((xx  ...) (gen-temp #'(x ...))))
-          #'(let ((inv (wrap-in in)))
+               (lambda z (values)))))))
+
+      ((_ (xy ...) (in) code #f #t)
+       (with-syntax* ((inv       (gentemp #'in))
+                     ((yy  ...) (replace_ zz #'(xy ...)))
+                     ((xx  ...) (gen-temp #'(yy ...))))
+       #'(let ((inv (wrap-in in)))
+           (clet (yy ...)
               (let lp ()
                 (let/ec break-ret
                   (catch StopIteration
                     (lambda ()
                       (call-with-values (lambda () (next inv))
                         (clambda (xx ...)
-                          (cset! x xx) ...
+                          (cset! yy xx) ...
                           (let/ec continue-ret
                             (with-sp ((break     (break-ret))
                                       (continue  (continue-ret)))
                                      code))
                           (lp))))
-                    (lambda z (values))))))))
-
-      ((_ (x ...) (in ...) code #f #t)
-       (with-syntax (((inv ...) (generate-temporaries #'(in ...)))
-                     ((xx  ...) (gen-temp #'(x ...))))
-          #'(let ((inv (wrap-in in)) ...)
+                    (lambda z (values)))))))))
+
+      ((_ (xy ...) (in ...) code #f #t)
+       (with-syntax* (((inv ...) (generate-temporaries #'(in ...)))
+                     ((yy  ...) (replace_ zz #'(xy ...)))
+                     ((xx  ...) (gen-temp #'(yy ...))))
+        #'(let ((inv (wrap-in in)) ...)
+            (clet (yy ...)
               (let lp ()
                 (let/ec break-ret
                   (catch StopIteration
                     (lambda ()
                       (call-with-values (lambda () (values (next inv) ...))
                         (clambda (xx ...)
-                          (cset! x xx) ...
+                          (cset! yy xx) ...
                           (let/ec continue-ret
                             (with-sp ((break     (break-ret))
                                       (continue  (continue-ret)))
                                      code))
                           (lp))))
-                    (lambda z (values))))))))
+                    (lambda z (values)))))))))
 
       ((_  (x ...) in code else #f)
        #'(for-adv (x ...) in code else #f))
 
 
 (define-syntax for-adv
-  (lambda (x)
+  (lambda (zz)
     (define (gen x y)
       (if (= (length (syntax->datum x)) (= (length (syntax->datum y))))
           (syntax-case x ()
           (syntax-case x ()
             ((x)  #'(next x)))))
     
-    (syntax-case x ()
-      ((_ (x ...) (in) code else p)
-       (with-syntax ((inv (gentemp #'in)))
-         (with-syntax (((xx ...) (gen-temp #'(x ...))))
+    (syntax-case zz ()
+      ((_ (xy ...) (in) code else p)
+       (with-syntax* ((inv (gentemp #'in))
+                     ((yy ...) (replace_ zz #'(xy ...)))
+                     ((xx ...) (gen-temp #'(yy ...))))
+                                 
            (if (syntax->datum #'p)
                #'(let ((inv (wrap-in in)))
-                   (clet (x ...)
+                   (clet (yy ...)
                      (let/ec break-ret
                        (catch StopIteration
                          (lambda ()
                            (let lp ()
                              (call-with-values (lambda () (next inv))
                                (clambda (xx ...)
-                                 (cset! x xx) ...
+                                 (cset! yy xx) ...
                                  (let/ec continue-ret
                                    (with-sp ((break     (break-ret))
                                              (continue  (continue-ret)))
                          (lambda q else)))))
              
                    #'(let ((inv (wrap-in in)))
-                       (clet (x ...)
+                       (clet (yy ...)
                              (let/ec break-ret
                                (catch StopIteration
                                  (lambda ()
                                    (let lp ()
                                      (call-with-values (lambda () (next inv))
                                        (clambda (xx ...)
-                                                (cset! x xx) ...
+                                                (cset! yy xx) ...
                                          (with-sp ((break     (break-ret))
                                                    (continue  (values)))
                                                   code)
                                          (lp)))))
-                                 (lambda e else)))))))))
+                                 (lambda e else))))))))
       
-      ((_ (x ...) (in ...) code else p)
-       (with-syntax (((inv ...) (generate-temporaries #'(in ...))))
-       (with-syntax ((get       (gen #'(inv ...) #'(x ...)))
-                     ((xx ...)  (gen-temp #'(x ...))))
+      ((_ (xy ...) (in ...) code else p)
+       (with-syntax* (((inv ...) (generate-temporaries #'(in ...)))
+                     ((yy  ...) (replace_ zz #'(xy ...)))
+                     (get       (gen #'(inv ...) #'(yy ...)))
+                     ((xx ...)  (gen-temp #'(yy ...))))
          (if (syntax->datum #'p)
-             #'(clet (x ...)
+             #'(clet (yy ...)
                  (let ((inv (wrap-in in)) ...)               
                    (let/ec break-ret
                      (catch StopIteration
                          (let lp ()
                            (call-with-values (lambda () get)
                              (clambda (xx ...)
-                               (cset! x xx) ...
+                               (cset! yy xx) ...
                                (let/ec continue-ret
                                  (with-sp ((break     (break-ret))
                                            (continue  (continue-ret)))
                                (lp)))))
                        (lambda q else)))))
              
-                 #'(clet (x ...)
+                 #'(clet (yy ...)
                      (let ((inv (wrap-in in)) ...)
                        (let/ec break-ret
                          (catch StopIteration
                              (let lp ()
                                (call-with-values (lambda () get)
                                  (clambda (xx ...)
-                                   (cset! x xx) ...
+                                   (cset! yy xx) ...
                                    (with-sp ((break     (break-ret))
                                              (continue  (values)))
                                             code)
                                    (lp)))))
-                           (lambda e else))))))))))))
+                           (lambda e else)))))))))))
 
 (define-syntax cset!
   (syntax-rules ()
index f8b0b45..39a4d45 100644 (file)
 
      (let ((seen (py-set)))
        (if (string? field_names)
-          (set! field_names (string-split field_names #\,)))
-
+          (set! field_names
+                (string-split field_names #\,)))
+
+       (set! field_names
+            (let lp ((fs field_names))
+              (if (pair? fs)
+                  (append (string-split (car fs) #\space)
+                          (lp (cdr fs)))
+                  '())))
+       
        (set! field_names (py-list (py-map scm-str field_names)))
        (set! typename (scm-str typename))
 
index 8d9d365..e0aa831 100644 (file)
@@ -2091,5 +2091,3 @@ def _test():
     import doctest, difflib
     return doctest.testmod(difflib)
 
-if __name__ == "__main__":
-    _test()