ordering.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 ORDER_WEIGHT < $ORDERED{ORDER_WEIGHT}, $BINARY, $STR

class ORDER_WEIGHT < $ORDERED{ORDER_WEIGHT}, $BINARY, $STR is -- This immutable class is provided to implement the weight ordering -- for string sorting purposes according to the standards ISO/IEC 14651/2. -- Version 1.1 Jul 98. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 11 Jul 97 kh Original -- 11 Jul 98 kh Added multiple weights, pre/post conds. private include AREF{CARD} aget -> aget ; -- Make modification routines private. include COMPARABLE ; include BINARY ; create(num : CARD) : SAME is --This creation routine is only used in the iters in this class and in -- the WEIGHT_RANGE class to create a single element weight. me : SAME := new(1) ; me[0] := num ; return me end ; nil : SAME is --This creation routine is only used in the iters in this class and in -- the WEIGHT_RANGE class to create a single element weight. me : SAME := new(1) ; me[0] := CARD::nil ; return me end ; build(cursor : BIN_CURSOR) : SAME pre ~void(cursor) and (cursor.remaining >= ((cursor.item.card * 2) + 1)) post result.asize = initial(cursor.item.card) is --This routine creates an order weight from the binary string which -- is attached to the cursor! loc_size : CARD := cursor.get_item.card ; -- No of individual weights me : SAME := new(loc_size) ; loop loc_size.times! ; loc_val : BINSTR := cursor.get_sized ; loc_wt : CARD := loc_val.cursor.card ; me.aset!(loc_wt) end ; return me end ; IGNORE : SAME is --Just a null object. return void end ; lowest : SAME is --This routine initialises a weight as the lowest possible value in the ordering sequence. return create(1) end ; highest : SAME is --This routine initialises a weight as the highest possible value in -- the ordering sequence for the given encoding. This value will be greater -- than the highest code value due to the definition of collating elements -- in ISO/IEC 14652. return create(CARD::maxval) end ; offset(by : CARD) : SAME pre ~void(self) and (asize > 0) post (result.size = self.size) is --This 'addition' routine is needed when establishing various groups of -- weights relative to an offset for each group. if void(self) then return void end ; res : SAME := new(asize) ; loop res.aset!(aelt! + by) end ; return res end ; next_one : SAME pre ~void(self) post result.size = self.size is --This returns the weight next in sequence of ordered weights . return offset(1) end ; binstr : BINSTR pre ~void(self) post (result.size = (size * NUM_BITS::Octets_per_Card)) is --This routine returns self as its binary string representation which -- includes size and element size octets. if void(self) then return void end ; res : FBINSTR := FBINSTR::create + OCTET::create(size) ; loop loc_str : BINSTR := aelt!.binstr ; -- MS octet first loc_size : CARD := 0 ; loop -- find first non-zero if loc_str.elt! /= OCTET::null then break! else loc_size := loc_size + 1 end end ; if loc_size = loc_str.size then -- All nulls! loc_size := 1 else loc_size := loc_str.size - loc_size end ; res := res + OCTET::create(loc_size) + loc_str.tail(loc_size) end ; return res.binstr end ; is_eq(other : SAME) : BOOL is --This predicate returns true if and only if self and other are the same, otherwise false. if other.size = size then loop if other.aelt! /= aelt! then return false end end ; return true else return false end end ; is_lt(other : SAME) : BOOL is --This predicate returns true if and only if self is less than other, otherwise false. if other.size = size then loop if ~(aelt! < other.aelt!) then return false end end ; return true else return other.size < size end end ; is_nil : BOOL is --This predicate returns true if and only if self is the nil weight. return [0] = CARD::nil end ; plus(other : SAME) : SAME pre true post (result.size = (size + other.size)) is --This routine may be used to add further elements to the weight -- as may be needed during weight manipulation. This has immutable semantics. res : SAME ; if void(self) then if void(other) then return void end ; res := new(other.asize) ; loop res.aset!(other.aelt!) end ; return res elsif void(other) then res := new(size) ; loop res.aset!(aelt!) end ; return res end ; res := new(other.size + size) ; loop res.aset!(aelt!) end ; loop outdex : CARD := asize.upto!(res.asize - 1) ; res[outdex] := other.aelt! end ; return res end ; minus(other : SAME) : SAME pre ~void(self) post (void(other) and (result = self)) or (~void(other) and (result.size = size)) or void(result) is --This routine may be used to reduce the value of elements by the -- weight offset indicated by the weight values of other, provided that both -- are the same size (or other is void) and no reduction would produce -- a weight less than lowest. This has immutable semantics. res : SAME ; if void(other) then res := new(size) ; loop res.aset!(aelt!) end ; return res end ; if asize = other.asize then res := new(size) ; loop diff : INT := aelt!.int - other.aelt!.int ; if diff < 0.int then return void end ; res.aset!(diff.card) end ; return res else return void end end ; card : CARD pre ~void(self) post ((asize = 1) and (result = [0])) or (result = 0) is --This routine returns the cardinality of weights represented by self -- provided that asize is one, otherwise zero. if asize = 1 then return [0] else return 0 end end ; size : CARD post result = asize is -- This routine returns the number of elements in the order weight. return asize end; elt! : SAME pre ~void(self) post true -- should be result = aelt! is --This iter yields successive individual weights of self -- -- which may, of course, only be 1! loop yield create(aelt!) end end ; next! : SAME pre ~void(self) post true -- should be result = create(aelt! + 1) is --This routine returns the value of the weight next greater than -- successive elements of self. This is required when establishing weights. loop yield create(aelt! + 1) end end ; str(lib : LIBCHARS) : STR pre ~void(self) and ~void(lib) post (result.size >= 2) is --This routine returns the string form of self using the given encoding -- and repertoire. res : STR := STR::create(lib) + lib.Left_Bracket.char.str ; loc_sep : STR := STR::create(lib) + lib.Comma.char + lib.Space.char ; loop loc_elem : CARD := aelt! ; res := res + loc_sep.separate!(loc_elem.hex_str(lib)) end ; return res + lib.Right_Bracket.char end ; str : STR pre ~void(self) post (result.size >= 2) is --This routine returns the string form of self using the default -- encoding and repertoire. return str(LIBCHARS::default) end ; end ; -- ORDER_WEIGHT

