Changeset trunk,5 for trunk/parse2.lisp

Timestamp:

06/08/2007 03:19:22 AM (19 years ago)

Author:

dsowen

revision id:

svn-v3-trunk0:2948df59-2b31-0410-8e06-c40c0b09d5b6:trunk:5

Message:

Added string parser.
Added stub for regex parser.
Added inline decls.

File:

• trunk/parse2.lisp (modified) (10 diffs)

trunk/parse2.lisp

@@ -4 +4 @@
 (import '(parse::with-gensyms parse::substring))
 
-(defvar *follow* t)
+(defvar *follow* nil)
 
 (defmacro follow (fmt &rest args)
   (when *follow*
     `(format t ,fmt ,@args)))
+
+(defun whole (n)
+  (declare ((or null (integer 0)) n))
+  (when (and n (/= n 0)) n))
+
+(defun min- (n)
+  (declare ((or null (integer 1)) n))
+  (when (and n (> n 1)) (1- n)))
+
+(defun max- (n)
+  (declare ((or null (integer 0)) n))
+  (when n (1- n)))
 
 (defmacro with-character-parser ((name char) &body body)
@@ -20 +32 @@
              (when (and (> (length ,input) 0) (char= (char ,input 0) ,char))
                (values t (substring ,input :start 1) '(,char)))))
+      (declare (inline ,name))
       ,@body)))
+
+(defmacro with-string-parser ((name string) &body body)
+  (declare (symbol name)
+           (string string))
+  (follow "with-string-parser~%")
+  (let ((len (length string)))
+    (with-gensyms (input)
+      `(flet ((,name (,input)
+               ,(format nil "String parser for ~S." string)
+               (declare (string ,input))
+               (when (and (>= (length ,input) ,len)
+                          (string= ,input ,string :end1 ,len))
+                 (values t (substring ,input :start ,len) '(,string)))))
+        (declare (inline ,name))
+        ,@body))))
+
+(defmacro with-regex-parser ((name regex) &body body)
+  (error "Not implemented."))
 
 (defmacro with-sequence-parser% ((name seq) &body body)
@@ -36 +67 @@
                          (,head ,input)
                        (when ,matched (,tail ,left (append ,tree ,found))))))
+              (declare (inline ,name))
               ,@body)))
         `(flet ((,name (,input ,tree)
@@ -41 +73 @@
                  (declare (list ,tree))
                  (values t ,input ,tree)))
+          (declare (inline ,name))
           ,@body))))
 
@@ -54 +87 @@
                    (,subname ,input nil)
                  (when ,matched (values t ,left (list ,found))))))
+        (declare (inline ,name))
         ,@body))))
 
@@ -71 +105 @@
                            (values t ,left ,found)
                            (,tail ,input)))))
+              (declare (inline ,name))
               ,@body)))
         `(flet ((,name (,input)
                  "Choice parser for base case."
                  (declare (ignore ,input))))
+          (declare (inline ,name))
           ,@body))))
 
@@ -85 +121 @@
                ,(format nil "Required parser for ~S." rule)
                (when (,sub ,input) (values t ,input nil))))
+        (declare (inline ,name))
         ,@body))))
 
@@ -95 +132 @@
                ,(format nil "Forbidden parser for ~S." rule)
                (unless (,sub ,input) (values t ,input nil))))
+        (declare (inline ,name))
         ,@body))))
 
@@ -110 +148 @@
                  ,(format nil "Range parser {~S, ~S} for ~S."
                           mincount maxcount rule)
-                 (cond
-                   ((and ,min (> ,min 0))
-                    (multiple-value-bind (,matched ,left ,found) (,sub ,input)
-                      (when ,matched
-                        (,subname (1- ,min) (when ,max (1- ,max))
-                                  ,left (append ,tree ,found)))))
-                   ((and ,max (> ,max 0))
-                    (multiple-value-bind (,matched ,left ,found) (,sub ,input)
-                      (if ,matched
-                          (,subname nil (1- ,max)
-                                    ,left (append ,tree ,found))
-                          (values t ,input ,tree))))
-                   ((and ,max (= ,max 0)) (values t ,input ,tree))
-                   (t (multiple-value-bind (,matched ,left ,found)
-                          (,sub ,input)
-                        (if ,matched
-                            (,subname nil nil ,left (append ,tree ,found))
-                            (values t ,input ,tree)))))))
-        (flet ((,name (,input) (,subname ,mincount ,maxcount ,input nil)))
+
+                 (if (and ,max (= ,max 0))
+
+                     ;; Only time this can happen (because we can't
+                     ;; create a {*,0} parser) is after already
+                     ;; collecting some matches.  Because MAX >= MIN
+                     ;; always, we've also already collected *enough*.
+                     (values t ,input ,tree)
+
+                     ;; We haven't hit the limit (if any), so try
+                     ;; another match.
+                     (multiple-value-bind (,matched ,left ,found) (,sub ,input)
+                       (cond
+                         (,matched (,subname (min- ,min) (max- ,max)
+                                             ,left (append ,tree ,found)))
+                         ;; Either no minimum, or already filled it
+                         ;; (by the saturating MIN-), so succeed.
+                         ((not ,min) (values t ,input ,tree))
+
+                         ;; Return NIL
+                         )))))
+
+        (flet ((,name (,input)
+                 (,subname ,(whole mincount) ,(whole maxcount) ,input nil)))
+          (declare (inline ,name))
           ,@body)))))
 
@@ -135 +179 @@
   (follow "with-parser~%")
   (etypecase rule
-    (character
-     `(with-character-parser (,name ,rule) ,@body))
+    (character `(with-character-parser (,name ,rule) ,@body))
+    (string `(with-string-parser (,name ,rule) ,@body))
     (list
      (destructuring-bind (head . tail) rule
        (case head
+         (^ (destructuring-bind (regex) tail
+              `(with-regex-parser (,name ,regex) ,@body)))
          (/ `(with-choice-parser (,name ,tail) ,@body))
          (& (destructuring-bind (subrule) tail