improvements of optparse
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Thu, 16 Aug 2018 20:41:44 +0000 (22:41 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Thu, 16 Aug 2018 20:41:44 +0000 (22:41 +0200)
modules/language/python/compile.scm
modules/language/python/list.scm
modules/language/python/module.scm
modules/language/python/module/_python.scm
modules/language/python/module/io.scm
modules/language/python/module/optparse.py
modules/language/python/module/os.scm
modules/language/python/module/python.scm
modules/language/python/module/sys.scm

index b2f5ea78c164fe097d245456dde40c9c076ed3cd..de4299d7bd6dea51da88271236e934c1cd23cdd8 100644 (file)
@@ -43,6 +43,8 @@
 (define-inlinable (H   x) `(@  (language python hash)    ,x))
 (define-inlinable (W   x) `(@  (language python with)    ,x))
 
+(define cvalues (G 'values))
+
 (define-syntax-rule (wth code)
   (let ((old s/d))
     (set! s/d (C 'qset!))
         
           (_ (error "unhandled addings")))
         (get-addings vs l fast?))))))
-  
+
 (define-syntax-rule (setwrap u)
   (call-with-values (lambda () u)
     (case-lambda
  (#:decorated
   ((_ (l ...))
    (fluid-set! decorations (map (g vs exp) l))
-   '(values)))
+   `(,cvalues)))
  
  (#:string
   ((_ l)
                                 (if (< ,x ,v)
                                     (begin
                                       (,(C 'let/ec) continue-ret
-                                       (,(C 'with-sp) ((continue (values))
+                                       (,(C 'with-sp) ((continue (,cvalues))
                                                        (break    (break-ret)))
                                         ,code2))
                                       (,lp (+ ,x 1))))))))
                                 (if (< ,x ,v2)
                                     (begin
                                       (,(C 'let/ec) continue-ret
-                                       (,(C 'with-sp) ((continue (values))
+                                       (,(C 'with-sp) ((continue (,cvalues))
                                                        (break    (break-ret)))
                                         ,code2))
                                       (,lp (+ ,x 1)))))))
                                         (begin
                                           (,(C 'let/ec) continue-ret
                                            (,(C 'with-sp)
-                                            ((continue (values))
+                                            ((continue (,cvalues))
                                              (break    (break-ret)))
                                             ,code2))
                                           (,lp (+ ,x ,st)))))
                                             (begin
                                               (,(C 'let/ec) continue-ret
                                                (,(C 'with-sp)
-                                                ((continue (values))
+                                                ((continue (,cvalues))
                                                  (break    (break-ret)))
                                                 ,code2))
                                               (,lp (+ ,x ,st)))))
             (if (,(C 'boolit) ,(exp vs test))
                 (begin
                   (,(C 'let/ec) continue-ret
-                   (,(C 'with-sp) ((continue (values))
+                   (,(C 'with-sp) ((continue (,cvalues))
                                    (break    (break-ret)))                    
                     ,code2))
                   (,lp)))))
             (if (,(C 'boolit) ,(exp vs test))
                 (begin
                   (,(C 'let/ec) ,(C 'continue-ret)
-                   (,(C 'with-sp) ((continue (values))
+                   (,(C 'with-sp) ((continue (,cvalues))
                                    (break    (break-ret)))
                     ,code2))
                   (,lp))
  
  (#:global
   ((_ . _)
-   '(values)))
+   `(,cvalues)))
  
  (#:list
   ((_ x (and e (#:cfor . _)))
  (#:stmt
   ((_ l)
    (if (> (length l) 1)
-       (cons 'values (map (g vs exp) l))
+       (cons cvalues (map (g vs exp) l))
        (exp vs (car l)))))
   
  (#:expr-stmt
          (if (= (length l) 1)
              `(begin
                 ,(make-set vs op (car l) (exp vs (car u)))
-                (values))
+                (,cvalues))
              `(begin
                 ,@(map (lambda (l u) (make-set vs op l u))
                        l
                        (map (g vs exp) u))
-                (values))))
+                (,cvalues))))
         
         ((and (= (length u) 1) (not op))         
          (let ((vars (map (lambda (x) (gensym "v")) l))
                              ,@(map (lambda (l v) (make-set vs op l v))
                                     l vars)))))
                   ,f))
-              (values))))
+              (,cvalues))))
         
         ((and (= (length l) 1) (not op))
          `(begin
             ,(make-set vs op (car l) `(,(G 'list) ,@(map (g vs exp) u)))
-            (values)))))))
+            (,cvalues)))))))
   
   ((_
     ((#:test (#:power #f (#:identifier v . _) () . #f) #f))
                 ,@(map (lambda (l u) (make-set vs op l u))
                        l
                        (map (g vs exp) u))
-                (values ,@(map (g exp vs) l)))))
+                (,cvalues ,@(map (g exp vs) l)))))
         
         ((and (= (length u) 1) (not op))         
          (let ((vars (map (lambda (x) (gensym "v")) l))
                              ,@(map (lambda (l v) (make-set vs op l v))
                                     l vars)))))
                   ,f))