immutable class WEIGHT_RANGE < $RANGE{ORDER_WEIGHT}

immutable class WEIGHT_RANGE < $RANGE{ORDER_WEIGHT} is -- This immutable class is provided to implement the ranges of single -- weights which are specified in this implementation of ISO/IEC 14651/2. -- Note that this is an immutable class with 'weight' values of single length -- weights! -- Version 1.0 Apr 98. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 21 Apr 98 kh Original include RANGE{ORDER_WEIGHT} ; is_lt(other : SAME) : BOOL is -- This predicate returns true if and only if the high value of self is -- strictly less than the low value of other -- taking into account the fact -- that the stored 'high' is one greater than the actual end of the range. return (self.high <= other.low) end ; in_range(val : ORDER_WEIGHT) : BOOL pre val.size = 1 post (val.card >= low)and (val.card < high) is --This predicate returns true iff val lies in the range. Note the -- assymetric test since high is always one greater than the high defined -- when created, etc. if val.size = 1 then return (val.card >= low) and (val.card < high) else return false end end ; offset(range_val : ORDER_WEIGHT) : ORDER_WEIGHT pre (size = 1) and in_range(range_val) and (range_val[0] > low) post (result[0] = range_val[0] - low) and (result.size = 1) is --This routine returns the value of range_val as an offset from zero, -- taking into account the range low limit. return ORDER_WEIGHT::create(range_val[0] - low) end ; first : ORDER_WEIGHT pre ~is_empty post (result[0] = low)and (result.size = 1) is --This routine returns the lowest value in the range provided that -- the range is not empty. return ORDER_WEIGHT::create(low) end ; last : ORDER_WEIGHT pre ~is_empty post (result[0] = (high - 1))and (result.size = 1) is --This routine returns the highest value in the range provided that -- the range is not empty. return ORDER_WEIGHT::create(high - 1) end ; reverse_elt! : ORDER_WEIGHT pre ~is_empty post (result.size = 1)and ((result[0] + elt![0]) = (high - 1 + low)) is --This iter yields all of the values of self from high - 1 down to and -- including low in turn. val : CARD := high ; loop until!(val = low) ; val := val - 1 ; yield ORDER_WEIGHT::create(val) end end ; end ; -- WEIGHT_RANGE

immutable class ORDER_RULE < $IS_EQ, $IS_LT{ORDER_RULE}, $BINARY, $STR

