diff options
Diffstat (limited to 'modules/language')
| -rw-r--r-- | modules/language/python/compile.scm | 305 | ||||
| -rw-r--r-- | modules/language/python/format2.scm | 43 | ||||
| -rw-r--r-- | modules/language/python/module/re.scm | 5 | ||||
| -rw-r--r-- | modules/language/python/module/re/compile.scm | 8 | ||||
| -rw-r--r-- | modules/language/python/module/re/parser.scm | 17 | ||||
| -rw-r--r-- | modules/language/python/module/struct.scm | 222 | ||||
| -rw-r--r-- | modules/language/python/module/textwrap.py | 478 | ||||
| -rw-r--r-- | modules/language/python/string.scm | 4 |
8 files changed, 838 insertions, 244 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index c3e7142..577d794 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -213,11 +213,19 @@ 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)))) @@ -819,16 +827,24 @@ (#: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) @@ -1033,7 +1049,10 @@ (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) @@ -1044,7 +1063,7 @@ ,(exp vs code) (,lp)))))) - ((_ test code else) + ((_ test code . else) (let ((lp (gensym "lp"))) `(let ,lp () (if test @@ -1499,7 +1518,7 @@ ,@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))))) @@ -1700,12 +1719,21 @@ (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) @@ -1719,63 +1747,68 @@ 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) @@ -1863,75 +1896,107 @@ ((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 () diff --git a/modules/language/python/format2.scm b/modules/language/python/format2.scm index f8c4c69..70ee212 100644 --- a/modules/language/python/format2.scm +++ b/modules/language/python/format2.scm @@ -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))) @@ -120,7 +121,8 @@ ("" (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))) @@ -159,29 +161,34 @@ (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) @@ -219,6 +226,7 @@ (() (lambda (x) '())))) + (let lp ((l l)) (match l ((a p . l) @@ -234,7 +242,8 @@ (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))) @@ -242,7 +251,13 @@ (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 @@ -250,7 +265,7 @@ (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)) diff --git a/modules/language/python/module/re.scm b/modules/language/python/module/re.scm index f16b697..3b8f8af 100644 --- a/modules/language/python/module/re.scm +++ b/modules/language/python/module/re.scm @@ -430,13 +430,16 @@ (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)))))))) diff --git a/modules/language/python/module/re/compile.scm b/modules/language/python/module/re/compile.scm index 3d7bdb1..93d7c38 100644 --- a/modules/language/python/module/re/compile.scm +++ b/modules/language/python/module/re/compile.scm @@ -204,10 +204,10 @@ (#: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) #:+?)) diff --git a/modules/language/python/module/re/parser.scm b/modules/language/python/module/re/parser.scm index 9ecc756..4d603c6 100644 --- a/modules/language/python/module/re/parser.scm +++ b/modules/language/python/module/re/parser.scm @@ -52,17 +52,20 @@ (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 diff --git a/modules/language/python/module/struct.scm b/modules/language/python/module/struct.scm index 5f5e872..b3d5b9f 100644 --- a/modules/language/python/module/struct.scm +++ b/modules/language/python/module/struct.scm @@ -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))) @@ -37,10 +49,10 @@ (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) @@ -110,8 +122,8 @@ (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)) @@ -134,7 +146,7 @@ (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)) @@ -143,7 +155,7 @@ (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) @@ -151,9 +163,16 @@ (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))))))) @@ -182,7 +201,7 @@ (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))))))))) @@ -227,7 +246,7 @@ l (cons (list (- n 1) tp) l)))) bv i))) - (() (lambda (bv i) '()))))) + (() '())))) bv n)) (define (unpack format buffer) @@ -238,9 +257,9 @@ (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)) @@ -250,60 +269,61 @@ (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) @@ -311,7 +331,15 @@ '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) @@ -320,52 +348,52 @@ (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)) @@ -373,36 +401,36 @@ (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? @@ -414,26 +442,26 @@ (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) @@ -443,7 +471,7 @@ (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) @@ -461,7 +489,7 @@ (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)) @@ -488,7 +516,7 @@ (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 index 0000000..62e90ba --- /dev/null +++ b/modules/language/python/module/textwrap.py @@ -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()) diff --git a/modules/language/python/string.scm b/modules/language/python/string.scm index 81b5a06..6c31f1e 100644 --- a/modules/language/python/string.scm +++ b/modules/language/python/string.scm @@ -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) |