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 +++++++++++++++++++++++++------------------------
 1 file changed, 25 insertions(+), 24 deletions(-)

(limited to 'base.lisp')

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)))))))
-- 
cgit v1.2.3