flist.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. <----------
-- flist.sa: Array-based lists of elements of type T.
-- Jan4/96 - incorporated Erik Schnetter's changes.
class FLIST{T} < $ARR{T}
class FLIST{T} < $ARR{T} is
-- Array-based lists of elements of type T. These are extensible
-- stacks based on amortized doubling. They may often be used as
-- replacements for linked lists. Like linked lists (which are
-- widely used as containers in languages like Lisp), they serve
-- as general container objects for holding collections of other
-- objects. They are often a more efficient abstraction, however,
-- because less allocation and deallocation must occur, because
-- they keep successive elements in successive memory locations,
-- because they don't require storage for the links in a linked
-- list, and they support efficient access by array index. Linked
-- lists also support insertion and deletion into the middle of
-- the list. The set operations `union', `intersection',
-- `difference', and `sym_difference' and the searching operation
-- `index_of' are implemented by brute force search. If extensive
-- use is made of these operations, one should consider the use of
-- other data structures such as FSET{T}.
include COMPARE{T};
private include AREF{T} aget->private aref_aget,
aset->private aref_aset; -- Storage for the stack elements.
private attr loc:INT; -- The index to insert the next element.
-- It would be nice to use an invariant here, but for
-- efficiency we want to be able to destroy old objects
-- after a size change occurs (requiring the writeback).
-- Such calls destroy self, and so the invariant can't
-- be called.
--invariant:BOOL is
-- -- Illegal state if false.
-- if void(self) then return true end;
-- return loc.is_bet(0,asize) and asize>0 end;
size:INT is
-- The current size. Self may be void.
if void(self) then return 0 else return loc end end;
create:SAME is return void; end;
create(n:INT):SAME
-- A new empty FLIST capable of storing `n' elements without extra
-- space allocation.
pre n>=0 is
if n=0 then return void
else return new(n)
end;
end;
create(a: ARRAY{T}): SAME is
-- Create a new FLIST from the elements in the array "a"
-- Useful for using the array shorthand for specifying the elements
sz ::= a.size;
res ::= new(sz);
res.loc := sz;
i ::= 0; loop until!(i = sz); res[i] := a[i]; i := i + 1; end;
return res;
end;
create_from(a: $ELT{T}): SAME is
-- Create from any container
res ::= #SAME;
loop res := res.push(a.elt!) end;
return res;
end;
create_empty_sized(n: INT): SAME
-- Create an flist with n elements that are set to elt_nil
pre n >= 0
is
res ::= create(n);
res.loc := n;
loop res.aset!(res.elt_nil) end;
return res;
end;
copy:SAME is
-- A copy of self.
-- Modified (ben) - ask Claudio
if void(self) then return void end;
r::=new(asize);
i ::= 0; sz ::= loc;
r.loc := loc;
loop until!(i = sz); r[i] := [i]; i := i + 1; end;
return r;
-- loop r:=r.push(elt!) end; return r
end;
aget(ind:INT):T
-- The element of self with index `ind'. Self may not be void.
pre ~void(self) and ind.is_bet(0,loc-1) is
return aref_aget(ind) end;
aset(ind:INT,val:T)
-- Set the element of self with index `ind' to `val'. Self may
-- not be void.
pre ~void(self) and ind.is_bet(0,loc-1) is
aref_aset(ind,val) end;
push(e:T):SAME is
-- Add a new element to the end of the list and return the list.
-- If self is void, create a new list. Usage: `l:=l.push(e)'.
r:SAME;
if void(self) then r:=new(5)
elsif loc<asize then r:=self
else r:=new(2*asize); r.loc:=loc;
loop r.aset!(elt!) end;
-- clear;
SYS::destroy(self); -- The old one should never be used.
end;
r.loc:=r.loc+1; r[r.loc-1]:=e; return r end;
pop:T is
-- Return the top element and shrink the list.
-- Void if the list is empty or void.
if size=0 then return void end;
r::=[loc-1]; [loc-1]:=void; loc:=loc-1; return r end;
top:T is
-- The value of the top of the list.
-- Void if the list is empty or void.
if size=0 then return void end;
return [loc-1] end;
equals(l: $RO_ARR{T}): BOOL is
-- Return true if the elemetns of "l" are the same as the elements
-- of self
if size /= l.size then return false end;
loop
if ~elt_eq(elt!,l.elt!) then return false end;
end;
return true;
end;
-- is_eq(l:SAME):BOOL is
-- -- True if self and `l' have the same number of elements and each
-- -- element of self is equal to the corresponding element of `l'.
-- -- Self may be void.
-- -- Modified (ben)
-- if void(self) then return l.size=0
-- elsif void(l) then return loc=0
-- elsif loc/=l.loc then return false
-- else
-- i ::= 0; sz ::= loc;
-- loop until!(i = sz);
-- if ~elt_eq([i],l[i]) then return false end;
-- i := i +1;
-- end;
-- -- loop if ~elt_eq(elt!,l.elt!) then return false end end end;
-- return true
-- end;
-- end;
is_empty:BOOL is
-- True if the list is empty or void.
return size=0 end;
clear is
-- Clear the list. Self may be void. Clear array elements
-- so they won't be referenced any more (and may become garbage).
if is_empty then return
else
nil: T;
loop [size.times!]:= nil end;
loc:=0;
end;
end;
reset is
-- Semantically identical to clear, but don't reset array
-- values (space may not be freed). Useful for quickly
-- emptying the list when you know it won't matter.
if ~void(self) then loc := 0 end;
end;
array:ARRAY{T} is
-- An array containing the elements of self. Void if self is void.
if void(self) then return void end;
r::=#ARRAY{T}(loc);
loop r.set!(elt!) end; return r end;
elt!:T is
-- Yield the elements of self in order. Self may be void.
-- Don't insert elements while calling this.
-- Modified (ben) - must ask Claudio
if ~void(self) then
i ::= 0; sz ::= loc;
loop until!(i = sz); yield [i]; i := i + 1; end;
end;
end;
-- loop yield aelt!(0,loc) end end end;
elt!(once beg:INT):T
-- Yield the elements of self starting at `beg'.
-- Don't insert elements while calling this.
-- Modified (ben) - Looked at fast version - does
-- not seem to be optimized out. Must ask Claudio about this
pre ~void(self) and beg.is_bet(0,loc-1) is
i ::= beg; sz ::= loc;
loop until!(i = sz); yield [i]; i := i + 1; end;
end;
-- loop yield aelt!(beg,loc-beg) end end;
elt!(once beg,once num:INT):T
-- Yield `num' successive elements starting at index `beg'.
-- Don't insert elements while calling this.
pre ~void(self) and beg.is_bet(0,loc-1) and
num.is_bet(0,loc-beg) is
i ::= beg; sz ::= loc.min(beg+num);
loop until!(i = sz); yield [i]; i := i + 1; end;
end;
-- loop yield aelt!(beg,num) end end;
private is_legal_elts_arg(beg,num,step:INT):BOOL is
-- True if the arguments are legal values for `elts'.
if ~beg.is_bet(0,loc-1) then return false end;
if step>0 then return num.is_bet(0,(loc-beg+step-1)/step);
elsif step<0 then return num.is_bet(0,(beg-step)/-step);
else return false end end;
elt!(once beg,once num,once step:INT):T
-- Yield `num' elements starting at `beg' stepping by `step'.
pre ~void(self) and is_legal_elts_arg(beg,num,step) is
loop yield aelt!(beg,num,step) end end;
ind!:INT is
if ~void(self) then
loop yield 0.upto!(loc-1) end end end;
index_of(e:T):INT is
-- The list index of `e'. -1 if the list is void or the
-- element is not present (not fast). Consider using FSET{T}.
if ~void(self) then
loop r::=ind!; if elt_eq(e,[r]) then return r end end end;
return -1 end;
contains(e: T): BOOL is return has(e) end;
has(e:T):BOOL is
-- True if `e' is contained in self.
loop if elt_eq(e,elt!) then return true end end;
return false end;
push_if_new(e:T):SAME is
-- Push `e' if it is not already present in the list.
-- Self may be void.
-- Usage is: `l:=l.push_if_new(e)'. Consider using FSET{T}.
if has(e) then return self else return push(e) end end;
append(l:SAME):SAME
-- Append `l' to the end of self and return the result.
-- Self may be void. `l' mustn't equal self unless void.
-- Modified(ben) - hopefully much more efficient - no iters
pre ~SYS::ob_eq(l,self) or void(self) is
r::=copy;
old_size ::= size;
r := r.expand_to_size(size+l.size);
i ::= old_size; sz ::= old_size+l.size;
li ::= 0;
loop until!(i=sz);
r[i] := l[li];
li := li+1;
i := i + 1;
end;
return r
end;
concat(l:SAME):SAME
-- Append 'l' destructively. 'l' mustn't equal self
-- unless void.
-- Modified (ben) - hopefully more efficient - no iters, single alloc
pre ~SYS::ob_eq(l,self) or void(self) is
res::=self;
if ~void(l) then
oldsize ::= size;
res := res.expand_to_size(size+l.size);
i ::= 0; sz ::= l.size;
resi ::= oldsize;
loop until!(i = sz);
res[resi] := l[i];
i := i + 1;
resi := resi+1;
end;
-- Old version: res:=res.push(l.elt!) end
end;
return (res);
end;
union(l:SAME):SAME is
-- A new list containing the elements in self unioned with
-- those in `l'. Doesn't modify self or `l'. Self may be void.
-- Consider using FSET{T} for better performance.
r::=copy; loop r:=r.push_if_new(l.elt!) end; return r end;
intersect(l:SAME):SAME is
-- A new list containing the elements in both self and `l'.
-- Doesn't modify self or `l'. Consider FSET{T} for better
-- performance. Self may be void.
r:SAME;
loop e::=elt!; if l.has(e) then r:=r.push(e) end end;
return r end;
difference(l:SAME):SAME is
-- A new list containing the elements of self not in `l'.
-- Doesn't modify self or `l'. Consider FSET{T} for better
-- performance. Self may be void.
r:SAME;
loop e::=elt!; if ~l.has(e) then r:=r.push(e) end end;
return r end;
sym_difference(l:SAME):SAME is
-- A new list containing the elements in self or `l' but
-- not both. Doesn't modify self or `l'. Consider FSET{T} for
-- better performance. Self may be void.
r:SAME;
loop e::=elt!; if ~l.has(e) then r:=r.push(e) end end;
loop e::=l.elt!; if ~has(e) then r:=r.push(e) end end;
return r end;
sublist(beg,num:INT):SAME
-- A new list with `num' entries copied from self starting
-- at `beg'. Self may not be void.
pre ~void(self) and
beg.is_bet(0,loc-1) and num.is_bet(0,loc-beg) is
r::=new(num+5); r.loc:=num; r.acopy(0,num,beg,self); return r end;
to_reverse is
-- Reverse the order of the elements in self. Self may be void.
if void(self) then return end;
loop i::=(loc/2).times!;
u::=loc-i-1; t::=[i]; [i]:=[u]; [u]:=t end end;
-- Users are advised to use this first set of routines
-- since these may later be rewritten to allow the FLIST
-- to shrink, which the versions without return values cannot do.
delete(ind: INT): SAME is delete(ind); return self end;
delete_elt(e: T): SAME is delete_elt(e); return self end;
delete_ordered(ind: INT): SAME is delete_ordered(ind); return self end;
delete_elt_ordered(e: T): SAME is delete_elt_ordered(e); return self end;
delete(ind:INT)
-- Delete the element with index `ind' and move the last element
-- in its place. Self may not be void.
pre ~void(self) and ind.is_bet(0,loc-1) is
[ind]:=[loc-1]; loc := loc - 1; end;
delete_elt(e: T) is delete(index_of(e)) end;
-- Delete first occurance of element e from the list.
-- Consider using FSET.
delete_ordered(ind: INT)
-- Delete the element with index `ind' and move up all other
-- elements (thus preseving order). More expensive than
-- 'delete'. Self may not be void.
pre ~void(self) and ind.is_bet(0,loc-1) is
i ::= ind+1; loop until!(i>=size);
[i-1] := [i];
i := i+1;
end;
loc := loc -1;
end;
delete_elt_ordered(e: T) is delete_ordered(index_of(e)) end;
-- Similar to delete_ord, but for the element "e"
-- map(map:FMAP{T,T}):SAME is
-- Nobody here uses this routine, and it drags in a bunch of (possibly)
-- irrelevant stuff into every compile
-- -- If an element of self is a key in FMAP
-- -- it is replaced with the corresponding
-- -- target. Self may be void.
-- if void(self) then
-- return void;
-- else
-- res::=copy;
-- loop
-- i::=0.upto!(loc-1);
-- if map.test(res[i]) then
-- res[i]:=map.get(res[i]);
-- end;
-- end;
-- return res end end;
has_ind(i: INT): BOOL is
return 0 <= i and i < size
end;
valid_after_ind(i: INT): BOOL is return -1 <= i and i < size end;
valid_before_ind(i:INT): BOOL is return 0 <=i and i <= size end;
insert_after(ind:INT, val:T): SAME pre valid_after_ind(ind) is
-- Insert the value "val" after the index "ind".
-- push all later elements upwards.
r: SAME := expand_to_size(size+1);
-- Then move all elements downwards
r.push_downward(ind+1,1);
r[ind+1] := val;
return r;
end;
insert_before(ind:INT, val:T): SAME pre valid_before_ind(ind) is
-- Insert val just before index "ind"
r: SAME := expand_to_size(size+1);
-- Then move all elements downwards, including the elt at "ind"
r.push_downward(ind,1);
r[ind] := val;
return r;
end;
insert_all_after(ind:INT, val:$CONTAINER{T}):SAME
pre valid_after_ind(ind) is
-- Insert all the values in "val" after the element at index
-- "ind" in the order in which they are yielded by "val"
r: SAME := expand_to_size(size+val.size);
r.push_downward(ind+1,val.size);
i ::= ind+1; loop r[i] := val.elt!; i := i + 1; end;
return r
end;
insert_all_before(ind:INT, val:$CONTAINER{T}) :SAME
pre valid_before_ind(ind) is
-- Insert all the values in "val" before the element in self at
-- index "ind" in the order in which they are yielded by "val"
r: SAME := expand_to_size(size+val.size);
r.push_downward(ind,val.size);
i ::= ind; loop r[i] := val.elt!; i := i + 1; end;
return r
end;
str: STR is
-- Prints out a string version of the flist of the components
-- that are under $STR
res ::= #FSTR("{");
i ::= 0;
loop until!(i = size);
e ::= [i];
if i > 0 then res := res+","+elt_str(e,i);
else res := res + elt_str(e,i); end;
i := i + 1;
end;
res := res+"}";
return(res.str);
end;
elt_str(e: T,i: INT): STR is
typecase e
when $STR then return e.str else return "Unprintable:"+i.str end;
end;
-- ------------------- Implementation ------------------
private push_downward(from_ind: INT, by: INT) pre from_ind >= 0 is
-- Push all the elements from index "from_ind" downward by
-- "ind" spots. The last elements are pushed off the end
to ::= size-1;
from ::= size-by-1;
-- if size = 0 then return; end;
loop until!(from < from_ind);
[to] := [from];
from := from - 1; -- Increments should be faster than using
to := to - 1; -- just one index and offseting it.
end;
end;
private expand_to_size(new_size: INT): SAME is
-- Expand space so that the result has space for "new_size" elements.
-- Then set the location to new_size, indicating that it is filled
-- After this is done, the resulting array will be of size = new_size
-- and will have all the old elements of "self" copied over
-- and the remaining elements (if any) void
r: SAME;
if void(self) then r:=new(5.max(new_size))
elsif new_size<=asize then r:=self
else r:=new((2*asize).max(new_size));
r.loc:=loc; -- Necessary?
i ::= 0; sz ::= size; -- Copy over existing elements in self
loop until!(i = sz);
r[i] := [i] ;
i := i + 1;
end; -- clear;
SYS::destroy(self); -- The old one should never be used.
end;
r.loc := new_size;
return r
end;
set!(e: T) is
loop aset!(e); yield; end;
end;
fill(e: T) is
loop set!(e) end;
end;
inds: ARRAY{INT} is
res ::= #ARRAY{INT}(size);
loop res.set!(size.times!) end;
return res;
end;
end; -- class FLIST{T}