summaryrefslogtreecommitdiff
diff options
context:
space:
mode:
-rw-r--r--input.lisp6
-rw-r--r--parser.lisp19
2 files changed, 16 insertions, 9 deletions
diff --git a/input.lisp b/input.lisp
index 4f803ec..1900459 100644
--- a/input.lisp
+++ b/input.lisp
@@ -6,8 +6,8 @@
(data nil :read-only t))
(defun has-data? (input &optional (window-size 1))
- (< (+ window-size -1 (input-cursor input))
- (length (input-data input))))
+ (<= (+ window-size (input-cursor input))
+ (length (input-data input))))
(defun peek-1 (input)
(char (input-data input)
@@ -16,7 +16,7 @@
(defun peek-n (input window-size)
(subseq (input-data input)
(input-cursor input)
- window-size))
+ (+ window-size (input-cursor input))))
(defun advance (input &optional (amount 1))
(let ((new-input (copy-structure input)))
diff --git a/parser.lisp b/parser.lisp
index a1ef1a8..2da9975 100644
--- a/parser.lisp
+++ b/parser.lisp
@@ -29,6 +29,13 @@
(funcall (funcall f (parsing-tree r)) (parsing-left r))
r))))
+(defun discarding-bind (p q)
+ (lambda (input)
+ (let ((r (funcall p input)))
+ (if (parsing-p r)
+ (funcall q (parsing-left r))
+ r))))
+
(defun fail (&optional (message "Unknown error."))
(lambda (input)
(make-critical-failure :place input :message message)))
@@ -53,12 +60,12 @@
(make-normal-failure :place input :message "Predicate not satisfied.")))
(make-normal-failure :place input :message "Reached end of input."))))
-(defun literal (predicate)
+(defun literal (str)
(lambda (input)
- (if (input::has-data? input (length predicate))
- (let ((str (input::peek-n input (length predicate))))
- (if (string= predicate str)
- (make-parsing :tree str :left (input::advance input (length predicate)))
+ (if (input::has-data? input (length str))
+ (let ((c (input::peek-n input (length str))))
+ (if (string= str 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."))))
@@ -68,7 +75,7 @@
(let ((v (first (car bindings)))
(p (second (car bindings))))
(if (eq v '_)
- `(bind ,p (lambda () (comp ,(cdr bindings) ,@body)))
+ `(discarding-bind ,p (comp ,(cdr bindings) ,@body))
`(bind ,p (lambda (,v) (comp ,(cdr bindings) ,@body)))))))
(defparameter nothing