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


immutable class MONETARY_UNITS < $ENUMS{MONETARY_UNITS}

immutable class MONETARY_UNITS < $ENUMS{MONETARY_UNITS} is -- This is an enumeration class which provides a convenient way of -- specifying all monetary Units in which it is desired to conduct business. -- Associated with it two files of data are required - the common one for -- string conversion and a special one giving the current exchange rates -- which is/may be updated periodically. -- The location of the file is expected to be in named in an environment -- variable EXCHANGE_RATES. The table read from the file is used when -- determining the current rate of exchange against the local currency. -- NOTE The format of the exchange rate file contains at the beginning -- the update periodicity in use by the organisation concerned followed -- by binary representations of the exchange rates in the order of the -- enumeration. The first value will always be 1/1 - the local -- currency! There will also always be one other entry of 1/1 -- corresponding to the international designation of the local currency -- name. -- Version 1.1 Oct 98. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 15 Jun 97 kh Original -- 1 Oct 98 kh Added exchange rate code from MONEY. include ENUM{MONETARY_UNITS} ; private const val_count : CARD := 173 ; private shared exchange_rates : ARRAY{RAT} ; -- The first element of this array is assumed to contain the value 1.0 -- which is the local currency 'exchange rate'. There will always be -- a second occurrence of 1.0 corresponding to the entry for the local -- monetary unit. private shared time_stamp : TIME_STAMP ; private shared Needs_Update : ELAPSED ; private shared exch_file : FILE_PATH ; private Env_Name : STR is -- This routine creates and returns a string which is the name of -- the exchange rate environment variable which is to be read when needed. lib : LIBCHARS := LIBCHARS::default ; loc_res : CODE_STR := CODE_STR::create(lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_E.card,lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_X.card,lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_C.card,lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_H.card,lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_A.card,lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_N.card,lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_G.card,lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_E.card,lib) + CHAR_CODE::create(UNICODE::LOW_LINE.card,lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_R.card,lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_A.card,lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_T.card,lib) + CHAR_CODE::create(UNICODE::LATIN_CAPITAL_LETTER_E.card,lib) ; return loc_res.tgt_str end ; update_rates pre void(exchange_rates) or ((time_stamp.now - time_stamp) > Needs_Update) or true post (void(initial(exchange_rates)) and ~void(exchange_rates) and (time_stamp = time_stamp.now)) or true is -- This routine is called when exchange_rates is 'out of date' or -- has not yet been read in from an exchange rate file. if void(exchange_rates) then loc_str : STR := OPSYS::get_env(Env_Name.str) ; exch_file := FILE_PATH::create(loc_str) end ; if void(exchange_rates) or ((TIME_STAMP::now - time_stamp) > Needs_Update) then fyle : BIN_FILE := BIN_FILE::open_for_read(exch_file.str) ; if fyle.error then if void(exchange_rates) then -- not even a first guess!! SYS_ERROR::create.file_error(self,fyle) else -- run on with the last obtainable version end else bin_cursor : BIN_CURSOR := fyle.buffer.binstr.cursor ; fyle.close ; Needs_Update := ELAPSED::build(bin_cursor) ; if void(exchange_rates) then -- need one! exchange_rates := ARRAY{RAT}::create(val_count) end ; loop val_count.times! ; exchange_rates.set!(RAT::build(bin_cursor)) ; if bin_cursor.is_done then -- Bad rate file!! SYS_ERROR::create.file_error(self,fyle) end end end ; time_stamp := TIME_STAMP::now end end ; private check_names( loc_lib : LIBCHARS ) pre ~void(self) and ~void(lib) post (lib = loc_lib) and (Names.asize = val_count) is -- This auxiliary routine is a specialised version for this enumerated -- class. It attempts to set the value of the Names array if that is void or -- of a different culture to the required one. If this action is not -- successful then an exception is raised. The second component of this -- checks for the presence/currency of the exchange rate table and updates -- it from the file as needed! if void(Names) or (lib /= loc_lib) then lib := loc_lib ; Names := lib.culture.resources.read(SYS::rune_name(self),val_count) ; update_rates end end ; -- The next routines provide the enumeration itself. Local : MONETARY_UNITS is return enum(1) end ; -- Whatever it is Afghanistan : MONETARY_UNITS is return enum(2) end ; Albania : MONETARY_UNITS is return enum(3) end ; Algeria : MONETARY_UNITS is return enum(4) end ; Angola : MONETARY_UNITS is return enum(5) end ; EC_Dollar : SAME is return enum(6) end ;-- - Anguilla -- - Antigua -- - Barbuda -- - Dominican C/W -- - Grenada -- - Montserrat -- - St Kitts-Nevis -- - St Lucia -- - St Vincent Argentina : SAME is return enum(7) end ; Aruba : SAME is return enum(8) end ; Australia : SAME is return enum(9) end ; -- also -- - Kiribati -- - Nauru -- - Norfolk Is -- - Tuvalu Is Austria : SAME is return enum(10) end ; Azerbaijan : SAME is return enum(11) end ; Bahamas : SAME is return enum(12) end ; Bahrain : SAME is return enum(13) end ; Bangladesh : SAME is return enum(14) end ; Barbados : SAME is return enum(15) end ; Byelorussia : SAME is return enum(16) end ; Belgium : SAME is return enum(17) end ; Belize : SAME is return enum(18) end ; CFA_Franc : SAME is return enum(19) end ; -- Benin -- - Burkina Faso -- - Cameroon -- - Guinea Bissau -- - Ivory Coast -- - Mali -- - Niger -- - Senegal -- - Togo Bermuda : SAME is return enum(20) end ; Bhutan : SAME is return enum(21) end ; Bolivia : SAME is return enum(22) end ; Bosnia_Herzegovina : SAME is return enum(23) end ; Botswana : SAME is return enum(24) end ; Brazil : SAME is return enum(25) end ; Brunei : SAME is return enum(26) end ; Bulgaria : SAME is return enum(27) end ; Burma : SAME is return enum(28) end ; Burundi : SAME is return enum(29) end ; Cambodia : SAME is return enum(30) end ; CAF_Franc : SAME is return enum(31) end ; -- Cameroon -- - Cent. Afr Rep. -- - Chad -- - Congo Rep -- - Eq. Guinea -- - Gabon Canada : SAME is return enum(32) end ; Cape_Verde_Is : SAME is return enum(33) end ; Cayman_Is : SAME is return enum(34) end ; Chile : SAME is return enum(35) end ; China : SAME is return enum(36) end ; Colombia : SAME is return enum(37) end ; Comoro_Is : SAME is return enum(38) end ; Congo_Zaire : SAME is return enum(39) end ; -- also -- - Congo (Kinshasa) Costa_Rica : SAME is return enum(40) end ; Croatia : SAME is return enum(41) end ; Cuba : SAME is return enum(42) end ; Cyprus : SAME is return enum(43) end ; Czech_Rep : SAME is return enum(44) end ; Denmark : SAME is return enum(45) end ; -- also -- - Faeroe Is -- - Greenland Djibouti : SAME is return enum(46) end ; Dominican_Rep : SAME is return enum(47) end ; Ecuador : SAME is return enum(48) end ; Egypt : SAME is return enum(49) end ; El_Salvador : SAME is return enum(50) end ; Estonia : SAME is return enum(51) end ; Ethiopia : SAME is return enum(52) end ; -- also -- - Eritrea Falkland_Is : SAME is return enum(53) end ; Fiji : SAME is return enum(54) end ; Finland : SAME is return enum(55) end ; France : SAME is return enum(56) end ; -- also -- - Andorra -- - Fr Guiana -- - Fr Polynesia -- - Guadeloupe -- - Martinique -- - Mayotte -- - Monaco -- - Reunion Is Gambia : SAME is return enum(57) end ; Georgia : SAME is return enum(58) end ; Germany : SAME is return enum(59) end ; Ghana : SAME is return enum(60) end ; Gibraltar : SAME is return enum(61) end ; Greece : SAME is return enum(62) end ; Guatemala : SAME is return enum(63) end ; Guinea : SAME is return enum(64) end ; Guyana : SAME is return enum(65) end ; Haiti : SAME is return enum(66) end ; Honduras : SAME is return enum(67) end ; Hong_Kong : SAME is return enum(68) end ; Hungary : SAME is return enum(69) end ; Iceland : SAME is return enum(70) end ; India : SAME is return enum(71) end ; -- also -- - Bhutan Indonesia : SAME is return enum(72) end ; Iran : SAME is return enum(73) end ; Iraq : SAME is return enum(74) end ; Ireland : SAME is return enum(75) end ; Israel : SAME is return enum(76) end ; Italy : SAME is return enum(77) end ; -- also -- - San Marino -- - Vatican City Jamaica : SAME is return enum(78) end ; Japan : SAME is return enum(79) end ; Jordan : SAME is return enum(80) end ; Kazakhstan : SAME is return enum(81) end ; Kenya : SAME is return enum(82) end ; North_Korea : SAME is return enum(83) end ; South_Korea : SAME is return enum(84) end ; Kuwait : SAME is return enum(85) end ; Kyrgyzstan : SAME is return enum(86) end ; Laos : SAME is return enum(87) end ; Latvia : SAME is return enum(88) end ; Lebanon : SAME is return enum(89) end ; Lesotho : SAME is return enum(90) end ; Liberia : SAME is return enum(91) end ; Libya : SAME is return enum(92) end ; Lithuania : SAME is return enum(93) end ; Luxembourg : SAME is return enum(94) end ; Macau : SAME is return enum(95) end ; Macedonia : SAME is return enum(96) end ; Madagascar : SAME is return enum(97) end ; Malawi : SAME is return enum(98) end ; Malaysia : SAME is return enum(99) end ; Maldive_Is : SAME is return enum(100) end ; Malta : SAME is return enum(101) end ; Mauritania : SAME is return enum(102) end ; Mauritius : SAME is return enum(103) end ; Mexico : SAME is return enum(104) end ; Moldova_Rep : SAME is return enum(105) end ; Mongolia : SAME is return enum(106) end ; Morocco : SAME is return enum(107) end ; Mozambique : SAME is return enum(108) end ; Myanmar : SAME is return enum(109) end ; Nepal : SAME is return enum(110) end ; Neth_Antilles : SAME is return enum(111) end ; Netherlands : SAME is return enum(112) end ; New_Caledonia : SAME is return enum(113) end ; New_Zealand : SAME is return enum(114) end ; -- also -- - Cook Is -- - Niue Nicaragua : SAME is return enum(115) end ; Nigeria : SAME is return enum(116) end ; Norway : SAME is return enum(117) end ; Oman : SAME is return enum(118) end ; Pakistan : SAME is return enum(119) end ; Panama : SAME is return enum(120) end ; Papua_New_Guinea : SAME is return enum(121) end ; Paraguay : SAME is return enum(122) end ; Peru : SAME is return enum(123) end ; Philippines : SAME is return enum(124) end ; Poland : SAME is return enum(125) end ; Portugal : SAME is return enum(126) end ; Qatar : SAME is return enum(127) end ; Romania : SAME is return enum(128) end ; Russian_Federation : SAME is return enum(129) end ; -- also -- - Armenia Rwanda : SAME is return enum(130) end ; W_Samoa : SAME is return enum(131) end ; Sao_Tome : SAME is return enum(132) end ; Saudi_Arabia : SAME is return enum(133) end ; Seychelles : SAME is return enum(134) end ; Sierra_Leone : SAME is return enum(135) end ; Singapore : SAME is return enum(136) end ; Slovakia : SAME is return enum(137) end ; Slovenia : SAME is return enum(138) end ; Solomon_Is : SAME is return enum(139) end ; Somalia : SAME is return enum(140) end ; South_Africa : SAME is return enum(141) end ;-- also -- - Namibia Spain : SAME is return enum(142) end ; -- also -- - Andorra Sri_Lanka : SAME is return enum(143) end ; Sudan : SAME is return enum(144) end ; Surinam : SAME is return enum(145) end ; Swaziland : SAME is return enum(146) end ; Sweden : SAME is return enum(147) end ; Switzerland : SAME is return enum(148) end ; -- also -- - Liechtenstein Syria : SAME is return enum(149) end ; Taiwan : SAME is return enum(150) end ; Tajikistan : SAME is return enum(151) end ; Tanzania : SAME is return enum(152) end ; Thailand : SAME is return enum(153) end ; Tonga : SAME is return enum(154) end ; Trinidad_Tobago : SAME is return enum(155) end ; Tunisia : SAME is return enum(156) end ; Turkey : SAME is return enum(157) end ; Turkmenistan : SAME is return enum(158) end ; Uganda : SAME is return enum(159) end ; Ukraine : SAME is return enum(160) end ; United_Kingdom : SAME is return enum(161) end ; USA : SAME is return enum(162) end ; -- also -- - British Virgin Is -- - Guam -- - Marshall Is -- - Micronesia -- - N Mariana Is -- - Palau Is -- - Puerto Rico -- - American Samoa -- - Turks & Caicos Is -- - US Virgin Is United_Arab_Em : SAME is return enum(163) end ; Uruguay : SAME is return enum(164) end ; Uzbekistan : SAME is return enum(165) end ; Vanuatu : SAME is return enum(166) end ; Venezuela : SAME is return enum(167) end ; Vietnam : SAME is return enum(168) end ; Yemen : SAME is return enum(169) end ; Yugoslavia : SAME is return enum(170) end ; Zambia : SAME is return enum(171) end ; Zimbabwe : SAME is return enum(172) end ; ECU : SAME is return enum(173) end ; -- European Currency Unit rate : RAT pre true post ~void(exchange_rates) and (result = exchange_rates[enum - 1]) is -- This routine is provided to return the exchange rate corresponding -- to the value of self relative to the local currency. update_rates ; return exchange_rates[enum - 1] end ; end ; -- MONETARY_UNITS

