summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--core.lisp15
-rw-r--r--extra.lisp6
-rw-r--r--input.lisp17
-rw-r--r--main.lisp6
-rw-r--r--package.lisp1
5 files changed, 30 insertions, 15 deletions
diff --git a/core.lisp b/core.lisp
index 2cd0120..3b06936 100644
--- a/core.lisp
+++ b/core.lisp
@@ -1,5 +1,14 @@
(in-package #:monparser)
+(defun opposite (p)
+ (lambda (input &key lazy)
+ (let ((result (funcall p input)))
+ (cond ((parsing-p result)
+ (make-failure :place input :message "Unexpected match."))
+ ((failure-p result)
+ (make-parsing :tree nil :left input))
+ (t (error "Unexpected result type."))))))
+
(defun fail (message)
(lambda (input &key lazy)
(make-failure :place input :message message)))
@@ -28,7 +37,8 @@
(make-parsing :tree it :left (advance input))
(make-failure :place input
:message (format nil "Expected: ~a, Got: ~a" ',predicate it))))
- (make-failure :place input :message "Reached end of input."))))
+ (make-failure :place input
+ :message (format nil "Reached end of input. Expected: ~a" ',predicate)))))
(defun lazily-select-parser (input parsers)
(let ((intermediate-parsers '())
@@ -46,8 +56,7 @@
(input-cursor (parsing-left result))))
(setf result r)))
((failure-p r)
- (when (or (failure-p result)
- (= (length parsers) 1))
+ (when (failure-p result)
(setf result r)))
(t (error (format nil "Invalid return value: ~a" r))))))
(if intermediate-parsers
diff --git a/extra.lisp b/extra.lisp
index b738da7..9451ce8 100644
--- a/extra.lisp
+++ b/extra.lisp
@@ -21,10 +21,8 @@
(defun many (p)
(comp ((x p)
- (xs (if x
- (optional (many p))
- (fail "Parsing result is empty."))))
- (cons x xs)))
+ (xs (optional (many p))))
+ (if x (cons x xs) xs)))
(defun repeat (p min &optional (max 0))
(if (> min 0)
diff --git a/input.lisp b/input.lisp
index 55a72cb..5d6a162 100644
--- a/input.lisp
+++ b/input.lisp
@@ -28,10 +28,17 @@
(values line column)))
(defmethod print-object ((obj parser-input) stream)
- (let ((context-length 10))
+ (let ((context-length 20))
(let ((begin (max (- (input-cursor obj) context-length) 0))
(end (min (+ (input-cursor obj) context-length) (length (input-data obj)))))
- (format stream "...~a~a~a..."
- (substitute #\¶ #\Newline (subseq (input-data obj) begin (input-cursor obj)))
- (substitute #\¶ #\Newline (subseq (input-data obj) (input-cursor obj) (1+ (input-cursor obj))))
- (substitute #\¶ #\Newline (subseq (input-data obj) (1+ (input-cursor obj)) end))))))
+ (when (< 0 begin)
+ (format stream "..."))
+ (format stream "~a"
+ (substitute #\↲ #\Newline (subseq (input-data obj) begin (input-cursor obj))))
+ (if (< (input-cursor obj) (length (input-data obj)))
+ (format stream "~a~a"
+ (substitute #\↲ #\Newline (subseq (input-data obj) (input-cursor obj) (1+ (input-cursor obj))))
+ (substitute #\↲ #\Newline (subseq (input-data obj) (1+ (input-cursor obj)) end)))
+ (format stream "¬"))
+ (when (< end (length (input-data obj)))
+ (format stream "...")))))
diff --git a/main.lisp b/main.lisp
index c0fd49c..197f1b2 100644
--- a/main.lisp
+++ b/main.lisp
@@ -6,9 +6,9 @@
:data data))))
(if (parsing-p result)
(let ((finished? (not (has-data? (parsing-left result)))))
- (values (parsing-tree result) finished?))
- (error (format nil "~a" result)))))
+ (values result finished?))
+ result)))
(defmethod print-object ((obj failure) stream)
(multiple-value-bind (line column) (line-and-column (failure-place obj))
- (format stream "~a:~a: ~a" line column (failure-message obj))))
+ (format stream "~a:~a: ~a~&~a" line column (failure-message obj) (failure-place obj))))
diff --git a/package.lisp b/package.lisp
index 2b64c6f..a20934f 100644
--- a/package.lisp
+++ b/package.lisp
@@ -10,6 +10,7 @@
#:one-of
#:unit
#:fail
+ #:opposite
#:literal
#:nothing
#:optional