diff options
Diffstat (limited to 'core.lisp')
-rw-r--r-- | core.lisp | 49 |
1 files changed, 25 insertions, 24 deletions
@@ -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) |