diff options
author | Juan Manuel Tomás <jtomas1815@gmail.com> | 2024-10-13 00:34:11 -0300 |
---|---|---|
committer | Juan Manuel Tomás <jtomas1815@gmail.com> | 2024-10-13 00:34:11 -0300 |
commit | 7a6f4586c2e83ffcdb5a8b7b2c5591f6e80e038f (patch) | |
tree | 441e462d4145c95e4aad94c7e64b89ddca667e6c /extra.lisp | |
parent | b196a5d56db31d6836c1ed028f38146cbb08436c (diff) | |
download | monparser-7a6f4586c2e83ffcdb5a8b7b2c5591f6e80e038f.tar.gz monparser-7a6f4586c2e83ffcdb5a8b7b2c5591f6e80e038f.zip |
Change project file structure and api
Diffstat (limited to 'extra.lisp')
-rw-r--r-- | extra.lisp | 63 |
1 files changed, 63 insertions, 0 deletions
diff --git a/extra.lisp b/extra.lisp new file mode 100644 index 0000000..916465b --- /dev/null +++ b/extra.lisp @@ -0,0 +1,63 @@ +(in-package #:monparser) + +(defmacro literal (word) + (when (not (stringp word)) + (error "Literal only accepts strings as input.")) + (let ((binding-list '()) + (name-list '())) + (loop :for c :across word :do + (when c + (let ((name (gensym))) + (push name name-list) + (push `(,name (unit ,c)) binding-list)))) + `(comp ,(reverse binding-list) + (coerce ,(cons 'list (reverse name-list)) 'string)))) + +(defparameter nothing + (new nil)) + +(defun optional (p) + (one-of p nothing)) + +(defun many (p) + (comp ((x p) + (xs (if (not x) + (fail "Parsing result is empty.") + (optional (many p))))) + (cons x 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) + (some (lambda (y) (char= x y)) '(#\Space #\Newline #\Tab))) + +(defparameter whitespace + (comp ((_ (optional (many (unit whitespace?))))) + :whitespace)) + +(defun separated-list (p separator &key include-separator) + (comp ((v p) + (sep (optional separator)) + (vn (if sep + (separated-list p separator) + nothing))) + (if include-separator + (cons v (cons sep vn)) + (cons v vn)))) + +(defun surrounded (left p right &key include-surrounding) + (comp ((l left) + (body p :lazy) + (r right)) + (if include-surrounding + (list l body r) + body))) |