(in-package #:monparser)

(defstruct parsing
  tree
  left
  limit)

(defstruct failure
  place
  message)

(defun lazy-parsing-p (r)
  (or (functionp r)
      (parsing-p r)))

(defun new (tree)
  (lambda (input &key limit lazy)
    (declare (ignore limit lazy))
    (make-parsing :tree tree :left input)))

(defun bind (parser f &key (greedy t))
  (lambda (input &key limit lazy)
    (let (r)
      (if greedy
        (setf r (funcall parser input :limit limit))
        (let ((next-parser (funcall f nil input))
              (inner-limit -1))
          (do ((sweep-input input (advance sweep-input)))
            ((or (not (has-data? sweep-input))
                 (and limit (> (cursor-distance sweep-input input) limit))
                 (> inner-limit -1)) nil)
            (when (lazy-parsing-p (funcall next-parser sweep-input :lazy t))
              (setf inner-limit (cursor-distance sweep-input input))
              (when limit (decf limit inner-limit))))
          (if (< inner-limit 0)
            (setf r (make-failure :place input
                                  :message "Reached end of input while sweeping."))
            (setf r (funcall parser input :limit inner-limit)))))
      (cond ((parsing-p r)
             (if lazy
               (lambda (ignored-input &key lazy limit)
                 (declare (ignore ignored-input))
                 (funcall (funcall f (parsing-tree r) input)
                          (parsing-left r)
                          :lazy lazy
                          :limit (if greedy (parsing-limit r) limit)))
               (funcall (funcall f (parsing-tree r) input)
                        (parsing-left r)
                        :limit (if greedy (parsing-limit r) limit))))
            ((failure-p r)
             r)
            (t (error (format nil "Invalid return value: ~a" r)))))))