chars_culture.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>  <--------------


class CHAR_GROUP < $BINARY

class CHAR_GROUP < $BINARY is -- This class embodies the notion of a character group and contains -- the members as a list of ranges of their code-points. -- Version 1.1 Mar 98. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 22 May 97 kh Original design using ISO/IEC 14652 spec. -- 30 Mar 98 kh Amended to include 'addition' include BINARY ; readonly attr ranges : FLIST{RANGE} ; create : SAME is -- This creation routine merely initialises the range list me : SAME := new ; me.ranges := FLIST{RANGE}::create ; return me end ; build(index : BIN_CURSOR) : SAME pre ~void(index) and ~index.is_done post ~void(result) is -- This routine reads its component values from the binary string -- indicated and then returns the new object. me : SAME := new ; loc_cnt : CARD := index.card ; -- loop count! me.ranges := FLIST{RANGE}::create(loc_cnt) ; loop loc_cnt.times! ; loc_range : RANGE := RANGE::build(index) ; if loc_range.is_empty then return void else me.ranges := me.ranges.push(loc_range) end end ; return me end ; binstr : BINSTR pre ~void(self) post true -- create(result) = self is -- This routine creates a binary string representation of self. loc_str : BINSTR := BINSTR::create + ranges.size.binstr ; -- the loop counter! loop rng : RANGE := ranges.elt! ; loc_str := loc_str + rng.low.binstr + rng.high.binstr end ; return loc_str end ; private get_range!(once rngs : SAME,val : RANGE) : RANGE pre ~void(rngs) post (result = val) or ~val.is_empty is -- This private iter is used to take the next value from the given list -- of ranges if val is empty on entry and the list is not exhausted, -- otherwise yields val. cnt : CARD := rngs.ranges.size ; loop if val.is_empty then if cnt = 0 then yield val else res : RANGE := rngs.ranges.elt! ; cnt := cnt - 1 ; yield res end else yield val end end end ; private do_tail(group : SAME, inout val : RANGE,tail : RANGE) : RANGE pre ~void(group) and ~val.is_empty and ~void(tail) post val.is_empty and ((result = initial(val)) or ((result.low <= initial(val.low)) and (result.low <= tail.low) and (result.high >= initial(val.high)) and (result.high >= tail.high))) is --This private routine is used to compare the current range at the tail -- of the result and one of the two source lists. Note that the case where -- val might be greater than tail is excluded by the calling code in the -- following public routine! res : RANGE ; if val.is_adjacent(tail) then res := val.merge(tail) else -- tail < val!! if ~tail.is_empty then group.ranges := group.ranges.push(tail) ; end ; res := val -- the new value of tail! end ; val := val.empty ; return res end ; private is_disjoint(ans : SAME) : BOOL is -- This private predicate returns true if and only if all of the -- elements of ans are disjoint from each other. loop loc_range : RANGE := ans.ranges.elt! ; loop val : RANGE := ans.ranges.elt! ; if (val /= loc_range) and ~loc_range.is_disjoint(val) then return false end end end ; return true end ; plus(other : SAME) : SAME pre ~void(self) and ~void(other) post is_disjoint(result) is -- This routine adds together the two lists of ranges in such a way that -- every element of the new list is disjoint and, therefore, that there are -- no duplications. res : SAME := new ; res.ranges := FLIST{RANGE}::create ; my_range : RANGE := my_range.empty ; other_range : RANGE := my_range.empty ; tail : RANGE := my_range.empty ; loop my_range := get_range!(self,my_range) ; other_range := get_range!(other,other_range) ; if my_range.is_empty or other_range.is_empty then if my_range.is_empty and other_range.is_empty then -- finished if ~tail.is_empty then res.ranges := res.ranges.push(tail) end ; break! else if my_range.is_empty then tail := do_tail(res,inout other_range,tail) else -- other range is empty! tail := do_tail(res,inout my_range,tail) end end else -- neither list exhausted if tail.is_empty then -- only the first pass if my_range < other_range then tail := my_range ; my_range := my_range.empty else tail := other_range ; other_range := other_range.empty end else -- all three are present if tail.is_adjacent(my_range) then tail := tail.merge(my_range) ; my_range := my_range.empty elsif tail.is_adjacent(other_range) then tail := tail.merge(other_range) ; other_range := my_range.empty elsif my_range < other_range then tail := do_tail(res,inout my_range, tail) else tail := do_tail(res,inout other_range, tail) end end end end ; return res end ; insert(rng : RANGE) : SAME pre ~rng.is_empty post (void(self) and (result.ranges.size = 1)) or(result.ranges.size >= self.ranges.size) is -- This routine inserts the given range in the appropriate ordered -- place in the list. res : SAME := create ; res.ranges := res.ranges.push(rng) ; if void(self) then return res else return self + res end end ; contains(code : CHAR_CODE) : BOOL pre ~void(self) post true is -- This routine returns true if and only if the character identified by -- the given code point is a member of this group. loop rng : RANGE := ranges.elt! ; if rng.contains(code.card) then return true end end ; return false end ; end ; -- CHAR_GROUP

