moneystr.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>  <--------------


class MONEY_DESCR

class MONEY_DESCR is -- This class provides a facility for describing the three internal -- component which make up a monetary value, the whole units, the fractions -- of a unit and the kind of unit. -- Version 1.0 Sep 98. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 30 Sep 98 kh Original readonly attr whole : INTI ; readonly attr fraction : INTI ; readonly attr kind : MONETARY_UNITS ; create( val : INTI, parts : INTI, unit : MONETARY_UNITS ) : SAME is -- This routine creates a new object by simple parameter copying. me : SAME := new ; me.whole := val ; me.fraction := parts ; me.kind := unit ; return me end ; build( loc_cursor : BIN_CURSOR ) : SAME pre ~void(loc_cursor) post ~void(result) is -- This routine creates a new descriptor from the indicated binary -- string. If void is returned then an error has occurred and the cursor -- index has not been moved. start_index : CARD := loc_cursor.index ; loc_val : INTI := INTI::build(loc_cursor) ; if void(loc_val) or loc_cursor.is_done then loc_cursor.set_index(start_index) ; return void end ; loc_fraction : INTI := INTI::build(loc_cursor) ; if void(loc_fraction) or loc_cursor.is_done then loc_cursor.set_index(start_index) ; return void end ; loc_unit : MONETARY_UNITS := MONETARY_UNITS::build(loc_cursor) ; if loc_unit.is_nil then loc_cursor.set_index(start_index) ; return void end ; return create(loc_val,loc_fraction,loc_unit) end ; binstr : BINSTR pre ~void(self) post ~void(result) is -- This routine provides a binary representation of self for filing, etc. return whole.binstr + fraction.binstr + kind.binstr end ; end ; -- MONEY_DESCR

partial class MONEY_STR < $TEXT, $FIXED_FMT

