set_incl.sa
Generated by gen_html_sa_files from ICSI. Contact gomes@icsi.berkeley.edu for details
---------------------------> Sather 1.1 source file <--------------------------
-- set_incl.sa: Set include partial classes
-- Author: Benedict A. Gomes <gomes@samosa.ICSI.Berkeley.EDU>
-- Copyright (C) 1995, International Computer Science Institute
-- $Id: set_incl.sa,v 1.10 1996/07/13 05:41:11 gomes Exp $
--
-- COPYRIGHT NOTICE: This code is provided WITHOUT ANY WARRANTY
-- and is subject to the terms of the SATHER LIBRARY GENERAL PUBLIC
-- LICENSE contained in the file: Sather/Doc/License of the
-- Sather distribution. The license is also available from ICSI,
-- 1947 Center St., Suite 600, Berkeley CA 94704, USA.
partial class RO_SET_INCL{E} < $RO_SET{E}
partial class RO_SET_INCL{E} < $RO_SET{E} is
-- Partial class for $RO_SET{E} that implements other functions
-- in terms of has and elt!
--
private include COMPARE{E};
stub has(e: E): BOOL;
-- Return true if the class has the element "e"
stub elt!: E;
-- Yield the elements of the set
stub copy: SAME;
-- Return a copy of the set
private create_from_internal(s: $RO_SET{E}): SET{E} is
-- Used as an auxilliary routine by the view creation routines.
-- When the return type can be any $RO_SET, then by default a
-- "SET" will be constructed and used
return #SET{E}(s);
end;
-- ------ Access/Measurement -------------
size: INT is
i ::= 0; loop discard ::= elt!; i := i + 1; end;
return i;
end;
is_empty: BOOL pre ~void(self) is
-- Do not do size=0. Finding size may require iteration
-- through all elements - quite wasteful for just "is_empty"
loop e ::= elt!; return false; end;
return true;
end;
-- ------ Queries/Comparison --------------
equals(a:$RO_SET{E}): BOOL pre ~void(self) and ~void(a) is
-- Returns 'true' if every element of self is elt_eq to
-- an element in 'a' and vice versa.
-- Neither may be void.
if a.size /= size then return false end;
loop e ::= a.elt!;
if ~has(e) then return false end
end;
-- The second loop could be replaced against
-- 'return size = a.size' but this won't work for
-- some types of elements.
loop if ~a.has(elt!) then return false; end end;
return true
end;
-- ------ Conversion ----------------------
as_array: ARRAY{E} is
res ::= #ARRAY{E}(size);
loop res.set!(elt!) end;
return res;
end;
str: STR is
-- Prints out a string version of the array of the components
-- that are under $STR
res ::= #FSTR("{");
loop e ::= elt!;
typecase e
when $STR then res := res+",".separate!(e.str);
else res := res+",".separate!("unprintable"); end;
end;
res := res + "}";
return(res.str);
end;
-- ------ Basic Operations ----------------
union(s: $RO_SET{E}): SET{E} is
-- Union is defined by default to create a "view" and then convert
-- that into a SET. Subtypes may redefine this behavior to return
-- a set of type "SAME", without going through a view
return create_from_internal(union_view(s));
end;
intersection(s:$RO_SET{E}): SET{E} is
-- See the comment for "union" and $RO_SET::intersection
return create_from_internal(intersection_view(s))
end;
diff(s: $RO_SET{E}): SET{E} is
-- See the comment for "union" and $RO_SET::diff
return create_from_internal(diff_view(s))
end;
sym_diff(s: $RO_SET{E}): SET{E} is
-- See the comment for "union" and $RO_SET::sym_diff
return create_from_internal(sym_diff_view(s))
end;
union_view(s: $RO_SET{E}): $RO_SET{E} is
-- Return a read-only "view" of the union of "self" and "s"
-- The resulting view just points to the two component sets
-- and computes its elements on-the-fly, as needed.
-- As a result, this form of union requires almost no
-- additional space but may it may take slightly longer to
-- perform operations
return BINOP_SET_VIEW{E}::create_union(get_set_of_self,s);
end;
intersection_view(s: $RO_SET{E}): $RO_SET{E} is
-- See the note for "union_view"
return BINOP_SET_VIEW{E}::create_intersection(get_set_of_self,s);
end;
diff_view(s: $RO_SET{E}): $RO_SET{E} is
-- See the comment for "union_view"
return BINOP_SET_VIEW{E}::create_diff(get_set_of_self,s);
end;
sym_diff_view(s: $RO_SET{E}): $RO_SET{E} is
-- See the comment for "union_view"
return BINOP_SET_VIEW{E}::create_sym_diff(get_set_of_self,s);
end;
is_subset_of(s: $RO_SET{E}): BOOL is
-- Return true if "self" is a subset of "s"
return diff_view(s).is_empty
end;
private get_set_of_self: SAME is
local_self ::= self;
typecase local_self
when $RO_SET{E} then return local_self
else
raise("Partial RO_SET_INCL included in a non-subtype of $RO_SET");
end;
end;
end;
partial class SET_INCL{E} < $SET{E}
partial class SET_INCL{E} < $SET{E} is
-- SET_INCL defines some of the set functions which are not dependant
-- on the implementation of the set.
-- The most common routines (union, intersect etc.) are special cased
-- so that when the argument is of type SAME there is no dispatching.
-- Be careful about create
include RO_SET_INCL{E};
stub insert(e:E);
-- Insert element "e" into the set
stub delete(e:E);
-- Delete element "e" from the set
stub create: SAME;
-- Create an empty set - used by the other set create routines
-- ------ Initialization/Duplication ------
create(a: ARRAY{E}): SAME is
return create_from(a);
end;
create_from(e: $ELT{E}): SAME is
res ::= create;
loop res.insert(e.elt!) end;
return res;
end;
copy_from(a: $ELT{E}) is
-- Clear old elts and insert the elements of self
clear;
loop insert(a.elt!) end;
end;
clear is
-- Expensive! To make sure that we don't overwrite while
-- reading, use a seperate array.
elts: FLIST{E} := #;
loop elts := elts.push(elt!) end;
loop delete(elts.elt!) end;
end;
-- ------ Basic Operations ----------------
-- Versions that modify self, special cased when the arg is SAME
to_union(a: $ELT{E}) pre ~void(self) and ~void(a) is
typecase a
when SAME then
loop e ::= a.elt!; if ~has(e) then insert(e) end end;
else loop e ::= a.elt!; if ~has(e) then insert(e) end end; end;
end;
to_diff(a: $ELT{E}) pre ~void(self) and ~void(a) is
typecase a
when SAME then loop e ::= a.elt!; if has(e) then delete(e) end end;
else loop e ::= a.elt!; if has(e) then delete(e) end end; end;
end;
to_sym_diff(a: $ELT{E}) pre ~void(self) and ~void(a) is
typecase a
when SAME then
loop e::=a.elt!; if has(e) then delete(e) else insert(e) end end;
else
loop e::=a.elt!; if has(e) then delete(e) else insert(e) end end;
end;
end;
to_intersection(a: $ELT{E}) is
typecase a
when SAME then
loop e ::= a.elt!; if ~has(e) then delete(e) end; end;
else loop e ::= a.elt!; if ~has(e) then delete(e) end; end; end;
end;
end; -- SET_INCL{E}
class BINOP_SET_VIEW{ETP} < $RO_SET{ETP}
class BINOP_SET_VIEW{ETP} < $RO_SET{ETP} is
-- View of a binary operation between two sets.
-- Handles union, intersection, diff and sym_diff
-- Instead of copying the sets, it merely maintains pointers
-- to the two sets.
-- This view is read-only and *cannot* be used to modify the
-- original sets. Note that it is *not* a value interface.
-- In fact, if the original sets change, this view will automatically
-- change. In some cases this is exactly the behavior you want;
-- in other cases it can be a source of nasty problems. Use carefully.
--
-- Usage:
-- s1: $SET{INT} := #SET{INT}(|1,2,3,5|);
-- s2: $SET{INT} := #SET{INT}(|1,5,3,9|);
-- s ::= BINOP_SET_VIEW{INT}::create_union(s1,s2);
-- #OUT+ s.str;
-- -- will print out the elements 1,2,3,5,9 in some arbitrary order
-- s2.delete(9);
-- #OUT+s.str;
-- -- will print out the elements 1,2,3,5 in some arbitrary order
--
-- Implementation:
-- Maintains pointers to the two sets, primary and secondary
-- The space of the final set is broken down into:
-- Primary set: ( primary )
-- Seconary set: ( secondary )
-- Result: ( p_minus_s ( intersection ) s_minus_p )
--
-- The flags use_p_minus_s, use_intersect and use_s_minus_p indicate
-- which part should be used
include RO_SET_INCL{ETP};
private attr primary: $RO_SET{ETP};
private attr secondary: $RO_SET{ETP};
private attr use_p_minus_s: BOOL; -- Use elements in prim-sec
private attr use_intersect: BOOL; -- Use elements in prim intersect sec
private attr use_s_minus_p: BOOL; -- Use elements in sec - prim
create_union(prim: $RO_SET{ETP},sec: $RO_SET{ETP}): SAME is
return #(prim,sec,true,true,true);
end;
create_intersection(prim: $RO_SET{ETP},sec: $RO_SET{ETP}): SAME is
return #(prim,sec,false,true,false);
end;
create_diff(prim: $RO_SET{ETP},sec: $RO_SET{ETP}): SAME is
return #(prim,sec,true,false,false);
end;
create_sym_diff(prim: $RO_SET{ETP},sec: $RO_SET{ETP}): SAME is
return #(prim,sec,true,false,true);
end;
create(prim: $RO_SET{ETP}, sec: $RO_SET{ETP},
use_p_minus_s: BOOL,use_intersect:BOOL, use_s_minus_p: BOOL): SAME
-- The three parameters indicate whether the resulting set should
-- contain
-- (a) elements from A-B
-- (b) elements from A intersection B
-- (c) elements from B-A
-- A-B A in B B-A
-- f f f = empty
-- *f f t = B-A
-- *f t f = intersection
-- f t t = B
-- *t f f = A - B
-- *t f t = Symmetric Difference
-- t t f = A
-- *t t t = A union B
-- The combinations marked with asterisks are the interesting combinations.
-- This class was designed thus so as to generate the different interesting
-- views of a set using a single class rather than creating separate
-- view classes which generates much more code.
pre ~void(prim) and ~void(sec)
is
res ::= new;
res.primary := prim;
res.secondary := sec;
res.use_p_minus_s := use_p_minus_s;
res.use_intersect := use_intersect;
res.use_s_minus_p := use_s_minus_p;
return res;
end;
copy: SAME is
-- Copy returns a copy of the same type of set
return #SAME(primary,secondary,use_p_minus_s,use_intersect,use_s_minus_p)
end;
has(e: ETP): BOOL is
-- Return true if "e" belongs to this set
-- ph = primary has e sh = secondary has e
-- * indicates a don't care
-- ph sh p-s p in s s-p
-- T T => result is True if * t *
-- T F => result is True if t * *
-- F T => True if * * t
-- F F => result is False
ph ::= primary.has(e); sh ::= secondary.has(e);
return (ph and sh and use_intersect)
or (ph and use_p_minus_s)
or (sh and use_s_minus_p)
end;
elt!: ETP is
if use_p_minus_s and use_intersect then
loop e ::= primary.elt!; yield e end;
elsif use_p_minus_s and ~use_intersect then
loop e ::= primary.elt!; if ~secondary.has(e) then yield e end end;
elsif ~use_p_minus_s and use_intersect then
loop e ::= primary.elt!; if secondary.has(e) then yield e end; end;
end;
if use_s_minus_p then
loop e ::= secondary.elt!; if ~primary.has(e) then yield e end; end;
end;
end;
end;