Type check functions

6 files changed, 62 insertions, 46 deletions

diff --git a/base.lisp b/base.lisp
index e8aac7d..fe28cd0 100644
--- a/base.lisp
+++ b/base.lisp
@@ -1,14 +1,19 @@
 (in-package #:monparser)
 
-(defstruct parsing
+(defstruct result)
+
+(defstruct (parsing (:include result))
   tree
-  start
-  end)
+  (start (make-instance 'cursor) :type cursor)
+  (end (make-instance 'cursor) :type cursor))
+
+(defstruct (failure (:include result))
+  (place (make-instance 'cursor) :type cursor)
+  (message "" :type string)
+  (priority 0 :type integer))
 
-(defstruct failure
-  place
-  (message "")
-  (priority 0))
+(deftype parser ()
+  `(function (cursor cursor) result))
 
 (defun line-and-column (str index)
   (let ((line 1) (column 1))
@@ -22,22 +27,23 @@
     (cons line column)))
 
 (defmethod print-object ((obj failure) stream)
-  (if (failure-place obj)
-    (let ((linecol (line-and-column (data (failure-place obj))
-                                    (index (failure-place obj)))))
-      (format stream "~a:~a: ~a~&~a~&"
-              (car linecol) (cdr linecol) (failure-message obj) (failure-place obj)))
-    (format stream "~a~&" (failure-message obj))))
+  (let ((linecol (line-and-column (data (failure-place obj))
+                                  (index (failure-place obj)))))
+    (format stream "~a:~a: ~a~&~a~&"
+            (car linecol) (cdr linecol) (failure-message obj) (failure-place obj))))
 
+(declaim (ftype (function (t &key (:priority integer)) parser) fail))
 (defun fail (message &key (priority 1))
   (lambda (start input)
     (declare (ignore start))
     (make-failure :place input :message message :priority priority)))
 
+(declaim (ftype (function (t) parser) new))
 (defun new (tree)
   (lambda (start input)
     (make-parsing :tree tree :start start :end input)))
 
+(declaim (ftype (function (parser (function (result) parser)) parser) bind))
 (defun bind (parser f)
   (lambda (start input)
     (let ((r (funcall parser input input)))
diff --git a/core.lisp b/core.lisp
index 833eb41..43dd234 100644
--- a/core.lisp
+++ b/core.lisp
@@ -3,6 +3,7 @@
 (defparameter nothing
   (new nil))
 
+(declaim (ftype (function (symbol list) list) normalize))
 (defun normalize (sym expression)
   (nsubst-if sym
              (lambda (x)
@@ -24,19 +25,21 @@
            (setf predicate
                  (normalize 'it predicate))))
         (t (error (format nil "Invalid predicate: ~a." predicate))))
-  `(lambda (start input)
-     (declare (ignore start))
-     (if (has-data? input)
-       (let ((it (peek input)))
-         (if ,predicate
-           (make-parsing :tree it
-                         :start input
-                         :end (advance input))
-           (make-failure :place input
-                         :message (format nil "Expected: ~a, Got: ~:c." ',predicate it))))
-       (make-failure :place input
-                     :message (format nil "Reached end of input. Expected: ~a." ',predicate)))))
+  `(the parser
+        (lambda (start input)
+          (declare (ignore start))
+          (if (has-data? input)
+            (let ((it (peek input)))
+              (if ,predicate
+                (make-parsing :tree it
+                              :start input
+                              :end (advance input))
+                (make-failure :place input
+                              :message (format nil "Expected: ~a, Got: ~:c." ',predicate it))))
+            (make-failure :place input
+                          :message (format nil "Reached end of input. Expected: ~a." ',predicate))))))
 
+(declaim (ftype (function (parser parser &rest parser) parser) one-of))
 (defun one-of (first-parser second-parser &rest other-parsers)
   (lambda (start input)
     (declare (ignore start))
@@ -63,9 +66,11 @@
                 (t (error (format nil "Invalid return value: ~a." r))))))
       result)))
 
+(declaim (ftype (function (parser) parser) optional))
 (defun optional (p)
   (one-of p nothing))
 
+(declaim (ftype (function (parser &key (:all t)) parser) many))
 (defun many (p &key all)
   (lambda (start input)
     (declare (ignore start))
diff --git a/cursor.lisp b/cursor.lisp
index 321ec3b..72d4c90 100644
--- a/cursor.lisp
+++ b/cursor.lisp
@@ -1,6 +1,6 @@
 (in-package #:monparser)
 
-(defclass text ()
+(defclass cursor ()
   ((index :type (unsigned-byte 44) :initarg :index :accessor index :initform 0)
    (data :type simple-string :initarg :data :reader data :initform "")))
 
@@ -12,7 +12,7 @@
         (index cursor)))
 
 (defun advance (cursor)
-  (make-instance 'text
+  (make-instance 'cursor
                  :data (data cursor)
                  :index (+ (index cursor) 1)))
 
@@ -29,7 +29,7 @@
     (push (subseq str begin index) result)
     result))
 
-(defmethod print-object ((obj text) stream)
+(defmethod print-object ((obj cursor) stream)
   (print-unreadable-object (obj stream :type t)
     (let ((str (if (has-data? obj)
                  (format nil "~{~a~a~a~}"
diff --git a/extra.lisp b/extra.lisp
index 024bd3b..c0a6a8a 100644
--- a/extra.lisp
+++ b/extra.lisp
@@ -1,9 +1,10 @@
 (in-package #:monparser)
 
-(defparameter whitespace
-  (many (unit (or (char= it #\Space)
-                  (not (graphic-char-p it))))))
+(defun whitespace? (it)
+  (or (char= it #\Space)
+      (not (graphic-char-p it))))
 
+(declaim (ftype (function (parser integer integer) parser) repeat))
 (defun repeat (p min &optional (max 0))
   (if (> min 0)
     (comp ((x p)
@@ -28,13 +29,15 @@
     `(comp ,(reverse binding-list)
        ,(cons 'list (reverse name-list)))))
 
-(defmacro within (left p right)
-  `(comp ((_ ,left)
-          (cell ,p)
-          (_ ,right))
-     cell))
+(declaim (ftype (function (parser parser parser) parser) within))
+(defun within (left p right)
+  (comp ((_ left)
+         (cell p)
+         (_ right))
+    cell))
 
-(defmacro interlinked (p separator)
-  `(many (comp ((cell ,p)
-                (_ (optional ,separator)))
-           cell)))
+(declaim (ftype (function (parser parser) parser) interlinked))
+(defun interlinked (p separator)
+  (many (comp ((cell p)
+               (_ (optional separator)))
+          cell)))
diff --git a/main.lisp b/main.lisp
index 8938f14..3e6f255 100644
--- a/main.lisp
+++ b/main.lisp
@@ -1,12 +1,12 @@
 (in-package #:monparser)
 
+(declaim (ftype (function (parser string) result) parse))
 (defun parse (parser data)
-  (if (typep data 'string)
-    (funcall parser
-             (make-instance 'text :data data)
-             (make-instance 'text :data data))
-    (error "Only string parsing is allowed.")))
+  (funcall parser
+           (make-instance 'cursor :data data)
+           (make-instance 'cursor :data data)))
 
+(declaim (ftype (function (parser string) parser) append-on-failure))
 (defun append-on-failure (p message)
   (lambda (start input)
     (let ((result (funcall p start input)))
diff --git a/package.lisp b/package.lisp
index e3882c6..acdefef 100644
--- a/package.lisp
+++ b/package.lisp
@@ -19,8 +19,10 @@
            #:optional
            #:many
            #:repeat
-           #:whitespace
+           #:whitespace?
            #:end-of-input
            #:literal
            #:within
            #:interlinked))
+
+(declaim (optimize (speed 3)))