abstract.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
---------------------------> Sather 1.1 source file <--------------------------
-- Copyright (C) International Computer Science Institute, 1994. COPYRIGHT --
-- NOTICE: This code is provided "AS IS" WITHOUT ANY WARRANTY and is subject --
-- to the terms of the SATHER LIBRARY GENERAL PUBLIC LICENSE contained in --
-- the file "Doc/License" of the Sather distribution. The license is also --
-- available from ICSI, 1947 Center St., Suite 600, Berkeley CA 94704, USA. --
--------> Please email comments to sather-bugs@icsi.berkeley.edu. <----------
-- abstract.sa: Abstractions indicating the presence of features.
-- Bug fixes in equality.
-- COMPARE{ETP}::elt_eq was using SYS::id instead of SYS::ob_eq
-- elt_hash was not testing for a void(e) or a value type "e"
-- $IS_EQ: Subtypes define "is_eq($OB):BOOL".
-- $IS_LT{T}: Subtypes define "is_lt(T):BOOL".
-- $HASH: Subtypes define "hash:INT".
-- $NIL: Subtypes define "nil:SAME".
-- $COPY: Subtypes define "copy:SAME"
-- $STR: Subtypes define "str:STR".
-- $ELT{T}: Subtypes define "elt!:T".
abstract class $IS_EQ
abstract class $IS_EQ is
-- Subtypes of this define "is_eq:BOOL". Typically used in
-- typecases to use instead of "=". Examples: INT < $IS_EQ,
-- STR < $IS_EQ.
-- NOTE:
-- This equality should be an IMMUTABLE equality that is valid
-- over the lifetime of the whole object. It should be possible
-- to use this equality (and an associated hash value) to
-- place an object in a hash table and then later retrieve it.
is_eq(e:$OB):BOOL; -- True if self is equal arg for
-- this element type.
end;
abstract class $HASH < $IS_EQ
abstract class $HASH < $IS_EQ is
-- Subtypes of this must provide a hash routine. This is the *new*
-- $HASH class and is a subtype of $IS_EQ so that all subtypes must
-- redefine both hash and is_eq. These two routines must work
-- together - is_eq must refer to an immutable equality
hash: INT;
end;
abstract class $SUPPORTS_REHASH
abstract class $SUPPORTS_REHASH is
-- A class that supports rehashing of its values, when its pointers
-- have been changed (possibly mysteriously, such as by being restored
-- from a string)
rehash;
end;
abstract class $IS_LT{T} < $IS_EQ
abstract class $IS_LT{T} < $IS_EQ is
-- Subtypes of this define "is_lt(T):BOOL and is_eq($OB)".
-- Typically used in typecases.
-- Examples: INT < $IS_LT{INT}, STR < $IS_LT{INT}.
--
-- Design Note: $IS_LT has the type parameter since objects are
-- almost always comparable only with the same type. With the new
-- rules, if is_lt were defined on e: $OB, then we would have to
-- find some meaning for < with arbitrary objects. (you can't just
-- return false - that makes >= be true!).
-- Hence, objects will only define comparisons with themselves
-- while the container classes can switch on $IS_LT{T} and then
-- use the SYS::is_lt when the contained objects are not directly
-- comparable
is_lt(e:T):BOOL; -- True if self is less than arg for
-- this element type.
end;
abstract class $IS_NIL
abstract class $IS_NIL is
-- Subtypes of this define "is_nil:BOOL". Typically used in typecases.
-- Example: INT < $IS_NIL.
is_nil:BOOL; -- Test whether a value is nil.
-- This is necessary for types with unusual is_eq behavior (such
-- as IEEE floats).
end;
abstract class $NIL < $IS_NIL
abstract class $NIL < $IS_NIL is
-- Inidicates that the subtype provides a nil value
--
-- Designer's Note:The advantage of T over SAME is that in
-- parametrized classes typecase e when $NILthen .... e.nil e.nil
-- is now known to be of type T, whereas if it were SAME, you would
-- need at least an extra level of typecase
nil:SAME;
end;
abstract class $COPY
abstract class $COPY is
-- Indicates that a subtype provides a copy routine
copy:SAME; -- Return a copy of self.
end;
abstract class $STR
abstract class $STR is
-- Subtypes of this define "str:STR". This should be a reasonable
-- string representation of an object.
str:STR; -- String form of object.
end;
abstract class $ELT
abstract class $ELT is
-- Subtypes will provide an elt! iterator that returns at least
-- a $OB (it could be more specific). Most objects will actually
-- subtype from $ELT{T}
elt!: $OB;
end;
abstract class $ELT{T} < $ELT
abstract class $ELT{T} < $ELT is
-- Subtypes of this define "elt!:T". This is a stronger version of
-- the generic $ELT routine
elt!:T; -- Contained items.
end;
partial class COMPARE{ETP}
partial class COMPARE{ETP} is
-- Partial class that should be included by containers of elements of
-- type ETP that need to provide an elt_eq and/or an elt_lt routine.
elt_eq(e1,e2:ETP):BOOL is
-- The "less than" relation used in the sorting routines. Compares
-- the object "id" by default. May be redefined in descendants.
typecase e1
when $IS_EQ then return e1.is_eq(e2)
else return SYS::ob_eq(e1,e2); end;
end;
elt_lt(e1,e2:ETP):BOOL is
-- The "less than" relation used in the sorting routines. Compares
-- the object "id" by default. May be redefined in descendants.
typecase e1
when $IS_LT{ETP} then return e1.is_lt(e2)
else
-- Void reference types cannot be compared for lt
-- Void value types must be placed under $IS_LT and
-- won't fall in this case
assert ~void(e1) and ~void(e2);
assert COMPARE_AUX::verify_ref_type(e1,
"Provide is_lt and place under $IS_LT");
-- Can call SYS::id on value types
return SYS::id(e1) < SYS::id(e2)
end;
end;
elt_hash(e:ETP):INT is
-- A hash value associated with an element. Must have the property
-- that if "elt_eq(e1,e2)" then "elt_hash(e1)=elt_hash(e2)". Can
-- be defined to always return 0, but many routines will then
-- become quadratic. Uses object "id" by default.
-- May be redefined in descendants.
typecase e
when $HASH then return e.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 COMPARE_AUX::verify_ref_type(e,
"Provide hash and place under $HASH");
return SYS::id(e).hash;
end;
end;
end;
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
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
typecase arg
when SAME then return is_eq(arg)
else return false end;
end;
end;
class COMPARE_AUX
class COMPARE_AUX is
-- These functions are separated out here so that they are not
-- included into other classes, causing unnecessary conflicts
verify_ref_type(e:$OB,msg:STR):BOOL is
-- Check that "e" is not of an immutable type
if SYS::tp(e) < 0 then
ts:STR := SYS::str_for_tp(SYS::tp(e));
raise "Cannot use immutable class:"+ts+ " "+msg;
else return true; end;
end;
end;