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