From 1d6874e060fce727616017f73149bef197f69d7b Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Juan=20Manuel=20Tom=C3=A1s?= Date: Tue, 6 Dec 2022 17:57:26 -0300 Subject: Fix lookahead input and introduce discarding bind --- input.lisp | 6 +++--- parser.lisp | 19 +++++++++++++------ 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 -- cgit v1.2.3