summaryrefslogtreecommitdiff
path: root/modules/language/python/module/re.scm
diff options
context:
space:
mode:
Diffstat (limited to 'modules/language/python/module/re.scm')
-rw-r--r--modules/language/python/module/re.scm52
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))