Change project file structure and api

8 files changed, 228 insertions, 260 deletions

diff --git a/base.lisp b/base.lisp
new file mode 100644
index 0000000..8206322
--- /dev/null
+++ b/base.lisp
@@ -0,0 +1,51 @@
+(in-package #:monparser)
+
+(defstruct parsing
+  tree
+  left
+  limit)
+
+(defstruct failure
+  place
+  message)
+
+(defun lazy-parsing-p (r)
+  (or (functionp r)
+      (parsing-p r)))
+
+(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 (cursor-distance 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))))
diff --git a/core.lisp b/core.lisp
new file mode 100644
index 0000000..d0955fe
--- /dev/null
+++ b/core.lisp
@@ -0,0 +1,83 @@
+(in-package #:monparser)
+
+(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.")))))
+
+(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))))))
+
+(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."))))))
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)))
diff --git a/input.lisp b/input.lisp
index 4edf6aa..e28e73a 100644
--- a/input.lisp
+++ b/input.lisp
@@ -1,53 +1,20 @@
 (in-package #:monparser)
 
-(defclass input ()
-  ((cursor :initarg :cursor :accessor cursor :initform 0)
-   (file :initarg :file :reader file :initform nil)
-   (data :initarg :data :reader data :initform nil)))
+(defclass parser-input ()
+  ((cursor :initarg :cursor :accessor input-cursor :initform 0)
+   (data :initarg :data :reader input-data :initform nil)))
 
 (defun has-data? (input)
-  (< (cursor input) (length (data input))))
-
-(defun prefix? (target input)
-  (string= target
-           (data input)
-           :start2 (cursor input)
-           :end2 (min (+ (cursor input) (length target))
-                      (length (data input)))))
+  (< (input-cursor input) (length (input-data input))))
 
 (defun peek (input)
-  (char (data input)
-        (cursor input)))
-
-(defun advance (input &optional (amount 1))
-  (make-instance 'input
-                 :data (data input)
-                 :file (file input)
-                 :cursor (+ (cursor input) amount)))
-
-(defun input-sub (input1 input2)
-  (- (cursor input1) (cursor input2)))
-
-(defun from-string (str)
-  (make-instance 'input :data str))
-
-(defun read-file (path)
-  (with-open-file (file path)
-    (let* ((size (file-length file))
-           (buf (make-string size)))
-      (read-sequence buf file)
-      buf)))
+  (char (input-data input)
+        (input-cursor input)))
 
-(defun from-file (filename)
-  (make-instance 'input :file filename :data (read-file filename)))
+(defun advance (input)
+  (make-instance 'parser-input
+                 :data (input-data input)
+                 :cursor (+ (input-cursor input) 1)))
 
-(defun line-and-column (input)
-  (let ((line 1) (column 1))
-    (dotimes (i (cursor input))
-      (let ((c (char (data input) i)))
-        (case c
-          (#\Newline
-           (incf line)
-           (setf column 1))
-          (t (incf column)))))
-    (values line column)))
+(defun cursor-distance (input1 input2)
+  (- (input-cursor input1) (input-cursor input2)))
diff --git a/main.lisp b/main.lisp
new file mode 100644
index 0000000..6357cc4
--- /dev/null
+++ b/main.lisp
@@ -0,0 +1,11 @@
+(in-package #:monparser)
+
+(defun parse (parser data)
+  (let* ((result (funcall parser
+                          (make-instance 'parser-input
+                                         :cursor 0
+                                         :data data))))
+    (if (parsing-p result)
+      (let ((finished? (not (has-data? (parsing-left result)))))
+        (values (parsing-tree result) finished?))
+      result)))
diff --git a/monparser.asd b/monparser.asd
index 2aa7290..aa5bc2c 100644
--- a/monparser.asd
+++ b/monparser.asd
@@ -3,4 +3,7 @@
   :components
   ((:file "package")
    (:file "input")
-   (:file "parser")))
+   (:file "base")
+   (:file "core")
+   (:file "extra")
+   (:file "main")))
diff --git a/package.lisp b/package.lisp
index 035cf77..c59f997 100644
--- a/package.lisp
+++ b/package.lisp
@@ -1,6 +1,10 @@
 (defpackage #:monparser
   (:use #:cl)
   (:export #:parse
+           #:failure-place
+           #:failure-message
+           #:input-cursor
+           #:input-data
            #:comp
            #:one-of
            #:unit
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)))