diff options
-rw-r--r-- | modules/language/python/compile.scm | 8 | ||||
-rw-r--r-- | modules/language/python/list.scm | 3 | ||||
-rw-r--r-- | modules/language/python/module/_python.scm | 6 | ||||
-rw-r--r-- | modules/language/python/module/re.scm | 4 | ||||
-rw-r--r-- | modules/language/python/module/re/compile.scm | 189 | ||||
-rw-r--r-- | modules/language/python/module/re/parser.scm | 2 | ||||
-rw-r--r-- | modules/language/python/module/textwrap.py | 4 | ||||
-rw-r--r-- | modules/language/python/number.scm | 7 | ||||
-rw-r--r-- | modules/language/python/string.scm | 10 |
9 files changed, 136 insertions, 97 deletions
diff --git a/modules/language/python/compile.scm b/modules/language/python/compile.scm index a268d26..ba07241 100644 --- a/modules/language/python/compile.scm +++ b/modules/language/python/compile.scm @@ -1176,7 +1176,7 @@ (if p `(,(C 'let/ec) break-ret (let ,lp () - (if ,(exp vs test) + (if (,(C 'boolit) ,(exp vs test)) (begin (,(C 'let/ec) continue-ret (,(C 'with-sp) ((continue (values)) @@ -1186,7 +1186,7 @@ `(,(C 'let/ec) break-ret (let ,lp () - (if ,(exp vs test) + (if (,(C 'boolit) ,(exp vs test)) (begin (,(C 'with-sp) ((break (break-ret))) ,code2) @@ -1199,7 +1199,7 @@ (if p `(,(C 'let/ec) break-ret (let ,lp () - (if ,(exp vs test) + (if (,(C 'boolit) ,(exp vs test)) (begin (,(C 'let/ec) ,(C 'continue-ret) (,(C 'with-sp) ((continue (values)) @@ -1209,7 +1209,7 @@ ,(exp vs else)))) `(,(C 'let/ec) break-ret (let ,lp () - (if ,(exp vs test) + (if (,(C 'boolit) ,(exp vs test)) (begin (,(C 'with-sp) ((break (break-ret))) ,code2) diff --git a/modules/language/python/list.scm b/modules/language/python/list.scm index 72224ba..99c4f59 100644 --- a/modules/language/python/list.scm +++ b/modules/language/python/list.scm @@ -415,7 +415,8 @@ (let ((swap (vector-ref vec i)) (k (- M i))) (vector-set! vec i (vector-ref vec k)) - (vector-set! vec k swap)))))) + (vector-set! vec k swap) + (lp (+ i 1))))))) (define-method (pylist-reverse! (o <p>) . l) diff --git a/modules/language/python/module/_python.scm b/modules/language/python/module/_python.scm index 04becbb..47df9fc 100644 --- a/modules/language/python/module/_python.scm +++ b/modules/language/python/module/_python.scm @@ -57,9 +57,9 @@ (define print (case-lambda - (() ((@ (guile) format) #t "~%")) - ((x) ((@ (guile) format) #t "~s~%" x)) - (l ((@ (guile) format) #t "~s~%" l)))) + (() ((@ (guile) display) "\n")) + ((x) ((@ (guile) display) x ) (print)) + (l ((@ (guile) display) l ) (print)))) (define (repr x) ((@ (guile) format) #f "~a" x)) (define abs py-abs) diff --git a/modules/language/python/module/re.scm b/modules/language/python/module/re.scm index bf44d13..6765654 100644 --- a/modules/language/python/module/re.scm +++ b/modules/language/python/module/re.scm @@ -168,8 +168,8 @@ (define-syntax-rule (mk split- grps mku) (def (split- re ss (= maxsplit 0) (= flags 0)) (if (not (isinstance re Regexp)) - (split- (Regexp re) ss maxsplit flags) - (begin + (split- (Regexp re) ss #:maxsplit maxsplit #:flags flags) + (begin (set-flags flags) (set-maxsplit maxsplit) (let ((m (parse ss (ff* (f-seq! e-maxsplit diff --git a/modules/language/python/module/re/compile.scm b/modules/language/python/module/re/compile.scm index ea71aee..9fe6fc0 100644 --- a/modules/language/python/module/re/compile.scm +++ b/modules/language/python/module/re/compile.scm @@ -15,6 +15,12 @@ #:use-module (ice-9 match) #:export (compile-reg test-reg parse)) +(define trace? #f) +(define (trace nm f) + (if trace? + (f-seq (f-pk nm) f) + f)) + (define-syntax-rule (<pp-lambda> (a b) . code) (<p-lambda> (d) (let ((a (car d)) @@ -61,33 +67,33 @@ (<p-cc> c))))) (define startline - (<pp-lambda> (L c) + (<p-lambda> (c) (when (= N 0) - (<p-cc> (wrap L c))))) + (<p-cc> c)))) (define dotall - (<pp-lambda> (L c) + (<p-lambda> (c) (let ((x (fluid-ref *flags*))) (when (not (= 0 (logand x DOTALL))) - (<p-cc> (wrap L c)))))) + (<p-cc> c))))) (define multiline - (<pp-lambda> (L c) + (<p-lambda> (c) (let ((x (fluid-ref *flags*))) - (when (not (= 0 (logand x DOTALL))) - (<p-cc> (wrap L c)))))) + (when (not (= 0 (logand x MULTILINE))) + (<p-cc> c))))) (define (gt f) (<pp-lambda> (L c) (let ((x #f)) - (<or> - (<and> - (.. c* (f-rev '())) - (.. c2 (f (list L '()))) - (<code> (set! x c2)) - <fail>) - (when x - (<p-cc> (wrap (car x) c))))))) + (<or> + (<and> + (.. c* (f-rev '())) + (.. c2 (f (list L '()))) + (<code> (set! x c2)) + <fail>) + (when x + (<p-cc> (wrap (car x) c))))))) (define-syntax-rule (group f) @@ -125,7 +131,8 @@ (define (incant name) (<p-lambda> (c) - (let* ((L (cadr c)) + (let* ((L (car c)) + (c (cadr c)) (r (if (number? name) (let lp ((l L)) (define (f x u l) @@ -155,15 +162,20 @@ (if r - (<and> (.. ((fw (f-tag! r)) c))) + (<and> + (.. c2 ((f-tag! r) c)) + (<p-cc> (wrap L c2))) (<code> (error "group is not existing in the history")))))) (define (incant-rev name) (<p-lambda> (c) - (let* ((L (cadr c)) + (let* ((L (car c)) + (c (cadr c)) (r (assoc name L))) (if r - (<and> (.. ((f-tag (reverse (cdr r))) c))) + (<and> + (.. c2 ((f-tag (reverse (cdr r))) c)) + (<p-cc> (wrap L c2))) (<code> (error "group is not existing in the history")))))) (define (reverse-form x) @@ -331,92 +343,110 @@ (lp l f)) (() f)))) - + +(define (get-ch x) + (let ((chx (string-ref x 0))) + (f-test! (lambda (ch) + (let ((y (fluid-ref *flags*))) + (if (= 0 (logand y IGNORECASE)) + (eq? ch chx) + (if (= 0 (logand y ASCII)) + (eq? (char-upcase chx) (char-upcase ch)) + (if (and (< (char->integer ch) 128) + (< (char->integer chx) 128)) + (eq? (char-upcase chx) (char-upcase ch)) + (eq? chx ch))))))))) + (define (compile x) (match x ((#:or x) (compile x)) - ((#:or . l) - (apply f-or (map compile l))) + ((#:or . l) + (trace 'or + (apply f-or (map compile l)))) ((#:seq x) (compile x)) ((#:seq . l) - (apply f-seq (map compile l))) + (trace 'seq + (apply f-seq (map compile l)))) ((#:sub f) - (group (compile f))) + (trace 'sub + (group (compile f)))) ((#:?P< n f) - (group-name (compile f) n)) - ((#:?: f) + (trace '?P< + (group-name (compile f) n))) + ((#:?: f) (compile f)) ((#:?P= name) - (incant name)) + (trace '?P= + (incant name))) ((#:?P=-rev name) (incant-rev name)) - ((#:?= f) (f-and (compile f) f-true)) - ((#:?! f) (f-and (f-not (compile f)) f-true)) - ((#:?<= f) (gt (compile (reverse-form f)))) - ((#:?<! f) (f-seq (f-not (f-seq f-rev (compile (reverse-form f)))) - f-true)) + ((#:?= f) (trace '?= (f-and (compile f) f-true))) + ((#:?! f) (trace '?! (f-and (f-not (compile f)) f-true))) + ((#:?<= f) (trace '?<= (gt (compile (reverse-form f))))) + ((#:?<! f) (trace '?<! (f-seq (f-not (f-seq f-rev + (compile (reverse-form f)))) + f-true))) ((#:?<=-rev f) (gt (compile f))) ((#:?<!-rev f) (f-seq (f-not (f-seq f-rev (compile f))) - f-true)) - ((#:not f) (f-and (f-not (compile f)) f-true)) + f-true)) + ((#:not f) (trace 'not (f-and (f-not (compile f)) f-true))) ((#:?if name yes no) - (f-or (f-seq (incant name) yes) - no)) - ((#:?if-rev name yes no) + (trace '?if (f-or (f-seq (incant name) yes) + no))) + ((#:?if-rev name yes no) (f-or (f-seq yes (incant-rev name)) no)) (#:$ - (f-or! f-eof - (f-and multiline - f-nl - f-true))) + (trace '$ + (fw + (f-or! f-eof + (f-and multiline + f-nl + f-true))))) (#:^ - (f-or! (f-nm 0 1) - (f-and multiline - startline - f-true))) + (trace '^ + (fw + (f-or! (f-nm 0 1) + (f-and multiline + startline + f-true))))) (#:dot - (f-or! (fw (f-reg! ".")) - (f-and - dotall - (fw f-nl!)))) + (trace 'dot + (fw + (f-or! (f-reg! ".") + (f-and + dotall + f-nl!))))) + ((#:flags a b f) (let ((maskon (mask-on a b)) (maskoff (mask-off a b))) - (f-flags maskon maskoff (compile f)))) + (fw (f-flags maskon maskoff (compile f))))) ((#:flags2 a) (let ((maskon (mask-on a "")) (maskoff (mask-off a ""))) - (f-flags2 maskon maskoff))) - ((#:op x #:* ) (g* (compile x) )) - ((#:op x #:+ ) (g+ (compile x) )) - ((#:op x (#:rep m n)) (gmn (compile x) m n)) - ((#:op x (#:rep m )) (gmn (compile x) m m)) - ((#:op x (#:rep? m n)) (ngmn (compile x) m n)) - ((#:op x (#:rep? m )) (ngmn (compile x) m m)) - ((#:op x #:? ) (g? (compile x) )) - ((#:op x #:*?) (ng* (compile x) )) - ((#:op x #:+?) (ng+ (compile x) )) - ((#:op x #:??) (ng? (compile x) )) + (fw (f-flags2 maskon maskoff)))) + + ((#:op x #:* ) (trace '* (g* (compile x) ))) + ((#:op x #:+ ) (trace '+ (g+ (compile x) ))) + ((#:op x (#:rep m n)) (trace 'mn (gmn (compile x) m n))) + ((#:op x (#:rep m )) (trace 'mn (gmn (compile x) m m))) + ((#:op x (#:rep? m n)) (trace 'nmn (ngmn (compile x) m n))) + ((#:op x (#:rep? m )) (trace 'nmn (ngmn (compile x) m m))) + ((#:op x #:? ) (trace '? (g? (compile x) ))) + ((#:op x #:*?) (trace 'n* (ng* (compile x) ))) + ((#:op x #:+?) (trace 'n+ (ng+ (compile x) ))) + ((#:op x #:??) (trace 'n? (ng? (compile x) ))) ((#:ch (#:class x)) - (fw (get-class x))) + (trace 'class + (fw (get-class x)))) ((#:ch x) - (let ((chx (string-ref x 0))) - (fw - (f-test! (lambda (ch) - (let ((y (fluid-ref *flags*))) - (if (= 0 (logand y IGNORECASE)) - (eq? ch chx) - (if (= 0 (logand y ASCII)) - (eq? (char-upcase chx) (char-upcase ch)) - (if (and (< (char->integer ch) 128) - (< (char->integer chx) 128)) - (eq? (char-upcase chx) (char-upcase ch)) - (eq? chx ch)))))))))) + (trace 'ch + (fw (get-ch x)))) ((#:bracket not ch ...) (let ((f (apply f-or! (map (lambda (x) @@ -426,12 +456,13 @@ ((#:ch (#:class ch)) (get-class ch)) ((#:ch ch) - (compile (list #:ch ch))))) + (get-ch ch)))) ch)))) - - (if not - (f-not! f) - f))))) + (trace `brack + (fw + (if not + (f-not! f) + f))))))) (define (maybe-add-nk x) (if (equal? (pylist-ref x (- (len x) 1)) "\n") diff --git a/modules/language/python/module/re/parser.scm b/modules/language/python/module/re/parser.scm index 75b0ba0..b20d272 100644 --- a/modules/language/python/module/re/parser.scm +++ b/modules/language/python/module/re/parser.scm @@ -89,7 +89,7 @@ (define line (f-cons* #:seq ws aatom ws (ff* (f-seq ws aatom ws) ))) (define ee (f-cons* #:or line (ff* (f-seq f-bar line)))) (define (parse-reg str) - (with-fluids ((*whitespace* ws)) + (with-fluids ((*whitespace* ws)) (parse str (f-seq ee f-eof)))) (define e-matcher ee) diff --git a/modules/language/python/module/textwrap.py b/modules/language/python/module/textwrap.py index 62e90ba..8c23431 100644 --- a/modules/language/python/module/textwrap.py +++ b/modules/language/python/module/textwrap.py @@ -262,7 +262,6 @@ class TextWrapper: 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 = [] @@ -333,7 +332,6 @@ class TextWrapper: break lines.append(indent + self.placeholder.lstrip()) break - return lines def _split_chunks(self, text): @@ -352,8 +350,10 @@ class TextWrapper: 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): diff --git a/modules/language/python/number.scm b/modules/language/python/number.scm index eb0d0d5..95965b8 100644 --- a/modules/language/python/number.scm +++ b/modules/language/python/number.scm @@ -321,8 +321,13 @@ (if n 1 0)) ((number? n) (lp (py-floor n))) + ((string? n) - (lp (string->number n))) + (lp (aif it (string->number n) + it + (raise + (ValueError + "invalid literal for int() with base 10"))))) (else (catch #t (lambda () diff --git a/modules/language/python/string.scm b/modules/language/python/string.scm index 4261a0a..9a58712 100644 --- a/modules/language/python/string.scm +++ b/modules/language/python/string.scm @@ -489,15 +489,17 @@ (define-py (py-translate translate s table . l) (let* ((n (len s)) (w (make-string n)) - (t (if (eq? table None) #f table)) + (t (if (eq? table None) + #f + table)) (d (match l (() #f) ((x) x)))) (define (tr ch) (define (e) (if t (let ((i (char->integer ch))) - (if (< i (string-length t)) - (string-ref t i) - ch)) + (catch #t + (lambda () (integer->char (pylist-ref t i))) + (lambda x ch))) ch)) (if d |