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