summaryrefslogtreecommitdiff
path: root/core.lisp
diff options
context:
space:
mode:
authorJuan Manuel Tomás <jtomas1815@gmail.com>2025-06-06 01:13:58 -0300
committerJuan Manuel Tomás <jtomas1815@gmail.com>2025-06-06 01:13:58 -0300
commit66e85e52ec8ef84275e2051a5ed2ab0e7c6cbea3 (patch)
treedc1d28266149dc66947132d21df5b311af6836f7 /core.lisp
parent053deeeb7ed42cd6cde5c3959c3a446fd1fd4674 (diff)
downloadmonparser-66e85e52ec8ef84275e2051a5ed2ab0e7c6cbea3.tar.gz
monparser-66e85e52ec8ef84275e2051a5ed2ab0e7c6cbea3.zip
Reduce generated code size on one-of
Diffstat (limited to 'core.lisp')
-rw-r--r--core.lisp49
1 files changed, 25 insertions, 24 deletions
diff --git a/core.lisp b/core.lisp
index 4ba3cd7..9bda418 100644
--- a/core.lisp
+++ b/core.lisp
@@ -30,33 +30,34 @@
:message (format nil "Expected: ~a, Got: ~a" ',predicate it))))
(make-failure :place input :message "Reached end of input."))))
+(defun lazily-select-parser (input parsers)
+ (let ((intermediate-parsers '())
+ (result (make-failure :place input
+ :message "Exhausted options.")))
+ (dolist (p parsers)
+ (let ((r (funcall p
+ input
+ :lazy (> (length parsers) 1))))
+ (cond ((functionp r)
+ (push r intermediate-parsers))
+ ((parsing-p r)
+ (when (or (not (parsing-p result))
+ (> (input-cursor (parsing-left r))
+ (input-cursor (parsing-left result))))
+ (setf result r)))
+ ((failure-p r)
+ (when (or (failure-p result)
+ (= (length parsers) 1))
+ (setf result r)))
+ (t (error (format nil "Invalid return value: ~a" r))))))
+ (if intermediate-parsers
+ (lazily-select-parser input intermediate-parsers)
+ result)))
+
(defmacro one-of (first-parser second-parser &rest other-parsers)
`(lambda (input &key lazy)
(declare (ignore lazy))
- (labels ((one-of-rec (parsers)
- (let ((intermediate-parsers '())
- (result (make-failure :place input
- :message "Exhausted options.")))
- (dolist (p parsers)
- (let ((r (funcall p
- input
- :lazy (> (length parsers) 1))))
- (cond ((functionp r)
- (push r intermediate-parsers))
- ((parsing-p r)
- (when (or (not (parsing-p result))
- (> (input-cursor (parsing-left r))
- (input-cursor (parsing-left result))))
- (setf result r)))
- ((failure-p r)
- (when (or (failure-p result)
- (= (length parsers) 1))
- (setf result r)))
- (t (error (format nil "Invalid return value: ~a" r))))))
- (if intermediate-parsers
- (one-of-rec intermediate-parsers)
- result))))
- (one-of-rec (list ,first-parser ,second-parser ,@other-parsers)))))
+ (lazily-select-parser input (list ,first-parser ,second-parser ,@other-parsers))))
(defmacro comp (bindings &body body)
(if (null bindings)