/****************************************************************************
* *
* * This file is part of GAP , a system for computational discrete algebra .
* *
* * Copyright of GAP belongs to its developers , whose names are too numerous
* * to list here . Please refer to the COPYRIGHT file for details .
* *
* * SPDX - License - Identifier : GPL - 2 . 0 - or - later
* *
* * This file contains the functions which mainly deal with strings .
* *
* * A * string * is a list that has no holes , and whose elements are all
* * characters . For the full definition of strings see chapter " Strings " in
* * the { \ GAP } manual . Read also " More about Strings " about the string flag
* * and the compact representation of strings .
* *
* * A list that is known to be a string is represented by a bag of type
* * ' T_STRING ' , which has the following format :
* *
* * + - - - - - - - - + - - - - + - - - - + - - - - + - - - - + - - - - +
* * | length | 1 st | 2 nd | | last | null |
* * | as UInt | char | char | | char | char |
* * + - - - - - - - - + - - - - + - - - - + - - - - + - - - - + - - - - +
* *
* * Each entry is a single character ( of C type ' unsigned char ' ) . The last
* * entry in the bag is the null character ( ' \ 0 ' ) , which terminates C
* * strings . We add this null character although the length is stored in the
* * object . This allows to use C routines with strings directly with null
* * character free strings ( e . g . , filenames ) .
* *
* * Note that a list represented by a bag of type ' T_PLIST ' might still be a
* * string . It is just that the kernel does not know this .
* *
* * This package consists of three parts .
* *
* * The first part consists of the functions ' NEW_STRING ' , ' CHARS_STRING ' ( or
* * ' CSTR_STRING ' ) , ' GET_LEN_STRING ' , ' SET_LEN_STRING ' , and more . These and
* * the functions below use the detailed knowledge about the representation
* * of strings .
* *
* * The second part consists of the functions ' LenString ' , ' ElmString ' ,
* * ' ElmsStrings ' , ' AssString ' , ' AsssString ' , PlainString ' ,
* * and ' IsPossString ' . They are the functions required by the generic lists
* * package . Using these functions the other parts of the { \ GAP } kernel can
* * access and modify strings without actually being aware that they are
* * dealing with a string .
* *
* * The third part consists of the functions ' PrintString ' , which is called
* * by ' FuncPrint ' , and ' IsString ' , which test whether an arbitrary list is a
* * string , and if so converts it into the above format .
*/
#include "stringobj.h"
#include "ariths.h"
#include "bool.h"
#include "error.h"
#include "gaputils.h"
#include "io.h"
#include "listfunc.h"
#include "lists.h"
#include "modules.h"
#include "opers.h"
#include "plist.h"
#include "range.h"
#include "saveload.h"
#include "sysstr.h"
#ifdef HPCGAP
#include "hpc/guards.h"
#endif
/****************************************************************************
* *
* F * * * * * * * * * * * * * * character functions * * * * * * * * * * * * *
*/
/****************************************************************************
* *
* V ObjsChar [ < chr > ] . . . . . . . . . . . . . . . . table of character values
* *
* * ' ObjsChar ' contains all the character values . That way we do not need to
* * allocate new bags for new characters .
*/
Obj ObjsChar [256 ];
/****************************************************************************
* *
* F TypeChar ( < chr > ) . . . . . . . . . . . . . . . type of a character value
* *
* * ' TypeChar ' returns the type of the character < chr > .
* *
* * ' TypeChar ' is the function in ' TypeObjFuncs ' for character values .
*/
static Obj TYPE_CHAR;
static Obj TypeChar(Obj chr)
{
return TYPE_CHAR;
}
/****************************************************************************
* *
* F EqChar ( < charL > , < charR > ) . . . . . . . . . . . compare two characters
* *
* * ' EqChar ' returns ' true ' if the two characters < charL > and < charR > are
* * equal , and ' false ' otherwise .
*/
static Int EqChar(Obj charL, Obj charR)
{
return CHAR_VALUE(charL) == CHAR_VALUE(charR);
}
/****************************************************************************
* *
* F LtChar ( < charL > , < charR > ) . . . . . . . . . . . compare two characters
* *
* * ' LtChar ' returns ' true ' if the character < charL > is less than the
* * character < charR > , and ' false ' otherwise .
*/
static Int LtChar(Obj charL, Obj charR)
{
return CHAR_VALUE(charL) < CHAR_VALUE(charR);
}
/****************************************************************************
* *
* F PrintChar ( < chr > ) . . . . . . . . . . . . . . . . . . print a character
* *
* * ' PrChar ' prints the character < chr > .
*/
static void PrintChar(Obj val)
{
UChar chr;
chr = CHAR_VALUE(val);
if ( chr == '\n' ) Pr("'\\n'" , 0 , 0 );
else if ( chr == '\t' ) Pr("'\\t'" , 0 , 0 );
else if ( chr == '\r' ) Pr("'\\r'" , 0 , 0 );
else if ( chr == '\b' ) Pr("'\\b'" , 0 , 0 );
else if ( chr == '\01' ) Pr("'\\>'" , 0 , 0 );
else if ( chr == '\02' ) Pr("'\\<'" , 0 , 0 );
else if ( chr == '\03' ) Pr("'\\c'" , 0 , 0 );
else if ( chr == '\' ' ) Pr("' \\'' ", 0, 0);
else if ( chr == '\\' ) Pr("'\\\\'" , 0 , 0 );
/* print every non-printable on non-ASCII character in three digit
* notation */
/* old version (changed by FL)
else if ( chr = = ' \ 0 ' ) Pr ( " ' \ \ 0 ' " , 0 , 0 ) ;
else if ( chr < 8 ) Pr ( " ' \ \ 0 % d ' " , ( Int ) ( chr & 7 ) , 0 ) ;
else if ( chr < 32 ) Pr("'\\0%d%d'",(Int)(chr/8),(Int)(chr&7));*/
else if ( chr < 32 || chr > 126 ) {
Pr("'\\%d%d" , (Int )((chr & 192 ) >> 6 ), (Int )((chr & 56 ) >> 3 ));
Pr("%d'" , (Int )(chr&7 ), 0 );
}
else Pr("'%c'" ,(Int )chr, 0 );
}
/****************************************************************************
* *
* F SaveChar ( < char > ) . . . . . . . . . . . . . . . . . . save a character
* *
*/
#ifdef GAP_ENABLE_SAVELOAD
static void SaveChar(Obj c)
{
SaveUInt1( CHAR_VALUE(c));
}
#endif
/****************************************************************************
* *
* F LoadChar ( < char > ) . . . . . . . . . . . . . . . . . . load a character
* *
*/
#ifdef GAP_ENABLE_SAVELOAD
static void LoadChar(Obj c)
{
SET_CHAR_VALUE(c, LoadUInt1());
}
#endif
/****************************************************************************
* *
* F * * * * * * * * * * * * * * GAP level functions * * * * * * * * * * * * *
*/
/****************************************************************************
* *
* F FuncEmptyString ( < self > , < len > ) . . . . . . . . empty string with space
* *
* * Returns an empty string , with space for < len > characters preallocated .
* *
*/
static Obj FuncEmptyString(Obj self, Obj len)
{
Obj new ;
RequireNonnegativeSmallInt(SELF_NAME, len);
new = NEW_STRING(INT_INTOBJ(len));
SET_LEN_STRING(new , 0 );
return new ;
}
/****************************************************************************
* *
* F FuncShrinkAllocationString ( < self > , < str > ) . . give back unneeded memory
* *
* * Shrinks the bag of < str > to minimal possible size ( possibly converts to
* * compact representation ) .
* *
*/
static Obj FuncShrinkAllocationString(Obj self, Obj str)
{
RequireStringRep(SELF_NAME, str);
SHRINK_STRING(str);
return (Obj)0 ;
}
/****************************************************************************
* *
* F FuncCHAR_INT ( < self > , < int > ) . . . . . . . . . . . . . . char by integer
*/
static Obj FuncCHAR_INT(Obj self, Obj val)
{
Int chr;
// get and check the integer value
chr = GetBoundedInt(SELF_NAME, val, 0 , 255 );
// return the character
return ObjsChar[chr];
}
/****************************************************************************
* *
* F FuncINT_CHAR ( < self > , < char > ) . . . . . . . . . . . . . integer by char
*/
static Obj FuncINT_CHAR(Obj self, Obj val)
{
// get and check the character
if (TNUM_OBJ(val) != T_CHAR) {
RequireArgument(SELF_NAME, val, "must be a character" );
}
// return the character
return INTOBJ_INT(CHAR_VALUE(val));
}
/****************************************************************************
* *
* F FuncCHAR_SINT ( < self > , < int > ) . . . . . . . . . . char by signed integer
*/
static Obj FuncCHAR_SINT(Obj self, Obj val)
{
Int chr;
// get and check the integer value
chr = GetBoundedInt(SELF_NAME, val, -128 , 127 );
// return the character
return ObjsChar[CHAR_SINT(chr)];
}
/****************************************************************************
* *
* F FuncSINT_CHAR ( < self > , < char > ) . . . . . . . . . signed integer by char
*/
static Obj FuncSINT_CHAR(Obj self, Obj val)
{
// get and check the character
if (TNUM_OBJ(val) != T_CHAR) {
RequireArgument(SELF_NAME, val, "must be a character" );
}
// return the character
return INTOBJ_INT(SINT_CHAR(CHAR_VALUE(val)));
}
/****************************************************************************
* *
* F FuncSINTLIST_STRING ( < self > , < string > ) signed integer list by string
*/
static Obj FuncINTLIST_STRING(Obj self, Obj val, Obj sign)
{
UInt l,i;
Obj n, *addr;
const UInt1 *p;
// test whether val is a string, convert to compact rep if necessary
RequireStringRep(SELF_NAME, val);
l=GET_LEN_STRING(val);
n=NEW_PLIST(T_PLIST,l);
SET_LEN_PLIST(n,l);
p=CONST_CHARS_STRING(val);
addr=ADDR_OBJ(n);
// signed or unsigned ?
if (sign == INTOBJ_INT(1 )) {
for (i=1 ; i<=l; i++) {
addr[i] = INTOBJ_INT(p[i-1 ]);
}
}
else {
for (i=1 ; i<=l; i++) {
addr[i] = INTOBJ_INT(SINT_CHAR(p[i-1 ]));
}
}
CHANGED_BAG(n);
return n;
}
static Obj FuncSINTLIST_STRING(Obj self, Obj val)
{
return FuncINTLIST_STRING(self, val, INTOBJ_INT(-1 ));
}
/****************************************************************************
* *
* F FuncSTRING_SINTLIST ( < self > , < string > ) string by signed integer list
*/
static Obj FuncSTRING_SINTLIST(Obj self, Obj val)
{
UInt l,i;
Int low, inc;
Obj n;
UInt1 *p;
/* there should be a test here, but how do I check cheaply for list of
* integers ? */
// general code
if (!IS_RANGE(val) && !IS_PLIST(val)) {
again:
RequireArgument(SELF_NAME, val,
"must be a plain list of small integers or a range" );
}
if (! IS_RANGE(val) ) {
l=LEN_PLIST(val);
n=NEW_STRING(l);
p=CHARS_STRING(n);
for (i=1 ;i<=l;i++) {
Obj x = ELM_PLIST(val,i);
if (!IS_INTOBJ(x))
goto again;
*p++=CHAR_SINT(INT_INTOBJ(x));
}
}
else {
l=GET_LEN_RANGE(val);
low=GET_LOW_RANGE(val);
inc=GET_INC_RANGE(val);
n=NEW_STRING(l);
p=CHARS_STRING(n);
for (i=1 ;i<=l;i++) {
*p++=CHAR_SINT(low);
low=low+inc;
}
}
return n;
}
/****************************************************************************
* *
* F FuncREVNEG_STRING ( < self > , < string > ) string by signed integer list
*/
static Obj FuncREVNEG_STRING(Obj self, Obj val)
{
UInt l,i,j;
Obj n;
const UInt1 *p;
UInt1 *q;
// test whether val is a string, convert to compact rep if necessary
RequireStringRep(SELF_NAME, val);
l=GET_LEN_STRING(val);
n=NEW_STRING(l);
p=CONST_CHARS_STRING(val);
q=CHARS_STRING(n);
j=l-1 ;
for (i=1 ;i<=l;i++) {
*q++=-p[j];
j--;
}
return n;
}
/****************************************************************************
* *
* F * * * * * * * * * * * * * * * string functions * * * * * * * * * * * * * *
*/
/****************************************************************************
* *
* F NEW_STRING ( < len > ) . . . returns new string with length < len > , first
* * character and " first behind last " set to zero
* *
*/
Obj NEW_STRING(Int len)
{
GAP_ASSERT(len >= 0 );
if (len > INT_INTOBJ_MAX) {
ErrorQuit("NEW_STRING: length must be a small integer" , 0 , 0 );
}
Obj res = NewBag(T_STRING, SIZEBAG_STRINGLEN(len));
SET_LEN_STRING(res, len);
return res;
}
/****************************************************************************
* *
* F GrowString ( < list > , < len > ) . . . . . . make sure a string is large enough
* *
* * returns the new length , but doesn ' t set SET_LEN_STRING .
*/
Int GrowString (
Obj list,
UInt need )
{
UInt len; // new physical length
UInt good; // good new physical length
if (need > INT_INTOBJ_MAX)
ErrorMayQuit("GrowString: string length too large" , 0 , 0 );
// find out how large the data area should become
good = 5 * (GET_LEN_STRING(list)+3 ) / 4 + 1 ;
if (good > INT_INTOBJ_MAX)
good = INT_INTOBJ_MAX;
// but maybe we need more
if ( need < good ) { len = good; }
else { len = need; }
// resize the bag
ResizeBag( list, SIZEBAG_STRINGLEN(len) );
// return the new maximal length
return (Int ) len;
}
/****************************************************************************
* *
* F TypeString ( < list > ) . . . . . . . . . . . . . . . . . . type of a string
* *
* * ' TypeString ' returns the type of the string < list > .
* *
* * ' TypeString ' is the function in ' TypeObjFuncs ' for strings .
*/
static Obj TYPE_STRING_MUTABLE;
static Obj TYPE_STRING_IMMUTABLE;
static Obj TYPE_STRING_NSORT_MUTABLE;
static Obj TYPE_STRING_NSORT_IMMUTABLE;
static Obj TYPE_STRING_SSORT_MUTABLE;
static Obj TYPE_STRING_SSORT_IMMUTABLE;
static Obj TypeString(Obj list)
{
BOOL mut = IS_MUTABLE_OBJ(list);
return mut ? TYPE_STRING_MUTABLE : TYPE_STRING_IMMUTABLE;
}
static Obj TypeStringNSort(Obj list)
{
BOOL mut = IS_MUTABLE_OBJ(list);
return mut ? TYPE_STRING_NSORT_MUTABLE : TYPE_STRING_NSORT_IMMUTABLE;
}
static Obj TypeStringSSort(Obj list)
{
BOOL mut = IS_MUTABLE_OBJ(list);
return mut ? TYPE_STRING_SSORT_MUTABLE : TYPE_STRING_SSORT_IMMUTABLE;
}
/****************************************************************************
* *
* F * * * * * * * * * * * * * * copy functions * * * * * * * * * * * * * * * *
*/
#if !defined (USE_THREADSAFE_COPYING)
/****************************************************************************
* *
* F CopyString ( < list > , < mut > ) . . . . . . . . . . . . . . . . copy a string
* *
* * ' CopyString ' returns a structural ( deep ) copy of the string < list > , i . e . ,
* * a recursive copy that preserves the structure .
* *
* * If < list > has not yet been copied , it makes a copy , leaves a forward
* * pointer to the copy in the first entry of the string , where the size of
* * the string usually resides , and copies all the entries . If the string
* * has already been copied , it returns the value of the forwarding pointer .
* *
* * ' CopyString ' is the function in ' CopyObjFuncs ' for strings .
*/
static Obj CopyString(Obj list, Int mut)
{
Obj copy; // handle of the copy, result
// immutable input is handled by COPY_OBJ
GAP_ASSERT(IS_MUTABLE_OBJ(list));
// make object for copy
copy = NewBag(TNUM_OBJ(list), SIZE_OBJ(list));
if (!mut)
MakeImmutableNoRecurse(copy);
ADDR_OBJ(copy)[0 ] = CONST_ADDR_OBJ(list)[0 ];
// leave a forwarding pointer
PrepareCopy(list, copy);
// copy the subvalues
memcpy(ADDR_OBJ(copy)+1 , CONST_ADDR_OBJ(list)+1 ,
SIZE_OBJ(list)-sizeof (Obj) );
// return the copy
return copy;
}
#endif //!defined(USE_THREADSAFE_COPYING)
/****************************************************************************
* *
* F * * * * * * * * * * * * * * list functions * * * * * * * * * * * * * * * *
*/
/****************************************************************************
* *
* F PrintString ( < list > ) . . . . . . . . . . . . . . . . . . . print a string
* F FuncVIEW_STRING_FOR_STRING ( < list > ) . . . . . . view a string as a string
* *
* * ' PrintString ' prints the string with the handle < list > .
* * ' VIEW_STRING_FOR_STRING ' returns a string containing what PrintString
* * outputs .
* *
* * No linebreaks are allowed , if one must be inserted anyhow , it must
* * be escaped by a backslash ' \ ' , which is done in ' Pr ' .
* *
* * The buffer ' PrStrBuf ' is used to protect ' Pr ' against garbage collections
* * caused by printing to string streams , which might move the body of list .
* *
* * The output uses octal number notation for non - ascii or non - printable
* * characters . The function can be used to print * any * string in a way
* * which can be read in by GAP afterwards .
*/
// Type of function given to OutputStringGeneric
typedef void StringOutputterType(void * data, char * strbuf, UInt len);
// Output using Pr
void ToPrOutputter(void * data, char * strbuf, UInt len)
{
strbuf[len++] = '\0' ;
Pr("%s" , (Int )strbuf, 0 );
}
// Output to a string
void ToStringOutputter(void * data, char * buf, UInt lenbuf)
{
AppendCStr((Obj)data, buf, lenbuf);
}
void OutputStringGeneric(Obj list, StringOutputterType func, void * data)
{
char PrStrBuf[10007 ]; // 7 for a \c\123 at the end
UInt scanout = 0 , n;
UInt1 c;
UInt len = GET_LEN_STRING(list);
UInt off = 0 ;
PrStrBuf[scanout++] = '\"' ;
func(data, PrStrBuf, scanout);
while (off < len) {
scanout = 0 ;
do {
c = CONST_CHARS_STRING(list)[off++];
switch (c) {
case '\\' :
PrStrBuf[scanout++] = '\\' ;
PrStrBuf[scanout++] = '\\' ;
break ;
case '\"' :
PrStrBuf[scanout++] = '\\' ;
PrStrBuf[scanout++] = '\"' ;
break ;
case '\n' :
PrStrBuf[scanout++] = '\\' ;
PrStrBuf[scanout++] = 'n' ;
break ;
case '\t' :
PrStrBuf[scanout++] = '\\' ;
PrStrBuf[scanout++] = 't' ;
break ;
case '\r' :
PrStrBuf[scanout++] = '\\' ;
PrStrBuf[scanout++] = 'r' ;
break ;
case '\b' :
PrStrBuf[scanout++] = '\\' ;
PrStrBuf[scanout++] = 'b' ;
break ;
case '\01' :
PrStrBuf[scanout++] = '\\' ;
PrStrBuf[scanout++] = '>' ;
break ;
case '\02' :
PrStrBuf[scanout++] = '\\' ;
PrStrBuf[scanout++] = '<' ;
break ;
case '\03' :
PrStrBuf[scanout++] = '\\' ;
PrStrBuf[scanout++] = 'c' ;
break ;
default :
if (c < 32 || c > 126 ) {
PrStrBuf[scanout++] = '\\' ;
n = c / 64 ;
c = c - n * 64 ;
PrStrBuf[scanout++] = n + '0' ;
n = c / 8 ;
c = c - n * 8 ;
PrStrBuf[scanout++] = n + '0' ;
PrStrBuf[scanout++] = c + '0' ;
}
else
PrStrBuf[scanout++] = c;
}
} while (off < len && scanout < 10000 );
func(data, PrStrBuf, scanout);
}
scanout = 0 ;
PrStrBuf[scanout++] = '\"' ;
func(data, PrStrBuf, scanout);
}
void PrintString(Obj list)
{
OutputStringGeneric(list, ToPrOutputter, (void *)0 );
}
Obj FuncVIEW_STRING_FOR_STRING(Obj self, Obj string)
{
if (!IS_STRING(string)) {
RequireArgument(SELF_NAME, string, "must be a string" );
}
if (!IS_STRING_REP(string)) {
string = CopyToStringRep(string);
}
Obj output = NEW_STRING(0 );
OutputStringGeneric(string, ToStringOutputter, output);
return output;
}
/****************************************************************************
* *
* F PrintString1 ( < list > ) . . . . . . . . . . . . print a string for ' Print '
* *
* * ' PrintString1 ' prints the string constant in the format used by the
* * ' Print ' and ' PrintTo ' function .
*/
void PrintString1 (
Obj list )
{
Pr("%g" , (Int )list, 0 );
}
/****************************************************************************
* *
* F EqString ( < listL > , < listR > ) . . . . . . . . test whether strings are equal
* *
* * ' EqString ' returns ' true ' if the two strings < listL > and < listR > are
* * equal and ' false ' otherwise .
*/
static Int EqString(Obj listL, Obj listR)
{
UInt lL, lR;
const UInt1 *pL, *pR;
lL = GET_LEN_STRING(listL);
lR = GET_LEN_STRING(listR);
if (lR != lL) return 0 ;
pL = CONST_CHARS_STRING(listL);
pR = CONST_CHARS_STRING(listR);
return memcmp(pL, pR, lL) == 0 ;
}
/****************************************************************************
* *
* F LtString ( < listL > , < listR > ) . test whether one string is less than another
* *
* * ' LtString ' returns ' true ' if the string < listL > is less than the string
* * < listR > and ' false ' otherwise .
*/
static Int LtString(Obj listL, Obj listR)
{
UInt lL, lR;
const UInt1 *pL, *pR;
lL = GET_LEN_STRING(listL);
lR = GET_LEN_STRING(listR);
pL = CONST_CHARS_STRING(listL);
pR = CONST_CHARS_STRING(listR);
Int res;
if (lL <= lR) {
res = memcmp(pL, pR, lL);
if (res == 0 )
return lL < lR;
}
else {
res = memcmp(pL, pR, lR);
if (res == 0 )
return 0 ;
}
return res < 0 ;
}
/****************************************************************************
* *
* F LenString ( < list > ) . . . . . . . . . . . . . . . . . . length of a string
* *
* * ' LenString ' returns the length of the string < list > as a C integer .
* *
* * ' LenString ' is the function in ' LenListFuncs ' for strings .
*/
static Int LenString(Obj list)
{
return GET_LEN_STRING( list );
}
/****************************************************************************
* *
* F IsbString ( < list > , < pos > ) . . . . . . . . . test for an element of a string
* *
* * ' IsbString ' returns 1 if the string < list > contains
* * a character at the position < pos > and 0 otherwise .
* * It can rely on < pos > being a positive integer .
* *
* * ' IsbString ' is the function in ' IsbListFuncs ' for strings .
*/
static BOOL IsbString(Obj list, Int pos)
{
// since strings are dense, this must only test for the length
return (pos <= GET_LEN_STRING(list));
}
/****************************************************************************
* *
* F GET_ELM_STRING ( < list > , < pos > ) . . . . . . select an element of a string
* *
* * ' GET_ELM_STRING ' returns the < pos > - th element of the string < list > .
* * < pos > must be a positive integer less than or equal to the length of
* * < list > .
*/
static inline Obj GET_ELM_STRING(Obj list, Int pos)
{
GAP_ASSERT(IS_STRING_REP(list));
GAP_ASSERT(pos > 0 );
GAP_ASSERT((UInt) pos <= GET_LEN_STRING(list));
UChar c = CONST_CHARS_STRING(list)[pos - 1 ];
return ObjsChar[c];
}
/****************************************************************************
* *
* F SET_ELM_STRING ( < list > , < pos > , < val > ) . . . . set a character of a string
* *
* * ' SET_ELM_STRING ' sets the < pos > - th character of the string < list > .
* * < val > must be a character and < list > stay a string after the assignment .
*/
static inline void SET_ELM_STRING(Obj list, Int pos, Obj val)
{
GAP_ASSERT(IS_STRING_REP(list));
GAP_ASSERT(pos > 0 );
GAP_ASSERT((UInt) pos <= GET_LEN_STRING(list));
GAP_ASSERT(TNUM_OBJ(val) == T_CHAR);
UChar * ptr = CHARS_STRING(list) + (pos - 1 );
*ptr = CHAR_VALUE(val);
}
/****************************************************************************
* *
* F Elm0String ( < list > , < pos > ) . . . . . . . . . select an element of a string
* F Elm0vString ( < list > , < pos > ) . . . . . . . . . select an element of a string
* *
* * ' Elm0String ' returns the element at the position < pos > of the string
* * < list > , or returns 0 if < list > has no assigned object at < pos > .
* * It can rely on < pos > being a positive integer .
* *
* * ' Elm0vString ' does the same thing as ' Elm0String ' , but it can
* * also rely on < pos > not being larger than the length of < list > .
* *
* * ' Elm0String ' is the function on ' Elm0ListFuncs ' for strings .
* * ' Elm0vString ' is the function in ' Elm0vListFuncs ' for strings .
*/
static Obj Elm0String(Obj list, Int pos)
{
if ( pos <= GET_LEN_STRING( list ) ) {
return GET_ELM_STRING( list, pos );
}
else {
return 0 ;
}
}
static Obj Elm0vString(Obj list, Int pos)
{
return GET_ELM_STRING( list, pos );
}
/****************************************************************************
* *
* F ElmString ( < list > , < pos > ) . . . . . . . . . . select an element of a string
* F ElmvString ( < list > , < pos > ) . . . . . . . . . select an element of a string
* *
* * ' ElmString ' returns the element at the position < pos > of the string
* * < list > , or signals an error if < list > has no assigned object at < pos > .
* * It can rely on < pos > being a positive integer .
* *
* * ' ElmvString ' does the same thing as ' ElmString ' , but it can
* * also rely on < pos > not being larger than the length of < list > .
* *
* * ' ElmwString ' does the same thing as ' ElmString ' , but it can
* * also rely on < list > having an assigned object at < pos > .
* *
* * ' ElmString ' is the function in ' ElmListFuncs ' for strings .
* * ' ElmfString ' is the function in ' ElmfListFuncs ' for strings .
* * ' ElmwString ' is the function in ' ElmwListFuncs ' for strings .
*/
static Obj ElmString(Obj list, Int pos)
{
// check the position
if ( GET_LEN_STRING( list ) < pos ) {
ErrorMayQuit("List Element: <list>[%d] must have an assigned value" ,
(Int )pos, 0 );
}
// return the selected element
return GET_ELM_STRING( list, pos );
}
#define ElmvString Elm0vString
#define ElmwString Elm0vString
/****************************************************************************
* *
* F ElmsString ( < list > , < poss > ) . . . . . . . . select a sublist from a string
* *
* * ' ElmsString ' returns a new list containing the elements at the positions
* * given in the list < poss > from the string < list > . It is the
* * responsibility of the called to ensure that < poss > is dense and contains
* * only positive integers . An error is signalled if an element of < poss > is
* * larger than the length of < list > .
* *
* * ' ElmsString ' is the function in ' ElmsListFuncs ' for strings .
*/
static Obj ElmsString(Obj list, Obj poss)
{
Obj elms; // selected sublist, result
Int lenList; // length of <list>
Char elm; // one element from <list>
Int lenPoss; // length of <positions>
Int pos; // <position> as integer
Int inc; // increment in a range
Int i; // loop variable
// general code
if ( ! IS_RANGE(poss) ) {
// get the length of <list>
lenList = GET_LEN_STRING( list );
// get the length of <positions>
lenPoss = LEN_LIST( poss );
// make the result list
elms = NEW_STRING( lenPoss );
// loop over the entries of <positions> and select
for ( i = 1 ; i <= lenPoss; i++ ) {
// get <position>
Obj p = ELMW_LIST(poss, i);
if (!IS_INTOBJ(p)) {
ErrorMayQuit("List Elements: position is too large for "
"this type of list" ,
0 , 0 );
}
pos = INT_INTOBJ(p);
// select the element
if ( lenList < pos ) {
ErrorMayQuit(
"List Elements: <list>[%d] must have an assigned value" ,
(Int )pos, 0 );
}
// select the element
elm = CONST_CHARS_STRING(list)[pos-1 ];
// assign the element into <elms>
CHARS_STRING(elms)[i-1 ] = elm;
}
}
// special code for ranges
else {
// get the length of <list>
lenList = GET_LEN_STRING( list );
// get the length of <positions>, the first elements, and the inc.
lenPoss = GET_LEN_RANGE( poss );
pos = GET_LOW_RANGE( poss );
inc = GET_INC_RANGE( poss );
// check that no <position> is larger than 'LEN_LIST(<list>)'
if ( lenList < pos ) {
ErrorMayQuit(
"List Elements: <list>[%d] must have an assigned value" ,
(Int )pos, 0 );
}
if ( lenList < pos + (lenPoss-1 ) * inc ) {
ErrorMayQuit(
"List Elements: <list>[%d] must have an assigned value" ,
(Int )(pos + (lenPoss - 1 ) * inc), 0 );
}
// make the result list
elms = NEW_STRING( lenPoss );
// loop over the entries of <positions> and select
const UInt1 * p = CONST_CHARS_STRING(list);
UInt1 * pn = CHARS_STRING(elms);
for ( i = 1 ; i <= lenPoss; i++, pos += inc ) {
pn[i - 1 ] = p[pos - 1 ];
}
}
return elms;
}
/****************************************************************************
* *
* F AssString ( < list > , < pos > , < val > ) . . . . . . . . . . . . assign to a string
* *
* * ' AssString ' assigns the value < val > to the string < list > at the position
* * < pos > . It is the responsibility of the caller to ensure that < pos > is
* * positive , and that < val > is not 0 .
* *
* * ' AssString ' is the function in ' AssListFuncs ' for strings .
* *
* * ' AssString ' keeps < list > in string representation if possible .
* *
*/
static void AssString(Obj list, Int pos, Obj val)
{
UInt len = GET_LEN_STRING(list);
if (TNUM_OBJ(val) != T_CHAR || pos > len+1 ) {
// convert the range into a plain list
PLAIN_LIST(list);
CLEAR_FILTS_LIST(list);
// resize the list if necessary
if ( len < pos ) {
GROW_PLIST( list, pos );
SET_LEN_PLIST( list, pos );
}
// now perform the assignment and return the assigned value
SET_ELM_PLIST( list, pos, val );
CHANGED_BAG( list );
}
else {
CLEAR_FILTS_LIST(list);
// resize the list if necessary
if ( len < pos ) {
GROW_STRING( list, pos );
SET_LEN_STRING( list, pos );
CHARS_STRING(list)[pos] = (UInt1)0 ;
}
// now perform the assignment and return the assigned value
SET_ELM_STRING( list, pos, val );
}
}
/****************************************************************************
* *
* F AsssString ( < list > , < poss > , < vals > ) . . assign several elements to a string
* *
* * ' AsssString ' assigns the values from the list < vals > at the positions
* * given in the list < poss > to the string < list > . It is the responsibility
* * of the caller to ensure that < poss > is dense and contains only positive
* * integers , that < poss > and < vals > have the same length , and that < vals > is
* * dense .
* *
* * ' AsssString ' is the function in ' AsssListFuncs ' for strings .
* *
* * ' AsssString ' simply delegates to AssString . Note that the ordering of
* * < poss > can be important if < list > should stay in string representation .
* *
*/
static void AsssString(Obj list, Obj poss, Obj vals)
{
Int i, len = LEN_LIST(poss);
for (i = 1 ; i <= len; i++) {
ASS_LIST(list, INT_INTOBJ(ELM_LIST(poss, i)), ELM_LIST(vals, i));
}
}
/****************************************************************************
* *
* F IsSSortString ( < list > ) . . . . . . . strictly sorted list test for strings
* *
* * ' IsSSortString ' returns 1 if the string < list > is strictly sorted and 0
* * otherwise .
* *
* * ' IsSSortString ' is the function in ' IsSSortListFuncs ' for strings .
*/
static BOOL IsSSortString(Obj list)
{
Int len;
Int i;
const UInt1 * ptr;
// test whether the string is strictly sorted
len = GET_LEN_STRING( list );
ptr = CONST_CHARS_STRING(list);
for ( i = 1 ; i < len; i++ ) {
if ( ! (ptr[i-1 ] < ptr[i]) )
break ;
}
// retype according to the outcome
SET_FILT_LIST( list, (len <= i) ? FN_IS_SSORT : FN_IS_NSORT );
return (len <= i);
}
/****************************************************************************
* *
* F IsPossString ( < list > ) . . . . . positions list test function for strings
* *
* * ' IsPossString ' is the function in ' IsPossListFuncs ' for strings .
*/
static BOOL IsPossString(Obj list)
{
return GET_LEN_STRING( list ) == 0 ;
}
/****************************************************************************
* *
* F PosString ( < list > , < val > , < pos > ) . . . . position of an element in a string
* *
* * ' PosString ' returns the position of the value < val > in the string < list >
* * after the first position < start > as a C integer . 0 is returned if < val >
* * is not in the list .
* *
* * ' PosString ' is the function in ' PosListFuncs ' for strings .
*/
static Obj PosString(Obj list, Obj val, Obj start)
{
Int lenList; // length of <list>
Int i; // loop variable
UInt1 valc; // C characters
const UInt1 *p; // pointer to chars of <list>
UInt istart;
/* if the starting position is too big to be a small int
then there can't be anything to find */
if (!IS_INTOBJ(start))
return Fail;
istart = INT_INTOBJ(start);
// get the length of <list>
lenList = GET_LEN_STRING( list );
// a string contains only characters
if (TNUM_OBJ(val) != T_CHAR) return Fail;
// val as C character
valc = CHAR_VALUE(val);
// search entries in <list>
p = CONST_CHARS_STRING(list);
for ( i = istart; i < lenList && p[i] != valc; i++ );
// return the position (0 if <val> was not found)
return (lenList <= i ? Fail : INTOBJ_INT(i+1 ));
}
/****************************************************************************
* *
* F PlainString ( < list > ) . . . . . . . . . . convert a string to a plain list
* *
* * ' PlainString ' converts the string < list > to a plain list . Not much work .
* *
* * ' PlainString ' is the function in ' PlainListFuncs ' for strings .
*/
static void PlainString(Obj list)
{
Int lenList; // logical length of the string
Obj tmp; // handle of the list
Int i; // loop variable
// find the length and allocate a temporary copy
lenList = GET_LEN_STRING( list );
tmp = NEW_PLIST_WITH_MUTABILITY(IS_MUTABLE_OBJ(list), T_PLIST, lenList);
SET_LEN_PLIST( tmp, lenList );
// copy the characters
for ( i = 1 ; i <= lenList; i++ ) {
SET_ELM_PLIST( tmp, i, GET_ELM_STRING( list, i ) );
}
// change size and type of the string and copy back
ResizeBag( list, SIZE_OBJ(tmp) );
RetypeBag( list, TNUM_OBJ(tmp) );
memcpy(ADDR_OBJ(list), CONST_ADDR_OBJ(tmp), SIZE_OBJ(tmp));
CHANGED_BAG(list);
}
/****************************************************************************
* *
* F IS_STRING ( < obj > ) . . . . . . . . . . . . test if an object is a string
* *
* * ' IS_STRING ' returns 1 if the object < obj > is a string and 0 otherwise .
* * It does not change the representation of < obj > .
*/
BOOL (*IsStringFuncs[LAST_REAL_TNUM + 1 ])(Obj obj);
static Obj IsStringFilt;
static BOOL IsStringList(Obj list)
{
Int lenList;
Obj elm;
Int i;
lenList = LEN_LIST( list );
for ( i = 1 ; i <= lenList; i++ ) {
elm = ELMV0_LIST( list, i );
if ( elm == 0 )
break ;
#ifdef HPCGAP
if ( !CheckReadAccess(elm) )
break ;
#endif
if ( TNUM_OBJ( elm ) != T_CHAR )
break ;
}
return (lenList < i);
}
static BOOL IsStringListHom(Obj list)
{
return (TNUM_OBJ( ELM_LIST(list,1 ) ) == T_CHAR);
}
static BOOL IsStringObject(Obj obj)
{
return (DoFilter( IsStringFilt, obj ) != False );
}
/****************************************************************************
* *
* F CopyToStringRep ( < string > ) . . . copy a string to string representation
* *
* * ' CopyToStringRep ' copies the string < string > to a new string in string
* * representation .
*/
Obj CopyToStringRep(
Obj string )
{
Int lenString; // length of the string
Obj elm; // one element of the string
Obj copy; // temporary string
Int i; // loop variable
lenString = LEN_LIST(string);
copy = NEW_STRING(lenString);
if ( IS_STRING_REP(string) ) {
memcpy(CHARS_STRING(copy), CONST_CHARS_STRING(string),
GET_LEN_STRING(string));
// XXX no error checks?
} else {
// copy the string to the string representation
for ( i = 1 ; i <= lenString; i++ ) {
elm = ELMW_LIST( string, i );
CHARS_STRING(copy)[i-1 ] = CHAR_VALUE(elm);
}
CHARS_STRING(copy)[lenString] = '\0' ;
}
return copy;
}
/****************************************************************************
* *
* F ImmutableString ( < string > ) . . . copy to immutable string in string rep .
* *
* * ' ImmutableString ' returns an immutable string in string representation
* * equal to < string > . This may return < string > if it already satisfies these
* * criteria .
*/
Obj ImmutableString(Obj string)
{
if (!IS_STRING_REP(string) || IS_MUTABLE_OBJ(string)) {
string = CopyToStringRep(string);
MakeImmutableNoRecurse(string);
}
return string;
}
/****************************************************************************
* *
* F ConvString ( < string > ) . . . . convert a string to string representation
* *
* * ' ConvString ' converts the string < string > to string representation .
*/
void ConvString (
Obj string )
{
Int lenString; // length of the string
Obj elm; // one element of the string
Obj tmp; // temporary string
Int i; // loop variable
// do nothing if the string is already in the string representation
if ( IS_STRING_REP(string) )
{
return ;
}
lenString = LEN_LIST(string);
tmp = NEW_STRING(lenString);
// copy the string to the string representation
for ( i = 1 ; i <= lenString; i++ ) {
elm = ELMW_LIST( string, i );
CHARS_STRING(tmp)[i-1 ] = CHAR_VALUE(elm);
}
CHARS_STRING(tmp)[lenString] = '\0' ;
// copy back to string
RetypeBagSM( string, T_STRING );
ResizeBag( string, SIZEBAG_STRINGLEN(lenString) );
// copy data area from tmp
memcpy(ADDR_OBJ(string), CONST_ADDR_OBJ(tmp), SIZE_OBJ(tmp));
}
/****************************************************************************
* *
* F IsStringConv ( < obj > ) . . . . . test if an object is a string and convert
* *
* * ' IsStringConv ' returns 1 if the object < obj > is a string , and 0
* * otherwise . If < obj > is a string it changes its representation to the
* * string representation .
*/
BOOL IsStringConv(Obj obj)
{
Int res;
// test whether the object is a string
res = IS_STRING( obj );
// if so, convert it to the string representation
if ( res ) {
ConvString( obj );
}
return res;
}
/****************************************************************************
* *
* F AppendCStr ( < str > , < buf > , < len > ) . . append data in a buffer to a string
* *
* * ' AppendCStr ' appends < len > bytes of data taken from < buf > to < str > , where
* * < str > must be a mutable GAP string object .
*/
void AppendCStr(Obj str, const char * buf, UInt len)
{
GAP_ASSERT(IS_MUTABLE_OBJ(str));
GAP_ASSERT(IS_STRING_REP(str));
UInt len1 = GET_LEN_STRING(str);
UInt newlen = len1 + len;
GROW_STRING(str, newlen);
SET_LEN_STRING(str, newlen);
CLEAR_FILTS_LIST(str);
memcpy(CHARS_STRING(str) + len1, buf, len);
CHARS_STRING(str)[newlen] = '\0' ; // add terminator
}
/****************************************************************************
* *
* F AppendString ( < str1 > , < str2 > ) . . . . . . . append one string to another
* *
* * ' AppendString ' appends < str2 > to the end of < str1 > . Both < str1 > and < str >
* * must be a GAP string objects , and < str1 > must be mutable .
*/
void AppendString(Obj str1, Obj str2)
{
GAP_ASSERT(IS_MUTABLE_OBJ(str1));
GAP_ASSERT(IS_STRING_REP(str1));
GAP_ASSERT(IS_STRING_REP(str2));
UInt len1 = GET_LEN_STRING(str1);
UInt len2 = GET_LEN_STRING(str2);
UInt newlen = len1 + len2;
GROW_STRING(str1, newlen);
SET_LEN_STRING(str1, newlen);
CLEAR_FILTS_LIST(str1);
memcpy(CHARS_STRING(str1) + len1, CONST_CHARS_STRING(str2), len2);
CHARS_STRING(str1)[newlen] = '\0' ; // add terminator
}
/****************************************************************************
* *
* F * * * * * * * * * * * * * * GAP level functions * * * * * * * * * * * * *
*/
/****************************************************************************
* *
* F FiltIS_STRING ( < self > , < obj > ) . . . . . . . . . test value is a string
*/
static Obj FiltIS_STRING(Obj self, Obj obj)
{
return (IS_STRING( obj ) ? True : False );
}
/****************************************************************************
* *
* F FuncIS_STRING_CONV ( < self > , < obj > ) . . . . . . . . . . check and convert
*/
static Obj FuncIS_STRING_CONV(Obj self, Obj obj)
{
// return 'true' if <obj> is a string and 'false' otherwise
return (IsStringConv(obj) ? True : False );
}
/****************************************************************************
* *
* F FuncCONV_STRING ( < self > , < string > ) . . . . . . . . convert to string rep
*/
static Obj FuncCONV_STRING(Obj self, Obj string)
{
if (!IS_STRING(string)) {
RequireArgument(SELF_NAME, string, "must be a string" );
}
// convert to the string representation
ConvString( string );
return 0 ;
}
/****************************************************************************
* *
* F FiltIS_STRING_REP ( < self > , < obj > ) . . . . test if value is a string rep
*/
static Obj IsStringRepFilt;
static Obj FiltIS_STRING_REP(Obj self, Obj obj)
{
return (IS_STRING_REP( obj ) ? True : False );
}
/****************************************************************************
* *
* F FuncCOPY_TO_STRING_REP ( < self > , < obj > ) . copy a string into string rep
*/
static Obj FuncCOPY_TO_STRING_REP(Obj self, Obj string)
{
if (!IS_STRING(string)) {
RequireArgument(SELF_NAME, string, "must be a string" );
}
return CopyToStringRep(string);
}
/****************************************************************************
* *
* F FuncPOSITION_SUBSTRING ( < self > , < string > , < substr > , < off > ) . position of
* * substring
* *
* * < str > and < substr > must be strings and < off > an integer . The position
* * of first character of substring in string , search starting from
* * < off > + 1 , is returned if such a substring exists . Otherwise ` fail ' is
* * returned .
*/
static Obj FuncPOSITION_SUBSTRING(Obj self, Obj string, Obj substr, Obj off)
{
Int ipos, i, j, lens, lenss, max;
const UInt1 *s, *ss;
RequireStringRep(SELF_NAME, string);
RequireStringRep(SELF_NAME, substr);
RequireNonnegativeSmallInt(SELF_NAME, off);
ipos = INT_INTOBJ(off);
// special case for the empty string
lenss = GET_LEN_STRING(substr);
if ( lenss == 0 ) {
return INTOBJ_INT(ipos + 1 );
}
lens = GET_LEN_STRING(string);
max = lens - lenss + 1 ;
s = CONST_CHARS_STRING(string);
ss = CONST_CHARS_STRING(substr);
const UInt1 c = ss[0 ];
for (i = ipos; i < max; i++) {
if (c == s[i]) {
for (j = 1 ; j < lenss; j++) {
if (! (s[i+j] == ss[j]))
break ;
}
if (j == lenss)
return INTOBJ_INT(i+1 );
}
}
return Fail;
}
/****************************************************************************
* *
* F FuncNormalizeWhitespace ( < self > , < string > ) . . . . . normalize white
* * space in place
* *
* * Whitespace characters are " \ r \ t \ n " . Leading and trailing whitespace in
* * string is removed . Intermediate sequences of whitespace characters are
* * substituted by a single space .
* *
*/
static Obj FuncNormalizeWhitespace(Obj self, Obj string)
{
UInt1 *s, c;
Int i, j, len, white;
RequireStringRep(SELF_NAME, string);
len = GET_LEN_STRING(string);
s = CHARS_STRING(string);
i = -1 ;
white = 1 ;
for (j = 0 ; j < len; j++) {
c = s[j];
if (c == ' ' || c == '\n' || c == '\t' || c == '\r' ) {
if (! white) {
i++;
s[i] = ' ' ;
white = 1 ;
}
}
else {
i++;
s[i] = c;
white = 0 ;
}
}
if (white && i > -1 )
i--;
s[i+1 ] = '\0' ;
SET_LEN_STRING(string, i+1 );
// to make it useful as C-string
CHARS_STRING(string)[i+1 ] = (UInt1)0 ;
return (Obj)0 ;
}
/****************************************************************************
* *
* F FuncREMOVE_CHARACTERS ( < self > , < string > , < rem > ) . . . . . delete characters
* * from < rem > in < string > in place
* *
*/
static Obj FuncREMOVE_CHARACTERS(Obj self, Obj string, Obj rem)
{
UInt1 *s;
Int i, j, len;
UInt1 REMCHARLIST[256 ] = {0 };
RequireStringRep(SELF_NAME, string);
RequireStringRep(SELF_NAME, rem);
// set REMCHARLIST by setting positions of characters in rem to 1
len = GET_LEN_STRING(rem);
s = CHARS_STRING(rem);
for (i=0 ; i<len; i++) REMCHARLIST[s[i]] = 1 ;
// now change string in place
len = GET_LEN_STRING(string);
s = CHARS_STRING(string);
i = -1 ;
for (j = 0 ; j < len; j++) {
if (REMCHARLIST[s[j]] == 0 ) {
i++;
s[i] = s[j];
}
}
i++;
s[i] = '\0' ;
SET_LEN_STRING(string, i);
SHRINK_STRING(string);
return (Obj)0 ;
}
/****************************************************************************
* *
* F FuncTranslateString ( < self > , < string > , < trans > ) . . . translate characters
* * in < string > in place , < string > [ i ] = < trans > [ < string > [ i ] ]
* *
*/
static Obj FuncTranslateString(Obj self, Obj string, Obj trans)
{
Int j, len;
RequireStringRep(SELF_NAME, string);
RequireStringRep(SELF_NAME, trans);
if ( GET_LEN_STRING( trans ) < 256 ) {
ErrorMayQuit("TranslateString: <trans> must have length >= 256" ,
0 , 0 );
}
// now change string in place
len = GET_LEN_STRING(string);
UInt1 *s = CHARS_STRING(string);
const UInt1 *t = CONST_CHARS_STRING(trans);
for (j = 0 ; j < len; j++) {
s[j] = t[s[j]];
}
return (Obj)0 ;
}
/****************************************************************************
* *
* F FuncSplitStringInternal ( < self > , < string > , < seps > , < wspace > ) . . . . split string
* * at characters in < seps > and < wspace >
* *
* * The difference of < seps > and < wspace > is that characters in < wspace > don ' t
* * separate empty strings .
*/
static Obj FuncSplitStringInternal(Obj self, Obj string, Obj seps, Obj wspace)
{
const UInt1 *s;
Int i, a, z, l, pos, len;
Obj res, part;
UInt1 SPLITSTRINGSEPS[256 ] = { 0 };
UInt1 SPLITSTRINGWSPACE[256 ] = { 0 };
RequireStringRep(SELF_NAME, string);
RequireStringRep(SELF_NAME, seps);
RequireStringRep(SELF_NAME, wspace);
// set SPLITSTRINGSEPS by setting positions of characters in rem to 1
len = GET_LEN_STRING(seps);
s = CONST_CHARS_STRING(seps);
for (i=0 ; i<len; i++) SPLITSTRINGSEPS[s[i]] = 1 ;
// set SPLITSTRINGWSPACE by setting positions of characters in rem to 1
len = GET_LEN_STRING(wspace);
s = CONST_CHARS_STRING(wspace);
for (i=0 ; i<len; i++) SPLITSTRINGWSPACE[s[i]] = 1 ;
// create the result (list of strings)
res = NEW_PLIST(T_PLIST, 2 );
pos = 0 ;
// now do the splitting
len = GET_LEN_STRING(string);
s = CONST_CHARS_STRING(string);
for (a=0 , z=0 ; z<len; z++) {
// Whenever we encounter a separator or a white space, the substring
// starting after the last separator/white space is cut out. The
// only difference between white spaces and separators is that white
// spaces don't separate empty strings.
if (SPLITSTRINGWSPACE[s[z]] == 1 ) {
if (a<z) {
l = z-a;
part = NEW_STRING(l);
// update s in case there was a garbage collection
s = CONST_CHARS_STRING(string);
COPY_CHARS(part, s + a, l);
CHARS_STRING(part)[l] = 0 ;
pos++;
AssPlist(res, pos, part);
s = CONST_CHARS_STRING(string);
a = z+1 ;
}
else {
a = z+1 ;
}
}
else {
if (SPLITSTRINGSEPS[s[z]] == 1 ) {
l = z-a;
part = NEW_STRING(l);
// update s in case there was a garbage collection
s = CONST_CHARS_STRING(string);
COPY_CHARS(part, s + a, l);
CHARS_STRING(part)[l] = 0 ;
pos++;
AssPlist(res, pos, part);
s = CONST_CHARS_STRING(string);
a = z+1 ;
}
}
}
// Pick up a substring at the end of the string. Note that a trailing
// separator does not produce an empty string.
if (a<z) {
// copy until last position which is z-1
l = z-a;
part = NEW_STRING(l);
s = CONST_CHARS_STRING(string);
COPY_CHARS(part, s + a, l);
CHARS_STRING(part)[l] = 0 ;
pos++;
AssPlist(res, pos, part);
}
return res;
}
#ifdef HPCGAP
/****************************************************************************
* *
* F FuncFIND_ALL_IN_STRING ( < self > , < string > , < chars > )
* *
* * Kernel function to return a list of all occurrences of a set of characters
* * within a string .
*/
static Obj FuncFIND_ALL_IN_STRING(Obj self, Obj string, Obj chars)
{
Obj result;
UInt i, len, matches;
unsigned char table[1 <<(8 *sizeof (char ))];
const UInt1 *s;
if (!IsStringConv(string) || !IsStringConv(chars))
ErrorQuit("FIND_ALL_IN_STRING: Requires two string arguments" , 0 , 0 );
memset(table, 0 , sizeof (table));
len = GET_LEN_STRING(chars);
s = CONST_CHARS_STRING(chars);
for (i=0 ; i<len; i++)
table[s[i]] = 1 ;
len = GET_LEN_STRING(string);
s = CONST_CHARS_STRING(string);
matches = 0 ;
for (i = 0 ; i < len; i++)
if (table[s[i]])
matches++;
result = NEW_PLIST(T_PLIST_DENSE, matches);
SET_LEN_PLIST(result, matches);
matches = 1 ;
for (i = 0 ; i < len; i++)
if (table[s[i]]) {
SET_ELM_PLIST(result, matches, INTOBJ_INT(i+1 ));
matches++;
}
return result;
}
/****************************************************************************
* *
* F FuncNORMALIZE_NEWLINES ( < self > , < string > )
* *
* * Kernel function to replace all occurrences of CR or CRLF within a
* * string with LF characters . This function modifies its argument and
* * returns it also as its result .
*/
static Obj FuncNORMALIZE_NEWLINES(Obj self, Obj string)
{
UInt i, j, len;
Char *s;
if (!IsStringConv(string) || !REGION(string))
ErrorQuit("NORMALIZE_NEWLINES: Requires a mutable string argument" , 0 , 0 );
len = GET_LEN_STRING(string);
s = CSTR_STRING(string);
for (i = j = 0 ; i < len; i++) {
if (s[i] == '\r' ) {
s[j++] = '\n' ;
if (i + 1 < len && s[i+1 ] == '\n' )
i++;
} else {
s[j++] = s[i];
}
}
SET_LEN_STRING(string, j);
return string;
}
#endif
/****************************************************************************
* *
* F FuncSMALLINT_STR ( < self > , < string > )
* *
* * Kernel function to extract parse small integers from strings . Needed before
* * we can conveniently have Int working for things like parsing command line
* * options
*/
static Obj FuncSMALLINT_STR(Obj self, Obj str)
{
const Char *string = CONST_CSTR_STRING(str);
Int x = 0 ;
Int sign = 1 ;
while (isspace((unsigned int )*string))
string++;
if (*string == '-' ) {
sign = -1 ;
string++;
} else if (*string == '+' ) {
string++;
}
const Char * start = string;
while (IsDigit(*string)) {
x *= 10 ;
x += (*string - '0' );
string++;
}
if (start == string || *string)
return Fail;
return INTOBJ_INT(sign*x);
}
/****************************************************************************
* *
* F UnbString ( < string > , < pos > ) . . . . . . unbind an element from a string
* *
* * This is to avoid unpacking of the string to a plain list when < pos > is
* * larger or equal to the length of < string > .
*/
static void UnbString(Obj string, Int pos)
{
GAP_ASSERT(IS_MUTABLE_OBJ(string));
const Int len = GET_LEN_STRING(string);
if (len == pos) {
// maybe the string becomes sorted
CLEAR_FILTS_LIST(string);
CHARS_STRING(string)[pos - 1 ] = (UInt1)0 ;
SET_LEN_STRING(string, len - 1 );
}
else if (pos < len) {
PLAIN_LIST(string);
UNB_LIST(string, pos);
}
}
/****************************************************************************
* *
* F * * * * * * * * * * * * * initialize module * * * * * * * * * * * * * * *
*/
/****************************************************************************
* *
* V BagNames . . . . . . . . . . . . . . . . . . . . . . . list of bag names
*/
static StructBagNames BagNames[] = {
{ T_CHAR, "character" },
{ T_STRING, "list (string)" },
{ T_STRING +IMMUTABLE, "list (string,imm)" },
{ T_STRING_SSORT, "list (string,ssort)" },
{ T_STRING_SSORT +IMMUTABLE, "list (string,ssort,imm)" },
{ T_STRING_NSORT, "list (string,nsort)" },
{ T_STRING_NSORT +IMMUTABLE, "list (string,nsort,imm)" },
{ -1 , "" }
};
/****************************************************************************
* *
* V ClearFiltsTab . . . . . . . . . . . . . . . . . . . . clear filter tnums
*/
static Int ClearFiltsTab [] = {
T_STRING, T_STRING,
T_STRING_NSORT, T_STRING,
T_STRING_SSORT, T_STRING,
-1 , -1
};
/****************************************************************************
* *
* V HasFiltTab . . . . . . . . . . . . . . . . . . . . . tester filter tnum
*/
static Int HasFiltTab [] = {
// string
T_STRING, FN_IS_DENSE, 1 ,
T_STRING, FN_IS_NDENSE, 0 ,
T_STRING, FN_IS_HOMOG, 1 ,
T_STRING, FN_IS_NHOMOG, 0 ,
T_STRING, FN_IS_TABLE, 0 ,
T_STRING, FN_IS_RECT, 0 ,
T_STRING, FN_IS_SSORT, 0 ,
T_STRING, FN_IS_NSORT, 0 ,
// ssort string
T_STRING_SSORT, FN_IS_DENSE, 1 ,
T_STRING_SSORT, FN_IS_NDENSE, 0 ,
T_STRING_SSORT, FN_IS_HOMOG, 1 ,
T_STRING_SSORT, FN_IS_NHOMOG, 0 ,
T_STRING_SSORT, FN_IS_TABLE, 0 ,
T_STRING_SSORT, FN_IS_RECT, 0 ,
T_STRING_SSORT, FN_IS_SSORT, 1 ,
T_STRING_SSORT, FN_IS_NSORT, 0 ,
// nsort string
T_STRING_NSORT, FN_IS_DENSE, 1 ,
T_STRING_NSORT, FN_IS_NDENSE, 0 ,
T_STRING_NSORT, FN_IS_HOMOG, 1 ,
T_STRING_NSORT, FN_IS_NHOMOG, 0 ,
T_STRING_NSORT, FN_IS_TABLE, 0 ,
T_STRING_NSORT, FN_IS_RECT, 0 ,
T_STRING_NSORT, FN_IS_SSORT, 0 ,
T_STRING_NSORT, FN_IS_NSORT, 1 ,
-1 , -1 , -1
};
/****************************************************************************
* *
* V SetFiltTab . . . . . . . . . . . . . . . . . . . . . setter filter tnum
*/
static Int SetFiltTab [] = {
// string
T_STRING, FN_IS_DENSE, T_STRING,
T_STRING, FN_IS_NDENSE, -1 ,
T_STRING, FN_IS_HOMOG, T_STRING,
T_STRING, FN_IS_NHOMOG, -1 ,
T_STRING, FN_IS_TABLE, -1 ,
T_STRING, FN_IS_RECT, -1 ,
T_STRING, FN_IS_SSORT, T_STRING_SSORT,
T_STRING, FN_IS_NSORT, T_STRING_NSORT,
// ssort string
T_STRING_SSORT, FN_IS_DENSE, T_STRING_SSORT,
T_STRING_SSORT, FN_IS_NDENSE, -1 ,
T_STRING_SSORT, FN_IS_HOMOG, T_STRING_SSORT,
T_STRING_SSORT, FN_IS_NHOMOG, -1 ,
T_STRING_SSORT, FN_IS_TABLE, -1 ,
T_STRING_SSORT, FN_IS_RECT, -1 ,
T_STRING_SSORT, FN_IS_SSORT, T_STRING_SSORT,
T_STRING_SSORT, FN_IS_NSORT, -1 ,
// nsort string
T_STRING_NSORT, FN_IS_DENSE, T_STRING_NSORT,
T_STRING_NSORT, FN_IS_NDENSE, -1 ,
T_STRING_NSORT, FN_IS_HOMOG, T_STRING_NSORT,
T_STRING_NSORT, FN_IS_NHOMOG, -1 ,
T_STRING_NSORT, FN_IS_TABLE, -1 ,
T_STRING_NSORT, FN_IS_RECT, -1 ,
T_STRING_NSORT, FN_IS_SSORT, -1 ,
T_STRING_NSORT, FN_IS_NSORT, T_STRING_NSORT,
-1 , -1 , -1
};
/****************************************************************************
* *
* V ResetFiltTab . . . . . . . . . . . . . . . . . . . unsetter filter tnum
*/
static Int ResetFiltTab [] = {
// string
T_STRING, FN_IS_DENSE, T_STRING,
T_STRING, FN_IS_NDENSE, T_STRING,
T_STRING, FN_IS_HOMOG, T_STRING,
T_STRING, FN_IS_NHOMOG, T_STRING,
T_STRING, FN_IS_TABLE, T_STRING,
T_STRING, FN_IS_RECT, T_STRING,
T_STRING, FN_IS_SSORT, T_STRING,
T_STRING, FN_IS_NSORT, T_STRING,
// ssort string
T_STRING_SSORT, FN_IS_DENSE, T_STRING_SSORT,
T_STRING_SSORT, FN_IS_NDENSE, T_STRING_SSORT,
T_STRING_SSORT, FN_IS_HOMOG, T_STRING_SSORT,
T_STRING_SSORT, FN_IS_NHOMOG, T_STRING_SSORT,
T_STRING_SSORT, FN_IS_TABLE, T_STRING_SSORT,
T_STRING_SSORT, FN_IS_RECT, T_STRING_SSORT,
T_STRING_SSORT, FN_IS_SSORT, T_STRING,
T_STRING_SSORT, FN_IS_NSORT, T_STRING_SSORT,
// nsort string
T_STRING_NSORT, FN_IS_DENSE, T_STRING_NSORT,
T_STRING_NSORT, FN_IS_NDENSE, T_STRING_NSORT,
T_STRING_NSORT, FN_IS_HOMOG, T_STRING_NSORT,
T_STRING_NSORT, FN_IS_NHOMOG, T_STRING_NSORT,
T_STRING_NSORT, FN_IS_TABLE, T_STRING_NSORT,
T_STRING_NSORT, FN_IS_RECT, T_STRING_NSORT,
T_STRING_NSORT, FN_IS_SSORT, T_STRING_NSORT,
T_STRING_NSORT, FN_IS_NSORT, T_STRING,
-1 , -1 , -1
};
/****************************************************************************
* *
* V GVarFilts . . . . . . . . . . . . . . . . . . . list of filters to export
*/
static StructGVarFilt GVarFilts [] = {
GVAR_FILT(IS_STRING, "obj" , &IsStringFilt),
GVAR_FILT(IS_STRING_REP, "obj" , &IsStringRepFilt),
{ 0 , 0 , 0 , 0 , 0 }
};
/****************************************************************************
* *
* V GVarFuncs . . . . . . . . . . . . . . . . . . list of functions to export
*/
static StructGVarFunc GVarFuncs [] = {
GVAR_FUNC_1ARGS(VIEW_STRING_FOR_STRING, string),
GVAR_FUNC_1ARGS(IS_STRING_CONV, string),
GVAR_FUNC_1ARGS(CONV_STRING, string),
GVAR_FUNC_1ARGS(COPY_TO_STRING_REP, string),
GVAR_FUNC_1ARGS(CHAR_INT, integer),
GVAR_FUNC_1ARGS(INT_CHAR, char ),
GVAR_FUNC_1ARGS(CHAR_SINT, integer),
GVAR_FUNC_1ARGS(SINT_CHAR, char ),
GVAR_FUNC_1ARGS(STRING_SINTLIST, list),
GVAR_FUNC_2ARGS(INTLIST_STRING, string, sign),
GVAR_FUNC_1ARGS(SINTLIST_STRING, string),
GVAR_FUNC_1ARGS(EmptyString, len),
GVAR_FUNC_1ARGS(ShrinkAllocationString, str),
GVAR_FUNC_1ARGS(REVNEG_STRING, string),
GVAR_FUNC_3ARGS(POSITION_SUBSTRING, string, substr, off),
#ifdef HPCGAP
GVAR_FUNC_2ARGS(FIND_ALL_IN_STRING, string, characters),
GVAR_FUNC_1ARGS(NORMALIZE_NEWLINES, string),
#endif
GVAR_FUNC_1ARGS(NormalizeWhitespace, string),
GVAR_FUNC_2ARGS(REMOVE_CHARACTERS, string, rem),
GVAR_FUNC_2ARGS(TranslateString, string, trans),
GVAR_FUNC_3ARGS(SplitStringInternal, string, seps, wspace),
GVAR_FUNC_1ARGS(SMALLINT_STR, string),
{ 0 , 0 , 0 , 0 , 0 }
};
/****************************************************************************
* *
* F InitKernel ( < module > ) . . . . . . . . initialise kernel data structures
*/
static Char CharCookie[256 ][21 ];
static Int InitKernel (
StructInitInfo * module )
{
UInt t1;
UInt t2;
Int i, j;
const Char * cookie_base = "src/stringobj.c:Char" ;
// GASMAN marking functions and GASMAN names
InitBagNamesFromTable( BagNames );
InitMarkFuncBags( T_CHAR , MarkNoSubBags );
for ( t1 = T_STRING; t1 <= T_STRING_SSORT; t1 += 2 ) {
InitMarkFuncBags( t1 , MarkNoSubBags );
InitMarkFuncBags( t1 +IMMUTABLE , MarkNoSubBags );
}
#ifdef HPCGAP
for ( t1 = T_STRING; t1 <= T_STRING_SSORT; t1 += 2 ) {
MakeBagTypePublic( t1 + IMMUTABLE );
}
MakeBagTypePublic(T_CHAR);
#endif
// make all the character constants once and for all
for ( i = 0 ; i < 256 ; i++ ) {
for (j = 0 ; j < 17 ; j++ ) {
CharCookie[i][j] = cookie_base[j];
}
CharCookie[i][j++] = '0' + i/100 ;
CharCookie[i][j++] = '0' + (i % 100 )/10 ;
CharCookie[i][j++] = '0' + i % 10 ;
CharCookie[i][j++] = '\0' ;
InitGlobalBag( &ObjsChar[i], &(CharCookie[i][0 ]) );
}
// install the type method
ImportGVarFromLibrary( "TYPE_CHAR" , &TYPE_CHAR );
TypeObjFuncs[ T_CHAR ] = TypeChar;
// install the type method
ImportGVarFromLibrary("TYPE_STRING_MUTABLE" , &TYPE_STRING_MUTABLE);
ImportGVarFromLibrary("TYPE_STRING_IMMUTABLE" , &TYPE_STRING_IMMUTABLE);
ImportGVarFromLibrary("TYPE_STRING_NSORT_MUTABLE" , &TYPE_STRING_NSORT_MUTABLE);
ImportGVarFromLibrary("TYPE_STRING_NSORT_IMMUTABLE" , &TYPE_STRING_NSORT_IMMUTABLE);
ImportGVarFromLibrary("TYPE_STRING_SSORT_MUTABLE" , &TYPE_STRING_SSORT_MUTABLE);
ImportGVarFromLibrary("TYPE_STRING_SSORT_IMMUTABLE" , &TYPE_STRING_SSORT_IMMUTABLE);
TypeObjFuncs[ T_STRING ] = TypeString;
TypeObjFuncs[ T_STRING +IMMUTABLE ] = TypeString;
TypeObjFuncs[ T_STRING_NSORT ] = TypeStringNSort;
TypeObjFuncs[ T_STRING_NSORT +IMMUTABLE ] = TypeStringNSort;
TypeObjFuncs[ T_STRING_SSORT ] = TypeStringSSort;
TypeObjFuncs[ T_STRING_SSORT +IMMUTABLE ] = TypeStringSSort;
// init filters and functions
InitHdlrFiltsFromTable( GVarFilts );
InitHdlrFuncsFromTable( GVarFuncs );
// initialise list tables
InitClearFiltsTNumsFromTable ( ClearFiltsTab );
InitHasFiltListTNumsFromTable ( HasFiltTab );
InitSetFiltListTNumsFromTable ( SetFiltTab );
InitResetFiltListTNumsFromTable( ResetFiltTab );
#ifdef GAP_ENABLE_SAVELOAD
// Install the saving function
SaveObjFuncs[ T_CHAR ] = SaveChar;
LoadObjFuncs[ T_CHAR ] = LoadChar;
#endif
// install the character functions
PrintObjFuncs[ T_CHAR ] = PrintChar;
EqFuncs[ T_CHAR ][ T_CHAR ] = EqChar;
LtFuncs[ T_CHAR ][ T_CHAR ] = LtChar;
#ifdef GAP_ENABLE_SAVELOAD
// install the saving method
for ( t1 = T_STRING; t1 <= T_STRING_SSORT; t1 += 2 ) {
SaveObjFuncs[ t1 ] = SaveString;
SaveObjFuncs[ t1 +IMMUTABLE ] = SaveString;
LoadObjFuncs[ t1 ] = LoadString;
LoadObjFuncs[ t1 +IMMUTABLE ] = LoadString;
}
#endif
#if !defined (USE_THREADSAFE_COPYING)
// install the copy method
for ( t1 = T_STRING; t1 <= T_STRING_SSORT; t1 += 2 ) {
CopyObjFuncs [ t1 ] = CopyString;
CopyObjFuncs [ t1 +IMMUTABLE ] = CopyString;
CleanObjFuncs[ t1 ] = 0 ;
CleanObjFuncs[ t1 +IMMUTABLE ] = 0 ;
}
#endif
// install the print method
for ( t1 = T_STRING; t1 <= T_STRING_SSORT; t1 += 2 ) {
PrintObjFuncs[ t1 ] = PrintString;
PrintObjFuncs[ t1 +IMMUTABLE ] = PrintString;
}
// install the comparison methods
for ( t1 = T_STRING; t1 <= T_STRING_SSORT+IMMUTABLE; t1++ ) {
for ( t2 = T_STRING; t2 <= T_STRING_SSORT+IMMUTABLE; t2++ ) {
EqFuncs[ t1 ][ t2 ] = EqString;
LtFuncs[ t1 ][ t2 ] = LtString;
}
}
// install the list methods
for ( t1 = T_STRING; t1 <= T_STRING_SSORT; t1 += 2 ) {
LenListFuncs [ t1 ] = LenString;
LenListFuncs [ t1 +IMMUTABLE ] = LenString;
IsbListFuncs [ t1 ] = IsbString;
IsbListFuncs [ t1 +IMMUTABLE ] = IsbString;
Elm0ListFuncs [ t1 ] = Elm0String;
Elm0ListFuncs [ t1 +IMMUTABLE ] = Elm0String;
Elm0vListFuncs [ t1 ] = Elm0vString;
Elm0vListFuncs [ t1 +IMMUTABLE ] = Elm0vString;
ElmListFuncs [ t1 ] = ElmString;
ElmListFuncs [ t1 +IMMUTABLE ] = ElmString;
ElmvListFuncs [ t1 ] = ElmvString;
ElmvListFuncs [ t1 +IMMUTABLE ] = ElmvString;
ElmwListFuncs [ t1 ] = ElmwString;
ElmwListFuncs [ t1 +IMMUTABLE ] = ElmwString;
ElmsListFuncs [ t1 ] = ElmsString;
ElmsListFuncs [ t1 +IMMUTABLE ] = ElmsString;
UnbListFuncs [ t1 ] = UnbString;
AssListFuncs [ t1 ] = AssString;
AsssListFuncs [ t1 ] = AsssString;
IsDenseListFuncs[ t1 ] = AlwaysYes;
IsDenseListFuncs[ t1 +IMMUTABLE ] = AlwaysYes;
IsHomogListFuncs[ t1 ] = AlwaysYes;
IsHomogListFuncs[ t1 +IMMUTABLE ] = AlwaysYes;
IsTableListFuncs[ t1 ] = AlwaysNo;
IsTableListFuncs[ t1 +IMMUTABLE ] = AlwaysNo;
IsSSortListFuncs[ t1 ] = IsSSortString;
IsSSortListFuncs[ t1 +IMMUTABLE ] = IsSSortString;
IsPossListFuncs [ t1 ] = IsPossString;
IsPossListFuncs [ t1 +IMMUTABLE ] = IsPossString;
PosListFuncs [ t1 ] = PosString;
PosListFuncs [ t1 +IMMUTABLE ] = PosString;
PlainListFuncs [ t1 ] = PlainString;
PlainListFuncs [ t1 +IMMUTABLE ] = PlainString;
}
IsSSortListFuncs[ T_STRING_NSORT ] = AlwaysNo;
IsSSortListFuncs[ T_STRING_NSORT +IMMUTABLE ] = AlwaysNo;
IsSSortListFuncs[ T_STRING_SSORT ] = AlwaysYes;
IsSSortListFuncs[ T_STRING_SSORT +IMMUTABLE ] = AlwaysYes;
// install the `IsString' functions
for ( t1 = FIRST_REAL_TNUM; t1 <= LAST_REAL_TNUM; t1++ ) {
assert(IsStringFuncs[ t1 ] == 0 );
IsStringFuncs[ t1 ] = AlwaysNo;
}
IsStringFuncs[ T_PLIST ] = IsStringList;
IsStringFuncs[ T_PLIST +IMMUTABLE ] = IsStringList;
IsStringFuncs[ T_PLIST_DENSE ] = IsStringList;
IsStringFuncs[ T_PLIST_DENSE+IMMUTABLE ] = IsStringList;
IsStringFuncs[ T_PLIST_EMPTY ] = AlwaysYes;
IsStringFuncs[ T_PLIST_EMPTY+IMMUTABLE ] = AlwaysYes;
for ( t1 = T_PLIST_HOM; t1 <= T_PLIST_HOM_SSORT; t1 += 2 ) {
IsStringFuncs[ t1 ] = IsStringListHom;
IsStringFuncs[ t1 +IMMUTABLE ] = IsStringListHom;
}
for ( t1 = T_STRING; t1 <= T_STRING_SSORT; t1++ ) {
IsStringFuncs[ t1 ] = AlwaysYes;
}
for ( t1 = FIRST_EXTERNAL_TNUM; t1 <= LAST_EXTERNAL_TNUM; t1++ ) {
IsStringFuncs[ t1 ] = IsStringObject;
}
MakeImmutableObjFuncs[ T_STRING ] = MakeImmutableNoRecurse;
MakeImmutableObjFuncs[ T_STRING_SSORT ] = MakeImmutableNoRecurse;
MakeImmutableObjFuncs[ T_STRING_NSORT ] = MakeImmutableNoRecurse;
return 0 ;
}
/****************************************************************************
* *
* F InitLibrary ( < module > ) . . . . . . . initialise library data structures
*/
static Int InitLibrary (
StructInitInfo * module )
{
Int i;
// make all the character constants once and for all
for ( i = 0 ; i < 256 ; i++ ) {
ObjsChar[i] = NewBag(T_CHAR, 1 );
SET_CHAR_VALUE(ObjsChar[i], (UChar)i);
}
// init filters and functions
InitGVarFiltsFromTable( GVarFilts );
InitGVarFuncsFromTable( GVarFuncs );
return 0 ;
}
/****************************************************************************
* *
* F InitInfoString ( ) . . . . . . . . . . . . . . . . table of init functions
*/
static StructInitInfo module = {
// init struct using C99 designated initializers; for a full list of
// fields, please refer to the definition of StructInitInfo
.type = MODULE_BUILTIN,
.name = "string" ,
.initKernel = InitKernel,
.initLibrary = InitLibrary,
};
StructInitInfo * InitInfoString ( void )
{
return &module;
}
Messung V0.5 in Prozent C=91 H=80 G=85
¤ Dauer der Verarbeitung: 0.58 Sekunden
(vorverarbeitet am 2026-09-28)
¤
*© Formatika GbR, Deutschland