(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-and
                 (f-seq "(?#" (f* (f-not (f-tag ")"))) ")")
                 f-true))
(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 flags   (f-list #:flags "(?"
                        (mk-token (f* (f-reg! "[aiLmsux]")))
                        (f-or!
                         (f-seq "-" (mk-token (f+ (f-reg! "[imsx]"))))
                         (f-out ""))
                        ":"
                        (Ds ee) ")"))
(define flags2  (f-list #:flags2 "(?"
                        (mk-token (f* (f-reg! "[aiLmsux]")))
                        ")"))
(define (bch f) (f-or! (f-seq (f-or! (f-tag "\\n") f-nl)      
                              (f-out (list->string (list #\newline))))
                       f))
(define bbody (f-cons (f-or!
		       (f-list #:range (bch (mk-token (f-reg! ".")))
			       "-" (bch (mk-token (f-reg! "."))))
		       (f-list #:ch    (bch (mk-token (f-reg! ".")))))
		      (ff*
		       (f-or!
			(f-list #:range (bch (mk-token (f-not! (f-tag "]"))))
				"-"
				(bch (mk-token (f-not! (f-tag "]")))))
                        (f-seq (f-tag " ") (f-out (list #:ch " ")))
			(f-list #:ch (bch (mk-token (f-not! (f-tag "]")))))))))

(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-out "^")))))
           (f-cons*
            (f-tag "[")
            (f-if (f-tag "^") (f-out #t) (f-out #f))
            (f-seq bbody "]")))))


(define f-bar  (f-tag "|"))
(define qq     (ch (f-reg "[][?+|*.$^()\\]")))
(define atom   (f-or qq f-. flags2 choice subexpr anongroup namegroup incant coment
		     lookh lookh! rev rev! f-^ f-$ flags))
(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 f-com  (f-seq (f-tag "#") (f* (f-not (f-or! f-eof f-nl)))))
(define ws     (f* (f-or! f-com f-nl (f-reg "[ \t\r]"))))
(define line   (f-cons* #:seq ws aatom ws (ff* (f-seq ws aatom ws) )))
(define ee     (f-cons* #:or line (ff* (f-seq f-bar line))))
(define (parse-reg str)
  (pk
   (with-fluids ((*whitespace* ws))
     (parse str (f-seq ee f-eof)))))

(define e-matcher ee)