OSCL/CXML
2
0
Fork 0
Code Issues Pull Requests Packages Projects Releases Wiki Activity

- use trivial-gray-streams

Browse Source 
- replaced dep-* files, since most of them were identical
This commit is contained in:
dlichteblau
2005-11-26 21:48:15 +00:00
parent b5230358fa
commit 241b24ac25
15 changed files with 112 additions and 358 deletions
Download Patch File Download Diff File Expand all files Collapse all files

12
xml/package.lisp
View File

@ -6,17 +6,7 @@
(in-package :cl-user)
(defpackage :cxml
(:use :cl :runes :encoding)
(:import-from #+sbcl :sb-gray
#+allegro :excl
#+cmu :ext
#+clisp :gray
#+openmcl :ccl
#+lispworks :stream
#-(or sbcl allegro cmu clisp openmcl lispworks) ...
#:fundamental-binary-input-stream
#-(or clisp openmcl) #:stream-read-sequence
stream-read-byte)
(:use :cl :runes :encoding :trivial-gray-streams)
(:export
;; xstreams
#:make-xstream

8
xml/xml-name-rune-p.lisp
View File

@ -11,7 +11,7 @@
(compile
nil
'(lambda ()
(let ((*max* #xD800))
(let ((.max. #xD800))
(labels
((name-start-rune-p (rune)
(or (letter-rune-p rune)
@ -207,7 +207,7 @@
(predicate-to-bv (p)
(let ((r (make-array *max* :element-type 'bit :initial-element 0)))
(let ((r (make-array .max. :element-type 'bit :initial-element 0)))
(dotimes (i #x10000 r)
(when (funcall p i)
(setf (aref r i) 1))))) )
@ -215,13 +215,13 @@
`(progn
(DEFINLINE NAME-RUNE-P (RUNE)
(SETF RUNE (RUNE-CODE RUNE))
(AND (<= 0 RUNE ,*max*)
(AND (<= 0 RUNE ,.max.)
(LOCALLY (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3)))
(= 1 (SBIT ',(predicate-to-bv #'name-rune-p)
(THE FIXNUM RUNE))))))
(DEFINLINE NAME-START-RUNE-P (RUNE)
(SETF RUNE (RUNE-CODE RUNE))
(AND (<= 0 RUNE ,*MAX*)
(AND (<= 0 RUNE ,.MAX.)
(LOCALLY (DECLARE (OPTIMIZE (SAFETY 0) (SPEED 3)))
(= 1 (SBIT ',(predicate-to-bv #'name-start-rune-p)
(THE FIXNUM RUNE)))))))) ))))

35
xml/xml-parse.lisp
View File

@ -2608,7 +2608,7 @@
(if sax:*namespace-processing*
(p/element-ns input)
(p/element-no-ns input)))
(defun p/element-no-ns (input)
;; [39] element ::= EmptyElemTag | STag content ETag
(error "sorry, bitrot")
@ -2660,14 +2660,16 @@
(error "Expecting element, got ~S." cat)))))
(undeclare-namespaces ns-decls))
(validate-end-element *ctx* name)))
(defun perror (stream format-string &rest format-args)
(when (zstream-p stream)
(setf stream (car (zstream-input-stack stream))))
(error "Parse error at line ~D column ~D: ~A"
(xstream-line-number stream)
(xstream-column-number stream)
(apply #'format nil format-string format-args)))
(if stream
(error "Parse error at line ~D column ~D: ~?"
(xstream-line-number stream)
(xstream-column-number stream)
format-string format-args)
(apply #'error format-string format-args)))
(defun p/content (input)
;; [43] content ::= (element | CharData | Reference | CDSect | PI | Comment)*
@ -2988,7 +2990,8 @@
;; XXX encoding is mis-handled by this kind of stream
(make-rod-xstream (string-rod string)))
(defclass octet-input-stream (fundamental-binary-input-stream)
(defclass octet-input-stream
(trivial-gray-stream fundamental-binary-input-stream)
((octets :initarg :octets)
(pos :initform 0)))
@ -3005,9 +3008,7 @@
(incf pos)))))
(defmethod stream-read-sequence
#-lispworks ((stream octet-input-stream) sequence
&optional (start 0) (end (length sequence)))
#+lispworks ((stream octet-input-stream) sequence start end)
((stream octet-input-stream) sequence start end &key &allow-other-keys)
(with-slots (octets pos) stream
(let* ((length (min (- end start) (- (length octets) pos)))
(end1 (+ start length))
@ -3024,20 +3025,6 @@
;;;;
#+allegro
(defmacro sp (&body body)
`(progn
(prof:with-profiling (:type :space) .,body)
(prof:show-flat-profile)))
#+allegro
(defmacro tm (&body body)
`(progn
(prof:with-profiling (:type :time) .,body)
(prof:show-flat-profile)))
;;;;
(defun zstream-push (new-xstream zstream)
(cond ((find-if (lambda (x)
(and (xstream-p x)