codes.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 CHAR_CODE < $ORDERED{CHAR_CODE}, $BINARY, $TEXT, $HASH
immutable class CHAR_CODE < $ORDERED{CHAR_CODE}, $BINARY, $TEXT, $HASH is
-- This class provides an implementation version of individual character
-- codes as they may appear in mapping conversions, etc. This class is for
-- an individual code and should not be confused with a 'code sequence' which
-- may be needed to form a complete character.
-- Version 1.1 Mar 99. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 26 Jun 97 kh Original for repertoire map use.
-- 26 Mar 99 kh Complete revision for V8 of text library
include AVAL{OCTET}
asize -> ;
include COMPARABLE ;
include BINARY ;
include WHOLE_STR{CHAR_CODE} ;
const asize : CARD := 4 ;
X_invariant:BOOL is
if void(self) or void(REP_LIB_LIST::lib_list) or void(priv_lib) or
(priv_lib=CARD::nil)
or ~REP_LIB_LIST::lib_list.has_ind(priv_lib)
then return true; end;
return REP_LIB_LIST::lib_list[priv_lib].my_size<4;
end;
const lib_check:BOOL:=false; -- for debug
inspect is
inspect(lib);
end;
inspect(lib:LIBCHARS) is
#OUT+"codes.sa CHAR_CODE:";
#OUT+"loc_lib="; if void(priv_lib) then #OUT+"v"; else #OUT+priv_lib.str_base(10); end; #OUT+":";
#OUT+"kind=";
if void(lib.culture.kind.binstr) then #OUT+"v";
else #OUT+lib.culture.kind.card.str_base(16);
end;
#OUT+":size="+lib.my_size.str_base(10)+":";
loop
loc_oct::=octet!;
if loc_oct=OCTET::null then #OUT+"n";
else #OUT+"*";
end;
end;
#OUT+":";
loop
loc_oct::=aelt!;
if loc_oct=OCTET::null then #OUT+"n";
else #OUT+"*";
end;
end;
#OUT+":\n";
end;
private attr priv_lib : CARD ;
--This is the index into the shared lib_list.
nil : SAME is
--This routine returns the nil value - which is an illegal code value.
me : SAME := me.priv_lib(CARD::nil) ; -- never valid!!
return me
end ;
null : SAME is
--This routine returns a null code as a means of initialising an object.
return create(0,LIBCHARS::default)
end ;
valid_number(lib : LIBCHARS) : BOOL is
--This predicate is used to test if self CHAR_CODE will fit into the
-- number of bits available for codes using lib.
-- It returns true if and only if the value will fit.
if SYS::is_little_endian then
loop
index : CARD := 0.upto!(asize - 1) ;
loc_oct : OCTET := aelt! ;
if index >= lib.my_size then
if loc_oct /= OCTET::null then
#OUT+"CHAR_CODE::valid_number. Too long bits for codes using lib.\n";
inspect;
return false
end
end
end ;
else -- big_endian
loop
index : CARD := 0.upto!(asize - 1) ;
loc_oct : OCTET := aelt! ;
if index+lib.my_size < asize then
if loc_oct /= OCTET::null then
#OUT+"CHAR_CODE::valid_number. Too long bits for codes using lib.\n";
return false
end
end;
end ;
end;
return true
end ;
valid_number: BOOL is
return valid_number(lib);
end;
raw_build(cursor : BIN_CURSOR,lib : LIBCHARS) : SAME
pre ~void(cursor) and ~cursor.is_done
is
--This routine creates a code object from the binary string indicated
-- by the cursor, in the given repertoire and encoding (which is not contained
-- in the binary string)!
me : SAME := me.priv_lib(REP_LIB_LIST::index(lib));
if SYS::is_little_endian then
loop
i::= (lib.my_size - 1).downto!(0) ;
me.aset(i, cursor.get_item);
end;
else -- big_endian
loop
i::= (asize-lib.my_size).upto!(asize-1) ;
me.aset(i, cursor.get_item);
end;
end;
return me;
end ;
build(cursor : BIN_CURSOR) : SAME
pre ~void(cursor) and ~cursor.is_done
is
--This routine creates a code object from the binary string indicated
-- by the cursor - which, after the 'kind', is expected to be MS octet first.
start_index : CARD := cursor.index ;
loc_lib : LIBCHARS := LIBCHARS::default ;
loc_kind : CODE_KINDS := CODE_KINDS::build(cursor) ;
me:SAME:=me.priv_lib(REP_LIB_LIST::index(loc_lib)) ;
if lib_check then
REP_LIB_LIST::inspect; -- inspect
#OUT+"(codes.sa build.1:";
#OUT+"ind="+me.priv_lib.str_base(10);
#OUT+",kind=";
if void(lib.culture.kind) then #OUT+"v";
else #OUT+lib.culture.kind.card.str_base(16);
end;
#OUT+",size="+me.lib.my_size.str_base(10);
#OUT+")";
end;
if loc_lib.culture.kind = loc_kind then
--#OUT+" loc_lib.culture.kind = loc_kind ";
else
loop
loc_lib := REP_LIB_LIST::lib_list.elt! ;
if (loc_kind = loc_lib.culture.kind)
and (loc_lib.culture.state <= loc_lib.culture.All)
then
me := me.priv_lib(REP_LIB_LIST::kind_index(loc_lib)) ;
break!
end
end ;
if loc_lib = LIBCHARS::default then
cursor.set_index(start_index) ;
return nil
end
end ;
if lib_check then
#OUT+"(codes.sa build.2:";
#OUT+"ind="+me.priv_lib.str_base(10);
#OUT+",kind=";
if void(lib.culture.kind.binstr) then #OUT+"v";
else #OUT+lib.culture.kind.card.str_base(16);
end;
#OUT+",size="+me.lib.my_size.str_base(10);
#OUT+")";
end;
if SYS::is_little_endian then
loop
i::= (me.lib.my_size-1).downto!(0) ;--loc_kind.size-1).downto!(0) ;
me.aset(i,cursor.get_item)
end;
else -- big_endian
loop
i::= (asize-loc_kind.size).upto!(asize-1) ;
me.aset(i,cursor.get_item)
end;
end;
if lib_check then
#OUT+" codes.sa build.3:"; me.inspect;
end;
-- assert me.valid_number;
return me
end ;
create(str : BINSTR,lib : LIBCHARS) : SAME
pre (str.size > 0) and ((str.size % lib.my_size) = 0)
post true -- but could be NUL!! ~void(result)
is
--This routine creates a code object from the given binary string which
-- does NOT have a preliminary code-kind octet.
me : SAME := me.priv_lib(REP_LIB_LIST::index(lib)) ;
if SYS::is_little_endian then
loop
i::=(lib.my_size - 1).downto!(0) ;
me.aset(i,str.aelt!)
end;
else -- big_endian
loop
i::=(asize-lib.my_size).upto!(asize-1) ;
me.aset(i,str.aelt!)
end;
end;
return me
end ;
is_valid(val : CARD,lib : LIBCHARS) : BOOL is
--This predicate is used to test if val will fit into the
-- number of bits available for codes using lib. It returns true if and
-- only if the value will fit.
case lib.my_size
when 1 then
return val <= OCTET::Octet_Max
when 2 then
return val <= HEXTET::Hextet_Max
else
return true
end ;
end ;
private priv_create(val : CARD,lib : LIBCHARS) : SAME is
--This private routine creates a new character code which has the
-- value given. This private version permits the creation of the
-- 'Invalid' value! Note that the required conversion order is the REVERSE
-- of binstr (MSB first) order.
me : SAME := me.priv_lib(REP_LIB_LIST::index(lib)) ;
loc_val : BINSTR := val.binstr ; -- MS octet first
if SYS::is_little_endian then
loop
i::=(asize - 1).downto!(0) ;
me.aset(i,loc_val.aelt!)
end;
else -- big_endian
loop
i::=(0).upto!(asize-1) ;
me.aset(i,loc_val.aelt!)
end;
end;
return me
end ;
create( val : CARD,lib : LIBCHARS) : SAME
pre ~void(lib) and is_valid(val,lib)
-- post result.lib = REP_LIB_LIST::index(lib)
is
--This routine creates a new character code which has the value given.
-- Note that the required conversion order is the REVERSE of binstr (MSB
-- first) order.
return priv_create(val,lib)
end ;
create(ch : CHAR,lib : LIBCHARS) : SAME
pre ~void(lib) and ch.valid_number(lib)
post result.lib = lib
is
-- This routine creates a new character code which has the value given.
me : SAME := me.priv_lib(REP_LIB_LIST::index(lib)) ;
loop
index : CARD := 0.upto!(asize - 1) ;
me.aset(index,ch.aelt!)
end ;
return me
end ;
invalid : SAME is
-- This routine returns a code value which is greater than the maximum
--value (0x7FFFFFFF) to indicate some erroneous behaviour.
return priv_create(CARD::nil,LIBCHARS::default)
end ;
is_eq_kind(other:SAME):BOOL is
if (priv_lib = CARD::nil) then
return (other.priv_lib = CARD::nil)
elsif (other.priv_lib = CARD::nil) then
return false
end ;
return (priv_lib = other.priv_lib)
end;
is_eq(other : SAME) : BOOL is
--This predicate returns true if and only if self and other are the
-- same, otherwise false.
if (priv_lib = CARD::nil) then
return (other.priv_lib = CARD::nil)
elsif (other.priv_lib = CARD::nil) then
return false
elsif self.asize /= other.asize then
return false
end ;
loop
if ~(aelt! = other.aelt!) then
return false
end
end ;
return REP_LIB_LIST::lib_list[priv_lib].culture.kind=REP_LIB_LIST::lib_list[other.priv_lib].culture.kind;
-- return (priv_lib = other.priv_lib)
end ;
is_lt(other : SAME) : BOOL
pre (priv_lib = other.priv_lib)
post true
is
-- This predicate performs comparison using field semantics (see the class FIELD).
return (self.card.field < other.card.field)
end ;
is_nil : BOOL is
--This routine returns true if and only if the value of self is the
-- nil value, otherwise false.
return is_eq(nil)
end ;
is_combining : BOOL is
--This predicate returns true if and only if self is a combining
-- encoding in the Unicode domain.
loop
loc_rng : RANGE := UNICODE::Combining.elt! ;
if loc_rng.contains(card) then
return true
end
end ;
return false
end ;
lib : LIBCHARS is
--This routine returns the actual repertoire and encoding used by
-- this class object.
return REP_LIB_LIST::lib_list[priv_lib]
end ;
raw_binstr : BINSTR
pre true -- should be ~void(self)
post (result.size > 0)
is
--This routine returns the 'raw' binary string form of self as a code
-- without any code kind informatiion.
res : BINSTR := BINSTR::create ;
loop
res:=res+octet!;
end;
return res
end ;
binstr : BINSTR
pre true -- should be ~void(self)
post (result.size > 0)
is
--This routine returns the binary string form of self - with the kind
-- of code in the first octet.
if lib_check then
-- #OUT+"codes.sa binstr:"; inspect;
end;
-- assert valid_number;
return lib.culture.kind.binstr+raw_binstr;
end ;
card : CARD
pre true -- should be ~void!!
post (priv_create(result,lib) = self)
is
--This routine returns the value of self as a cardinal number.
-- It must be noted here that the aelt! iter yields octets in the
-- order from LSB to MSB - ie the REVERSE of that required!!!!!!
res : CARD := 0 ;
if SYS::is_little_endian then
loop
loc_tmp : QUADBITS := aelt!.quad ;
loc_mult : CARD := 0.upto!(QUADBITS::Octets_per_Quad - 1) ;
res := res + (loc_tmp.left(loc_mult * OCTET::Octet_Bits)).card;
end ;
else
loop
loc_tmp : QUADBITS := aelt!.quad ;
loc_mult : CARD := (QUADBITS::Octets_per_Quad - 1).downto!(0) ;
res := res + (loc_tmp.left(loc_mult * OCTET::Octet_Bits)).card;
end ;
end;
return res;
end ;
char : CHAR
pre true -- ~void(self) but may be 'zero'
post true
is
--This routine returns the value of self as a character. Note that both
-- pre and post condition are vacuous because of use in the culture start-up.
res : CHAR ;
loop
index : CARD := 0.upto!(asize - 1) ;
res.aset(index,aelt!)
end ;
return res
end ;
rune : RUNE
pre ~(self = nil)
post (result.code = self)
is
--This routine returns the value of self as a single code rune.
return RUNE::create(self)
end ;
hash : CARD
pre true
post true
is
--This routine returns the hash value corresponding to this raw code.
return binstr.hash
end ;
next : SAME is
--This successor routine is provided to enable simple sequential code
-- operations to be carried out. Note that the successor of the bit-pattern
-- with all bits set is that with no bits set as the semantics attributed are
-- those of the closed field class FIELD.
return create((card.field + 1.field).binstr.tail(lib.my_size),lib)
end ;
private in_size(offset : CARD) : BOOL is
--This predicate calculates if the result of offsetting code by the
-- given POSITIVE value will still be within the code range - or not!
return is_valid((card + offset),lib)
end ;
offset( cnt : INT) : SAME
pre ((cnt > INT::zero)
and in_size(cnt.card))
or ((cnt < INT::zero)
and (card >= cnt.abs.card))
post ((cnt < INT::zero)
and (result.card = self.card - cnt.abs.card))
or ((cnt > INT::zero)
and (result.card = self.card + cnt.card))
is
--This routine returns the code which is count positions before/after
-- self provided that such a code exists. Note that 'void' is a valid
-- encoding for the default library (which will usually have an index of zero!).
loc_num : CARD ;
if cnt < INT::zero then
loc_num := card - cnt.abs.card
else
loc_num := card + cnt.card
end ;
return create(loc_num,lib)
end ;
octet!(once cnt : CARD) : OCTET pre ~(self = nil) and (cnt <= asize) is
--This iter yields cnt successive octets of self finishing at the least significant octet!
if SYS::is_little_endian then
loop
yield aget((cnt-1).downto!(0)) ;
end;
else -- big_endian
loop
yield aget((asize-cnt).upto!(asize-1)) ;
end;
end;
end ;
octet!: OCTET pre ~(self = nil) is
--This iter yields successive octets of self starting at the most significant octet!
if SYS::is_little_endian then
loop
i::=(lib.my_size - 1).downto!(0);
yield aget(i) ;
end;
else -- big_endian
loop
i::=(asize-lib.my_size).upto!(asize-1);
yield aget(i) ;
end;
end;
end ;
end ; -- CHAR_CODE