From 6659f26d557d792a0bf3f596a0d87aa69a7f2317 Mon Sep 17 00:00:00 2001
From: =?UTF-8?q?Juan=20Manuel=20Tom=C3=A1s?= <jtomas1815@gmail.com>
Date: Sun, 13 Oct 2024 03:52:47 -0300
Subject: Improve safety based on json parser tests

---
 base.lisp  | 49 +++++++++++++++++++++++++------------------------
 core.lisp  | 14 ++++++++++----
 extra.lisp |  3 +--
 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)
-- 
cgit v1.2.3