thodg/css-parser

diff --git a/css-parser.lisp b/css-parser.lisp
index 1853c20..2dd96a3 100644
--- a/css-parser.lisp
+++ b/css-parser.lisp
@@ -1,31 +1,46 @@
 
 (in-package :parse-css)
 
-(defclass item ()
+(defclass css-item (item)
   ((parent :initarg :parent
 	   :accessor item-parent
 	   :type (or null item))))
 
-(defclass named-item (item)
+(defclass named-item (css-item)
   ((name :initarg :name
 	 :accessor item-name
 	 :type string)))
 
-(defclass with-prelude (item)
+(defclass with-prelude (css-item)
   ((prelude :initarg :prelude
 	    :initform nil
 	    :accessor item-prelude
 	    :type list)))
 
-(defclass with-items (item)
+(defclass with-items (css-item)
   ((items :initarg :items
 	  :initform nil
 	  :accessor item-items
-	  :type list)))
+	  :type list)
+   (items-end :initform nil
+              :accessor item-items-end
+              :type list)))
+
+(defgeneric item-append (with-items item))
+
+(defmethod item-append ((parent with-items) (item item))
+  (let ((end (list item)))
+    (cond ((endp (item-items parent))
+           (setf (item-items parent) end
+                 (item-items-end parent) end))
+          (t
+           (setf (cdr (item-items-end parent)) end
+                 (item-items-end parent) end))))
+  item)
 
 (defclass stylesheet (with-items) ())
 
-(defclass toplevel-flag (item)
+(defclass toplevel-flag (css-item)
   ((toplevel :initarg :toplevel
 	     :initform nil
 	     :accessor item-toplevel
@@ -34,23 +49,18 @@
 (defclass at-rule (named-item with-prelude with-items toplevel-flag) ())
 (defclass qualified-rule (with-prelude with-items toplevel-flag) ())
 
-(defclass css-declaration (named-item)
-  ((values :initarg :value
-	   :initform nil
-	   :accessor item-value
-	   :type list)
-   (important-p :initarg :important
-		:initform nil
-		:accessor important-p
-		:type boolean)))
-
-(defclass component-value (item) ())
-
-(defclass values-block (item)
+(defclass values-block (css-item)
   ((values :initarg :values
+           :initform nil
 	   :accessor item-values
 	   :type list)))
 
+(defclass css-declaration (named-item values-block)
+  ((important-p :initarg :important
+		:initform nil
+		:accessor important-p
+		:type boolean)))
+
 (defclass {}-block (values-block) ())
 (defclass paren-block (values-block) ())
 (defclass []-block (values-block) ())
@@ -59,71 +69,17 @@
 	     :reader item-function
 	     :type function-token)))
 
-(defun make-item-buffer ()
-  (make-array 64
-	      :adjustable t
-	      :fill-pointer 0))
-
-(defmethod item-push-extend ((p parser) (item item))
-  (vector-push-extend item (parser-ib p) 64))
-
-(defmethod item-input ((p parser) (length fixnum))
-  (unless (= 0 length)
-    (item-push-extend p (consume-token p))
-    (item-input p (1- length))))
-
-(defmethod parser-match-item ((p parser))
-  (item-input p 1)
-  (aref (parser-ib p) (parser-item-match-start p)))
-
-(defmethod item-match ((p parser) (type symbol))
-  (let ((item (parser-match-item p)))
-    (when (typep item type)
-      (incf (parser-item-match-start p))
-      item)))
-
-(defmethod item-match ((p parser) (type list))
-  (let ((item (parser-match-item p)))
-    (when (typep item type)
-      (incf (parser-item-match-start p))
-      item)))
-
-(defmethod push-item ((p parser))
-  (push (parser-item-match-start p) (parser-item-stack p)))
-
-(defmethod pop-item ((p parser))
-  (assert (parser-item-stack p))
-  (let* ((cb (parser-cb p))
-	 (fill-pointer (fill-pointer cb))
-	 (item (pop (parser-item-stack p)))
-	 (match-start (parser-char-match-start p)))
-    (setf (item-string item) (cb-string cb
-					  (item-start item)
-					  match-start))
-    (when (endp (parser-item-stack p))
-      (replace cb cb :start2 match-start :end2 fill-pointer)
-      (setf (parser-char-match-start p) 0
-	    (fill-pointer (parser-cb p)) (- fill-pointer match-start)))
-    item))
-
-(defmethod make-item ((p parser) (class symbol) &rest initargs)
-  (let ((pt (pop-item p)))
-    (apply #'make-instance class
-	   :string (item-string pt)
-	   :line (item-line pt)
-	   :character (item-character pt)
-	   initargs)))
-
-(defmethod discard-item ((p parser))
-  (pop-item p)
-  nil)
+(defclass css-parser (parser)
+  ((item :initform (make-instance 'stylesheet)
+         :accessor parser-item
+         :type css-item)))
 
 ;;  Parsing
 
-(defgeneric parser-error (parser message))
-(defgeneric assert-item (parser type))
+(defgeneric parser-error (parser &rest message))
 (defgeneric parse-at-rule (parser &key toplevel))
 (defgeneric parse-qualified-rule (parser &key toplevel))
+(defgeneric parse-declaration (parser))
 (defgeneric parse-component-value (parser))
 (defgeneric parse-component-value* (parser))
 (defgeneric parse-{}-block (parser))
@@ -132,107 +88,174 @@
 (defgeneric parse-function-block (parser))
 (defgeneric parse-preserved-token (parser))
 
-(defmethod parser-error ((p parser) (message string))
-  (error "CSS error ~A:~D:~D ~A"
-	 (parser-input p)
-	 (parser-input-line p)
-	 (parser-input-character p)
-	 message))
-
-(defmethod assert-item ((p parser) (type symbol))
-  (or (typep (parser-item p) type)
-      (parser-error p (format nil "rule expected inside ~A" type))))
-
-(defmethod pop-parser-item ((p parser))
-  (setf (parser-item p) (item-parent (parser-item p))))
-
-(defmethod parse-component-value ((p parser))
-  (or (parse-function-block p)
-      (parse-[]-block p)
-      (parse-paren-block p)
-      (parse-{}-block p)
-      (parse-preserved-token p)))
-
-(defmethod parse-component-value* ((p parser))
-  (let ((value (parse-component-value p)))
-    (when value
-      (cons value (parse-component-value* p)))))
-
-(defmethod parse-{}-block ((p parser))
-  (when ({-token p)
-    (let ((values (parse-component-value* p)))
-      (if (}-token p)
-	  (make-instance '{}-block
-			 :values values)
-	  (parser-error p "expected '}'")))))
-
-(defmethod parse-paren-block ((p parser))
-  (when (left-paren-token p)
-    (let ((values (parse-component-value* p)))
-      (if (right-paren-token p)
-	  (make-instance 'paren-block
-			 :values values)
-	  (parser-error p "expected ')'")))))
-
-(defmethod parse-[]-block ((p parser))
-  (when ([-token p)
-    (let ((values (parse-component-value* p)))
-      (if (]-token p)
-	  (make-instance '[]-block
-			 :values values)
-	  (parser-error p "expected ']'")))))
-
-(defmethod parse-function-block ((p parser))
-  (let ((fun (function-token p)))
-    (when fun
-      (let ((values (parse-component-value* p)))
-	(if (right-paren-token p)
-	    (make-instance 'function-block
-			   :function fun
-			   :values values)
-	    (parser-error p "expected ')'"))))))
-
-(defmethod parse-preserved-token ((p parser))
-  (let ((token (consume-token p)))
-    (if (typep token '(or function-token {-token left-paren-token [-token))
-	(parser-error p (format nil "unexpected '~A'" (token-string token)))
-	token)))
-
-(defmethod parse-at-rule ((p parser) &key toplevel)
-  (let ((at-keyword (at-keyword-token p)))
+(defmethod parser-error ((pr parser) &rest message)
+  (let ((token (parser-token pr 0)))
+    (error "CSS error ~A:~A ~A"
+           (token-line token)
+           (token-character token)
+           (str message))))
+
+(defmethod parse-component-value ((pr parser))
+  (or (parse-function-block pr)
+      (parse-[]-block pr)
+      (parse-paren-block pr)
+      (parse-declaration pr)
+      (parse-preserved-token pr)))
+
+(defmethod parse-component-value* ((pr parser))
+  (let ((values ()))
+    (loop (or (match pr 'whitespace-token)
+              (let ((value (parse-component-value pr)))
+                (when value
+                  (push value values)))
+              (return)))
+    (nreverse values)))
+
+(defmethod parse-{}-block ((pr parser))
+  (match-sequence pr
+    (when (match pr '{-token)
+      (let ((values (parse-component-value* pr)))
+        (when values
+          (if (match pr '}-token)
+              (setf (item-items (parser-item pr)) values)
+              (parser-error pr "expected '}'")))))))
+
+(defmethod parse-paren-block ((pr parser))
+  (match-sequence pr
+    (when (match pr 'left-paren-token)
+      (let ((values (parse-component-value* pr)))
+        (if (match pr 'right-paren-token)
+            (make-instance 'paren-block :values values)
+            (parser-error pr "expected ')'"))))))
+
+(defmethod parse-[]-block ((pr parser))
+  (match-sequence pr
+    (when (match pr '[-token)
+      (let ((values (parse-component-value* pr)))
+        (if (match pr ']-token)
+            (make-instance '[]-block :values values)
+            (parser-error pr "expected ']'"))))))
+
+(defmethod parse-function-block ((pr parser))
+  (match-sequence pr
+    (let ((fun (match pr 'function-token)))
+      (when fun
+        (let ((values (parse-component-value* pr)))
+          (if (match pr 'right-paren-token)
+              (make-instance 'function-block
+                             :function fun
+                             :values values)
+              (parser-error pr "expected ')'")))))))
+
+(defmethod parse-preserved-token ((pr parser))
+  (match-not pr (lambda (pr)
+                  (match-or pr '({-token }-token
+                                 [-token ]-token
+                                 left-paren-token right-paren-token
+                                 eof-token)))))
+
+(defmethod parse-declaration ((pr parser))
+  (match-sequence pr
+    (match pr 'whitespace-token)
+    (let ((name (parse-preserved-token pr)))
+      (when name
+        (let ((prop (make-instance 'css-declaration
+                                   :name (token-string name))))
+          (trace match)
+          (unwind-protect
+               (progn
+                 (match pr 'whitespace-token)
+                 (when (match pr 'colon-token)
+                   (loop
+                      (match pr 'whitespace-token)
+                      (when (or (match pr 'semicolon-token)
+                                (typep (parser-match-token pr 0) '}-token))
+                        (return prop))
+                      (let ((value (parse-preserved-token pr)))
+                        (when value
+                          (push value (item-values prop)))))))
+            (untrace match)))))))
+  
+(defmethod parse-at-rule ((pr parser) &key toplevel)
+  (parser-push pr)
+  (let ((at-keyword (match pr 'at-keyword-token)))
     (when at-keyword
-      (let* ((parent (parser-item p))
-	     (name (token-string (token-ident at-keyword)))
-	     (prelude (parse-component-value* p))
-	     (item (make-instance 'at-rule
-				  :parent parent
-				  :name name
-				  :prelude prelude
-				  :toplevel toplevel)))
-	(setf (parser-item p) item)
-	(cond ((or (semicolon-token p)
-		   (parse-{}-block p))
-	       (push item (item-items parent))
-	       (pop-parser-item p)
-	       item)
+      (let* ((parent (parser-item pr))
+             (name (token-string (token-ident at-keyword)))
+             (prelude (parse-component-value* pr))
+             (item (make-instance 'at-rule
+                                  :parent parent
+                                  :name name
+                                  :prelude prelude
+                                  :toplevel toplevel)))
+        (setf (parser-item pr) item)
+	(cond ((or (semicolon-token pr)
+                   (parse-{}-block pr))
+               (item-append parent item)
+               (setf (parser-item pr) parent)
+               item)
 	      (t
-	       (pop-parser-item p)
+	       (parser-pop pr)
 	       nil))))))
 
-(defmethod parse-rule-list ((p parser))
-  (if (or (parse-at-rule p)
-	  (parse-qualified-rule p)
-	  (whitespace-token p))
-      (parse-rule-list p))
+(defmethod parse-rule-list ((pr parser))
+  (if (or (parse-at-rule pr)
+	  (parse-qualified-rule pr)
+	  (match pr 'whitespace-token))
+      (parse-rule-list pr))
       t)
 
-(defmethod parse-stylesheet ((p parser))
-  (setf (parser-item p) (make-instance 'stylesheet :parent nil))
-  (or (and (or (parse-at-rule p :toplevel t)
-	       (parse-qualified-rule p :toplevel t)
-	       (whitespace-token p)
-	       (cdc-token p)
-	       (cdc-token p))
-	   (parse-stylesheet p))
-      (eof-token p)
-      (parser-error p "at top level")))
+(defmethod parse-qualified-rule ((pr parser) &key toplevel)
+  (match-sequence pr
+    (let* ((parent (parser-item pr))
+           (prelude (parse-component-value* pr))
+           (item (make-instance 'qualified-rule
+                                :prelude prelude
+                                :parent parent
+                                :toplevel toplevel)))
+      (setf (parser-item pr) item)
+      (let ((block (parse-{}-block pr)))
+        (when block
+          (setf (item-items item) block)
+          (item-append parent item))
+        (setf (parser-item pr) parent)
+        (when block
+          item)))))
+
+(defmethod parse-stylesheet ((pr parser))
+  (let ((stylesheet (make-instance 'stylesheet :parent nil)))
+    (setf (parser-item pr) stylesheet)
+    (loop
+       (unless (or (parse-at-rule pr :toplevel t)
+                   (parse-qualified-rule pr :toplevel t)
+                   (match pr 'whitespace-token)
+                   (match pr 'cdo-token)
+                   (match pr 'cdc-token))
+         (return)))
+    (unless (match pr 'eof-token)
+      (parser-error pr "at top level"))
+    stylesheet))
+
+(defmethod parser-parse ((pr parser))
+  (parse-stylesheet pr))
+
+(defun css-parser (stream)
+  (make-instance 'css-parser :stream stream))
+
+(trace
+ item-append
+ ;match-not
+ ;match-or
+ parse-stylesheet
+ parse-qualified-rule
+ parse-rule-list
+ parse-at-rule
+ parse-preserved-token
+ ;parse-function-block
+ ;parse-[]-block
+ ;parse-paren-block
+ parse-{}-block
+ parse-component-values*
+ parse-component-value
+ parse-declaration
+ )
diff --git a/input.lisp b/input.lisp
deleted file mode 100644
index 57180cb..0000000
--- a/input.lisp
+++ /dev/null
@@ -1,74 +0,0 @@
-
-(in-package :parse-css)
-
-(defgeneric cb-string (cb start end))
-(defgeneric cb-push-extend (parser character))
-(defgeneric input-char (parser))
-(defgeneric input-length (parser length))
-(defgeneric parser-match-char (parser &optional char-index))
-
-(defun make-character-buffer (&optional string (start 0))
-  (let* ((length (when string (- (length string) start)))
-	 (cb (make-array (if string
-			     (* 64 (ceiling length 64))
-			     64)
-			 :element-type 'fixnum
-			 :adjustable t
-			 :fill-pointer 0)))
-    (when string
-      (setf (fill-pointer cb) length)
-      (replace cb string :start2 start))
-    cb))
-
-(defmethod cb-string ((cb array) (start fixnum) (end fixnum))
-  (let* ((length (- end start))
-	 (s (make-string length)))
-    (labels ((at (i j)
-	       (let ((cb-char (aref cb i)))
-		 (unless (or (= length j)
-			     (= cb-char -1))
-		   (setf (char s j) (code-char cb-char))
-		   (at (1+ i) (1+ j))))))
-      (at start 0))))
-    
-(defmethod cb-push-extend ((p parser) (c fixnum))
-  (let ((cb (parser-cb p)))
-    (let* ((fill-pointer (fill-pointer cb))
-	   (new-fill-pointer (1+ fill-pointer)))
-      (if (= fill-pointer (array-dimension cb 0))
-	  (setf (parser-cb p) (adjust-array cb (+ fill-pointer 64)
-					    :fill-pointer new-fill-pointer))
-	  (setf (fill-pointer cb) new-fill-pointer))
-      (locally (declare (optimize (safety 0)))
-	(setf (aref cb fill-pointer) c))
-      fill-pointer)))
-
-(defun read-char-code (stream)
-  (let ((c (read-char stream nil nil)))
-    (if c (char-code c) -1)))
-
-(defmethod input-char ((p parser))
-  (let* ((in (parser-input p))
-	 (c (read-char-code in))
-	 (pos (cb-push-extend p c)))
-    (cond ((or (and (= #x000A c)
-		    (not (and (< 0 pos)
-			      (= #x000D (aref (parser-cb p) (1- pos))))))
-	       (= #x000D c)
-	       (= #x000C c))
-	   (setf (parser-input-character p) 0)
-	   (incf (parser-input-line p)))
-	  (t
-	   (incf (parser-input-character p))))
-    c))
-
-(defmethod input-length ((p parser) (length fixnum))
-  (when (< (- (fill-pointer (parser-cb p))
-	      (parser-char-match-start p))
-	   length)
-    (input-char p)
-    (input-length p length)))
-
-(defmethod parser-match-char ((p parser) &optional (index 0))
-  (input-length p (1+ index))
-  (aref (parser-cb p) (+ (parser-char-match-start p) index)))
diff --git a/package.lisp b/package.lisp
index 90dbad5..81d577d 100644
--- a/package.lisp
+++ b/package.lisp
@@ -2,5 +2,12 @@
 (in-package :common-lisp-user)
 
 (defpackage :parse-css
-  (:use :common-lisp)
-  (:export #:parser))
+  (:use :cl-stream
+        :common-lisp
+        :css-lexer
+        :str)
+  #.(cl-stream:shadowing-import-from)
+  (:export
+   #:css-item
+   #:parse-stylesheet
+   #:css-parser))
diff --git a/parse-css.asd b/parse-css.asd
index 87d0203..dfbbc34 100644
--- a/parse-css.asd
+++ b/parse-css.asd
@@ -9,14 +9,17 @@
 (defsystem :parse-css
   :name "parse-css"
   :author "Thomas de Grivel <thoxdg@gmail.com>"
-  :version "0.1"
+  :version "0.2"
   :description "CSS level 3 parser"
-  :depends-on ()
+  :depends-on ("css-lexer" "str")
   :components
   ((:file "package")
    (:file "parser" :depends-on ("package"))
-   (:file "input" :depends-on ("parser"))
-   (:file "matcher" :depends-on ("parser"))
-   (:file "tokenizer" :depends-on ("parser"))
-   (:file "css-lexer" :depends-on ("input" "matcher" "tokenizer"))
-   (:file "css-parser" :depends-on ("css-lexer"))))
+   (:file "css-parser" :depends-on ("parser"))))
+
+(defsystem :parse-css/test
+  :depends-on ("babel-stream"
+               "parse-css"
+               "unistd-stream")
+  :components
+  ((:file "test")))
diff --git a/parser.lisp b/parser.lisp
index 67741d0..538934a 100644
--- a/parser.lisp
+++ b/parser.lisp
@@ -1,53 +1,200 @@
 
 (in-package :parse-css)
 
-(defclass token ()
-  ((string :initarg :string
-	   :accessor token-string
-	   :type string)
-   (line :initarg :line
-	 :initform 0
-	 :accessor token-line
-	 :type fixnum)
-   (character :initarg :character
-	      :initform 0
-	      :accessor token-character
-	      :type fixnum)))
-
-(defclass parser-token (token)
-  ((start :initarg :start
-	  :accessor token-start
-	  :type fixnum)))
-
-(defclass parser ()
-  ((input :initarg :stream
-	   :reader parser-input
-	   :type stream)
-   (input-line :initarg :input-line
-	       :initform 0
-	       :accessor parser-input-line
-	       :type fixnum)
-   (input-character :initarg :input-character
-		    :initform -1
-		    :accessor parser-input-character
-		    :type fixnum)
-   (eof :initform nil
-	:accessor parser-eof)
-   (cb :initform (make-character-buffer)
-       :accessor parser-cb
-       :type array)
-   (char-match-start :initform 0
-		     :accessor parser-char-match-start
-		     :type fixnum)
-   (token-stack :initform ()
-		:accessor parser-token-stack
-		:type list)
-   (ib :initform (make-item-buffer)
-       :accessor parser-ib
-       :type vector)
-   (item-match-start :initform 0
-		     :accessor parser-item-match-start
-		     :type fixnum)
-   (item-stack :initform ()
-	       :accessor parser-item-stack
-	       :type list)))
+(defvar *buffer-size* 64)
+
+(defclass item ()
+  ((tokens :initform #()
+           :accessor item-tokens
+           :type simple-vector)))
+
+(defgeneric item-character (item))
+(defgeneric item-line (item))
+(defgeneric item-token (item n))
+
+(defmethod item-token ((item item) (n integer))
+  (declare (type fixnum n))
+  (svref (item-tokens item) n))
+
+(defmethod item-line ((item item))
+  (token-stream:token-line (item-token item 0)))
+
+(defmethod item-character ((item item))
+  (token-stream:token-character (item-token item 0)))
+
+(defun make-buffer ()
+  (make-array `(,*buffer-size*)
+	      :adjustable t
+              :element-type '(or null item)
+	      :fill-pointer 0
+              :initial-element nil))
+
+(defclass parser (super-stream input-stream)
+  ((buffer :initform (make-buffer)
+           :accessor parser-buffer
+           :type (vector token))
+   (eof-p :initform nil
+          :accessor parser-eof-p
+          :type boolean)
+   (input-ended :initform nil
+                :accessor parser-input-ended
+                :type boolean)
+   (match-start :initform 0
+                :accessor parser-match-start
+                :type fixnum)
+   (stack :initform ()
+          :accessor parser-stack
+          :type list)))
+
+(defmethod stream-element-type ((stream parser))
+  'item)
+
+;;  Input
+
+(defmethod parser-push-extend ((pr parser) item)
+  (vector-push-extend item (parser-buffer pr) 64))
+
+(defmethod parser-token ((pr parser) (index integer))
+  (declare (type fixnum index))
+  (aref (the (vector token) (parser-buffer pr)) index))
+
+(defmethod parser-input ((pr parser))
+  (let ((in (stream-underlying-stream pr)))
+    (multiple-value-bind (token state) (stream-read in)
+      (ecase state
+        ((nil) (parser-push-extend pr token)
+         (values token nil))
+        ((:eof) (setf (parser-input-ended pr) t)
+         (values nil :eof))
+        ((:non-blocking)
+         (signal (make-condition 'non-blocking :stream pr)))))))
+
+(defmethod parser-input-n ((pr parser) (n integer))
+  (declare (type fixnum n))
+  (loop
+     (let ((length (- (the fixnum (fill-pointer (parser-buffer pr)))
+                      (the fixnum (parser-match-start pr)))))
+       (declare (type fixnum length))
+       (when (parser-input-ended pr)
+         (return))
+       (unless (< length n)
+         (return))
+       (parser-input pr))))
+
+(defmethod parser-match-token ((pr parser) (index integer))
+  (declare (type fixnum index))
+  (parser-input-n pr (the fixnum (1+ index)))
+  (let ((buf (parser-buffer pr))
+        (match-index (+ (the fixnum (parser-match-start pr))
+                        index)))
+    (declare (type vector buf)
+             (type fixnum match-index))
+    (aref (the (vector token) buf) match-index)))
+
+;;  Matcher
+
+(defmethod match ((pr parser) (type symbol))
+  (let ((item (parser-match-token pr 0)))
+    (when (subtypep (type-of item) (find-class type))
+      (incf (the fixnum (parser-match-start pr)))
+      item)))
+
+(defmethod match-or ((pr parser) (types cons))
+  (loop
+     (when (endp types)
+       (return))
+     (let* ((type (pop types))
+            (token (match pr type)))
+       (when token
+         (return token)))))
+
+(defmethod match-option ((pr parser) (f function))
+  (or (funcall f pr)
+      (parser-match-start pr)))
+
+(defmethod match-not ((pr parser) (f function))
+  (let ((match-start (parser-match-start pr)))
+    (cond ((or (funcall f pr)
+               (parser-input-ended pr))
+           (setf (parser-match-start pr) match-start)
+           nil)
+          (t
+           (let ((token (parser-match-token pr 0)))
+             (incf (the fixnum (parser-match-start pr)))
+             token)))))
+
+(defmacro match-sequence (parser &body body)
+  (let ((pr (gensym "PR-"))
+	(match-start (gensym "MATCH-START-"))
+	(result (gensym "RESULT-")))
+    `(let* ((,pr ,parser)
+	    (,match-start (parser-match-start ,pr))
+	    (,result (progn ,@body)))
+       (cond (,result
+	      ,result)
+	     (t
+	      (setf (parser-match-start ,pr) ,match-start)
+	      nil)))))
+
+(defmethod match-times ((pr parser) (f function) (min integer) (max integer))
+  (declare (type fixnum min max))
+  (match-sequence pr
+    (let ((n 0))
+      (loop
+         (unless (< n max)
+           (return (parser-match-start pr)))
+         (unless (funcall f pr)
+           (if (< n min)
+               (return nil)
+               (return (parser-match-start pr))))
+         (incf n)))))
+
+(defmethod match-times ((pr parser) (f function) (min integer) (max null))
+  (declare (type fixnum min))
+  (match-sequence pr
+    (let ((n 0))
+      (declare (type fixnum n))
+      (loop
+         (unless (funcall f pr)
+           (if (< n min)
+               (return nil)
+               (return (parser-match-start pr))))
+         (incf n)))))
+
+(defmethod stream-read ((pr parser))
+  (if (parser-eof-p pr)
+      (values nil :eof)
+      (handler-case (values (parser-parse pr) nil)
+        (end-of-file () (values nil :eof))
+        (non-blocking () (values nil :non-blocking)))))
+
+;;  Item stack
+
+(defmethod parser-push ((pr parser))
+  (push (parser-match-start pr) (parser-stack pr)))
+
+(defmethod parser-pop ((pr parser))
+  (assert (parser-stack pr))
+  (let* ((buffer (the (vector token) (parser-buffer pr)))
+	 (fp (fill-pointer buffer))
+	 (start (pop (parser-stack pr)))
+	 (match-start (parser-match-start pr))
+         (tokens (subseq buffer start match-start))
+         (item (make-instance 'item :tokens tokens)))
+    (when (endp (parser-stack pr))
+      (replace buffer buffer :start2 match-start :end2 fp)
+      (setf (parser-match-start pr) 0
+	    (fill-pointer (parser-buffer pr)) (- fp match-start)))
+    item))
+
+(defmethod parser-discard ((pr parser))
+  (assert (parser-stack pr))
+  (let* ((buffer (the (vector token) (parser-buffer pr)))
+	 (fp (fill-pointer buffer))
+	 (match-start (parser-match-start pr)))
+    (pop (parser-stack pr))
+    (when (endp (parser-stack pr))
+      (replace buffer buffer :start2 match-start :end2 fp)
+      (setf (parser-match-start pr) 0
+	    (fill-pointer buffer) (- fp match-start)))
+    nil))
diff --git a/test.lisp b/test.lisp
new file mode 100644
index 0000000..e9aa276
--- /dev/null
+++ b/test.lisp
@@ -0,0 +1,34 @@
+
+(in-package :common-lisp-user)
+
+(defpackage :parse-css/test
+  (:use :babel-stream
+        :cl-stream
+        :common-lisp
+        :css-lexer
+        :parse-css
+        :unistd-stream)
+  #.(cl-stream:shadowing-import-from)
+  (:export
+   #:run
+   #:simple-test
+   #:test-file))
+
+(in-package :parse-css/test)
+
+(defun simple-test ()
+  (with-stream (css (css-parser
+                     (css-lexer
+                      (string-input-stream
+                       "body { color: #f00; }"))))
+    (stream-read css)))
+
+(defun test-file (path)
+  (with-stream (in (css-lexer
+                    (babel-input-stream
+                     (unistd-stream-open path :read t))))
+    (let ((parser (make-instance 'parser :stream in)))
+      (stream-read parser))))
+
+(defun run ()
+  (simple-test))