floatstr.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 FLOAT_STR{T} < $TEXT, $FLT_FMT

partial class FLOAT_STR{T} < $TEXT, $FLT_FMT is -- This partial class provides numeric real number conversion routines, -- to and from character strings. -- Version 1.0 Sep 98. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 3 Sep 98 kh Original from Modula-2 standard -- The character representation of a signed fixed-point number is -- -- [optional sign], decimal digit, {decimal digit}, -- ["." {decimal digit}] -- -- The character representation of a signed floating point number is -- -- signed fixed point number, "E", [optional sign], -- decimal digit, {decimal digit} stub Decimal_Multiplier : T ; stub max_exp : INT ; stub min_exp : INT ; stub Max_Precision : CARD ; private const Eng_Places : CARD := 3 ; private const Decimal_Base : CARD := 10 ; private const -- a local 'enumeration' Infinity, Not_a_Number ; private const Msg_Cnt : CARD := Not_a_Number + 1 ; private shared Names : ARRAY{STR} ; -- for external representation! private shared lib : LIBCHARS ; private check_names( loc_lib : LIBCHARS ) pre ~void(loc_lib) post (lib = loc_lib) and (Names.asize = Msg_Cnt) is -- This auxiliary routine attempts to set the value of the Names array -- if void or of a different culture to the required one. If this action -- is not successful then an exception is raised. if void(Names) or (lib /= loc_lib) then lib := loc_lib ; Names := lib.culture.resources.read(SYS::rune_name(self),Msg_Cnt) ; end end ; private exp_scan( cursor : STR_CURSOR, out negative : BOOL ) : FLIST{CARD} pre ~void(cursor) post true is -- This private routine checks the exponent of a number and sets -- the result to be the digit string or, if an error in format occurred -- then void, when the cursor is left in the same state as it was on entry. loc_lib : LIBCHARS := cursor.buffer.index_lib ; loc_format : NUMBER_FMT := loc_lib.culture.numeric.format ; start_index : CARD := cursor.index ; cursor.advance ; -- past the exponent mark! loc_code : CHAR_CODE := CHAR_CODE::create(cursor.item.char,loc_lib) ; signed : BOOL ; negative := loc_lib.culture.numeric.opt_sign(loc_code,out signed) ; if signed then cursor.advance end ; if cursor.is_done or ~cursor.item.is_digit(loc_lib) then cursor.set_index(start_index) ; return void else return loc_format.digit_string(cursor,true,Decimal_Base) end end ; private integral_part( digits : FLIST{CARD}, out sig_figs : CARD, out places : CARD ) : T pre (digits.size > 0) post result = result.truncate is -- This routine carries out the conversion for the integral part of -- the real number -- before the decimal point! The result is a whole -- number in floating point form of sig_figs digits. The exponent is -- the value for the complete number if it is greater than zero. res : T := T::zero ; leading_zeroes : CARD := 0 ; sig_figs := 0 ; loc_cvar : T := res ; -- for typecase in loop! loop loc_digit : CARD := digits.elt! ; typecase loc_cvar when FLT then res := res * Decimal_Multiplier + loc_digit.flt when FLTD then res := res * Decimal_Multiplier + loc_digit.fltd end ; if res > T::zero then sig_figs := sig_figs + 1 ; if sig_figs = Max_Precision then break! end else leading_zeroes := leading_zeroes + 1 end end ; places := digits.size - leading_zeroes ; return res end ; private fraction_part( digits : FLIST{CARD}, res : T, inout sig_digits : CARD, out leading_zeroes : CARD ) : T pre ~void(digits) post true is -- This second private routine continues conversion for the fractional -- part of the number (if any). leading_zeroes := CARD::zero ; -- so far!! loc_res : T := res ; -- for typecase in loop! loop loc_digit : CARD := digits.elt! ; if sig_digits < Max_Precision then typecase loc_res when FLT then res := res * Decimal_Multiplier + loc_digit.flt when FLTD then res := res * Decimal_Multiplier + loc_digit.fltd end ; if res > T::zero then -- NOT leading zeroes! sig_digits := sig_digits + 1 else leading_zeroes := leading_zeroes + CARD::one end else -- maximum precision reached break! end end ; return res end ; private make_val( digits : FLIST{CARD} ) : CARD pre ~void(digits) post true is -- This private routine is used to convert strings of digits into a -- single cardinal number. res : CARD := 0 ; loop loc_digit : CARD := digits.elt! ; if res > CARD::maxval - loc_digit then return CARD::nil else res := res * Decimal_Base + loc_digit end end ; return res end ; private scan( cursor : STR_CURSOR ) : SAME pre ~void(cursor) post (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 or NaN if -- there is a range error. loc_lib : LIBCHARS := cursor.buffer.index_lib ; loc_format : NUMBER_FMT := loc_lib.culture.numeric.format ; start_index : CARD := cursor.index ; places : CARD ; normalise : INT ; cursor.skip_space ; loc_code : CHAR_CODE := CHAR_CODE::create(cursor.item,cursor.buffer.index_lib) ; signed : BOOL ; negative : BOOL := loc_lib.culture.numeric.opt_sign(loc_code,out signed) ; if signed then cursor.advance end ; exp_negative : BOOL ; precision : CARD := 0 ; exponent : INT ; whole_sig_digits : CARD ; sig_digits : CARD ; leading_zeroes : CARD ; if ~cursor.item.is_digit(loc_lib) then cursor.set_index(start_index) ; return zero end ; whole_str : FLIST{CARD} := loc_format.digit_string( cursor,true,Decimal_Base) ; fraction_str : FLIST{CARD} ; exp_str : FLIST{CARD} ; if cursor.item = loc_lib.Decimal_Mark.char then cursor.advance else cursor.set_index(start_index) ; return zero end ; if cursor.item.is_digit(loc_lib) then fraction_str := loc_format.digit_string(cursor,false,Decimal_Base) ; if cursor.item.is_alpha and (cursor.item.upper = loc_lib.Exponent_Mark.char.upper) then exp_str := exp_scan(cursor,out exp_negative) end else -- mandatory digit after decimal cursor.set_index(start_index) ; return zero end ; res : T := integral_part(whole_str,out whole_sig_digits,out places) ; sig_digits := whole_sig_digits ; if sig_digits < Max_Precision then res := fraction_part(fraction_str, res, inout sig_digits, out leading_zeroes) end ; if ~void(exp_str) then if exp_negative then exponent := - (make_val(exp_str).int) else exponent := make_val(exp_str).int end else exponent := 0 end ; if places > 0 then normalise := exponent - (sig_digits - whole_sig_digits).int ; else -- fraction only! normalise := exponent - (leading_zeroes + sig_digits).int ; end ; if (normalise < min_exp) or (normalise > max_exp) then cursor.set_index(start_index) ; return quiet_NaN(INT::zero) end ; normaliser : T := T::one ; -- to start with anyway! loop normalise.abs.times! ; normaliser := normaliser * Decimal_Multiplier end ; if negative then res := -res end ; if normalise < INT::zero then return res / normaliser else return res * normaliser end end ; is_real( 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 real 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 : T := scan(loc_cursor) ; if loc_cursor.index = start_index then if loc_res = zero then return CONVERSION_RESULTS::Bad_Format else return CONVERSION_RESULTS::Out_of_Range end else loc_cursor.set_index(start_index) ; return CONVERSION_RESULTS::All_Right end end ; build( loc_cursor : STR_CURSOR ) : SAME pre ~void(loc_cursor) and ~loc_cursor.is_done post (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_real(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 eval_exponent : INT pre true post ((self = zero) and (result = INT::zero)) or ((self.abs < one) and (result < INT::zero)) or ((self.abs >= one) and (result >= INT::zero)) is -- This routine determines the value of the decimal exponent of self -- as an integer. The mantissa is assumed to be in the range 0 to 10! if self = zero then return INT::zero end ; res : INT := INT::zero ; val : SAME ; if self < zero then val := -self else val := self end ; if val < one then loop while!(val < one) ; val := val * Decimal_Multiplier ; res := res - INT::one end else loop while!(val >= one) ; val := val / Decimal_Multiplier ; res := res + INT::one end ; res := res - INT::one -- 'cos it was one too big! end ; return res end ; private resize( loc_list : FLIST{CARD}, new_size : CARD ) : FLIST{CARD} pre ~void(loc_list) and (new_size >= 2) post result.size = new_size is -- This private routine is used to extend or crop the size of the digit -- array. Any elements added are put on the front (Least Significant end!). if new_size = loc_list.size then return loc_list else res : FLIST{CARD} := FLIST{CARD}::create(new_size) ; loc_start : CARD ; if new_size < loc_list.size then -- crop it loc_start := loc_list.size - new_size else loc_start := 0 ; loop -- the leading zeroes! (new_size - loc_list.size).times! ; res := res.push(CARD::zero) end end ; loop res := res.push(loc_list.elt!(loc_start)) end ; return res end end ; num_chars : CARD is -- This routine returns the number of characters in the result, including -- any exponent needed. res : CARD := 0 ; loc_val : SAME := self ; if self < zero then res := 1 ; loc_val := -self end ; res := res + loc_val.mantissa.size ; loc_exp : INT := eval_exponent ; if loc_exp.is_neg then return res + 2 + loc_exp.num_chars elsif loc_exp.is_pos then return res + 1 + loc_exp.num_chars else return res end end ; private roundup( loc_list : FLIST{CARD}, digit_cnt : CARD ) : FLIST{CARD} pre loc_list.size > 0 post result.size >= loc_list.size is -- This private routine carries out right to left rounding of the -- mantissa character string before assembly, setting carry to true if -- a left carry is needed. last_digit : CARD ; if digit_cnt < loc_list.size then -- numeric propagation possible! last_digit := loc_list.size - digit_cnt ; loop index : CARD := 0.upto!(last_digit - 1) ; if loc_list[index] >= 5 then loc_list[index + 1] := loc_list[index + 1] + 1 end end else last_digit := 0 end ; loop -- to propagate 9s if needed! index : CARD := last_digit.upto!(loc_list.size - 1) ; if loc_list[index] > 9 then if index = loc_list.size - 1 then loc_list[index] := 0 ; loc_list := loc_list.push(1) ; break! else loc_list[index] := 0 ; loc_list[index + 1] := loc_list[index + 1] + 1 end else break! end end ; return loc_list end ; private mantissa : FLIST{CARD} pre (self >= zero) post (result.size <= (Max_Precision + 1)) is -- This private routine produces the significant digits of the textual -- representation of self to the maximum precision provided by the internal -- number representation. exponent : INT := eval_exponent ; normaliser : T := T::one ; val : T := self ; res : FLIST{CARD} := FLIST{CARD}::create ; loop exponent.abs.times! ; normaliser := normaliser * Decimal_Multiplier end ; if exponent > 0.int then -- set in the range 1 to 10 val := val / normaliser else val := val * normaliser end ; loop digit : T := val.truncate ; res := res.push(digit.card) ; val := val - digit ; if res.size = Max_Precision then if val >= T::half then res := res.push(9) end ; loop -- reverse the digit order! up_index : CARD := 0.upto!((res.size - 1)/2) ; down_index : CARD := (res.size - 1).downto!(res.size/2) ; temp : CARD := res[up_index] ; res[up_index] := res[down_index] ; res[down_index] := temp end ; return res end ; val := val * Decimal_Multiplier end end ; private sig_figs( figs : CARD ) : CARD pre true post ((result = 1) and (figs = 0)) or ((result = Max_Precision) and (figs >= Max_Precision)) or (result = figs) is -- This routine checks that the number of significant figures is -- at least 1 and no more than the maximum mantissa precision if figs = 0 then return 1 elsif figs > Max_Precision then return Max_Precision else return figs end end ; private assemble( significant : CARD, decimal_places : INT, exponent_val : INT, lib : LIBCHARS, out digit_list : FLIST{CARD} ) : TUP{INT,INT} pre (significant > 0) and ~void(lib) post digit_list.size >= 2 is -- This private routine provides a mantissa value as a list of digits -- according to the parameters, setting the exponent_val argument to the -- decimal exponent needed to complement the mantissa value. -- -- The value of the decimal places determines the general format of -- the string as follows :- -- -- 0 - means that the value is to be presented in engineering notation -- with three significant digits after the decimal mark. -- -- > 0 - means that the value indicates the number of places after -- the decimal mark -- -- < 0 - means that the value is to be presented as a whole number with -- only a zero after the decimal mark (plus an exponent if -- necessary) and as many zeroes as indicated before it val : T := self ; is_signed : BOOL := self < T::zero ; if is_signed then val := -val end ; digit_list := val.mantissa ; zero_count : CARD := 0 ; -- the number of trailing zeroes! loop if digit_list.elt! = 0 then zero_count := zero_count + 1 else break! end end ; loc_size : CARD := sig_figs(significant) ; left_digits : CARD := 1 ; -- defaults for approx numbers! -- Handle special and ordinary layouts if zero_count = digit_list.size then -- zero - a special case loc_size := 2 ; -- one before & one after! decimal_places := INT::one ; exponent_val := INT::zero elsif (decimal_places = INT::zero) -- this is 'engineering notation' and (exponent_val /= - INT::one) then exp_shift : INT := exponent_val.abs % Eng_Places.int ; left_digits := left_digits + exp_shift.card ; if exponent_val < INT::zero then exponent_val := exponent_val - exp_shift + INT::one else exponent_val := exponent_val - exp_shift end ; decimal_places := (loc_size - left_digits).int ; -- never negative elsif (exponent_val = - INT::one) then -- use 0.xxxx form. digit_list := digit_list.push(0) ; exponent_val := INT::zero ; loc_size := decimal_places.card + 1 elsif (exponent_val < 3.int) and (exponent_val >= INT::zero) then -- special for < 1000.0 left_digits := left_digits + exponent_val.card ; exponent_val := INT::zero ; loc_size := decimal_places.card + left_digits elsif decimal_places < INT::zero then -- want places in front of '.' loc_size := (-decimal_places).card + 1 ; exponent_val := exponent_val - decimal_places ; decimal_places := INT::one else -- an ordinary layout! loc_size := decimal_places.card + left_digits end ; list_size : CARD := digit_list.size ; digit_list := roundup(digit_list,loc_size) ; if digit_list.size > list_size then -- an MS 1 digit appended! exponent_val := exponent_val + INT::one ; decimal_places := decimal_places - INT::one end ; digit_list := resize(digit_list,loc_size) ; return TUP{INT,INT}::create(exponent_val,decimal_places) end ; private do_specials( lib : LIBCHARS, negative : BOOL ) : STR is -- This private routine returns the culture-dependent 'name for the -- two special values 'NaN' and 'infinity'. check_names(lib) ; -- succeeds or an exception!! res : STR := STR::create ; if negative then res := res + lib.Minus_Sign.char end ; if self.is_nan then return res + Names[Not_a_Number] else return res + Names[Infinity] end end ; private do_value( negative : BOOL, lib : LIBCHARS, format : NUMBER_FMT ) : STR is -- This routine produces the actual text string for the number. places : INT ; exponent : INT := eval_exponent ; val : SAME := self ; if negative then val := -val end ; if (exponent < Max_Precision.int) and (exponent >= -1) then if exponent = (Max_Precision.int - 1.int) then places := 1 else places := Max_Precision.int - (exponent + 1.int) end else places := Max_Precision.int - 1.int end ; temp : FLIST{CARD} ; loc_res : TUP{INT,INT} := val.assemble(Max_Precision,places, exponent,lib,out temp) ; exponent := loc_res.t1 ; places := loc_res.t2 ; res : STR := format.fmt(temp,places.card,false,lib).tgt_str ; if negative then res := STR::create(lib) + lib.Minus_Sign.char + res end ; if exponent /= INT::zero then res := res + lib.Exponent_Mark.char + exponent.str(lib) end ; return res end ; raw_str( lib : LIBCHARS ) : STR pre ~void(lib) post (result.size > 0) is -- This routine returns a string representation of self using the given -- repertoire and encoding. The format will be either fixed point or -- floating point dependent upon the value of self - without group separation -- characters. val : T ; is_signed : BOOL := self < T::zero ; if is_signed then val := -self else val := self end ; if is_nan or (val = infinity) then return do_specials(lib,is_signed) end ; loc_fmt : NUMBER_FMT := NUMBER_FMT::create( CODE_STR::create(lib.Decimal_Mark), CODE_STR::create(lib.Space), FLIST{CARD}::create) ; return do_value(is_signed,lib,loc_fmt) end ; raw_str : STR pre true post (result.size > 0) is -- This routine returns a string representation of self using the default -- repertoire and encoding. The format will be either fixed point or -- floating point dependent upon the value of self - without group separation -- characters. return raw_str(LIBCHARS::default) end ; str( lib : LIBCHARS ) : STR pre ~void(lib) -- and self /= quiet_NaN(0.int) post (result.size > 0) is -- This routine returns a string representation of self using the given -- repertoire and encoding. The format will be either fixed point or -- floating point dependent upon the value of self. val : T ; is_signed : BOOL := self < T::zero ; if is_signed then val := -self else val := self end ; if is_nan or (val = infinity) then return do_specials(lib,is_signed) end ; return do_value(is_signed,lib,lib.culture.numeric.format) end ; str : STR pre true -- self /= quiet_NaN(0.int) post (result.size > 0) is -- This routine returns a string representation of self using the given -- repertoire and encoding. The format will be either fixed point or -- floating point dependent upon which of the two is the shorter string. return str(LIBCHARS::default) end ; str( decimal_places : CARD, lib : LIBCHARS ) : STR pre ~void(lib) post ~void(result) is -- This routine justifies the character representation of self in -- a format which requires the given number of decimal places only! val : T ; is_signed : BOOL := self < T::zero ; if is_signed then val := -self else val := self end ; if val.is_nan or (val = infinity) then return do_specials(lib,is_signed) end ; exponent : INT := eval_exponent ; temp : FLIST{CARD} ; places : INT := decimal_places.int ; loc_res : TUP{INT,INT} := self.assemble(Max_Precision,places, exponent,lib,out temp) ; exponent := loc_res.t1 ; decimal_places := loc_res.t2.card ; res : STR := lib.culture.numeric.format.fmt(temp,decimal_places, true,lib).tgt_str ; if is_signed then res := STR::create(lib.Minus_Sign.char,lib) + res end ; if exponent /= INT::zero then res := res + lib.Exponent_Mark.char + exponent.str end ; return res end ; str( decimal_places : CARD ) : STR pre true post ~void(result) is -- This routine justifies the character representation of self in -- floating-point engineering format (three digits after the decimal point), -- using an exponent if necessary. return str(decimal_places,LIBCHARS::default) end ; eng_str( lib : LIBCHARS ) : STR pre ~void(lib) post (result.size >= 7) is -- This routine justifies the character representation of self in -- floating-point engineering format (three digits after the decimal point), -- using an exponent if necessary. return str(0,lib) end ; eng_str : STR pre true post (result.size >= 7) is -- This routine justifies the character representation of self in -- floating-point engineering format (three digits after the decimal point), -- using an exponent if necessary. return str(0,LIBCHARS::default) end ; fmt( format : FLT_DESCR, lib : LIBCHARS ) : STR pre ~void(format) and ~void(lib) post result.size > 0 is -- This routine returns a formatted representation of self in the given -- repertoire and encoding as dictated by the given format description. val : T ; is_signed : BOOL := self < T::zero ; if is_signed then val := -self else val := self end ; if val.is_nan or (val = infinity) then return do_specials(lib,is_signed) end ; places : INT := format.precision.int ; sig_figs : CARD := format.whole_digits + format.precision ; exponent : INT := eval_exponent ; exp_str : STR ; temp : FLIST{CARD} ; loc_res : TUP{INT,INT} := val.assemble(sig_figs,places, exponent,lib,out temp) ; exponent := loc_res.t1 ; places := loc_res.t2 ; if ((temp.size.int - places).card < format.whole_digits) then -- need a few leading zeroes loc_list : FLIST{CARD} := FLIST{CARD}::create ; loop (sig_figs - temp.size).times! ; loc_list := loc_list.push(0) end ; loop -- to add the non-zeroes! loc_list := loc_list.push(temp.elt!) end ; temp := loc_list end ; res : STR := lib.culture.numeric.format.fmt(temp,places.card, false,lib).tgt_str ; if is_signed then res := STR::create(lib) + lib.Minus_Sign.char + res elsif format.val_sign then res := STR::create(lib) + lib.Plus_Sign.char + res end ; if exponent /= INT::zero then exp_str := exponent.str(lib) ; if exp_str.size < format.exponent_size then loc_fill : STR := STR::create(lib) + lib.digit(0).char ; exp_str := loc_fill.repeat(format.exponent_size - exp_str.size) + exp_str end ; if format.exp_sign and exponent >= 0.int then exp_str := STR::create(lib) + lib.Plus_Sign.char + exp_str end ; res := res + lib.Exponent_Mark.char + exp_str end ; if res.size < format.width then loc_fill : STR := STR::create(lib) + format.filler.char ; res := loc_fill.repeat(format.width - res.size) + res end ; return res end ; fmt( format : FLT_DESCR ) : STR pre ~void(format) post result.size > 0 is -- This routine returns a formatted representation of self in the default -- repertoire and encoding as dictated by the given format description. return fmt(format,LIBCHARS::default) end ; end ; -- FLOAT_STR