summaryrefslogtreecommitdiff
path: root/extra.lisp
diff options
context:
space:
mode:
authorJuan Manuel Tomás <jtomas1815@gmail.com>2024-10-13 00:34:11 -0300
committerJuan Manuel Tomás <jtomas1815@gmail.com>2024-10-13 00:34:11 -0300
commit7a6f4586c2e83ffcdb5a8b7b2c5591f6e80e038f (patch)
tree441e462d4145c95e4aad94c7e64b89ddca667e6c /extra.lisp
parentb196a5d56db31d6836c1ed028f38146cbb08436c (diff)
downloadmonparser-7a6f4586c2e83ffcdb5a8b7b2c5591f6e80e038f.tar.gz
monparser-7a6f4586c2e83ffcdb5a8b7b2c5591f6e80e038f.zip
Change project file structure and api
Diffstat (limited to 'extra.lisp')
-rw-r--r--extra.lisp63
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)))