fstring.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>  <--------------


partial class FSTRING_INCL{ETP}

partial class FSTRING_INCL{ETP} is -- This partial class implements those features of strings which are -- related to string storage and are common to all 'fast' forms except the -- text ones, since text strings have variable storage sizes and strings in -- general do not! -- Version 1.0 Apr 99. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 13 Apr 99 kh Revised for V8 of text classes include FLIST_IMPL{ETP} -- without the 'set' features difference ->, equals ->, fill ->, inds ->, intersect ->, reset ->, sym_difference ->, union -> ; -- The above inclusion provides features array, clear, contains, copy, -- push, pop, top, ind! and elt! while omitting those features which offer -- set style operations on the list. It also exposes loc for external use. include ELT_FILTERS{ETP} ; -- This makes available the filter utilities for simple strings. end ; -- FSTRING_INCL

partial class FSTRING{ETP,STP}

partial class FSTRING{ETP,STP} is -- This partial class implements those features common to both binary -- and text fast strings. This provides a buffer for efficiently -- constructing strings by repeated concatenation using amortized doubling. -- Version 1.2 Apr 99. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 10 Jan 97 kh Original adapted from old FSTR -- 12 Feb 99 kh Complete rewrite for cultural handling -- 13 Apr 99 kh Revised for V8 of text classes include COMPARABLE ; stub nil : SAME ; -- This routine returns the nil (empty) string. octets : CARD is -- This routine returns the number of storage units in the string. return asize end ; acopy( str : STP ) pre ~void(self) and (asize >= str.asize) post (loc = initial(loc)) is -- This is a bit-pattern copy of str into self. Note that the current -- insert point has not been changed! Built-in to this implementation. builtin FSTR_ACOPY_STR end ; acopy( fstr : SAME ) pre ~void(self) and (asize >= fstr.asize) post (loc = initial(loc)) is -- This is a bit-pattern copy from one fstr to self. Note that the -- current insert point in self has not been changed! Built-in to this -- implementation. builtin FSTR_ACOPY_FSTR end ; acopyn( str : STP, cnt : CARD ) pre ~void(self) and (cnt >= str.size) post (loc = initial(loc)) is -- This is a bit-pattern copy from str of cnt elements into self. Note -- that the current insert point of self has not been changed. Built-in to -- this implementation. builtin FSTR_ACOPYN_STR_CARD end ; acopyn( fstr : SAME, cnt : CARD ) pre ~void(self) and (cnt >= fstr.size) post (loc = initial(loc)) is -- This is a bit-pattern copy from fstr of cnt elements into self. Note -- that the current insert point of self has not been changed. Built-in to -- this implementation. builtin FSTR_ACOPYN_FSTR_CARD end ; acopy( beg : CARD, src : STP ) pre ~void(self) and (asize > (beg + str.size)) post (loc = initial(loc)) is -- This routine copies from src to self beginning at the element beg. -- Note that the current insert point of self has not been changed. -- Built-in to this implementation. builtin FSTR_ACOPY_CARD_STR end ; acopy( beg : CARD, src : SAME ) pre ~void(self) and (asize > (beg + src.size)) post (loc = initial(loc)) is -- This routine copies from src to self beginning at the element beg. -- Note that the current insert point of self has not been changed. -- Built-in to this implementation. builtin FSTR_ACOPY_CARD_FSTR end ; index_of( val : ETP ) : CARD pre ~void(self) post true is -- This routine returns the index of the first element (from the -- beginning) which contains the given value - or CARD::nil if not found. loop index : CARD := ind! ; if [index] = val then return index end end ; return CARD::nil end ; plus( elem : ETP ) : SAME pre true post (result.size = (initial(size) + 1)) is -- This routine appends elem to self and returns it. return self.push(elem) end ; plus( fstr : SAME ) : SAME pre true post ~void(result) -- and (result.loc = (initial(self.loc) + fstr.loc)) is -- This routine appends the string fstr to self and returns it. res : SAME ; length : CARD := fstr.asize ; if void(self) then res := create(2 * length) elsif ((loc + length) < asize) then res := self else res :=new(2 * (asize + length)) ; -- Amortised doubling res.loc := loc ; res.acopy(self) ; SYS::destroy(self) -- old one shouldn't be used now. end ; if (length = 0) then return res end ; res.loc := res.loc + length ; res.acopy(res.loc - length,fstr) ; return res end ; plus( str : STP ) : SAME pre true post ~void(result) and (result.loc = (initial(self.size) + str.size)) is -- This routine appends the string str to self and returns the resulting -- string. res : SAME ; length : CARD := str.asize ; if void(self) then res := create(2 * length) elsif ((loc + length) < asize) then res := self else res :=new(2 * (asize + length)) ; -- Amortised doubling res.loc := loc ; res.acopy(self) ; SYS::destroy(self) -- old one shouldn't be used now. end ; if (length = 0) then return res end ; res.loc := res.loc + length ; res.acopy(res.loc - length,str) ; return res end ; private is_eq_helper( fstr : SAME, cnt : CARD ) : BOOL is -- This predicate uses a fast bit-pattern compare of cnt elements of -- self and fstr. Built-in to this implementation. builtin FSTR_MEMCMP_FSTR_CARD end ; private is_eq_helper( str : STP, cnt : CARD ) : BOOL is -- This predicate uses a fast bit-pattern compare of cnt elements of -- self and fstr. Built-in to this implementation. builtin FSTR_MEMCMP_STR_CARD end ; is_eq( other : SAME ) : BOOL is -- This predicate yields true if and only if self and other are the same. lgth, lgth_other : CARD ; if void(self) then lgth := CARD::nil else lgth := loc end ; if void(other) then lgth_other := CARD::nil else lgth_other := other.loc end ; -- maxval is an otherwise illegal value. It is used to distinguish -- 'void' from a zero length string. if lgth /= lgth_other then return false end ; return is_eq_helper(other,lgth) -- 'built-in' string compare end ; is_eq( bstr : STP ) : BOOL is -- This routine is a convenience when comparing an ordinary string -- object and a 'fast' one. lgth : CARD ; lgth_bstr : CARD ; if void(self) then lgth := CARD::nil else lgth := size end ; if void(bstr) then lgth_bstr := CARD::nil else lgth_bstr := bstr.asize end ; -- maxval is an otherwise illegal value. It is used to distinguish -- 'void' from a zero length OCTETSTR. if lgth /= lgth_bstr then return false end ; return is_eq_helper(bstr,lgth) -- built-in C-style compare end ; is_nil : BOOL is -- This predicate returns true if and only if self is the nil string. return ~void(self) and (size = 0) end ; private const Hash_Prime : FIELD := 19 ; hash : CARD is -- This routine returns a hash value formed from all of the elements -- of the string. res : FIELD := FIELD::zero ; loop res := (res + (elt!.card.field) + ind!.field) * Hash_Prime end ; return res.card end ; thumbprint : STR pre true post ~void(result) is -- This routine creates a 'name' from the contents of self which should -- be unique to the value. return size.str + LIBCHARS::default.Decimal_Mark.char + hash.str end ; substring( beg, num : CARD ) : SAME pre (size >= num) and ((size - num) >= beg) post (result.size = num) is -- This routine returns as a new string the substring with num elements -- whose first element has index beg. res : SAME := create(num) ; res.loc := num ; loop index : CARD := beg.upto!(beg + num - 1) ; res.aset((index - beg),aget(index)) end ; return res end ; head( cnt : CARD ) : SAME pre ~void(self) and (loc >= cnt) post (result.size = cnt) and (result[0] = self[0]) is -- This routine returns the first cnt elements of self as a new string. return substring(0,cnt) end ; tail( cnt : CARD ) : SAME pre ~void(self) and (loc >= cnt) post (result.size = cnt) and ((cnt = 0) or (result[0] = self[size - cnt])) is -- This routine returns the last cnt elements of self as a new string. return substring(loc - cnt,cnt) end ; end ; -- FSTRING{ETP,STP}

