## float-format.pkg
## AUTHOR: Emden Gansner & John Reppy
## AT&T Bell Laboratories
## Murray Hill, NJ 07974
## erg@ulysses.att.com & jhr@research.att.com
# Compiled by:
# src/lib/std/standard.lib#
# Basic float to string conversions.
#
# This module is used internally, but is
# not part of the exported library interface.
#
# It duplicates code in the Lib7 boot directory, src/lib/std/src/float-format.pkg# but it is more portable not to rely on it. XXX BUGGO FIXME
#
package float_format: (weak)
api {
# Low-level float to string conversion routines. For F and E format, the precision
# specifies the number of fractional digits with 0's appended if necessary.
# For G format, precision specifies the number of significant digits, but
# trailing 0's in the fractional part are dropped.
float_fformat: ((Float, Int)) -> { sign: Bool, mantissa: String };
float_eformat: ((Float, Int)) -> { sign: Bool, mantissa: String, exp: Int };
float_gformat: ((Float, Int)) -> { sign: Bool, whole: String, frac: String, exp: Null_Or( Int ) };
}
{
exception BAD_PRECISION;
# Raised by float to string conversions, if the precision is < 0.
fun zero_lpad (s, w) = number_string::pad_left '0' w s;
fun zero_rpad (s, w) = number_string::pad_right '0' w s;
# Convert an integer between 0..9 to a single digit:
#
fun make_digit (i: Int)
=
string::get_byte_as_char ("0123456789", i);
# Decompose a non-zero float into a list of at most maxPrec significant digits
# (the first digit non-zero), and integer exponent. The return value
# (a ! b ! c..., exp)
# is produced from float argument
# a.bc... * (10 ^^ exp)
# If the list would consist of all 9's, the list consisting of 1 followed by
# all 0's is returned instead.
max_prec = 15;
fun decompose (f, e, precision_g)
=
{ fun scale_up (x, e) = if (x < 1.0 ) scale_up (10.0*x, e - 1); else (x, e); fi;
fun scale_dn (x, e) = if (x >= 10.0 ) scale_dn ( 0.1*x, e + 1); else (x, e); fi;
fun mkdigits (f, 0)
=>
([], if (f < 5.0 ) 0; else 1;fi);
mkdigits (f, i)
=>
(digit ! digits, c)
where
d = floor f;
(mkdigits (10.0 * (f - float(d)), i - 1))
->
(digits, carry);
my (digit, c)
=
case (d, carry)
#
(9, 1) => (0, 1);
_ => (d + carry, 0);
esac;
end;
end;
my (f, e)
=
if (f < 1.0 ) scale_up (f, e);
else if (f >= 10.0 ) scale_dn (f, e);
else (f, e); fi;
fi;
my (digits, carry)
=
mkdigits (f, int::max (0, int::min (precision_g e, max_prec)));
case carry
0 => (digits, e);
_ => (1 ! digits, e+1);
esac;
};
fun float_fformat (r, prec)
=
{ fun pf e
=
e + prec + 1;
fun rtoa (digits, e)
=
{ fun do_frac (_, 0, l) => implode( reverse l);
do_frac ([], p, l) => do_frac ([], p - 1, '0' ! l);
do_frac (hd ! tl, p, l) => do_frac (tl, p - 1, (make_digit hd) ! l);
end;
fun do_whole ([], e, l)
=>
if (e >= 0)
do_whole ([], e - 1, '0' ! l);
else
if (prec == 0) implode (reverse l);
else do_frac ([], prec, '.' ! l); fi;
fi;
do_whole (arg as (hd ! tl), e, l)
=>
if (e >= 0)
do_whole (tl, e - 1, (make_digit hd) ! l);
else
if (prec == 0) implode (reverse l);
else do_frac (arg, prec, '.' ! l); fi;
fi;
end;
fun do_zeros (n, 0, l) => implode (reverse l);
do_zeros (1, p, l) => do_frac (digits, p, l);
do_zeros (n, p, l) => do_zeros (n - 1, p - 1, '0' ! l);
end;
if (e >= 0)
do_whole (digits, e, []);
else
if (prec == 0)
"0";
else
do_zeros (-e, prec, ['.', '0']);
fi;
fi;
};
if (prec < 0 ) raise exception BAD_PRECISION; fi;
if (r < 0.0)
{ sign => TRUE,
mantissa => rtoa (decompose(-r, 0, pf))
};
else
if (r > 0.0)
{ sign => FALSE,
mantissa => rtoa (decompose (r, 0, pf))
};
else
if (prec == 0)
{ sign => FALSE,
mantissa => "0"
};
else
{ sign => FALSE,
mantissa => zero_rpad ("0.", prec+2) };
fi;
fi;
fi;
}; # fun float_fformat
fun float_eformat (r, prec)
=
{ fun pf _
=
prec + 1;
fun rtoa (sign, (digits, e))
=
{ fun make_res (m, e)
=
{ sign,
mantissa => m,
exp => e
};
fun do_frac (_, 0, l) => implode (reverse l);
do_frac ([], n, l) => zero_rpad (implode (reverse l), n);
do_frac (hd ! tl, n, l) => do_frac (tl, n - 1, (make_digit hd) ! l);
end;
if (prec == 0)
make_res (string::from_char (make_digit (head digits)), e);
else
make_res (do_frac (tail digits, prec, ['.', make_digit (head digits)]), e);
fi;
};
if (prec < 0 ) raise exception BAD_PRECISION; fi;
if (r < 0.0)
rtoa (TRUE, decompose(-r, 0, pf));
else
if (r > 0.0)
rtoa (FALSE, decompose (r, 0, pf));
else
if (prec == 0)
{ sign => FALSE,
mantissa => "0",
exp => 0
};
else
{ sign => FALSE,
mantissa => zero_rpad("0.", prec+2), exp=>0
};
fi;
fi;
fi;
}; # fun float_eformat
fun float_gformat (r, prec)
=
{ fun pf _ = prec;
fun rtoa (sign, (digits, e))
=
{ fun make_res (w, f, e)
=
{ sign,
whole => w,
frac => f,
exp => e
};
fun do_frac []
=>
[];
do_frac (0 ! tl)
=>
case (do_frac tl)
[] => [];
rest => '0' ! rest;
esac;
do_frac (hd ! tl)
=>
(make_digit hd) ! (do_frac tl);
end;
fun do_whole ([], e, wh)
=>
if (e >= 0)
do_whole([], e - 1, '0' ! wh);
else
make_res (implode (reverse wh), "", NULL);
fi;
do_whole (arg as (hd ! tl), e, wh)
=>
if (e >= 0)
do_whole (tl, e - 1, (make_digit hd) ! wh);
else
make_res (implode (reverse wh), implode (do_frac arg), NULL);
fi;
end;
if (e < -4 or e >= prec)
make_res (
string::from_char (make_digit (head digits)),
implode( do_frac (tail digits)),
THE e
);
else
if (e >= 0)
do_whole (digits, e, []);
else
frac = implode (do_frac digits);
make_res(
"0",
zero_lpad (frac, (size frac) + (-1 - e)),
NULL
);
fi;
fi;
};
if (prec < 1 ) raise exception BAD_PRECISION; fi;
if (r < 0.0)
rtoa (TRUE, decompose(-r, 0, pf));
else
if (r > 0.0)
rtoa (FALSE, decompose (r, 0, pf));
else
{ sign => FALSE,
whole => "0",
frac => "",
exp => NULL
};
fi;
fi;
}; # fun float_gformat
}; # package float_format