diff options
Diffstat (limited to 'modules/language/python/module/re.scm')
-rw-r--r-- | modules/language/python/module/re.scm | 52 |
1 files changed, 37 insertions, 15 deletions
diff --git a/modules/language/python/module/re.scm b/modules/language/python/module/re.scm index 0efbec9..48259e8 100644 --- a/modules/language/python/module/re.scm +++ b/modules/language/python/module/re.scm @@ -1,17 +1,18 @@ (define-module (language python modules re) - #:export()) + #:use-module (parser stis-parser) + #:export(parse-reg)) -(define-sytax-rule (mk n tag str) (define n (f-seq tag (f-tag str)))) +(define-syntax-rule (mk n tag str) (define n (f-seq tag (f-tag str)))) (mk f-. #:. ".") (mk f-^ #:^ "^") (mk f-$ #:$ "$") (define subexpr (f-list #:sub - (f-seq (f-tag "(") f-start ee f-end (f-tag ")")))) + (f-seq (f-tag "(") (Ds ee) (f-tag ")")))) (define f-back - (f-or (f-list #:class (mk-token (f-reg! "[AZbBdDsSwS]"))) + (f-or (f-list #:class (mk-token (f-reg! "[AZbBdDsSw]"))) (mk-token (f-reg ".")))) (define (ch not) @@ -21,6 +22,8 @@ (define bbody (f-cons (ch "[\\]") (ff* (ch "[]\\]")))) +(define q (ch (f-reg "[][?+*.$^()\\]"))) + (define choice (f-cons #:bracket (f-or! @@ -36,12 +39,12 @@ (.. c2 ((f-tag str) c)) (<p-cc> (cons (list tag (car c)) (cdr c)))))) -(mk-post q* "*" #:*) -(mk-post q? "?" #:?) -(mk-post q+ "+" #:+) -(mk-post q* "*?" #:*?) -(mk-post q? "??" #:??) -(mk-post q+ "+?" #:+?) +(mk-post q* "*" #:*) +(mk-post q? "?" #:?) +(mk-post q+ "+" #:+) +(mk-post q*? "*?" #:*?) +(mk-post q?? "??" #:??) +(mk-post q+? "+?" #:+?) (define q-or (<p-lambda> (c) @@ -53,12 +56,31 @@ (.. c2 ((f-tag "*") c)) (<p-cc> (cons (list #:* (car c)) (cdr c))))) +(define ee + (ff* (f-or! q+? q?? q*? q* q? q+ q-or choice subexpr f-. f-$ f-^ q))) + +#| +(define-syntax with + (syntax-rules () + ((_ a b c ((s v) . l) . code) + (let ((ss v)) + (syntax-parameterize + ((s (lambda (x) + (syntax-case x () + ((_ . l) + #'(ss . l)) + (_ + #'ss))))) + + (with a b c l . code)))) + ((_ a b c () . code) (<and> a b c . code)))) + (define group (lambda (f) (<p-lambda> (c1) (.. c2 (f '())) (with ((L (cons (cons I c2) L)) - (I (+ i 1))) + (I (+ I 1))) (<p-cc> (list #:list (#:append c1 c2))))))) (define group-name @@ -158,7 +180,7 @@ (let ((f (apply f-or! (map (lambda (x) (match x - ((#:ch (:class ch)) + ((#:ch (:class ch)) (get-class ch)) ((#:ch ch) (f-tag! ch)))) ch)))) @@ -216,9 +238,9 @@ (begin (yield m) (call-with-values cont lp)))))))))) - - - +|# + +(define (parse-reg str) (parse str ee)) |