diff options
Diffstat (limited to 'modules')
-rw-r--r-- | modules/language/python/module.scm | 8 | ||||
-rw-r--r-- | modules/language/python/module/re/compile.scm | 124 | ||||
-rw-r--r-- | modules/language/python/module/re/flags.scm | 2 | ||||
-rw-r--r-- | modules/language/python/module/re/parser.scm | 6 |
4 files changed, 104 insertions, 36 deletions
diff --git a/modules/language/python/module.scm b/modules/language/python/module.scm index 101f62e..3453a25 100644 --- a/modules/language/python/module.scm +++ b/modules/language/python/module.scm @@ -135,7 +135,7 @@ (rawset self '_module _module) (hash-set! _modules l self)))))) - (define __getattr__ + (define __getattribute__ (lambda (self k) (define (fail) (raise (AttributeError "getattr in Module"))) @@ -149,7 +149,7 @@ (define __setattr__ (lambda (self k v) (let ((k (_k k)) - (fail (lambda () (raise KeyError "getattr in Module" k)))) + (fail (lambda () (raise KeyError "setattr in Module" k)))) (if (rawref self k) (fail) (aif m (rawref self '_module) @@ -163,7 +163,7 @@ (define __delattr__ (lambda (self k) - (define (fail) (raise KeyError "getattr in Module")) + (define (fail) (raise KeyError "delattr in Module")) (aif m (rawref self '_module) (let ((k (_k k))) (if (module-defined? m k) @@ -188,7 +188,7 @@ (define __getitem__ (lambda (self k) (define k (if (string? k) (string->symbol k) k)) - (__getattr__ self k))) + (__getattribute__ self k))) (define __iter__ (lambda (self) diff --git a/modules/language/python/module/re/compile.scm b/modules/language/python/module/re/compile.scm index e0b415b..9c4dfd3 100644 --- a/modules/language/python/module/re/compile.scm +++ b/modules/language/python/module/re/compile.scm @@ -1,11 +1,14 @@ (define-module (language python module re compile) #:use-module (language python module re parser) + #:use-module (language python module re flags) #:use-module (language python list) #:use-module (language python string) #:use-module ((parser stis-parser) #:select ((parse . stisparse) <p-lambda> <p-cc> .. f-nl! f-nl - f-tag! f-tag f-seq f-or f-or! f-and f-true g* g+ gmn ng* ng+ ngmn - g? ng? f-test! f-eof f-not! f-prev f-not f-out f-rev *whitespace* + f-tag! f-tag f-seq f-or f-or! f-and f-true g* g+ gmn ng* ng+ + ngmn f-reg! f-and! + g? ng? f-test! f-eof f-not! f-prev f-not f-out f-rev + *whitespace* f-nm f-pos)) #:use-module (parser stis-parser macros) @@ -25,6 +28,19 @@ (.. c2 (f c)) (<p-cc> (wrap L c2)))) +(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))))))) + + (define-syntax-rule (group f) (let () (define-syntax-rule (mac s) (lambda (x n m) (set! s x))) @@ -107,10 +123,14 @@ (reverse-form x)) ((#:or . l) (cons #:or (map reverse-form l))) + ((#:seq x) + (reverse-form x)) + ((#:seq . l) + (cons #:seq (reverse (map reverse-form l)))) ((#:sub f) (list #:group (reverse-form f))) - ((#:?P< f n) - (list #:?P< (reverse-form f) n)) + ((#:?P< n f) + (list #:?P< n (reverse-form f))) ((#:?: f) (reverse-form f)) ((#:?P= name) @@ -118,29 +138,59 @@ ((#:?P=-rev name) (#:?P= name)) ((#:?if name yes no) - (list #:?if-rev name (reverse-form yes) (reverse-form no))) - ((#:?if-rev name yes no) - (list #:?if name (reverse-form yes) (reverse-form no))) - ((#:?= f ) (list #:?= (reverse-form f))) - ((#:?! f ) (list #:?! (reverse-form f))) - ((#:?<= f ) (list #:?<= f)) - ((#:?<! f ) (list #:?<! f)) - ((#:* x ) (list #:* (reverse-form x))) - ((#:+ x ) (list #:+ (reverse-form x))) - ((#:mn x m n) (list #:mn (reverse-form x) m n)) - ((#:? x ) (list #:? (reverse-form x))) - ((#:*? x ) (list #:*? (reverse-form x))) - ((#:+? x ) (list #:+? (reverse-form x))) - ((#:?? x ) (list #:?? (reverse-form x))) - ((:mn? x m n) (list #:mn? (reverse-form x) m n)) - ((#:ch x ) (list #:ch x)) - ((#:bracket . l) (cons #:bracket l)) - ((x . l) (map reverse-form (cons x l))) - (x x))) + (list #:if name (reverse-form yes) (reverse-form no))) + ((#:?= f) (list #:?= (reverse-form f))) + ((#:?! f) (list #:?= (reverse-form f))) + ((#:?<= f) f) + ((#:?<! f) (#:not f)) + ((#:not f) (list #:not (reverse-form f))) + (#:$ #:^) + (#:^ #:$) + ((#: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 #:? ) (list #:op (reverse-form x) #:?)) + ((#:op x #:*?) (list #:op (reverse-form x) #:*?)) + ((#:op x #:+?) (list #:op (reverse-form x) #:+?)) + ((#:op x #:??) (list #:op (reverse-form x) #:??)) + ((and a (#:ch (#:class x))) a) + ((and a (#:ch x)) a) + ((and a (#:bracket not ch ...)) a))) + + +(define f-w + (f-or! (f-test! (lambda (x) + (let ((x (fluid-ref *flags*))) + (and + (= (logand x ASCII) 0) + (or (char-numeric? x) + (char-alphabetic? x)))))) + + (f-tag "_") + (f-reg! "a-zA-Z0-9"))) + +(define f-d + (f-or! + (f-test! (lambda (x) + (let ((x (fluid-ref *flags*))) + (and + (= (logand x ASCII) 0) + (char-numeric? x))))) + (f-reg! "0-9"))) + +(define f-s + (f-or! + (f-test! + (lambda (x) + (let ((fl (fluid-ref *flags*))) + (and + (= (logand fl ASCII) 0) + (char-whitespace? x))))) + (f-reg! "[\n\r \t\f\v]"))) -(define f-w (f-test! (lambda (x) (or (char-numeric? x) (char-alphabetic? x) (eq? x #\_))))) -(define f-d (f-test! (lambda (x) (or (char-numeric? x))))) -(define f-s (f-test! (lambda (x) (or (char-whitespace? x))))) (define (get-class tag) (match tag ("n" f-nl!) @@ -208,8 +258,10 @@ (incant-rev name)) ((#:?= f) (f-and (compile f) f-true)) ((#:?! f) (f-and (f-not (compile f)) f-true)) - ((#:?<= f) (f-and (f-seq f-rev (compile (reverse-form f))) f-true)) - ((#:?<! f) (f-and (f-seq f-rev (f-not (compile (reverse-form f)))) f-true)) + ((#:?<= f) (gt (compile (reverse-form f)))) + ((#:?<! f) (f-seq (f-not (f-seq f-rev (compile (reverse-form f)))) + f-true)) + ((#:not f) (f-and (f-not (compile f)) f-true)) ((#:?if name yes no) (f-or (f-seq (incant name) yes) no)) @@ -231,7 +283,18 @@ ((#:ch (#:class x)) (fw (get-class x))) ((#:ch x) - (fw (f-tag! 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)))))))))) ((#:bracket not ch ...) (let ((f (apply f-or! (map (lambda (x) @@ -239,7 +302,8 @@ ((#:ch (#:class ch)) (get-class ch)) ((#:ch ch) - (f-tag! ch)))) ch)))) + (compile (list #:ch ch))))) + ch)))) (if not (f-not! f) diff --git a/modules/language/python/module/re/flags.scm b/modules/language/python/module/re/flags.scm index 527bb09..4db839a 100644 --- a/modules/language/python/module/re/flags.scm +++ b/modules/language/python/module/re/flags.scm @@ -1,5 +1,5 @@ (define-module (language python module re flags) - #:export (set-flags get-flags + #:export (set-flags get-flags *flags* A ASCII DEBUG I IGNORECASE L LOCALE M MULTILINE X VERBOSE)) (define *flags* (make-fluid 0)) diff --git a/modules/language/python/module/re/parser.scm b/modules/language/python/module/re/parser.scm index eae4b3f..a7210d1 100644 --- a/modules/language/python/module/re/parser.scm +++ b/modules/language/python/module/re/parser.scm @@ -37,6 +37,10 @@ (define lookh (f-list #:?= "(?=" (Ds ee) ")")) (define lookh! (f-list #:?! "(?!" (Ds ee) ")")) + +(define rev (f-list #:?<= "(?<=" (Ds ee) ")")) +(define rev! (f-list #:?<! "(?<!" (Ds ee) ")")) + (define bbody (f-cons (ch (f-reg "[\\]")) (ff* (ch (f-reg "[]\\]"))))) (define (f-if a b c) (f-or! (f-seq a b) c)) @@ -52,7 +56,7 @@ (define f-bar (f-tag "|")) (define qq (ch (f-reg "[][?+|*.$^() \\]"))) -(define atom (f-or qq f-. choice subexpr anongroup namegroup incant coment lookh lookh! f-^ f-$)) +(define atom (f-or qq f-. choice subexpr anongroup namegroup incant coment lookh lookh! rev rev! f-^ f-$)) (define spec (f-list #:op atom (f-or! q+? q?? q*? q* q? q+ repn? repnm? repn repnm))) (define aatom (f-or! spec atom)) (define line (f-cons* #:seq aatom (ff* aatom ))) |