(define-module (language python module re parser)
  #:use-module (parser stis-parser)
  #:export(parse-reg e-matcher))

(define-syntax-rule (mk n tag str) (define n (f-seq tag (f-tag str))))
(mk f-. #:dot  ".")
(mk f-^ #:^    "^")
(mk f-$ #:$    "$")
(mk q*  #:*    "*")
(mk q?  #:?    "?")
(mk q+  #:+    "+")
(mk q*? #:*?   "*?")
(mk q?? #:??   "??")
(mk q+? #:+?   "+?")

(define subexpr (f-list #:sub
                        (f-seq (f-tag "(")  (Ds ee) (f-tag ")"))))

(define f-back
  (f-or (f-list #:class (mk-token (f-reg! "[AZbBdDsSwntr]")))
        (mk-token (f-reg "."))))

(define anongroup (f-list #:?:  "(?:" (Ds ee) ")"))
(define namegroup (f-list #:?P< "(?P<" (mk-token (f+ (f-not! (f-reg "[> ]")))) ">" (Ds ee) ")"))
(define (ch not)
  (f-list #:ch
          (f-or! (f-seq (f-char #\\) f-back)
                 (mk-token (f-not! not)))))
(define number (mk-token (f+ (f-reg! "[0-9]")) string->number))
(define incant (f-list #:?P= "(?P=" (f-or! number
					   (mk-token (f+ (f-not! (f-reg "[) ]"))))) ")"))
(define coment  (f-seq "(?#" (f* (f-not (f-tag ")"))) ")"))
(define repn?   (f-list #:rep? "{" number "}" "?"))
(define repnm?  (f-list #:rep? "{" number "," number "}" "?"))
(define repn    (f-list #:rep  "{" number "}"))
(define repnm   (f-list #:rep  "{" number "," number "}"))

(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))
(define choice
  (f-cons #:bracket
          (f-or!
           (f-seq "[^]" (f-out (list (list #:ch (f-out #f) "^"))))
           (f-cons*
            (f-tag "[")
            (f-if (f-tag "^") (f-out #t) (f-out #f))
            bbody))))


(define f-bar  (f-tag "|"))
(define qq     (ch (f-reg "[][?+|*.$^() \\]")))
(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 )))
(define ee     (f-cons* #:or line (ff* (f-seq f-bar line))))

(define (parse-reg str) (parse str ee))

(define e-matcher ee)