immutable class MONEY < $NFE{MONEY}, $SIGNED{MONEY}, $HASH,

immutable class MONEY < $NFE{MONEY}, $SIGNED{MONEY}, $HASH, $OPTION, $FIXED_FMT is -- This class is a numeric class which implements the abstraction of -- a monetary value. The unit of value is that prevailing at the location -- where the program is running! -- This class is primarily implemented by the simple operations of -- the infinite integer class RAT - in so far as they apply to sums of money. -- Version 1.2 Oct 98. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 11 Jun 97 kh Original. -- 28 Sep 98 kh Factored out conversions to MONEY_STR -- 11 Oct 98 kh Converted to use RAT include COMPARABLE ; include BINARY ; include MONEY_STR ; const negatable : BOOL := true ; const is_limited : BOOL := false ; const is_signed : BOOL := true ; readonly attr val : RAT ; const Calculate_Places : CARD := 4 ; -- Four decimal places! const Precision : INTI := INTI::create(10000) ; -- divisor for four places! zero : SAME is -- This is one of the two 'constants' of this class. return val(RAT::zero) end ; one : SAME is -- This is one of the two 'constants' of this class. return val(RAT::create(Precision,Precision)) end ; nil : SAME is -- This routine returns a nil value which may not be used in arithmetic. return val(RAT::nil) end ; build( cursor : BIN_CURSOR ) : SAME pre ~void(cursor) and ~cursor.is_done post true is -- This routine returns the value found in the binary string indicated -- which is expected to start with an 'infinite' integer representing the -- monetary value in local currency units. return val(RAT::build(cursor)) end ; create(val : CARD) : SAME is -- This routine creates a local money value from the given number -- of integral local currency units. return val(RAT::create(val.inti * Precision,Precision)) end ; create( val : FIELD ) : SAME is -- This routine creates a money value from the given number of integral -- local currency units. return val(RAT::create(val.inti * Precision,Precision)) end ; create( val : INT ) : SAME is -- This routine creates a money value from the given number of integral -- local currency units. return val(RAT::create(val.inti * Precision,Precision)) end ; create( ival : INTI ) : SAME is -- This routine creates a money value from the given number of integral -- local currency units. return val(RAT::create(ival * Precision,Precision)) end ; create( val : INTI, fraction : INTI ) : SAME pre ~(val.is_zero) and ~(fraction.is_zero) and (val.sign = fraction.sign) post true is -- This routine creates a money value from the given number of local -- currency units expressed as a whole number before the decimal mark and -- a whole number representing the fraction part. if fraction.is_zero then return val(RAT::create(val)) else factor : INTI := INTI::create(10) ; loop while!(factor < fraction) ; factor := factor * INTI::create(10) end ; return val(RAT::create(val * factor + fraction)) end end ; create( rval : RAT ) : SAME is -- This routine creates a money value from the given number of currency -- units, rounded to the internal precision. return val(RAT::create(rval.num * Precision / rval.denom, Precision)) end ; create( val : FLT ) : SAME is -- This routine creates a money value from the given number of currency -- units, rounded to the internal precision. loc_whole : FLT := val.floor ; loc_fract : FLT := ((val - val.floor) * Precision.flt + 0.5).truncate ; return val(RAT::create(loc_whole.inti * Precision + loc_fract.inti,Precision)) end ; create( val : FLTD ) : SAME is -- Provided that val is an integer value, this routine creates an -- equivalent valued RAT object. loc_whole : FLTD := val.floor ; loc_fract : FLTD := ((val - val.floor) * Precision.fltd + 0.5d).truncate ; return val(RAT::create(loc_whole.inti * Precision + loc_fract.inti,Precision)) end ; create( val : FLTD, units : MONETARY_UNITS ) : SAME is -- This version of the creation routine creates a money value in the -- local currency by multiplying by the exchange rate for the currency -- indicated. loc_whole : FLTD := val.floor ; loc_fract : FLTD := ((val - val.floor) * Precision.fltd + 0.5d).truncate ; return val(RAT::create(loc_whole.inti * Precision + loc_fract.inti,Precision) * units.rate) end ; create( descr : MONEY_DESCR ) : SAME is -- This routine converts the money descr into a value in the local currency, -- using the exchange rate table. Note that this conversion is made at -- the rate prevailing at the instant of calling this routine. return val(create(descr.whole,descr.fraction).val * descr.kind.rate) end ; is_eq( other : SAME ) : BOOL is -- This predicate returns true if and only if self and other represent -- the same amount of money. return val = other.val end ; is_lt( other : SAME ) : BOOL is -- This predicate returns true if and only if self represents a lesser -- monetary value than other. return val < other.val end ; is_exact : BOOL is -- This predicate returns true if and only if the value of self is an exact number. return val.is_exact; end ; is_pos : BOOL is -- This predicate returns true if and only if the value of self is -- greater than zero. return self > zero end ; is_zero : BOOL is -- This predicate returns true if and only if the values of self -- is zero. return self = zero end ; is_neg : BOOL is -- This predicate returns true if and only if the value of self is less -- than zero. return self < zero end ; is_nil : BOOL is -- This predicate returns true if and only if self has the value nil. return val = RAT::nil end ; sign : NUM_SIGNS pre ~void(self) post (result = val.sign) is -- This routine returns the sign state of the cash value represented by -- self. return val.sign end ; abs : SAME pre ~void(self) post result.val = val.abs is -- This is the unary absolute routine which merely copies the RAT answer. return val(self.val.abs) end ; negate : SAME pre ~void(self) post result.val.is_zero or (result.val.is_neg and val.is_pos) or (result.val.is_pos and val.is_neg) is -- This is the unary minus routine which merely copies the RAT answer. return val(-self.val) end ; plus( other : SAME ) : SAME pre ~void(self) and ~void(other) post result.val = val + other.val is -- This routine performs the addition of two monetary values. return val(self.val + other.val) end ; minus( other : SAME ) : SAME pre ~void(self) and ~void(other) post result.val = val - other.val is -- This routine performs the subtraction of two monetary values. return val(self.val - other.val) end ; times( factor : INTI ) : SAME pre ~void(self) and ~void(factor) post result.val = val * RAT::create(factor) is -- This routine multiplies self by a number to produce a new monetary -- value. return val(self.val * RAT::create(factor)) end ; times( factor : INT ) : SAME pre ~void(self) and ~void(factor) post result.val = val * RAT::create(factor) is -- This routine multiplies self by a number to produce a new monetary -- value. return val(self.val * RAT::create(factor)) end ; times( factor : CARD ) : SAME pre ~void(self) and ~void(factor) post result.val = val * RAT::create(factor) is -- This routine multiplies self by a number to produce a new monetary -- value. return val(self.val * RAT::create(factor)) end ; times( factor : FLT ) : SAME pre ~void(self) and ~void(factor) post true ---- Ought to be cleverer!!!!!!!!!!!!! is -- This routine multiplies self by a number to produce a new monetary -- value. loc_whole : FLT := factor.floor ; loc_fract : FLT := ((factor - factor.floor) * Precision.flt + 0.5).truncate ; loc_factor : RAT := RAT::create(loc_whole.inti * Precision + loc_fract.inti,Precision) ; return val(val * loc_factor) end ; times( factor : FLTD ) : SAME pre ~void(self) and ~void(factor) post true ---- Ought to be cleverer!!!!!!!!!!!!! is -- This routine multiplies self by a number to produce a new monetary -- value. loc_whole : FLTD := factor.floor ; loc_fract : FLTD := ((factor - factor.floor) * Precision.fltd + 0.5d).truncate ; loc_factor : RAT := RAT::create(loc_whole.inti * Precision + loc_fract.inti,Precision) ; return val(val * loc_factor) end ; binstr : BINSTR pre ~void(self) post self = create(result) is -- This routine returns the binary string form of self. return val.binstr end ; div( divisor : INTI ) : SAME pre ~void(self) and ~void(divisor) post result.val = val / RAT::create(divisor) is -- This routine divides self by a number to produce a new monetary -- value. return val(val / RAT::create(divisor)) end ; div( divisor : INT ) : SAME pre ~void(self) and ~(divisor = INT::zero) post result.val = val / RAT::create(divisor) is -- This routine divides self by a number to produce a new monetary -- value. return val(val / RAT::create(divisor)) end ; div( divisor : CARD ) : SAME pre ~void(self) and ~(divisor = 0) post result.val = val / RAT::create(divisor) is -- This routine divides self by a number to produce a new monetary -- value. return val(val / RAT::create(divisor)) end ; div( divisor : FLT ) : SAME pre ~void(self) and ~(divisor = FLT::zero) post true ---- Ought to be cleverer!!!!!!!!!!!!! is -- This routine divides self by a number to produce a new monetary -- value. loc_whole : FLT := divisor.floor ; loc_fract : FLT := ((divisor - divisor.floor) * Precision.flt + 0.5).truncate ; loc_divisor : RAT := RAT::create(loc_whole.inti * Precision + loc_fract.inti,Precision) ; return val(val / loc_divisor) end ; div( divisor : FLTD ) : SAME pre ~void(self) and ~(divisor = FLTD::zero) post true ---- Ought to be cleverer!!!!!!!!!!!!! is -- This routine divides self by a number to produce a new monetary -- value. loc_whole : FLTD := divisor.floor ; loc_fract : FLTD := ((divisor - divisor.floor) * Precision.fltd + 0.5d).truncate ; loc_divisor : RAT := RAT::create(loc_whole.inti * Precision + loc_fract.inti,Precision) ; return val(val / loc_divisor) end ; div( other : SAME ) : FLT pre ~void(self) and ~void(other) post result = (self.val / other.val).flt is -- This routine divides self by a monetary value, giving the ratio -- between the two. return (val / other.val).flt end ; foreign( unit : MONETARY_UNITS ) : SAME pre ~void(self) and ~unit.is_nil post result.val = val * unit.rate is -- This routine multiplies self by the given exchange rate to produce -- a value in the indicated currency - which is thereafter the 'local' value -- for which local is the given unit argument. -- -- WARNING After conversion this value is no longer comparable with -- the true local (to the executing program) currency value. -- Any attempt to do so will produce an ERRONEOUS result return val(self.val * unit.rate) end ; hash : CARD pre true -- whatever the value post true -- whatever the result is -- This routine returns the hash value for the corresponding infinite -- integer. return val.hash end ; loc_val : BINSTR pre ~void(self) post create(result) = self is -- This routine returns a binary string form of the monetary value in -- the local unit of value. return val.binstr end ; exchange_val( units : MONETARY_UNITS ) : BINSTR pre ~void(self) and ~units.is_nil post true -- create(result) = self * units.rate is -- This routine returns a binary string form of the monetary value in -- the given units as determined by the rate of exchange current at the time -- of calling this routine. return MONEY_DESCR::create(val.num,val.denom,units).binstr end ; end ; -- MONEY