partial class FTEXT_INCL{ETP}

partial class FTEXT_INCL{ETP} is -- This partial class implements those features and stubs which are -- common to the text string classes FSTR/FRUNES in the required library. -- Version 1.0 Apr 99. Copyright K Hopper, U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 13 Apr 99 kh Original for version 8 of text classes include FLIST_IMPL{OCTET} difference ->, -- inappropriate features! equals ->, fill ->, inds ->, intersect ->, is_full->, reset ->, sym_difference ->, union ->, top ->, pop->, to_reverse ->, create -> raw_create, array -> private oct_array, aget -> private oct_aget, aset -> private aset, loc -> loc, elt! -> ; include ELT_FILTERS{ETP} ; -- The above two inclusions provide FLIST 'storage' as octets and the -- filter features on the elements of self (not, in general, octets!). stub aget( index : CARD ) : ETP ; -- This is the standard aget operation specialised for the difference -- between character elements and the underlying octet storage. is_full : BOOL is -- This routine returns true if and only if the current buffer is full. return loc >= asize end ; end ; -- FTEXT_INCL

partial class FTEXT_STRING{ETP,STP}

partial class FTEXT_STRING{ETP,STP} is -- This partial class implements those features common to all forms of -- fast text strings. This provides a buffer (based on the FLIST mechanism) -- for efficiently constructing text strings by repeated concatenation using -- amortized doubling. -- Version 1.0 Apr 99. Copyright K Hopper,U of Waikato -- Development History -- ------------------- -- Date Who By Detail -- ---- ------ ------ -- 12 Apr 99 kh Original for V8 of text classes include FSTRING{ETP,STP} ; include BINARY ; private attr priv_lib : CARD ; -- This attribute is the index into the global list of repertoires used -- by a program. build( cursor : BIN_CURSOR, lib : LIBCHARS ) : SAME pre ~void(cursor) and ~cursor.is_done and ~void(lib) post (void(result) and (initial(cursor.index) = cursor.index)) or (result.size >= 0) is -- This routine builds the string from the binary string indicated using -- the encoding and repertoire defined by lib. If there is insufficient data -- in the string then void is returned and the cursor has not been moved. if cursor.remaining.mod(lib.my_size) > 0 then return void end ; chunk_size : CARD := lib.my_size ; res : SAME := create(cursor.remaining,lib) ; loc_str : BINSTR := cursor.get_remainder ; res.priv_lib := REP_LIB_LIST::index(lib) ; loop index : CARD := 0.up! ; res := res + ETP::build(loc_str.chunk!(chunk_size).cursor,lib) end ; return res end ; build( cursor : BIN_CURSOR ) : SAME pre ~void(cursor) and ~cursor.is_done post (void(result) and (initial(cursor.index) = cursor.index)) or (result.size >= 0) is -- This routine builds the string from the binary string indicated using -- the encoding and repertoire defined by lib. If there is insufficient data -- in the string then void is returned and the cursor has not been moved. return build(cursor,LIBCHARS::default) end ; create( -- arr : ARRAY{ETP} arr : $RO_ARR{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 ; contains( ch : ETP ) : BOOL is -- This private predicate returns true if and only if ch is one of -- the elements of self. loop if ch = elt! then return true end end ; return false end ; count( ch : ETP ) : CARD is -- This routine returns the count of the number of 'chars' equal to the -- given argument. res : CARD := 0 ; loop if ch = elt! then res := res + 1 end end ; return res end ; private contains( code_set : CODE_STR, code : CHAR_CODE ) : BOOL is -- This private predicate returns true if and only if code is one of -- the elements of code_set. loop if code = code_set.elt! then return true end end ; return false end ; index_lib : LIBCHARS is -- This routine returns the repertoire and encoding of self. if priv_lib >= REP_LIB_LIST::lib_list.size then return void else return REP_LIB_LIST::lib_list[priv_lib] end end ; elt_eq( first, second : ETP ) : BOOL is -- This predicate returns true if and only if the two arguments are -- equal. The equality relation uses the user defined is_eq routine, if the -- argument type is a subtype of $IS_EQ. Otherwise it uses the system defined -- equality routine is used. typecase first when $IS_EQ then return first.is_eq(second) else return SYS::ob_eq(first,second) end end ; private const Hash_Prime : FIELD := 19 ; hash : CARD is -- This routine returns a hash value formed from all of the elements -- of the string. res : FIELD := FIELD::zero ; loop res := (res + (elt!.code.card.field) + ind!.field) * Hash_Prime end ; return res.card end ; substring( beg, num : CARD ) : SAME pre (size >= num) and ((size - num) >= beg) and (num > 0) post (result.size = num) is -- This routine returns as a new string using the same repertoire and encoding, -- the substring with num elements whose first element has index beg. res : SAME := create(num,index_lib) ; res.loc := num ; loop index : CARD := beg.upto!(beg + num - 1) ; res.aset((index - beg),aget(index)) end ; return res end ; plus( elem : ETP ) : SAME pre true post (result.size = (initial(size) + 1)) is -- This routine appends elem to self and returns it. return self.push(elem) end ; plus( fstr : SAME ) : SAME pre ~void(fstr) and (void(self) or (index_lib = fstr.index_lib)) post ~void(result) -- and (result.loc = (initial(self.loc) + fstr.loc)) is -- This routine appends the string fstr to self and returns the result. res : SAME ; length : CARD := fstr.loc ; if void(self) then res := create(2 * length,fstr.index_lib) elsif ((loc + length) < asize) then res := self else res := create(2 * (asize + length),index_lib) ; -- Amortised doubling res.loc := loc ; res.acopy(self) ; SYS::destroy(self) -- old one shouldn't be used now. end ; if (length = 0) then return res end ; res.loc := res.loc + length ; res.acopy(res.loc - length,fstr) ; return res end ; plus( str : STP ) : SAME pre ~void(str) and (void(self) or (index_lib = str.index_lib)) post ~void(result) and (result.loc = (initial(self.size) + str.asize)) is -- This routine appends the string str to self and returns the resulting -- string. res : SAME ; length : CARD := str.asize ; if void(self) then res := create(2 * length,str.index_lib) elsif ((loc + length) < asize) then res := self else res :=create(2 * (asize + length),index_lib) ; -- Amortised doubling res.loc := loc ; res.acopy(self) ; SYS::destroy(self) -- old one shouldn't be used now. end ; if (length = 0) then return res end ; res.acopy(res.loc,str) ; res.loc := res.loc + length ; return res end ; array : ARRAY{ETP} is -- This routine returns the contents of self as an array. res : ARRAY{ETP} := ARRAY{ETP}::create(size) ; loop res.set!(elt!) end ; return res end ; strip : SAME pre ~void(self) post (result.size <= size) is -- This routine 'strips' any number of contiguous line_marks (LF, CR, -- CR/LF, LF/CR) from the end of self -- if present. This is done by -- decrementing the value of loc. The correct operation of this routine -- depends upon the premise that any code representing a line end function -- does not have combining components! if size = 0 then return self end ; loc_end_str : CODE_STR := index_lib.Line_Mark ; last_ch : ETP ; loop if loc = 0 then break! end ; last_ch := aget(size - 1) ; if contains(loc_end_str,last_ch.code) then loc := loc - index_lib.my_size else break! end end ; return self end ; ind! : CARD pre (size > 0) post true is -- This routine yields in turn all of the element indices of self. loop yield 0.upto!(size - 1) end end ; elt! : ETP pre true post contains(result) is -- This yields each element of the string in sequence starting at -- the first element. loop yield aget(ind!) end end ; elt!( once start : CARD ) : ETP pre ~void(self) and (start < size) post true -- (result = [start + ind!]) is -- This iter yields the elements of self in order beginning with the -- character at the given starting index. Self may be modified. loop index : CARD := start.upto!(asize - 1) ; yield aget(index) end end ; elt!( once start, once num : CARD ) : ETP pre ~void(self) and ((start + num) <= size) post true -- (result = [start + ind!]) is -- This iter yields num elements of the string in sequence, starting with -- the one indexed by start. loop index : CARD := start.upto!(start + num - 1) ; yield aget(index) end end ; set!( val : ETP ) pre ~void(self) post true -- (result = [start + ind!]) is -- This iter yields having set the next element of the string in -- sequence. loop index : CARD := 0.upto!(size - 1) ; aset(index,val) end end ; code!( once start_elem : CARD ) : CHAR_CODE pre ~void(self) post (result.binstr.size = index_lib.my_size) is -- This iter yields each individual character encoding in self -- in sequence starting from the indicated element. loop elem : ETP := elt!(start_elem) ; loop yield elem.code! end end end ; code! : CHAR_CODE pre ~void(self) post (result.binstr.size = index_lib.my_size) is -- This iter yields each individual character encoding in self. loop yield code!(0) end end ; end ; -- FTEXT_STRING{ETP}