diff options
| -rw-r--r-- | package.lisp | 1 | ||||
| -rw-r--r-- | parser.lisp | 70 |
2 files changed, 40 insertions, 31 deletions
diff --git a/package.lisp b/package.lisp index deae22c..21662fd 100644 --- a/package.lisp +++ b/package.lisp @@ -2,7 +2,6 @@ (:use #:cl) (:export #:parse-file #:parse-string - #:crit #:comp #:one-of #:unit diff --git a/parser.lisp b/parser.lisp index ca13598..2fe6f67 100644 --- a/parser.lisp +++ b/parser.lisp @@ -28,31 +28,41 @@ (format stream "~a: ~a" (cursor (failure-place obj)) (failure-message obj))))) (defun new (tree) - (lambda (input) + (lambda (input &optional lazy) + (declare (ignore lazy)) (make-parsing :tree tree :left input))) (defun bind-with-input (p f) - (lambda (input) + (lambda (input &optional lazy) (let ((r (funcall p input))) (if (parsing-p r) - (funcall (the function (funcall f (parsing-tree r) input)) - (parsing-left r)) + (if lazy + (lambda (ignored-input &optional lazy) + (declare (ignore ignored-input)) + (funcall (funcall f (parsing-tree r) input) (parsing-left r) lazy)) + (funcall (funcall f (parsing-tree r) input) (parsing-left r))) r)))) (defun bind (p f) - (lambda (input) + (lambda (input &optional lazy) (let ((r (funcall p input))) (if (parsing-p r) - (funcall (the function (funcall f (parsing-tree r))) - (parsing-left r)) + (if lazy + (lambda (ignored-input &optional lazy) + (declare (ignore ignored-input)) + (funcall (funcall f (parsing-tree r)) (parsing-left r) lazy)) + (funcall (funcall f (parsing-tree r)) (parsing-left r))) r)))) (defun discarding-bind (p f) - (lambda (input) + (lambda (input &optional lazy) (let ((r (funcall p input))) (if (parsing-p r) - (funcall (the function (funcall f)) - (parsing-left r)) + (if lazy + (lambda (ignored-input &optional lazy) + (declare (ignore ignored-input)) + (funcall (funcall f) (parsing-left r) lazy)) + (funcall (funcall f) (parsing-left r))) r)))) (defmacro comp (bindings &body body) @@ -70,25 +80,23 @@ `(bind-with-input ,p (lambda (,(car v) ,(cdr v)) (comp ,(cdr bindings) ,@body))) (error "Binding name/(name,input) must be either a symbol or a cons of symbols.")))))) -(defun crit (p) - (lambda (input) - (let ((r (funcall p input))) - (if (parsing-p r) - r - (error (format nil "~a" r)))))) - (defun one-of (first-parser second-parser &rest other-parsers) - (lambda (input) - (labels ((one-of-rec (parsers failures) - (if (car parsers) - (let ((r (funcall (car parsers) input))) - (cond ((failure-p r) - (one-of-rec (cdr parsers) (cons r failures))) - ((listp r) - (one-of-rec (cdr parsers) (append r failures))) - (t r))) - failures))) - (one-of-rec (cons first-parser (cons second-parser other-parsers)) nil)))) + (lambda (input &optional lazy) + (declare (ignore lazy)) + (labels ((one-of-rec (parsers) + (let ((intermediate-parsers '()) + (result (make-failure :place input + :message "Exausted options."))) + (dolist (p parsers) + (let ((r (funcall p input (> (length parsers) 1)))) + (cond ((functionp r) + (push r intermediate-parsers)) + ((parsing-p r) + (setf result r))))) + (if intermediate-parsers + (one-of-rec intermediate-parsers) + result)))) + (one-of-rec (cons first-parser (cons second-parser other-parsers)))))) (defmacro unit (&optional predicate) (cond ((null predicate) @@ -102,7 +110,8 @@ (lambda (x) (and (symbolp x) (string-equal (symbol-name x) "IT"))) predicate)))) - `(lambda (input) + `(lambda (input &optional lazy) + (declare (ignore lazy)) (if (has-data? input) (let ((it (peek input))) (if ,predicate @@ -112,7 +121,8 @@ (make-failure :place input :message "Reached end of input.")))) (defun literal (target) - (lambda (input) + (lambda (input &optional lazy) + (declare (ignore lazy)) (if (has-data? input) (if (prefix? target input) (make-parsing :tree target :left (advance input (length target))) |