format strings added

6 files changed, 207 insertions, 83 deletions

diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm
index 8dc715a..d4b1011 100644
--- a/modules/language/python/compile.scm
+++ b/modules/language/python/compile.scm
@@ -46,6 +46,43 @@
 (define exit-prompt (make-prompt-tag))
 (define exit-fluid  (make-fluid #f))
 
+(define (formatter . x) "<missing>")
+
+(define (mk-string vs l)
+  (define (mk-string2 x)
+    (if (string? x)
+        x
+        (let ((l (let lp ((l x))
+                   (match l
+                     ((x . l)
+                      (cons
+                       (if (string? x)
+                           x
+                           (match x
+                             ((#:field tag a b)
+                              `(,(C 'formatter) ,(exp vs tag) ,a ,b))))
+                       (lp l)))
+                     (() '())))))
+          (match l
+            ((x) x)
+            ((x . l) (cons* '+ x l))))))
+                              
+  (let ((r
+         (let lp ((l l))
+           (match l
+             ((x . l)
+              (let ((x (mk-string2 x))
+                    (l (lp l)))
+                (if (and (string? x) (= (length l) 1) (string? (car l)))
+                    (list (+ x (car l)))
+                    (cons x l))))
+             (() (list ""))))))
+    (if (string? r)
+        r
+        (cons '+ r))))
+  
+             
+
 (define-syntax-rule (with-exit code ...)
   (with-fluids ((exit-fluid #t))
     (call-with-prompt exit-prompt
@@ -942,6 +979,19 @@
                    
     ...))
 
+(define *doc* (make-fluid #f))
+(define (get-doc)
+  (aif it (fluid-ref *doc*)
+       it
+       ""))
+(define set-doc
+  (case-lambda
+    (()  (fluid-set! *doc* #f))
+    ((x)
+     (if (not (fluid-ref *doc*))
+         (fluid-set! *doc* x)))))
+  
+
 (define (tr-comp op x y)
   (match op
     ((or "<" ">" "<=" ">=")
@@ -984,7 +1034,7 @@
  
  (#:string
   ((_ l)
-   (string-join l "")))
+   (mk-string vs l)))
 
  (#:bytes
   ((_ l)
@@ -1156,7 +1206,12 @@
                           (() #f)
                           (#f #f)
                           ((#:arglist . _)
-                           (get-addings vs (list parents) #f)))))
+                           (get-addings vs (list parents) #f))))
+               (cd.doc  (with-fluids ((*doc* #f))
+                          (let ((cd (wth (exp vs code))))
+                            (cons cd (get-doc)))))
+               (cd      (car cd.doc))
+               (doc     (cdr cd.doc)))
           `(set! ,class
              (,(C 'class-decor) ,decor
               (,(C 'with-class) ,class
@@ -1165,8 +1220,11 @@
                 ,(if parents
                      (arglist->pkw (clean parents))
                      `(,(G 'cons) (,(G 'quote) ()) (,(G 'quote) ())))
-                ,(map (lambda (x) `(define ,x ,(gw-persson x vo))) ls)
-                ,(wth (exp vs code)))))))))))
+                ,doc
+                ,(cons
+                  (list 'define '__doc__ doc)
+                  (map (lambda (x) `(define ,x ,(gw-persson x vo))) ls))
+                ,cd)))))))))
  (#:verb
   ((_ x) x))
  
@@ -1174,8 +1232,28 @@
   ((_ (#:string _ s)) (with-input-from-string s read)))
 
  (#:comma
+  ((_
+    (and x
+         (#:expr-stmt
+          ((#:test
+            (#:power #f (#:string l) () . #f)
+            #f))
+          (#:assign))))
+   (set-doc (mk-string vs l))
+   (exp vs x))
+  
   ((_ a)
    (exp vs a))
+
+  ((_ (and a
+           (#:expr-stmt
+            ((#:test
+              (#:power #f (#:string ll) () . #f)
+              #f))
+            (#:assign))) . l)
+   (set-doc (mk-string vs ll))
+   `(,(G 'begin) ,(exp vs a) ,(exp vs (cons #:comma l))))
+  
   ((_ a . l)
    `(,(G 'begin) ,(exp vs a) ,(exp vs (cons #:comma l)))))
   
@@ -1566,8 +1644,18 @@
           (ex  (gensym "ex"))
           (y   'scm.yield)
           (y.f (gen-yield f))
-          (ls  (diff (diff ns vs) df)))
-   
+          (ls  (diff (diff ns vs) df))
+          (cd.doc (with-fluids ((is-class? #f)
+                                (*doc*     #f)
+                                (return    r))
+                    (let ((cd (wth (exp ns code))))
+                      (cons cd (get-doc)))))
+          (cd     (car cd.doc))
+          (doc    (cdr cd.doc))
+          (docv   (gensym "fv"))
+          (docer  (lambda (x) `(,(G 'let) ((,docv ,x))
+                                (,(C 'set) ,docv (,(G 'quote) __doc__) ,doc)
+                                ,docv))))
      (define (mk code)
        `(let-syntax ((,y   (syntax-rules ()
                              ((_ . args)
@@ -1577,48 +1665,46 @@
                               (abort-to-prompt ,ab . args)))))
           ,code))
      
-     (with-fluids ((is-class? #f))
-       (if c?
-           (if y?
-               `(set! ,f
-                  (,(C 'def-decor) ,decor
-                   (,(C 'def-wrap) ,y? ,f ,ab
+     (if c?
+         (if y?
+             `(set! ,f
+                ,(docer
+                  `(,(C 'def-decor) ,decor
+                    (,(C 'def-wrap) ,y? ,f ,ab
+                     (,(D 'lam) ,aa
+                      (,(C 'with-return) ,r
+                       ,(mk `(,(G 'let) ,(map (lambda (x) (list x #f)) ls)
+                              (,(C 'with-self) ,c? ,aa
+                               ,cd)))))))))
+             
+             `(set! ,f
+                ,(docer
+                  `(,(C 'def-decor) ,decor
                     (,(D 'lam) ,aa
                      (,(C 'with-return) ,r
                       ,(mk `(,(G 'let) ,(map (lambda (x) (list x #f)) ls)
                              (,(C 'with-self) ,c? ,aa
-                              ,(with-fluids ((return r))
-                                 (wth (exp ns code)))))))))))
-               
-               `(set! ,f
-                  (,(C 'def-decor) ,decor
-                   (,(D 'lam) ,aa
-                    (,(C 'with-return) ,r
-                     ,(mk `(,(G 'let) ,(map (lambda (x) (list x #f)) ls)
-                            (,(C 'with-self) ,c? ,aa
-                             ,(with-fluids ((return r))
-                                (wth (exp ns code)))))))))))
+                              ,cd)))))))))
             
-           (if y?
-               `(set! ,f
-                  (,(C 'def-decor) ,decor
-                   (,(C 'def-wrap) ,y? ,f ,ab
-                    (,(D 'lam) ,aa
-                     (,(C 'with-return) ,r 
-                      (,(G 'let) ,(map (lambda (x) (list x #f)) ls)
-                       (,(C 'with-self) ,c? ,aa
-                        ,(with-fluids ((return r))
-                           (mk
-                            (wth (exp ns code)))))))))))
-               `(set! ,f
-                  (,(C 'def-decor) ,decor
-                   (,(D 'lam) ,aa
-                    (,(C 'with-return) ,r 
-                     (,(G 'let) ,(map (lambda (x) (list x #f)) ls)
-                      (,(C 'with-self) ,c? ,aa
-                       ,(with-fluids ((return r))
-                          (wth (exp ns code)))))))))))))))
- 
+         (if y?
+             `(set! ,f
+                ,(docer
+                  `(,(C 'def-decor) ,decor
+                    (,(C 'def-wrap) ,y? ,f ,ab
+                     (,(D 'lam) ,aa
+                      (,(C 'with-return) ,r 
+                       (,(G 'let) ,(map (lambda (x) (list x #f)) ls)
+                        (,(C 'with-self) ,c? ,aa
+                         ,(mk cd)))))))))
+             `(set! ,f
+                  ,(docer
+                    `(,(C 'def-decor) ,decor
+                      (,(D 'lam) ,aa
+                       (,(C 'with-return) ,r 
+                        (,(G 'let) ,(map (lambda (x) (list x #f)) ls)
+                         (,(C 'with-self) ,c? ,aa
+                          ,(mk cd)))))))))))))
+
  (#:global
   ((_ . _)
    `(,cvalues)))
@@ -1946,14 +2032,20 @@
 	    (set! x (cdr x)))
 
 	(let* ((globs (get-globals x))
-	       (e     (map (g globs exp) x)))
+	       (e.doc (with-fluids ((*doc* #f))
+                        (let ((r (map (g globs exp) x)))
+                          (cons r (get-doc)))))
+               (e     (car e.doc))
+               (doc   (cdr e.doc)))
+          
 	  `(begin
+             (,(G 'set!) __doc__ ,doc)
 	     ,@start
 	     (,(G 'define) ,fnm (,(G 'make-hash-table)))
 	     ,@(map (lambda (s)
 		      (if (member s (fluid-ref ignore))
 			  `(,cvalues)
-			  `(,(C 'var) ,s))) globs)
+			  `(,(C 'var) ,(cons '__doc__ s)))) globs)
 	     ,@e
 	     (,(C 'export-all)))))
 
diff --git a/modules/language/python/exceptions.scm b/modules/language/python/exceptions.scm
index 5b58f9e..0a3689f 100644
--- a/modules/language/python/exceptions.scm
+++ b/modules/language/python/exceptions.scm
@@ -13,7 +13,7 @@
 			  ZeroDivisionError ArithmeticError
 			  OverflowError RecursionError
 			  Warning DeprecationWarning BytesWarning
-                          ResourceWarning
+                          ResourceWarning UserWarning
                           UnicodeDecodeError LookupError IndentationError
                           KeyboardInterrupt MemoryError NameError
                           EOFError UnicodeError UnicodeEncodeError
@@ -127,3 +127,4 @@
 (define-wr BytesWarning       'BytesWarning)
 (define-wr DepricationWarning 'DeprecationWarning)
 (define-wr ResourceWarning    'ResourceWarning)
+(define-wr UserWarning        'UserWarning)
diff --git a/modules/language/python/module/binascii.scm b/modules/language/python/module/binascii.scm
index 2fc0e62..12bdcac 100644
--- a/modules/language/python/module/binascii.scm
+++ b/modules/language/python/module/binascii.scm
@@ -386,7 +386,7 @@
 		(lp (+ i 2) (cons x r)))
 	      (bytes (reverse r)))))))
 
-(define (id x) x)
+(define-inlinable (id x) x)
 (define-syntax-rule (mkcrc crc_hqx high xor mask)
   (def (crc_hqx data (= value 0))
        (let ((n (len data))
diff --git a/modules/language/python/module/string.scm b/modules/language/python/module/string.scm
index c99344c..9c0d818 100644
--- a/modules/language/python/module/string.scm
+++ b/modules/language/python/module/string.scm
@@ -9,7 +9,9 @@
   #:use-module (language python for)
   #:use-module (language python def)
   #:use-module (language python string)
-  #:use-module (parser stis-parser)
+  #:use-module (language python bytes)
+  #:use-module ((parser stis-parser) #:select (*whitespace* f-n f-m))
+  #:use-module (parser stis-parser lang python3 tool)
   #:export (Formatter ascii_letters digits hexdigits))
 
 (define digits        "0123456789")
@@ -239,17 +241,27 @@
   (f-cons argName (ff* (f-or! (f-list #:attr "." attributeName)
                               (f-list #:elem "[" elementIndex "]")))))
 
-(define replField
+(define (replField fieldName1)
   (f-list
    #:field
-   (ff?            (mk-token (f-scope fieldName ))  None)
+   (ff?                      fieldName1             None)
    (ff? (f-seq "!" (mk-token (f-scope conversion))) None)
    (ff? (f-seq ":" (mk-token (f-scope formatSpec))) None)))
  
-(define tag     (f-seq (f-tag "{") replField (f-tag "}")))
+(define (tag fieldName1)
+  (f-seq (f-tag "{") (replField fieldName1) (f-tag "}")))
+
 (define nontag  (f-list #:str
-                        (mk-token (f+ (f-or! (f-tag! "{{") (f-not! tag))))))
-(define e       (f-seq (ff* (f-or! tag nontag)) f-eof))
+                        (mk-token (f+
+                                   (f-or!
+                                    (f-tag! "{{")
+                                    (f-not! (tag (mk-token
+                                                  (f-scope
+                                                   fieldName)))))))))
+
+(define e       (f-seq (ff* (f-or! (tag fieldName)  nontag)) f-eof))
+
+(set! (@@ (parser stis-parser lang python3-parser) f-formatter) tag)
 
 (define mk-gen
   (make-generator (l)
@@ -293,24 +305,40 @@
     (lam (self format_string (* args) (** kwargs))
          ((ref self 'vformat) format_string args kwargs)))
 
+  (define vformat2
+    (lambda (self fn2 co fo)
+      (if (and (eq? fo None) (eq? co None))
+          ((ref self 'convert_field)  fn2 "r")
+          (let ((fn3 (if (eq? co None)
+                         fn2
+                         ((ref self 'convert_field)
+                          fn2 co))))
+            (if (eq? fo None)
+                fn3
+                ((ref self 'format_field ) fn3 fo))))))
+  
+  (define vformat1
+    (lambda (self s fn fo co ss args kwargs)
+      (if (eq? fn None)
+          (cons s ss)
+          (let* ((fn2 ((ref self 'get_field    ) fn args kwargs))
+                 (fn3 (if (and (eq? fo None) (eq? co None))
+                          ((ref self 'convert_field)  fn2 "r")
+                          (let ((fn3 (if (eq? co None)
+                                         fn2
+                                         ((ref self 'convert_field)
+                                          fn2 co))))
+                            (if (eq? fo None)
+                                fn3
+                                ((ref self 'format_field )
+                                 fn3 fo))))))
+            (cons* fn3 s ss)))))
+      
   (define vformat
     (lambda (self format_string args kwargs)
       (set self '_args '())
       (for ((s fn fo co : ((ref self 'parse) format_string))) ((ss '("")))
-           (if (eq? fn None)
-               (cons s ss)
-               (let* ((fn2 ((ref self 'get_field    ) fn args kwargs))
-                      (fn3 (if (and (eq? fo None) (eq? co None))
-                               ((ref self 'convert_field)  fn2 "r")
-                               (let ((fn3 (if (eq? co None)
-                                              fn2
-                                              ((ref self 'convert_field)
-                                               fn2 co))))
-                                 (if (eq? fo None)
-                                     fn3
-                                     ((ref self 'format_field )
-                                      fn3 fo))))))
-                 (cons* fn3 s ss)))
+           (vformat self s fn fo co ss args kwargs)
            #:final
            (begin
              ((ref self 'check_unused_args) (ref self '_args) args kwargs)
@@ -376,4 +404,6 @@
 
 (define (ascii x) (bytes x))
 
-(set! (@@ (language python string) formatter) (Formatter))
+(define formatter (Formatter))
+(set! (@@ (language python string)  formatter) formatter)
+(set! (@@ (language python compile) formatter) (ref formatter 'vformat2))
diff --git a/modules/language/python/module/urllib/request.py b/modules/language/python/module/urllib/request.py
index ff79318..d5372e5 100644
--- a/modules/language/python/module/urllib/request.py
+++ b/modules/language/python/module/urllib/request.py
@@ -82,7 +82,7 @@ f = urllib.request.urlopen('http://www.python.org/')
 # Possible extensions:
 # complex proxies  XXX not sure what exactly was meant by this
 # abstract factory for opener
-
+pk(1)
 import base64
 import bisect
 import email
@@ -100,7 +100,7 @@ import collections
 import tempfile
 import contextlib
 import warnings
-
+pk(2)
 
 from urllib.error import URLError, HTTPError, ContentTooShortError
 from urllib.parse import (
@@ -109,7 +109,7 @@ from urllib.parse import (
     splitattr, splitquery, splitvalue, splittag, to_bytes,
     unquote_to_bytes, urlunparse)
 from urllib.response import addinfourl, addclosehook
-
+pk(3)
 # check for SSL
 try:
     import ssl
diff --git a/modules/language/python/module/urllib/robotparser.py b/modules/language/python/module/urllib/robotparser.py
index f110d80..cde8b47 100644
--- a/modules/language/python/module/urllib/robotparser.py
+++ b/modules/language/python/module/urllib/robotparser.py
@@ -1,4 +1,4 @@
-module(urllib.robotparser)
+module(urllib,robotparser)
 
 """ robotparser.py
 
@@ -13,8 +13,9 @@ module(urllib.robotparser)
 """
 
 import collections
-import urllib.parse
-import urllib.request
+import urllib.parse as uparse
+import urllib.error as error
+import urllib.request as request
 
 __all__ = ["RobotFileParser"]
 
@@ -55,13 +56,13 @@ class RobotFileParser:
     def set_url(self, url):
         """Sets the URL referring to a robots.txt file."""
         self.url = url
-        self.host, self.path = urllib.parse.urlparse(url)[1:3]
+        self.host, self.path = uparse.urlparse(url)[1:3]
 
     def read(self):
         """Reads the robots.txt URL and feeds it to the parser."""
         try:
-            f = urllib.request.urlopen(self.url)
-        except urllib.error.HTTPError as err:
+            f = request.urlopen(self.url)
+        except error.HTTPError as err:
             if err.code in (401, 403):
                 self.disallow_all = True
             elif err.code >= 400 and err.code < 500:
@@ -112,7 +113,7 @@ class RobotFileParser:
             line = line.split(':', 1)
             if len(line) == 2:
                 line[0] = line[0].strip().lower()
-                line[1] = urllib.parse.unquote(line[1].strip())
+                line[1] = uparse.unquote(line[1].strip())
                 if line[0] == "user-agent":
                     if state == 2:
                         self._add_entry(entry)
@@ -160,10 +161,10 @@ class RobotFileParser:
             return False
         # search for given user agent matches
         # the first match counts
-        parsed_url = urllib.parse.urlparse(urllib.parse.unquote(url))
-        url = urllib.parse.urlunparse(('','',parsed_url.path,
+        parsed_url = uparse.urlparse(uparse.unquote(url))
+        url = uparse.urlunparse(('','',parsed_url.path,
             parsed_url.params,parsed_url.query, parsed_url.fragment))
-        url = urllib.parse.quote(url)
+        url = uparse.quote(url)
         if not url:
             url = "/"
         for entry in self.entries:
@@ -202,8 +203,8 @@ class RuleLine:
         if path == '' and not allowance:
             # an empty value means allow all
             allowance = True
-        path = urllib.parse.urlunparse(urllib.parse.urlparse(path))
-        self.path = urllib.parse.quote(path)
+        path = uparse.urlunparse(uparse.urlparse(path))
+        self.path = uparse.quote(path)
         self.allowance = allowance
 
     def applies_to(self, filename):