summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
authorJuan Manuel Tomás <jtomas1815@gmail.com>2024-10-13 03:52:47 -0300
committerJuan Manuel Tomás <jtomas1815@gmail.com>2024-10-13 03:52:47 -0300
commit6659f26d557d792a0bf3f596a0d87aa69a7f2317 (patch)
tree4d5dfedef0b55b7d594a283e8eb4be1b7793c41d
parent1af10ddc10e35805c6723d7a2a85d7e3768497f8 (diff)
downloadmonparser-6659f26d557d792a0bf3f596a0d87aa69a7f2317.tar.gz
monparser-6659f26d557d792a0bf3f596a0d87aa69a7f2317.zip
Improve safety based on json parser tests
-rw-r--r--base.lisp49
-rw-r--r--core.lisp14
-rw-r--r--extra.lisp3
3 files changed, 36 insertions, 30 deletions
diff --git a/base.lisp b/base.lisp
index 8206322..2a80086 100644
--- a/base.lisp
+++ b/base.lisp
@@ -15,37 +15,38 @@
(defun new (tree)
(lambda (input &key limit lazy)
- (declare (ignore lazy))
- (if (and limit (> limit 0))
- (make-failure :place input
- :message (format nil "Didn't reach expected limit: ~a." limit))
- (make-parsing :tree tree :left input))))
+ (declare (ignore limit lazy))
+ (make-parsing :tree tree :left input)))
-(defun bind (p f &key (greedy t))
+(defun bind (parser f &key (greedy t))
(lambda (input &key limit lazy)
(let (r)
(if greedy
- (setf r (funcall p input :limit limit))
+ (setf r (funcall parser input :limit limit))
(let ((next-parser (funcall f nil input))
- (limit -1))
+ (inner-limit -1))
(do ((sweep-input input (advance sweep-input)))
((or (not (has-data? sweep-input))
- (> limit -1)) nil)
+ (and limit (> (cursor-distance sweep-input input) limit))
+ (> inner-limit -1)) nil)
(when (lazy-parsing-p (funcall next-parser sweep-input :lazy t))
- (setf limit (cursor-distance sweep-input input))))
- (if (< limit 0)
+ (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 p input :limit limit)))))
- (if (parsing-p r)
- (if lazy
- (lambda (ignored-input &key lazy limit)
- (declare (ignore ignored-input limit))
- (funcall (funcall f (parsing-tree r) input)
- (parsing-left r)
- :lazy lazy
- :limit (if greedy (parsing-limit r))))
- (funcall (funcall f (parsing-tree r) input)
- (parsing-left r)
- :limit (if greedy (parsing-limit r))))
- r))))
+ (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)))))))
diff --git a/core.lisp b/core.lisp
index d0955fe..3d3f4e8 100644
--- a/core.lisp
+++ b/core.lisp
@@ -11,11 +11,15 @@
(setf predicate `(,predicate it)))
((characterp predicate)
(setf predicate `(char-equal ,predicate it)))
- (t (setf predicate
+ ((listp predicate)
+ (if (eq (car predicate) 'function)
+ (setf predicate `(funcall ,predicate it))
+ (setf predicate
(nsubst-if 'it
(lambda (x)
(and (symbolp x)
(string-equal (symbol-name x) "IT"))) predicate))))
+ (t (error (format nil "Invalid predicate: ~a." predicate))))
`(lambda (input &key limit lazy)
(declare (ignore lazy))
(if (and limit (<= limit 0))
@@ -33,7 +37,8 @@
(declare (ignore lazy))
(labels ((one-of-rec (parsers)
(let ((intermediate-parsers '())
- (result nil))
+ (result (make-failure :place input
+ :message "Exhausted options.")))
(dolist (p parsers)
(let ((r (funcall p
input
@@ -48,8 +53,9 @@
(setf result r)))
((failure-p r)
(when (or (failure-p result)
- (= (length parsers) 1))
- (setf result r))))))
+ (= (length parsers) 1))
+ (setf result r)))
+ (t (error (format nil "Invalid return value: ~a" r))))))
(if intermediate-parsers
(one-of-rec intermediate-parsers)
result))))
diff --git a/extra.lisp b/extra.lisp
index 916465b..2963e94 100644
--- a/extra.lisp
+++ b/extra.lisp
@@ -41,8 +41,7 @@
(some (lambda (y) (char= x y)) '(#\Space #\Newline #\Tab)))
(defparameter whitespace
- (comp ((_ (optional (many (unit whitespace?)))))
- :whitespace))
+ (comp ((_ (optional (many (unit whitespace?)))))))
(defun separated-list (p separator &key include-separator)
(comp ((v p)