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