Implement literal as a macro that chains unit

2 files changed, 17 insertions, 12 deletions

diff --git a/package.lisp b/package.lisp
index c352bd4..035cf77 100644
--- a/package.lisp
+++ b/package.lisp
@@ -4,6 +4,7 @@
            #:comp
            #:one-of
            #:unit
+           #:fail
            #:literal
            #:nothing
            #:optional
diff --git a/parser.lisp b/parser.lisp
index d22ae81..c627af1 100644
--- a/parser.lisp
+++ b/parser.lisp
@@ -40,10 +40,6 @@
                     :message (format nil "Didn't reach expected limit: ~a." limit))
       (make-parsing :tree tree :left input))))
 
-(defun fail (message)
-  (lambda (input &key limit lazy)
-    (make-failure :place input :message message)))
-
 (defun bind (p f &key (greedy t))
   (lambda (input &key limit lazy)
     (let (r)
@@ -127,6 +123,10 @@
                              result))))
       (one-of-rec (cons first-parser (cons second-parser other-parsers))))))
 
+(defun fail (message)
+  (lambda (input &key limit lazy)
+    (make-failure :place input :message message)))
+
 (defmacro unit (&optional predicate)
   (cond ((null predicate)
          (setf predicate '(characterp it)))
@@ -151,14 +151,18 @@
                            :message (format nil "Expected: ~a, Got: ~a" ',predicate it))))
          (make-failure :place input :message "Reached end of input.")))))
 
-(defun literal (target)
-  (lambda (input &key limit lazy)
-    (declare (ignore lazy limit))
-    (if (has-data? input)
-      (if (prefix? target input)
-        (make-parsing :tree target :left (advance input (length target)))
-        (make-failure :place input :message "Predicate not satisfied."))
-      (make-failure :place input :message "Reached end of input."))))
+(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))