money_cult.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 SIGN_POSITIONS < $ENUMS{SIGN_POSITIONS}
immutable class SIGN_POSITIONS < $ENUMS{SIGN_POSITIONS} is
-- This is an enumeration class which describes the different
-- positions in which a plus/minus sign may be placed when formatting
-- a monetary quantity.
-- There should be associated message files with entries containing
-- words indicating the following semantics given in English below
--
-- Parentheses - the fact that a quantity is negative is indicated by
-- enclosing it and the monetary symbol in parentheses.
-- Preceding - the sign appears in front of the value
-- Following - the sign appears after the value
-- After - the sign appears after the currency symbol
-- Before - the sign appears in front of the currency symbol.
-- Version 1.0 May 97. Copright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 20 May 97 kh Original
include ENUM{SIGN_POSITIONS} ;
private const val_count : CARD := 5 ;
-- The next routines provide the enumeration itself for a selection
-- of the official registry encodings.
Parentheses : SAME is return enum(1) end ;
Preceding : SAME is return enum(2) end ;
Following : SAME is return enum(3) end ;
Before_SY : SAME is return enum(4) end ;
After_SY : SAME is return enum(5) end ;
end ; -- SIGN_POSITIONS
immutable class MON_SPACING < $ENUMS{MON_SPACING}
immutable class MON_SPACING < $ENUMS{MON_SPACING} is
-- This is an enumeration class which describes the positioning of any
-- space included in the formatted representation of a monetary quantity.
-- The associated messages file should have the following entries with
-- the semantics given below in English
--
-- None
-- Value_Sep - a space is to be placed between the symbol and the value
-- Sign_Sep - a space separates the symbol and sign string (if they are
-- adjacent)
-- Version 1.0 May 97. Copright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 20 May 97 kh Original
include ENUM{MON_SPACING} ;
private const val_count : CARD := 3 ;
-- The next routines provide the enumeration itself for a selection
-- of the official registry encodings.
None : SAME is return enum(1) end ;
Value_Sep : SAME is return enum(2) end ;
Sign_Sep : SAME is return enum(3) end ;
end ; -- MON_SPACING
class MONEY_FMT < $BINARY
class MONEY_FMT < $BINARY is
-- This class implements the specialised money value format description
-- for use when preparing textual representations of a money value as well as
-- when obtaining a monetary value from a string.
-- Version 1.1 Jul 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 22 May 97 kh Original design using ISO/IEC 14652 spec.
-- 22 Jul 98 kh Added $BINARY features.
include BINARY ;
private const Money_Base : CARD := 10 ;
private const Carry : CARD := 1 ; -- used when rounding!
readonly attr num_fmt : NUMBER_FMT ;
readonly attr positive_sign : CHAR_CODE ;
readonly attr negative_sign : CHAR_CODE ;
readonly attr currency_symbol : CODE_STR ;
private attr sections : ARRAY{CARD} ; -- all small numbers
private attr places : CARD ; -- a small number
private attr positive_symbol_precedes : TRI_STATE ;
private attr positive_sign_separation : MON_SPACING ;
private attr positive_sign_position : SIGN_POSITIONS ;
private attr negative_symbol_precedes : TRI_STATE ;
private attr negative_sign_separation : MON_SPACING ;
private attr negative_sign_position : SIGN_POSITIONS ;
create(
dec,
sep,
plus_mark,
minus_mark,
symbol : CODE_STR,
sects : FLIST{CARD},
precision : CARD,
plus_before : TRI_STATE,
plus_sep : MON_SPACING,
plus_posn : SIGN_POSITIONS,
neg_before : TRI_STATE,
neg_sep : MON_SPACING,
neg_pos : SIGN_POSITIONS
) : SAME
pre ~void(sects)
and (sects.size > 0)
and ~plus_sep.is_nil
and ~plus_posn.is_nil
and ~neg_sep.is_nil
and ~neg_pos.is_nil
post ~void(result)
is
-- This creation routine is provided to enable the program which is
-- creating the binary files from their source text to create one of these
-- format objects.
me : SAME := new ;
me.num_fmt := NUMBER_FMT::create(dec,sep,sects) ;
if ~void(plus_mark) then
loop
me.positive_sign := plus_mark.elt! ;
break!
end
end ;
if ~void(minus_mark) then
loop
me.negative_sign := minus_mark.elt! ;
break!
end
end ;
if ~void(symbol) then
me.currency_symbol := symbol
end ;
me.places := precision ;
me.positive_symbol_precedes := plus_before ;
me.positive_sign_separation := plus_sep ;
me.positive_sign_position := plus_posn ;
me.negative_symbol_precedes := neg_before ;
me.negative_sign_separation := neg_sep ;
me.negative_sign_position := neg_pos ;
return me
end ;
build(
index : BIN_CURSOR,
lib : LIBCHARS
) : SAME
pre ~void(index)
and ~index.is_done
post ~void(result)
or index.is_done
is
-- This routine reads its component values from the binary string
-- indicated and then returns the new object.
me : SAME := new ;
me.num_fmt := NUMBER_FMT::build(index,lib) ;
loc_str : BINSTR := index.get_sized ;
if loc_str.size > 0 then
me.positive_sign := CHAR_CODE::create(loc_str,lib)
end ;
loc_str := index.get_sized ;
if loc_str.size > 0 then
me.negative_sign := CHAR_CODE::create(loc_str,lib)
end ;
loc_cursor : BIN_CURSOR := index.get_sized.cursor ;
if ~void(loc_cursor) then
me.currency_symbol := CODE_STR::build(loc_cursor,lib)
end ;
me.places := index.get_item.card ;
me.positive_symbol_precedes := TRI_STATE::build(index) ;
me.positive_sign_separation := MON_SPACING::build(index) ;
me.positive_sign_position := SIGN_POSITIONS::build(index) ;
me.negative_symbol_precedes := TRI_STATE::build(index) ;
me.negative_sign_separation := MON_SPACING::build(index) ;
me.negative_sign_position := SIGN_POSITIONS::build(index) ;
return me
end ;
build(
index : BIN_CURSOR
) : SAME
pre ~void(index)
post ~void(result)
or index.is_done
is
-- This routine creates a new object from the given binary string, using
-- the default repertoire and encoding.
return build(index,LIBCHARS::default)
end ;
binstr : BINSTR
pre ~void(self)
post ~void(result)
is
-- This routine returns a binary string representation of self starting
-- with the numeric format, the signs/symbols, then the special features.
loc_str : BINSTR := num_fmt.binstr +
positive_sign.raw_binstr.sized +
negative_sign.raw_binstr.sized +
currency_symbol.binstr.sized ;
loc_str := loc_str + OCTET::create(places) ;
loc_str := loc_str + positive_symbol_precedes.binstr +
positive_sign_separation.binstr +
positive_sign_position.binstr +
negative_symbol_precedes.binstr +
negative_sign_separation.binstr +
negative_sign_position.binstr ;
return loc_str
end ;
private do_layout(
num : CODE_STR,
symbol_precedes : TRI_STATE,
sign : CODE_STR,
position : SIGN_POSITIONS,
separation : MON_SPACING,
lib : LIBCHARS
) : CODE_STR
pre ~void(lib)
and (num.size > 0)
post result.size >= num.size
is
-- This is the routine which lays out a monetary string representation
-- in accordance with the parameters given.
res : CODE_STR := CODE_STR::create(lib) ;
if symbol_precedes = TRI_STATE::Yes then -- the value
case position
when SIGN_POSITIONS::Parentheses then
res := res + lib.Left_Parenthesis ;
res := res + currency_symbol ;
if separation = MON_SPACING::Value_Sep then
res := res + lib.Space
end ;
res := res + num ;
res := res + lib.Right_Parenthesis ;
return res
-- return res + num + lib.Right_Parenthesis
when SIGN_POSITIONS::Preceding then
res := currency_symbol ;
case separation
when MON_SPACING::None then
res := res + sign
when MON_SPACING::Value_Sep then
res := res + sign + lib.Space
when MON_SPACING::Sign_Sep then
res := res + lib.Space + sign
end ;
return res + num
when SIGN_POSITIONS::Following then
res := currency_symbol ;
case separation
when MON_SPACING::None then
res := res + num
when MON_SPACING::Value_Sep then
res := res + lib.Space + num
when MON_SPACING::Sign_Sep then
res := res + num + lib.Space
end ;
return res + sign
when SIGN_POSITIONS::Before_SY then
res := sign ;
case separation
when MON_SPACING::None then
res := res + currency_symbol
when MON_SPACING::Value_Sep then
res := res + currency_symbol + lib.Space
when MON_SPACING::Sign_Sep then
res := res + lib.Space + currency_symbol
end ;
return res + num
when SIGN_POSITIONS::After_SY then
res := currency_symbol ;
case separation
when MON_SPACING::None then
res := res + sign
when MON_SPACING::Value_Sep then
res := res + sign + lib.Space
when MON_SPACING::Sign_Sep then
res := res + lib.Space + sign
end ;
return res + num
end
else -- symbol after value
case position
when SIGN_POSITIONS::Parentheses then
res := res + lib.Left_Parenthesis + num ;
if separation = MON_SPACING::Value_Sep then
res := res + lib.Space
end ;
return res + currency_symbol + lib.Right_Parenthesis
when SIGN_POSITIONS::Preceding then
res := sign ;
case separation
when MON_SPACING::None,
MON_SPACING::Value_Sep then
res := res + num
when MON_SPACING::Sign_Sep then
res := res + lib.Space + num
end ;
return res + currency_symbol
when SIGN_POSITIONS::Following then
res := num ;
case separation
when MON_SPACING::None,
MON_SPACING::Value_Sep then
res := res + sign
when MON_SPACING::Sign_Sep then
res := res + lib.Space + sign
end ;
return res + currency_symbol
when SIGN_POSITIONS::Before_SY then
res := num ;
case separation
when MON_SPACING::None,
MON_SPACING::Value_Sep then
res := res + sign
when MON_SPACING::Sign_Sep then
res := res + sign + lib.Space
end ;
return res + currency_symbol
when SIGN_POSITIONS::After_SY then
res := num ;
case separation
when MON_SPACING::None then
res := res + num + currency_symbol
when MON_SPACING::Value_Sep then
res := res + lib.Space + currency_symbol
when MON_SPACING::Sign_Sep then
res := res + currency_symbol + lib.Space
end ;
return res + sign
end
end
end ;
-- The following routine returns the formatted monetary string
-- representation for the value given.
fmt(
cash : MONEY,
lib : LIBCHARS
) : STR
pre ~void(lib)
post ~void(result) -- and it is a culturally correct string
is
-- This routine produces a formatted version of the given data as a text
-- string representation. The first section of the routine converts the
-- monetary value into an infinite integer and then a decimal digit list.
-- Subsequently the numbers are formatted as a number and then laid out in
-- textual representation as required by the format.
res : CODE_STR := CODE_STR::create(lib) ;
multiplier : INTI := INTI::create(1) ;
loc_base : INTI := INTI::create(Money_Base) ;
loc_denom : INTI := cash.val.denom ;
loc_val : INTI := cash.val.num ; -- for normalisation!
loc_val := (loc_val * cash.Precision) / loc_denom ;
-- Now get the list of digits (with four decimal places!)
digs : FLIST{CARD} := loc_val.digits ;
if cash.Calculate_Places > places then
loc_round : BOOL := false ;
loc_place : CARD ;
index : CARD ;
loop -- rounding for representation!
index := 0.upto!(cash.Calculate_Places - places - 1) ;
if loc_round then
if digs[index] + 1 >= 5 then
loc_place := index
else
loc_round := false
end
elsif digs[index] >= 5 then
loc_round := true ;
loc_place := index
end
end ;
if loc_round then
loop -- to round to MS digits as needed
index := (loc_place + 1).upto!(digs.size - 1) ;
if digs[index] = 9 then
digs[index] := 0
else
digs[index] := digs[index] + 1 ;
break!
end
end
end ;
loc_place := cash.Calculate_Places - places ;
digs := digs.sublist(loc_place,digs.size - loc_place)
end ;
loc_sign : CODE_STR ;
num : CODE_STR := num_fmt.fmt(digs,places,true,lib) ;
-- numeric value string!
if cash.val >= RAT::zero then -- use 'positive' comps
if void(positive_sign) then
loc_sign := CODE_STR::create(lib)
else
loc_sign := CODE_STR::create(positive_sign)
end ;
return do_layout(num,positive_symbol_precedes,loc_sign,
positive_sign_position,positive_sign_separation,
lib).tgt_str
else -- use 'negative' comps
if void(negative_sign) then
loc_sign := CODE_STR::create(lib)
else
loc_sign := CODE_STR::create(negative_sign)
end ;
return do_layout(num,negative_symbol_precedes,loc_sign,
negative_sign_position,negative_sign_separation,
lib).tgt_str
end
end ;
end ; -- MONEY FMT
class CASH < $BINARY
class CASH < $BINARY is
-- This class contains the component values and formats for the monetary
-- section of the cultural specification in ISO/IEC 14652 (as amended).
--
-- Version 1.0 Jun 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 26 Jun 98 kh Original design from cultural compiler
include BINARY ;
readonly attr local : MONEY_FMT ;
readonly attr international : MONEY_FMT ;
readonly attr local_duo : MONEY_FMT ;
readonly attr international_duo : MONEY_FMT ;
readonly attr validity_from : DATES ;
readonly attr validity_to : DATES ;
readonly attr duo_validity_from : DATES ;
readonly attr duo_validity_to : DATES ;
readonly attr exchange_rate : RAT ;
build(
str : BIN_CURSOR,
lib : LIBCHARS
) : SAME
pre ~void(str)
and ~str.is_done
and ~void(lib)
post ~void(result)
or str.is_done
is
-- Given a binary file string, this routine attempts to create a new
-- object from the indicated binary string.
me : SAME := new ;
me.local := MONEY_FMT::build(str,lib) ;
me.international := MONEY_FMT::build(str,lib) ;
me.local_duo := MONEY_FMT::build(str,lib) ;
me.international_duo := MONEY_FMT::build(str,lib) ;
me.validity_from := DATES::read(str) ; -- This group of comps is optional
me.validity_to := DATES::read(str) ;
me.duo_validity_from := DATES::read(str) ;
me.duo_validity_to := DATES::read(str) ;
me.exchange_rate := RAT::build(str) ; -- not optional
if void(me.local) -- have run off the binary string!
or void(me.international)
or void(me.local_duo)
or void(me.international_duo)
or void(me.exchange_rate) then
return void
else
return me
end
end ;
build(
str : BIN_CURSOR
) : SAME
pre ~void(str)
and ~str.is_done
post ~void(result)
or str.is_done
is
-- Given a binary file string, this routine attempts to create a new
-- object from the indicated binary string using the default repertoire and
-- encoding.
return build(str,LIBCHARS::default)
end ;
binstr : BINSTR
pre ~void(self)
post ~void(result)
is
-- This routine returns the contents of self as a binary string.
res : BINSTR := BINSTR::create + local.binstr + international.binstr +
local_duo.binstr + international_duo.binstr ;
res := res + (~(validity_from = DATES::null)).binstr ;
if ~(validity_from = DATES::null) then
res := res + validity_from.binstr
end ;
res := res + (~(validity_to = DATES::null)).binstr ;
if ~(validity_to = DATES::null) then
res := res + validity_to.binstr
end ;
res := res + (~(duo_validity_from = DATES::null)).binstr ;
if ~(duo_validity_from = DATES::null) then
res := res + duo_validity_from.binstr
end ;
res := res + (~(duo_validity_to = DATES::null)).binstr ;
if ~(duo_validity_to = DATES::null) then
res := res + duo_validity_to.binstr
end ;
res := res + exchange_rate.binstr ;
return res
end ;
end ; -- CASH