diff options
| -rw-r--r-- | input.lisp | 10 | ||||
| -rw-r--r-- | package.lisp | 12 | ||||
| -rw-r--r-- | parser.lisp | 46 |
3 files changed, 55 insertions, 13 deletions
@@ -18,11 +18,21 @@ (input-cursor input) (+ window-size (input-cursor input)))) +(defun peek-rest (input) + (subseq (input-data input) + (input-cursor input) + (length (input-data input)))) + (defun advance (input &optional (amount 1)) (let ((new-input (copy-structure input))) (incf (input-cursor new-input) amount) new-input)) +(defun advance-to-end (input) + (let ((new-input (copy-structure input))) + (setf (input-cursor new-input) (length (input-data input))) + new-input)) + (declaim (ftype (function (simple-string) (values input &optional)) from-string)) (defun from-string (str) (make-input :data str)) diff --git a/package.lisp b/package.lisp index 8656c7c..45e8266 100644 --- a/package.lisp +++ b/package.lisp @@ -6,13 +6,15 @@ (defpackage #:parser (:use #:cl) (:export #:run - #:new - #:bind #:fail #:either #:unit + #:not-unit + #:unit-if + #:literal + #:until-literal #:comp #:nothing - #:zero-or-one - #:zero-or-more - #:one-or-more)) + #:optional + #:many + #:separated-list)) diff --git a/parser.lisp b/parser.lisp index 989938b..a92355c 100644 --- a/parser.lisp +++ b/parser.lisp @@ -51,7 +51,25 @@ (funcall (car body) input)))) (either-rec (cons first-parser (cons second-parser other-parsers)))))) -(defun unit (&optional (predicate #'characterp)) +(defun unit (predicate) + (lambda (input) + (if (input::has-data? input) + (let ((c (input::peek-1 input))) + (if (char= c predicate) + (make-parsing :tree c :left (input::advance input)) + (make-normal-failure :place input :message "Predicate not satisfied."))) + (make-normal-failure :place input :message "Reached end of input.")))) + +(defun not-unit (predicate) + (lambda (input) + (if (input::has-data? input) + (let ((c (input::peek-1 input))) + (if (char/= c predicate) + (make-parsing :tree c :left (input::advance input)) + (make-normal-failure :place input :message "Predicate not satisfied."))) + (make-normal-failure :place input :message "Reached end of input.")))) + +(defun unit-if (&optional (predicate #'characterp)) (lambda (input) (if (input::has-data? input) (let ((c (input::peek-1 input))) @@ -60,15 +78,25 @@ (make-normal-failure :place input :message "Predicate not satisfied."))) (make-normal-failure :place input :message "Reached end of input.")))) -(defun literal (str) +(defun literal (predicate) (lambda (input) - (if (input::has-data? input (length str)) - (let ((c (input::peek-n input (length str)))) - (if (string= str c) + (if (input::has-data? input (length predicate)) + (let ((c (input::peek-n input (length predicate)))) + (if (string= predicate c) (make-parsing :tree c :left (input::advance input (length c))) (make-normal-failure :place input :message "Predicate not satisfied."))) (make-normal-failure :place input :message "Reached end of input.")))) +(defun until-literal (predicate) + (lambda (input) + (let ((c (search predicate (input::input-data input) :start2 (input::input-cursor input)))) + (if c + (let ((window (- c (input::input-cursor input)))) + (if (> window 0) + (make-parsing :tree (input::peek-n input window) :left (input::advance input window)) + (make-failure :place input :message "Predicate not satisfied."))) + (make-parsing :tree (input::peek-rest input) :left (input::advance-to-end input)))))) + (defmacro comp (bindings &body body) (if (null bindings) `(new (progn ,@body)) @@ -89,11 +117,13 @@ (xs (optional (many p)))) (cons x xs))) -(defun separated-list (p separator) +(defun separated-list (p separator &key (include-separator nil)) (comp ((v p) - (sep (optional (the-char separator))) + (sep (optional separator)) (vn (if sep (either (separated-list p separator) (fail "Value expected.")) nothing))) - (cons v vn))) + (if include-separator + (cons v (cons sep vn)) + (cons v vn)))) |