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