string.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 STR_SEARCH{ELT}
partial class STR_SEARCH{ELT} is
--This partial class contains those string searching operations which
-- need parameterisation on the element type. This permits the use of
-- private search operations for binary and text string classes.
-- Version 1.0 May 99. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 7 May 99 kh Original
private forall(elem : ELT, from, to : CARD) : BOOL is
--This private predicate is used in testing the post-condition of
-- the searching routines which follow. It returns true if and only if
-- the test element is not found in the inclusive range given. It is
-- expensive!
loop
index : CARD := from.upto!(to) ;
if elem = [index] then
return false
end
end ;
return true
end ;
search(elem : ELT, start : CARD) : CARD
pre start < size
post (result = CARD::maxval)
or (contains(elem) and
((result = 0)or forall(elem,start,(result - 1)))
and ([result] = elem))
is
--This routine returns the index in self at which elem is first found
-- at or after index start. If not found returns CARD::maxval.
loop
index : CARD := start.upto!(size - 1) ;
if [index] = elem then
return index
end
end ;
return CARD::maxval
end ;
search(elem : ELT) : CARD
pre true
post (result = CARD::maxval)
or (contains(elem)
and ((result = 0) or forall(elem,0,(result - 1)))
and ([result] = elem))
is
--This routine returns the index of the first appearance of elem
-- in self or maxval if not found.
return search(elem,0)
end ;
search(str : SAME,start : CARD) : CARD
pre (size > 0)
--and (start < size)
--and (str.size <= size)
post (result = CARD::maxval)
or (str = substring(result,str.size))
is
--This routine returns the index of the first appearance of the entire
-- string str in self starting from the index start. CARD::maxval is
-- returned if no such position is found.
if str.size+start>size then return CARD::maxval; end;
if void(str) then return start end ;
loop
index : CARD := start.upto!(size - str.size) ;
match : BOOL := true ;
loop
if elt!(index) /= str.elt! then
match := false ;
break!
end
end ;
if match then
return index
end
end ;
return CARD::maxval
end ;
search(str : SAME) : CARD
pre (size > 0)
--and (str.size <= size)
post (result = CARD::maxval)
or (str = substring(result,str.size))
is
--This routine returns the index of the leftmost substring of self
-- which completely matches str. If there is no such position then
-- CARD::maxval is returned. Either string may be void.
return search(str,0)
end ;
search_backwards(elem : ELT,start : CARD) : CARD
pre self.size > 0
and (start < size)
post (result = CARD::maxval)
or (contains(elem)
and ((result = size - 1)
or forall(elem,(result + 1),start))
and ([result] = elem))
is
--This routine returns the index in self at which the bit-pattern elem
-- is first found starting to search backwards from index start. If not
-- found then CARD::nil is returned.
loop
index : CARD := start.downto!(0) ;
if [index] = elem then
return index
end
end ;
return CARD::nil
end ;
search_backwards(elem : ELT) : CARD
pre self.size > 0
post (result = CARD::maxval)
or (contains(elem)
and ((result = size - 1)
or forall(elem,(result + 1),(size - 1)))
and ([result] = elem))
is
--This routine returns the index of the last occurrence of elem in
-- self -- or CARD::nil if not found at all.
return search_backwards(elem,size - 1)
end ;
end ; -- STR_SEARCH{ELT}
partial class STRING_IMPL{ELT,FSTP}
partial class STRING_IMPL{ELT,FSTP} is
--This partial class implements all those operations which are common
-- to all forms of string, irrespective of the element or whether it is
-- immutable or not. it is provided for inclusion in strings which may or
-- may not also include filtering features.
-- Version 1.1 Sep 2001. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 10 May 99 kh Original from STRING class
-- 21 Sep 01 kh Added nil/is_nil
include AREF{ELT} create -> aref_create ;
include COMPARABLE ;
include COMPARE{ELT} ;
stub create : SAME ;
--This routine creates a new empty (nil) string.
stub size : CARD ;
--This routine returns the size as a number of string elements, not the
-- storage size in octets -- which may be different.
stub is_eq(other : SAME) : BOOL ;
--This stub ensures that a common equality predicate is made available
-- in the instantiating class which may be used in this partial class.
is_nil : BOOL is
-- This predicate returns true if and only if the string is empty.
return ~void(self) and size = 0
end ;
nil : SAME is
-- This predicate returns true if and only if the string is empty.
return create
end ;
acopyn(fstr : FSTP,cnt : CARD)
pre (cnt <= fstr.size)
post (self.asize = fstr.size) -- and contents the same!
is
--This routine copies cnt octets from octstr into self.
builtin STR_ACOPY_FSTR_CARD
end ;
acopyn(str : SAME,cnt : CARD) is
--This routine copies cnt items from str into self or as many as will
-- fit if self is not large enough.
builtin STR_ACOPY_STR_CARD
end ;
acopy(src : $STRINGS)
pre ~void(self) and ~void(src)
post true
is
--This routine copies as many elements from src to self as will fit.
builtin AREF_ACOPY
end ;
copy : SAME
pre ~void(self)
post ~void(result)
is
--This routine returns an identical copy of self.
res : SAME := create(asize) ;
res.acopyn(self,self.size) ;
return res
end ;
is_prefix(other : SAME) : BOOL is
--This predicate returns true if and only if other is identical to the
-- bit-pattern starting at the beginning of self.
if size < other.size then
return false
else
return head(other.size) = other
end
end ;
is_empty : BOOL is
--This predicate returns true if and only if self is an empty string.
return (size = 0)
end ;
has_ind(val : CARD) : BOOL is
--This predicate returns true if and only if self may be indexed by the given value.
return val < size
end ;
from_fstr(fstr : FSTP) : SAME
pre ~void(fstr)
post (result.size = fstr.size)
is
--This routine converts the given fast character string into the normal
-- string form (which has immutable semantics).
res : SAME := create(fstr.loc) ;
res.acopyn(fstr,fstr.loc) ;
return res
end ;
private append_destroy(src : SAME,destroy : BOOL) : SAME
pre true
post ((size = 0) and (result = initial(src)))
or ((initial(src.asize) = 0) and (result = self))
or (result.asize = (self.asize + initial(src.asize)))
is
--This private auxiliary routine appends src to self and destroys src
-- if the second parameter is true.
res : SAME ;
if size = 0 then
return src
else
sz : CARD := src.asize ;
if sz = 0 then
return self
else
res := new(asize + sz) ;
res.acopy(self) ;
res.acopy(asize,src)
end
end ;
if destroy
and ~void(src) then -- 'src' was just a temporary
SYS::destroy(src)
end ;
return res
end ;
append(src : SAME) : SAME
pre true
post (result.size = (self.size + src.size))
and (result.head(self.size) = self)
and (result.tail(src.size) = src)
is
-- This routine returns a new string formed by appending src to self.
-- Either src or self may be void.
if void(self) then
return src
end ;
if void(src) then
return self
end ;
selfsize : CARD := asize ;
ssize : CARD := src.asize ;
res : SAME := new(selfsize + ssize) ;
res.acopy(self) ;
res.acopy(selfsize,src) ;
return res
end ;
plus(elem : ELT) : SAME
pre true
post (result.size = (self.size + 1))
and (result.aget(result.asize - 1) = elem)
is
-- This routine returns a new string consisting of the contents
-- of self with elem appended to it.
src : SAME := create(elem) ;
return append_destroy(src, true)
end ;
plus(str : SAME) : SAME
pre true
post (result.size = (self.size + initial(str.size)))
is
-- This routine returns a new string made up of self with str appended.
return append_destroy(str, false)
end ;
plus(fstr : FSTP) : SAME
pre true
post (result.size = (self.size + initial(fstr.size)))
is
-- This routine returns a new string made up of self with fstr appended.
return append_destroy(from_fstr(fstr),true)
end ;
private stub store_index(elem_index : CARD) : CARD ;
--This routine returns the store index corresponding to the given
--element_index for use where they may be different).
substring(beg, num : CARD) : SAME
pre ~void(self) and ((beg + num) <= size)
post true -- (result.size = num) Problem with text div by 0
is
--This routine returns the substring of num elements of self beginning
-- with the one whose index is beg.
if num = 0 then -- just an empty string!
return create
end ;
loc_start : CARD := store_index(beg) ;
loc_length : CARD ;
if (beg + num) = size then
loc_length := asize - loc_start
else
loc_length := store_index(beg + num) - loc_start
end ;
if loc_length = 0 then
return create
end ;
res : SAME := new(loc_length) ;
res.acopy(0,loc_length,loc_start,self) ;
return res
end ;
head(cnt : CARD) : SAME
pre ~void(self) and (cnt <= size)
post (result.size = cnt) and ((cnt = 0) or (result[0] = self[0]))
is
--This routine returns either cnt elements from the head of self or
-- the contents of self if that is shorter. If cnt is zero then self may
-- be void.
return substring(0,cnt)
end ;
tail(cnt : CARD) : SAME
pre ~void(self) and (cnt <= size)
post (result.size = cnt)
and ((cnt = 0) or (result[0] = self[size - cnt]))
is
--This routine returns either cnt elements from the end of self or
-- the contents of self if that is shorter. If cnt is zero then self may
-- be void.
if cnt = 0 then -- just an empty string!
return create
else
return substring(size - cnt,cnt)
end
end ;
contains(elem : ELT) : BOOL is
--This predicate returns true if and only if at least one of
-- the elements of self has the value elem, otherwise false.
loop
if elt! = elem then
return true
end
end ;
return false
end ;
private to_reverse is
-- This private routine is the one which actually reverses the contents.
loop
high : CARD := (size - 1).downto!(0) ;
low : CARD := 0.up! ;
if high <= low then
return
end ;
temp : ELT := aget(high) ;
aset(high,aget(low)) ;
aset(low,temp)
end
end ;
reverse : SAME
pre (self.size > 0)
post [0] = result[size - 1] -- and the others!
is
-- This routine returns a string which has the value of self with all
-- elements in the reverse order.
res : SAME := create(asize) ;
res.acopy(self) ;
res.to_reverse ;
return res
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 ;
private sum_OK(arry : ARRAY{SAME}) : BOOL is
-- This is an auxiliary predicate only used in the post-condition test
-- for the following routine. It is very expensive!
loc_tmp : SAME := self ;
loop
loc_index : CARD := arry.ind! ;
loc_size : CARD := arry[loc_index].size ;
loc_head : SAME := loc_tmp.head(loc_size) ;
if ~(arry[loc_index] = loc_head) then
return false
end ;
loc_tmp := loc_tmp.tail(loc_tmp.size - loc_size)
end ;
return true
end ;
concat_all(arry : ARRAY{SAME}) : SAME
pre arry.size > 0
post result.sum_OK(arry)
is
-- This routine returns the string formed by concatenating the array of
-- strings given as parameter. There is NO separator.
res : SAME := create ;
cnt : CARD := arry.size ;
loop
index : CARD := 0.upto!(cnt - 1) ;
res := res + arry[index]
end ;
return res
end ;
count(elem : ELT) : CARD
pre true
post result <= size
is
-- This routine returns a count of the number of occurrences of the
-- bit-pattern elem in self.
cnt : CARD := 0 ;
loop
if elt! = elem then
cnt := cnt + 1
end
end ;
return cnt
end ;
count(str : SAME) : CARD
pre ~void(self) and ~void(str)
post result <= size
is
-- This routine returns the number of times that any element in
-- str appears in self. Self may be void.
cnt : CARD := 0 ;
loop
if str.contains(elt!) then
cnt := cnt + 1
end
end ;
return cnt
end ;
private pairwise(other : SAME, last : CARD) : BOOL is
-- This private predicate is used in the post-condition of routines
-- below. It returns true if and only if the elements of self and other are
-- identical up to and not including last.
loop
index : CARD := 0.upto!(last - 1) ;
if [index] /= other[index] then
return false
end
end ;
return (last = other.size) or ([last] /= other[last])
end ;
mismatch(other : SAME) : CARD
pre true
post (other.is_prefix(self) and (result = CARD::maxval))
or (result = 0)
or pairwise(other,result)
is
-- This routine returns the index of the first octet in self which has
-- a different element value from other or CARD::maxval if self is a prefix of other.
-- Either string may be void.
if void(other) then
return 0
elsif other.is_prefix(self) then
return CARD::maxval
end ;
index : CARD ;
loop
index := ind! ;
if [index] /= other.elt! then
return index
end
end ;
return index
end ;
ind! : CARD
pre size >= 0
post true
is
-- This routine yields in turn all of the element indices of self.
if size = 0 then
quit
end ;
loop
yield 0.upto!(size - 1)
end
end ;
elt! : ELT
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 ) : ELT
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!(size - 1) ;
yield aget(index)
end
end ;
elt!(once start, once num : CARD) : ELT
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!(elem : ELT)
pre ~void(self)
post contains(elem) -- [ind!] = ch
is
-- This iter sets the elements of self in order.
loop
aset(ind!,elem) ;
yield
end
end ;
chunk!( once start : CARD, chunk_size : CARD) : SAME
pre ((start + chunk_size) <= self.size)
and (chunk_size > 0)
post (result.size = chunk_size)
is
-- This iter yields successive groups of elements starting at start,
-- the length of which is defined by the chunk_size parameter.
cur_loc : CARD := start ;
str_sz : CARD := size ;
loop
until!(cur_loc >= str_sz) ;
res : SAME := substring(cur_loc,chunk_size) ;
cur_loc := cur_loc + chunk_size ;
yield res
end
end ;
chunk!(chunk_size : CARD) : SAME
pre (chunk_size > 0)
post (result.size = chunk_size)
is
-- This iter yields successive groups of octets the length of which
-- is defined by the chunk_size parameter.
cur_loc : CARD := 0 ;
str_sz : CARD := size ;
loop
until!(cur_loc >= str_sz) ;
res : SAME := substring(cur_loc,chunk_size) ;
cur_loc := cur_loc + chunk_size ;
yield res
end
end ;
end ; -- STRING_IMPL{ELT,FSTP}
partial class STRING{ELT,FSTP}
partial class STRING{ELT,FSTP} is
-- This partial class contains all those operations which are common
-- to all forms of string, irrespective of the element or whether it is
-- immutable or not
-- Version 1.2 May 99. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 10 Jan 97 kh Original
-- 14 Oct 98 kh Added pre/post conditions
include STRING_IMPL{ELT,FSTP} ;
include ELT_FILTERS{ELT} ;
-- The above two inclusions provide for generic simple strings to offer
-- the filtering features of ELT_FILTERS.
end ; -- STRING(ELT,FSTP}
partial class TEXT_STRING{ELT,FSTP}
partial class TEXT_STRING{ELT,FSTP} is
-- This partial class contains all those operations which are common
-- to all forms of text string, irrespective of the form or encoding.
-- NOTE The storage of the content is in octets, rather than whatever the
-- character coding may be.
-- Version 1.0 Apr 99. Copyright K Hopper, U of Waikato
-- Development History
-- -------------------
-- Date Who By Detail
-- ---- ------ ------
-- 12 Apr 99 kh Original for Version 8 of text classes.
include STRING_IMPL{OCTET,FSTP}
append_destroy ->,
from_fstr ->,
substring -> private oct_substr,
aget -> private oct_aget,
aset -> private oct_aset,
plus ->,
reverse ->,
set! -> ,
contains->,
count ->
;
count(str : SAME) : CARD
pre ~void(self) and ~void(str)
post result <= size
is
-- This routine returns the number of times that any element in
-- str appears in self. Self may be void.
cnt : CARD := 0 ;
loop
if str.contains(elt!) then
cnt := cnt + 1
end
end ;
return cnt
end ;
include STR_SEARCH{ELT} ;
include COLLATE ;
include BINARY ;
include ELT_FILTERS{ELT} ;
private attr priv_lib : CARD ;
-- This attribute is the index of the repertoire and encoding of self
-- in the global repertoire list.
stub convert(lib : LIBCHARS) : SAME ;
-- This routine converts self to be in the given encoding and repertoire.
private stub do_replace(old_ch, new_ch : ELT) : SAME ;
-- This private routine is the one which does the actual replacement
-- of old_ch by new_ch.
stub replace(set : SAME, new_ch : ELT) : SAME ;
-- This routine replaces the occurrence of any element of str in self
-- by the new character given.
stub escape(escape_ch : ELT, elem_set : SAME) : SAME ;
-- This routine provides a version of self in which all elements equal
-- to the escape are preceded by another escape element and any element in
-- the given element-set is also preceded by an escape element.
stub char(index : CARD) : ELT ;
-- This routine returns the character at the given postion in the string.
stub binstr : BINSTR ;
-- This routine returns the value of self represented as a binary string
-- suitable for external storage.
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 the data in the string
-- is notan exact multiple of the required encoding size then void is returned
-- and the cursor has not been moved.
loc_size : CARD := cursor.remaining ;
if loc_size.mod(lib.my_size) > 0 then
return void
end ;
res : SAME := create(loc_size/lib.my_size,lib) ;
res.acopy(cursor.get_remainder) ;
res.buffer_scan ;
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 a character string from the indicated binary
-- string using the default character repertoire and encoding.
return build(cursor,LIBCHARS::default)
end ;
copy : SAME
pre ~void(self)
post ~void(result)
is
-- This routine returns an identical copy of self.
res : SAME := create(asize,index_lib) ;
res.acopyn(self,self.size) ;
res.buffer_scan ;
return res
end ;
index_lib : LIBCHARS is
-- This routine returns the repertoire which is associated with self.
if priv_lib >= REP_LIB_LIST::lib_list.size then
loc_res : LIBCHARS := LIBCHARS::default ;
width := loc_res.my_size ;
priv_lib := REP_LIB_LIST::index(loc_res) ;
end ;
return REP_LIB_LIST::lib_list[priv_lib]
end ;
from_fstr(fstr : FSTP) : SAME
pre ~void(fstr)
post (result.size = fstr.size)
is
-- This routine converts the given fast character string into the normal
-- string form (which has immutable semantics).
res : SAME := create(fstr.loc,fstr.index_lib) ;
res.acopyn(fstr,fstr.loc) ;
res.buffer_scan ;
return res
end ;
count(elem : ELT) : CARD
pre true
post result <= size
is
-- This routine returns a count of the number of occurrences of the
-- 'character' elem in self.
cnt : CARD := 0 ;
loop
if elt! = elem then
cnt := cnt + 1
end
end ;
return cnt
end ;
elt_eq(first, second : ELT) : 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.
typecase first
when $IS_EQ then
return first.is_eq(second)
else
return SYS::ob_eq(first,second)
end
end ;
private append_destroy(src : SAME, destroy : BOOL) : SAME
pre void(self)
or (priv_lib = src.priv_lib)
post true --(result.size = (initial(size) + initial(src.size)))
is
-- This private auxiliary routine appends src to self and destroys src
-- if the second parameter is true.
res : SAME ;
if size = 0 then
return src
else
if src.size = 0 then
return self
else
res := create(size + src.size,index_lib) ;
res.acopy(self) ;
res.acopy(self.asize,src)
end
end ;
if destroy
and ~void(src) then -- 'src' was just a temporary
SYS::destroy(src)
end ;
res.buffer_scan ;
return res
end ;
plus(elem : ELT) : SAME
pre true
post (result.size = (initial(size) + 1))
is
-- This routine returns a new string consisting of the contents
-- of self with elem appended to it.
loc_lib : LIBCHARS ;
if void(self) then
loc_lib := LIBCHARS::default
else
loc_lib := index_lib
end ;
src : SAME := create(elem.code(loc_lib)) ;
src.buffer_scan ;
return append_destroy(src, true)
end ;
plus(str : SAME) : SAME
pre (index_lib = str.index_lib)
post (result.size = (self.size + str.size))
is
-- This routine returns a new string made up of self with str appended.
return append_destroy(str,false)
end ;
plus(fstr : FSTP) : SAME
pre (index_lib = fstr.index_lib)
post (result.size = (initial(self.size) + fstr.size))
and (result.head(self.size) = self)
is
-- This routine returns a new string made up of self with str appended.
return append_destroy(from_fstr(fstr),true)
end ;
minus(str : SAME,start : CARD) : SAME
pre ~void(self)
and ~void(str)
and (start < size)
and (index_lib = str.index_lib)
post (void(str)
and (result = self))
or ((result.size + str.size) = size)
is
-- This routine returns a copy of self in which the first occurrence
-- of str after the given start index (if any) is deleted.
loc : CARD := search(str,start) ;
if loc = CARD::maxval then -- Not found!
return self
else
return head(loc) + tail(size - (loc + str.size))
end
end ;
minus(str : SAME) : SAME
pre ~void(self)
and (index_lib = str.index_lib)
post (void(str)
and (result = self))
or (self.contains(str[0])
and ((result.size + str.size) = size))
is
-- This routine returns a copy of self with the first (if any)
-- occurrence of str deleted.
return minus(str,0)
end ;
is_upper : BOOL is
-- This predicate returns true if and only if every character of self is
-- upper-case, otherwise false. Self may be void.
loop
if ~elt!.is_upper then
return false
end
end ;
return true
end ;
is_lower : BOOL is
-- This predicate returns true if and only if every character of self is
-- lower-case, otherwise false. Self may be void.
loop
if ~elt!.is_lower then
return false
end
end ;
return true
end ;
upper : SAME
pre ~void(self)
post (result.size = size)
is
-- This routine returns a copy of self in which every lower case
-- character is converted to its upper case equivalent.
res : SAME := create(size,index_lib) ;
loop
index : CARD := 0.upto!(size - 1) ;
loc_ch : ELT := elt! ;
if loc_ch.is_lower(index_lib) then
loc_ch := loc_ch.upper(index_lib)
end ;
res[index] := loc_ch
end ;
return res
end ;
lower : SAME
pre ~void(self)
post void(result)
or (result.upper = upper)
is
-- This routine returns a copy of self in which every upper case
-- character is converted to its lower case equivalent.
res : SAME := create(size,index_lib) ;
loop
index : CARD := 0.upto!(size - 1) ;
loc_ch : ELT := elt! ;
if loc_ch.is_upper(index_lib) then
loc_ch := loc_ch.lower(index_lib)
end ;
res[index] := loc_ch
end ;
return res
end ;
capitalize : SAME
pre true
post (result.size = size) -- and case changes done!
is
-- This returns a copy of self in which the first character of every word
-- (starting at the beginning of the string or after punctuation or
-- a whitespace) is converted to its upper case equivalent. Self may
-- be void.
if void(self) then
return void
end ;
res : SAME := create(asize,index_lib) ;
word_start : BOOL := true ;
index : CARD := 0 ;
loop
ch : ELT := elt! ;
if word_start
and ch.is_lower then
ch := ch.upper
end ;
word_start := ch.is_punct
or ch.is_space ;
res[index] := ch ;
index := index + 1
end ;
return res
end ;
line_mark : SAME is
-- This routine returns the line mark corresponding to the culture of
-- self (or the default if self is void).
loc_lib : LIBCHARS ;
if void(self) then
loc_lib := LIBCHARS::default
else
loc_lib := index_lib
end ;
return create(loc_lib.Line_Mark.tgt_str)
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 ;
repeat(cnt : CARD) : SAME
pre ~void(self)
and (cnt > 0)
post (result.size = (self.size * cnt))
is
-- This routine returns a new string which contains the contents of
-- self repeated cnt times.
res : SAME := create(asize * cnt,index_lib) ;
loop
res.acopy(0.step!(cnt,asize.int),self)
end ;
res.buffer_scan ;
return res
end ;
replace(old_ch,new_ch : ELT) : SAME
pre true
post ((old_ch = new_ch)
and (result = self))
or (result.size = initial(size))
is
-- This routine returns a new string of runes which is a copy of self in
-- which each occurrence of old_rn has been replaced by new_rn. Self may be void.
if old_ch = new_ch then
return copy
else
return do_replace(old_ch,new_ch)
end
end ;
remove(ch : ELT) : SAME
pre ~void(self)
post ~result.contains(ch)
is
-- This routine returns a copy of self with all occurrences of ch
-- removed. If the result would be empty then void is returned.
remove_length : CARD := count(ch) ;
if remove_length = 0 then
return copy
end ;
new_size : CARD := asize - remove_length ;
if new_size = 0 then
return void
else
res : SAME := create(new_size,index_lib) ;
index : CARD := 0 ;
loop
test_ch : ELT := elt! ;
if ~(test_ch = ch) then
res.aset(index,test_ch) ;
index := index + 1
end
end ;
res.buffer_scan ;
return res
end
end ;
contains(elem : ELT) : BOOL is
-- This predicate returns true if and only if at least one of
-- the elements of self has the value elem, otherwise false.
if void(self) then
return false
end ;
loop
if elt! = elem then
return true
end
end ;
return false
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 ;
contains(substr : SAME) : BOOL is
-- This predicate returns true if and only if the given argument is
-- a substring of self under the same coding scheme.
if (substr.priv_lib /= priv_lib)
or (substr.size > size) then
return false
end ;
loc_index : CARD := 0 ;
inner : CARD ;
max_sub_index : CARD := substr.size - 1 ; -- avoid re-calculation!
last_start : CARD := (size - 1) - max_sub_index ;
loop
next_start : CARD := 1.up! ;
loc_ch : ELT := [loc_index] ;
next_ch : ELT ;
loop
inner := substr.ind! ;
next_ch := substr[inner] ;
loc_index := loc_index + 1 ;
if loc_ch = next_ch then
if inner = max_sub_index then
return true
else
loc_ch := [loc_index]
end
else
loc_index := next_start ;
break!
end
end ;
if loc_index > last_start then
return false
end
end
end ;
remove(str : SAME) : SAME
pre ~void(self)
and ~void(str)
and (priv_lib = str.priv_lib)
post (void(self)
and void(result))
or ((void(str)
or (count(str) = 0))
and (result = self))
or (result.size = (self.size - count(str)))
is
-- This routine is a copy of self from which all characters contained
-- in str have been removed.
res : SAME := SAME::create(0,index_lib) ;
loop
ch : ELT := elt! ;
if ~str.contains(ch) then
res := res + ch
end
end ;
res.buffer_scan ;
return res
end ;
strip : SAME
pre ~void(self)
post true
is
-- This routine strips any number of contiguous line_marks (LF, CR,
-- CR/LF, LF/CR) from the end of self -- if present -- returning the result.
if size = 0 then
return self
end ;
loc_end_str : CODE_STR := index_lib.Line_Mark ;
last_ch : ELT ;
loc_cnt : CARD := 0 ;
loc_size : CARD := size ;
loop
if loc_cnt = loc_size then
return create(0,index_lib)
end ;
last_ch := aget(loc_size - loc_cnt - 1) ;
if contains(loc_end_str,last_ch.code) then
loc_cnt := loc_cnt + 1
else
break!
end
end ;
res : SAME := head(size - loc_cnt) ;
res.buffer_scan ;
return res
end ;
private to_reverse is
-- This private routine is the one which actually reverses the contents
-- of the string.
dummy : LIBCHARS := index_lib ;
if void(index_lib) then -- it is a string literal!
priv_lib := REP_LIB_LIST::index(LIBCHARS::default)
end ;
loop
high : CARD := (size - 1).downto!(0) ;
low : CARD := 0.up! ;
if high <= low then
return
end ;
temp : ELT := aget(high) ;
aset(high,aget(low)) ;
aset(low,temp)
end
end ;
reverse : SAME
pre (self.size > 0)
post [0] = result[size - 1] -- and the others!
is
-- This routine returns a string which has the value of self with all
-- elements in the reverse order.
res : SAME := create(asize,index_lib) ;
res.acopy(self) ;
res.buffer_scan ;
res.to_reverse ;
return res
end ;
substring(beg, num : CARD) : SAME
pre ~void(self)
and ((beg + num) <= size)
post (result.size = num)
is
-- This routine returns the substring of num elements of self beginning
-- with the one whose index is beg.
loc_width : CARD := width ; -- in case self is destroyed!
res : SAME := oct_substr(beg,num) ;
res.width := loc_width ;
res.buffer_scan ;
return res
end ;
elt! : ELT
pre ~void(self)
post true
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 ) : ELT
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!(size - 1) ;
yield aget(index)
end
end ;
elt!( once start, once num : CARD) : ELT
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!(elem : ELT)
pre ~void(self)
post true
is
-- This iter sets the elements of self in order.
loop
aset(ind!,elem) ;
yield
end
end ;
rev! : ELT
pre ~void(self)
post contains(result) -- (result = [size - 1 - ind!])
is
-- This iter yields the elements of self in reverse order, starting with
-- the last element.
loop
index : CARD := (size - 1).downto!(0) ;
yield aget(index)
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.
loop
loc_elem : ELT := elt!(start_elem) ;
loop
yield loc_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
-- in sequence using the code specified repertoire and encoding. This does
-- NOT change the bit-patterns from those in self.
loop
yield code!(0)
end
end ;
end ; -- TEXT_STRING{ELT}