Change project file structure and api

1 files changed, 0 insertions, 214 deletions

diff --git a/parser.lisp b/parser.lisp
deleted file mode 100644
index c627af1..0000000
--- a/parser.lisp
+++ /dev/null
@@ -1,214 +0,0 @@
-(in-package #:monparser)
-
-(defun parse-string (p input)
-  (let ((result (funcall p (from-string input))))
-    (if (parsing-p result)
-      (parsing-tree result)
-      result)))
-
-(defun parse-file (p input)
-  (let ((result (funcall p (from-file input))))
-    (if (parsing-p result)
-      (parsing-tree result)
-      result)))
-
-(defstruct parsing
-  tree
-  left
-  limit)
-
-(defun lazy-parsing-p (r)
-  (or (functionp r)
-      (parsing-p r)))
-
-(defstruct failure
-  place
-  message)
-
-(defmethod print-object ((obj failure) stream)
-  (let ((file (file (failure-place obj))))
-    (if file
-      (multiple-value-bind (line column) (line-and-column (failure-place obj))
-        (format stream "~a:~a:~a: ~a" line column file (failure-message obj)))
-      (format stream "~a: ~a" (cursor (failure-place obj)) (failure-message obj)))))
-
-(defun new (tree)
-  (lambda (input &key limit lazy)
-    (declare (ignore lazy))
-    (if (and limit (> limit 0))
-      (make-failure :place input
-                    :message (format nil "Didn't reach expected limit: ~a." limit))
-      (make-parsing :tree tree :left input))))
-
-(defun bind (p f &key (greedy t))
-  (lambda (input &key limit lazy)
-    (let (r)
-      (if greedy
-        (setf r (funcall p input :limit limit))
-        (let ((next-parser (funcall f nil input))
-              (limit -1))
-          (do ((sweep-input input (advance sweep-input)))
-            ((or (not (has-data? sweep-input))
-                 (> limit -1)) nil)
-            (when (lazy-parsing-p (funcall next-parser sweep-input :lazy t))
-              (setf limit (input-sub sweep-input input))))
-          (if (< limit 0)
-            (setf r (make-failure :place input
-                                  :message "Reached end of input while sweeping."))
-            (setf r (funcall p input :limit limit)))))
-      (if (parsing-p r)
-        (if lazy
-          (lambda (ignored-input &key lazy limit)
-            (declare (ignore ignored-input limit))
-            (funcall (funcall f (parsing-tree r) input)
-                     (parsing-left r)
-                     :lazy lazy
-                     :limit (if greedy (parsing-limit r))))
-          (funcall (funcall f (parsing-tree r) input)
-                   (parsing-left r)
-                   :limit (if greedy (parsing-limit r))))
-      r))))
-
-(defmacro comp (bindings &body body)
-  (if (null bindings)
-    `(new (progn ,@body))
-    (let ((var (first (car bindings)))
-          (parser (second (car bindings)))
-          (lazy (third (car bindings)))
-          (unused (gensym)))
-      (if (symbolp var)
-        (if (string= (symbol-name var) "_")
-          `(bind ,parser
-                 (lambda (&rest ,unused)
-                   (declare (ignore ,unused))
-                   (comp ,(cdr bindings) ,@body))
-                 :greedy ,(not lazy))
-          `(bind ,parser
-                 (lambda (,var &rest ,unused)
-                   (declare (ignore ,unused))
-                   (comp ,(cdr bindings) ,@body))
-                 :greedy ,(not lazy)))
-        (if (and (consp var) (symbolp (car var)) (symbolp (cdr var)))
-          `(bind ,parser
-                 (lambda (,(car var) ,(cdr var) &rest ,unused)
-                   (declare (ignore ,unused))
-                   (comp ,(cdr bindings) ,@body))
-                 :greedy ,(not lazy))
-          (error "Binding must be either a symbol or a cons of symbols."))))))
-
-(defun one-of (first-parser second-parser &rest other-parsers)
-  (lambda (input &key limit lazy)
-    (declare (ignore lazy))
-    (labels ((one-of-rec (parsers)
-                         (let ((intermediate-parsers '())
-                               (result nil))
-                           (dolist (p parsers)
-                             (let ((r (funcall p
-                                               input
-                                               :lazy (> (length parsers) 1)
-                                               :limit limit)))
-                               (cond ((functionp r)
-                                      (push r intermediate-parsers))
-                                     ((parsing-p r)
-                                      (when (or (not (parsing-p result))
-                                                (> (cursor (parsing-left r))
-                                                   (cursor (parsing-left result))))
-                                        (setf result r)))
-                                     ((failure-p r)
-                                      (when (or (failure-p result)
-                                                 (= (length parsers) 1))
-                                        (setf result r))))))
-                           (if intermediate-parsers
-                             (one-of-rec intermediate-parsers)
-                             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)))
-        ((symbolp predicate)
-         (setf predicate `(,predicate it)))
-        ((characterp predicate)
-         (setf predicate `(char-equal ,predicate it)))
-        (t (setf predicate
-                 (nsubst-if 'it
-                            (lambda (x)
-                              (and (symbolp x)
-                                   (string-equal (symbol-name x) "IT"))) predicate))))
-  `(lambda (input &key limit lazy)
-     (declare (ignore lazy))
-     (if (and limit (<= limit 0))
-       (make-failure :place input :message "Reached established limit.")
-       (if (has-data? input)
-         (let ((it (peek input)))
-           (if ,predicate
-             (make-parsing :tree it :left (advance input) :limit (if limit (1- limit)))
-             (make-failure :place input
-                           :message (format nil "Expected: ~a, Got: ~a" ',predicate it))))
-         (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))
-
-(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)))