diff options
| -rw-r--r-- | base.lisp | 16 | ||||
| -rw-r--r-- | main.lisp | 27 | ||||
| -rw-r--r-- | monparser.asd | 1 | ||||
| -rw-r--r-- | test.lisp | 9 |
4 files changed, 21 insertions, 32 deletions
@@ -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"))) @@ -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*)) |