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}