Changeset trunk,11 for trunk/csv.lisp

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.

File:

• trunk/csv.lisp (modified) (1 diff)

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.