partial class MONEY_STR < $TEXT, $FIXED_FMT is -- This partial class provides conversion routines for monetary values, -- to and from character strings. Note that local format is only supported -- for the current default culture, whereas the use of other currencies -- presumes the international formats. -- Version 1.0 Sep 98. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 28 Sep 98 kh Original private check_sign( str : STR, out negative : BOOL ) : BOOL pre (str.size > 0) and ~void(str.index_lib) post true is -- This private routine tests if the given str is a valid monetary sign -- in any of the formats known in the lib culture, sets negative appropriately -- and returns true. If the string is not a valid sign then false is -- returned. ch : CHAR ; if str.size > 1 then return false else ch := str[0] end ; cash : CASH := str.index_lib.culture.currency ; negative := false ; -- the default! res : BOOL ; if cash.local.positive_sign = ch then return true elsif cash.local.negative_sign = ch then negative := true ; return true elsif cash.international.positive_sign = ch then return true elsif cash.international.negative_sign = ch then negative := true ; return true elsif cash.local_duo.positive_sign = ch then return true elsif cash.local_duo.negative_sign = ch then negative := true ; return true elsif cash.international_duo.positive_sign = ch then return true elsif cash.international_duo.negative_sign = ch then negative := true ; return true else return false end end ; private is_sign( ch : CHAR, lib : LIBCHARS ) : BOOL pre ~void(lib) post result = ~ch.is_space(lib) is -- This routine returns true if and only if ch is part of a valid sign -- or monetary unit designation. return ~ch.is_space(lib) end ; private is_symbol( ch : CHAR, lib : LIBCHARS ) : BOOL pre ~void(lib) post (result = (~ch.is_space(lib) and ~ch.is_digit(lib))) is -- This routine returns true if and only if ch is part of a valid -- symbol for a currency - ie neither space nor punctuation nor digit. return ~ch.is_space(lib) and ~ch.is_digit(lib) end ; private is_sign_or_unit( ch : CHAR, lib : LIBCHARS ) : BOOL pre ~void(lib) post (result = (~ch.is_space(lib) and ~ch.is_digit(lib))) is -- This routine returns true if and only if ch is part of a valid sign -- or monetary unit designation. return ~ch.is_space(lib) and ~ch.is_digit(lib) end ; private check_prefix( cursor : STR_CURSOR, out negative : BOOL, out paren : BOOL, out has_sign : BOOL ) : MONETARY_UNITS pre ~void(cursor) and ~cursor.is_done and ~void(cursor.buffer.index_lib) post true is -- This private routine checks the form of the numerical value prefix -- and sets the out arguments and result as appropriate. res : MONETARY_UNITS ; start_index : CARD := cursor.index ; loc_lib : LIBCHARS := cursor.buffer.index_lib ; paren := false ; -- default! has_sign := false ; -- meaning a sign has been seen! loop if cursor.is_done then cursor.set_index(start_index) ; return void elsif cursor.item.is_digit(loc_lib) then return res -- which may be void here! end ; if cursor.item = loc_lib.Left_Parenthesis.char then paren := true ; negative := true ; has_sign := true ; cursor.advance elsif cursor.item /= loc_lib.Space.char then -- may be sign or monetary unit! str : STR := cursor.get_pred(bind(is_sign_or_unit(_,loc_lib))) ; if has_sign then res := MONETARY_UNITS::create(str) ; else has_sign := check_sign(str, out negative) ; cursor.skip_space ; if ~res.is_nil then return res end end else cursor.advance end end end ; private suffix_check( cursor : STR_CURSOR, paren, has_sign : BOOL, out negative : BOOL ) : BOOL pre ~void(cursor) and ~cursor.is_done post true is -- This private routine checks the form of the numerical value suffix -- and sets the out argument and result as appropriate. loc_lib : LIBCHARS := cursor.buffer.index_lib ; if cursor.item = loc_lib.Right_Parenthesis.char then if paren then negative := true ; cursor.advance ; return true else return false end else start_index : CARD := cursor.index ; cursor.skip_space ; str : STR := cursor.get_pred(bind(is_sign(_,loc_lib))) ; loc_sign : BOOL := check_sign(str, out negative) ; if has_sign then if loc_sign then -- OOPS! cursor.set_index(start_index) ; return false end else return true end end end ; private symbol_check( loc_cursor : STR_CURSOR, inout currency : MONETARY_UNITS ) : BOOL pre ~void(loc_cursor) and ~void(loc_cursor.buffer.index_lib) post true is -- This private routine checks that the next symbol in the indicated -- string is the correct decimal mark for the currency, returning the -- currency found. start_index : CARD := loc_cursor.index ; loc_lib : LIBCHARS := loc_cursor.buffer.index_lib ; test_str : STR := loc_cursor.get_pred(bind(is_symbol(_,loc_lib))) ; cash : CASH := loc_lib.culture.currency ; if (test_str = cash.local.num_fmt.decimal_mark) or (test_str = cash.local_duo.num_fmt.decimal_mark) or (test_str = cash.international.num_fmt.decimal_mark) or (test_str = cash.international_duo.num_fmt.decimal_mark) then return true elsif currency.is_nil then -- sometimes this is the decimal! currency := MONETARY_UNITS::create(test_str) ; if currency.is_nil then loc_cursor.set_index(start_index) ; return false else return true end else loc_cursor.set_index(start_index) ; return false end end ; private scan( loc_cursor : STR_CURSOR ) : MONEY_DESCR pre ~void(loc_cursor) and ~loc_cursor.is_done post (void(result) and (initial(loc_cursor.index) = loc_cursor.index)) or (initial(loc_cursor.index) < loc_cursor.index) is -- This routine checks that the string indicated by the cursor starts -- with a monetary value, returning the components if alright. start_index : CARD := loc_cursor.index ; loc_lib : LIBCHARS := loc_cursor.buffer.index_lib ; loc_start : CARD ; signed : BOOL ; negative : BOOL ; parenthesised : BOOL ; currency : MONETARY_UNITS := check_prefix(loc_cursor, out negative, out parenthesised, out signed) ; if (loc_cursor.index = start_index) or ~loc_cursor.item.is_digit(loc_lib) then loc_cursor.set_index(start_index) ; return void end ; -- at this point there is a digit and hence the following is OK! loc_res : INTI := INTI::build(loc_cursor) ; fraction : INTI := INTI::create(0) ; if loc_cursor.item /= loc_lib.Space.char then -- is it a decimal mark? if symbol_check(loc_cursor,inout currency) then loc_start := loc_cursor.index ; fraction := INTI::build(loc_cursor) ; if loc_start = loc_cursor.index then loc_cursor.set_index(start_index) ; return void end end end ; if suffix_check(loc_cursor,signed,parenthesised,out negative) then if negative then return MONEY_DESCR::create(-loc_res,fraction,currency) else return MONEY_DESCR::create(loc_res,fraction,currency) end else loc_cursor.set_index(start_index) ; return void end end ; is_money( str : STR ) : CONVERSION_RESULTS pre true post (result = CONVERSION_RESULTS::All_Right) 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 in 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 ; if void(scan(str.cursor)) then return CONVERSION_RESULTS::Bad_Format else return CONVERSION_RESULTS::All_Right end end ; build( loc_cursor : STR_CURSOR ) : SAME pre ~void(loc_cursor) and ~loc_cursor.is_done post (void(result) and (initial(loc_cursor.index) = loc_cursor.index)) or (initial(loc_cursor.index) < loc_cursor.index) is -- This routine creates the integer number corresponding to the textual -- representation contained in the string indicated. loc_descr : MONEY_DESCR := scan(loc_cursor) ; loc_rate : RAT := loc_descr.kind.rate ; -- Which may be different from 1/1 if the currency is not -- local, so the following inverted conversion is needed! return create(loc_descr) * loc_rate.denom / loc_rate.num end ; create( str : STR ) : SAME pre (is_money(str) = CONVERSION_RESULTS::All_Right) post true is -- This routine creates the whole number corresponding to the textual -- representation contained in str in the given repertoire and encoding. return build(str.cursor) end ; 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 fixed point. return lib.culture.currency.local.fmt(self,lib).str end ; str : STR pre true 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 ; fmt( format : FIXED_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. res : STR := str(lib) ; loc_fill : STR := STR::create(lib) + format.filler.char ; if res.size < format.whole_digits then -- needs a filler res := loc_fill.repeat(format.whole_digits - res.size) + res end ; return res end ; fmt( format : FIXED_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 ; -- MONEY_STR