Revision: 4090 Author: hans URL: http://bknr.net/trac/changeset/4090
Optimize encoder for a 100x speedup. Don't use PRINC unless you know that you need it.
U trunk/libraries/yason/encode.lisp
Modified: trunk/libraries/yason/encode.lisp =================================================================== --- trunk/libraries/yason/encode.lisp 2008-11-27 12:18:22 UTC (rev 4089) +++ trunk/libraries/yason/encode.lisp 2008-11-27 14:13:59 UTC (rev 4090) @@ -17,99 +17,100 @@
(:documentation "Encode OBJECT to STREAM in JSON format. May be specialized by applications to perform specific rendering. STREAM - defaults to *STANDARD-OUTPUT*.") + defaults to *STANDARD-OUTPUT*."))
- (:method ((object string) &optional (stream *standard-output*)) - (with-standard-output-to (stream) - (princ #") - (loop - for char across object - do (case char - ((#\ #" #/) - (princ #\) (princ char)) - (#\Backspace - (princ #\) (princ #\b)) - (#\Page - (princ #\) (princ #\f)) - (#\Newline - (princ #\) (princ #\n)) - (#\Return - (princ #\) (princ #\r)) - (#\Tab - (princ #\) (princ #\t)) - (t - (princ char)))) - (princ #")) - object) +(defparameter *char-replacements* + (alexandria:plist-hash-table + '(#\ "\\" + #" "\"" + #/ "\/" + #\Backspace "\b" + #\Page "\f" + #\Newline "\n" + #\Return "\r" + #\Tab "\t"))) +
- (:method ((object rational) &optional (stream *standard-output*)) - (encode (float object) stream) - object) +(defmethod encode ((string string) &optional (stream *standard-output*)) + (with-standard-output-to (stream) + (write-char #") + (dotimes (i (length string)) + (let* ((char (aref string i)) + (replacement (gethash char *char-replacements*))) + (if replacement + (write-string replacement) + (write-char char)))) + (write-char #") + string))
- (:method ((object integer) &optional (stream *standard-output*)) - (princ object stream)) +(defmethod encode ((object rational) &optional (stream *standard-output*)) + (encode (float object) stream) + object)
- (:method ((object hash-table) &optional (stream *standard-output*)) - (with-standard-output-to (stream) - (princ #{) - (let (printed) - (maphash (lambda (key value) - (if printed - (princ #,) - (setf printed t)) - (encode key stream) - (princ #:) - (encode value stream)) - object)) - (princ #})) - object) +(defmethod encode ((object integer) &optional (stream *standard-output*)) + (princ object stream))
- (:method ((object vector) &optional (stream *standard-output*)) - (with-standard-output-to (stream) - (princ #[) - (let (printed) - (loop - for value across object - do - (when printed - (princ #,)) - (setf printed t) - (encode value stream))) - (princ #])) - object) +(defmethod encode ((object hash-table) &optional (stream *standard-output*)) + (with-standard-output-to (stream) + (write-char #{) + (let (printed) + (maphash (lambda (key value) + (if printed + (write-char #,) + (setf printed t)) + (encode key stream) + (write-char #:) + (encode value stream)) + object)) + (write-char #})) + object)
- (:method ((object list) &optional (stream *standard-output*)) - (with-standard-output-to (stream) - (princ #[) - (let (printed) - (dolist (value object) - (if printed - (princ #,) - (setf printed t)) - (encode value stream))) - (princ #])) - object) +(defmethod encode ((object vector) &optional (stream *standard-output*)) + (with-standard-output-to (stream) + (write-char #[) + (let (printed) + (loop + for value across object + do + (when printed + (write-char #,)) + (setf printed t) + (encode value stream))) + (write-char #])) + object)
- (:method ((object (eql 'true)) &optional (stream *standard-output*)) - (princ "true" stream) - object) +(defmethod encode ((object list) &optional (stream *standard-output*)) + (with-standard-output-to (stream) + (write-char #[) + (let (printed) + (dolist (value object) + (if printed + (write-char #,) + (setf printed t)) + (encode value stream))) + (write-char #])) + object)
- (:method ((object (eql 'false)) &optional (stream *standard-output*)) - (princ "false" stream) - object) +(defmethod encode ((object (eql 'true)) &optional (stream *standard-output*)) + (write-string "true" stream) + object)
- (:method ((object (eql 'null)) &optional (stream *standard-output*)) - (princ "null" stream) - object) +(defmethod encode ((object (eql 'false)) &optional (stream *standard-output*)) + (write-string "false" stream) + object)
- (:method ((object (eql t)) &optional (stream *standard-output*)) - (princ "true" stream) - object) +(defmethod encode ((object (eql 'null)) &optional (stream *standard-output*)) + (write-string "null" stream) + object)
- (:method ((object (eql nil)) &optional (stream *standard-output*)) - (princ "null" stream) - object)) +(defmethod encode ((object (eql t)) &optional (stream *standard-output*)) + (write-string "true" stream) + object)
+(defmethod encode ((object (eql nil)) &optional (stream *standard-output*)) + (write-string "null" stream) + object) + (defclass json-output-stream () ((output-stream :reader output-stream :initarg :output-stream) @@ -119,7 +120,7 @@
(defun next-aggregate-element () (if (car (stack *json-output*)) - (princ (car (stack *json-output*)) (output-stream *json-output*)) + (write-char (car (stack *json-output*)) (output-stream *json-output*)) (setf (car (stack *json-output*)) #,)))
(defmacro with-output ((stream) &body body) @@ -147,12 +148,12 @@ (error 'no-json-output-context)) (when (stack *json-output*) (next-aggregate-element)) - (princ ,begin-char (output-stream *json-output*)) + (write-char ,begin-char (output-stream *json-output*)) (push nil (stack *json-output*)) (prog1 (progn ,@body) (pop (stack *json-output*)) - (princ ,end-char (output-stream *json-output*))))) + (write-char ,end-char (output-stream *json-output*)))))
(defmacro with-array (() &body body) "Open a JSON array, then run BODY. Inside the body, @@ -188,7 +189,7 @@ type for which an ENCODE method is defined." (next-aggregate-element) (encode key (output-stream *json-output*)) - (princ #: (output-stream *json-output*)) + (write-char #: (output-stream *json-output*)) (encode value (output-stream *json-output*)) value)