/****************************************************************************
**
*F FuncAddRowVectorVecFFEs( <self>, <vecL>, <vecR> )
**
*/
Obj FuncAddRowVectorVecFFEs( Obj self, Obj vecL, Obj vecR )
{
Obj *ptrL;
Obj *ptrR;
FFV valS;
FFV valL;
FFV valR;
FF fld;
FFV *succ;
UInt len;
UInt xtype;
UInt i;
xtype = KTNumPlist(vecL, (Obj *) 0);
if (xtype != T_PLIST_FFE && xtype != T_PLIST_FFE + IMMUTABLE)
return TRY_NEXT_METHOD;
xtype = KTNumPlist(vecR, (Obj *) 0);
if (xtype != T_PLIST_FFE && xtype != T_PLIST_FFE + IMMUTABLE)
return TRY_NEXT_METHOD;
/* check the lengths */
len = LEN_PLIST(vecL);
if (len != LEN_PLIST(vecR)) {
vecR = ErrorReturnObj(
"Vector *: vector lengths differ <left> %d, <right> %d",
(Int)len, (Int)LEN_PLIST(vecR),
"you can replace vector <right> via 'return <right>;'");
return CALL_2ARGS(AddRowVectorOp, vecL, vecR);
}
/* check the fields */
fld = FLD_FFE(ELM_PLIST(vecL, 1));
if (FLD_FFE(ELM_PLIST(vecR, 1)) != fld) {
/* check the characteristic */
if (CHAR_FF(fld) == CHAR_FF(FLD_FFE(ELM_PLIST(vecR, 1))))
return TRY_NEXT_METHOD;
vecR = ErrorReturnObj(
"AddRowVector: vectors have different fields",
0L, 0L,
"you can replace vector <right> via 'return <right>;'");
return CALL_2ARGS(AddRowVectorOp, vecL, vecR);
}
succ = SUCC_FF(fld);
ptrL = ADDR_OBJ(vecL);
ptrR = ADDR_OBJ(vecR);
for (i = 1; i <= len; i++) {
valL = VAL_FFE(ptrL[i]);
valR = VAL_FFE(ptrR[i]);
valS = SUM_FFV(valL, valR, succ);
ptrL[i] = NEW_FFE(fld, valS);
}
return (Obj) 0;
}
/****************************************************************************
**
*F FuncLIST_SORTED_LIST( <self>, <list> ) . . . . . make a set from a list
**
** 'FuncLIST_SORTED_LIST' implements the internal function 'SetList'.
**
** 'SetList( <list> )'
**
** 'SetList' returns a new proper set, which is represented as a sorted list
** without holes or duplicates, containing the elements of the list <list>.
**
** 'SetList' returns a new list even if the list <list> is already a proper
** set, in this case it is equivalent to 'ShallowCopy' (see "ShallowCopy").
*/
Obj FuncLIST_SORTED_LIST (
Obj self,
Obj list )
{
Obj set; /* result */
/* check the argument */
while ( ! IS_SMALL_LIST( list ) ) {
list = ErrorReturnObj(
"Set: <list> must be a small list (not a %s)",
(Int)TNAM_OBJ(list), 0L,
"you can replace <list> via 'return <list>;'" );
}
/* if the list is empty create a new empty list */
if ( LEN_LIST(list) == 0 ) {
set = NEW_PLIST( T_PLIST_EMPTY, 0 );
}
/* if <list> is a set just shallow copy it */
else if ( /* IS_HOMOG_LIST(list) && */ IS_SSORT_LIST(list) ) {
set = SHALLOW_COPY_OBJ( list );
}
/* otherwise let 'SetList' do the work */
else {
set = SetList( list );
}
/* return the set */
return set;
}
static void UnbRecError(Obj rec, UInt rnam)
{
rec = ErrorReturnObj(
"Record Unbind: <rec> must be a record (not a %s)",
(Int)TNAM_OBJ(rec), 0L,
"you can replace <rec> via 'return <rec>;'" );
UNB_REC( rec, rnam );
}
static void AssRecError(Obj rec, UInt rnam, Obj obj)
{
rec = ErrorReturnObj(
"Record Assignment: <rec> must be a record (not a %s)",
(Int)TNAM_OBJ(rec), 0L,
"you can replace <rec> via 'return <rec>;'" );
ASS_REC( rec, rnam, obj );
}
static Int IsbRecError(Obj rec, UInt rnam)
{
rec = ErrorReturnObj(
"Record IsBound: <rec> must be a record (not a %s)",
(Int)TNAM_OBJ(rec), 0L,
"you can replace <rec> via 'return <rec>;'" );
return ISB_REC( rec, rnam );
}
static Obj ElmRecError(Obj rec, UInt rnam)
{
rec = ErrorReturnObj(
"Record Element: <rec> must be a record (not a %s)",
(Int)TNAM_OBJ(rec), 0L,
"you can replace <rec> via 'return <rec>;'" );
return ELM_REC( rec, rnam );
}
Obj FuncIS_BLOCKED_IOSTREAM( Obj self, Obj stream )
{
UInt pty = INT_INTOBJ(stream);
while (!PtyIOStreams[pty].inuse)
pty = INT_INTOBJ(ErrorReturnObj("IOSTREAM %d is not in use",pty,0L,
"you can replace stream number <num> via 'return <num>;'"));
return (PtyIOStreams[pty].blocked || PtyIOStreams[pty].changed || !PtyIOStreams[pty].alive) ? True : False;
}
Obj FuncFD_OF_IOSTREAM( Obj self, Obj stream )
{
UInt pty = INT_INTOBJ(stream);
while (!PtyIOStreams[pty].inuse)
pty = INT_INTOBJ(ErrorReturnObj("IOSTREAM %d is not in use",pty,0L,
"you can replace stream number <num> via 'return <num>;'"));
return INTOBJ_INT(PtyIOStreams[pty].ptyFD);
}
Obj FuncWRITE_IOSTREAM( Obj self, Obj stream, Obj string, Obj len )
{
UInt pty = INT_INTOBJ(stream);
ConvString(string);
while (!PtyIOStreams[pty].inuse)
pty = INT_INTOBJ(ErrorReturnObj("IOSTREAM %d is not in use",pty,0L,
"you can replace stream number <num> via 'return <num>;'"));
HandleChildStatusChanges(pty);
return INTOBJ_INT(WriteToPty(pty, CSTR_STRING(string), INT_INTOBJ(len)));
}
static Obj ElmRecObject(Obj obj, UInt rnam)
{
Obj elm;
elm = DoOperation2Args( ElmRecOper, obj, INTOBJ_INT(rnam) );
while (elm == 0)
elm = ErrorReturnObj("Record access method must return a value",0L,0L,
"you can supply a value <val> via 'return <val>;'");
return elm;
}
Obj FuncSIGNAL_CHILD_IOSTREAM( Obj self, Obj stream , Obj sig)
{
UInt pty = INT_INTOBJ(stream);
while (!PtyIOStreams[pty].inuse)
pty = INT_INTOBJ(ErrorReturnObj("IOSTREAM %d is not in use",pty,0L,
"you can replace stream number <num> via 'return <num>;'"));
/* Don't check for child having changes status */
SignalChild( pty, INT_INTOBJ(sig) );
return 0;
}
static Obj MPD_STRING(Obj self, Obj s, Obj prec)
{
while (!IsStringConv(s))
{
s = ErrorReturnObj("MPD_STRING: object to be converted must be a string, not a %s",
(Int)TNAM_OBJ(s),0,
"You can return a string to continue" );
}
TEST_IS_INTOBJ("MPD_STRING",prec);
int n = INT_INTOBJ(prec);
if (n == 0)
n = GET_LEN_STRING(s)*1000 / 301;
Obj g = NEW_MPD(INT_INTOBJ(prec));
char *p = (char *) CHARS_STRING(s), *newp;
int sign = 1;
mpd_set_ui(MPD_OBJ(g), 0, MPD_RNDNN);
mpfr_ptr f = MPD_OBJ(g)->re;
Obj newg = NEW_MPFR(INT_INTOBJ(prec));
for (;;) {
printf("<%c>",*p);
switch (*p) {
case '-':
case '+':
case 0:
if (!mpfr_nan_p(MPFR_OBJ(newg))) { /* drop the last read float */
mpfr_add (f, f, MPFR_OBJ(newg), GMP_RNDN);
mpfr_set_nan (MPFR_OBJ(newg));
f = MPD_OBJ(g)->re;
sign = 1;
}
if (!*p)
return g;
if (*p == '-')
sign = -sign;
case '*': p++; break;
case 'i':
case 'I': if (f == GET_MPD(g)->re) {
f = MPD_OBJ(g)->im;
if (mpfr_nan_p(MPFR_OBJ(newg)))
mpfr_set_si (MPFR_OBJ(newg), sign, GMP_RNDN); /* accept 'i' as '1*i' */
} else return Fail;
p++; break;
default:
mpfr_strtofr(MPFR_OBJ(newg), p, &newp, 10, GMP_RNDN);
if (newp == p && f != GET_MPD(g)->im)
return Fail; /* no valid characters read */
if (sign == -1)
mpfr_neg(MPFR_OBJ(newg), MPFR_OBJ(newg), GMP_RNDN);
p = newp;
}
}
return g;
}
/****************************************************************************
**
*F DiffVecFFEFFE(<vecL>,<elmR>) difference of a vector and a fin field elm
**
** 'DiffVecFFEFFE' returns the difference of the vector <vecL> and the
** finite field element <elmR>. The difference is a list, where each
** element is the difference of <elmR> and the corresponding element of
** <vecL>.
**
** 'DiffVecFFEFFE' is an improved version of 'DiffListScl', which does not
** call 'DIFF'.
*/
Obj DiffVecFFEFFE (
Obj vecL,
Obj elmR )
{
Obj vecD; /* handle of the difference */
Obj * ptrD; /* pointer into the difference */
FFV valD; /* the value of a difference */
Obj * ptrL; /* pointer into the left operand */
FFV valL; /* the value of an element in vecL */
UInt len; /* length */
UInt i; /* loop variable */
FF fld; /* finite field */
FF * succ; /* successor table */
FFV valR; /* the value of elmR */
/* get the field and check that vecL and elmR have the same field */
fld = FLD_FFE(ELM_PLIST(vecL, 1));
if (FLD_FFE(elmR) != fld) {
/* check the characteristic */
if (CHAR_FF(fld) == CHAR_FF(FLD_FFE(elmR)))
return DiffListScl(vecL, elmR);
elmR = ErrorReturnObj(
"<vec>-<elm>: <elm> and <vec> must belong to the same finite field",
0L, 0L, "you can replace <elm> via 'return <elm>;'");
return DIFF(vecL, elmR);
}
/* make the result list */
len = LEN_PLIST(vecL);
vecD = NEW_PLIST(IS_MUTABLE_OBJ(vecL) ?
T_PLIST_FFE : T_PLIST_FFE + IMMUTABLE, len);
SET_LEN_PLIST(vecD, len);
/* to subtract we need the successor table */
succ = SUCC_FF(fld);
/* loop over the elements and subtract */
valR = VAL_FFE(elmR);
valR = NEG_FFV(valR, succ);
ptrL = ADDR_OBJ(vecL);
ptrD = ADDR_OBJ(vecD);
for (i = 1; i <= len; i++) {
valL = VAL_FFE(ptrL[i]);
valD = SUM_FFV(valL, valR, succ);
ptrD[i] = NEW_FFE(fld, valD);
}
/* return the result */
return vecD;
}
/****************************************************************************
**
*F ProdVecFFEVecFFE(<vecL>,<vecR>) . . . . . . . . . product of two vectors
**
** 'ProdVecFFEVecFFE' returns the product of the two vectors <vecL> and
** <vecR>. The product is the sum of the products of the corresponding
** elements of the two lists.
**
** 'ProdVecFFEVecFFE' is an improved version of 'ProdListList', which does
** not call 'PROD'.
*/
Obj ProdVecFFEVecFFE (
Obj vecL,
Obj vecR )
{
FFV valP; /* one product */
FFV valS; /* sum of the products */
Obj * ptrL; /* pointer into the left operand */
FFV valL; /* one element of left operand */
Obj * ptrR; /* pointer into the right operand */
FFV valR; /* one element of right operand */
UInt lenL, lenR, len; /* length */
UInt i; /* loop variable */
FF fld; /* finite field */
FF * succ; /* successor table */
/* check the lengths */
lenL = LEN_PLIST(vecL);
lenR = LEN_PLIST(vecR);
len = (lenL < lenR) ? lenL : lenR;
/* check the fields */
fld = FLD_FFE(ELM_PLIST(vecL, 1));
if (FLD_FFE(ELM_PLIST(vecR, 1)) != fld) {
/* check the characteristic */
if (CHAR_FF(fld) == CHAR_FF(FLD_FFE(ELM_PLIST(vecR, 1))))
return ProdListList(vecL, vecR);
vecR = ErrorReturnObj(
"Vector *: vectors have different fields",
0L, 0L,
"you can replace vector <right> via 'return <right>;'");
return PROD(vecL, vecR);
}
/* to add we need the successor table */
succ = SUCC_FF(fld);
/* loop over the elements and add */
valS = (FFV)0;
ptrL = ADDR_OBJ(vecL);
ptrR = ADDR_OBJ(vecR);
for (i = 1; i <= len; i++) {
valL = VAL_FFE(ptrL[i]);
valR = VAL_FFE(ptrR[i]);
valP = PROD_FFV(valL, valR, succ);
valS = SUM_FFV(valS, valP, succ);
}
/* return the result */
return NEW_FFE(fld, valS);
}
/****************************************************************************
**
*F SumFFEVecFFE(<elmL>,<vecR>) . . . . sum of an fin field elm and a vector
**
** 'SumFFEVecFFE' returns the sum of the fin field elm <elmL> and the vector
** <vecR>. The sum is a list, where each element is the sum of <elmL> and
** the corresponding element of <vecR>.
**
** 'SumFFEVecFFE' is an improved version of 'SumSclList', which does not
** call 'SUM'.
*/
Obj SumFFEVecFFE (
Obj elmL,
Obj vecR )
{
Obj vecS; /* handle of the sum */
Obj * ptrS; /* pointer into the sum */
FFV valS; /* the value of a sum */
Obj * ptrR; /* pointer into the right operand */
FFV valR; /* the value of an element in vecR */
UInt len; /* length */
UInt i; /* loop variable */
FF fld; /* finite field */
FF * succ; /* successor table */
FFV valL; /* the value of elmL */
/* get the field and check that elmL and vecR have the same field */
fld = FLD_FFE(ELM_PLIST(vecR, 1));
if (FLD_FFE(elmL) != fld) {
/* check the characteristic */
if (CHAR_FF(fld) == CHAR_FF(FLD_FFE(elmL)))
return SumSclList(elmL, vecR);
elmL = ErrorReturnObj(
"<elm>+<vec>: <elm> and <vec> must belong to the same finite field",
0L, 0L, "you can replace <elm> via 'return <elm>;'");
return SUM(elmL, vecR);
}
/* make the result list */
len = LEN_PLIST(vecR);
vecS = NEW_PLIST(IS_MUTABLE_OBJ(vecR) ?
T_PLIST_FFE : T_PLIST_FFE + IMMUTABLE, len);
SET_LEN_PLIST(vecS, len);
/* to add we need the successor table */
succ = SUCC_FF(fld);
/* loop over the elements and add */
valL = VAL_FFE(elmL);
ptrR = ADDR_OBJ(vecR);
ptrS = ADDR_OBJ(vecS);
for (i = 1; i <= len; i++) {
valR = VAL_FFE(ptrR[i]);
valS = SUM_FFV(valL, valR, succ);
ptrS[i] = NEW_FFE(fld, valS);
}
/* return the result */
return vecS;
}
Obj FuncIS_EQUAL_SET (
Obj self,
Obj list1,
Obj list2 )
{
/* check the arguments, convert to sets if necessary */
while ( ! IS_SMALL_LIST(list1) ) {
list1 = ErrorReturnObj(
"IsEqualSet: <list1> must be a small list (not a %s)",
(Int)TNAM_OBJ(list1), 0L,
"you can replace <list1> via 'return <list1>;'" );
}
if ( ! IsSet( list1 ) ) list1 = SetList( list1 );
while ( ! IS_SMALL_LIST(list2) ) {
list2 = ErrorReturnObj(
"IsEqualSet: <list2> must be a small list (not a %s)",
(Int)TNAM_OBJ(list2), 0L,
"you can replace <list2> via 'return <list2>;'" );
}
if ( ! IsSet( list2 ) ) list2 = SetList( list2 );
/* and now compare them */
return (EqSet( list1, list2 ) ? True : False );
}
Obj FuncMACFLOAT_STRING( Obj self, Obj s )
{
while (!IsStringConv(s))
{
s = ErrorReturnObj("MACFLOAT_STRING: object to be converted must be a string not a %s",
(Int)(InfoBags[TNUM_OBJ(s)].name),0,"You can return a string to continue" );
}
char * endptr;
UChar *sp = CHARS_STRING(s);
Obj res= NEW_MACFLOAT((Double) STRTOD((char *)sp,&endptr));
if ((UChar *)endptr != sp + GET_LEN_STRING(s))
return Fail;
return res;
}
/****************************************************************************
**
*F FuncNameRNam(<self>,<rnam>) . . . . convert a record name to a string
**
** 'FuncNameRNam' implements the internal function 'NameRName'.
**
** 'NameRName( <rnam> )'
**
** 'NameRName' returns the string corresponding to the record name <rnam>.
*/
static Obj FuncNameRNam(Obj self, Obj rnam)
{
Obj name;
Obj oname;
const UInt countRNam = LEN_PLIST(NamesRNam);
while ( ! IS_INTOBJ(rnam)
|| INT_INTOBJ(rnam) <= 0
|| countRNam < INT_INTOBJ(rnam) ) {
rnam = ErrorReturnObj(
"NameRName: <rnam> must be a record name (not a %s)",
(Int)TNAM_OBJ(rnam), 0L,
"you can replace <rnam> via 'return <rnam>;'" );
}
oname = NAME_RNAM( INT_INTOBJ(rnam) );
name = CopyToStringRep(oname);
return name;
}
Obj FuncREAD_IOSTREAM_NOWAIT(Obj self, Obj stream, Obj len)
{
Obj string;
UInt pty = INT_INTOBJ(stream);
Int ret;
string = NEW_STRING(INT_INTOBJ(len));
while (!PtyIOStreams[pty].inuse)
pty = INT_INTOBJ(ErrorReturnObj("IOSTREAM %d is not in use",pty,0L,
"you can replace stream number <num> via 'return <num>;'"));
/* HandleChildStatusChanges(pty); Omit this to allow picking up "trailing" bytes*/
ret = ReadFromPty2(pty, CSTR_STRING(string), INT_INTOBJ(len), 0);
if (ret == -1)
return Fail;
SET_LEN_STRING(string, ret);
ResizeBag(string, SIZEBAG_STRINGLEN(ret));
return string;
}
Obj NameRNamHandler (
Obj self,
Obj rnam )
{
Obj name;
Char *cname;
while ( ! IS_INTOBJ(rnam)
|| INT_INTOBJ(rnam) <= 0
|| CountRNam < INT_INTOBJ(rnam) ) {
rnam = ErrorReturnObj(
"NameRName: <rnam> must be a record name (not a %s)",
(Int)TNAM_OBJ(rnam), 0L,
"you can replace <rnam> via 'return <rnam>;'" );
}
cname = NAME_RNAM( INT_INTOBJ(rnam) );
C_NEW_STRING_DYN( name, cname);
return name;
}
Obj FuncCLOSE_PTY_IOSTREAM( Obj self, Obj stream )
{
UInt pty = INT_INTOBJ(stream);
int status;
int retcode;
/*UInt count; */
while (!PtyIOStreams[pty].inuse)
pty = INT_INTOBJ(ErrorReturnObj("IOSTREAM %d is not in use",pty,0L,
"you can replace stream number <num> via 'return <num>;'"));
PtyIOStreams[pty].inuse = 0;
/* Close down the child */
retcode = close(PtyIOStreams[pty].ptyFD);
if (retcode)
Pr("Strange close return code %d\n",retcode, 0);
kill(PtyIOStreams[pty].childPID, SIGTERM);
retcode = waitpid(PtyIOStreams[pty].childPID, &status, 0);
FreeStream(pty);
return 0;
}
/****************************************************************************
**
*F RNamObj(<obj>) . . . . . . . . . . . convert an object to a record name
**
** 'RNamObj' returns the record name corresponding to the object <obj>,
** which currently must be a string or an integer.
*/
UInt RNamObj (
Obj obj )
{
/* convert integer object */
if ( IS_INTOBJ(obj) ) {
return RNamIntg( INT_INTOBJ(obj) );
}
/* convert string object (empty string may have type T_PLIST) */
else if ( IsStringConv(obj) && IS_STRING_REP(obj) ) {
return RNamName( CSTR_STRING(obj) );
}
/* otherwise fail */
else {
obj = ErrorReturnObj(
"Record: '<rec>.(<obj>)' <obj> must be a string or an integer",
0L, 0L,
"you can replace <obj> via 'return <obj>;'" );
return RNamObj( obj );
}
}
Obj FuncMultRowVectorVecFFEs( Obj self, Obj vec, Obj mult )
{
Obj *ptr;
FFV valM;
FFV valS;
FFV val;
FF fld;
FFV *succ;
UInt len;
UInt xtype;
UInt i;
if (TNUM_OBJ(mult) != T_FFE)
return TRY_NEXT_METHOD;
if (VAL_FFE(mult) == 1)
return (Obj) 0;
xtype = KTNumPlist(vec, (Obj *) 0);
if (xtype != T_PLIST_FFE &&
xtype != T_PLIST_FFE + IMMUTABLE)
return TRY_NEXT_METHOD;
/* check the lengths */
len = LEN_PLIST(vec);
fld = FLD_FFE(ELM_PLIST(vec, 1));
/* Now check the multiplier field */
if (FLD_FFE(mult) != fld) {
/* check the characteristic */
if (CHAR_FF(fld) != CHAR_FF(FLD_FFE(mult))) {
mult = ErrorReturnObj(
"MultRowVector: <multiplier> has different field",
0L, 0L,
"you can replace <multiplier> via 'return <multiplier>;'");
return CALL_2ARGS(MultRowVectorOp, vec, mult);
}
/* if the multiplier is over a non subfield then redispatch */
if ((DEGR_FF(fld) % DegreeFFE(mult)) != 0)
return TRY_NEXT_METHOD;
/* otherwise it's a subfield, so promote it */
valM = VAL_FFE(mult);
if (valM != 0)
valM = 1 + (valM - 1) * (SIZE_FF(fld) - 1) / (SIZE_FF(FLD_FFE(mult)) - 1);
} else
valM = VAL_FFE(mult);
succ = SUCC_FF(fld);
ptr = ADDR_OBJ(vec);
/* two versions of the loop to avoid multipling by 0 */
if (valM == 0) {
Obj z;
z = NEW_FFE(fld, 0);
for (i = 1; i <= len; i++) {
ptr[i] = z;
}
} else
for (i = 1; i <= len; i++) {
val = VAL_FFE(ptr[i]);
valS = PROD_FFV(val, valM, succ);
ptr[i] = NEW_FFE(fld, valS);
}
return (Obj) 0;
}
Obj FuncAddRowVectorVecFFEsMult( Obj self, Obj vecL, Obj vecR, Obj mult )
{
Obj *ptrL;
Obj *ptrR;
FFV valM;
FFV valS;
FFV valL;
FFV valR;
FF fld;
FFV *succ;
UInt len;
UInt xtype;
UInt i;
if (TNUM_OBJ(mult) != T_FFE)
return TRY_NEXT_METHOD;
if (VAL_FFE(mult) == 0)
return (Obj) 0;
xtype = KTNumPlist(vecL, (Obj *) 0);
if (xtype != T_PLIST_FFE && xtype != T_PLIST_FFE + IMMUTABLE)
return TRY_NEXT_METHOD;
xtype = KTNumPlist(vecR, (Obj *) 0);
if (xtype != T_PLIST_FFE && xtype != T_PLIST_FFE + IMMUTABLE)
return TRY_NEXT_METHOD;
/* check the lengths */
len = LEN_PLIST(vecL);
if (len != LEN_PLIST(vecR)) {
vecR = ErrorReturnObj(
"AddRowVector: vector lengths differ <left> %d, <right> %d",
(Int)len, (Int)LEN_PLIST(vecR),
"you can replace vector <right> via 'return <right>;'");
return CALL_3ARGS(AddRowVectorOp, vecL, vecR, mult);
}
/* check the fields */
fld = FLD_FFE(ELM_PLIST(vecL, 1));
if (FLD_FFE(ELM_PLIST(vecR, 1)) != fld) {
/* check the characteristic */
if (CHAR_FF(fld) == CHAR_FF(FLD_FFE(ELM_PLIST(vecR, 1))))
return TRY_NEXT_METHOD;
vecR = ErrorReturnObj(
"AddRowVector: vectors have different fields",
0L, 0L,
"you can replace vector <right> via 'return <right>;'");
return CALL_3ARGS(AddRowVectorOp, vecL, vecR, mult);
}
/* Now check the multiplier field */
if (FLD_FFE(mult) != fld) {
/* check the characteristic */
if (CHAR_FF(fld) != CHAR_FF(FLD_FFE(mult))) {
mult = ErrorReturnObj(
"AddRowVector: <multiplier> has different field",
0L, 0L,
"you can replace <multiplier> via 'return <multiplier>;'");
return CALL_3ARGS(AddRowVectorOp, vecL, vecR, mult);
}
/* if the multiplier is over a non subfield then redispatch */
if ((DEGR_FF(fld) % DegreeFFE(mult)) != 0)
return TRY_NEXT_METHOD;
/* otherwise it's a subfield, so promote it */
valM = VAL_FFE(mult);
if (valM != 0)
valM = 1 + (valM - 1) * (SIZE_FF(fld) - 1) / (SIZE_FF(FLD_FFE(mult)) - 1);
} else
valM = VAL_FFE(mult);
succ = SUCC_FF(fld);
ptrL = ADDR_OBJ(vecL);
ptrR = ADDR_OBJ(vecR);
/* two versions of the loop to avoid multipling by 1 */
if (valM == 1)
for (i = 1; i <= len; i++) {
valL = VAL_FFE(ptrL[i]);
valR = VAL_FFE(ptrR[i]);
valS = SUM_FFV(valL, valR, succ);
ptrL[i] = NEW_FFE(fld, valS);
}
else
for (i = 1; i <= len; i++) {
valL = VAL_FFE(ptrL[i]);
valR = VAL_FFE(ptrR[i]);
valS = PROD_FFV(valR, valM, succ);
valS = SUM_FFV(valL, valS, succ);
ptrL[i] = NEW_FFE(fld, valS);
}
return (Obj) 0;
}
/****************************************************************************
**
*F DiffVecFFEVecFFE(<vecL>,<vecR>) . . . . . . . . difference of two vectors
**
** 'DiffVecFFEVecFFE' returns the difference of the two vectors <vecL> and
** <vecR>. The difference is a new list, where each element is the
** difference of the corresponding elements of <vecL> and <vecR>.
**
** 'DiffVecFFEVecFFE' is an improved version of 'DiffListList', which does
** not call 'DIFF'.
*/
Obj DiffVecFFEVecFFE (
Obj vecL,
Obj vecR )
{
Obj vecD; /* handle of the difference */
Obj * ptrD; /* pointer into the difference */
FFV valD; /* one element of difference list */
Obj * ptrL; /* pointer into the left operand */
FFV valL; /* one element of left operand */
Obj * ptrR; /* pointer into the right operand */
FFV valR; /* one element of right operand */
UInt len, lenL, lenR; /* length */
UInt lenmin;
UInt i; /* loop variable */
FF fld; /* finite field */
FF * succ; /* successor table */
/* check the lengths */
lenL = LEN_PLIST(vecL);
lenR = LEN_PLIST(vecR);
if (lenR > lenL) {
len = lenR;
lenmin = lenL;
} else {
len = lenL;
lenmin = lenR;
}
/* check the fields */
fld = FLD_FFE(ELM_PLIST(vecL, 1));
if (FLD_FFE(ELM_PLIST(vecR, 1)) != fld) {
/* check the characteristic */
if (CHAR_FF(fld) == CHAR_FF(FLD_FFE(ELM_PLIST(vecR, 1))))
return DiffListList(vecL, vecR);
vecR = ErrorReturnObj(
"Vector -: vectors have different fields",
0L, 0L, "you can replace vector <right> via 'return <right>;'");
return DIFF(vecL, vecR);
}
/* make the result list */
vecD = NEW_PLIST((IS_MUTABLE_OBJ(vecL) || IS_MUTABLE_OBJ(vecR)) ?
T_PLIST_FFE : T_PLIST_FFE + IMMUTABLE, len);
SET_LEN_PLIST(vecD, len);
/* to subtract we need the successor table */
succ = SUCC_FF(fld);
/* loop over the elements and subtract */
ptrL = ADDR_OBJ(vecL);
ptrR = ADDR_OBJ(vecR);
ptrD = ADDR_OBJ(vecD);
for (i = 1; i <= lenmin; i++) {
valL = VAL_FFE(ptrL[i]);
valR = VAL_FFE(ptrR[i]);
valR = NEG_FFV(valR, succ);
valD = SUM_FFV(valL, valR, succ);
ptrD[i] = NEW_FFE(fld, valD);
}
if (lenL < lenR)
for (; i <= len; i++) {
valR = VAL_FFE(ptrR[i]);
valD = NEG_FFV(valR, succ);
ptrD[i] = NEW_FFE(fld, valD);
}
else
for (; i <= len; i++)
ptrD[i] = ptrL[i];
/* return the result */
return vecD;
}
/****************************************************************************
**
*F FuncIS_SUBSET_SET(<self>,<s1>,<s2>) test if a set is a subset of another
**
** 'FuncIS_SUBSET_SET' implements the internal function 'IsSubsetSet'.
**
** 'IsSubsetSet( <set1>, <set2> )'
**
** 'IsSubsetSet' returns 'true' if the set <set2> is a subset of the set
** <set1>, that is if every element of <set2> is also an element of <set1>.
** Either argument may also be a list that is not a proper set, in which
** case 'IsSubsetSet' silently applies 'Set' (see "Set") to it first.
*/
Obj FuncIS_SUBSET_SET (
Obj self,
Obj set1,
Obj set2 )
{
UInt len1; /* length of the left set */
UInt len2; /* length of the right set */
UInt i1; /* index into the left set */
UInt i2; /* index into the right set */
Obj e1; /* element of left set */
Obj e2; /* element of right set */
UInt pos; /* position */
/* check the arguments, convert to sets if necessary */
while ( ! IS_SMALL_LIST(set1) ) {
set1 = ErrorReturnObj(
"IsSubsetSet: <set1> must be a small list (not a %s)",
(Int)TNAM_OBJ(set1), 0L,
"you can replace <set1> via 'return <set1>;'" );
}
while ( ! IS_SMALL_LIST(set2) ) {
set2 = ErrorReturnObj(
"IsSubsetSet: <set2> must be a small list (not a %s)",
(Int)TNAM_OBJ(set2), 0L,
"you can replace <set2> via 'return <set2>;'" );
}
if ( ! IsSet( set1 ) ) set1 = SetList( set1 );
if ( ! IsSet( set2 ) ) set2 = SetList( set2 );
/* special case if the second argument is a set */
if ( IsSet( set2 ) ) {
/* get the logical lengths and get the pointer */
len1 = LEN_PLIST( set1 );
len2 = LEN_PLIST( set2 );
i1 = 1;
i2 = 1;
/* now compare the two sets */
while ( i1 <= len1 && i2 <= len2 && len2 - i2 <= len1 - i1 ) {
e1 = ELM_PLIST( set1, i1 );
e2 = ELM_PLIST( set2, i2 );
if ( EQ( e1, e2 ) ) {
i1++; i2++;
}
else if ( LT( e1, e2 ) ) {
i1++;
}
else {
break;
}
}
}
/* general case */
else {
/* first convert the other argument into a proper list */
PLAIN_LIST( set2 );
/* get the logical lengths */
len1 = LEN_PLIST( set1 );
len2 = LEN_PLIST( set2 );
/* loop over the second list and look for every element */
for ( i2 = 1; i2 <= len2; i2++ ) {
/* ignore holes */
if ( ELM_PLIST(set2,i2) == 0 )
continue;
/* perform the binary search to find the position */
pos = PositionSortedDensePlist( set1, ELM_PLIST(set2,i2) );
/* test if the element was found at position k */
if ( len1<pos || ! EQ(ELM_PLIST(set1,pos),ELM_PLIST(set2,i2)) ) {
break;
}
}
}
/* return 'true' if every element of <set2> appeared in <set1> */
return ((i2 == len2 + 1) ? True : False);
}
Obj SCTableEntryHandler (
Obj self,
Obj table,
Obj i,
Obj j,
Obj k )
{
Obj tmp; /* temporary */
Obj basis; /* basis list */
Obj coeffs; /* coeffs list */
Int dim; /* dimension */
Int len; /* length of basis/coeffs lists */
Int l; /* loop variable */
/* check the table */
if ( ! IS_SMALL_LIST(table) ) {
table = ErrorReturnObj(
"SCTableEntry: <table> must be a small list (not a %s)",
(Int)TNAM_OBJ(table), 0L,
"you can replace <table> via 'return <table>;'" );
return SCTableEntryHandler( self, table, i, j, k );
}
dim = LEN_LIST(table) - 2;
if ( dim <= 0 ) {
table = ErrorReturnObj(
"SCTableEntry: <table> must be a list with at least 3 elements",
0L, 0L,
"you can replace <table> via 'return <table>;'" );
return SCTableEntryHandler( self, table, i, j, k );
}
/* check <i> */
if ( ! IS_INTOBJ(i) || INT_INTOBJ(i) <= 0 || dim < INT_INTOBJ(i) ) {
i = ErrorReturnObj(
"SCTableEntry: <i> must be an integer between 0 and %d",
dim, 0L,
"you can replace <i> via 'return <i>;'" );
return SCTableEntryHandler( self, table, i, j, k );
}
/* get and check the relevant row */
tmp = ELM_LIST( table, INT_INTOBJ(i) );
if ( ! IS_SMALL_LIST(tmp) || LEN_LIST(tmp) != dim ) {
table = ErrorReturnObj(
"SCTableEntry: <table>[%d] must be a list with %d elements",
INT_INTOBJ(i), dim,
"you can replace <table> via 'return <table>;'" );
return SCTableEntryHandler( self, table, i, j, k );
}
/* check <j> */
if ( ! IS_INTOBJ(j) || INT_INTOBJ(j) <= 0 || dim < INT_INTOBJ(j) ) {
j = ErrorReturnObj(
"SCTableEntry: <j> must be an integer between 0 and %d",
dim, 0L,
"you can replace <j> via 'return <j>;'" );
return SCTableEntryHandler( self, table, i, j, k );
}
/* get and check the basis and coefficients list */
tmp = ELM_LIST( tmp, INT_INTOBJ(j) );
if ( ! IS_SMALL_LIST(tmp) || LEN_LIST(tmp) != 2 ) {
table = ErrorReturnObj(
"SCTableEntry: <table>[%d][%d] must be a basis/coeffs list",
0L, 0L,
"you can replace <table> via 'return <table>;'" );
return SCTableEntryHandler( self, table, i, j, k );
}
/* get and check the basis list */
basis = ELM_LIST( tmp, 1 );
if ( ! IS_SMALL_LIST(basis) ) {
table = ErrorReturnObj(
"SCTableEntry: <table>[%d][%d][1] must be a basis list",
0L, 0L,
"you can replace <table> via 'return <table>;'" );
return SCTableEntryHandler( self, table, i, j, k );
}
/* get and check the coeffs list */
coeffs = ELM_LIST( tmp, 2 );
if ( ! IS_SMALL_LIST(coeffs) ) {
table = ErrorReturnObj(
"SCTableEntry: <table>[%d][%d][2] must be a coeffs list",
0L, 0L,
"you can replace <table> via 'return <table>;'" );
return SCTableEntryHandler( self, table, i, j, k );
}
/* check that they have the same length */
len = LEN_LIST(basis);
if ( LEN_LIST(coeffs) != len ) {
table = ErrorReturnObj(
"SCTableEntry: <table>[%d][%d][1], ~[2] must have equal length",
0L, 0L,
"you can replace <table> via 'return <table>;'" );
return SCTableEntryHandler( self, table, i, j, k );
}
/* check <k> */
if ( ! IS_INTOBJ(k) || INT_INTOBJ(k) <= 0 || dim < INT_INTOBJ(k) ) {
k = ErrorReturnObj(
"SCTableEntry: <k> must be an integer between 0 and %d",
dim, 0L,
"you can replace <k> via 'return <k>;'" );
return SCTableEntryHandler( self, table, i, j, k );
}
/* look for the (i,j,k) entry */
for ( l = 1; l <= len; l++ ) {
if ( EQ( ELM_LIST( basis, l ), k ) )
break;
}
/* return the coefficient of zero */
if ( l <= len ) {
return ELM_LIST( coeffs, l );
}
else {
return ELM_LIST( table, dim+2 );
}
}
Obj SCTableProductHandler (
Obj self,
Obj table,
Obj list1,
Obj list2 )
{
Obj res; /* result list */
Obj row; /* one row of sc table */
Obj zero; /* zero from sc table */
Obj ai, aj; /* elements from list1 */
Obj bi, bj; /* elements from list2 */
Obj c, c1, c2; /* products of above */
Int dim; /* dimension of vectorspace */
Int i, j; /* loop variables */
/* check the arguments a bit */
if ( ! IS_SMALL_LIST(table) ) {
table = ErrorReturnObj(
"SCTableProduct: <table> must be a list (not a %s)",
(Int)TNAM_OBJ(table), 0L,
"you can replace <table> via 'return <table>;'" );
return SCTableProductHandler( self, table, list1, list2 );
}
dim = LEN_LIST(table) - 2;
if ( dim <= 0 ) {
table = ErrorReturnObj(
"SCTableProduct: <table> must be a list with at least 3 elements",
0L, 0L,
"you can replace <table> via 'return <table>;'" );
return SCTableProductHandler( self, table, list1, list2 );
}
zero = ELM_LIST( table, dim+2 );
if ( ! IS_SMALL_LIST(list1) || LEN_LIST(list1) != dim ) {
list1 = ErrorReturnObj(
"SCTableProduct: <list1> must be a list with %d elements",
dim, 0L,
"you can replace <list1> via 'return <list1>;'" );
return SCTableProductHandler( self, table, list1, list2 );
}
if ( ! IS_SMALL_LIST(list2) || LEN_LIST(list2) != dim ) {
list2 = ErrorReturnObj(
"SCTableProduct: <list2> must be a list with %d elements",
dim, 0L,
"you can replace <list2> via 'return <list2>;'" );
return SCTableProductHandler( self, table, list1, list2 );
}
/* make the result list */
res = NEW_PLIST( T_PLIST, dim );
SET_LEN_PLIST( res, dim );
for ( i = 1; i <= dim; i++ ) {
SET_ELM_PLIST( res, i, zero );
}
CHANGED_BAG( res );
/* general case */
if ( EQ( ELM_LIST( table, dim+1 ), INTOBJ_INT(0) ) ) {
for ( i = 1; i <= dim; i++ ) {
ai = ELM_LIST( list1, i );
if ( EQ( ai, zero ) ) continue;
row = ELM_LIST( table, i );
for ( j = 1; j <= dim; j++ ) {
bj = ELM_LIST( list2, j );
if ( EQ( bj, zero ) ) continue;
c = PROD( ai, bj );
if ( ! EQ( c, zero ) ) {
SCTableProdAdd( res, c, ELM_LIST( row, j ), dim );
}
}
}
}
/* commutative case */
else if ( EQ( ELM_LIST( table, dim+1 ), INTOBJ_INT(1) ) ) {
for ( i = 1; i <= dim; i++ ) {
ai = ELM_LIST( list1, i );
bi = ELM_LIST( list2, i );
if ( EQ( ai, zero ) && EQ( bi, zero ) ) continue;
row = ELM_LIST( table, i );
c = PROD( ai, bi );
if ( ! EQ( c, zero ) ) {
SCTableProdAdd( res, c, ELM_LIST( row, i ), dim );
}
for ( j = i+1; j <= dim; j++ ) {
bj = ELM_LIST( list2, j );
aj = ELM_LIST( list1, j );
if ( EQ( aj, zero ) && EQ( bj, zero ) ) continue;
c1 = PROD( ai, bj );
c2 = PROD( aj, bi );
c = SUM( c1, c2 );
if ( ! EQ( c, zero ) ) {
SCTableProdAdd( res, c, ELM_LIST( row, j ), dim );
}
}
}
}
/* anticommutative case */
else if ( EQ( ELM_LIST( table, dim+1 ), INTOBJ_INT(-1) ) ) {
for ( i = 1; i <= dim; i++ ) {
ai = ELM_LIST( list1, i );
bi = ELM_LIST( list2, i );
if ( EQ( ai, zero ) && EQ( bi, zero ) ) continue;
row = ELM_LIST( table, i );
for ( j = i+1; j <= dim; j++ ) {
bj = ELM_LIST( list2, j );
aj = ELM_LIST( list1, j );
if ( EQ( aj, zero ) && EQ( bj, zero ) ) continue;
c1 = PROD( ai, bj );
c2 = PROD( aj, bi );
c = DIFF( c1, c2 );
if ( ! EQ( c, zero ) ) {
SCTableProdAdd( res, c, ELM_LIST( row, j ), dim );
}
}
}
}
/* return the result */
return res;
}
/****************************************************************************
**
*F ProdVectorMatrix(<vecL>,<vecR>) . . . . product of a vector and a matrix
**
** 'ProdVectorMatrix' returns the product of the vector <vecL> and the matrix
** <vecR>. The product is the sum of the rows of <vecR>, each multiplied by
** the corresponding entry of <vecL>.
**
** 'ProdVectorMatrix' is an improved version of 'ProdListList', which does
** not call 'PROD' and also accumulates the sum into one fixed vector
** instead of allocating a new for each product and sum.
*/
Obj ProdVecFFEMatFFE (
Obj vecL,
Obj matR )
{
Obj vecP; /* handle of the product */
Obj * ptrP; /* pointer into the product */
FFV * ptrV; /* value pointer into the product */
FFV valP; /* one value of the product */
FFV valL; /* one value of the left operand */
Obj vecR; /* one vector of the right operand */
Obj * ptrR; /* pointer into the right vector */
FFV valR; /* one value from the right vector */
UInt len; /* length */
UInt col; /* length of the rows in matR */
UInt i, k; /* loop variables */
FF fld; /* the common finite field */
FF * succ; /* the successor table */
/* check the lengths */
len = LEN_PLIST(vecL);
col = LEN_PLIST(ELM_PLIST(matR, 1));
if (len != LEN_PLIST(matR)) {
matR = ErrorReturnObj(
"<vec>*<mat>: <vec> (%d) must have the same length as <mat> (%d)",
(Int)len, (Int)col,
"you can replace matrix <mat> via 'return <mat>;'");
return PROD(vecL, matR);
}
/* check the fields */
vecR = ELM_PLIST(matR, 1);
fld = FLD_FFE(ELM_PLIST(vecL, 1));
if (FLD_FFE(ELM_PLIST(vecR, 1)) != fld) {
/* check the characteristic */
if (CHAR_FF(fld) == CHAR_FF(FLD_FFE(ELM_PLIST(vecR, 1))))
return ProdListList(vecL, matR);
matR = ErrorReturnObj(
"<vec>*<mat>: <vec> and <mat> have different fields",
0L, 0L,
"you can replace matrix <mat> via 'return <mat>;'");
return PROD(vecL, matR);
}
/* make the result list by multiplying the first entries */
vecP = ProdFFEVecFFE(ELM_PLIST(vecL, 1), vecR);
/* to add we need the successor table */
succ = SUCC_FF(fld);
/* convert vecP into a list of values */
/*N 5Jul1998 werner: This only works if sizeof(FFV) <= sizeof(Obj) */
/*N We have to be careful not to overwrite the length info */
ptrP = ADDR_OBJ(vecP);
ptrV = ((FFV*)(ptrP + 1)) - 1;
for (k = 1; k <= col; k++)
ptrV[k] = VAL_FFE(ptrP[k]);
/* loop over the other entries and multiply */
for (i = 2; i <= len; i++) {
valL = VAL_FFE(ELM_PLIST(vecL, i));
vecR = ELM_PLIST(matR, i);
ptrR = ADDR_OBJ(vecR);
if (valL == (FFV)1) {
for (k = 1; k <= col; k++) {
valR = VAL_FFE(ptrR[k]);
valP = ptrV[k];
ptrV[k] = SUM_FFV(valP, valR, succ);
}
} else if (valL != (FFV)0) {
for (k = 1; k <= col; k++) {
valR = VAL_FFE(ptrR[k]);
valR = PROD_FFV(valL, valR, succ);
valP = ptrV[k];
ptrV[k] = SUM_FFV(valP, valR, succ);
}
}
}
/* convert vecP back into a list of finite field elements */
/*N 5Jul1998 werner: This only works if sizeof(FFV) <= sizeof(Obj) */
/*N We have to be careful not to overwrite the length info */
for (k = col; k >= 1; k--)
ptrP[k] = NEW_FFE(fld, ptrV[k]);
/* return the result */
return vecP;
}
/****************************************************************************
**
*F FuncADD_SET( <self>, <set>, <obj> ) . . . . . . . add an element to a set
**
** 'FuncADD_SET' implements the internal function 'AddSet'.
**
** 'AddSet( <set>, <obj> )'
**
** 'AddSet' adds <obj>, which may be an object of an arbitrary type, to the
** set <set>, which must be a proper set. If <obj> is already an element of
** the set <set>, then <set> is not changed. Otherwise <obj> is inserted at
** the correct position such that <set> is again a set afterwards.
**
** 'AddSet' does not return anything, it is only called for the side effect
** of changing <set>.
*/
Obj FuncADD_SET (
Obj self,
Obj set,
Obj obj )
{
UInt len; /* logical length of the list */
UInt pos; /* position */
UInt isCyc; /* True if the set being added to consists
of kernel cyclotomics */
UInt notpos; /* position of an original element
(not the new one) */
UInt wasHom;
UInt wasNHom;
UInt wasTab;
/* check the arguments */
while ( ! IsSet(set) || ! IS_MUTABLE_OBJ(set) ) {
set = ErrorReturnObj(
"AddSet: <set> must be a mutable proper set (not a %s)",
(Int)TNAM_OBJ(set), 0L,
"you can replace <set> via 'return <set>;'" );
}
len = LEN_LIST(set);
/* perform the binary search to find the position */
pos = PositionSortedDensePlist( set, obj );
/* add the element to the set if it is not already there */
if ( len < pos || ! EQ( ELM_PLIST(set,pos), obj ) ) {
GROW_PLIST( set, len+1 );
SET_LEN_PLIST( set, len+1 );
{
Obj *ptr;
ptr = PTR_BAG(set);
memmove((void *)(ptr + pos+1),(void*)(ptr+pos),(size_t)(sizeof(Obj)*(len+1-pos)));
#if 0
for ( i = len+1; pos < i; i-- ) {
*ptr = *(ptr-1);
ptr--; */
/* SET_ELM_PLIST( set, i, ELM_PLIST(set,i-1) ); */
}
#endif
}
SET_ELM_PLIST( set, pos, obj );
CHANGED_BAG( set );
/* fix up the type of the result */
if ( HAS_FILT_LIST( set, FN_IS_SSORT ) ) {
isCyc = (TNUM_OBJ(set) == T_PLIST_CYC_SSORT);
wasHom = HAS_FILT_LIST(set, FN_IS_HOMOG);
wasTab = HAS_FILT_LIST(set, FN_IS_TABLE);
wasNHom = HAS_FILT_LIST(set, FN_IS_NHOMOG);
CLEAR_FILTS_LIST(set);
/* the result of addset is always dense */
SET_FILT_LIST( set, FN_IS_DENSE );
/* if the object we added was not
mutable then we might be able to
conclude more */
if ( ! IS_MUTABLE_OBJ(obj) ) {
/* a one element list is automatically
homogenous and ssorted */
if (len == 0 )
{
if (TNUM_OBJ(obj) <= T_CYC)
RetypeBag( set, T_PLIST_CYC_SSORT);
else
{
SET_FILT_LIST( set, FN_IS_HOMOG );
SET_FILT_LIST( set, FN_IS_SSORT );
if (IS_HOMOG_LIST(obj)) /* it might be a table */
SET_FILT_LIST( set, FN_IS_TABLE );
}
}
else
{
/* Now determine homogeneity */
if (isCyc)
if (TNUM_OBJ(obj) <= T_CYC)
RetypeBag( set, T_PLIST_CYC_SSORT);
else
{
RESET_FILT_LIST(set, FN_IS_HOMOG);
SET_FILT_LIST(set, FN_IS_NHOMOG);
}
else if (wasHom)
{
if (!SyInitializing) {
notpos = (pos == 1) ? 2 : 1;
if (FAMILY_OBJ(ELM_PLIST(set,notpos)) == FAMILY_OBJ(obj))
{
SET_FILT_LIST(set, FN_IS_HOMOG);
if (wasTab) {
if (IS_HOMOG_LIST( obj ))
SET_FILT_LIST(set, FN_IS_TABLE);
}
}
else
SET_FILT_LIST(set, FN_IS_NHOMOG);
}
}
else if (wasNHom)
SET_FILT_LIST(set, FN_IS_NHOMOG);
}
}
SET_FILT_LIST( set, FN_IS_SSORT );
}
else {
CLEAR_FILTS_LIST(set);
SET_FILT_LIST( set, FN_IS_DENSE );
}
}
