From: Nikodemus S. <de...@us...> - 2010-09-20 07:33:34
|
Update of /cvsroot/sbcl/sbcl/src/code In directory sfp-cvsdas-3.v30.ch3.sourceforge.com:/tmp/cvs-serv24966/src/code Modified Files: reader.lisp Log Message: 1.0.42.46: style-warn users about READ-FROM-STRING &optional gotcha Check -- at runtime if need be! -- if the EOF-ERROR-P argument to READ-FROM-STRING is one of its keyword arguments, and signal a style-warning explaining the issue if so, Since the runtime check surprisingly has a measurable cost, add a compiler-macro that * signals the style-warning at compile-time. * rewrites the call into required-args-only form. Which actually nets us a 2% speedup... perhaps we should consider more widespread rewriting of &KEY calls into required-args-only form. Index: reader.lisp =================================================================== RCS file: /cvsroot/sbcl/sbcl/src/code/reader.lisp,v retrieving revision 1.60 retrieving revision 1.61 diff -u -d -r1.60 -r1.61 --- reader.lisp 4 Jan 2010 15:55:21 -0000 1.60 +++ reader.lisp 20 Sep 2010 07:33:24 -0000 1.61 @@ -1542,14 +1542,19 @@ ;;;; READ-FROM-STRING -(defun read-from-string (string &optional (eof-error-p t) eof-value - &key (start 0) end - preserve-whitespace) - #!+sb-doc - "The characters of string are successively given to the lisp reader - and the lisp object built by the reader is returned. Macro chars - will take effect." - (declare (string string)) +(defun maybe-note-read-from-string-signature-issue (eof-error-p) + ;; The interface is so unintuitive that we explicitly check for the common + ;; error. + (when (member eof-error-p '(:start :end :preserve-whitespace)) + (style-warn "~@<~S as EOF-ERROR-P argument to ~S: probable error. ~ + Two optional arguments must be provided before the ~ + first keyword argument.~:@>" + eof-error-p 'read-from-string) + t)) + +(declaim (ftype (sfunction (string t t index (or null index) t) (values t index)) + %read-from-string)) +(defun %read-from-string (string eof-error-p eof-value start end preserve-whitespace) (with-array-data ((string string :offset-var offset) (start start) (end end) @@ -1559,6 +1564,55 @@ (%read-preserving-whitespace stream eof-error-p eof-value nil) (read stream eof-error-p eof-value)) (- (string-input-stream-current stream) offset))))) + +(defun read-from-string (string &optional (eof-error-p t) eof-value + &key (start 0) end preserve-whitespace) + #!+sb-doc + "The characters of string are successively given to the lisp reader + and the lisp object built by the reader is returned. Macro chars + will take effect." + (declare (string string)) + (maybe-note-read-from-string-signature-issue eof-error-p) + (%read-from-string string eof-error-p eof-value start end preserve-whitespace)) + +(define-compiler-macro read-from-string (&whole form string &rest args) + ;; Check this at compile-time, and rewrite it so we're silent at runtime. + (destructuring-bind (&optional eof-error-p eof-value &rest keys) + args + (cond ((maybe-note-read-from-string-signature-issue eof-error-p) + `(read-from-string ,string t ,eof-value ,@keys)) + (t + (let* ((start (gensym "START")) + (end (gensym "END")) + (preserve-whitespace (gensym "PRESERVE-WHITESPACE")) + bind seen ignore) + (do () + ((not (cdr keys)) + ;; Odd number of keys, punt. + (when keys (return-from read-from-string form))) + (let* ((key (pop keys)) + (value (pop keys)) + (var (case key + (:start start) + (:end end) + (:preserve-whitespace preserve-whitespace) + (otherwise + (return-from read-from-string form))))) + (when (assoc key seen) + (setf var (gensym "IGNORE")) + (push var ignore)) + (push key seen) + (push (list var value) bind))) + (dolist (default (list (list start 0) + (list end nil) + (list preserve-whitespace nil))) + (unless (assoc (car default) bind) + (push default bind))) + (once-only ((string string)) + `(let ,(nreverse bind) + ,@(when ignore `((declare (ignore ,@ignore)))) + (%read-from-string ,string ,eof-error-p ,eof-value + ,start ,end ,preserve-whitespace)))))))) ;;;; PARSE-INTEGER |