compare.sa


Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
 
------------------------->  GNU Sather - sourcefile  <-------------------------
-- Copyright (C) 1995 by International Computer Science Institute            --
-- 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>  <--------------

-- Comparison include classes
-- Author: Benedict A. Gomes <gomes@samosa.ICSI.Berkeley.EDU>


class COMPARE{ETP}

class COMPARE{ETP} is -- Partial class that should be included by containers of elements -- of type ETP that need to provide an elt_eq, elt_lt, hash, -- elt_nil or is_elt_nil routines. These routines use the user -- defined functionality by default, falling back to the system -- versions of equality, hash and comparison if it is possible and -- correct to do so. elt_eq(e1,e2:ETP):BOOL is return ELT_EQ{ETP}::elt_eq(e1,e2); end; elt_lt(e1,e2:ETP):BOOL is return ELT_LT{ETP}::elt_lt(e1,e2); end; elt_hash(e:$OB):INT is return ELT_HASH::elt_hash(e) end; elt_nil:ETP is return ELT_NIL{ETP}::elt_nil end; is_elt_nil(e:ETP):BOOL is return ELT_NIL{ETP}::is_elt_nil(e); end; end;

class ELT_EQ{ETP}

class ELT_EQ{ETP} is -- Provides the equality comparison function for elements of type -- ETP. Tries to use the user provided equality and falls back -- on the system default equality if the user has not provided an -- appropriate method elt_eq(e1,e2:ETP):BOOL is -- The equality relation uses the user defined is_eq routine, if -- ETP < $IS_EQ. Otherwise it uses the system defined equality typecase e1 when $IS_EQ then return e1.is_eq(e2) else return SYS::ob_eq(e1,e2); end; end; end;

class ELT_LT{ETP}

class ELT_LT{ETP} is -- Provides the less than comparison function for elements of type -- ETP. Tries to use the user defined comparison and falls back -- on the system default comparison, if possible elt_lt(e1,e2:ETP):BOOL is -- The default "less than" relation e1 < e2. Uses the user -- defined is_lt if ETP < $IS_LT{ETP}. Otherwise it uses a -- default system implementation of is_lt. -- -- Due to a current limitation, the default implemetnation of -- is_lt does not work for immutable classes. Hence, they must -- be placed under $IS_LT typecase e1 when $IS_LT{ETP} then return e1.is_lt(e2) else -- The less than operation for two objects that are not under -- $IS_LT{T}. Value objects must be placed under $IS_LT{ETP} assert verify_can_call_lt(e1,e2); return SYS::id(e1) < SYS::id(e2); end; end; private verify_can_call_lt(e1,e2:$OB): BOOL is -- Return true if it the system call SYS::id(e1) < SYS::id(e2) would -- run without problems if void(e1) or void(e2) then raise "Error: No default less than operator for void objects"; elsif SYS::tp(e1) < 0 or SYS::tp(e2) < 0 then t1:STR := SYS::str_for_tp(SYS::tp(e1)); t2:STR := SYS::str_for_tp(SYS::tp(e2)); raise "Error:" +" No default system lt for immutable classes.\n" +"Please redefine is_lt and place "+t1+ " and "+ t2 +" under $IS_LT"; else return true; end; end; end;

class ELT_HASH

class ELT_HASH is -- Provides the hash value of an object. Returns the user defined -- hash value, if there is one (i.e. the object subtypes from $HASH) -- Otherwise provides a system defined hash value. elt_hash(e:$OB):INT is -- The default hash value of an object "e". Uses the user defined -- hash function if e < $HASH. Otherwise, uses the system defined hash -- function. -- -- If e < $IS_EQ, then the system defined hash function will not -- be used, since it may not be valid. An exception will be raised. -- The hash function must maintain the property that -- a=b => a.hash=b.hash -- However, if the user has redefined equality, there is no way -- for the system to guarantee that any hash values it provides -- preserve the above property, except by returning the same -- value every time (which is correct, but useless for hashing). -- -- Due to a current limitation of the compiler, the system defined -- hash function will not work on immutable classes. Hence, immutable -- classes must define their own hash function and be under $HASH -- typecase e when $HASH then return e.hash when $IS_EQ then -- ETP redefines equality but not hash. The standard system -- hash value cannot be used. raise "Cannot provide a default hash for:"+SYS::str_for_tp(SYS::tp(e)) +" since is_eq is defined.Redefine hash and subtype from $HASH." else if void(e) then -- Handle the void case specially. Some reference -- types such as the F classes are valid when void -- and therefore require a valid hash function.. return 0 else assert verify_can_call_hash(e); return SYS::id(e).hash; end; end; end; private verify_can_call_hash(e:$OB):BOOL is -- Check that "e" is of a reference type. If not, raise an error if SYS::tp(e) < 0 then t:STR := SYS::str_for_tp(SYS::tp(e)); raise "Error " +" No default system definition of hash for immutable classes\n" +" Please define a hash for "+t+" and subtype from $HASH"; else return true end; end; end;

class ELT_NIL{ETP}

class ELT_NIL{ETP} is -- Provides the nil value for an object of type ETP. -- If ETP < $NIL then return ETP::nil otherwise return void -- This does not work for abstract types - hence, abstract -- classes should not be placed under $NIL elt_nil: ETP is -- Return the nil value. If the element is under $NIL then -- return e.nil. Otherwise, return "void" e: ETP; typecase e when $NIL then -- Note: The double typecase is necessary since -- at this point we know that "e" is of type $NIL and -- $NIL::nil returns SAME, which is $NIL. -- We need the extra typecase to return an ETP. -- If ETP < $NIL, then the second typecase is not needed. -- Won't work for void reference classes. res ::= e.nil; typecase res when ETP then return res end; else return void end end; is_elt_nil(e:ETP):BOOL is -- Return true if ETP is defines a nil value and "e" has that value -- or if ETP does not define a nil value, but "e" is void typecase e when $IS_NIL then return e.is_nil; else return void(e); end; end; end;

partial class COMPARABLE

partial class COMPARABLE is -- Partial class that implements the generalized equality routine. -- Classes should provide an is_eq(SAME) and include this class to -- provide the more general versions stub is_eq(arg: SAME): BOOL; is_eq(arg: $OB): BOOL is -- Overloaded version of the is_eq routine that works with an argument -- of any type. If the type of the 'arg' is not the same as they -- type of 'self' then return false. Otherwise, deletegate to -- the 'real' is_eq(SAME):BOOL routine typecase arg when SAME then return is_eq(arg) else return false end; end; end;