number_culture.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 ALT_DIGITS < $BINARY
class ALT_DIGITS < $BINARY is
-- This class embodies the abstraction of other characters than Arabic
-- digits being used for the string representation of numbers. See ISO/IEC
-- 14652 for details.
-- The reason for the class containing an array of strings is that it
-- is possible a table of character sequences needed in the expression of
-- numbers in a non-positional notation or where there are more values in
-- a positional notation than can be expressed by a single character (eg in
-- Chinese or Japanese).
-- The implementation is a very cut down version similar to FLIST.
-- Version 1.1 Oct 98. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 13 Jun 97 kh Original design
-- 30 Oct 98 kh Added BINARY and pre/post conditions.
include COMPARE{CODE_STR} ;
include BINARY ;
private include AREF{CODE_STR}
aset -> aref_aset,
aget -> aget ;
private attr loc : CARD ;
private attr kind : CODE_KINDS ;
private const Min_Size : CARD := 10 ; -- Many scripts have only ten!
create : SAME is
-- This routine creates an empty list for filling up!
return void
end ;
build(cursor : BIN_CURSOR,lib : LIBCHARS) : SAME
pre ~void(cursor)
and ~cursor.is_done
and ~void(lib)
post cursor.is_done -- ran out of data!
or (result.size = initial(cursor.item.card))
is
-- This routine reads the data using the given binary cursor, returning
-- the newly created object
loc_size : CARD := cursor.get_item.card ; -- max is 100
-- (see ISO/IEC 14652
me : SAME := new(loc_size) ;
loop
index : CARD := 0.upto!(loc_size - 1) ;
me[index] := CODE_STR::build(cursor.get_sized.cursor,lib) ;
if cursor.is_done then -- string wasn't long enough!
break!
end
end ;
me.loc := me.asize ; -- is the NEXT index to be filled
return me
end ;
build(cursor : BIN_CURSOR) : SAME
pre ~void(cursor)
and ~cursor.is_done
post cursor.is_done -- ran out of data!
or (result.size = initial(cursor.item.card))
is
-- This routine reads the data using the given binary cursor, returning
-- the newly created object
return build(cursor,LIBCHARS::default)
end ;
read(index : BIN_CURSOR,lib : LIBCHARS) : SAME
pre ~void(index)
and ~index.is_done
post true
is
-- This routine assumes that the next octet in the binary string
-- represents a boolean value. If this value is true then the appropriate
-- number of octets is used to build and return a new object. The use of
-- lib is provided in case the object being built needs conversion of
-- binary data to some textual form.
if BOOL::build(index) then
return build(index,lib)
else
return void
end
end ;
is_empty : BOOL is
-- This predicate returns true if and only if the size is zero.
return loc = 0
end ;
size : CARD
pre true
post (result = 0)
or (result = loc)
is
-- This routine returns the current size -- self may be void when
-- the value zero is returned.
if void(self) then
return 0
else
return loc
end
end ;
private aset(index : CARD,val : CODE_STR)
pre ~void(self)
and (val.size > 0)
and (index < loc)
post self[index] = val
is
-- This routine sets the indexed element of self to the value val.
-- Self may not be void.
aref_aset(index,val)
end ;
is_alt_digit(ch : CHAR_CODE) : BOOL is
-- This predicate returns true if and only if the given character is
-- found in the array. Where a value is greater than a single character it
-- is presumed to be made up from a sequence of characters previously found
-- in earlier elements of the array - which makes testing different from
-- conversion to numeric form.
loop
if aelt![0] = ch then
return true
end
end ;
return false
end ;
push(codes : CODE_STR) : SAME
pre ~void(codes)
post (result.loc = self.loc + 1)
is
--This routine appends the argument to self.
res : SAME ;
if void(self) then
res := new(Min_Size)
elsif loc < asize then
res := self
else
res := new(2 * asize) ;
res.loc := loc ;
res.kind := self.kind ;
loop
res.aset!(aelt!)
end ;
SYS::destroy(self) -- old one should never be used.
end ;
res[res.loc] := codes ;
res.loc := res.loc + 1 ; -- for next time
return res
end ;
card(val : CODE_STR ) : CARD
pre ~void(self)
and (self.loc > 0) -- something to look up against
and (val.size > 0)
post (result = CARD::nil) -- not found
or ([result] = val)
is
--This routine returns the index of elem if found in the list,
-- otherwise CARD::nil. This could be used, for example for input
-- analysis using non-Arabic characters.
if ~void(self) then
loop
res : CARD := ind! ;
if elt_eq(val,[res]) then
return res
end
end
end ;
return CARD::nil
end ;
binstr : BINSTR
pre ~void(self)
post ~void(result)
is
--This routine returns a binary string representation of self. Note
-- that the array has already been converted into target encoding!
loc_str : BINSTR := BINSTR::create(OCTET::create(loc)) ;
loop
loc_str := loc_str + aelt!.binstr.sized
end ;
return loc_str
end ;
ind! : CARD
pre ~void(self)
post result < loc
is
-- Provided that self is not void this iter yields the sequence of index
-- numbers by which self may be indexed.
if ~void(self) then
loop
yield 0.upto!(loc - 1)
end
end
end ;
str(val : CARD) : STR
pre ~void(self) and (val < (loc - 1))
is
-- This routine returns the string representation of the given value
-- provided that val is in the range of the array!
return aget(val).tgt_str
end ;
end ; -- ALT_DIGITS
class NUMBER_FMT < $BINARY
class NUMBER_FMT < $BINARY is
-- This class is the descriptor to be used when formatting a numeric
-- value when converting to a textual representation. Note that the
-- mechanism for formatting floating numbers requires the digit string,
-- rather than a value!
-- Version 1.0 May 97. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 22 May 97 kh Original design using ISO/IEC 14652 spec.
include BINARY ;
private const Octal_Base : CARD := 8 ;
private const Decimal_Base : CARD := 10 ;
private const Hexadecimal_Base : CARD := 16 ;
readonly attr decimal_mark : CHAR_CODE ;
readonly attr thousands_sep : CHAR_CODE ;
private attr sections : FLIST{CARD} ;
create(dec, sep : CODE_STR, sects : FLIST{CARD}) : SAME
pre ~void(sects) -- although it may be empty!
and ~void(dec)
and ~void(sep)
post ~void(result)
and (result.sections.size = sects.size)
is
--This creation routine is provided for use by the program reading
-- source text to create this object.
me : SAME := new ;
loop
me.decimal_mark := dec.elt! ;
break!
end ;
loop
me.thousands_sep := sep.elt! ;
break!
end ;
me.sections := sects.copy ;
return me
end ;
build(index : BIN_CURSOR,lib : LIBCHARS) : SAME
pre ~void(index)
and ~index.is_done
and ~void(lib)
post ~void(result)
is
--This routine reads its component values from the binary string
-- indicated using the indicated repertoire and encoding and then returns
-- the new object.
me : SAME := new ;
-- The following two component assignments all assume that
-- the components involved are a single character!
loc_kind : CODE_KINDS := CODE_KINDS::build(index) ;
if loc_kind /= lib.culture.kind then
SYS_ERROR::create.error(me,SYS_EXCEPT::Bad_Value,loc_kind.str)
end ;
loc_str : BINSTR := index.get_sized ;
if loc_str.size > 0 then
me.decimal_mark := CHAR_CODE::create(loc_str,lib)
end ;
loc_str := index.get_sized ;
if loc_str.size > 0 then
me.thousands_sep := CHAR_CODE::create(loc_str,lib)
end ;
loc_cnt : CARD := index.get_item.card ;
if loc_cnt > 0 then
me.sections := FLIST{CARD}::create(loc_cnt) ;
loop
loc_cnt.times! ;
if index.is_done then
break!
end ;
me.sections := me.sections.push(index.get_item.card)
end
end ;
return me
end ;
build(index : BIN_CURSOR) : SAME
pre ~void(index)
and ~index.is_done
post ~index.is_done
is
--This routine reads its component values from the binary string
-- indicated using the indicated repertoire and encoding and then returns
-- the new object.
return build(index,LIBCHARS::default)
end ;
binstr : BINSTR
pre ~void(self)
post ~void(result)
is
--This routine converts the numeric format to a binary representation
-- suitable for filing which can be built again as desired.
res : BINSTR := decimal_mark.lib.culture.kind.binstr +
decimal_mark.raw_binstr.sized +
thousands_sep.raw_binstr.sized ;
res := res + OCTET::create(sections.size) ;
loop
res := res + OCTET::create(sections.elt!)
end ;
return res
end ;
digit_string(cursor : STR_CURSOR,seps_allowed : BOOL,base : CARD) : FLIST{CARD}
pre ~void(cursor)
and ~cursor.is_done
post true
is
--This routine is the digit scanner which returns the string of digits
-- for the given base, ignoring separator characters if they are permitted.
start_index : CARD := cursor.index ;
loc_lib : LIBCHARS := cursor.buffer.index_lib ;
res : FLIST{CARD} := FLIST{CARD}::create ;
loop
if cursor.is_done then
return res
end ;
loc_code : CHAR_CODE := cursor.item.code ;
if loc_code = thousands_sep then
if seps_allowed then -- 'separator'
cursor.advance
else
return res
end
else
case base
when Octal_Base then
if cursor.item.is_octal_digit(loc_lib) then
res := res.push(loc_lib.oct_card(loc_code.char)) ;
cursor.advance
else
return res
end
when Decimal_Base then
if cursor.item.is_digit(loc_lib) then
res := res.push(loc_lib.card(loc_code.char)) ;
cursor.advance
else
return res
end
when Hexadecimal_Base then
if cursor.item.is_hex_digit(loc_lib) then
res := res.push(loc_lib.hex_card(loc_code.char)) ;
cursor.advance
else
return res
end
else
cursor.set_index(start_index) ;
return void
end
end
end
end ;
private do_format(val : FLIST{CARD},digits : ROUT{CARD} : CHAR_CODE,places : CARD,force : BOOL) : CODE_STR
pre ~void(val)
and (val.size > 0)
post result.size >= val.size
is
-- This is the private routine which does all of the actual number formatting.
-- val: digits in Least Sig first order
-- force: a decimal mark if places zero!
res : CODE_STR := CODE_STR::create(decimal_mark.lib) ; -- Used to give correct lib!
if (places = 0)
and force then -- put in a zero after the point.
res := res + digits.call(0)
end ;
digit_index : CARD := 0 ;
if places > 0 then
loop -- fraction digits first!
digit_index := 0.upto!(places - 1) ;
digit : CARD := val[digit_index] ;
res := res + digits.call(digit)
end ;
digit_index := places -- ready to start whole part!
end ;
if places > val.size then
loop -- to insert leading zeroes!
(places - val.size).times! ;
res := res + digits.call(0)
end
end ;
if (places > 0) or force then
res := res + decimal_mark
end ;
if (digit_index > 0)
or (places = 0) then -- just a single digit?
index : CARD := 0 ; -- for the group array!
group_cnt : CARD ;
if sections.size = 0 then -- no separators!
group_cnt := CARD::maxval -- suitable large value!
else
group_cnt := sections[index]
end ;
loop
digit_index := digit_index.upto!(val.size - 1) ;
digit : CARD := val[digit_index] ;
if (group_cnt = 0) then -- NOTE never entered if maxval!
res := res + thousands_sep ;
if index < (sections.size - 1) then
index := index + 1
end ;
group_cnt := sections[index]
end ;
group_cnt := group_cnt - 1 ;
res := res + digits.call(digit) ;
end
elsif force then -- a leading zero!
res := res + digits.call(0)
end ;
return res.reverse
end ;
private do_format_no_sep(val : FLIST{CARD},digits : ROUT{CARD} : CHAR_CODE,places : CARD,force : BOOL) : CODE_STR
pre ~void(val)
and (val.size > 0)
post result.size >= val.size
is
-- This is the private routine which does all of the actual number formatting without separators.
-- val: digits in Least Sig first order
-- force: a decimal mark if places zero!
res : CODE_STR := CODE_STR::create(decimal_mark.lib) ; -- Used to give correct lib!
if (places = 0)
and force then -- put in a zero after the point.
res := res + digits.call(0)
end ;
digit_index : CARD := 0 ;
if places > 0 then
loop -- fraction digits first!
digit_index := 0.upto!(places - 1) ;
digit : CARD := val[digit_index] ;
res := res + digits.call(digit)
end ;
digit_index := places -- ready to start whole part!
end ;
if places > val.size then
loop -- to insert leading zeroes!
(places - val.size).times! ;
res := res + digits.call(0)
end
end ;
if (places > 0) or force then
res := res + decimal_mark
end ;
if (digit_index > 0)
or (places = 0) then -- just a single digit?
index : CARD := 0 ; -- for the group array!
--group_cnt : CARD ;
--if sections.size = 0 then -- no separators!
--group_cnt := CARD::maxval -- suitable large value!
--else
--group_cnt := sections[index]
--end ;
loop
digit_index := digit_index.upto!(val.size - 1) ;
digit : CARD := val[digit_index] ;
--if (group_cnt = 0) then -- NOTE never entered if maxval!
--res := res + thousands_sep ;
--if index < (sections.size - 1) then
--index := index + 1
--end ;
--group_cnt := sections[index]
--end ;
--group_cnt := group_cnt - 1 ;
res := res + digits.call(digit) ;
end
elsif force then -- a leading zero!
res := res + digits.call(0)
end ;
return res.reverse
end ;
fmt(val : FLIST{CARD},places : CARD,force : BOOL,lib : LIBCHARS) : CODE_STR
pre ~void(self)
and ~void(lib)
post result.size >= val.size
is
--This routine is provided for use by all numeric classes for
-- formatting the digits corresponding to the unsigned value, including any
-- fractional part as may be needed. The force parameter only forces
-- a terminating decimal mark if the number of places is zero!
return do_format(val,bind(lib.digit(_)),places,force)
end ;
fmt_no_sep(val : FLIST{CARD},places : CARD,force : BOOL,lib : LIBCHARS) : CODE_STR
pre ~void(self)
and ~void(lib)
post result.size >= val.size
is
--This routine is provided for use by all numeric classes for
-- formatting the digits corresponding to the unsigned value, including any
-- fractional part as may be needed. The force parameter only forces
-- a terminating decimal mark if the number of places is zero!
return do_format_no_sep(val,bind(lib.digit(_)),places,force)
end ;
fmt(val : CARD,base : CARD,lib : LIBCHARS) : CODE_STR
pre ~void(self)
and ((base = 8)
or (base = 10)
or (base = 16))
and ~void(lib)
post result.size >= 1
is
-- This routine produces a formatted version of the given value as a text
-- string representation. This may also be used for a FIELD number.
--
-- NOTE Conversion to a digit string is carried out LS digit first!
nums : FLIST{CARD} := FLIST{CARD}::create ;
digs : ROUT{CARD} : CHAR_CODE ;
loc_val : CARD := val ;
case base
when 8 then
digs := bind(lib.oct_digit(_))
when 10 then
digs := bind(lib.digit(_))
when 16 then
digs := bind(lib.hex_digit(_))
else
return void
end ;
loop
nums := nums.push(loc_val % base) ;
loc_val := loc_val / base ;
until!(loc_val = 0)
end ;
return do_format(nums,digs,0,false)
end ;
end ; -- NUMBER_FMT
class NUMBERS < $BINARY
class NUMBERS < $BINARY is
-- This class contains the numeric components of the cultural
-- description as specified in ISO/IEC 14652 (as amended).
--
-- The two components actually come from two different segments of
-- the specification :-
--
-- format from the LC_NUMBER section
-- alternative digits - from the date/time section.
--
-- Apart from reading and writing of the attributes from/to a file,
-- this provides services to produce a string of digits from a character
-- string, omitting thousands_sep characters and (optionally) suppressing
-- leading zeroes.
-- Version 1.1 Jan 99. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 26 Jun 98 kh Original design from cultural compiler
-- 11 Jan 99 kh made sub-type from $BINARY
include BINARY ;
readonly attr format : NUMBER_FMT ;
readonly attr digits : ALT_DIGITS ;
create(form : NUMBER_FMT,digs : ALT_DIGITS) : SAME
pre ~void(form)
post true
is
--This simple creation routine returns a new object with the given
-- attributes. Note that digs may legitimately be void if the culture
-- concerned uses 'arabic' numerals as defined by the char is_digit predicate.
me : SAME := new ;
me.format := form ;
me.digits := digs ;
return me
end ;
opt_sign(val : CHAR_CODE,out found : BOOL) : BOOL
pre ~void(val)
post true
is
-- This routine returns true if and only if val is a numeric sign code
found := false ;
if (val = val.lib.Plus_Sign)
or (val = val.lib.Minus_Sign) then
found := true ;
return (val = val.lib.Minus_Sign)
else
return false
end
end ;
is_ignore(ch : CHAR_CODE) : BOOL is
-- This predicate yields true if ch is a valid separator.
return (ch = format.thousands_sep)
end ;
strip(src : CODE_STR) : CODE_STR
pre src.size > 0
post result.size <= src.size
is
--This routine strips leading zeroes from the src string.
count : CARD := 0 ;
loop
ch : CHAR_CODE := src.elt! ;
while!(ch = src.lib.digit(0)) ;
count := count + 1
end ;
if count = src.size then -- all zeroes!
count := count - 1
end ;
res : CODE_STR := CODE_STR::create(src.lib) ;
loop
res := res + src.elt!(src.size - count - 1)
end ;
return res
end ;
build(str : BIN_CURSOR,lib : LIBCHARS) : SAME is
-- Given a binary file string, this routine attempts to create a new
-- object provided that the first octet is an encoding of the value true,
-- otherwise void is returned and the only octet which has been removed is
-- the first.
me : SAME := new ;
me.digits := ALT_DIGITS::read(str,lib) ; -- It may not be present!
me.format := NUMBER_FMT::build(str,lib) ;
return me
end ;
build(str : BIN_CURSOR) : SAME is
-- Given a binary file string, this routine attempts to create a new
-- object provided that the first octet is an encoding of the value true,
-- otherwise void is returned and the only octet which has been removed is
-- the first.
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 + (~void(digits)).binstr ;
if ~void(digits) then
res := res + digits.binstr
end ;
res := res + format.binstr ; -- which isn't optional!
return res
end ;
end ; -- NUMBERS