From 4d355a842737f7938d148c53338ce6f3fa055628 Mon Sep 17 00:00:00 2001 From: =?UTF-8?q?Juan=20Manuel=20Tom=C3=A1s?= Date: Sun, 15 Jun 2025 07:24:38 -0300 Subject: Make many into an iterative parser --- core.lisp | 51 +++++++++++++++++++++------------------------------ extra.lisp | 51 ++++++++++++++++----------------------------------- monparser.asd | 1 + package.lisp | 16 ++++++++++------ quant.lisp | 33 +++++++++++++++++++++++++++++++++ 5 files changed, 81 insertions(+), 71 deletions(-) create mode 100644 quant.lisp diff --git a/core.lisp b/core.lisp index 6e4bf6e..ac06a1f 100644 --- a/core.lisp +++ b/core.lisp @@ -30,37 +30,28 @@ (make-failure :place input :message (format nil "Reached end of input. Expected: ~a." ',predicate))))) -(defparameter end +(defun one-of (first-parser second-parser &rest other-parsers) (lambda (input) - (if (has-data? input) - (make-failure :place input :message "Didn't reach end of input.") - (make-parsing :tree nil :left input)))) - -(defun select-parser (input parsers) - (let ((result (make-failure :place input))) - (dolist (p parsers) - (let ((r (funcall p input))) - (cond ((parsing-p r) - (when (or (not (parsing-p result)) - (> (input-cursor (parsing-left r)) - (input-cursor (parsing-left result)))) - (setf result r))) - ((failure-p r) - (when (failure-p result) - (let ((priority-cmp (- (failure-priority r) - (failure-priority result)))) - (when (or (> priority-cmp 0) - (and (= priority-cmp 0) - (>= (input-cursor (failure-place r)) - (input-cursor (failure-place result))))) - (setf result r))))) - (t (error (format nil "Invalid return value: ~a." r)))))) - result)) - -(defmacro one-of (first-parser second-parser &rest other-parsers) - `(lambda (input) - (select-parser input - (list ,first-parser ,second-parser ,@other-parsers)))) + (let ((parsers `(,first-parser ,second-parser ,@other-parsers)) + (result (make-failure :place input))) + (dolist (p parsers) + (let ((r (funcall p input))) + (cond ((parsing-p r) + (when (or (not (parsing-p result)) + (> (input-cursor (parsing-left r)) + (input-cursor (parsing-left result)))) + (setf result r))) + ((failure-p r) + (when (failure-p result) + (let ((priority-cmp (- (failure-priority r) + (failure-priority result)))) + (when (or (> priority-cmp 0) + (and (= priority-cmp 0) + (>= (input-cursor (failure-place r)) + (input-cursor (failure-place result))))) + (setf result r))))) + (t (error (format nil "Invalid return value: ~a." r)))))) + result))) ;;; TODO: Find a way to be able to use the input without needing to define a name for it. (defmacro comp (bindings &body body) diff --git a/extra.lisp b/extra.lisp index 20a13b1..11e32f8 100644 --- a/extra.lisp +++ b/extra.lisp @@ -1,5 +1,12 @@ (in-package #:monparser) +(defun whitespace? (x) + (or (char= x #\Space) + (not (graphic-char-p x)))) + +(defparameter whitespace + (many (unit #'whitespace?))) + (defmacro literal (word) (when (not (stringp word)) (error "Literal only accepts strings as input.")) @@ -13,39 +20,13 @@ `(comp ,(reverse binding-list) ,(cons 'list (reverse name-list))))) -(defparameter nothing - (new nil)) - -(defun optional (p) - (one-of p nothing)) - -(defun many (p &key all) - (comp ((x p) - (xs (if all - (one-of end - (many p :all all)) - (optional (many p))))) - (if x (cons x xs) xs))) - -(defun repeat (p min &optional (max 0)) - (if (> min 0) - (comp ((x p) - (xs (repeat p (1- min) (1- max)))) - (cons x xs)) - (if (> max 0) - (comp ((x (optional p)) - (xs (repeat p 0 (if x (1- max) 0)))) - (if x (cons x xs) x)) - nothing))) - -(defun whitespace? (x) - (or (char= x #\Space) - (not (graphic-char-p x)))) - (defun separated-list (p separator) - (comp ((v p) - (sep (optional separator)) - (vn (if sep - (separated-list p separator) - nothing))) - (cons v vn))) + (many + (comp ((v p) + (_ (optional separator))) + v))) + +(defun surround (left p &optional right) + (comp ((_ left) + (value p) + (_ (or right nothing))))) diff --git a/monparser.asd b/monparser.asd index aa5bc2c..68165a9 100644 --- a/monparser.asd +++ b/monparser.asd @@ -5,5 +5,6 @@ (:file "input") (:file "base") (:file "core") + (:file "quant") (:file "extra") (:file "main"))) diff --git a/package.lisp b/package.lisp index e0a58e5..dca5908 100644 --- a/package.lisp +++ b/package.lisp @@ -5,15 +5,19 @@ #:failure-p #:failure-place #:failure-message - #:comp - #:one-of - #:unit + #:fail - #:end - #:literal + #:unit + #:one-of + #:comp + #:nothing #:optional #:many #:repeat + + #:literal #:whitespace? - #:separated-list)) + #:whitespace + #:separated-list + #:surround)) diff --git a/quant.lisp b/quant.lisp new file mode 100644 index 0000000..bdd0cfc --- /dev/null +++ b/quant.lisp @@ -0,0 +1,33 @@ +(in-package #:monparser) + +(defparameter nothing + (new nil)) + +(defun optional (p) + (one-of p nothing)) + +(defun many (p &key all) + (lambda (input) + (let* ((result '()) + (last-failure + (do ((r (funcall p input) (funcall p input))) ((failure-p r) r) + (when (parsing-p r) + (setf input (parsing-left r)) + (when (parsing-tree r) + (push (parsing-tree r) result)))))) + (if (or (not result) + (and result all (has-data? (failure-place last-failure)))) + (make-failure :place input :message (failure-message last-failure)) + (make-parsing :tree (reverse result) :left input))))) + +; TODO: Need to be redone in a non-recursive way +(defun repeat (p min &optional (max 0)) + (if (> min 0) + (comp ((x p) + (xs (repeat p (1- min) (1- max)))) + (cons x xs)) + (if (> max 0) + (comp ((x (optional p)) + (xs (repeat p 0 (if x (1- max) 0)))) + (if x (cons x xs) x)) + nothing))) -- cgit v1.2.3