ratstr.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
-------------------------> GNU Sather - sourcefile <-------------------------
-- Copyright (C) 2000 by K Hopper, University of Waikato, New Zealand --
-- This file is part of the GNU Sather library. It is free software; you may --
-- redistribute and/or modify it under the terms of the GNU Library General --
-- Public License (LGPL) as published by the Free Software Foundation; --
-- either version 2 of the license, or (at your option) any later version. --
-- This library is distributed in the hope that it will be useful, but --
-- WITHOUT ANY WARRANTY without even the implied warranty of MERCHANTABILITY --
-- or FITNESS FOR A PARTICULAR PURPOSE. See Doc/LGPL for more details. --
-- The license text is also available from: Free Software Foundation, Inc., --
-- 59 Temple Place, Suite 330, Boston, MA 02111-1307 USA --
--------------> Please email comments to <bug-sather@gnu.org> <--------------
partial class RAT_STR < $TEXT, $ANCHORED_FMT
partial class RAT_STR < $TEXT, $ANCHORED_FMT is
-- This partial class provides formatting services for the class STR.
-- Version 1.0 Sep 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 22 Sep 98 kh Original from FLOAT_STR
private scan(
cursor : STR_CURSOR
) : SAME
pre ~void(cursor)
post (void(result)
and (initial(cursor.index) = cursor.index))
or (initial(cursor.index) < cursor.index)
is
-- This routine is the real number 'scanner' to obtain the real number
-- value expected to be next in the indicated string - or returning with
-- the string unchanged, returning void if there is a format error.
start_index : CARD := cursor.index ;
loc_lib : LIBCHARS := cursor.buffer.index_lib ;
loc_num : INTI := INTI::build(cursor) ;
if cursor.index = start_index then
return void
else
loc_start : CARD := cursor.index ;
cursor.skip_space ;
if cursor.item /= loc_lib.Solidus.char then -- not a rational!
cursor.set_index(start_index) ;
return void
end
end ;
cursor.skip_space ;
loc_start : CARD := cursor.index ;
loc_denom : INTI := INTI::build(cursor) ;
if cursor.index = loc_start then
cursor.set_index(start_index) ;
return void
else
return num(loc_num).denom(loc_denom)
end
end ;
is_rat(
str : STR
) : CONVERSION_RESULTS
pre true
post (result = CONVERSION_RESULTS::All_Right)
or (result = CONVERSION_RESULTS::Out_of_Range)
or (result = CONVERSION_RESULTS::Bad_Format)
or (result = CONVERSION_RESULTS::Empty)
is
-- This routine checks that the format of of the leading characters of
-- the given string using the given repertoire and encoding corresponds to
-- that required for a rational number, returning the relevant result state.
if str.size = 0 then
return CONVERSION_RESULTS::Empty
end ;
start_index : CARD := 0 ;
loc_cursor : STR_CURSOR := str.cursor ;
loc_res : SAME := scan(loc_cursor) ;
if loc_cursor.index = start_index then
return CONVERSION_RESULTS::Bad_Format
else
loc_cursor.set_index(start_index) ;
return CONVERSION_RESULTS::All_Right
end
end ;
build(
loc_cursor : STR_CURSOR
) : SAME
pre ~void(loc_cursor)
post (void(result)
and (initial(loc_cursor.index) = loc_cursor.index))
or (initial(loc_cursor.index) < loc_cursor.index)
is
-- This routine creates the real number corresponding to the textual
-- representation contained in str which must have a digit both before and
-- after a mandatory decimal mark! If the string indicated does not
-- contain a real number as the next non-blank item in the string then zero is
-- returned or if out of range then quiet_NaN is returned -- and the cursor
-- has not been moved!
return scan(loc_cursor)
end ;
create(
str : STR
) : SAME
pre (is_rat(str) = CONVERSION_RESULTS::All_Right)
post true
is
-- This routine creates the real number corresponding to the textual
-- representation contained in str.
return build(str.cursor)
end ;
private float(
precision,
base : CARD
) : TUP{BOOL, INTI, INT, BOOL}
pre (precision > 0)
and (base > 1) is
-- This routine returns the floating point number which is the value of
-- self to the given precision and in the given base as a 4-tuple :--
--
-- Sign -- true if negative
-- Mantissa
-- Exponent
-- Exact -- true if the value is an accurate representation of self.
--
-- Where rounding is required then younding to nearest is used -- except
-- when 'tie-breaking' when rounding to even (as in IEEE 754) is used.
--
-- The implementation is essentially AlgorithmM described by W.D.
-- Clinger in "How to Read Floating Point Numbers Accurately", Proc PLDI 1990,
-- p. 92-101.
if num.is_zero then
return TUP{BOOL,INTI,INT,BOOL}::create(false,INTI::create(0),0,true)
else
beta : INTI := INTI::create(base) ;
beta_n1 : INTI := beta^(precision - 1) ;
beta_n : INTI := beta_n1 * beta ;
sign : BOOL := num.is_neg ;
numerator : INTI := num.abs ;
denominator : INTI := denom ;
assert denominator.is_pos ;
-- approximation for exponent
exponent : INT := numerator.log2 - denominator.log2 ;
if base /= 2 then
exponent := (exponent.flt / base.flt.log2).round.int
end ;
exponent := exponent - precision.int ;
if exponent < 0 then
numerator := numerator * beta^(-exponent)
else
denominator := denominator * beta^exponent
end ;
-- normalize mantissa (usually 0 or 1 iterations required)
mantissa : INTI ;
loop
-- u/v * b^e = |self|
mantissa := numerator / denominator ;
if mantissa < beta_n1 then
numerator := numerator * beta ;
exponent := exponent - 1
elsif mantissa >= beta_n then
denominator := denominator * beta ;
exponent := exponent + 1
else
break!
end
end ;
-- Convert to float and round to nearest.
rem : INTI := numerator % denominator ;
divisor : INTI := denominator - rem ;
if (rem > divisor)
or ((rem = divisor)
and mantissa.is_odd) then -- next float
mantissa := mantissa + INTI::create(1) ;
if mantissa = beta_n then
mantissa := beta_n1 ;
exponent := exponent + 1
end
end ;
return TUP{BOOL,INTI,INT,BOOL}::create(
sign, mantissa, exponent, rem.is_zero)
end
end ;
flt_str(
precision : CARD,
lib : LIBCHARS
) : STR
pre precision > 0 is
-- This routine returns a string representation of self as a floating
-- point number using the given repertoire and encoding.
raw_value : TUP{BOOL,INTI,INT,BOOL} := float(precision, 10) ;
res : STR := STR::create(lib) ;
if raw_value.t1 then
res := res + lib.Minus_Sign.char
end ;
mantissa : STR := raw_value.t2.str(lib) ;
digits : CARD := mantissa.size ;
trailing_zeros : CARD ;
loop
trailing_zeros := 0.upto!(digits - 1) ;
while!(mantissa[digits - 1 - trailing_zeros] = lib.digit(0).char)
end ;
res := res + mantissa[0] + lib.Decimal_Mark.char ;
after_decimal : INT := digits.int - 1.int - trailing_zeros.int ;
if after_decimal > 0.int then
res := res + mantissa.substring(1,after_decimal.card)
end ;
exponent : INT := raw_value.t3 + digits.int - 1.int ;
if exponent.is_non_zero then
res := res + lib.Exponent_Mark.char + exponent.str(lib)
end ;
return res
end ;
str(
lib : LIBCHARS
) : STR is
-- This routine returns a string representation of self as a vulgar
-- fraction (unless the value is integral) using the given repertoire and
-- encoding.
if is_int
or is_card then
return num.str
else
return num.str + lib.Solidus.char + denom.str
end
end ;
str : STR is
-- This routine returns a string representation of self as a vulgar
-- fraction using the default repertoire and encoding.
return str(LIBCHARS::default)
end ;
fmt(
format : ANCHORED_DESCR,
lib : LIBCHARS
) : STR is
-- This routine returns the formatted string representation of self in
-- accordance with the string format. This provides special case treatment
-- where the leading component is exactly one - it reduces the value string
-- to the single leading character - which is therefore expected to differ
-- for the two values!.
res : STR := str(lib) ;
loc_fill : STR := STR::create(lib) + format.filler.char ;
if format.leading = 1 then
res := res.head(1)
elsif res.size < format.leading then -- needs a filler
res := loc_fill.repeat(format.leading - res.size) + res
end ;
return res + loc_fill.repeat(format.trailing)
end ;
fmt(
format : ANCHORED_DESCR
) : STR is
-- This routine returns the formatted string representation of self in
-- accordance with the string format.
return fmt(format,LIBCHARS::default)
end ;
end ; -- RAT_STR