Index: trunk/package.lisp
===================================================================
--- trunk/package.lisp	(revision trunk,15)
+++ trunk/package.lisp	(revision trunk,16)
@@ -1,3 +1,3 @@
-(defpackage #:parse
+(defpackage #:dso-parse
   (:documentation
    "Defines macros for matching input against rules and building trees
Index: trunk/parse.lisp
===================================================================
--- trunk/parse.lisp	(revision trunk,3)
+++ trunk/parse.lisp	(revision trunk,16)
@@ -1,238 +1,2 @@
-(defpackage #:parse
-  (:use #:cl #:cl-ppcre)
-  (:export #:defgrammar
-	   #:token))
-
-(in-package #:parse)
-
-
-
-(defstruct token
-  class
-  string)
-
-;;;; A parser returns, as a list, all parts matched; and, the
-;;;; remainder of the token-list.  Named parts appear as sub-trees.
-
-
-
-(defmacro with-gensyms (syms &body body)
-  `(let (,@(mapcar (lambda (sym) `(,sym (gensym ,(symbol-name sym)))) syms))
-    ,@body))
-
-(defun substring (string &key (start 0) end length)
-  (when (and end length) (error "Specify only one of END or LENGTH."))
-  (when end (setf length (- end start)))
-  (unless length (setf length (- (length string) start)))
-  (make-array length
-	      :element-type 'character
-	      :displaced-to string
-	      :displaced-index-offset start))
-
-(defmacro scase (sym &body clauses)
-  (with-gensyms (sym-name)
-    `(let ((,sym-name (symbol-name ,sym)))
-      (cond
-	,@(mapcar #'(lambda (clause)
-		      (if (eq t (first clause))
-			  clause
-			  (let ((clause-sym-name (symbol-name (first clause)))
-				(clause-body (rest clause)))
-			    `((string= ,sym-name ,clause-sym-name)
-			      ,@clause-body))))
-		  clauses)))))
-
-(defmacro specials ((&body decls) &body body)
-  "Like LET, but declares the bound variables to be special."
-  `(let ,decls
-    (declare (special ,@(mapcar #'first decls)))
-    ,@body))
-
-(defun as-list (item) (if (listp item) item (list item)))
-
-
-
-
-
-;; This is the entry-point for now.
-
-(defun make-parser (rule)
-  (declare (ignore rule))
-  nil)
-
-
-
-(defun parse-sequence (rule-parsers token-list tree)
-  (if rule-parsers
-      (multiple-value-bind (matched rlist mtree)
-	  (funcall (first rule-parsers) token-list)
-	(when matched
-	  (parse-sequence (rest rule-parsers) rlist (append tree mtree))))
-      (values t token-list tree)))
-
-(defun parse-choice (rule-parsers token-list)
-  (if rule-parsers
-      (multiple-value-bind (matched rlist mtree)
-	  (funcall (first rule-parsers) token-list)
-	(if matched
-	    (values t rlist mtree)
-	    (parse-choice (rest rule-parsers) token-list)))
-      nil))
-
-(defun parse-anycount (rule-parser token-list tree)
-  (multiple-value-bind (matched rlist mtree) (funcall rule-parser token-list)
-    (if matched
-	(parse-anycount rule-parser rlist (append tree mtree))
-	(values t token-list tree))))
-
-(defun parse-eqcount (count rule-parser token-list tree)
-  (if (> count 0)
-      (multiple-value-bind (matched rlist mtree)
-	  (funcall rule-parser token-list)
-	(when matched
-	  (parse-eqcount (1- count) rule-parser rlist (append tree mtree))))
-      (values t token-list tree)))
-
-(defun parse-mincount (count rule-parser token-list tree)
-  (if (> count 0)
-      (multiple-value-bind (matched rlist mtree)
-	  (funcall rule-parser token-list)
-	(when matched
-	  (parse-mincount (1- count) rule-parser rlist (append tree mtree))))
-      (parse-anycount rule-parser token-list tree)))
-
-(defun parse-maxcount (count rule-parser token-list tree)
-  (if (> count 0)
-      (multiple-value-bind (matched rlist mtree)
-	  (funcall rule-parser token-list)
-	(if matched
-	    (parse-maxcount (1- count) rule-parser rlist (append tree mtree))
-	    (values t token-list tree)))
-      (values t token-list tree)))
-
-
-
-;; This needs to be changed to just use the function of the given
-;; symbol-name, so that any format of sequence may be supported.
-(defun make-token-parser (token-class)
-  (declare (special definition-names
-		    *import*))
-  (unless (or (member token-class definition-names)
-	      (member token-class *import*))
-    (warn "Parser ~A is neither defined nor imported." token-class))
-  (if (member token-class definition-names)
-      `(function ,token-class)
-      (with-gensyms (token-list token)
-	`(lambda (,token-list)
-	  (let ((,token (first ,token-list)))
-	    (when (and ,token-list (eq (token-class ,token) ',token-class))
-	      (values t (rest ,token-list) (list ,token))))))))
-
-(defun make-character-parser (ch)
-  (with-gensyms (str)
-    `(lambda (,str)
-      (when (and (> (length ,str) 0) (char= (char ,str 0) ,ch))
-	(values
-	 t
-	 (substring ,str :start 1)
-	 (list ,ch))))))
-
-(defun make-regex-parser (regex)
-  (declare (special *regex-flags*))
-  (let ((regex `(:sequence (:flags ,@*regex-flags*) :start-anchor
-		 (:register (:regex ,regex)))))
-    (with-gensyms (str start end)
-      `(lambda (,str)
-	(multiple-value-bind (,start ,end) (scan (quote ,regex) ,str)
-	  (when ,start
-	    (values
-	     t
-	     (substring ,str :start ,end)
-	     (list (substring ,str :end ,end)))))))))
-
-
-(defun make-sequence-parser (rules)
-  (with-gensyms (rule-parsers token-list)
-    `(let ((,rule-parsers (list ,@(mapcar #'make-parser rules))))
-      (lambda (,token-list) (parse-sequence ,rule-parsers ,token-list nil)))))
-
-(defun make-choice-parser (rules)
-  (with-gensyms (rule-parsers token-list)
-    `(let ((,rule-parsers (list ,@(mapcar #'make-parser rules))))
-      (lambda (,token-list) (parse-choice ,rule-parsers ,token-list)))))
-
-(defun make-anycount-parser (rule)
-  (with-gensyms (rule-parser token-list)
-    `(let ((,rule-parser ,(make-parser rule)))
-      (lambda (,token-list) (parse-anycount ,rule-parser ,token-list nil)))))
-
-(defun make-eqcount-parser (count rule)
-  (with-gensyms (rule-parser token-list)
-    `(let ((,rule-parser ,(make-parser rule)))
-      (lambda (,token-list)
-	(parse-eqcount ,count ,rule-parser ,token-list nil)))))
-
-(defun make-maxcount-parser (count rule)
-  (with-gensyms (rule-parser token-list)
-    `(let ((,rule-parser ,(make-parser rule)))
-      (lambda (,token-list)
-	(parse-maxcount ,count ,rule-parser ,token-list nil)))))
-
-(defun make-0or1-parser (rule) (make-maxcount-parser 1 rule))
-
-(defun make-+-parser (rule)
-  (with-gensyms (rule-parser token-list)
-    `(let ((,rule-parser ,(make-parser rule)))
-      (lambda (,token-list)
-	(parse-mincount 1 ,rule-parser ,token-list nil)))))
-
-(defun make-required-pred (rule)
-  (with-gensyms (rule-parser token-list)
-    `(let ((,rule-parser ,(make-parser rule)))
-      (lambda (,token-list)
-	(when (funcall ,rule-parser ,token-list)
-	  (values t ,token-list nil))))))
-
-(defun make-forbidden-pred (rule)
-  (with-gensyms (rule-parser token-list)
-    `(let ((,rule-parser ,(make-parser rule)))
-      (lambda (,token-list)
-	(unless (funcall ,rule-parser ,token-list)
-	  (values t ,token-list nil))))))
-
-(defun make-match-parser (rule)
-  (with-gensyms (rule-parser token-list matched rlist)
-    `(let ((,rule-parser ,(make-parser rule)))
-      (lambda (,token-list)
-	(multiple-value-bind (,matched ,rlist)
-	    (funcall ,rule-parser ,token-list)
-	  (when ,matched (values t ,rlist nil)))))))
-
-(defmacro dispatch (sym fun)
-  `(progn
-    (when (cddr rule) (error ,(format nil "~A takes one argument" sym)))
-    (,fun (second rule))))
-
-(setf (symbol-function 'make-parser) (lambda (rule)
-  (etypecase rule
-    (symbol (make-token-parser rule))
-    (character (make-character-parser rule))
-    (string (make-regex-parser rule))
-    (list
-     (if (symbolp (first rule))
-	 (scase (first rule)
-	   (& (dispatch & make-required-pred))
-	   (! (dispatch ! make-forbidden-pred))
-	   (* (dispatch * make-anycount-parser))
-	   (? (dispatch ? make-0or1-parser))
-	   (+ (dispatch + make-+-parser))
-	   (= (make-match-parser (cdr rule)))
-	   (/ (make-choice-parser (cdr rule)))
-	   (t (make-sequence-parser rule)))
-	 (make-sequence-parser rule))))))
-
-
-
-
 (defun hash-names (names &optional (map (make-hash-table)))
   (if names