compare.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 ELT_EQ{ETP}

class ELT_EQ{ETP} is -- This class provides the equality comparison function for elements -- of type ETP. If no user methos has been provided then a default system- -- defined equality is used. -- Version 1.1 Mar 00. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 21 Nov 98 kh Original from Sather 1.2 dist -- 23 Mar 00 kh No longer a partial class elt_eq(first, second : ETP) : BOOL is -- This predicate returns true if and only if the two arguments are equal. -- The equality relation uses the user defined is_eq routine, -- if the argument type is a subtype of $IS_EQ. Otherwise it uses the system -- defined equality routine is used. typecase first --when $FMT then return SYS::ob_eq(first,second) -- test when $IS_EQ then return first.is_eq(second); else return SYS::ob_eq(first,second) end end ; end ; -- ELT_EQ

class ELT_LT{ETP}

class ELT_LT{ETP} is -- This class provides the less than comparison facility for the given -- element type. -- Version 1.1 Mar 00. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 21 Nov 98 kh Original from Sather 1.2 -- 23 Mar 90 kh No longer a partial class private verify_can_call_lt( first, second : $OB ) : BOOL is -- This private predicate is used in the assertion in the following -- routine to establish whether or not a less than comparison on first and -- second can be done, when true is returned! Neither of the two operands -- may be void nor may they be immutable! if void(first) or void(second) then return false elsif REFERENCE::is_immutable(first) or REFERENCE::is_immutable(second) then return false else return true end end ; elt_lt( first, second : ETP ) : BOOL is -- This predicate returns true if and only if the first argument is less -- than second. Should there be no user-defined operation then an assertion -- is used to ensure that the system relation predicate is valid - if not -- then the assertion fails. typecase first when $IS_LT{ETP} then return first.is_lt(second) else assert verify_can_call_lt(first,second) ; return SYS::id(first) < SYS::id(second) end end ; end ; -- ELT_LT

class ELT_HASH

class ELT_HASH is -- This class provides the hash value of an object. This is guaranteed -- to be the same on repeated calls on the same object. -- Version 1.1 Mar 00. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 21 Nov 98 kh Original from Sather 1.2 -- 23 Mar 00 kh No longer a partial class private verify_can_call_hash(item : $OB) : BOOL is -- This private predicate returns true if and only if item is of -- a reference type. return ~REFERENCE::is_immutable(item) end ; elt_hash(item : $OB) : CARD is -- This routine returns a hash value for the given item, using the -- user-defined hash routine if one is defined. Otherwise, uses the system -- defined hash function. typecase item when $HASH then return item.hash when $IS_EQ then -- therefore cannot use SYS routine SYS_ERROR::create.error(self,SYS_EXCEPT::Bad_Type, SYS::str_for_tp(SYS::tp(item))) ; return void -- to keep compiler happy! else if void(item) then -- special case for valid voids! return 0 else assert verify_can_call_hash(item) ; return SYS::id(item).hash end end end ; end ; -- ELT_HASH

class ELT_NIL{ETP}

class ELT_NIL{ETP} is -- This class provides a nil value for an object of type ETP. -- This operation does not work for abstract types! -- Version 1.1 Mar 00. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 21 Nov 98 kh Original from Sather 1.2 -- 23 Mar 00 kh No longer a partial class elt_nil : ETP is -- This routine returns a 'nil' value for the given class if one -- exists, otherwise void. loc_val : ETP ; typecase loc_val when $NIL then res : $NIL := loc_val.nil ; -- This is of abstract type $NIL typecase res -- needed to return value of ETP when ETP then return res end else return void end end ; is_elt_nil( item : ETP ) : BOOL is -- This predicate returns true if and only if ETP defines a nil value -- and item has that value. typecase item when $IS_NIL then return item.is_nil else return void(item) end end ; end ; -- ELT_NIL

partial class COMPARE{ETP}

partial class COMPARE{ETP} is -- This partial class should be included by containers of elements of -- class ETP which must provide an elt_eq, an elt_lt, elt_hash, elt_nil or -- is_elt_nil routines. The user defined functions are used by default, -- otherwise the implementation defined equality, hash and nil if it is -- possible and correct to do so. -- Version 1.1 Nov 98. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 16 Dec 96 kh Original from Sather dist abstract.sa -- 21 Nov 98 kh Rewrite for Sather 1.2 distrib. elt_eq(first,second : ETP) : BOOL is -- This is the standard 'less than' predicate used in sorting routines. -- The using class must specify an equality predicate routine. return ELT_EQ{ETP}::elt_eq(first,second) end ; elt_lt(first,second : ETP) : BOOL is -- This routine is the standard predicate 'less than' for use in -- sorting. By default the object identity components are compared. -- It may be redefined in descendants. return ELT_LT{ETP}::elt_lt(first,second) end ; elt_hash(elem : $OB) : CARD is -- This routine returns a hash value associated with an element. This -- must have the property that if "elt_eq(first,second)" then -- "elt_hash(first)=elt_hash(second)". It could be defined always to return 0, -- but many routines will then become quadratic. This uses the object "id" by -- default. It may be redefined in descendants. return ELT_HASH::elt_hash(elem) end ; elt_nil : ETP is -- This routine returns the NIL value. If the element class is a -- subclass of $NIL then it returns nil, otherwise void. return ELT_NIL{ETP}::elt_nil end ; is_elt_nil( elem : ETP) : BOOL is -- This predicate returns true if and only if elem is NIL. return ELT_NIL{ETP}::is_elt_nil(elem) end ; end ; -- COMPARE

partial class COMPARABLE

partial class COMPARABLE is -- This partial class implements the generalized equality routine. Where -- classes require comparison routines they should provide an is_eq(SAME) -- and include this class to provide the more general versions -- Version 1.0 Dec 96. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 11 Dec 96 kh Original from standard Sather dist. stub is_eq(other : SAME) : BOOL ; -- This stub is a 'forward' definition notifier for the is_eq routine -- which an importing class must provide. is_eq(other : $OB) : BOOL is -- This is the generic equality predicate. c.f. the class $IS_EQ typecase other when SAME then return is_eq(other) else #OUT+"class mismatch:"+SYS::str_for_tp(SYS::tp(self)) +"::is_eq("+SYS::str_for_tp(SYS::tp(other))+")\n"; raise 2; --return false; end end ; end ; -- COMPARABLE