debuggings
[software/python-on-guile.git] / modules / language / python / module / re / parser.scm
1 (define-module (language python module re parser)
2 #:use-module (parser stis-parser)
3 #:export(parse-reg e-matcher))
4
5 (define-syntax-rule (mk n tag str) (define n (f-seq tag (f-tag str))))
6 (mk f-. #:dot ".")
7 (mk f-^ #:^ "^")
8 (mk f-$ #:$ "$")
9 (mk q* #:* "*")
10 (mk q? #:? "?")
11 (mk q+ #:+ "+")
12 (mk q*? #:*? "*?")
13 (mk q?? #:?? "??")
14 (mk q+? #:+? "+?")
15
16 (define subexpr (f-list #:sub
17 (f-seq (f-tag "(") (Ds ee) (f-tag ")"))))
18
19 (define f-back
20 (f-or (f-list #:class (mk-token (f-reg! "[AZbBdDsSwntr]")))
21 (mk-token (f-reg! "."))))
22
23 (define anongroup (f-list #:?: "(?:" (Ds ee) ")"))
24 (define namegroup (f-list #:?P< "(?P<" (mk-token (f+ (f-not! (f-reg "[> ]")))) ">" (Ds ee) ")"))
25 (define (ch not)
26 (f-list #:ch
27 (f-or! (f-seq (f-char #\\) f-back)
28 (mk-token (f-not! not)))))
29 (define number (mk-token (f+ (f-reg! "[0-9]")) string->number))
30 (define incant (f-list #:?P= "(?P=" (f-or! number
31 (mk-token (f+ (f-not! (f-reg "[) ]"))))) ")"))
32 (define coment (f-and
33 (f-seq "(?#" (f* (f-not (f-tag ")"))) ")")
34 f-true))
35 (define repn? (f-list #:rep? "{" number "}" "?"))
36 (define repnm? (f-list #:rep? "{" number "," number "}" "?"))
37 (define repn (f-list #:rep "{" number "}"))
38 (define repnm (f-list #:rep "{" number "," number "}"))
39
40 (define lookh (f-list #:?= "(?=" (Ds ee) ")"))
41 (define lookh! (f-list #:?! "(?!" (Ds ee) ")"))
42
43 (define rev (f-list #:?<= "(?<=" (Ds ee) ")"))
44 (define rev! (f-list #:?<! "(?<!" (Ds ee) ")"))
45 (define flags (f-list #:flags "(?"
46 (mk-token (f* (f-reg! "[aiLmsux]")))
47 (f-or!
48 (f-seq "-" (mk-token (f+ (f-reg! "[imsx]"))))
49 (f-out ""))
50 ":"
51 (Ds ee) ")"))
52 (define flags2 (f-list #:flags2 "(?"
53 (mk-token (f* (f-reg! "[aiLmsux]")))
54 ")"))
55
56 (define bbody (f-cons (f-or!
57 (f-list #:range (mk-token (f-reg! "."))
58 "-" (mk-token (f-reg! ".")))
59 (f-list #:ch (mk-token (f-reg! "."))))
60 (ff*
61 (f-or!
62 (f-list #:range (mk-token (f-not! (f-tag "]")))
63 "-"
64 (mk-token (f-not! (f-tag "]"))))
65 (f-list #:ch (mk-token (f-not! (f-tag "]"))))))))
66
67 (define (f-if a b c) (f-or! (f-seq a b) c))
68 (define choice
69 (f-cons #:bracket
70 (f-or!
71 (f-seq "[^]" (f-out (list (list #:ch (f-out #f) (f-out "^")))))
72 (f-cons*
73 (f-tag "[")
74 (f-if (f-tag "^") (f-out #t) (f-out #f))
75 (f-seq bbody "]")))))
76
77
78 (define f-bar (f-tag "|"))
79 (define qq (ch (f-reg "[][?+|*.$^()\\]")))
80 (define atom (f-or qq f-. flags2 choice subexpr anongroup namegroup incant coment
81 lookh lookh! rev rev! f-^ f-$ flags))
82 (define spec (f-list #:op atom (f-or! q+? q?? q*? q* q? q+ repn? repnm? repn repnm)))
83 (define aatom (f-or! spec atom))
84 (define f-com (f-seq (f-tag "#") (f* (f-not (f-or! f-eof f-nl)))))
85 (define ws (f* (f-or! f-com f-nl (f-reg "[ \t\r]"))))
86 (define line (f-cons* #:seq ws aatom ws (ff* (f-seq ws aatom ws) )))
87 (define ee (f-cons* #:or line (ff* (f-seq f-bar line))))
88 (define (parse-reg str)
89 (pk
90 (with-fluids ((*whitespace* ws))
91 (parse str (f-seq ee f-eof)))))
92
93 (define e-matcher ee)