I attach an updated printf that fixes a bunch of bugs in %r format, viz:
-- Yijue Hou's -0.8333 problem
-- Rounding instead of truncating
So sprintf("%5.3r", &pi) == 3.142, not 3.141-- The underflow problem, where sprintf("%.5r", 0.00009)
came out all garbled-- The string problem, where under some conditions if you passed in a number as a string it wouldn't get formatted.
BONUS: This version of printf *also* has %e format!
I had send an earlier version of this to Greg Townsend for the IPL. It seems not to have been included yet. Anyway this version fixes more of the %r format bugs, plus one bug in the version I sent to Townsend.
I invite any and all to find the bugs in this version! Then we can submit an update to the IPL with more confidence.
-- Michael Glass Valparaiso University
############################################################################ # # File: printf.icn # # Subject: Procedures for printf-style formatting # # Author: William H. Mitchell # # Date: May 2, 2001 # # UPDATE REVISION: 16 June 2003, Michael Glass. Please send me any # bug fixes, then we can submit to IPL. # ############################################################################ # # This file is in the public domain. # ############################################################################ # # Contributors: Cheyenne Wills, Phillip Lee Thomas, Michael Glass # ############################################################################ # # This procedure behaves somewhat like the standard printf. # Supports d, e, s, o, and x formats like printf. An "r" format # prints real numbers in a manner similar to that of printf's "f", # but will produce a result in an exponential format if the number # is larger than the largest integer plus one. Though "e" differs # from printf in some details, it always produces exponential format. # # Left or right justification and field width control are pro- # vided as in printf. %s, %r, and %e handle precision specifications. # # Code contributions for %f, %e, and %g formats that work like # printf are welcome. # # Possible new formats: # # %t -- print a real number as a time in hh:mm # %R -- roman numerals # %w -- integers in English # %b -- binary # ############################################################################
procedure sprintf(format, args[])
return _doprnt(format, args)
end
procedure fprintf(file, format, args[])
writes(file, _doprnt(format, args))
return
end
procedure printf(format, args[])
writes(&output, _doprnt(format, args))
return
end
procedure _doprnt(format, args)
local out, v, just, width, conv, prec, pad
out := ""
format ? repeat {
(out ||:= tab(upto('%'))) | (out ||:= tab(0) & break)
v := get(args)
move(1)
just := right
width := conv := prec := pad := &null
="-" & just := left
width := tab(many(&digits))
(\width)[1] == "0" & pad := "0"
="." & prec := tab(many(&digits))
conv := move(1)
##write("just: ",image(just),", width: ", width, ", prec: ",
## prec, ", conv: ", conv)
case conv of {
"d": {
v := string(integer(v))
}
"s": {
v := string(v[1:(\prec+1)|0])
}
"x": v := hexstr(v)
"o": v := octstr(v)
"i": v := image(v)
"r": v := rformatstr(v,prec)
"e": v := eformatstr(v, prec, width)
default: {
push(args, v)
v := conv
}
}
if \width & *v < width then {
v := just(v, width, pad)
}
out ||:= v
}
return out
end
procedure hexstr(n)
local h, neg
static BigNeg, hexdigs, hexfix
initial {
BigNeg := -2147483647-1
hexdigs := "0123456789abcdef"
hexfix := "89abcdef"
}
n := integer(n)
if n = BigNeg then
return "80000000"
h := ""
if n < 0 then {
n := -(BigNeg - n)
neg := 1
}
repeat {
h := hexdigs[n%16+1]||h
if (n /:= 16) = 0 then
break
}
if \neg then {
h := right(h,8,"0")
h[1] := hexfix[h[1]+1]
}
return h
end
procedure octstr(n)
local h, neg
static BigNeg, octdigs, octfix
initial {
BigNeg := -2147483647-1
octdigs := "01234567"
octfix := "23"
}
n := integer(n)
if n = BigNeg then
return "20000000000"
h := ""
if n < 0 then {
n := -(BigNeg - n)
neg := 1
}
repeat {
h := octdigs[n%8+1]||h
if (n /:= 8) = 0 then
break
}
if \neg then {
h := right(h,11,"0")
h[1] := octfix[h[1]+1]
}
return h
end
# r-format: [-]mmm.ddd
#
# This is similar to C or Fortran f format.
#
# -- The "precision" (number of decimal places) is adhered to exactly.
#
# -- If there are too many digits in the converted number to fit
# in the available width, then the number is not truncated to
# fit. It just becomes too wide.
#
procedure rformatstr(x, prec)
local s, signpart, wholepart, fracpart, exppart
/prec := 6
# Check for so-large-that-we-return-e-format
integer(x) | return image(x)
# Separate string representation of x into parts
#
s := string(real(x)) | return image(x)
s ? { signpart := (=("-" | "+") | "")
wholepart := 1(tab(many(&digits)), any('.eE')) | return image(x)
fracpart := ((=".", tab(many(&digits))) | "")
exppart := integer((=("e"|"E"), tab(0)) | 0)
}
# Shift fraction into whole part if exponent > 0
#
if exppart > 0 then {
fracpart ||:= repl("0", exppart)
wholepart ||:= fracpart[1+:exppart]
fracpart := fracpart[exppart+1:0]
# Shift whole part into fraction if exponent < 0
#
} else if exppart < 0 then {
wholepart := repl("0", -exppart) || wholepart
fracpart := wholepart[exppart:0] || fracpart
wholepart := wholepart[1:exppart]
}
# Round fraction to requested number of places
#
fracpart := adjustfracprec(fracpart, prec)
wholepart +:= fracpart[2]
# Assemble and return result
#
return signpart || wholepart || "." || fracpart[1]
end
# e-format: [-]m.dddddde(+|-)xx
#
# Differs from C and Fortran E formats primarily in the
# details, among them:
#
# - Single-digit exponents are not padded out to two digits.
#
# - The precision (number of digits after the decimal point)
# is reduced if needed to make the number fit in the available
# width, if possible. The precision is never reduced-to-fit
# below 1 digit after the decimal point.
#
procedure eformatstr(x, prec, width)
local signpart, wholepart, fracpart, exppart
local choppart, shiftcount, toowide
local rslt, s
/prec := 6
/width := prec+7
# Separate string representation of x into parts
#
s := string(real(x)) | return image(x)
s ? { signpart := (=("-" | "+") | "")
wholepart := 1(tab(many(&digits)), any('.eE')) | return image(x)
fracpart := ((=".", tab(many(&digits))) | "")
exppart := integer((=("e"|"E"), tab(0)) | 0)
}
# When the integer part has more than 1 digit, shift it
# right into fractional part and scale the exponent
#
if *wholepart > 1 then {
exppart +:= *wholepart -1
fracpart := wholepart[2:0] || fracpart
wholepart := wholepart[1]
}
# If the the number is unnormalized, shift the fraction
# left into the whole part and scale the exponent
#
if wholepart == "0" then {
if shiftcount := upto('123456789', fracpart) then {
exppart -:= shiftcount
wholepart := fracpart[shiftcount]
fracpart := fracpart[shiftcount+1:0]
}
}
# Adjust the fractional part to the requested precision.
# If the carry causes the whole part to overflow from
# 9 to 10 then renormalize.
#
fracpart := adjustfracprec(fracpart, prec)
wholepart +:= fracpart[2]
fracpart := fracpart[1]
if *wholepart > 1 then {
wholepart := wholepart[1]
exppart +:= 1
}
# Assemble the final result.
# - Leading "+" dropped in mantissa
# - Leading "+" obligatory in exponent
# - Decimal "." included iff fractional part is non-empty
#
wholepart := (signpart == "-", "-") || wholepart
exppart := (exppart > 0, "+") || exppart
fracpart := (*fracpart > 0, ".") || fracpart
rslt := wholepart || fracpart || "e" || exppart
# Return the result.
# -- If too short, pad on the left with blanks (not zeros!).
# -- If too long try to shrink the precision
# -- If shrinking is not possible return a field of stars.
#
return (*rslt <= width, right(rslt, width)) |
(*rslt - width < prec, eformatstr(x, prec + width - *rslt, width)) |
repl("*", width)
end
# Zero-extend or round the fractional part to 'prec' digits.
#
# Returns a list:
#
# [ fracpart, carry ]
#
# where the fracpart has been adjusted to the requested
# precision, and the carry (result of possible rounding)
# is to be added into the whole number.
#
procedure adjustfracprec(fracpart, prec)
local choppart, carryout
# Zero-extend if needed.
if *fracpart < prec then return [left(fracpart, prec, "0"), 0]
# When the fractional part has more digits than the requested
# precision, chop off the extras and round.
#
carryout := 0
if *fracpart > prec then {
choppart := fracpart[prec+1:0]
fracpart := fracpart[1+:prec]
# If rounding up is needed...
#
if choppart[1] >>= "5" then {
# When the fractional part is .999s or the precision is 0,
# then round up overflows into the whole part.
#
if (prec = 0) | (string(cset(fracpart)) == "9") then {
fracpart := left("0", prec, "0")
carryout := 1
}
# In the usual case, round up simply increments the
# fractional part. (We put back any leading
# zeros that got lost.)
else {
fracpart := right(integer(fracpart)+1, prec, "0")
}
}
}
return [fracpart, carryout]
end