immutable class ORDER_RULE < $IS_EQ, $IS_LT{ORDER_RULE}, $BINARY, $STR is -- This immutable class is provided to implement an individual rule -- as used in text string sorting purposes according to the standards -- ISO/IEC 14651/2. -- Version 1.0 Jul 97. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 11 Jul 97 kh Original include BINARY ; include COMPARABLE ; readonly attr left_to_right : BOOL ; readonly attr positional : BOOL ; create(fwd : BOOL,posn : BOOL) : SAME is --This is the only special creation routine for an ordering rule. return left_to_right(fwd).positional(posn) end ; build(index : BIN_CURSOR) : SAME pre ~void(index) and (index.remaining >= 2) is -- This routine builds an order rule from the next two elements in the -- given binary representation. return left_to_right(BOOL::build(index)).positional(BOOL::build(index)) end ; is_eq(other : SAME) : BOOL is --This predicate returns true iof and only if self and other are the -- same rule. return (left_to_right = other.left_to_right) and (positional = other.positional) end ; is_lt(other : SAME) : BOOL is --This predicate is provided solely for array manipulation purposes. -- It is identically false. return false end ; binstr : BINSTR pre true post create(result) = self is --This routine returns a binary string representation of self. return left_to_right.binstr + positional.binstr end ; forward : BOOL is --This routine returns true if and only if left_to_right is true, -- otherwise false. return left_to_right end ; backward : BOOL is --This routine returns true if and only if left_to_right is false, -- otherwise false. return ~left_to_right end ; private do_str(lib : LIBCHARS) : CODE_STR pre ~void(lib) post (result.size >= 5) is --This routine returns a text string representation of self. return CODE_STR::create(lib) + lib.Left_Angle + CODE_STR::create(left_to_right.str(lib)) + lib.Comma + CODE_STR::create(positional.str(lib)) + lib.Right_Angle end ; str(lib : LIBCHARS) : STR pre true post (result.size >= 5) is --This routine returns a text string representation of self. return do_str(LIBCHARS::default).tgt_str end ; str : STR pre true post (result.size >= 5) is --This routine returns a text string representation of self. return do_str(LIBCHARS::default).tgt_str end ; end ; -- ORDER_RULE

class RANGE_ORDERING

class RANGE_ORDERING is -- This class models an ordering rule which applies to all of -- the members of a range of tokens. -- Version 1.2 Apr 98. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 12 Mar 97 kh Original -- 11 Jul 97 kh Modified to rectify misunderstanding -- 21 Apr 98 kh Converted to use ORDER_WEIGHT readonly attr domain : RANGE ; readonly attr base_weight : ORDER_WEIGHT ; readonly attr rules : ARRAY{ORDER_RULE} ; private attr weights : ARRAY{ORDER_WEIGHT} ; -- This array is 'parameterised' in that any weight which is of the -- value ORDER_WEIGHT::maxval is deemed to be of the weight of the token -- in the range. create(dom : RANGE,base : ORDER_WEIGHT,dirns : ARRAY{ORDER_RULE},wts : ARRAY{ORDER_WEIGHT}) : SAME pre ~dom.is_empty and ~void(base) and (dirns.size = wts.size) and (dirns.size > 0) post (result.domain = dom) and (result.base_weight = base) and (result.rules.size = dirns.size) and (result.weights.size = wts.size) is --This is just a simple creation routine from the components read from -- the repertoire map file. me : SAME := new ; me.domain := dom ; me.base_weight := base ; me.rules := dirns ; me.weights := wts ; return me end ; contains(code : TOKEN) : BOOL pre ~void(self)and ~(code.card = 0) post result = domain.contains(code.card) is --This routine returns true if and only if the given token is in -- the domain of this ordering, otherwise false. return domain.contains(code.card) end ; weights(code : TOKEN) : ARRAY{ORDER_WEIGHT} pre ~void(self) post (result.size = self.weights.size) is --This routine returns a new array of weights corresponding to the -- given token tok. res : ARRAY{ORDER_WEIGHT} := weights.copy ; loop index : CARD := 0.upto!(weights.asize - 1) ; if res[index] = ORDER_WEIGHT::highest then res[index] := ORDER_WEIGHT::create(base_weight.card + (code.card - domain.low)) end end ; return res end ; end ; -- RANGE_ORDERING

class ORDERING

