From 688ade34430eb1d4d205698cae810c35c8f44d21 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Juan=20Manuel=20Tom=C3=A1s?= Date: Fri, 8 Nov 2024 15:06:17 -0300 Subject: Turn bind and one-of into macros to avoid eagerly evaluating arguments --- base.lisp | 30 +++++++++++++++--------------- core.lisp | 54 +++++++++++++++++++++++++++--------------------------- package.lisp | 1 + 3 files changed, 43 insertions(+), 42 deletions(-) diff --git a/base.lisp b/base.lisp index 61c47bc..bbfab80 100644 --- a/base.lisp +++ b/base.lisp @@ -13,18 +13,18 @@ (declare (ignore lazy)) (make-parsing :tree tree :left input))) -(defun bind (parser f) - (lambda (input &key lazy) - (let ((r (funcall parser input))) - (cond ((parsing-p r) - (if lazy - (lambda (ignored-input &key lazy) - (declare (ignore ignored-input)) - (funcall (funcall f (parsing-tree r) input) - (parsing-left r) - :lazy lazy)) - (funcall (funcall f (parsing-tree r) input) - (parsing-left r)))) - ((failure-p r) - r) - (t (error (format nil "Invalid return value: ~a" r))))))) +(defmacro bind (parser f) + `(lambda (input &key lazy) + (let ((r (funcall ,parser input))) + (cond ((parsing-p r) + (if lazy + (lambda (ignored-input &key lazy) + (declare (ignore ignored-input)) + (funcall (funcall ,f (parsing-tree r) input) + (parsing-left r) + :lazy lazy)) + (funcall (funcall ,f (parsing-tree r) input) + (parsing-left r)))) + ((failure-p r) + r) + (t (error (format nil "Invalid return value: ~a" r))))))) diff --git a/core.lisp b/core.lisp index 2870f7b..4ba3cd7 100644 --- a/core.lisp +++ b/core.lisp @@ -30,33 +30,33 @@ :message (format nil "Expected: ~a, Got: ~a" ',predicate it)))) (make-failure :place input :message "Reached end of input.")))) -(defun 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 (cons first-parser (cons second-parser other-parsers)))))) +(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))))) (defmacro comp (bindings &body body) (if (null bindings) diff --git a/package.lisp b/package.lisp index bd3f17b..cf3f1df 100644 --- a/package.lisp +++ b/package.lisp @@ -15,6 +15,7 @@ #:optional #:many #:repeat + #:whitespace? #:whitespace #:separated-list #:surround)) -- cgit v1.2.3