class CHAR_MAP < $BINARY

class CHAR_MAP < $BINARY is -- This class embodies the notion of a character mapping function. It -- contains two lists of one-to-one mappings, providing for mapping in either -- direction. It is always defined that the mapping 'to' is valid. The -- mapping 'from' validity (or not) depends on the semantics of the -- particular object environment. -- Version 1.0 May 97. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 22 May 97 kh Original design using ISO/IEC 14652 spec. include BINARY ; private attr map : FLIST{CASE_MAPLET} ; create : SAME is -- This routine creates an empty map, initialising the map before -- returning. me : SAME := new ; me.map := FLIST{CASE_MAPLET}::create ; return me end ; build(index : BIN_CURSOR) : SAME pre ~void(index) and ~index.is_done post true -- result = create(result.binstr) is -- This routine reads its component values from the binary string -- indicated and then returns the new object. me : SAME := new ; loc_cnt : CARD := index.card ; -- the loop count! me.map := FLIST{CASE_MAPLET}::create(loc_cnt) ; loop loc_num : CARD := loc_cnt.times! ; loc_maplet : CASE_MAPLET := CASE_MAPLET::build(index) ; if loc_maplet.count = 0 then return void else me.map := me.map.push(loc_maplet) end end ; return me end ; binstr : BINSTR pre ~void(self) and (map.size > 0) post true -- self = create(result) is --This routine creates a storage string from the value of self. res : BINSTR := BINSTR::create + map.size.binstr ; if map.size > 0 then loop maplet : CASE_MAPLET := map.elt! ; res := res + maplet.binstr end end ; return res end ; private can_insert(elem : CASE_MAPLET) : BOOL is --This private predicate returns true if and only if it is permissible -- to insert the given entry in the map, otherwise false. If the map size is -- non-zero then a preliminary test for the same code library is made -- before testing for disjuncture with existing map contents. if map.size > 0 then loc_elem : CASE_MAPLET := map[0] ; if loc_elem.base.lib /= elem.base.lib then return false end ; loop loc_elem := map.elt! ; if ~elem.is_disjoint(loc_elem) then return false end end ; return true else return true end end ; insert(entry : CASE_MAPLET) : BOOL pre true -- should be can_insert(entry) post (map.size >= initial(map.size)) is --This routine tests if the given maplet may be inserted into this map, -- doing so if possible and returning true if this has been successful, -- otherwise false! if can_insert(entry) then map := map.push(entry) ; return true else return false end end ; private mapping(ch_code : CHAR_CODE,forward : BOOL) : CASE_MAPLET is --This routine returns true if and only if ch_code is in the range or -- domain of this map depending whether forward or reverse mapping is required. maplet : CASE_MAPLET ; if forward then loop maplet := map.elt! ; if maplet.in_domain(ch_code) then return maplet end end else loop maplet := map.elt! ; if maplet.in_range(ch_code) then return maplet end end end ; return void end ; is_mapped(ch_code : CHAR_CODE) : BOOL is --This predicate returns true if and only if the character code is -- mappable using this character map. return ~void(mapping(ch_code,true)) or ~void(mapping(ch_code,false)) end ; to_domain(ch_code : CHAR_CODE) : CHAR_CODE pre ~void(self) and (ch_code /= CHAR_CODE::nil) post (result /= CHAR_CODE::nil) is --This routine converts a character found in its range to the -- corresponding character in the domain. If ch is not in the range then -- ch_code is returned without change. loc_maplet : CASE_MAPLET := mapping(ch_code,false) ; if void(loc_maplet) then return ch_code else return loc_maplet.reverse_map(ch_code) end end ; to_range(ch_code : CHAR_CODE) : CHAR_CODE pre ~void(self) and (ch_code /= CHAR_CODE::nil) post (result = ch_code) or (to_domain(result) = ch_code) is -- This routine converts a character code found in its domain to the -- corresponding character in the range. If ch is not in the domain then -- ch_code is returned without change loc_maplet : CASE_MAPLET := mapping(ch_code,true) ; if void(loc_maplet) then return ch_code else return loc_maplet.map(ch_code) end end ; end ; -- CHAR_MAP