Changeset trunk,11 for trunk

Timestamp:

06/18/2007 07:51:03 PM (19 years ago)

Author:

dsowen

revision id:

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

Message:

Expanded CSV example.
Fixed: IF-MATCHES-PARSER was misspelled as IF-MATCHER-PARSER.
Adjusted tree construction for sequence matching.

Location:

trunk

Files:

• csv.lisp (modified) (1 diff)
• parse3.lisp (modified) (3 diffs)

trunk/csv.lisp

@@ +1 @@
+(require '#:dso-lex)
 (require '#:parse)
 (require '#:cl-ppcre)
+(use-package '#:dso-lex)
 (import 'parse::substring)
 (import 'parse::with-gensyms)
 (import 'cl-ppcre:scan)
-(load "parse/parse3")
+(load "lisp/parse/parse3")
 
-(defmacro defparser (name rule)
+
+
+(flet ((trim (s) (substring s :start 1 :length (- (length s) 2))))
+  (defun un-squote (s)
+    (cl-ppcre:regex-replace-all "''" (trim s) "'"))
+  (defun un-dquote (s)
+    (cl-ppcre:regex-replace-all "\"\"" (trim s) "\"")))
+
+(deflexer lex-csv
+  ("," comma)
+  ("\\n|\\r|\\r\\n" newline)
+  ("'(?:[^']|'')*'" value un-squote)
+  ("\"(?:[^\"]|\"\")*\"" value un-dquote)
+  ("[^,'\"\\n\\r]+" value))
+
+(defun lex-all-csv (input &optional tokens)
+  (multiple-value-bind (class image left) (lex-csv input)
+    (if class
+        (lex-all-csv left (cons (list class image) tokens))
+        (nreverse tokens))))
+
+(defmacro defmatcher (class)
+  (let ((fn-sym (intern (concatenate 'string "T-" (symbol-name class)))))
+    `(defun ,fn-sym (token-list)
+      (when token-list
+        (destructuring-bind (class image) (first token-list)
+          (when (eq class ',class)
+            (values t (rest token-list) (list class image))))))))
+
+(defmatcher comma)
+(defmatcher newline)
+(defmatcher value)
+
+(defmacro defparser (name rule &optional filter)
   (with-gensyms (input next match)
-  `(defun ,name (,input)
-    (if-matches ,input ,rule (,next ,match)
-      (values t ,next (list ',name ,match))))))
+    `(defun ,name (,input)
+      (if-matches ,input ,rule (,next ,match)
+        (values t ,next (cons ',name ,(if filter `(,filter ,match) match)))))))
 
 (defmacro defgrammar (&body definitions)
   (flet ((x (definition)
-           (destructuring-bind (name rule) definition
-             `(defparser ,name ,rule))))
+           (destructuring-bind (name rule &optional filter) definition
+             `(defparser ,name ,rule ,filter))))
     `(progv () ,@(mapcar #'x definitions))))
 
 (defgrammar
-  (file (+ row))
-  (row (value (* ((= comma) value)) (= #\Newline)))
-  (comma #\,)
-  (value (? (/ dquoted-value squoted-value raw-value)))
-  (dquoted-value (#\" (^ "(?:[^\"]|\"\")*") #\"))
-  (squoted-value (#\' (^ "(?:[^']|'')*") #\'))
-  (raw-value (^ "[^,'\"\\n]*")))
+    (file (+ row))
+  (row (t-value (* row-rest) (= t-newline))
+       (lambda (row)
+         (princ row)
+         (mapcar #'second (cons (first row) (mapcar #'second (second row))))))
+  (row-rest ((= t-comma) t-value) cdr))
 
-;;; (deparser test (* (#\a #\b))) doesn't grab the match.
+;;; (defparser test (* (#\a #\b))) doesn't grab the match.

trunk/parse3.lisp

@@ -4 +4 @@
     ,@body))
 
-(defmacro if-matcher-parser (input parser (next match)
+(defmacro if-matches-parser (input parser (next match)
                              &body (&optional (then t) else))
   (declare (symbol parser next match))
@@ -66 +66 @@
           `(if-matches ,input ,head (,head-next ,head-match)
             (if-matches-sequence ,head-next ,tail (,next ,tail-match)
-              (let ((,match (cons ,head-match (list ,tail-match))))
+              (let ((,match (cons ,head-match ,tail-match)))
                 ,then)
               ,else)
             ,else))
-        `(if-matches ,input ,head (,next ,match) ,then ,else))))
+        (with-gensyms (tail-match)
+          `(if-matches ,input ,head (,next ,tail-match)
+            (let ((,match (list ,tail-match)))
+              ,then)
+            ,else)))))
 
 (defmacro if-matches-eqcount (input count rule (next match)
@@ -149 +153 @@
 (defmacro if-matches (input rule (next match) &body (&optional (then t) else))
   (etypecase rule
-    (symbol `(if-matcher-parser ,input ,rule (,next ,match) ,then ,else))
+    (symbol `(if-matches-parser ,input ,rule (,next ,match) ,then ,else))
     (character `(if-matches-char ,input ,rule (,next ,match) ,then ,else))
     (string `(if-matches-string ,input ,rule (,next ,match) ,then ,else))