[Openmcl-cvs-notifications] r11158 - /trunk/source/lib/format.lisp

gz at clozure.com gz at clozure.com
Sat Oct 18 14:19:22 EDT 2008


Author: gz
Date: Sat Oct 18 14:19:22 2008
New Revision: 11158

Log:
Small optimizations tweaks

Modified:
    trunk/source/lib/format.lisp

Modified: trunk/source/lib/format.lisp
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=3D=
=3D=3D=3D
--- trunk/source/lib/format.lisp (original)
+++ trunk/source/lib/format.lisp Sat Oct 18 14:19:22 2008
@@ -335,9 +335,11 @@
 		       (require-type stream 'stream)))     =

 	(if (functionp control-string)
 	  (apply control-string stream format-arguments)
-	  (let ((*format-control-string* (ensure-simple-string control-string))
-                (*format-pprint* nil)
-                (*format-justification-semi* nil))
+	  (let* ((control-string (ensure-simple-string control-string))
+                 (*format-control-string* control-string)
+                 (*format-pprint* nil)
+                 (*format-justification-semi* nil))
+            (declare (type simple-string control-string))
 	    (cond
 	      ;; Try to avoid pprint overhead in this case.
 	      ((not (position #\~ control-string))
@@ -495,12 +497,12 @@
     (let ((cpos (format-find-char #\: ipos epos))
           package)
       (cond (cpos =

-             (setq package (string-upcase (%substr string ipos cpos)))
+             (setq package (find-package (string-upcase (%substr string ip=
os cpos))))
              (when (eql #\: (schar string (%i+ 1 cpos)))
                (setq cpos (%i+ cpos 1)))
              (setq ipos (%i+ cpos 1)))
-            (t (setq package :cl-user)))
-      (let ((thing (intern (string-upcase (%substr string ipos epos)) (fin=
d-package package))))
+            (t (setq package (find-package "CL-USER"))))
+      (let ((thing (intern (string-upcase (%substr string ipos epos)) pack=
age)))
         (setq *format-index* epos) ; or 1+ epos?
         (apply thing stream (pop-format-arg) colon atsign parms)))))
 =




More information about the Openmcl-cvs-notifications mailing list