-              (values ,@(map (g exp vs) l)))))
+              (,cvalues ,@(map (g exp vs) l)))))
         
         ((and (= (length l) 1) (not op))
          `(begin
             ,(make-set vs op (car l) `(,(G 'list) ,@(map (g vs exp) u)))
-            (values ,(exp vs (car l))))))))))
+            (,cvalues ,(exp vs (car l))))))))))
   
  (#:return
   ((_  x)
     (#:None  (E 'None))
     (#:null  ''())
     (#:False #f)
-    (#:pass  `(values))
+    (#:pass  `(,cvalues))
     (#:break
      (C 'break))    
     (#:continue
             (define ,fnm (make-hash-table))
              ,@(map (lambda (s)
                       (if (member s (fluid-ref ignore))
-                          `(values)
+                          `(,cvalues)
                           `(,(C 'var) ,s))) globs)
              ,@e
              (,(C 'export-all)))))
              (fluid-set! (@@ (system base message) %dont-warn-list) '())
              ,@(map (lambda (s)
                       (if (member s (fluid-ref ignore))
-                          `(values)
+                          `(,cvalues)
                           `(,(C 'var) ,s))) globs)
              ,@e)))))
               
         (x #'x)))
   
     (define (is-ec ret x tail)
-      (syntax-case x (let-syntax begin let if define @@)
+      (syntax-case x (let-syntax begin let let* if define @@)
         ((cond (p a ... b) ...)
          (equal? (syntax->datum #'cond)
                  '(@ (guile) cond))
-           (or
-            (or-map (lambda (x) (is-ec ret x #f))
-                    #'(a ... ...))
-            (or-map (lambda (x) (is-ec ret x tail))
-                    #'(b ...))))
+         (or
+          (or-map (lambda (x) (is-ec ret x #f))
+                  #'(a ... ...))
+          (or-map (lambda (x) (is-ec ret x tail))
+                  #'(b ...))))
         
         ((with-self u v a ... b)
          (equal? (syntax->datum #'with-self)
           (or-map (lambda (x) (is-ec ret x #f)) #'(a ...))
           (is-ec ret #'b tail)))
 
+        ((let* ((y x) ...) a ... b)
+         #t
+         (or
+          (or-map (lambda (x) (is-ec ret x #f)) #'(x ...))
+          (or-map (lambda (x) (is-ec ret x #f)) #'(a ...))
+          (is-ec ret #'b tail)))
+
         ((define . _)
          #t
          #f)
       ((_ ret  l)
        (let ((code (analyze #'ret #'l)))
          (if (is-ec #'ret #'l #t)
-             #`(let/ec ret #,code)
+             #`(let/ec ret l)
              code))))))
 
 (define-syntax var
                    (q (apply f q)))
                  f)))))))
 
+(define (gen-temp x)
+  (syntax-case x ()
+    ((x ...) (map gen-temp #'(x ...)))
+    (x       (car (generate-temporaries (list #'x))))))
+
 (define-syntax cfor
   (lambda (x)
     (syntax-case x ()
     (syntax-case x ()
       ((_ (x ...) (in) code #f #f)
        (with-syntax ((inv      (gentemp #'in))
-                     ((xx ...) (generate-temporaries #'(x ...))))
+                     ((xx ...) (gen-temp #'(x ...))))
          #'(let ((inv (wrap-in in)))
              (catch StopIteration
                (lambda ()
                  (let lp ()
                    (call-with-values (lambda () (next inv))
                      (clambda (xx ...)
-                       (set! x xx) ... 
+                       (cset! x xx) ... 
                        (with-sp ((break    (values))
                                  (continue (values)))
                                 code
 
       ((_ (x ...) (in ...) code #f #f)
        (with-syntax (((inv ...) (generate-temporaries #'(in ...)))
-                     ((xx  ...) (generate-temporaries #'(x ...))))
+                     ((xx  ...) (gen-temp #'(x ...))))
          #'(let ((inv (wrap-in in)) ...)
              (catch StopIteration
                (lambda ()
                  (let lp ()
                    (call-with-values (lambda () (values (next inv) ...))
                      (clambda (xx ...)
-                       (set! x xx) ...
+                       (cset! x xx) ...
                        (with-sp ((break    (values))
                                  (continue (values)))
                                 code
 
       ((_ (x ...) (in) code #f #t)
        (with-syntax ((inv       (gentemp #'in))
-                     ((xx  ...) (generate-temporaries #'(x ...))))
+                     ((xx  ...) (gen-temp #'(x ...))))
           #'(let ((inv (wrap-in in)))
               (let lp ()
                 (let/ec break-ret
                     (lambda ()
                       (call-with-values (lambda () (next inv))
                         (clambda (xx ...)
-                          (set! x xx) ...
+                          (cset! x xx) ...
                           (let/ec continue-ret
                             (with-sp ((break     (break-ret))
                                       (continue  (continue-ret)))
 
       ((_ (x ...) (in ...) code #f #t)
        (with-syntax (((inv ...) (generate-temporaries #'(in ...)))
-                     ((xx  ...) (generate-temporaries #'(x ...))))
+                     ((xx  ...) (gen-temp #'(x ...))))
           #'(let ((inv (wrap-in in)) ...)
               (let lp ()
                 (let/ec break-ret
                     (lambda ()
                       (call-with-values (lambda () (values (next inv) ...))
                         (clambda (xx ...)
-                          (set! x xx) ...
+                          (cset! x xx) ...
                           (let/ec continue-ret
                             (with-sp ((break     (break-ret))
                                       (continue  (continue-ret)))
             ((x ...) #'(values (next x) ...)))
           (syntax-case x ()
             ((x)  #'(next x)))))
-
-    (define (gen-temp x)
-      (syntax-case x ()
-        ((x ...) (map gen-temp #'(x ...)))
-        (x       (car (generate-temporaries (list #'x))))))
     
     (syntax-case x ()
       ((_ (x ...) (in) code else p)
 
 
 (define-syntax boolit
-  (syntax-rules (and or not < <= > >=)
-    ((_ (and x y)) (and (boolit x) (boolit y)))
-    ((_ (or  x y)) (or  (boolit x) (boolit y)))
-    ((_ (not x  )) (not (boolit x)))
-    ((_ (<   x y)) (<  x y))
-    ((_ (<=  x y)) (<= x y))
-    ((_ (>   x y)) (>  x y))
-    ((_ (>=  x y)) (>= x y))
+  (syntax-rules (and eq? equal? or not < <= > >=)
+    ((_ (and    x y)) (and (boolit x) (boolit y)))
+    ((_ (or     x y)) (or  (boolit x) (boolit y)))
+    ((_ (not    x  )) (not (boolit x)))
+    ((_ (<      x y)) (<  x y))
+    ((_ (<=     x y)) (<= x y))
+    ((_ (>      x y)) (>  x y))
+    ((_ (>=     x y)) (>= x y))
+    ((_ (eq?    x y)) (eq? x y))
+    ((_ (equal? x y)) (equal? x y))
+
+    ((_ ((@ (guile) eq?   ) x y))    (eq? x y))
+    ((_ ((@ (guile) equal?) x y)) (equal? x y))
+    ((_ ((@ (guile) and   ) x y))    (and (boolit x) (boolit y)))
+    ((_ ((@ (guile) or    ) x y))    (or  (boolit x) (boolit y)))
+    ((_ ((@ (guile) not   ) x  ))    (not (boolit x)))
+    ((_ ((@ (guile) <     ) x y))    (<  x y))
+    ((_ ((@ (guile) <=    ) x y))    (<= x y))
+    ((_ ((@ (guile) >     ) x y))    (>  x y))
+    ((_ ((@ (guile) >=    ) x y))    (>= x y))
     ((_ #t) #t)
     ((_ #f) #f)
     ((_ x ) (bool x))))
index 99c4f595b283a17d6f66fda034a66f9b182120eb..5cdb3d37ca14b3f7dc3839972c4e4dfbadd24d10 100644 (file)
 
 
 ;;SLICE
-(define-method (pylist-slice (o <p>) n1 n2 n3)
+(define-method (pylist-slice (o <p>) . l)
   (aif it (ref o '__getslice__)
-       (it n1 n2 n3)
+       (apply it l)
        (next-method)))
 
 (define-method (pylist-slice (o <py-list>) n1 n2 n3)
   (define N (slot-ref o 'n))
   (define (f n) (if (< n 0) (+ N n) n))
-    
   (let* ((n1   (f (if (eq? n1 None) 0                n1)))
          (n2   (f (if (eq? n2 None) (slot-ref o 'n)  n2)))
          (n3   (f (if (eq? n3 None) 1                n3)))
        (next-method)))
 
 ;;POP!
-(define-method (pylist-pop! (o <py-list>))
-  (let* ((n   (slot-ref o 'n))
-         (m   (- n 1))
-         (vec (slot-ref o 'vec)))
-    (if (> n 0)
-        (let ((ret (vector-ref vec m)))
-          (slot-set! o 'n m)
-          (vector-set! vec m #f)
-          ret)
-        (raise IndexError "pop from empty list"))))
+(define-method (pylist-pop! (o <py-list>) . l)
+  (let ((index (if (null? l)
+                   #f
+                   (car l))))
+    (if index
+        (let ((x (pylist-ref o index)))
+          (pylist-delete! o index)
+          x)                                 
+        (let* ((n   (slot-ref o 'n))
+               (m   (- n 1))
+               (vec (slot-ref o 'vec)))
+          (if (> n 0)
+              (let ((ret (vector-ref vec m)))
+                (slot-set! o 'n m)
+                (vector-set! vec m #f)
+                ret)
+              (raise IndexError "pop from empty list"))))))
 
 (define-method (pylist-pop! (o <p>) . l)
   (aif it (ref o 'pop) 
index 52ec88b06e163c5859e8697b30ba1cbae64be8e5..680cf15591e1b515819a88846e8a809570b19e54 100644 (file)
       (let* ((h (slot-ref self 'h))
             (l '())
              (m (_m self))
-            (add (lambda (k . u) (set! l (cons (symbol->string k) l)))))
+            (add (lambda (k . u)
+                    (if (not (in "-" (symbol->string k)))
+                        (set! l (cons (symbol->string k) l))))))
        (hash-for-each add h)
         (module-for-each add m)
        (py-list l))))
index 2fac0a1e149f29ac014f6647159ceafcbcdf01cb..d9cb1c993b1a8d1968a044b17f916e4aa3d0af7d 100644 (file)
@@ -9,6 +9,8 @@
   #:use-module (language python exceptions       )
   #:use-module ((language python module string   ) #:select ())
   #:use-module ((language python module io       ) #:select (open))
+  #:use-module ((language python module sys      )
+                #:select ((stdout . _stdout)))
   #:use-module (language python def              ) 
   #:use-module (language python for              )
   #:use-module (language python try              )
 (define vars py-dict)
 
 (define print
-  (case-lambda
-    (()  ((@ (guile) display) "\n"))
-    ((x) ((@ (guile) display) x ) (print))
-    (l   ((@ (guile) display) l ) (print))))
+  (lam ((= file _stdout) (* l))
+    (if file (set! file (ref file '_port)))
+    (with-output-to-port file
+       (lambda ()
+         (apply
+          (case-lambda
+            (()  ((@ (guile) display) "\n"))
+            ((x) ((@ (guile) display) x    ) (print))
+            (l   ((@ (guile) display) l    ) (print)))
+          l)))))
 
 (define (repr x) ((@ (guile) format) #f "~a" x))
 (define abs     py-abs)
index 87a2ec88b36c42e1fa72754e6668377fae693ea7..058e62de8e3ef417553cb0390b2d124786d9d857 100644 (file)
 (define-python-class FileIO (RawIOBase)
   (define __init__
     (lam (self name (= mode 'r') (= closefd #t) (= opener None))
-         (if (pair? name)
-             (set self '_port (car name))
-             (set self '_port
-                  (open- (path-it name)
-                         #:mode      mode
-                         #:closefd   closefd
-                         #:opener    opener)))
-         (set self 'mode mode)
-         (set self 'name (cdr name)))))
+         (if (port? name)
+             (set self '_port name)
+             (begin
+               (if (pair? name)
+                   (set self '_port (car name))
+                   (set self '_port
+                        (open- (path-it name)
+                               #:mode      mode
+                               #:closefd   closefd
+                               #:opener    opener)))
+               (set self 'mode mode)
+               (set self 'name (cdr name)))))))
 
 
 (define-python-class BytesIO (BufferedIOBase)
index 886e685f066a32fc71c5afad5e96f23727cbe637..903b374e0f0dafbb68fb7d53c3f1bbfe83596998 100644 (file)
@@ -210,12 +210,14 @@ class HelpFormatter:
                  short_first):
         self.parser = None
         self.indent_increment = indent_increment
+
         if width is None:
             try:
                 width = int(os.environ['COLUMNS'])
             except (KeyError, ValueError):
                 width = 80
             width -= 2
+
         self.width = width
         self.help_position = self.max_help_position = \
                 min(max_help_position, max(width - 20, indent_increment * 2))
@@ -1102,7 +1104,6 @@ class OptionGroup (OptionContainer):
         formatter.dedent()
         return result
 
-
 class OptionParser (OptionContainer):
 
     """
@@ -1186,17 +1187,23 @@ class OptionParser (OptionContainer):
                  add_help_option=True,
                  prog=None,
                  epilog=None):
+
         OptionContainer.__init__(
             self, option_class, conflict_handler, description)
+
         self.set_usage(usage)
         self.prog = prog
         self.version = version
         self.allow_interspersed_args = True
         self.process_default_values = True
+
         if formatter is None:
             formatter = IndentedHelpFormatter()
+
         self.formatter = formatter
+
         self.formatter.set_parser(self)
+
         self.epilog = epilog
 
         # Populate the option list; initial sources are the
@@ -1205,10 +1212,8 @@ class OptionParser (OptionContainer):
         # _add_help_option() methods.
         self._populate_option_list(option_list,
                                    add_help=add_help_option)
-
         self._init_parsing_state()
 
-
     def destroy(self):
         """
         Declare that you are done with this OptionParser.  This cleans up
@@ -1307,14 +1312,12 @@ class OptionParser (OptionContainer):
         if not self.process_default_values:
             # Old, pre-Optik 1.5 behaviour.
             return Values(self.defaults)
-
         defaults = self.defaults.copy()
         for option in self._get_all_options():
             default = defaults.get(option.dest)
             if isinstance(default, str):
                 opt_str = option.get_opt_string()
                 defaults[option.dest] = option.check_value(opt_str, default)
-
         return Values(defaults)
 
 
@@ -1367,6 +1370,7 @@ class OptionParser (OptionContainer):
         over after parsing options.
         """
         rargs = self._get_args(args)
+
         if values is None:
             values = self.get_default_values()
 
@@ -1434,7 +1438,7 @@ class OptionParser (OptionContainer):
                 del rargs[0]
             else:
                 return                  # stop now, leave this arg in rargs
-
+            
         # Say this is the original argument list:
         # [arg0, arg1, ..., arg(i-1), arg(i), arg(i+1), ..., arg(N-1)]
         #                            ^
index afed9d177caf262ade97ae3924eb088e16f756ad..16ee6e67bf767dda3f0eacce54dd5ba798864a61 100644 (file)
 
       (define __getitem__
         (lambda (self k)
-          (let ((r ((@ (guile) getenv) (slot-ref (pystring k) 'str))))
+          (let ((r ((@ (guile) getenv)
+                    (catch #t
+                      (lambda ()
+                        (pystring k))
+                      (lambda x
+                        (raise (ValueError "cant stringify k in env[x]")))))))
             (if r r (raise IndexError)))))
 
       (define __setitem__
-        (lambda (self k v) 
-          ((@ (guile) putenv) (slot-ref (pystring (+ k "=" v)) 'str))))
+        (lambda (self k v)
+          (call-with-values
+              (lambda ()
+                (catch #t
+                  (lambda ()
+                    (values (pystring k) (pystring v)))
+                  (lambda x
+                    (raise (ValueError "not stringable in environ")))))
+            (lambda (k v)
+              ((@ (guile) putenv) (pystring (+ k "=" v)))))))
 
       (define __delitem__
         (lambda (self k)
-          ((@ (guile) putenv) (slot-ref (pystring k) 'str))))
+          ((@ (guile) putenv) (pystring k))))
       
       (define __iter__
         (lambda (self)
index 9f8defe07c853c364b7ac976820789b6633a59fe..82c0cab448e3e9c3e0e4600a339266e3f2adb57a 100644 (file)
     [(_ iface _ li)
      (let ((l 'li))
        (module-for-each 
-        (lambda (name . l)        
+        (lambda (name . l)
           (if (not (member name l))
-              (module-re-export! (current-module) ((@ (guile) list) name))))
+              (module-re-export! (current-module)
+                                 ((@ (guile) list) (pk name)))))
         (resolve-interface 'iface)))]))
 
 (set! (@ (language python module os) path)
index ed521187f018afad3258e5b1a38450d9a1bc1859..fe0a4eaa4b96df04d12cc34f01fe126295689ae6 100644 (file)
@@ -2,6 +2,7 @@
   #:use-module (rnrs bytevectors)
   #:use-module (language python exceptions)
   #:use-module (language python hash)
+  #:use-module (language python module io)
   #:use-module (language python try)
   #:use-module (language python module python)
   #:use-module (oop pf-objects)
@@ -13,7 +14,7 @@
                    tarcebacklimit platform maxsize hash_info
                    base_prefix))
 
-(define-syntax stdin
+(define-syntax stdin_
   (lambda (x)
     (syntax-case x (set!)
       ((set! stdin port)
@@ -22,7 +23,7 @@
        (error "sys.stdin is not a function"))
       (s #'(current-input-port)))))
 
-(define-syntax stdout
+(define-syntax stdout_
   (lambda (x)
     (syntax-case x (set!)
       ((set! stdin port)
@@ -31,7 +32,7 @@
        (error "sys.stdin is not a function"))
       (s #'(current-output-port)))))
 
-(define-syntax stderr
+(define-syntax stderr_
   (lambda (x)
     (syntax-case x (set!)
       ((set! stdin port)
        (error "sys.stdin is not a function"))
       (s #'(current-error-port)))))
 
+(define stdin  (FileIO stdin_ ))
+(define stderr (FileIO stderr_))
+(define stdout (FileIO stdout_))
+
 (define __stdin__  stdin)
 (define __stdout__ stdout)
 (define __stderr__ stderr)