Prepare for new tracing and tidy up testing

Main stuff was moved into base so that I can better incorporate
tracing in the future. I'm thinking it will involve modifying
new and bind.

4 files changed, 21 insertions, 32 deletions

diff --git a/base.lisp b/base.lisp
index 7c72501..5531562 100644
--- a/base.lisp
+++ b/base.lisp
@@ -18,6 +18,22 @@
 (deftype parser ()
   `(function (cursor) result))
 
+(declaim (ftype (function (parser string) result) parse))
+(defun parse (parser data)
+  (funcall parser (make-cursor :data data)))
+
+(defmacro defparser (name args parser)
+  (let ((message (format nil "In ~a:~&" name)))
+    (if (and (listp args) (every #'symbolp args))
+      (let (definition)
+        (when (= (length args) 0)
+          (push `(defparameter ,name (,name)) definition))
+        (push `(defun ,name (,@args) ,parser)
+              definition)
+        (push 'progn definition)
+        definition)
+      (error "Malformed argument list."))))
+
 (defmacro lazy (parser &rest args)
   (let ((input (gensym)))
     `(the parser
diff --git a/main.lisp b/main.lisp
deleted file mode 100644
index b557327..0000000
--- a/main.lisp
+++ /dev/null
@@ -1,27 +0,0 @@
-(in-package #:monparser)
-
-(declaim (ftype (function (parser string) result) parse))
-(defun parse (parser data)
-  (funcall parser (make-cursor :data data)))
-
-(declaim (ftype (function (parser string) parser) append-on-failure))
-(defun append-on-failure (p message)
-  (lambda (input)
-    (let ((result (funcall p input)))
-      (if (failure-p result)
-        (make-failure :place (result-place result)
-                      :message (concatenate 'string message (failure-message result))
-                      :priority (failure-priority result))
-        result))))
-
-(defmacro defparser (name args parser)
-  (let ((message (format nil "In ~a:~&" name)))
-    (if (and (listp args) (every #'symbolp args))
-      (let (definition)
-        (when (= (length args) 0)
-          (push `(defparameter ,name (,name)) definition))
-        (push `(defun ,name (,@args) (append-on-failure ,parser ,message))
-              definition)
-        (push 'progn definition)
-        definition)
-      (error "Malformed argument list."))))
diff --git a/monparser.asd b/monparser.asd
index f9ee915..ad7ce26 100644
--- a/monparser.asd
+++ b/monparser.asd
@@ -7,5 +7,4 @@
    (:file "base")
    (:file "core")
    (:file "extra")
-   (:file "main")
    (:file "test")))
diff --git a/test.lisp b/test.lisp
index 358ceb4..1d98702 100644
--- a/test.lisp
+++ b/test.lisp
@@ -8,7 +8,7 @@
     (format nil "~a" result)
     (format nil "~a" (parsing-tree result))))
 
-(defun check-result (actual expected input)
+(defun check-result (actual expected)
   (cond ((eq expected :failure)
          (or (failure-p actual)
              (progn
@@ -19,7 +19,7 @@
          (or (funcall expected actual)
              (progn
                (format t "~tFAIL: custom check failed~&")
-               (format t "~t~tInput: ~a~&" input)
+               (format t "~t~tInput: ~a~&" (result-place actual))
                (format t "~t~tResult: ~a~&" actual)
                (incf *test-failed*)
                nil)))
@@ -61,9 +61,10 @@
             (input (second test))
             (expected (third test)))
         (push `(let ((actual (parse ,parser ,input)))
-                 (if (check-result actual ,expected ,input)
+                 (if (check-result actual ,expected)
                    (incf *test-passed*)
-                   (incf *test-failed*))) test-forms)))
+                   (incf *test-failed*)))
+              test-forms)))
     (setf test-forms (nreverse test-forms))
     `(progn
        (let ((had-failures *test-failed*))