textwrap compiles
authorStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sun, 12 Aug 2018 19:52:45 +0000 (21:52 +0200)
committerStefan Israelsson Tampe <stefan.itampe@gmail.com>
Sun, 12 Aug 2018 19:52:45 +0000 (21:52 +0200)
modules/language/python/compile.scm
modules/language/python/format2.scm
modules/language/python/module/re.scm
modules/language/python/module/re/compile.scm
modules/language/python/module/re/parser.scm
modules/language/python/module/struct.scm
modules/language/python/module/textwrap.py [new file with mode: 0644]
modules/language/python/string.scm

index c3e714231d79949fd07c04b00aa7882568d54105..577d7943e35d717e4185df785eff5ebeab0d14fc 100644 (file)
       vs))
 
     ((#:for es in code . final)
-     (let ((vs (let lp ((es es))
-                 (match es
-                   (((#:power #f (#:tuple . l) . _))
-                    (lp l))
-                   (_ (union vs (map (g vs exp) es)))))))
+     (let ((vs (union
+                vs
+                (let lp ((es es))
+                  (match es
+                   (((#:sub . l) . u)
+                    (union (lp l) (lp u))) 
+                   (((#:power #f (#:tuple . l) . _) . u)
+                    (union (lp l) (lp u)))
+                   (((and (#:power . _) x) . u)
+                    (union (list (exp vs x)) (lp u)))
+                   ((e . es)
+                    (union (lp e) (lp es)))
+                   (() '()))))))
        (scope final (scope code vs))))
 
      
 
  (#:del
   ;;We don't delete variables
-  ((_  (#:power #f base () . #f))
-   '(void))
+  ((_  . l)
+   `(begin 
+      ,@(let lp ((l l))
+          (match l
+            (((#:power #f base () . #f) . l)
+             (cons `(set! ,(exp vs base) #f)
+                   (lp l)))
+   
   
-  ((_  (#:power #f base (l ... fin) . #f))
-   (let* ((f     (exp vs base))
-          (fast? (not (eq? f 'super)))
-          (add   (get-addings vs l fast?))
-          (fin   (get-addings vs (list fin) fast?)))
-         
-     `(,(C 'del-x) (,(C 'ref-x) ,f ,@add) ,@fin))))
+            (((#:power #f base (l ... fin) . #f) . ll)
+             (let* ((f     (exp vs base))
+                    (fast? (not (eq? f 'super)))
+                    (add   (get-addings vs l fast?))
+                    (fin   (get-addings vs (list fin) fast?)))
+               (cons
+                `(,(C 'del-x) (,(C 'ref-x) ,f ,@add) ,@fin)
+                (lp ll))))
+            (() '()))))))
 
  (#:with
   ((_ (l ...) code)
                (else2 (if else (exp vs2 else) #f))
                (in2   (map (g vs exp) in)))
           (list (C 'cfor) es2 in2 code2 else2 p)))))))
+
+ (#:sub
+  ((_ l)
+   (map (g vs exp) l)))
 
  (#:while
   ((_ test code . #f)
                  ,(exp vs code)
                  (,lp))))))
 
-  ((_ test code else)
+  ((_ test code else)
    (let ((lp (gensym "lp")))
      `(let ,lp ()
            (if test
              ,@start
              ,(C 'clear-warning-data)
              (fluid-set! (@@ (system base message) %dont-warn-list) '())
-            (define ,(C 'fnm) (make-hash-table))
+            (define ,fnm (make-hash-table))
              ,@(map (lambda (s) `(,(C 'var) ,s)) globs)
              ,@(map (g globs exp) x)
              (,(C 'export-all)))))
 
 (define (gentemp stx) (datum->syntax stx (gensym "x")))
 
+(define-syntax mmatch
+  (syntax-rules ()
+    ((_ (a . aa) (b . bb) . code)
+     (match a (b (mmatch aa bb . code))))
+    ((_ () () . code)
+     (begin . code))))
+
 (define-syntax clambda
   (lambda (x)
     (syntax-case x ()
       ((_ (x ...) code ...)
-       (with-syntax ((n (length #'(x ...))))
-         #'(let ((f (lambda (x ... . u) code ...)))
+       (with-syntax ((n (length #'(x ...)))
+                     ((y ...) (generate-temporaries #'(x ...))))
+         #'(let ((f (lambda (y ... . u)
+                      (mmatch (y ...) (x ...) code ...))))
              (if (> n 1)                
                  (case-lambda
                    ((c)
                  f)))))))
 
 (define-syntax cfor
-  (syntax-rules ()
-    ((_ (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)))
-                            code)
-                   (lp (cdr l))))))
-         (for/adv1 (x) (a) code #f #f)))
+  (lambda (x)
+    (syntax-case x ()
+      ((_ (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)))
+                                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)
-                 (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)))
+     #'(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)))))
+           (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)))
+     #'(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)))
+     #'(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))))
+     #'(for/adv1 x a code next p)))))
 
 (define-syntax for/adv1
   (lambda (x)
             ((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)
        (with-syntax ((inv (gentemp #'in)))
-         (with-syntax (((xx ...) (generate-temporaries #'(x ...))))
+         (with-syntax (((xx ...) (gen-temp #'(x ...))))
            (if (syntax->datum #'p)
-               #'(let ((inv (wrap-in in)))               
+               #'(let ((inv (wrap-in in)))
+                   (clet (x ...)
+                     (let/ec break-ret
+                       (catch StopIteration
+                         (lambda ()
+                           (let lp ()
+                             (call-with-values (lambda () (next inv))
+                               (clambda (xx ...)
+                                 (cset! x xx) ...
+                                 (let/ec continue-ret
+                                   (with-sp ((break     (break-ret))
+                                             (continue  (continue-ret)))
+                                            code))
+                                 (lp)))))
+                         (lambda q else)))))
+             
+                   #'(let ((inv (wrap-in in)))
+                       (clet (x ...)
+                             (let/ec break-ret
+                               (catch StopIteration
+                                 (lambda ()
+                                   (let lp ()
+                                     (call-with-values (lambda () (next inv))
+                                       (clambda (xx ...)
+                                                (cset! x xx) ...
+                                         (with-sp ((break     (break-ret))
+                                                   (continue  (values)))
+                                                  code)
+                                         (lp)))))
+                                 (lambda e else)))))))))
+      
+      ((_ (x ...) (in ...) code else p)
+       (with-syntax (((inv ...) (generate-temporaries #'(in ...))))
+       (with-syntax ((get       (gen #'(inv ...) #'(x ...)))
+                     ((xx ...)  (gen-temp #'(x ...))))
+         (if (syntax->datum #'p)
+             #'(clet (x ...)
+                 (let ((inv (wrap-in in)) ...)               
                    (let/ec break-ret
                      (catch StopIteration
                        (lambda ()
                          (let lp ()
-                           (call-with-values (lambda () (next inv))
+                           (call-with-values (lambda () get)
                              (clambda (xx ...)
-                               (set! x xx) ...
+                               (cset! x xx) ...
                                (let/ec continue-ret
                                  (with-sp ((break     (break-ret))
                                            (continue  (continue-ret)))
                                           code))
                                (lp)))))
-                       (lambda q else))))
-             
-               #'(let ((inv (wrap-in in)))
-                   (let/ec break-ret
-                     (catch StopIteration
-                       (lambda ()
-                         (let lp ()
-                           (call-with-values (lambda () (next inv))
-                             (clambda (xx ...)
-                               (set! x xx) ...
-                               (with-sp ((break     (break-ret))
-                                         (continue  (values)))
-                                        code)
-                               (lp)))))
-                       (lambda e else))))))))
-      
-      ((_ (x ...) (in ...) code else p)
-       (with-syntax (((inv ...) (generate-temporaries #'(in ...))))
-       (with-syntax ((get      (gen #'(inv ...) #'(x ...)))
-                     ((xx ...) (generate-temporaries #'(x ...))))
-         (if (syntax->datum #'p)
-             #'(let ((inv (wrap-in in)) ...)               
-                 (let/ec break-ret
-                   (catch StopIteration
-                     (lambda ()
-                       (let lp ()
-                         (call-with-values (lambda () get)
-                           (clambda (xx ...)
-                             (set! x xx) ...
-                             (let/ec continue-ret
-                               (with-sp ((break     (break-ret))
-                                         (continue  (continue-ret)))
-                                        code))
-                             (lp)))))
-                     (lambda q else))))
+                       (lambda q else)))))
              
-             #'(let ((inv (wrap-in in)) ...)
-                 (let/ec break-ret
-                   (catch StopIteration
-                     (lambda ()
-                       (let lp ()
-                         (call-with-values (lambda () get)
-                           (clambda (xx ...)
-                             (set! x xx) ...
-                             (with-sp ((break     (break-ret))
-                                       (continue  (values)))
-                                      code)
-                             (lp)))))
-                     (lambda e else)))))))))))
+                 #'(clet (x ...)
+                     (let ((inv (wrap-in in)) ...)
+                       (let/ec break-ret
+                         (catch StopIteration
+                           (lambda ()
+                             (let lp ()
+                               (call-with-values (lambda () get)
+                                 (clambda (xx ...)
+                                   (cset! x xx) ...
+                                   (with-sp ((break     (break-ret))
+                                             (continue  (values)))
+                                            code)
+                                   (lp)))))
+                           (lambda e else))))))))))))
+
+(define-syntax cset!
+  (syntax-rules ()
+    ((_ (a . aa) (b . bb))
+     (begin
+       (cset! a  b)
+       (cset! aa bb)))
+    ((_ () ())
+     (values))
+    ((_ a b)
+     (set! a b))))
 
+(define-syntax clet
+  (syntax-rules ()
+    ((_ ((a . l) . u) . code)
+     (clet (a l . u) . code))
+    ((_ (() . u) . code)
+     (clet u . code))    
+    ((_ (a . u) . code)
+     (let ((a #f))
+       (clet u . code)))
+    ((_ () . code)
+     (begin . code))))
+    
 (define-syntax def-wrap
   (lambda (x)
     (syntax-case x ()
index f8c4c69e4adf26def3238b58810fae540987390c..70ee21260b2fb4b40fcd44cd91888f4233f884cf 100644 (file)
@@ -6,6 +6,7 @@
   #:use-module ((language python module re)     #:select (splitm splitmm))
   #:use-module (language python exceptions)
   #:use-module (language python number)
+  #:use-module (language python dict)
   #:export (format fnm))
 
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
         (""
          (let ((kind (get-intkind tp)))                             
            (if min
-               (let ((pat (string-append "~" (number->string min) ",' " kind)))
+               (let ((pat (string-append "~"
+                                          (number->string min) ",' " kind)))
                  (lambda (x)
                    (scm-format #f pat x)))
                (let ((pat (string-append "~" kind)))
                                        (member #\0 c))
                                    "-"
                                    ""))
-                      (d       (string-append pre kpre "~"
-                                              (number->string
-                                               (-  min
-                                                   (if (= (string-length kpre) 0) 0 2)
-                                                   (if (= (string-length pre ) 0) 0 1)))
-                                              ",'"
-                                              padchar
-                                              kind)))
+                      (d       (string-append
+                                 pre kpre "~"
+                                 (number->string
+                                  (-  min
+                                      (if (= (string-length kpre) 0) 0 2)
+                                      (if (= (string-length pre ) 0) 0 1)))
+                                 ",'"
+                                 padchar
+                                 kind)))
                  (if (= (string-length pre) 0)
                      (lambda (x)
                        (if (and (number? x) (integer? x))
                            (scm-format #f d x)
-                           (raise (ValueError "not a integer, format spec %d"))))
+                           (raise
+                             (ValueError "not a integer, format spec %d"))))
                      (lambda (x)
                        (if (and (number? x) (integer? x))
                            (scm-format #f d (if (< x 0) neg pos) (abs x))
-                           (raise (ValueError "not a integer, format spec %d")))))))
+                           (raise
+                             (ValueError
+                              "not a integer, format spec %d")))))))
              (let* ((kind (get-intkind tp))
                     (pat  (string-append "~" kind)))
                (lambda (x)
                  (if (and (number? x) (integer? x))
                      (scm-format #f pat x)
-                     (raise (ValueError "not a integer, format spec %d"))))))))))))
+                     (raise
+                       (ValueError "not a integer, format spec %d"))))))))))))
       
  
 (define (analyze p)
            (()
             (lambda (x)
               '()))))
+        
        (let lp ((l l))
          (match l
            ((a p . l)
                    (cons* a (f (car x) (cadr x)) (rest (cddr x)))))
                 ((2)
                  (lambda (x)
-                   (cons* a (f (car x) (cadr x) (caddr x)) (rest (cdddr x))))))))          
+                   (cons* a (f (car x) (cadr x) (caddr x))
+                           (rest (cdddr x))))))))          
            ((a)
             (lambda (x)
               (list a)))
             (lambda (x)
               '())))))))
 
+(define (id? x)
+  (or (pair? x)
+      (hash-table? x)
+      (is-a? x <py-hashtable>)))
+
 (define (format-- s l ha)
+  (set! l (if (id? l) l (list l)))
   (aif it (hashq-ref ha s #f)
        (string-join (it l) "")
        (begin
         (format-- s l ha))))
   
 (define (format- str l)
-  (string-join ((compile str) l) ""))
+  (string-join ((compile str) (if (id? l) l (list l))) ""))
 
 (define formatters (make-hash-table))
 
index f16b697761fcc8a7d5210c11663217c21bdcf5c1..3b8f8af77bb5e694c0f84ef6b00e1b93d0b4aa29 100644 (file)
 
 (define escape
   (let ((m (string->list "()[]#$*+-.^|\\")))
+    (set! m (cons #\newline m))
     (lambda (x)
       (let lp ((l (string->list x)) (r '()))
        (ice-match l
          ((x . l)
           (lp l
               (if (member x m)
-                  (cons* #\\ x r)
+                   (if (eq? x #\newline)
+                       (cons* #\n #\\  r)
+                       (cons* x   #\\  r))
                   (cons x r))))
          (()
           (list->string (reverse r))))))))
index 3d7bdb10a95c001fec9d0dac1b574c32a5ea7641..93d7c3817aae76e4babc1f01e4fd51d883ddc53b 100644 (file)
     (#:dot #:dot)
     ((#:op  x #:* ) (list #:op  (reverse-form x) #:*)) 
     ((#:op  x #:+ ) (list #:op  (reverse-form x) #:+)) 
-    ((#:op  x (#:rep  m n)) (list #:op  (reverse-form x) (#:rep  m n)))
-    ((#:op  x (#:rep  m  )) (list #:op  (reverse-form x) (#:rep  m)))
-    ((#:op  x (#:rep? m n)) (list #:op  (reverse-form x) (#:rep?  m n)))
-    ((#:op  x (#:rep? m  )) (list #:op  (reverse-form x) (#:rep?  m)))
+    ((#:op  x (#:rep  m n)) (list #:op  (reverse-form x) (list #:rep  m n)))
+    ((#:op  x (#:rep  m  )) (list #:op  (reverse-form x) (list #:rep  m)))
+    ((#:op  x (#:rep? m n)) (list #:op  (reverse-form x) (list #:rep?  m n)))
+    ((#:op  x (#:rep? m  )) (list #:op  (reverse-form x) (list #:rep?  m)))
     ((#:op  x #:? ) (list #:op  (reverse-form x) #:?)) 
     ((#:op  x #:*?) (list #:op  (reverse-form x) #:*?)) 
     ((#:op  x #:+?) (list #:op  (reverse-form x) #:+?)) 
index 9ecc75644ab33b5ff9eef5d55219128d5c14a7a1..4d603c698b4a21466f5c4a36fecdda8c9ef565ef 100644 (file)
 (define flags2  (f-list #:flags2 "(?"
                         (mk-token (f* (f-reg! "[aiLmsux]")))
                         ")"))
-                         
+(define (bch f) (f-or! (f-seq (f-or! (f-tag "\\n") f-nl)      
+                              (f-out (list->string (list #\newline))))
+                       f))
 (define bbody (f-cons (f-or!
-                      (f-list #:range (mk-token (f-reg! "."))
-                              "-" (mk-token (f-reg! ".")))
-                      (f-list #:ch    (mk-token (f-reg! "."))))
+                      (f-list #:range (bch (mk-token (f-reg! ".")))
+                              "-" (bch (mk-token (f-reg! "."))))
+                      (f-list #:ch    (bch (mk-token (f-reg! ".")))))
                      (ff*
                       (f-or!
-                       (f-list #:range (mk-token (f-not! (f-tag "]")))
+                       (f-list #:range (bch (mk-token (f-not! (f-tag "]"))))
                                "-"
-                               (mk-token (f-not! (f-tag "]"))))                         
-                       (f-list #:ch    (mk-token (f-not! (f-tag "]"))))))))
+                               (bch (mk-token (f-not! (f-tag "]")))))
+                        (f-seq (f-tag " ") (f-out (list #:ch " ")))
+                       (f-list #:ch (bch (mk-token (f-not! (f-tag "]")))))))))
 
 (define (f-if a b c) (f-or! (f-seq a b) c))
 (define choice
index 5f5e8727796c1d3e4aabdfd93d7b686fe5b73cf9..b3d5b9f473c947325e0794095600153b61900123 100644 (file)
@@ -1,19 +1,31 @@
 (define-module (language python module struct)
   #:use-module (oop pf-objects)
+  #:use-module (ice-9 match)
+  #:use-module (rnrs bytevectors)
+  #:use-module (parser stis-parser)
   #:use-module (language python list)
+  #:use-module (language python bool)
   #:use-module (language python yield)
+  #:use-module (language python def)
+  #:use-module (language python exceptions)
   #:export (calcsize pack pack_into unpack unpack_from
                      iter_unpack Struct error))
 
-(define-python-class StructError (Error))
+(define-python-class StructError (Exception))
+
+(define bytevector-f32-ref  bytevector-ieee-single-ref)
+(define bytevector-f32-set! bytevector-ieee-single-set!)
+(define bytevector-f64-ref  bytevector-ieee-double-ref)
+(define bytevector-f64-set! bytevector-ieee-double-set!)
+
 (define error StructError)
 
 (define (analyze s)
   ;; Parser
-  (define f-head (make-token (f-or! (f-reg! "[@=<>!]") (f-out "@"))))
-  (define f-1    (make-token (f-reg! "[xcbB?hHiIlLqQnNefdspP]")))
-  (define f-item (f-or! (f-list (make-token (f+ (f-tag! "[0-9]"))
-                                            string->number)
+  (define f-head (f-or! (mk-token (f-reg! "[@=<>!]")) (f-out "@")))
+  (define f-1    (mk-token (f-reg! "[xcbB?hHiIlLqQnNefdspP]")))
+  (define f-item (f-or! (f-list (mk-token (f+ (f-reg! "[0-9]"))
+                                          string->number)
                                 f-1)
                         (f-list (f-out 1) f-1)))
   (define f-e    (f-cons f-head (ff* f-item)))
   (define (incr i n)
     (+ i (if pack
              n
-             (+ n (let ((x (modulo n 8)))
+             (+ n (let ((x (modulo n 4)))
                     (if (= x 0)
                         0
-                        (- 8 x)))))))
+                        (- 4 x)))))))
   
   (define c-x
     (lambda (k)
         (cons (bytevector-u64-ref bv i end)
               (k bv (incr i 8))))))
 
-  (define c-i c-i8)
-  (define c-I c-I8)
+  (define c-i c-i4)
+  (define c-I c-I4)
   
   (define c-l (if standard c-i4 c-l8))
   (define c-L (if standard c-I4 c-L8)) 
         (cons (bytevector-f64-ref bv i end)
               (k bv (incr i 8))))))
 
-  (define c-g
+  (define c-e
     (lambda (k)
       (lambda (bv i)
         (let* ((num   (bytevector-u16-ref bv i end))
                (mant  (logand #x3ff num)))
           (cons (cond
                  ((= exp 0)
-                  (* (if (= sign 0) 0 -1)
+                  (* (if (= sign 0) 1 -1)
                      (expt 2 -14)
                      (string->number (format #f "0.~a" mant))))
                  ((= exp #x1f)
                       (inf)
                       (- (inf))))
                  (else
-                  (* (if (= sign 0) 0 -1)
+                  (* (if (= sign 0) 1 -1)
                      (expt 2 (- exp 15))
-                     (string->number (format #f "1.~a" mant)))))
+                     (+ 1
+                        (cond
+                         ((< mant 10)
+                          (/ mant 1000.0))
+                         ((< mant 100)
+                          (/ mant 100.0))
+                         (else
+                          (/ mant 10.0)))))))                 
                 (k bv (incr i 2)))))))
                   
                   
           (let lp ((j 0) (l i))
             (if (and (< j size) (< j N))
                 (begin
-                  (bytevector-u8-set! bvv j (bytevector-u8-ref bv l) r)
+                  (bytevector-u8-set! bvv j (bytevector-u8-ref bv l))
                   (lp (+ j 1) (+ l 1)))
                 (cons bvv (k bv (incr i N)))))))))
 
                      l
                      (cons (list (- n 1) tp) l))))
                bv i)))
-         (() (lambda (bv i) '())))))
+         (() '()))))
    bv n))
               
 (define (unpack format buffer)  
        (unpacker (analyze format) buffer offset)))
 
 (define (iter_unpack format buffer)
-  (let ((l (analyze format))
-        (n (len buffer))
-        (m (calcsize l)))
+  (let* ((l format)
+         (n (len buffer))
+         (m (calcsize l)))
     ((make-generator
       (lambda (yield)
         (let lp ((i 0))
                 (lp (+ i m))))))))))
               
 (define (calcsize format)
-  (define type (car format))
-  (define rest     (cdr l))
-  (define pack     (member type '("@")))
-  (define end      (if (member type '("@"))
-                       (native-endianness)
-                       (if (member type '("<"))
-                           'little
-                           'big)))
-  (define standard (not (member type '("@"))))
-
-  (define (sz p i)
-    (if p
-        i
-        (let ((x (modulo i 8)))
-          (if (= x 0) i (+ i (- 8 x))))))
-  
-  (define (size n p tp)
-    (sz p
-     (match tp
-       ((or "x" "c" "B" "b" "?")
-        1)
-       ((or "h" "H" "g")
-        2)
-       ((or "i" "I" "f")
-        4)
-       ((or "q" "Q" "n" "N" "d" "P")
-        8)
-       ((or "l" "L")
-        (if standard 4 8))
-       ((or "s" "p")
-        n))))
-           
-  (if (string? format)
-      (calcsize (analyze format))
-      (let ((type (car format)))
-        (let lp ((l (cdr format)))
-          (match l
-            (((1  tp) . l)
-             (+ (size 1 (null? l) tp)))
-            (((n  (or "s" "p")) . l)
-             (+ (size n (null? l) tp)
-                (lp l)))
-            (((n  tp) . l)
-             (+ (size (- n 1) #f tp)
-                (lp (cons (list 1 tp) l))))
-            (() 0))))))
-                   
+  (let lp ((format format))
+    (if (string? format)
+        (lp (analyze format))
+        (let ()
+          (define type (car format))
+          (define rest (cdr format))
+          (define pack (member type '("@")))
+          (define end  (if (member type '("@"))
+                           (native-endianness)
+                           (if (member type '("<"))
+                               'little
+                               'big)))
+          (define standard (not (member type '("@"))))
+                              
+          (define (sz p i)
+            (if p
+                i
+                (let ((x (modulo i 4)))
+                  (if (= x 0) i (+ i (- 4 x))))))
+      
+          (define (size n p tp)
+            (sz p
+                (match tp
+                  ((or "x" "c" "B" "b" "?")
+                   1)
+                  ((or "h" "H" "e")
+                   2)
+                  ((or "i" "I" "f")
+                   4)
+                  ((or "q" "Q" "n" "N" "d" "P")
+                   8)
+                  ((or "l" "L")
+                   (if standard 4 8))
+                  ((or "s" "p")
+                   n))))
+      
+          (let lp ((l (cdr format)))
+            (match l
+              (((1  tp) . l)
+               (+ (size 1 (null? l) tp)))
+              (((n  (and tp (or "s" "p"))) . l)
+               (+ (size n (null? l) tp)
+                  (lp l)))
+              (((n  tp) . l)
+               (+ (size (- n 1) #f tp)
+                  (lp (cons (list 1 tp) l))))
+              (() 0)))))))
+    
 (define (pack_into_ format bv offset l)
-  (let lp ((l format))
-    (if (string? l)
-        (lp (analyze l))
+  (let lp ((format format))
+    (if (string? format)
+        (lp (analyze format))
         (let ()
-          (define type (car l))
-          (define rest (cdr l))
+          (define type (car format))
+          (define rest (cdr format))
           (define pack (member type '("@")))
           (define end  (if (member type '("@"))
                            (native-endianness)
                                'little
                                'big)))
           (define standard (not (member type '("@"))))
-          
+
+          (define (incr i n)
+            (+ i (if pack
+                     n
+                     (+ n (let ((x (modulo n 4)))
+                            (if (= x 0)
+                                0
+                                (- 4 x)))))))
+
           (define c-x
             (lambda (i)
               (bytevector-u8-set! bv i 0)
           (define c-c
             (lambda (i l)
               (bytevector-u8-set! bv i (pylist-ref (car l) 0))
-              (values (inc i 1) (cdr l))))
+              (values (incr i 1) (cdr l))))
 
           (define c-b
             (lambda (i l)
               (bytevector-s8-set! bv i (car l))
-              (values (inc i 1) (cdr l))))
+              (values (incr i 1) (cdr l))))
 
           (define c-B
             (lambda (i l)
               (bytevector-u8-set! bv i (car l))
-              (values (inc i 1) (cdr l))))
+              (values (incr i 1) (cdr l))))
 
           (define c-?
             (lambda (i l)
               (bytevector-u8-set! bv i (if (bool (car l)) 1 0))
-              (values (inc i 1) (cdr l))))
+              (values (incr i 1) (cdr l))))
 
           (define c-h
             (lambda (i l)
               (bytevector-s16-set! bv i (car l) end)
-              (values (inc i 2) (cdr l))))
+              (values (incr i 2) (cdr l))))
 
           (define c-H
             (lambda (i l)
               (bytevector-u16-set! bv i (car l) end)
-              (values (inc i 2) (cdr l))))
+              (values (incr i 2) (cdr l))))
 
           (define c-i
             (lambda (i l)
               (bytevector-s32-set! bv i (car l) end)
-              (values (inc i 4) (cdr l))))
+              (values (incr i 4) (cdr l))))
 
           (define c-I
             (lambda (i l)
               (bytevector-u32-set! bv i (car l) end)
-              (values (inc i 4) (cdr l))))
+              (values (incr i 4) (cdr l))))
 
           (define c-l8
             (lambda (i l)
               (bytevector-s64-set! bv i (car l) end)
-              (values (inc i 8) (cdr l))))
+              (values (incr i 8) (cdr l))))
 
           (define c-L8
             (lambda (i l)
               (bytevector-u64-set! bv i (car l) end)
-              (values (inc i 8) (cdr l))))
+              (values (incr i 8) (cdr l))))
 
           (define c-l (if standard c-i c-l8))
           (define c-L (if standard c-I c-L8))
           (define c-q
             (lambda (i l)
               (bytevector-s64-set! bv i (car l) end)
-              (values (inc i 8) (cdr l))))
+              (values (incr i 8) (cdr l))))
 
           (define c-Q
             (lambda (i l)
               (bytevector-u64-set! bv i (car l) end)
-              (values (inc i 8) (cdr l))))
+              (values (incr i 8) (cdr l))))
 
           (define c-n
             (lambda (i l)
               (bytevector-s64-set! bv i (car l) end)
-              (values (inc i 8) (cdr l))))
+              (values (incr i 8) (cdr l))))
 
           (define c-N
             (lambda (i l)
               (bytevector-u64-set! bv i (car l) end)
-              (values (inc i 8) (cdr l))))
+              (values (incr i 8) (cdr l))))
 
           (define c-e
             (let ((X  (expt 2 -14))
                   (XX (expt 2 -24)))
               (lambda (i l)
                 (let* ((x (car l))
-                       (s (>= x 0) 0 1)
+                       (s (if (>= x 0) 0 1))
                        (x (abs x))
                        (e (if (< x X)
                               (if (< x XX)
                                   #x1f
-                                  0))
-                          (inexact->exact
-                           (floor (+ (log2 x) 15))))
+                                  0)
+                              (inexact->exact
+                               (floor (+ (/ (log x) (log 2)) 15)))))
                        (s? (= e 0))
                        (i? (= e #x1f))
                        (m  (if i?
                                    (inexact->exact
                                     (floor
                                      (* x (expt 2 14)))))))
-                       (x   (logand (ash s               16)
+                       (x   (logior (ash s                16)
                                     (ash (logand e #x1f ) 10)
                                     (ash (logand m #x3ff) 00))))
                   (bytevector-u16-set! bv i x end)
-                  (values (inc i 2) (cdr l))))))
+                  (values (incr i 2) (cdr l))))))
 
           (define c-f
             (lambda (i l)
               (bytevector-f32-set! bv i (car l) end)
-              (values (inc i 4) (cdr l))))
+              (values (incr i 4) (cdr l))))
 
           (define c-d
             (lambda (i l)
               (bytevector-f64-set! bv i (car l) end)
-              (values (inc i 8) (cdr l))))
+              (values (incr i 8) (cdr l))))
 
           (define c-P
             (lambda (i l)
               (bytevector-u64-set! bv i (car l) end)
-              (values (inc i 8) (cdr l))))
+              (values (incr i 8) (cdr l))))
 
           (define c-s
             (lambda (i l n)
                       (begin
                         (bytevector-u8-set! bv k (pylist-ref x j))
                         (lp (+ j 1) (+ k 1)))
-                      (values (inc i n) (cdr l)))))))
+                      (values (incr i n) (cdr l)))))))
 
           (define c-p
             (lambda (i l n)
                             (begin
                               (bytevector-u8-set! bv k 0)
                               (lp (+ j 1) (+ k 1)))
-                            (values (inc i n) (cdr l)))))))))
+                            (values (incr i n) (cdr l)))))))))
           
                   
           (define tr (make-hash-table))
           (hash-set! tr "p" c-p)
           (hash-set! tr "P" c-P)
           
-          (let lp ((p rest) (i offset) (l rest))
+          (let lp ((p rest) (i offset) (l l))
             (match p
               (((n (and tp (or "p" "s"))) . p)
                (call-with-values
diff --git a/modules/language/python/module/textwrap.py b/modules/language/python/module/textwrap.py
new file mode 100644 (file)
index 0000000..62e90ba
--- /dev/null
@@ -0,0 +1,478 @@
+module(textwrap)
+
+"""Text wrapping and filling.
+"""
+
+# Copyright (C) 1999-2001 Gregory P. Ward.
+# Copyright (C) 2002, 2003 Python Software Foundation.
+# Written by Greg Ward <gward@python.net>
+
+import re
+
+__all__ = ['wrap', 'TextWrapper', 'fill', 'dedent', 'indent', 'shorten']
+
+# Hardcode the recognized whitespace characters to the US-ASCII
+# whitespace characters.  The main reason for doing this is that
+# some Unicode spaces (like \u00a0) are non-breaking whitespaces.
+_whitespace = '\t\n\x0b\x0c\r '
+
+
+class TextWrapper:
+    """
+    Object for wrapping/filling text.  The public interface consists of
+    the wrap() and fill() methods; the other methods are just there for
+    subclasses to override in order to tweak the default behaviour.
+    If you want to completely replace the main wrapping algorithm,
+    you'll probably have to override _wrap_chunks().
+
+    Several instance attributes control various aspects of wrapping:
+      width (default: 70)
+        the maximum width of wrapped lines (unless break_long_words
+        is false)
+      initial_indent (default: "")
+        string that will be prepended to the first line of wrapped
+        output.  Counts towards the line's width.
+      subsequent_indent (default: "")
+        string that will be prepended to all lines save the first
+        of wrapped output; also counts towards each line's width.
+      expand_tabs (default: true)
+        Expand tabs in input text to spaces before further processing.
+        Each tab will become 0 .. 'tabsize' spaces, depending on its position
+        in its line.  If false, each tab is treated as a single character.
+      tabsize (default: 8)
+        Expand tabs in input text to 0 .. 'tabsize' spaces, unless
+        'expand_tabs' is false.
+      replace_whitespace (default: true)
+        Replace all whitespace characters in the input text by spaces
+        after tab expansion.  Note that if expand_tabs is false and
+        replace_whitespace is true, every tab will be converted to a
+        single space!
+      fix_sentence_endings (default: false)
+        Ensure that sentence-ending punctuation is always followed
+        by two spaces.  Off by default because the algorithm is
+        (unavoidably) imperfect.
+      break_long_words (default: true)
+        Break words longer than 'width'.  If false, those words will not
+        be broken, and some lines might be longer than 'width'.
+      break_on_hyphens (default: true)
+        Allow breaking hyphenated words. If true, wrapping will occur
+        preferably on whitespaces and right after hyphens part of
+        compound words.
+      drop_whitespace (default: true)
+        Drop leading and trailing whitespace from lines.
+      max_lines (default: None)
+        Truncate wrapped lines.
+      placeholder (default: ' [...]')
+        Append to the last line of truncated text.
+    """
+
+    unicode_whitespace_trans = {}
+    uspace = ord(' ')
+    for x in _whitespace:
+        unicode_whitespace_trans[ord(x)] = uspace
+
+    # This funky little regex is just the trick for splitting
+    # text up into word-wrappable chunks.  E.g.
+    #   "Hello there -- you goof-ball, use the -b option!"
+    # splits into
+    #   Hello/ /there/ /--/ /you/ /goof-/ball,/ /use/ /the/ /-b/ /option!
+    # (after stripping out empty strings).
+    word_punct = r'[\w!"\'&.,?]'
+    letter = r'[^\d\W]'
+    whitespace = r'[%s]' % re.escape(_whitespace)
+    nowhitespace = '[^' + whitespace[1:]
+    wordsep_re = re.compile(r'''
+        ( # any whitespace
+          %(ws)s+
+        | # em-dash between words
+          (?<=%(wp)s) -{2,} (?=\w)
+        | # word, possibly hyphenated
+          %(nws)s+? (?:
+            # hyphenated word
+              -(?: (?<=%(lt)s{2}-) | (?<=%(lt)s-%(lt)s-))
+              (?= %(lt)s -? %(lt)s)
+            | # end of word
+              (?=%(ws)s|\Z)
+            | # em-dash
+              (?<=%(wp)s) (?=-{2,}\w)
+            )
+        )''' % {'wp': word_punct, 'lt': letter,
+                'ws': whitespace, 'nws': nowhitespace},
+        re.VERBOSE)
+    del word_punct, letter, nowhitespace
+
+    # This less funky little regex just split on recognized spaces. E.g.
+    #   "Hello there -- you goof-ball, use the -b option!"
+    # splits into
+    #   Hello/ /there/ /--/ /you/ /goof-ball,/ /use/ /the/ /-b/ /option!/
+    wordsep_simple_re = re.compile(r'(%s+)' % whitespace)
+    del whitespace
+
+    # XXX this is not locale- or charset-aware -- string.lowercase
+    # is US-ASCII only (and therefore English-only)
+    sentence_end_re = re.compile(r'[a-z]'             # lowercase letter
+                                 r'[\.\!\?]'          # sentence-ending punct.
+                                 r'[\"\']?'           # optional end-of-quote
+                                 r'\Z')               # end of chunk
+
+    def __init__(self,
+                 width=70,
+                 initial_indent="",
+                 subsequent_indent="",
+                 expand_tabs=True,
+                 replace_whitespace=True,
+                 fix_sentence_endings=False,
+                 break_long_words=True,
+                 drop_whitespace=True,
+                 break_on_hyphens=True,
+                 tabsize=8,
+                 *,
+                 max_lines=None,
+                 placeholder=' [...]'):
+        self.width = width
+        self.initial_indent = initial_indent
+        self.subsequent_indent = subsequent_indent
+        self.expand_tabs = expand_tabs
+        self.replace_whitespace = replace_whitespace
+        self.fix_sentence_endings = fix_sentence_endings
+        self.break_long_words = break_long_words
+        self.drop_whitespace = drop_whitespace
+        self.break_on_hyphens = break_on_hyphens
+        self.tabsize = tabsize
+        self.max_lines = max_lines
+        self.placeholder = placeholder
+
+
+    # -- Private methods -----------------------------------------------
+    # (possibly useful for subclasses to override)
+
+    def _munge_whitespace(self, text):
+        """_munge_whitespace(text : string) -> string
+
+        Munge whitespace in text: expand tabs and convert all other
+        whitespace characters to spaces.  Eg. " foo\\tbar\\n\\nbaz"
+        becomes " foo    bar  baz".
+        """
+        if self.expand_tabs:
+            text = text.expandtabs(self.tabsize)
+        if self.replace_whitespace:
+            text = text.translate(self.unicode_whitespace_trans)
+        return text
+
+
+    def _split(self, text):
+        """_split(text : string) -> [string]
+
+        Split the text to wrap into indivisible chunks.  Chunks are
+        not quite the same as words; see _wrap_chunks() for full
+        details.  As an example, the text
+          Look, goof-ball -- use the -b option!
+        breaks into the following chunks:
+          'Look,', ' ', 'goof-', 'ball', ' ', '--', ' ',
+          'use', ' ', 'the', ' ', '-b', ' ', 'option!'
+        if break_on_hyphens is True, or in:
+          'Look,', ' ', 'goof-ball', ' ', '--', ' ',
+          'use', ' ', 'the', ' ', '-b', ' ', option!'
+        otherwise.
+        """
+        if self.break_on_hyphens is True:
+            chunks = self.wordsep_re.split(text)
+        else:
+            chunks = self.wordsep_simple_re.split(text)
+        chunks = [c for c in chunks if c]
+        return chunks
+
+    def _fix_sentence_endings(self, chunks):
+        """_fix_sentence_endings(chunks : [string])
+
+        Correct for sentence endings buried in 'chunks'.  Eg. when the
+        original text contains "... foo.\\nBar ...", munge_whitespace()
+        and split() will convert that to [..., "foo.", " ", "Bar", ...]
+        which has one too few spaces; this method simply changes the one
+        space to two.
+        """
+        i = 0
+        patsearch = self.sentence_end_re.search
+        while i < len(chunks)-1:
+            if chunks[i+1] == " " and patsearch(chunks[i]):
+                chunks[i+1] = "  "
+                i += 2
+            else:
+                i += 1
+
+    def _handle_long_word(self, reversed_chunks, cur_line, cur_len, width):
+        """_handle_long_word(chunks : [string],
+                             cur_line : [string],
+                             cur_len : int, width : int)
+
+        Handle a chunk of text (most likely a word, not whitespace) that
+        is too long to fit in any line.
+        """
+        # Figure out when indent is larger than the specified width, and make
+        # sure at least one character is stripped off on every pass
+        if width < 1:
+            space_left = 1
+        else:
+            space_left = width - cur_len
+
+        # If we're allowed to break long words, then do so: put as much
+        # of the next chunk onto the current line as will fit.
+        if self.break_long_words:
+            cur_line.append(reversed_chunks[-1][:space_left])
+            reversed_chunks[-1] = reversed_chunks[-1][space_left:]
+
+        # Otherwise, we have to preserve the long word intact.  Only add
+        # it to the current line if there's nothing already there --
+        # that minimizes how much we violate the width constraint.
+        elif not cur_line:
+            cur_line.append(reversed_chunks.pop())
+
+        # If we're not allowed to break long words, and there's already
+        # text on the current line, do nothing.  Next time through the
+        # main loop of _wrap_chunks(), we'll wind up here again, but
+        # cur_len will be zero, so the next line will be entirely
+        # devoted to the long word that we can't handle right now.
+
+    def _wrap_chunks(self, chunks):
+        """_wrap_chunks(chunks : [string]) -> [string]
+
+        Wrap a sequence of text chunks and return a list of lines of
+        length 'self.width' or less.  (If 'break_long_words' is false,
+        some lines may be longer than this.)  Chunks correspond roughly
+        to words and the whitespace between them: each chunk is
+        indivisible (modulo 'break_long_words'), but a line break can
+        come between any two chunks.  Chunks should not have internal
+        whitespace; ie. a chunk is either all whitespace or a "word".
+        Whitespace chunks will be removed from the beginning and end of
+        lines, but apart from that whitespace is preserved.
+        """
+        lines = []
+        if self.width <= 0:
+            raise ValueError("invalid width %r (must be > 0)" % self.width)
+        if self.max_lines is not None:
+            if self.max_lines > 1:
+                indent = self.subsequent_indent
+            else:
+                indent = self.initial_indent
+            if len(indent) + len(self.placeholder.lstrip()) > self.width:
+                raise ValueError("placeholder too large for max width")
+
+        # Arrange in reverse order so items can be efficiently popped
+        # from a stack of chucks.
+        chunks.reverse()
+
+        while chunks:
+
+            # Start the list of chunks that will make up the current line.
+            # cur_len is just the length of all the chunks in cur_line.
+            cur_line = []
+            cur_len = 0
+
+            # Figure out which static string will prefix this line.
+            if lines:
+                indent = self.subsequent_indent
+            else:
+                indent = self.initial_indent
+
+            # Maximum width for this line.
+            width = self.width - len(indent)
+
+            # First chunk on line is whitespace -- drop it, unless this
+            # is the very beginning of the text (ie. no lines started yet).
+            if self.drop_whitespace and chunks[-1].strip() == '' and lines:
+                del chunks[-1]
+
+            while chunks:
+                l = len(chunks[-1])
+
+                # Can at least squeeze this chunk onto the current line.
+                if cur_len + l <= width:
+                    cur_line.append(chunks.pop())
+                    cur_len += l
+
+                # Nope, this line is full.
+                else:
+                    break
+
+            # The current line is full, and the next chunk is too big to
+            # fit on *any* line (not just this one).
+            if chunks and len(chunks[-1]) > width:
+                self._handle_long_word(chunks, cur_line, cur_len, width)
+                cur_len = sum(map(len, cur_line))
+
+            # If the last chunk on this line is all whitespace, drop it.
+            if self.drop_whitespace and cur_line and cur_line[-1].strip() == '':
+                cur_len -= len(cur_line[-1])
+                del cur_line[-1]
+
+            if cur_line:
+                if (self.max_lines is None or
+                    len(lines) + 1 < self.max_lines or
+                    (not chunks or
+                     self.drop_whitespace and
+                     len(chunks) == 1 and
+                     not chunks[0].strip()) and cur_len <= width):
+                    # Convert current line back to a string and store it in
+                    # list of all lines (return value).
+                    lines.append(indent + ''.join(cur_line))
+                else:
+                    while cur_line:
+                        if (cur_line[-1].strip() and
+                            cur_len + len(self.placeholder) <= width):
+                            cur_line.append(self.placeholder)
+                            lines.append(indent + ''.join(cur_line))
+                            break
+                        cur_len -= len(cur_line[-1])
+                        del cur_line[-1]
+                    else:
+                        if lines:
+                            prev_line = lines[-1].rstrip()
+                            if (len(prev_line) + len(self.placeholder) <=
+                                    self.width):
+                                lines[-1] = prev_line + self.placeholder
+                                break
+                        lines.append(indent + self.placeholder.lstrip())
+                    break
+
+        return lines
+
+    def _split_chunks(self, text):
+        text = self._munge_whitespace(text)
+        return self._split(text)
+
+    # -- Public interface ----------------------------------------------
+
+    def wrap(self, text):
+        """wrap(text : string) -> [string]
+
+        Reformat the single paragraph in 'text' so it fits in lines of
+        no more than 'self.width' columns, and return a list of wrapped
+        lines.  Tabs in 'text' are expanded with string.expandtabs(),
+        and all other whitespace characters (including newline) are
+        converted to space.
+        """
+        chunks = self._split_chunks(text)
+        if self.fix_sentence_endings:
+            self._fix_sentence_endings(chunks)
+        return self._wrap_chunks(chunks)
+
+    def fill(self, text):
+        """fill(text : string) -> string
+
+        Reformat the single paragraph in 'text' to fit in lines of no
+        more than 'self.width' columns, and return a new string
+        containing the entire wrapped paragraph.
+        """
+        return "\n".join(self.wrap(text))
+
+# -- Convenience interface ---------------------------------------------
+
+def wrap(text, width=70, **kwargs):
+    """Wrap a single paragraph of text, returning a list of wrapped lines.
+
+    Reformat the single paragraph in 'text' so it fits in lines of no
+    more than 'width' columns, and return a list of wrapped lines.  By
+    default, tabs in 'text' are expanded with string.expandtabs(), and
+    all other whitespace characters (including newline) are converted to
+    space.  See TextWrapper class for available keyword args to customize
+    wrapping behaviour.
+    """
+    w = TextWrapper(width=width, **kwargs)
+    return w.wrap(text)
+
+def fill(text, width=70, **kwargs):
+    """Fill a single paragraph of text, returning a new string.
+
+    Reformat the single paragraph in 'text' to fit in lines of no more
+    than 'width' columns, and return a new string containing the entire
+    wrapped paragraph.  As with wrap(), tabs are expanded and other
+    whitespace characters converted to space.  See TextWrapper class for
+    available keyword args to customize wrapping behaviour.
+    """
+    w = TextWrapper(width=width, **kwargs)
+    return w.fill(text)
+
+def shorten(text, width, **kwargs):
+    """Collapse and truncate the given text to fit in the given width.
+
+    The text first has its whitespace collapsed.  If it then fits in
+    the *width*, it is returned as is.  Otherwise, as many words
+    as possible are joined and then the placeholder is appended::
+
+        >>> textwrap.shorten("Hello  world!", width=12)
+        'Hello world!'
+        >>> textwrap.shorten("Hello  world!", width=11)
+        'Hello [...]'
+    """
+    w = TextWrapper(width=width, max_lines=1, **kwargs)
+    return w.fill(' '.join(text.strip().split()))
+
+# -- Loosely related functionality -------------------------------------
+
+_whitespace_only_re = re.compile('^[ \t]+$', re.MULTILINE)
+_leading_whitespace_re = re.compile('(^[ \t]*)(?:[^ \t\n])', re.MULTILINE)
+
+def dedent(text):
+    """Remove any common leading whitespace from every line in `text`.
+
+    This can be used to make triple-quoted strings line up with the left
+    edge of the display, while still presenting them in the source code
+    in indented form.
+
+    Note that tabs and spaces are both treated as whitespace, but they
+    are not equal: the lines "  hello" and "\\thello" are
+    considered to have no common leading whitespace.  (This behaviour is
+    new in Python 2.5; older versions of this module incorrectly
+    expanded tabs before searching for common leading whitespace.)
+    """
+    # Look for the longest leading string of spaces and tabs common to
+    # all lines.
+    margin = None
+    text = _whitespace_only_re.sub('', text)
+    indents = _leading_whitespace_re.findall(text)
+    for indent in indents:
+        if margin is None:
+            margin = indent
+        
+        # Current line more deeply indented than previous winner:
+        # no change (previous winner is still on top).
+        elif indent.startswith(margin):
+            pass
+        
+        # Current line consistent with and no deeper than previous winner:
+        # it's the new winner.
+        elif margin.startswith(indent):
+            margin = indent
+        
+        
+        # Find the largest common whitespace between current line and previous
+        # winner.
+        else:
+            for i, (x, y) in enumerate(zip(margin, indent)):
+                if x != y:
+                    margin = margin[:i]
+                    break
+            else:
+                margin = margin[:len(indent)]
+    
+    if margin:
+        text = re.sub(r'(?m)^' + margin, '', text)
+    return text
+
+
+def indent(text, prefix, predicate=None):
+    """Adds 'prefix' to the beginning of selected lines in 'text'.
+
+    If 'predicate' is provided, 'prefix' will only be added to the lines
+    where 'predicate(line)' is True. If 'predicate' is not provided,
+    it will default to adding 'prefix' to all non-empty lines that do not
+    consist solely of whitespace characters.
+    """
+    if predicate is None:
+        def predicate(line):
+            return line.strip()
+
+    def prefixed_lines():
+        for line in text.splitlines(True):
+            yield (prefix + line if predicate(line) else line)
+    return ''.join(prefixed_lines())
index 81b5a063382ec32df2eeac5a58058e862eb0fcd3..6c31f1eb3c409580acebda36747c09c2f27bc1a3 100644 (file)
@@ -24,7 +24,9 @@
 (define-syntax-rule (aif it p x y) (let ((it p)) (if it x y)))
 
 (define (scm-str x)
-  (slot-ref (pystring x) 'str))
+  (if (string? x)
+      x
+      (slot-ref (pystring x) 'str)))
 
 (define (scm-sym x)
   (if (symbol? x)