flist.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 FLIST_IMPL{ETP} < $ARR{ETP}
class FLIST_IMPL{ETP} < $ARR{ETP} is
-- This class implements array based lists of elements with mutable
-- semantics. These are extensible stacks based on amortized doubling.
-- They may be used as replacements for linked lists. Like linked lists
-- they serve as general container objects for holding collections of other
-- objects. This is frequently more efficient, however, because less
-- allocation and deallocation must occur; since they keep successive
-- elements in successive memory locations they don't require storage for
-- the links in a linked list and offer efficient access by array index.
--
-- The set operations `union', `intersection', `difference',
-- `symmetric_difference' and the searching operation `index_of' are
-- implemented by brute force search. If extensive use of these operations
-- is needed then an alternative data structure (eg FSET) should be
-- considered.
-- NOTE 1. The use of an invariant is not possible since for efficiency
-- reasons it must be possible to destroy old objects after a
-- size change occurs. This destroys self so that an invariant
-- cannot be used.
--
-- 2. This has been taken out of the FLIST class implementation in
-- order to enable strings to include this without the filter
-- features from ELT_FILTERS!!
-- Version 1.0 May 99. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 10 May 99 kh Original from FLIST.
include COMPARE{ETP} ;
private include AREF{ETP}
aget->private aref_aget,
aset->private aref_aset,
array_ptr -> array_ptr,
acopy -> oct_acopy ;
include CONTAINER_STR{ETP} ;
-- The storage for the data elements.
private attr loc : CARD ; -- index to insert next element.
private const Min_Size : CARD := 5 ;
create(cnt : CARD) : SAME
pre true
post ((cnt > 0) and (result.asize = cnt)) or (result.asize = Min_Size)
is
--This returns a new empty list capable of storing cnt elements without
-- extra space allocation.
if cnt = 0 then
cnt := Min_Size
end ;
me : SAME := new(cnt) ;
me.loc := 0 ;
return me
end ;
create : SAME is
-- This is the variant of create which creates a 'default' size list!
return create(Min_Size)
end ;
create(arr : ARRAY{ETP}) : SAME is
-- This creation routine produces a new list containing the elements of arr.
-- This is useful when using array notation for specifying elements.
sz : CARD := arr.size ;
me : SAME := new(sz) ;
me.loc := sz ;
index : CARD := 0 ;
loop
until!(index = sz) ;
me[index] := arr[index] ;
index := index + 1
end ;
return me
end ;
create_from(container : $ELT{ETP}) : SAME
pre ~void(container)
post ~void(result)
is
-- This variant creates a list from the contents of an object of any
-- container class.
me : SAME := create ;
loop
me := me.push(container.elt!)
end ;
return me
end ;
create_empty_sized(cnt : CARD) : SAME is
-- This routine creates a sized array all of whose elements are set
-- to the value elt_nil.
me : SAME := create(cnt) ;
me.loc := cnt ;
loop
me.aset!(me.elt_nil)
end ;
return me
end ;
copy : SAME
pre true
post (void(self) and void(result)) or ~void(result) -- and result = self
is
-- This routine creates an exact copy of self.
if void(self) then
return void
end ;
res : SAME := new(asize) ;
index : CARD := 0 ;
sz : CARD := loc ;
res.loc := loc ;
loop
until!(index = sz) ;
res[index] := [index] ;
index := index + 1
end ;
return res
end ;
is_empty : BOOL is
-- This predicate returns true if and only if the list size is zero.
return size = 0
end ;
is_full : BOOL is
-- This predicate returns true if and only if the current buffer has
-- no more free space.
return loc = asize
end ;
equals(other : $RO_ARR{ETP}) : BOOL is
-- This predicate returns true if and only if all of the elements of
-- other have the same value as the corresponding elements of self.
if void(self) then
return other.size = 0
end ;
loop
if ~elt_eq(elt!,other.elt!) then
return false
end
end ;
return true
end ;
contains(elem : ETP) : BOOL is
-- This predicate returns true if and only if at least one element of
-- self is equal to the given argument.
if void(self) then
return false
end ;
loop
if elt_eq(elem,aelt!) then
return true
end
end ;
return false
end ;
count(elem : ETP) : CARD is
-- This routine returns the number of elements of the list which are
-- equal to elem.
res : CARD ;
loop
if elt_eq(elem,aelt!) then
res := res + 1
end
end ;
return res
end ;
has_ind(index : CARD) : BOOL is
-- This predicate returns true if and only if index is a valid index for the list.
return index < size
end ;
private valid_after_ind(index : CARD) : BOOL is
-- This predicate is a private synonym for has_ind.
return has_ind(index)
end ;
private valid_before_ind(index : CARD) : BOOL is
-- This predicate returns true if and only if the given index is within
-- the list or only one past the end of the list.
return index <= size
end ;
size : CARD
pre true
post (void(self)and (result = 0)) or (result = loc)
is
-- This routine returns the current size of the list -- which may
-- be void.
if void(self) then
return 0
else
return loc
end
end ;
aget(index : CARD) : ETP
pre ~void(self) and (index < loc) and (index < asize)
post true -- void(result)
-- or elt_eq(result,aref_aget(index))
is
-- This routine returns the element of self with the given index.
-- Self may not be void.
return aref_aget(index)
end ;
aset(index : CARD,val : ETP)
pre ~void(self) and (index <= loc)
post true -- void(val)
-- or elt_eq(aref_aget(index),val)
is
-- This routine sets the indexed element of self to the given value.
aref_aset(index,val)
end ;
push(elem : ETP) : SAME
pre true
post (initial(void(self))
and (result.asize = Min_Size)
and (result.loc = 1))
or (result.loc >= 1)
is
-- This routine adds a new element to the END of the list and returns
-- the resulting list. If self is void a new list is created with
-- the single element value.
res : SAME ;
if void(self) then
res := new(Min_Size)
elsif loc < asize then
res := self
else
res := new(2 * asize) ;
res.loc := loc ;
loop
res.set!(elt!)
end ;
SYS::destroy(self) -- old one should never be used.
end ;
res.loc := res.loc + 1 ;
res[res.loc - 1] := elem ;
return res
end ;
pop : ETP
pre ~void(self)
post ((initial(size) = 0) and void(result)) or (loc = (initial(loc) - 1))
is
-- This routine removes the element at the end of the list and returns it.
if size = 0 then
return void
end ;
res : ETP := [loc - 1] ;
loc := loc - 1 ;
return res
end ;
top : ETP
pre ~void(self)
is
-- This routine returns the value at the end of the list or void if
-- the list is empty.
if size = 0 then
return void
end ;
return [loc - 1]
end ;
clear
pre true
post (void(self) and is_empty) or (loc = 0)
is
-- This routine sets all elements of the list to be void. Self may
-- be void.
if is_empty then
return
else
nil : ETP := void ;
loop
[size.times!] := nil
end ;
loc := 0
end
end ;
reset
pre true
post void(self)
or (loc = 0)
is
-- This routine resets the list to be empty without clearing
-- the individual elements.
if ~void(self) then
loc := 0
end
end ;
array : ARRAY{ETP}
pre true
post (void(self) and void(result)) or (result.size = loc)
is
-- This routine returns an array containing the elements of self. Void
-- is returned if self is void.
if void(self) then
return void
end ;
res : ARRAY{ETP} := ARRAY{ETP}::create(loc) ;
loop
res.aset(ind!,aelt!)
end ;
return res
end ;
index_of(elem : ETP) : CARD
pre true
post contains(elem) or (result = CARD::maxval)
is
-- This routine returns the index of elem if found in the list,
-- otherwise CARD::maxval.
if ~void(self) then
loop
res : CARD := ind! ;
if elt_eq(elem,aref_aget(res)) then
return res
end
end
end ;
return CARD::maxval
end ;
private push_if_new(elem : ETP) : SAME
pre true
post result.contains(elem)
or (void(self)
and (result.asize = Min_Size)
-- and (result[0] = elem)
and (result.loc = 1))
or ((initial(loc) < initial(asize))
-- and (result[initial(loc)] = elem)
and (result.loc = (initial(loc) + 1)))
or ((result.asize = 2 * initial(asize))
-- and (result[loc] = elem)
and (result.loc = (initial(loc) + 1)))
is
-- This routine pushes elem onto the end of the list if it is not
-- already there, returning the resulting list.
if contains(elem) then
return self
else
return push(elem)
end
end ;
private expand_to_size(new_size : CARD) : SAME is
-- This private routine expands the list space so that the result has
-- space for new_size elements. The element values from self are copied,
-- loc is set and the resulting list returned.
res : SAME ;
if void(self) then
res := new(Min_Size.max(new_size))
elsif new_size <= asize then
res :=self
else
res := new((2 * asize).max(new_size)) ;
res.loc := new_size ;
loop
index : CARD := 0.upto!(size - 1) ;
res[index] := [index]
end ;
SYS::destroy(self) ; -- old one should never be used.
end ;
return res
end ;
append(list : SAME) : SAME
pre ~SYS::ob_eq(list,self) or void(self)
post ((self.size + list.size) = result.size)
is
-- This routine appends the given list to the end of a copy of self and
-- returns the result. Self may be void; list must not be the same as self
-- unless void!
res : SAME := copy ;
old_size : CARD := size ;
res := res.expand_to_size(size + list.size) ;
index : CARD := old_size ;
res.loc := old_size + list.size ;
listindex : CARD := 0 ;
loop
until!(index = res.loc) ;
res[index] := list[listindex] ;
listindex := listindex + 1 ;
index := index + 1
end ;
return res
end ;
concat(list : SAME) : SAME
pre void(list) or ~SYS::ob_eq(list,self)
post (result.size = (initial(self.size) + list.size))
is
-- This routine appends list to self destructively. Providing that
-- list is not void it must not be the same as self.
res : SAME := self ;
if list.size > 0 then
oldsize : CARD := size ;
res := res.expand_to_size(oldsize + list.size) ;
res.loc := oldsize + list.size ;
loop
index : CARD := 0.upto!(list.size - 1) ;
res_index : CARD := oldsize.up! ;
res[res_index] := list[index]
end
end ;
return res
end ;
-- The following four routines are really set operations.
-- if extensive use is being made of these then the use of
-- FSET is recommended.
union(list : SAME) : SAME
pre true
post (result.size <= (size + list.size))
is
-- This routine returns a new list containing the elements in the union
-- of self and list. Self may be void.
res : SAME := copy ;
loop
res := res.push_if_new(list.elt!)
end ;
return res
end ;
intersect(list : SAME) : SAME
pre true
post (result.size <= list.size)
is
-- This routine returns a new list containing the elements which are
-- in both self and list. Self may be void.
res : SAME ;
loop
elem : ETP :=elt! ;
if list.contains(elem) then
res := res.push(elem)
end
end ;
return res
end ;
difference(list : SAME) : SAME
pre true
post (result.size <= size)
is
-- This routine returns a new list containing the elements of self
-- which are not in list. Self may be void.
res : SAME ;
loop
elem : ETP := elt! ;
if ~list.contains(elem) then
res := res.push(elem)
end
end ;
return res
end ;
sym_difference(list : SAME) : SAME
pre true
post (result.size <= (size + list.size))
is
-- This routine returns a new list containing the elements in self or in
-- list but not in both. Self may be void.
res : SAME ;
loop
elem : ETP := elt! ;
if ~list.contains(elem) then
res := res.push(elem)
end
end ;
loop
elem : ETP := list.elt! ;
if ~contains(elem) then
res := res.push(elem)
end
end ;
return res
end ;
sublist(beg,num : CARD) : SAME
pre ~void(self)
and (beg <= (loc - 1))
and (num <= (loc - beg))
post (result.size = num)
-- and (result[0] = [beg])
is
-- This routine returns a sublist of num entries starting at beg.
-- Self may not be void.
res : SAME := new(num + Min_Size) ;
res.loc := num ;
res.oct_acopy(0,num,beg,self) ;
return res
end ;
to_reverse
pre true
post (self.size = initial(self.size)) -- (initial([0]) = [size - 1])
is
-- This routine sets self to be rearranged in the reverse order of
-- elements.
if void(self) then
return
end ;
loop
index : CARD := (loc/2).times! ;
upper_index : CARD := loc - index - 1 ;
temp : ETP := [index] ;
[index] := [upper_index] ;
[upper_index] := temp
end
end ;
delete(index : CARD)
pre ~void(self) and (index <= (loc - 1))
post (loc = (initial(loc) - 1))
is
-- This routine deletes the element with the given index and replaces
-- it with the last list element. Self may not be void.
[index] := [loc - 1] ;
loc := loc - 1
end ;
delete_elt(elem : ETP)
pre ~void(self) and contains(elem)
post (loc = (initial(loc) - 1))
is
-- This routine deletes the first occurrence of element e in the list.
delete(index_of(elem))
end ;
delete_ordered(index : CARD)
pre ~void(self) and (index <= (loc - 1))
post (loc = (initial(loc) - 1))
-- and (self[index] = initial(self[index + 1]))
is
-- This routine deletes the element with the given index and moves all
-- subsequent ones up to preserve the order of the list. Self may not be
-- void.
loc_index : CARD := index + 1 ;
loop
until!(loc_index >= size) ;
[loc_index - 1] := [loc_index] ;
loc_index := loc_index + 1
end ;
loc := loc - 1
end ;
delete_elt_ordered(elem : ETP)
pre ~void(self) and contains(elem)
post (loc = (initial(loc) - 1))
is
-- This routine is similar to delete_elt except that the order of
-- the remaining original list elements is preserved.
delete_ordered(index_of(elem))
end ;
-- WARNING User code should use the following versions of the above
-- four routines which return self. This will permit
-- later modifications to be made to improve efficiency,
-- delete unwanted space, etc.
delete(index : CARD) : SAME
pre ~void(self) and (index <= (loc - 1))
post (result.loc = (initial(loc) - 1))
is
-- This routine returns the result of deleting the indexed element from self.
delete(index) ;
return self
end ;
delete_elt(elem : ETP) : SAME
pre ~void(self) and contains(elem)
post (result.loc = (initial(loc) - 1))
is
-- This routine returns the result of deleting the given element from self.
delete_elt(elem) ;
return self
end ;
delete_ordered(index : CARD) : SAME
pre ~void(self) and (index <= (loc - 1))
post (result.loc = (initial(loc) - 1))
is
-- This routine returns the result of deleting the indexed element from
-- self in such a way as to preserve the order of the list.
delete_ordered(index) ;
return self
end ;
delete_elt_ordered(elem : ETP) : SAME
pre ~void(self) and contains(elem)
post (result.loc = (initial(loc) - 1))
is
-- This routine returns the result of deleting the given element from
-- self in such a way as to preserve the order of the list.
delete_elt_ordered(elem) ;
return self
end ;
fill(elem : ETP)
pre ~void(self)
post true -- should be every(bind(_.elt_eq(elem)))
is
-- This routine fills all elements of the list with the given element
-- value.
loop
set!(elem)
end
end ;
inds : ARRAY{CARD}
pre ~void(self)
post ((result.size = size) and (result[size - 1] = (size - 1)))
is
-- This routine produces an array containing the same number of elements
-- as self, the individual elements of which contain a value corresponding
-- to their index.
res : ARRAY{CARD} := ARRAY{CARD}::create(size) ;
loop
res.set!(size.times!)
end ;
return res
end ;
private push_downward(from : CARD,by : CARD)
pre ~void(self) and (size > by) and (by > 0)
post (loc = initial(loc))
is
-- This private routine pushes all of the list elements starting with
-- from down the list by by elements. Elements are 'pushed' off the end as
-- required!
to : CARD := size - 1 ;
loc_from : CARD := size - by - 1 ;
loop
until!(loc_from < from) ;
[to] := [loc_from] ;
if (loc_from) = 0 then
break!
end ;
loc_from := loc_from - 1 ;
to := to - 1
end
end ;
insert_after(index : CARD,val : ETP) : SAME
pre valid_after_ind(index)
post (result.size = initial(size) + 1)
-- and (result[index + 1] = val)
is
-- This routine inserts the given value after the element indexed with
-- the given index. All later elements are pushed toward the end by one
-- place.
res : SAME := expand_to_size(size + 1) ;
res.push_downward(index + 1,1) ;
res[index + 1] := val ;
return res
end ;
insert_before(index : CARD,val : ETP) : SAME
pre valid_before_ind(index)
post (result.size = initial(size) + 1)
-- and (result[index] = val)
is
-- This routine inserts the given value at the specified index position.
-- All later index elements are moved towards a higher index position.
res : SAME := expand_to_size(size + 1) ;
res.push_downward(index,1) ;
res[index] := val ;
return res
end ;
insert_all_after(index : CARD,val : $CONTAINER{ETP}) : SAME
pre valid_after_ind(index)
post (result.size = initial(size) + val.size)
-- and (result[index + 1] = val[0])
is
-- This routine inserts all of the values in val in sequence starting
-- at the given index position. All later elements of self are moved
-- towards a higher index location.
res : SAME := expand_to_size(size + val.size) ;
res.push_downward(index + 1,val.size) ;
loc_index : CARD := index + 1 ;
loop
res[loc_index] := val.elt! ;
loc_index := loc_index + 1
end ;
return res
end ;
insert_all_before(index : CARD,val : $CONTAINER{ETP}) : SAME
pre valid_before_ind(index)
post (result.size = initial(size) + val.size)
-- and (result[index] = val[0])
is
-- This routine inserts all of the values of val in sequence in the
-- result starting at the given index position. All later elements of self
-- are moved towards a higher index.
res : SAME := expand_to_size(size + val.size) ;
res.push_downward(index,val.size) ;
loc_index : CARD := index ;
loop
res[loc_index] := val.elt! ;
loc_index := loc_index + 1
end ;
return res
end ;
ind! : CARD
pre true
post (result < size)
is
-- Provided that self is not void this iter yields the sequence of index
-- numbers by which self may be indexed.
if (size > 0) then
loop
yield 0.upto!(loc - 1)
end
end
end ;
elt! : ETP
is
-- This iter yields all of the elements of self in sequence. Self may be void.
-- WARNING Further elements may not be inserted while calling this iter!
if ~void(self) then
index : CARD := 0 ;
loop
until!(index >= loc) ;
yield [index] ;
index := index + 1
end
end
end ;
elt!(once beg : CARD) : ETP
is
-- This iter yields successive elements of the list starting at the index given by beg.
-- WARNING Do not insert further elements while calling this iter.
if ~void(self) then
index : CARD := beg ;
loop
until!(index >= loc) ;
yield [index] ;
index := index + 1
end;
end;
end ;
elt!(once beg,once num : CARD) : ETP
pre ~void(self) and (beg <= (loc - 1)) and (num <= (loc - beg))
post contains(result) -- (result = [beg + ind!])
is
-- This iter yields up to num successive values from the list starting
-- with the one indexed by beg. WARNING Do not insert further elements while
-- calling this.
index : CARD := beg ;
sz : CARD := size.min(beg + num) ;
loop
until!(index = sz) ;
yield [index] ;
index := index + 1
end
end ;
private is_legal_elts_arg(beg,num : CARD,step : INT) : BOOL is
-- This predicate returns true if and only if the three parameters form
-- a legal value for use in the following iter.
if ~(beg <= (loc - 1)) then
return false
end ;
if step > 0 then
return (num.int <= (loc.int - beg.int + step - 1)/step)
elsif step < 0 then
return (num.int <= (beg.int - step)/ -step)
else
return false
end
end ;
elt!(once beg,once num : CARD,once step : INT) : ETP
pre ~void(self) and is_legal_elts_arg(beg,num,step)
post contains(result)
is
-- This iter yields a sequence of up to num elements starting at beg
-- and stepping up or down by step, dependent on its sign.
loop
yield aelt!(beg,num,step)
end
end ;
set!(elem : ETP)
pre true
post contains(elem) -- ([ind!] = elem)
is
-- This iter sets successive elements of self before yielding to its caller.
loop
aset!(elem) ;
yield
end
end ;
end ; -- FLIST_IMPL{ETP}
class FLIST{ETP} < $FLISTS{ETP}
class FLIST{ETP} < $FLISTS{ETP} is
-- This class implements array based lists of elements with mutable
-- semantics - by inclusion of FLIST_IMPL.
-- Version 1.4 Nov 2000. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 11 Apr 94 bg Original
-- 4 Jan 96 es Efficiency improvements
-- 20 Mar 97 kh Adapted to use CARD, etc
-- 10 May 99 kh Removed body to FLIST_IMPL
-- 28 Nov 00 kh Changed inheritance from $ARR to $FLISTS
include FLIST_IMPL{ETP} ;
include ELT_FILTERS{ETP} ;
end ; -- FLIST{ETP}