Index: /tags/dso-lex_0.1.2/dso-lex.asd
===================================================================
--- /tags/dso-lex_0.1.2/dso-lex.asd	(revision 9)
+++ /tags/dso-lex_0.1.2/dso-lex.asd	(revision 9)
@@ -0,0 +1,5 @@
+;;;; -*- Mode: Lisp; Syntax: ANSI-Common-Lisp -*-
+
+(asdf:defsystem #:dso-lex
+  :depends-on (#:cl-ppcre)
+  :components ((:file "lex")))
Index: /tags/dso-lex_0.1.2/example.lisp
===================================================================
--- /tags/dso-lex_0.1.2/example.lisp	(revision 9)
+++ /tags/dso-lex_0.1.2/example.lisp	(revision 9)
@@ -0,0 +1,30 @@
+(require '#:cl-ppcre)
+(require '#:dso-lex)
+
+(use-package '(#:cl-ppcre #:dso-lex))
+
+
+
+(defun snip (s) (subseq s 1 (1- (length s))))
+
+(defun un-squote (s) (regex-replace-all "''" (snip s) "'"))
+
+(defun un-dquote (s) (regex-replace-all "\"\"" (snip s) "\""))
+
+(deflexer scan-csv
+  ("," comma)
+  ("[^\"',]+" value)
+  ("'(?:[^']|'')*'" value un-squote)
+  ("\"(?:[^\"]|\"\")*\"" value un-dquote))
+
+(defun scan-all (input)
+  (labels ((scan (input tokens)
+	     (if (> (length input) 0)
+		 (multiple-value-bind (class literal remainder)
+		     (scan-csv input)
+		   (when class
+		     (scan remainder (cons (cons class literal) tokens))))
+		 (reverse tokens))))
+    (scan input '())))
+
+(scan-all "no quotes,'a ''quote''',\"another \"\"quote\"\"\"")
Index: /tags/dso-lex_0.1.2/lex.lisp
===================================================================
--- /tags/dso-lex_0.1.2/lex.lisp	(revision 9)
+++ /tags/dso-lex_0.1.2/lex.lisp	(revision 9)
@@ -0,0 +1,38 @@
+(defpackage #:dso-lex
+    (:documentation "Allows the definition of lexers.  See DEFLEXER.")
+  (:use #:cl #:cl-ppcre)
+  (:export #:deflexer))
+
+(in-package #:dso-lex)
+
+
+
+(defun combine (regex-list)
+  (let ((mapped (mapcar
+		 (lambda (regex) `(:register (:regex ,regex)))
+		 regex-list)))
+    (when (rest mapped) (setq mapped `((:alternation ,@mapped))))
+    `(:sequence (:flags :single-line-mode-p) :start-anchor
+      (:group ,@mapped)
+      (:register (:greedy-repetition 0 nil :everything)))))
+
+(defmacro deflexer (name &body body)
+  "Defines lexers, called as a function of the given NAME.  The body
+consists of token-class definitions, each being a list of a regular
+expression, the name of the class, and an optional filter.
+
+Currently, matching is done using *only* priority (first match wins),
+and does not look for the longest match."
+  (let ((regex (combine (mapcar #'first body)))
+	(classes (map 'vector #'second body))
+	(filters (map 'vector #'third body)))
+    `(defun ,name (line)
+      (let ((parts
+	     (nth-value 1 (scan-to-strings (quote ,regex) line))))
+	(let ((idx (position-if #'identity parts)))
+	  (when idx
+	    (let ((token (aref parts idx))
+		  (filter (aref ,filters idx)))
+	      (values (aref ,classes idx)
+		      (if filter (funcall filter token) token)
+		      (aref parts ,(length classes))))))))))
