casemaplet.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 CASE_MAPLET < $IS_EQ, $IMMUTABLE
immutable class CASE_MAPLET < $IS_EQ, $IMMUTABLE is
-- This class provides a maplet for one or more mappings between upper
-- and lower cases of alphabetic scripts (Latin, Greek, Cyrillic, Armenian and Georgian).
-- Its three components are used to denote/describe a single one-to-one
-- mapping for one character encoding to another coding which is identical
-- except for its case.
-- Version 1.2 Nov 99. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 19 Nov 96 kh Original
-- 22 Jul 98 kh Added sub-typing from $BINARY
-- 11 Nov 99 kh Strengthened pre-conditions.
include BINARY ;
include COMPARABLE ; -- is_eq over-ridden later.
private const Min_Code_Size : CARD := 2 ; -- must have at least code kind
-- plus 1 octet
readonly attr base : CHAR_CODE ;
--This attribute gives the code value of the first 'from' case code in the maplet.
readonly attr offset : INT ;
--This second attribute gives the offset to be used in calculating
-- the conversion from range to domain and vv. There is a special
-- case when the offset is one as the count then refers to pairs of adjacent
-- numeric values. This maplet kind is quite common in the various script
-- extensions in the code standard.
readonly attr count : CARD ;
--This final attribute indicates the number of upper/lower pairs
-- denoted by this maplet.
private is_valid(val : CHAR_CODE,off : INT,cnt : CARD) : BOOL is
--This private predicate determines whether the creation of a maplet
-- will result in mappings always being valid provided that the appropriate
-- range/domain check is part of the mapping routine definitions.
if off.is_zero then
#OUT+"casemaplet.sa is_valid. off=0"+"\n";
return true;
end;
loc_base : CARD := val.card ;
loc_rng_base : CARD ;
loc_rng, loc_domain : RANGE ;
if off < INT::zero then
if loc_base < off.abs.card or ~ val.is_valid(loc_base + cnt - 1,val.lib) then
#OUT+"casemaplet.sa is_valid.1"+"\n";
return false
end ;
loc_rng_base := loc_base - off.abs.card
elsif off = INT::one then -- special case of pairs
#OUT+"casemaplet.sa is_valid.2"+"\n";
return val.is_valid((loc_base - 1 + (cnt * 2)),val.lib)
else
loc_rng_base := loc_base + off.card ;
if ~ val.is_valid(loc_rng_base + cnt - 1,val.lib) then
#OUT+"casemaplet.sa is_valid.3"+"\n";
return false
end
end ;
loc_domain := RANGE::create(loc_base,loc_base + cnt - 1) ;
loc_rng := RANGE::create(loc_rng_base,loc_rng_base + cnt - 1) ;
#OUT+"casemaplet.sa is_valid.4"+"\n";
res::=loc_rng.is_disjoint(loc_domain);
if res then
#OUT+"casemaplet.sa is_valid.4.1:true:"+"(val,off,cnt)=("+val.str+","+off.str+","+cnt.str+")"+"\n";
else
#OUT+"casemaplet.sa is_valid.4.2:false:"+"(val,off,cnt)=("+val.str+","+off.str+","+cnt.str+")"+"\n";
end;
return res;
end ;
create(code_base : CHAR_CODE,off : INT,cnt : CARD) : SAME
pre is_valid(code_base,off,cnt)
post (result = self.base(code_base).offset(off).count(cnt))
is
--This routine merely creates a new maplet with the three component
-- values given as parameters, provided they form a consistent set as given
-- in the pre-condition above.
assert code_base.valid_number;
return base(code_base).offset(off).count(cnt)
end ;
build(index : BIN_CURSOR) : SAME
pre ~void(index)
and ~index.is_done
and (index.remaining >= (Min_Code_Size + CARD::binstr.size + INT::binstr.size))
post true -- result = self.base(CHAR_CODE::build(index)).offset(index.int).count(index.card)
is
--This routine creates a new object from the string representation.
-- Note that the code is expected to contain a leading code kind octet!
loc_code : CHAR_CODE := CHAR_CODE::build(index) ;
loc_off : INT := index.int ;
loc_cnt : CARD := index.card ;
return base(loc_code).offset(loc_off).count(loc_cnt)
end ;
is_eq(other : SAME) : BOOL is
--This routine returns true if and only if self and other have
-- identical component values.
return (base=other.base)
and (offset = other.offset)
and (count = other.count)
end ;
is_disjoint(other : SAME) : BOOL is
--This routine returns true if and only if self and other have
-- NO elements in common!!
loc_base : CARD := base.card ;
other_base : CARD := other.base.card ;
loc_dom_base,
other_dom_base : CARD ;
loc_rng,
loc_domain,
other_rng,
other_domain : RANGE ;
if offset < INT::zero then
loc_dom_base := loc_base - offset.abs.card
else
loc_dom_base := loc_base + offset.card
end ;
if other.offset < INT::zero then
other_dom_base := other_base - other.offset.abs.card
else
other_dom_base := other_base + other.offset.card
end ;
loc_rng := RANGE::create(loc_base,loc_base + count - 1) ;
loc_domain := RANGE::create(loc_dom_base,loc_dom_base + count - 1) ;
other_rng := RANGE::create(other_base,other_base + other.count - 1) ;
other_domain := RANGE::create(other_dom_base,other_dom_base + other.count - 1) ;
return loc_rng.is_disjoint(other_rng)
and loc_rng.is_disjoint(other_domain)
and loc_domain.is_disjoint(other_rng)
and loc_domain.is_disjoint(other_domain)
end ;
binstr : BINSTR
post (create(result) = self)
is
--This routine creates and returns a binary string representation from
-- the three components of self.
assert base.valid_number;
#OUT+"base["+base.str+"]=["+base.binstr.text_str+"]=["
+CHAR_CODE::build(base.binstr.cursor).str+"]\n";
#OUT+"ofset["+offset.str+"]=["+offset.binstr.cursor.int.str+"]\n";
#OUT+"count["+count.str+"]=["+count.binstr.cursor.card.str+"]\n";
-- #OUT+"create(...)=["+create(base,offset,count).str+"]\n";
res::= base.binstr + offset.binstr + count.binstr;
res_c::=res.cursor;
loc_code ::= CHAR_CODE::build(res_c) ;
loc_off ::= res_c.int ;
loc_cnt ::= res_c.card ;
#OUT+"casemaplet.sa binstr self["+str+"]"+
", 1 res=["+res.text_str+"]"+
", 2 [("+loc_code.str+","+loc_off.binstr.text_str+" - "+loc_cnt.binstr.text_str+")]"+
", 3 build["+build(res.cursor).str+"]"+
", 4 create(res)["+create(res).str+"]"+
"\n";
--assert (base.lib.my_size<4);
return base.binstr + offset.binstr + count.binstr
end ;
in_range(code : CHAR_CODE) : BOOL is
-- This predicate returns true if and only if the given code number
-- is in the range of this maplet.
loc_val : CARD ;
if offset = INT::one then
return (code.card <= (base.card + (count * offset.card) - 1))
and (code.card > base.card)
and ((code.card % 2) = ((base.card + 1) % 2))
elsif offset < INT::zero then
loc_val := base.card - offset.abs.card
else
loc_val := base.card + offset.card
end ;
return (code.card >= loc_val)
and (code.card < (loc_val + count))
end ;
in_domain(code : CHAR_CODE) : BOOL is
--This predicate returns true if and only if the given code number
-- is in the domain of this maplet.
if offset = INT::one then
return ((base.card % 2) = (code.card % 2))
and (code.card >= base.card)
and (code.card <= (base.card + (count * 2)))
else
return (code.card >= base.card)
and (code.card < (count + base.card))
end
end ;
reverse_map(upcode : CHAR_CODE) : CHAR_CODE
pre in_range(upcode)
post true -- Should be map(result) = upcode
is
--This routine returns the value of the range entry which maps from
-- the domain (since this is a one-to-one mapping this is possible).
return upcode.offset(-offset)
end ;
map(lowcode : CHAR_CODE) : CHAR_CODE
pre in_domain(lowcode)
post true -- should be reverse_map(result) = lowcode
is
--This routine returns the value in the domain of this maplet
-- corresponding to the given range value.
return lowcode.offset(offset)
end ;
str(lib : LIBCHARS) : STR is
--This routine returns a textual representation of the maplet in
-- the given repertoire and encoding.
return STR::create + lib.Left_Brace.char +
base.str + lib.Comma.char + lib.Space.char +
offset.str + lib.Space.char +
lib.Hyphen.char + lib.Space.char +
count.str + lib.Right_Brace.char
end ;
str : STR is
--This routine returns a textual representation of the maplet in
-- the default repertoire and encoding.
return str(LIBCHARS::default)
end ;
end ; -- CASE_MAPLET