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}