diff options
| -rw-r--r-- | input.lisp | 20 | ||||
| -rw-r--r-- | package.lisp | 10 | ||||
| -rw-r--r-- | parser.lisp | 97 |
3 files changed, 62 insertions, 65 deletions
@@ -9,30 +9,18 @@ (<= (+ window-size (input-cursor input)) (length (input-data input)))) -(defun peek-1 (input) +(defun prefix? (target input) + (string= target (input-data input) :start2 (input-cursor input) :end2 (+ (input-cursor input) (length target)))) + +(defun peek (input) (char (input-data input) (input-cursor input))) -(defun peek-n (input window-size) - (subseq (input-data input) - (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 45e8266..50ce3df 100644 --- a/package.lisp +++ b/package.lisp @@ -7,13 +7,15 @@ (:use #:cl) (:export #:run #:fail - #:either + #:comp + #:one-of + #:all-of + #:negate + #:unit-if #:unit #:not-unit - #:unit-if #:literal - #:until-literal - #:comp + #:not-literal #:nothing #:optional #:many diff --git a/parser.lisp b/parser.lisp index a92355c..55ded57 100644 --- a/parser.lisp +++ b/parser.lisp @@ -36,81 +36,88 @@ (funcall q (parsing-left r)) r)))) +(defmacro comp (bindings &body body) + (if (null bindings) + `(new (progn ,@body)) + (let ((v (first (car bindings))) + (p (second (car bindings)))) + (if (string= (symbol-name v) "_") + `(discarding-bind ,p (comp ,(cdr bindings) ,@body)) + `(bind ,p (lambda (,v) (comp ,(cdr bindings) ,@body))))))) + (defun fail (&optional (message "Unknown error.")) (lambda (input) (make-critical-failure :place input :message message))) -(defun either (first-parser second-parser &rest other-parsers) +(defun one-of (first-parser second-parser &rest other-parsers) (lambda (input) - (labels ((either-rec (body) + (labels ((one-of-rec (body) (if (cdr body) (let ((r (funcall (car body) input))) (if (normal-failure-p r) - (either-rec (cdr body)) + (one-of-rec (cdr body)) r)) (funcall (car body) input)))) - (either-rec (cons first-parser (cons second-parser other-parsers)))))) + (one-of-rec (cons first-parser (cons second-parser other-parsers)))))) -(defun unit (predicate) +(defun all-of (first-parser second-parser &rest other-parsers) (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.")))) + (labels ((all-of-rec (body) + (if (cdr body) + (let ((r (funcall (car body) input))) + (if (parsing-p r) + (all-of-rec (cdr body)) + r)) + (funcall (car body) input)))) + (all-of-rec (cons first-parser (cons second-parser other-parsers)))))) -(defun not-unit (predicate) +(defun negate (p) (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.")))) + (let ((r (funcall p input))) + (cond ((parsing-p r) + (make-normal-failure :place input :message "Negated parser result.")) + ((normal-failure-p r) + (make-parsing :tree nil :left input)) + (t r))))) (defun unit-if (&optional (predicate #'characterp)) (lambda (input) (if (input::has-data? input) - (let ((c (input::peek-1 input))) + (let ((c (input::peek input))) (if (funcall predicate c) (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 literal (predicate) - (lambda (input) - (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 unit (target) + (unit-if (lambda (x) (char= x target)))) + +(defun not-unit (target) + (unit-if (lambda (x) (char/= x target)))) -(defun until-literal (predicate) +(defun literal (target) (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)))))) + (if (input::has-data? input (length target)) + (if (input::prefix? target input) + (make-parsing :tree target :left (input::advance input (length target))) + (make-normal-failure :place input :message "Predicate not satisfied.")) + (make-normal-failure :place input :message "Not enough data.")))) -(defmacro comp (bindings &body body) - (if (null bindings) - `(new (progn ,@body)) - (let ((v (first (car bindings))) - (p (second (car bindings)))) - (if (eq v '_) - `(discarding-bind ,p (comp ,(cdr bindings) ,@body)) - `(bind ,p (lambda (,v) (comp ,(cdr bindings) ,@body))))))) +(defun not-literal (target) + (lambda (input) + (if (input::has-data? input (length target)) + (if (input::prefix? target input) + (make-normal-failure :place input :message "Predicate not satisfied.") + (make-parsing :tree (input::peek input) :left (input::advance input))) + (if (input::has-data? input) + (make-parsing :tree (input::peek input) :left (input::advance input)) + (make-normal-failure :place input :message "Reached end of input."))))) (defparameter nothing (new nil)) (defun optional (p) - (either p nothing)) + (one-of p nothing)) (defun many (p) (comp ((x p) @@ -121,7 +128,7 @@ (comp ((v p) (sep (optional separator)) (vn (if sep - (either (separated-list p separator) + (one-of (separated-list p separator) (fail "Value expected.")) nothing))) (if include-separator |