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 ; 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 ; raw_build( cursor : BIN_CURSOR, lib : LIBCHARS ) : SAME pre ~void(cursor) and ~cursor.is_done post result.asize >= 0 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)) ; loop index : CARD := (lib.my_size - 1).downto!(0) ; me.aset(index,cursor.get_item) end ; return me end ; build( cursor : BIN_CURSOR ) : SAME pre ~void(cursor) and ~cursor.is_done post result.asize >= 0 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. me : SAME ; start_index : CARD := cursor.index ; loc_lib : LIBCHARS := LIBCHARS::default ; loc_kind : CODE_KINDS := CODE_KINDS::build(cursor) ; if loc_lib.culture.kind = loc_kind then me := me.priv_lib(REP_LIB_LIST::index(loc_lib)) ; 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::index(loc_lib)) ; break! end end ; if loc_lib = LIBCHARS::default then cursor.set_index(start_index) ; return nil end end ; loop index : CARD := (loc_kind.size - 1).downto!(0) ; me.aset(index,cursor.get_item) end ; 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)) ; loop index : CARD := (lib.my_size - 1).downto!(0) ; me.aset(index,str.aelt!) 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 ; loop index : CARD := (asize - 1).downto!(0) ; me.aset(index,loc_val.aelt!) 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 ; private valid_ch( val : CHAR, lib : LIBCHARS ) : BOOL is -- This private 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. loop index : CARD := 0.upto!(asize - 1) ; loc_oct : OCTET := val.aelt! ; if index >= lib.my_size then if loc_oct /= OCTET::null then return false end end end ; return true end ; create( ch : CHAR, lib : LIBCHARS ) : SAME pre ~void(lib) and valid_ch(ch,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( 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 (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 index : CARD := (lib.my_size - 1).downto!(0) ; res := res + [index] 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. res : BINSTR := BINSTR::create + lib.culture.kind.binstr ; loop index : CARD := (lib.my_size - 1).downto!(0) ; res := res + [index] end ; return res 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 ; 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 ; 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 (asize > 0) and (cnt <= asize) post true is -- This iter yields cnt successive octets of self finishing at the least -- significant octet! loop index : CARD := (cnt - 1).downto!(0) ; yield aget(index) end end ; octet! : OCTET pre ~(self = nil) post true is -- This iter yields successive octets of self starting at the most -- significant octet! loop index : CARD := (lib.my_size - 1).downto!(0) ; yield aget(index) end end ; end ; -- CHAR_CODE