Introduce critical failure type

1 files changed, 10 insertions, 6 deletions

diff --git a/parser.lisp b/parser.lisp
index 30c68fd..04d3f2b 100644
--- a/parser.lisp
+++ b/parser.lisp
@@ -14,6 +14,10 @@
   place
   message)
 
+(defstruct (normal-failure (:include failure)))
+
+(defstruct (critical-failure (:include failure)))
+
 (defun new (tree)
   (lambda (input)
     (make-parsing :tree tree :left input)))
@@ -27,16 +31,16 @@
 
 (defun fail (&optional (message "Unknown error."))
   (lambda (input)
-    (make-failure :place input :message message)))
+    (make-critical-failure :place input :message message)))
 
 (defun either (first-parser &rest other-parsers)
   (lambda (input)
     (labels ((either-rec (body)
                          (if (cdr body)
                            (let ((r (funcall (car body) input)))
-                             (if (parsing-p r)
-                               r
-                               (either-rec (cdr body))))
+                             (if (normal-failure-p r)
+                               (either-rec (cdr body))
+                               r))
                            (funcall (car body) input))))
       (either-rec (cons first-parser other-parsers)))))
 
@@ -46,8 +50,8 @@
       (let ((c (input::element input)))
         (if (funcall predicate c)
           (make-parsing :tree c :left (input::advance input))
-          (make-failure :place input :message "Predicate not satisfied.")))
-      (make-failure :place input :message "Reached end of input."))))
+          (make-normal-failure :place input :message "Predicate not satisfied.")))
+      (make-normal-failure :place input :message "Reached end of input."))))
 
 (defmacro comp (bindings &body body)
   (if (null bindings)