Commit 59e48b3c4657053d6e3c74107ad7818340b892e4

Thomas de Grivel 2018-06-29T05:55:57

Rename to css-parser, depend on cl-stream/parser-stream

diff --git a/css-parser.asd b/css-parser.asd
new file mode 100644
index 0000000..d959968
--- /dev/null
+++ b/css-parser.asd
@@ -0,0 +1,24 @@
+
+(in-package :common-lisp-user)
+
+(defpackage :css-parser.system
+  (:use :common-lisp :asdf))
+
+(in-package :css-parser.system)
+
+(defsystem :css-parser
+  :name "css-parser"
+  :author "Thomas de Grivel <thoxdg@gmail.com>"
+  :version "0.2"
+  :description "CSS level 3 parser"
+  :depends-on ("css-lexer" "parser-stream" "str")
+  :components
+  ((:file "package")
+   (:file "css-parser" :depends-on ("package"))))
+
+(defsystem :css-parser/test
+  :depends-on ("babel-stream"
+               "css-parser"
+               "unistd-stream")
+  :components
+  ((:file "test")))
diff --git a/css-parser.lisp b/css-parser.lisp
index 7c2d80a..37e4aae 100644
--- a/css-parser.lisp
+++ b/css-parser.lisp
@@ -1,5 +1,5 @@
 
-(in-package :parse-css)
+(in-package :css-parser)
 
 (defclass css-item (item)
   ((parent :initarg :parent
@@ -69,7 +69,7 @@
 	     :reader item-function
 	     :type function-token)))
 
-(defclass css-parser (parser)
+(defclass css-parser (parser-stream)
   ((item :initform (make-instance 'stylesheet)
          :accessor parser-item
          :type css-item)))
@@ -240,7 +240,8 @@
 (defun css-parser (stream)
   (make-instance 'css-parser :stream stream))
 
-(trace
+#+nil
+(untrace
  item-append
  ;match-not
  ;match-or
diff --git a/package.lisp b/package.lisp
index 81d577d..338039c 100644
--- a/package.lisp
+++ b/package.lisp
@@ -1,10 +1,11 @@
 
 (in-package :common-lisp-user)
 
-(defpackage :parse-css
+(defpackage :css-parser
   (:use :cl-stream
         :common-lisp
         :css-lexer
+        :parser-stream
         :str)
   #.(cl-stream:shadowing-import-from)
   (:export
diff --git a/parse-css.asd b/parse-css.asd
deleted file mode 100644
index dfbbc34..0000000
--- a/parse-css.asd
+++ /dev/null
@@ -1,25 +0,0 @@
-
-(in-package :common-lisp-user)
-
-(defpackage :parse-css.system
-  (:use :common-lisp :asdf))
-
-(in-package :parse-css.system)
-
-(defsystem :parse-css
-  :name "parse-css"
-  :author "Thomas de Grivel <thoxdg@gmail.com>"
-  :version "0.2"
-  :description "CSS level 3 parser"
-  :depends-on ("css-lexer" "str")
-  :components
-  ((:file "package")
-   (:file "parser" :depends-on ("package"))
-   (: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
deleted file mode 100644
index b9940b0..0000000
--- a/parser.lisp
+++ /dev/null
@@ -1,204 +0,0 @@
-
-(in-package :parse-css)
-
-(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))
-  (let ((buf (parser-buffer pr)))
-    (declare (type (vector token) buf))
-    (when (< index (fill-pointer buf))
-      (aref buf 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))
-       (unless (< length n)
-         (return t))
-       (when (parser-input-ended pr)
-         (return))
-       (parser-input pr))))
-
-(defmethod parser-match-token ((pr parser) (index integer))
-  (declare (type fixnum index))
-  (when (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 (and item (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)))
-             (when token
-               (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/tokenizer.lisp b/tokenizer.lisp
deleted file mode 100644
index 05462fc..0000000
--- a/tokenizer.lisp
+++ /dev/null
@@ -1,41 +0,0 @@
-
-(in-package :parse-css)
-
-(defgeneric push-token (parser))
-(defgeneric pop-token (parser))
-(defgeneric make-token (parser class &rest initargs))
-(defgeneric discard-token (parser))
-
-(defmethod push-token ((p parser))
-  (let ((token (make-instance 'parser-token
-			      :start (parser-char-match-start p)
-			      :line (parser-input-line p)
-			      :character (parser-input-character p))))
-    (push token (parser-token-stack p))))
-
-(defmethod pop-token ((p parser))
-  (assert (parser-token-stack p))
-  (let* ((cb (parser-cb p))
-	 (fill-pointer (fill-pointer cb))
-	 (token (pop (parser-token-stack p)))
-	 (match-start (parser-char-match-start p)))
-    (setf (token-string token) (cb-string cb
-					  (token-start token)
-					  match-start))
-    (when (endp (parser-token-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)))
-    token))
-
-(defmethod make-token ((p parser) (class symbol) &rest initargs)
-  (let ((pt (pop-token p)))
-    (apply #'make-instance class
-	   :string (token-string pt)
-	   :line (token-line pt)
-	   :character (token-character pt)
-	   initargs)))
-
-(defmethod discard-token ((p parser))
-  (pop-token p)
-  nil)