(implicit parsepos*)
(implicit parsefail*)

(def parsefail ()
  (parsefail*))

; failfn must be called *outside* the w/parsefail* scope,
; thus the code to pass the normal/fail result of calling f
; out through the w/parsefail*

(def fonparsefail (failfn f)
  (with (return-value nil failed nil)
    (catch
     (w/parsefail* (fn () (set failed) (throw nil))
       (= return-value (f))))
    (if failed (failfn) return-value)))

(mac on-parsefail (onfail . body)
  `(fonparsefail (fn () ,onfail) (fn () ,@body)))

(def fparse (seq body)
  (on-parsefail nil
    (w/parsepos* (if (isa seq 'string) (coerce seq 'cons) seq)
      (body))))

(mac parse (s . body)
  `(fparse ,s (fn () ,@body)))

(def rest ()
  parsepos*)

(def at-end ()
  (no parsepos*))

(def fail-at-end ()
  (if (at-end) (parsefail)))

(def match (item)
  (fail-at-end)
  (let v car.parsepos*
    (if ((testify item) v)
         (do (= parsepos* cdr.parsepos*) v)
         (parsefail))))

(def literal (pat (o value pat))
  (if (begins parsepos* (if (isa pat 'string) (coerce pat 'cons) pat))
       (do (= parsepos* (nthcdr len.pat parsepos*))
           value)
       (parsefail)))

(def falt2 (f1 f2)
  (let mark parsepos*
    (on-parsefail
     (do (= parsepos* mark)
         (f2))
     (f1))))

(mac alt2 (p1 p2)
  `(falt2 (fn () ,p1) (fn () ,p2)))

(mac alt ps
  (if (no ps)
       `(parsefail)
      (no (cdr ps))
       (car ps)
       `(alt2 ,(car ps) (alt ,@(cdr ps)))))

(mac optional body
  `(alt (do ,@body) nil))

(def fmany (fp)
  (accum a
    (on-parsefail nil        
      (xloop ()
        (a (fp))
        (next)))))

(mac many body
  `(fmany (fn () ,@body)))

(mac many1 parser
  `(cons (do ,@parser) (many (do ,@parser))))

(mac must (errmsg . body)
  `(on-parsefail (err ,errmsg) (do ,@body)))

(def munch (f)
  (fail-at-end)
  (let v car.parsepos*
    (= parsepos* cdr.parsepos*)
    (f v)))

(mac parse-intersperse (separator parser must-message)
  `(optional
    (cons ,parser
          (many ,separator
                (must ,must-message ,parser)))))

(def skipwhite ()
  (many (match whitec)))

(mac comma-separated (must-message parser)
  `(parse-intersperse
    (do (skipwhite) (match #\,))
    ,parser
    ,must-message))