projects
/
sbcl.git
/ blobdiff
commit
grep
author
committer
pickaxe
?
search:
re
summary
|
shortlog
|
log
|
commit
|
commitdiff
|
tree
raw
|
inline
| side by side
More explicit high-level interface for consets
[sbcl.git]
/
src
/
code
/
target-format.lisp
diff --git
a/src/code/target-format.lisp
b/src/code/target-format.lisp
index
c851874
..
6419712
100644
(file)
--- a/
src/code/target-format.lisp
+++ b/
src/code/target-format.lisp
@@
-51,6
+51,12
@@
(%format destination control-string format-arguments)
nil)))
(%format destination control-string format-arguments)
nil)))
+(define-compiler-macro format (&whole form destination control &rest args)
+ (declare (ignore control args))
+ (when (stringp destination)
+ (warn "Literal string as destination in FORMAT:~% ~S" form))
+ form)
+
(defun %format (stream string-or-fun orig-args &optional (args orig-args))
(if (functionp string-or-fun)
(apply string-or-fun stream args)
(defun %format (stream string-or-fun orig-args &optional (args orig-args))
(if (functionp string-or-fun)
(apply string-or-fun stream args)
@@
-78,8
+84,7
@@
(function
(typecase character
(base-char
(function
(typecase character
(base-char
- (svref *format-directive-interpreters* (char-code character)))
- (character nil)))
+ (svref *format-directive-interpreters* (char-code character)))))
(*default-format-error-offset*
(1- (format-directive-end directive))))
(unless function
(*default-format-error-offset*
(1- (format-directive-end directive))))
(unless function
@@
-281,9
+286,8
@@
:start2 src :end2 (+ src commainterval)))
new-string))))
:start2 src :end2 (+ src commainterval)))
new-string))))
-;;; FIXME: This is only needed in this file, could be defined with
-;;; SB!XC:DEFMACRO inside EVAL-WHEN
-(defmacro interpret-format-integer (base)
+(eval-when (:compile-toplevel :execute)
+(sb!xc:defmacro interpret-format-integer (base)
`(if (or colonp atsignp params)
(interpret-bind-defaults
((mincol 0) (padchar #\space) (commachar #\,) (commainterval 3))
`(if (or colonp atsignp params)
(interpret-bind-defaults
((mincol 0) (padchar #\space) (commachar #\,) (commainterval 3))
@@
-294,6
+298,7
@@
(*print-radix* nil)
(*print-escape* nil))
(output-object (next-arg) stream))))
(*print-radix* nil)
(*print-escape* nil))
(output-object (next-arg) stream))))
+) ; EVAL-WHEN
(def-format-interpreter #\D (colonp atsignp params)
(interpret-format-integer 10))
(def-format-interpreter #\D (colonp atsignp params)
(interpret-format-integer 10))
@@
-599,7
+604,8
@@
(float-nan-p number))
(prin1 number stream)
(multiple-value-bind (num expt) (sb!impl::scale-exponent (abs number))
(float-nan-p number))
(prin1 number stream)
(multiple-value-bind (num expt) (sb!impl::scale-exponent (abs number))
- (let* ((expt (- expt k))
+ (let* ((k (if (= num 1.0) (1- k) k))
+ (expt (- expt k))
(estr (decimal-string (abs expt)))
(elen (if e (max (length estr) e) (length estr)))
spaceleft)
(estr (decimal-string (abs expt)))
(elen (if e (max (length estr) e) (length estr)))
spaceleft)