class ORDERING is -- This class implements an order weighting look-up 'table' for a single -- script (as specified in ISO/IEC 14652) needed when attempting to order -- a text string according to the rules given in ISO/IEC 14651. -- Version 1.1 Jul 97. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 11 Jul 97 kh Original -- 15 Jul 97 kh Incorporated range orders in the script. readonly attr rule : ARRAY{ORDER_RULE} ; private attr table : FMAP{TOKEN,ARRAY{ORDER_WEIGHT}} ; private attr range_list : FLIST{RANGE_ORDERING} ; create : SAME pre true post (result.rule[0] = ORDER_RULE::create(true,false)) is --This routine creates an empty ordering object with a default single -- rule of forward into which entries may be inserted. me : SAME := new ; me.rule := ARRAY{ORDER_RULE}::create(1) ; me.rule[0] := ORDER_RULE::create(true,false) ; me.table := FMAP{TOKEN,ARRAY{ORDER_WEIGHT}}::create ; me.range_list := FLIST{RANGE_ORDERING}::create ; return me end ; create(rules : ARRAY{ORDER_RULE}) : SAME pre ~void(rules) post ~void(result) is --This routine creates an empty ordering object with the given ordering -- rule into which entries may later be inserted. me : SAME := new ; me.rule := ARRAY{ORDER_RULE}::create(rules.asize) ; loop index : CARD := 0.upto!(rules.asize - 1) ; me.rule[index] := rules.elt! end ; me.table := FMAP{TOKEN,ARRAY{ORDER_WEIGHT}}::create ; me.range_list := FLIST{RANGE_ORDERING}::create ; return me end ; size : CARD pre true post result = table.size is --This routine returns the number of entries in the map. return table.size end ; insert(tok : TOKEN,wts : ARRAY{ORDER_WEIGHT}) : BOOL pre ~(tok.card = 0)and ~void(wts) post (result = table.test(tok)) or ~result is --This routine returns true only if it has been determined that tok -- is not already in the table and that (except for the first entry) all -- weight arrays are of the same length. if table.size = 0 then table := table.insert(tok,wts) ; return true elsif table.test(tok) then return false else loc_wts : ARRAY{ORDER_WEIGHT} ; loop -- just need one array for testing loc_wts := table.elt! ; break! end ; if loc_wts.asize /= wts.asize then -- must be same number! return false end ; table := table.insert(tok,wts) ; return true end end ; insert(order : RANGE_ORDERING) : BOOL pre ~void(order) post (initial(void(range_list)) and (result = (range_list.size = 1))) or (initial(range_list.size) + 1 = range_list.size) is --This routine permits the insertion of a range order specified as -- part of the script ordering specification. True is always returned -- for consistency with the insertion routine above. if void(range_list) then range_list := FLIST{RANGE_ORDERING}::create end ; range_list := range_list.push(order) ; return true end ; private from_range(tok : TOKEN) : ARRAY{ORDER_WEIGHT} pre ~void(self)and ~(tok.card = 0) post true is --This routine checks the ranges associated with this script. If the -- token is in one of them then the corresponding weights are returned, -- otherwise void! loop order : RANGE_ORDERING := range_list.elt! ; if order.contains(tok) then return order.weights(tok) end end ; return void end ; contains(tok_list : FLIST{TOKEN}) : BOOL pre ~void(self)and ~void(tok_list) post true is --This routine returns true if and only if any ONE token in the list is -- in the map of this group, otherwise false. tok : TOKEN ; loop tok := tok_list.elt! ; if (table.test(tok) or ~void(from_range(tok))) then return true end end ; return false end ; weights(tok_list : FLIST{TOKEN}) : ARRAY{ORDER_WEIGHT} pre contains(tok_list) post ~void(result) is --This is the routine which returns a new copy of the list of weights -- for the most recently pushed token in the list (which is really a set of -- homonymous tokens) which has a set of weights. loc_list : FLIST{TOKEN} := tok_list.copy ; loop loc_list.size.times! ; tok : TOKEN := loc_list.pop ; if table.test(tok) then return table.get(tok).copy end end ; loc_list := tok_list.copy ; loop -- check for range orders loc_list.size.times! ; tok : TOKEN := loc_list.pop ; loc_res : ARRAY{ORDER_WEIGHT} := from_range(tok) ; if ~void(loc_res) then return loc_res.copy end end ; return void end ; end ; -- ORDERING