thodg/css-parser

diff --git a/css-lexer.lisp b/css-lexer.lisp
deleted file mode 100644
index 664da97..0000000
--- a/css-lexer.lisp
+++ /dev/null
@@ -1,495 +0,0 @@
-
-(in-package :parse-css)
-
-(defgeneric match-comment (parser))
-(defgeneric match-newline (parser))
-(defgeneric match-whitespace (parser))
-(defgeneric match-hex-digit (parser))
-(defgeneric match-escape (parser))
-(defgeneric whitespace-token (parser))
-(defgeneric match-ws* (parser))
-(defgeneric match-ident-char (parser))
-(defgeneric match-ident-char* (parser))
-(defgeneric ident-token (parser))
-(defgeneric function-token (parser))
-(defgeneric at-keyword-token (parser))
-(defgeneric match-string-char (parser end-char))
-(defgeneric match-string (parser end-char))
-(defgeneric string-token (parser))
-(defgeneric match-non-printable (parser))
-(defgeneric match-url-unquoted-char (parser))
-(defgeneric match-url-unquoted (parser))
-(defgeneric url-token (parser))
-(defgeneric match-digit (parser))
-(defgeneric match-digit+ (parser))
-(defgeneric number-token (parser))
-(defgeneric dimension-token (parser))
-(defgeneric percentage-token (parser))
-(defgeneric unicode-range-token (parser))
-(defgeneric include-match-token (parser))
-(defgeneric dash-match-token (parser))
-(defgeneric prefix-match-token (parser))
-(defgeneric suffix-match-token (parser))
-(defgeneric substring-match-token (parser))
-(defgeneric column-token (parser))
-(defgeneric cdo-token (parser))
-(defgeneric cdc-token (parser))
-
-(defclass identified-token (token)
-  ((ident :initarg :ident
-	  :reader token-ident
-	  :type ident-token)))
-
-(defclass comment-token (token) ())
-(defclass whitespace-token (token) ())
-(defclass ident-token (token) ())
-(defclass function-token (identified-token) ())
-(defclass at-keyword-token (identified-token) ())
-(defclass hash-token (token) ())
-(defclass string-token (token) ())
-
-(defclass url-token (identified-token)
-  ((url :initarg :url
-	:reader token-url
-	:type token)))
-
-(defclass number-token (token) ())
-
-(defclass numbered-token (token)
-  ((number :initarg :number
-	   :reader token-number
-	   :type number-token)))
-
-(defclass dimension-token (identified-token numbered-token) ())
-(defclass percentage-token (numbered-token) ())
-(defclass unicode-range-token (token) ())
-(defclass include-match-token (token) ())
-(defclass dash-match-token (token) ())
-(defclass prefix-match-token (token) ())
-(defclass suffix-match-token (token) ())
-(defclass substring-match-token (token) ())
-(defclass column-token (token) ())
-(defclass cdo-token (token) ())
-(defclass cdc-token (token) ())
-(defclass left-paren-token (token) ())
-(defclass right-paren-token (token) ())
-(defclass comma-token (token) ())
-(defclass colon-token (token) ())
-(defclass semicolon-token (token) ())
-(defclass [-token (token) ())
-(defclass ]-token (token) ())
-(defclass {-token (token) ())
-(defclass }-token (token) ())
-(defclass eof-token (token) ())
-(defclass delim-token (token) ())
-
-(defmethod comment-token ((p parser))
-  (push-token p)
-  (if (match p "/*")
-      (progn (match-until p "*/")
-	     (make-token p 'comment-token))
-      (discard-token p)))
-
-(defmethod match-newline ((p parser))
-  (or (match p #\Newline)
-      (match p (coerce '(#\Return #\Newline) 'string))
-      (match p #\Return)
-      (match p #\Linefeed)))
-
-(defmethod match-whitespace ((p parser))
-  (or (match p #\Space)
-      (match p #\Tab)
-      (match-newline p)))
-
-(defmethod match-hex-digit ((p parser))
-  (let ((c (the fixnum (parser-match-char p))))
-    (when (or (<= (char-code #\0) c (char-code #\9))
-	      (<= (char-code #\a) c (char-code #\f))
-	      (<= (char-code #\A) c (char-code #\F)))
-      (incf (parser-char-match-start p)))))
-       
-(defmethod match-escape ((p parser))
-  (match-sequence p
-    (and (match p #\\)
-	 (or (when (match-times p #'match-hex-digit 1 6)
-	       (match-whitespace p)
-	       (parser-char-match-start p))
-	     (when (not (match-newline p))
-	       (parser-char-match-start p))))))
-
-(defmethod whitespace-token ((p parser))
-  (push-token p)
-  (if (match-times p #'match-whitespace 1 nil)
-      (make-token p 'whitespace-token)
-      (discard-token p)))
-
-(defmethod match-ws* ((p parser))
-  (match-option p #'whitespace-token))
-
-(defmethod match-ident-char ((p parser))
-  (or (match-escape p)
-      (let ((c (the fixnum (parser-match-char p))))
-	(when (or (<= (char-code #\a) c (char-code #\z))
-		  (<= (char-code #\A) c (char-code #\Z))
-		  (<= (char-code #\0) c (char-code #\9))
-		  (=  (char-code #\_) c)
-		  (=  (char-code #\-) c)
-		  (<  #x007F c))
-	  (incf (parser-char-match-start p))))))
-
-(defmethod match-ident-char* ((p parser))
-  (match-times p #'match-ident-char 0 nil))
-
-(defmethod ident-token ((p parser))
-  (match-sequence p
-    (push-token p)
-    (match p #\-)
-    (cond ((or (match-escape p)
-	       (let ((c (the fixnum (parser-match-char p))))
-		 (when (or (<= (char-code #\a) c (char-code #\z))
-			   (<= (char-code #\A) c (char-code #\Z))
-			   (=  (char-code #\_) c)
-			   (<  #x007F c))
-		   (incf (parser-char-match-start p)))))
-	   (match-ident-char* p)
-	   (make-token p 'ident-token))
-	  (t
-	   (discard-token p)))))
-
-(defmethod function-token ((p parser))
-  (match-sequence p
-    (push-token p)
-    (let ((ident (ident-token p)))
-      (if (and ident (match p #\())
-	  (make-token p 'function-token :ident ident)
-	  (discard-token p)))))
-
-(defmethod at-keyword-token ((p parser))
-  (match-sequence p
-    (push-token p)
-    (if (match p #\@)
-	(let ((ident (ident-token p)))
-	  (if ident
-	      (make-token p 'at-keyword-token :ident ident)
-	      (discard-token p)))
-	(discard-token p))))
-
-(defmethod hash-token ((p parser))
-  (match-sequence p
-    (push-token p)
-    (if (match p #\#)
-	(and (match-ident-char* p)
-	     (make-token p 'hash-token))
-	(discard-token p))))
-
-(defgeneric string-token-string (string-token))
-
-(defmethod string-token-string ((s string-token))
-  (let ((string (token-string s)))
-    (subseq string 1 (1- (length string)))))
-
-(defmethod match-string-char ((p parser) (end-char character))
-  (or (match-sequence p
-	(and (match p #\\)
-	     (match-newline p)))
-      (match-escape p)
-      (match-not p
-	(or (match p end-char)
-	    (match p #\\)
-	    (match-newline p)))))
-
-(defmethod match-string ((p parser) (end-char character))
-  (match-sequence p
-    (match p end-char)
-    (match-times p (lambda (p) (match-string-char p end-char)) 0 nil)
-    (match p end-char)))
-
-(defmethod string-token ((p parser))
-  (push-token p)
-  (if (or (match-string p #\")
-	  (match-string p #\'))
-      (make-token p 'string-token)))
-
-(defmethod match-non-printable ((p parser))
-  (let ((c (the fixnum (parser-match-char p))))
-    (when (or (<= #x0000 c #x0008)
-	      (=  #x000B c)
-	      (<= #x000E c #x001F)
-	      (=  #x007F c))
-      (incf (parser-char-match-start p)))))
-
-(defmethod match-url-unquoted-char ((p parser))
-  (or (match-escape p)
-      (match-not p
-	(or (match p #\")
-	    (match p #\')
-	    (match p #\()
-	    (match p #\))
-	    (match p #\\)
-	    (match-whitespace p)
-	    (match-non-printable p)))))
-
-(defmethod match-url-unquoted ((p parser))
-  (push-token p)
-  (if (match-times p #'match-url-unquoted-char 1 nil)
-      (make-token p 'token)
-      (discard-token p)))
-
-(defmethod url-token ((p parser))
-  (push-token p)
-  (or (match-sequence p
-	(let ((ident (ident-token p)))
-	  (and (string= "url" (token-string ident))
-	       (match p #\()
-	       (match-ws* p)
-	       (let ((url (or (string-token p)
-			      (match-url-unquoted p))))
-		 (match-ws* p)
-		 (when (match p #\))
-		   (make-token p (url-token :ident ident :url url)))))))
-      (discard-token p)))
-
-(defmethod match-digit ((p parser))
-  (let ((c (the fixnum (parser-match-char p))))
-    (when (<= (char-code #\0) c (char-code #\9))
-      (incf (parser-char-match-start p)))))
-
-(defmethod match-digit+ ((p parser))
-  (match-times p #'match-digit 1 nil))
-
-(defmethod number-token ((p parser))
-  (push-token p)
-  (if (match-sequence p
-	(and (or (match p #\-)
-		 (match p #\+)
-		 t)
-	     (or (match-sequence p
-		   (and (match p #\.)
-			(match-digit+ p)))
-		 (match-sequence p
-		   (match-digit+ p)
-		   (match p #\.)
-		   (match-digit+ p))
-		 (match-digit+ p))
-	     (or (match-sequence p
-		   (and (or (match p #\E)
-			    (match p #\e))
-			(or (match p #\-)
-			    (match p #\+)
-			    t)
-			(match-digit+ p)))
-		 (parser-char-match-start p))))
-      (make-token p 'number-token)
-      (discard-token p)))
-
-(defmethod dimension-token ((p parser))
-  (push-token p)
-  (or (match-sequence p
-	(let ((number (number-token p)))
-	  (when number
-	    (let ((ident (ident-token p)))
-	      (when ident
-		(make-token p 'dimension-token
-			    :number number
-			    :ident ident))))))
-      (discard-token p)))
-
-(defmethod percentage-token ((p parser))
-  (push-token p)
-  (or (match-sequence p
-	(let ((number (number-token p)))
-	  (when number
-	    (when (match p #\%)
-	      (make-token p 'percentage-token
-			  :number number)))))
-      (discard-token p)))
-
-(defmethod unicode-range-token ((p parser))
-  (push-token p)
-  (or (match-sequence p
-	(and (or (match p #\u)
-		 (match p #\U))
-	     (match p #\+)
-	     (or (match-sequence p
-		   (and (match-times p #'match-hex-digit 1 6)
-			(match p #\-)
-			(match-times p #'match-hex-digit 1 6)))
-		 (match-sequence p
-		   (let ((start (parser-char-match-start p)))
-		     (and (match-times p #'match-hex-digit 0 5)
-			  (let ((digits (- (parser-char-match-start p) start)))
-			    (match-times p (lambda (p) (match p #\?))
-					 1 (- 6 digits))))))
-		 (match-times p #'match-hex-digit 1 6))
-	     (make-token p 'unicode-range-token)))
-      (discard-token p)))
-
-(defmethod include-match-token ((p parser))
-  (push-token p)
-  (if (match p "~=")
-      (make-token p 'include-match-token)
-      (discard-token p)))
-
-(defmethod dash-match-token ((p parser))
-  (push-token p)
-  (if (match p "|=")
-      (make-token p 'dash-match-token)
-      (discard-token p)))
-
-(defmethod prefix-match-token ((p parser))
-  (push-token p)
-  (if (match p "^=")
-      (make-token p 'prefix-match-token)
-      (discard-token p)))
-
-(defmethod suffix-match-token ((p parser))
-  (push-token p)
-  (if (match p "$=")
-      (make-token p 'suffix-match-token)
-      (discard-token p)))
-
-(defmethod substring-match-token ((p parser))
-  (push-token p)
-  (if (match p "*=")
-      (make-token p 'substring-match-token)
-      (discard-token p)))
-
-(defmethod column-token ((p parser))
-  (push-token p)
-  (if (match p "||")
-      (make-token p 'column-token)
-      (discard-token p)))
-
-(defmethod cdo-token ((p parser))
-  (push-token p)
-  (if (match p "<!--")
-      (make-token p 'cdo-token)
-      (discard-token p)))
-
-(defmethod cdc-token ((p parser))
-  (push-token p)
-  (if (match p "-->")
-      (make-token p 'cdc-token)
-      (discard-token p)))
-
-(defmethod left-paren-token ((p parser))
-  (push-token p)
-  (if (match p #\()
-      (make-token p 'left-paren-token)
-      (discard-token p)))
-
-(defmethod right-paren-token ((p parser))
-  (push-token p)
-  (if (match p #\))
-      (make-token p 'right-paren-token)
-      (discard-token p)))
-
-(defmethod comma-token ((p parser))
-  (push-token p)
-  (if (match p #\,)
-      (make-token p 'comma-token)
-      (discard-token p)))
-
-(defmethod colon-token ((p parser))
-  (push-token p)
-  (if (match p #\:)
-      (make-token p 'colon-token)
-      (discard-token p)))
-
-(defmethod semicolon-token ((p parser))
-  (push-token p)
-  (if (match p #\;)
-      (make-token p 'semicolon-token)
-      (discard-token p)))
-
-(defmethod [-token ((p parser))
-  (push-token p)
-  (if (match p #\[)
-      (make-token p '[-token)
-      (discard-token p)))
-
-(defmethod ]-token ((p parser))
-  (push-token p)
-  (if (match p #\])
-      (make-token p ']-token)
-      (discard-token p)))
-
-(defmethod {-token ((p parser))
-  (push-token p)
-  (if (match p #\{)
-      (make-token p '{-token)
-      (discard-token p)))
-
-(defmethod }-token ((p parser))
-  (push-token p)
-  (if (match p #\})
-      (make-token p '}-token)
-      (discard-token p)))
-
-(defmethod eof-token ((p parser))
-  (push-token p)
-  (if (match p -1)
-      (make-token p 'eof-token)
-      (discard-token p)))
-
-(defmethod delim-token ((p parser))
-  (push-token p)
-  (input-length p 1)
-  (incf (parser-char-match-start p))
-  (make-token p 'delim-token))
-
-;;  CSS lexer
-
-(defmethod consume-token ((p parser))
-  (or (whitespace-token p)
-      (string-token p)
-      (hash-token p)
-      (suffix-match-token p)
-      (left-paren-token p)
-      (right-paren-token p)
-      (substring-match-token p)
-      (number-token p)
-      (comma-token p)
-      (cdc-token p)
-      (comment-token p)
-      (colon-token p)
-      (semicolon-token p)
-      (cdo-token p)
-      (at-keyword-token p)
-      ([-token p)
-      (]-token p)
-      (prefix-match-token p)
-      ({-token p)
-      (}-token p)
-      (unicode-range-token p)
-      (ident-token p)
-      (dash-match-token p)
-      (include-match-token p)
-      (eof-token p)
-      (delim-token p)))
-
-(defun lex-stream (stream)
-  (let ((p (make-instance 'parser :stream stream))
-	(document nil))
-    (labels ((push-tokens ()
-	       (let ((token (consume-token p)))
-		 (push token document)
-		 (unless (typep token 'eof-token)
-		   (push-tokens)))))
-      (push-tokens))
-    (nreverse document)))
-
-(defun lex-string (string)
-  (with-input-from-string (stream string)
-    (lex-stream stream)))
-
-(defun lex-file (filespec)
-  (with-open-file (stream filespec
-			  :element-type 'character
-			  :external-format :utf-8)
-    (lex-stream stream)))
-
-;;  Tests
-
-#+test
-(lex-string "/* hello world */ body { color: #ff0000; }")
diff --git a/matcher.lisp b/matcher.lisp
deleted file mode 100644
index cbd7d6a..0000000
--- a/matcher.lisp
+++ /dev/null
@@ -1,113 +0,0 @@
-
-(in-package :parse-css)
-
-(defgeneric cb= (parser item &key start1))
-(defgeneric match (parser item))
-(defgeneric match-until (parser item))
-(defgeneric match-option (parser function))
-(defgeneric match-times (parser function min max))
-
-(defmethod cb= ((p parser) (s string) &key (start1 0))
-  (let ((cb (parser-cb p))
-	(end (length s)))
-    (when (<= end (- (fill-pointer cb) start1))
-      (locally (declare (optimize (safety 0)))
-	(labels ((at (m i)
-		   (declare (type fixnum m i))
-		   (cond ((= end i)
-			  t)
-			 ((= (aref cb m) (char-code (char s i)))
-			  (at (the fixnum (1+ m)) (the fixnum (1+ i))))
-			 (t
-			  nil))))
-	  (at start1 0))))))
-
-(defmethod match ((p parser) (s string))
-  (input-length p (length s))
-  (when (cb= p s :start1 (parser-char-match-start p))
-    (incf (parser-char-match-start p) (length s))))
-
-(defmethod match ((p parser) (c fixnum))
-  (when (= (the fixnum (parser-match-char p)) c)
-    (incf (parser-char-match-start p))))
-
-(defmethod match ((p parser) (c character))
-  (match p (char-code c)))
-
-(defmethod match-until ((p parser) (s string))
-  (input-length p (length s))
-  (labels ((maybe-eat ()
-	     (or (match p s)
-		 (and (not (match p -1))
-		      (progn
-			(input-char p)
-			(incf (parser-char-match-start p))
-			(maybe-eat))))))
-    (maybe-eat)))
-
-(defmethod match-option ((p parser) (f function))
-  (or (funcall f p)
-      (parser-char-match-start p)))
-
-(defmacro match-not (p &body body)
-  (let ((parser (gensym "PARSER-"))
-	(match-start (gensym "MATCH-START-"))
-	(result (gensym "RESULT-")))
-    `(let* ((,parser ,p)
-	    (,match-start (parser-char-match-start ,parser))
-	    (,result (progn ,@body)))
-       (cond ((or ,result
-		  (match p -1))
-	      (setf (parser-char-match-start ,parser) ,match-start)
-	      nil)
-	     (t
-	      (incf (parser-char-match-start p)))))))
-
-(defmacro match-sequence (p &body body)
-  (let ((parser (gensym "PARSER-"))
-	(match-start (gensym "MATCH-START-"))
-	(result (gensym "RESULT-")))
-    `(let* ((,parser ,p)
-	    (,match-start (parser-char-match-start ,parser))
-	    (,result (progn ,@body)))
-       (cond (,result
-	      ,result)
-	     (t
-	      (setf (parser-char-match-start ,parser) ,match-start)
-	      nil)))))
-
-(defmethod match-times ((p parser) (f function) (min fixnum) (max fixnum))
-  (match-sequence p
-    (labels ((match-min ()
-	       (cond ((= 0 min)
-		      (match-max))
-		     ((funcall f p)
-		      (decf min)
-		      (decf max)
-		      (match-min))
-		     (t
-		      nil)))
-	     (match-max ()
-	       (cond ((and (< 0 max) (funcall f p))
-		      (decf max)
-		      (match-max))
-		     (t
-		      (parser-char-match-start p)))))
-      (match-min))))
-
-(defmethod match-times ((p parser) (f function) (min fixnum) (max null))
-  (match-sequence p
-    (labels ((match-min ()
-	       (cond ((= 0 min)
-		      (match-max))
-		     ((funcall f p)
-		      (decf min)
-		      (match-min))
-		     (t
-		      nil)))
-	     (match-max ()
-	       (cond ((funcall f p)
-		      (match-max))
-		     (t
-		      (parser-char-match-start p)))))
-      (match-min))))