/****************************************************************************
**
*F SetList( <list> ) . . . . . . . . . . . . . . . . make a set from a list
**
** 'SetList' returns a new set that contains the elements of <list>. Note
** that 'SetList' returns a new plain list even if <list> was already a set.
**
** 'SetList' makes a copy of the list <list>, removes the holes, sorts the
** copy and finally removes duplicates, which must appear next to each other
** now that the copy is sorted.
*/
Obj SetList (
Obj list )
{
Obj set; /* result set */
Int lenSet; /* length of <set> */
Int lenList; /* length of <list> */
Obj elm; /* one element of the list */
UInt status; /* the elements are mutable */
UInt i; /* loop variable */
/* make a dense copy */
lenList = LEN_LIST( list );
set = NEW_PLIST( T_PLIST, lenList );
lenSet = 0;
for ( i = 1; i <= lenList; i++ ) {
elm = ELMV0_LIST( list, i );
if ( elm != 0 ) {
lenSet += 1;
SET_ELM_PLIST( set, lenSet, elm );
CHANGED_BAG(set); /* in case elm had to be made, not just extracted */
}
}
SET_LEN_PLIST( set, lenSet );
SET_FILT_LIST( set, FN_IS_DENSE );
/* sort the set (which is a dense plain list) */
SortDensePlist( set );
/* remove duplicates */
status = RemoveDupsDensePlist( set );
/* adjust flags where possible */
switch(status)
{
case 0:
break;
case 1:
SET_FILT_LIST(set, FN_IS_NHOMOG);
SET_FILT_LIST(set, FN_IS_SSORT);
break;
case 2:
SET_FILT_LIST( set, FN_IS_HOMOG );
SET_FILT_LIST( set, FN_IS_SSORT );
break;
}
/* return set */
return set;
}
Obj CopyContainerToGap(const T& v)
{
size_t s = v.size();
if(s == 0)
{
Obj l = NEW_PLIST(T_PLIST_EMPTY, 0);
SET_LEN_PLIST(l, 0);
CHANGED_BAG(l);
return l;
}
Obj list = NEW_PLIST(T_PLIST_DENSE, s);
SET_LEN_PLIST(list, s);
CHANGED_BAG(list);
GAP_maker<typename T::value_type> m;
int pos = 1;
for(typename T::const_iterator it = v.begin(); it != v.end(); ++it, ++pos)
{
SET_ELM_PLIST(list, pos, m(*it));
CHANGED_BAG(list);
}
return list;
}
/* 'InitLibrary' sets up gvars, rnams, functions */
static Int InitLibrary ( StructInitInfo * module )
{
Obj func1;
Obj body1;
/* Complete Copy/Fopy registration */
UpdateCopyFopyInfo();
FileName = MakeImmString( "assert.g" );
PostRestore(module);
/* create all the functions defined in this module */
func1 = NewFunction(NameFunc[1],0,0,HdlrFunc1);
SET_ENVI_FUNC( func1, STATE(CurrLVars) );
CHANGED_BAG( STATE(CurrLVars) );
body1 = NewBag( T_BODY, sizeof(BodyHeader));
SET_BODY_FUNC( func1, body1 );
CHANGED_BAG( func1 );
CALL_0ARGS( func1 );
/* return success */
return 0;
}
Obj FuncWeakPointerObj( Obj self, Obj list ) {
Obj wp;
Int i;
Int len;
len = LEN_LIST(list);
wp = (Obj) NewBag(T_WPOBJ, (len+1)*sizeof(Obj));
STORE_LEN_WPOBJ(wp,len);
for (i = 1; i <= len ; i++)
{
ELM_WPOBJ(wp,i) = ELM0_LIST(list,i);
CHANGED_BAG(wp); /* this must be here in case list is
in fact an object and causes a GC in the
element access method */
}
return wp;
}
void AddIn( Obj list, Obj w, Obj e ) {
Int g, i;
Obj r, s, t;
for( i = 1; i < LEN_PLIST(w); i += 2 ) {
g = INT_INTOBJ( ELM_PLIST( w, i ) );
s = ELM_PLIST( w, i+1 );
C_PROD_FIA( t, s, e ); /* t = s * e */
r = ELM_PLIST( list, g );
C_SUM_FIA( s, t, r ); /* s = r + s * e */
SET_ELM_PLIST( list, g, s ); CHANGED_BAG( list );
}
}
/* handler for function 1 */
static Obj HdlrFunc1 (
Obj self )
{
Obj t_1 = 0;
Obj t_2 = 0;
Bag oldFrame;
/* allocate new stack frame */
SWITCH_TO_NEW_FRAME(self,0,0,oldFrame);
/* runtest := function ( )
Print( AssertionLevel( ), "\n" );
Assert( 1, false, "fail-A" );
Assert( 1, false );
Assert( 0, true, "fail-B" );
Assert( 0, true );
SetAssertionLevel( 2 );
Print( AssertionLevel( ), "\n" );
Assert( 3, false, "fail-C" );
Assert( 3, false );
Assert( 2, true, "fail-D" );
Assert( 2, true );
Assert( 2, false, "pass!\n" );
Print( "end of function\n" );
return;
end; */
t_1 = NewFunction( NameFunc[2], 0, 0, HdlrFunc2 );
SET_ENVI_FUNC( t_1, STATE(CurrLVars) );
t_2 = NewBag( T_BODY, sizeof(BodyHeader) );
SET_STARTLINE_BODY(t_2, 1);
SET_ENDLINE_BODY(t_2, 18);
SET_FILENAME_BODY(t_2, FileName);
SET_BODY_FUNC(t_1, t_2);
CHANGED_BAG( STATE(CurrLVars) );
AssGVar( G_runtest, t_1 );
/* return; */
SWITCH_TO_OLD_FRAME(oldFrame);
return 0;
/* return; */
SWITCH_TO_OLD_FRAME(oldFrame);
return 0;
}
/****************************************************************************
**
*F CleanObjWPObjCopy( <obj> ) . . . . . . . . . . . . . . clean WPobj copy
*/
void CleanObjWPObjCopy (
Obj obj )
{
UInt i; /* loop variable */
Obj elm; /* subobject */
/* remove the forwarding pointer */
ADDR_OBJ(obj)[0] = ELM_PLIST( ADDR_OBJ(obj)[0], 1 );
CHANGED_BAG(obj);
/* now it is cleaned */
RetypeBag( obj, TNUM_OBJ(obj) - COPYING );
/* clean the subvalues */
for ( i = 1; i < SIZE_OBJ(obj)/sizeof(Obj); i++ ) {
elm = ADDR_OBJ(obj)[i];
if ( elm != 0 && !IS_WEAK_DEAD_BAG(elm))
CLEAN_OBJ( elm );
}
}
/* handler for function 1 */
static Obj HdlrFunc1 (
Obj self )
{
Obj t_1 = 0;
Obj t_2 = 0;
Bag oldFrame;
/* allocate new stack frame */
SWITCH_TO_NEW_FRAME(self,0,0,oldFrame);
/* runtest := function ( )
Print( 1, "\n" );
Print( "abc", "\n" );
Print( (1,2)(5,6), "\n" );
Print( [ 1, "abc" ], "\n" );
Print( Group( (1,2,3) ), "\n" );
return;
end; */
t_1 = NewFunction( NameFunc[2], 0, 0, HdlrFunc2 );
SET_ENVI_FUNC( t_1, STATE(CurrLVars) );
t_2 = NewBag( T_BODY, sizeof(BodyHeader) );
SET_STARTLINE_BODY(t_2, 1);
SET_ENDLINE_BODY(t_2, 7);
SET_FILENAME_BODY(t_2, FileName);
SET_BODY_FUNC(t_1, t_2);
CHANGED_BAG( STATE(CurrLVars) );
AssGVar( G_runtest, t_1 );
/* return; */
SWITCH_TO_OLD_FRAME(oldFrame);
return 0;
/* return; */
SWITCH_TO_OLD_FRAME(oldFrame);
return 0;
}
/* handler for function 1 */
static Obj HdlrFunc1 (
Obj self )
{
Obj t_1 = 0;
Obj t_2 = 0;
Bag oldFrame;
OLD_BRK_CURR_STAT
/* allocate new stack frame */
SWITCH_TO_NEW_FRAME(self,0,0,oldFrame);
REM_BRK_CURR_STAT();
SET_BRK_CURR_STAT(0);
/* runtest := function ( )
return 1 + 2;
end; */
t_1 = NewFunction( NameFunc[2], 0, 0, HdlrFunc2 );
SET_ENVI_FUNC( t_1, STATE(CurrLVars) );
t_2 = NewBag( T_BODY, sizeof(BodyHeader) );
SET_STARTLINE_BODY(t_2, 1);
SET_ENDLINE_BODY(t_2, 3);
SET_FILENAME_BODY(t_2, FileName);
SET_BODY_FUNC(t_1, t_2);
CHANGED_BAG( STATE(CurrLVars) );
AssGVar( G_runtest, t_1 );
/* return; */
RES_BRK_CURR_STAT();
SWITCH_TO_OLD_FRAME(oldFrame);
return 0;
/* return; */
RES_BRK_CURR_STAT();
SWITCH_TO_OLD_FRAME(oldFrame);
return 0;
}
/****************************************************************************
**
*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 );
}
}
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;
}
/* handler for function 1 */
static Obj HdlrFunc1 (
Obj self )
{
Obj t_1 = 0;
Obj t_2 = 0;
Bag oldFrame;
/* allocate new stack frame */
SWITCH_TO_NEW_FRAME(self,0,0,oldFrame);
/* f1 := function ( a )
Print( "f1:", a, "\n" );
return;
end; */
t_1 = NewFunction( NameFunc[2], 1, 0, HdlrFunc2 );
SET_ENVI_FUNC( t_1, STATE(CurrLVars) );
t_2 = NewBag( T_BODY, sizeof(BodyHeader) );
SET_STARTLINE_BODY(t_2, 1);
SET_ENDLINE_BODY(t_2, 3);
SET_FILENAME_BODY(t_2, FileName);
SET_BODY_FUNC(t_1, t_2);
CHANGED_BAG( STATE(CurrLVars) );
AssGVar( G_f1, t_1 );
/* f2 := function ( a, b )
Print( "f2:", a, ":", b, "\n" );
return;
end; */
t_1 = NewFunction( NameFunc[3], 2, 0, HdlrFunc3 );
SET_ENVI_FUNC( t_1, STATE(CurrLVars) );
t_2 = NewBag( T_BODY, sizeof(BodyHeader) );
SET_STARTLINE_BODY(t_2, 5);
SET_ENDLINE_BODY(t_2, 7);
SET_FILENAME_BODY(t_2, FileName);
SET_BODY_FUNC(t_1, t_2);
CHANGED_BAG( STATE(CurrLVars) );
AssGVar( G_f2, t_1 );
/* f3 := function ( a... )
Print( "f3:", a, "\n" );
return;
end; */
t_1 = NewFunction( NameFunc[4], -1, 0, HdlrFunc4 );
SET_ENVI_FUNC( t_1, STATE(CurrLVars) );
t_2 = NewBag( T_BODY, sizeof(BodyHeader) );
SET_STARTLINE_BODY(t_2, 9);
SET_ENDLINE_BODY(t_2, 11);
SET_FILENAME_BODY(t_2, FileName);
SET_BODY_FUNC(t_1, t_2);
CHANGED_BAG( STATE(CurrLVars) );
AssGVar( G_f3, t_1 );
/* f4 := function ( a, b... )
Print( "f4:", a, ":", b, "\n" );
return;
end; */
t_1 = NewFunction( NameFunc[5], -2, 0, HdlrFunc5 );
SET_ENVI_FUNC( t_1, STATE(CurrLVars) );
t_2 = NewBag( T_BODY, sizeof(BodyHeader) );
SET_STARTLINE_BODY(t_2, 13);
SET_ENDLINE_BODY(t_2, 15);
SET_FILENAME_BODY(t_2, FileName);
SET_BODY_FUNC(t_1, t_2);
CHANGED_BAG( STATE(CurrLVars) );
AssGVar( G_f4, t_1 );
/* runtest := function ( )
f1( 2 );
f2( 2, 3 );
f3( );
f3( 2 );
f3( 2, 3, 4 );
f4( 1 );
f4( 1, 2 );
f4( 1, 2, 3 );
return;
end; */
t_1 = NewFunction( NameFunc[6], 0, 0, HdlrFunc6 );
SET_ENVI_FUNC( t_1, STATE(CurrLVars) );
t_2 = NewBag( T_BODY, sizeof(BodyHeader) );
SET_STARTLINE_BODY(t_2, 17);
SET_ENDLINE_BODY(t_2, 26);
SET_FILENAME_BODY(t_2, FileName);
SET_BODY_FUNC(t_1, t_2);
CHANGED_BAG( STATE(CurrLVars) );
AssGVar( G_runtest, t_1 );
/* return; */
SWITCH_TO_OLD_FRAME(oldFrame);
return 0;
/* return; */
SWITCH_TO_OLD_FRAME(oldFrame);
return 0;
}
UInt RNamName (
const Char * name )
{
Obj rnam; /* record name (as imm intobj) */
UInt pos; /* hash position */
UInt len; /* length of name */
Char namx [1024]; /* temporary copy of <name> */
Obj string; /* temporary string object <name> */
Obj table; /* temporary copy of <HashRNam> */
Obj rnam2; /* one element of <table> */
const Char * p; /* loop variable */
UInt i; /* loop variable */
/* start looking in the table at the following hash position */
pos = 0;
len = 0;
for ( p = name; *p != '\0'; p++ ) {
pos = 65599 * pos + *p;
len++;
}
pos = (pos % SizeRNam) + 1;
if(len >= 1023) {
// Note: We can't pass 'name' here, as it might get moved by garbage collection
ErrorQuit("Record names must consist of less than 1023 characters", 0, 0);
}
/* look through the table until we find a free slot or the global */
while ( (rnam = ELM_PLIST( HashRNam, pos )) != 0
&& strncmp( NAME_RNAM( INT_INTOBJ(rnam) ), name, 1023 ) ) {
pos = (pos % SizeRNam) + 1;
}
/* if we did not find the global variable, make a new one and enter it */
/* (copy the name first, to avoid a stale pointer in case of a GC) */
if ( rnam == 0 ) {
CountRNam++;
rnam = INTOBJ_INT(CountRNam);
SET_ELM_PLIST( HashRNam, pos, rnam );
strlcpy( namx, name, sizeof(namx) );
C_NEW_STRING_DYN(string, namx);
GROW_PLIST( NamesRNam, CountRNam );
SET_LEN_PLIST( NamesRNam, CountRNam );
SET_ELM_PLIST( NamesRNam, CountRNam, string );
CHANGED_BAG( NamesRNam );
}
/* if the table is too crowed, make a larger one, rehash the names */
if ( SizeRNam < 3 * CountRNam / 2 ) {
table = HashRNam;
SizeRNam = 2 * SizeRNam + 1;
HashRNam = NEW_PLIST( T_PLIST, SizeRNam );
SET_LEN_PLIST( HashRNam, SizeRNam );
for ( i = 1; i <= (SizeRNam-1)/2; i++ ) {
rnam2 = ELM_PLIST( table, i );
if ( rnam2 == 0 ) continue;
pos = 0;
for ( p = NAME_RNAM( INT_INTOBJ(rnam2) ); *p != '\0'; p++ ) {
pos = 65599 * pos + *p;
}
pos = (pos % SizeRNam) + 1;
while ( ELM_PLIST( HashRNam, pos ) != 0 ) {
pos = (pos % SizeRNam) + 1;
}
SET_ELM_PLIST( HashRNam, pos, rnam2 );
}
}
/* return the record name */
return INT_INTOBJ(rnam);
}
Obj CollectPolycyc (
Obj pcp,
Obj list,
Obj word )
{
Int ngens = INT_INTOBJ( CONST_ADDR_OBJ(pcp)[ PC_NUMBER_OF_GENERATORS ] );
Obj commute = CONST_ADDR_OBJ(pcp)[ PC_COMMUTE ];
Obj gens = CONST_ADDR_OBJ(pcp)[ PC_GENERATORS ];
Obj igens = CONST_ADDR_OBJ(pcp)[ PC_INVERSES ];
Obj pow = CONST_ADDR_OBJ(pcp)[ PC_POWERS ];
Obj ipow = CONST_ADDR_OBJ(pcp)[ PC_INVERSEPOWERS ];
Obj exp = CONST_ADDR_OBJ(pcp)[ PC_EXPONENTS ];
Obj wst = CFTLState()->WORD_STACK;
Obj west = CFTLState()->WORD_EXPONENT_STACK;
Obj sst = CFTLState()->SYLLABLE_STACK;
Obj est = CFTLState()->EXPONENT_STACK;
Obj conj=0, iconj=0; /*QQ initialize to please compiler */
Int st;
Int g, syl, h, hh;
Obj e, ee, ge, mge, we, s, t;
Obj w, x = (Obj)0, y = (Obj)0;
if( LEN_PLIST(word) == 0 ) return (Obj)0;
if( LEN_PLIST(list) < ngens ) {
ErrorQuit( "vector too short", 0L, 0L );
return (Obj)0;
}
if( LEN_PLIST(word) % 2 != 0 ) {
ErrorQuit( "Length of word odd", 0L, 0L );
return (Obj)0;
}
st = 0;
PUSH_STACK( word, INTOBJ_INT(1) );
while( st > 0 ) {
w = ELM_PLIST( wst, st );
syl = INT_INTOBJ( ELM_PLIST( sst, st ) );
g = INT_INTOBJ( ELM_PLIST( w, syl ) );
if( st > 1 && syl==1 && g == GET_COMMUTE(g) ) {
/* Collect word^exponent in one go. */
e = ELM_PLIST( west, st );
/* Add in. */
AddIn( list, w, e );
/* Reduce. */
for( h = g; h <= ngens; h++ ) {
s = ELM_PLIST( list, h );
if( IS_INT_ZERO( s ) ) continue;
y = (Obj)0;
if( (e = GET_EXPONENT( h )) != (Obj)0 ) {
if( !LtInt( s, e ) ) {
t = ModInt( s, e );
SET_ELM_PLIST( list, h, t ); CHANGED_BAG( list );
if( (y = GET_POWER( h )) ) e = QuoInt( s, e );
}
else if( LtInt( s, INTOBJ_INT(0) ) ) {
t = ModInt( s, e );
SET_ELM_PLIST( list, h, t ); CHANGED_BAG( list );
if( (y = GET_IPOWER( h )) ) {
e = QuoInt( s, e );
if( !IS_INT_ZERO( t ) ) e = DiffInt( e, INTOBJ_INT(1) );
e = AInvInt(e);
}
}
}
if( y != (Obj)0 ) AddIn( list, y, e );
}
st--;
}
else {
if( g == GET_COMMUTE( g ) ) {
s = ELM_PLIST( list, g );
t = ELM_PLIST( est, st );
C_SUM_FIA( ge, s, t );
SET_ELM_PLIST( est, st, INTOBJ_INT(0) );
}
else {
/* Assume that the top of the exponent stack is non-zero. */
e = ELM_PLIST( est, st );
if( LtInt( INTOBJ_INT(0), e ) ) {
C_DIFF_FIA( ee, e, INTOBJ_INT(1) ); e = ee;
SET_ELM_PLIST( est, st, e ); CHANGED_BAG( est );
conj = CONST_ADDR_OBJ(pcp)[PC_CONJUGATES];
iconj = CONST_ADDR_OBJ(pcp)[PC_INVERSECONJUGATES];
C_SUM_FIA( ge, ELM_PLIST( list, g ), INTOBJ_INT(1) );
}
else {
C_SUM_FIA( ee, e, INTOBJ_INT(1) ); e = ee;
SET_ELM_PLIST( est, st, e ); CHANGED_BAG( est );
conj = CONST_ADDR_OBJ(pcp)[PC_CONJUGATESINVERSE];
iconj = CONST_ADDR_OBJ(pcp)[PC_INVERSECONJUGATESINVERSE];
C_DIFF_FIA( ge, ELM_PLIST( list, g ), INTOBJ_INT(1) );
}
}
SET_ELM_PLIST( list, g, ge ); CHANGED_BAG( list );
/* Reduce the exponent. We delay putting the power onto the
stack until all the conjugates are on the stack. The power is
stored in y, its exponent in ge. */
y = (Obj)0;
if( (e = GET_EXPONENT( g )) ) {
if( !LtInt( ge, e ) ) {
mge = ModInt( ge, e );
SET_ELM_PLIST( list, g, mge ); CHANGED_BAG( list );
if( (y = GET_POWER( g )) ) ge = QuoInt( ge, e );
}
else if( LtInt( ge, INTOBJ_INT(0) ) ) {
mge = ModInt( ge, e );
SET_ELM_PLIST( list, g, mge ); CHANGED_BAG( list );
if( (y = GET_IPOWER( g )) ) {
ge = QuoInt( ge, e );
if( !IS_INT_ZERO( mge ) )
ge = DiffInt( ge, INTOBJ_INT(1) );
ge = AInvInt(ge);
}
}
}
hh = h = GET_COMMUTE( g );
/* Find the place where we start to collect. */
for( ; h > g; h-- ) {
e = ELM_PLIST( list, h );
if( !IS_INT_ZERO(e) ) {
if( LtInt( INTOBJ_INT(0), e ) ) {
if( GET_CONJ( h, g ) ) break;
}
else {
if( GET_ICONJ( h, g ) ) break;
}
}
}
/* Put those onto the stack, if necessary. */
if( h > g || y != (Obj)0 )
for( ; hh > h; hh-- ) {
e = ELM_PLIST( list, hh );
if( !IS_INT_ZERO(e) ) {
SET_ELM_PLIST( list, hh, INTOBJ_INT(0) );
if( LtInt( INTOBJ_INT(0), e ) ) {
x = ELM_PLIST( gens, hh );
}
else {
x = ELM_PLIST( igens, hh );
C_PROD_FIA( ee, e, INTOBJ_INT(-1) ); e = ee;
}
PUSH_STACK( x, e );
}
}
for( ; h > g; h-- ) {
e = ELM_PLIST( list, h );
if( !IS_INT_ZERO(e) ) {
SET_ELM_PLIST( list, h, INTOBJ_INT(0) );
x = (Obj)0;
if( LtInt( INTOBJ_INT(0), e ) ) x = GET_CONJ( h, g );
else x = GET_ICONJ( h, g );
if( x == (Obj)0 ) {
if( LtInt( INTOBJ_INT(0), e ) ) x = ELM_PLIST( gens, h );
else x = ELM_PLIST( igens, h );
}
if( LtInt( e, INTOBJ_INT(0) ) ) {
C_PROD_FIA( ee, e, INTOBJ_INT(-1) ); e = ee;
}
PUSH_STACK( x, e );
}
}
if( y != (Obj)0 ) PUSH_STACK( y, ge );
}
while( st > 0 && IS_INT_ZERO( ELM_PLIST( est, st ) ) ) {
w = ELM_PLIST( wst, st );
syl = INT_INTOBJ( ELM_PLIST( sst, st ) ) + 2;
if( syl > LEN_PLIST( w ) ) {
we = DiffInt( ELM_PLIST( west, st ), INTOBJ_INT(1) );
if( EqInt( we, INTOBJ_INT(0) ) ) { st--; }
else {
SET_ELM_PLIST( west, st, we );
SET_ELM_PLIST( sst, st, INTOBJ_INT(1) );
SET_ELM_PLIST( est, st, ELM_PLIST( w, 2 ) );
CHANGED_BAG( west ); CHANGED_BAG( est );
}
}
else {
SET_ELM_PLIST( sst, st, INTOBJ_INT(syl) );
SET_ELM_PLIST( est, st, ELM_PLIST( w, syl+1 ));
CHANGED_BAG( est );
}
}
}
return (Obj)0;
}
/* handler for function 2 */
static Obj HdlrFunc2 (
Obj self )
{
Obj t_1 = 0;
Obj t_2 = 0;
Obj t_3 = 0;
Obj t_4 = 0;
Obj t_5 = 0;
Obj t_6 = 0;
Bag oldFrame;
/* allocate new stack frame */
SWITCH_TO_NEW_FRAME(self,0,0,oldFrame);
/* Print( 1, "\n" ); */
t_1 = GF_Print;
t_2 = MakeString( "\n" );
CALL_2ARGS( t_1, INTOBJ_INT(1), t_2 );
/* Print( "abc", "\n" ); */
t_1 = GF_Print;
t_2 = MakeString( "abc" );
t_3 = MakeString( "\n" );
CALL_2ARGS( t_1, t_2, t_3 );
/* Print( (1,2)(5,6), "\n" ); */
t_1 = GF_Print;
t_2 = IdentityPerm;
t_4 = NEW_PLIST( T_PLIST, 2 );
SET_LEN_PLIST( t_4, 2 );
t_3 = NEW_PLIST( T_PLIST, 2 );
SET_LEN_PLIST( t_3, 2 );
SET_ELM_PLIST( t_4, 1, t_3 );
CHANGED_BAG( t_4 );
SET_ELM_PLIST( t_3, 1, INTOBJ_INT(1) );
CHANGED_BAG( t_3 );
SET_ELM_PLIST( t_3, 2, INTOBJ_INT(2) );
CHANGED_BAG( t_3 );
t_3 = NEW_PLIST( T_PLIST, 2 );
SET_LEN_PLIST( t_3, 2 );
SET_ELM_PLIST( t_4, 2, t_3 );
CHANGED_BAG( t_4 );
SET_ELM_PLIST( t_3, 1, INTOBJ_INT(5) );
CHANGED_BAG( t_3 );
SET_ELM_PLIST( t_3, 2, INTOBJ_INT(6) );
CHANGED_BAG( t_3 );
t_2 = Array2Perm( t_4 );
t_3 = MakeString( "\n" );
CALL_2ARGS( t_1, t_2, t_3 );
/* Print( [ 1, "abc" ], "\n" ); */
t_1 = GF_Print;
t_2 = NEW_PLIST( T_PLIST, 2 );
SET_LEN_PLIST( t_2, 2 );
SET_ELM_PLIST( t_2, 1, INTOBJ_INT(1) );
t_3 = MakeString( "abc" );
SET_ELM_PLIST( t_2, 2, t_3 );
CHANGED_BAG( t_2 );
t_3 = MakeString( "\n" );
CALL_2ARGS( t_1, t_2, t_3 );
/* Print( Group( (1,2,3) ), "\n" ); */
t_1 = GF_Print;
t_3 = GF_Group;
t_4 = IdentityPerm;
t_6 = NEW_PLIST( T_PLIST, 1 );
SET_LEN_PLIST( t_6, 1 );
t_5 = NEW_PLIST( T_PLIST, 3 );
SET_LEN_PLIST( t_5, 3 );
SET_ELM_PLIST( t_6, 1, t_5 );
CHANGED_BAG( t_6 );
SET_ELM_PLIST( t_5, 1, INTOBJ_INT(1) );
CHANGED_BAG( t_5 );
SET_ELM_PLIST( t_5, 2, INTOBJ_INT(2) );
CHANGED_BAG( t_5 );
SET_ELM_PLIST( t_5, 3, INTOBJ_INT(3) );
CHANGED_BAG( t_5 );
t_4 = Array2Perm( t_6 );
t_2 = CALL_1ARGS( t_3, t_4 );
CHECK_FUNC_RESULT( t_2 )
t_3 = MakeString( "\n" );
CALL_2ARGS( t_1, t_2, t_3 );
/* return; */
SWITCH_TO_OLD_FRAME(oldFrame);
return 0;
/* return; */
SWITCH_TO_OLD_FRAME(oldFrame);
return 0;
}
Obj boyers_planarity_check(Obj digraph, int flags, bool krtwsk) {
DIGRAPHS_ASSERT(flags == EMBEDFLAGS_PLANAR || flags == EMBEDFLAGS_OUTERPLANAR
|| flags == EMBEDFLAGS_SEARCHFORK23
|| flags == EMBEDFLAGS_SEARCHFORK4
|| flags == EMBEDFLAGS_SEARCHFORK33);
if (CALL_1ARGS(IsDigraph, digraph) != True) {
ErrorQuit("Digraphs: boyers_planarity_check (C): the 1st argument must be "
"a digraph, not %s",
(Int) TNAM_OBJ(digraph),
0L);
}
Obj const out = FuncOutNeighbours(0L, digraph);
if (FuncIS_ANTISYMMETRIC_DIGRAPH(0L, out) != True) {
ErrorQuit("Digraphs: boyers_planarity_check (C): the 1st argument must be "
"an antisymmetric digraph",
0L,
0L);
}
Int V = DigraphNrVertices(digraph);
Int E = DigraphNrEdges(digraph);
if (V > INT_MAX) {
// Cannot currently test this, it might always be true, depending on the
// definition of Int.
ErrorQuit("Digraphs: boyers_planarity_check (C): the maximum number of "
"nodes is %d, found %d",
INT_MAX,
V);
return 0L;
} else if (2 * E > INT_MAX) {
// Cannot currently test this
ErrorQuit("Digraphs: boyers_planarity_check (C): the maximum number of "
"edges is %d, found %d",
INT_MAX / 2,
E);
return 0L;
}
graphP theGraph = gp_New();
switch (flags) {
case EMBEDFLAGS_SEARCHFORK33:
gp_AttachK33Search(theGraph);
break;
case EMBEDFLAGS_SEARCHFORK23:
gp_AttachK23Search(theGraph);
break;
case EMBEDFLAGS_SEARCHFORK4:
gp_AttachK4Search(theGraph);
break;
}
if (gp_InitGraph(theGraph, V) != OK) {
gp_Free(&theGraph);
ErrorQuit("Digraphs: boyers_planarity_check (C): invalid number of nodes!",
0L,
0L);
return 0L;
} else if (gp_EnsureArcCapacity(theGraph, 2 * E) != OK) {
gp_Free(&theGraph);
ErrorQuit("Digraphs: boyers_planarity_check (C): invalid number of edges!",
0L,
0L);
return 0L;
}
int status;
for (Int v = 1; v <= LEN_LIST(out); ++v) {
DIGRAPHS_ASSERT(gp_VertexInRange(theGraph, v));
gp_SetVertexIndex(theGraph, v, v);
Obj const out_v = ELM_LIST(out, v);
for (Int w = 1; w <= LEN_LIST(out_v); ++w) {
DIGRAPHS_ASSERT(gp_VertexInRange(theGraph, w));
int u = INT_INTOBJ(ELM_LIST(out_v, w));
if (v != u) {
status = gp_AddEdge(theGraph, v, 0, u, 0);
if (status != OK) {
// Cannot currently test this, i.e. it shouldn't happen (and
// currently there is no example where it does happen)
gp_Free(&theGraph);
ErrorQuit("Digraphs: boyers_planarity_check (C): internal error, "
"can't add edge from %d to %d",
(Int) v,
(Int) u);
return 0L;
}
}
}
}
status = gp_Embed(theGraph, flags);
if (status == NOTOK) {
// Cannot currently test this, i.e. it shouldn't happen (and
// currently there is no example where it does happen)
gp_Free(&theGraph);
ErrorQuit("Digraphs: boyers_planarity_check (C): status is not ok", 0L, 0L);
}
Obj res;
if (krtwsk) {
// Kuratowski subgraph isolator
gp_SortVertices(theGraph);
Obj subgraph = NEW_PLIST_IMM(T_PLIST, theGraph->N);
SET_LEN_PLIST(subgraph, theGraph->N);
for (int i = 1; i <= theGraph->N; ++i) {
int nr = 0;
Obj list = NEW_PLIST_IMM(T_PLIST, 0);
int j = theGraph->V[i].link[1];
while (j) {
if (CALL_3ARGS(IsDigraphEdge,
digraph,
INTOBJ_INT((Int) i),
INTOBJ_INT((Int) theGraph->E[j].neighbor))
== True) {
AssPlist(list, ++nr, INTOBJ_INT(theGraph->E[j].neighbor));
}
j = theGraph->E[j].link[1];
}
if (nr == 0) {
RetypeBag(list, T_PLIST_EMPTY);
}
SET_ELM_PLIST(subgraph, i, list);
CHANGED_BAG(subgraph);
}
res = NEW_PLIST_IMM(T_PLIST, 2);
SET_LEN_PLIST(res, 2);
SET_ELM_PLIST(res, 1, (status == NONEMBEDDABLE ? False : True));
SET_ELM_PLIST(res, 2, subgraph);
CHANGED_BAG(res);
} else if (status == NONEMBEDDABLE) {
res = False;
} else {
res = True;
}
gp_Free(&theGraph);
return res;
}
/* 'InitLibrary' sets up gvars, rnams, functions */
static Int InitLibrary ( StructInitInfo * module )
{
Obj func1;
Obj body1;
/* Complete Copy/Fopy registration */
UpdateCopyFopyInfo();
/* global variables used in handlers */
G_IS__FUNCTION = GVarName( "IS_FUNCTION" );
G_ADD__LIST = GVarName( "ADD_LIST" );
G_Error = GVarName( "Error" );
G_IS__IDENTICAL__OBJ = GVarName( "IS_IDENTICAL_OBJ" );
G_AND__FLAGS = GVarName( "AND_FLAGS" );
G_HASH__FLAGS = GVarName( "HASH_FLAGS" );
G_WITH__HIDDEN__IMPS__FLAGS = GVarName( "WITH_HIDDEN_IMPS_FLAGS" );
G_IS__SUBSET__FLAGS = GVarName( "IS_SUBSET_FLAGS" );
G_TRUES__FLAGS = GVarName( "TRUES_FLAGS" );
G_FLAGS__FILTER = GVarName( "FLAGS_FILTER" );
G_WITH__HIDDEN__IMPS__FLAGS__COUNT = GVarName( "WITH_HIDDEN_IMPS_FLAGS_COUNT" );
G_WITH__HIDDEN__IMPS__FLAGS__CACHE__MISS = GVarName( "WITH_HIDDEN_IMPS_FLAGS_CACHE_MISS" );
G_WITH__HIDDEN__IMPS__FLAGS__CACHE__HIT = GVarName( "WITH_HIDDEN_IMPS_FLAGS_CACHE_HIT" );
G_IMPLICATIONS = GVarName( "IMPLICATIONS" );
G_WITH__IMPS__FLAGS__CACHE = GVarName( "WITH_IMPS_FLAGS_CACHE" );
G_WITH__IMPS__FLAGS__COUNT = GVarName( "WITH_IMPS_FLAGS_COUNT" );
G_WITH__IMPS__FLAGS__CACHE__HIT = GVarName( "WITH_IMPS_FLAGS_CACHE_HIT" );
G_WITH__IMPS__FLAGS__CACHE__MISS = GVarName( "WITH_IMPS_FLAGS_CACHE_MISS" );
G_CLEAR__IMP__CACHE = GVarName( "CLEAR_IMP_CACHE" );
G_BIND__GLOBAL = GVarName( "BIND_GLOBAL" );
G_UNBIND__GLOBAL = GVarName( "UNBIND_GLOBAL" );
G_RANK__FILTERS = GVarName( "RANK_FILTERS" );
G_RankFilter = GVarName( "RankFilter" );
G_RANK__FILTER = GVarName( "RANK_FILTER" );
G_RANK__FILTER__LIST__CURRENT = GVarName( "RANK_FILTER_LIST_CURRENT" );
G_RANK__FILTER__LIST = GVarName( "RANK_FILTER_LIST" );
G_RANK__FILTER__COUNT = GVarName( "RANK_FILTER_COUNT" );
/* record names used in handlers */
/* information for the functions */
C_NEW_STRING( DefaultName, 14, "local function" );
C_NEW_STRING( FileName, 21, "GAPROOT/lib/filter1.g" );
NameFunc[1] = DefaultName;
NamsFunc[1] = 0;
NargFunc[1] = 0;
NameFunc[2] = DefaultName;
NamsFunc[2] = 0;
NargFunc[2] = 0;
NameFunc[3] = DefaultName;
NamsFunc[3] = 0;
NargFunc[3] = 1;
NameFunc[4] = DefaultName;
NamsFunc[4] = 0;
NargFunc[4] = 1;
NameFunc[5] = DefaultName;
NamsFunc[5] = 0;
NargFunc[5] = 1;
NameFunc[6] = DefaultName;
NamsFunc[6] = 0;
NargFunc[6] = 1;
/* create all the functions defined in this module */
func1 = NewFunction(NameFunc[1],NargFunc[1],NamsFunc[1],HdlrFunc1);
ENVI_FUNC( func1 ) = TLS(CurrLVars);
CHANGED_BAG( TLS(CurrLVars) );
body1 = NewBag( T_BODY, NUMBER_HEADER_ITEMS_BODY*sizeof(Obj));
BODY_FUNC( func1 ) = body1;
CHANGED_BAG( func1 );
CALL_0ARGS( func1 );
/* return success */
return 0;
}
/* handler for function 1 */
static Obj HdlrFunc1 (
Obj self )
{
Obj t_1 = 0;
Obj t_2 = 0;
Obj t_3 = 0;
Obj t_4 = 0;
Bag oldFrame;
OLD_BRK_CURR_STAT
/* allocate new stack frame */
SWITCH_TO_NEW_FRAME(self,0,0,oldFrame);
REM_BRK_CURR_STAT();
SET_BRK_CURR_STAT(0);
/* WITH_HIDDEN_IMPS_FLAGS_COUNT := 0; */
AssGVar( G_WITH__HIDDEN__IMPS__FLAGS__COUNT, INTOBJ_INT(0) );
/* WITH_HIDDEN_IMPS_FLAGS_CACHE_MISS := 0; */
AssGVar( G_WITH__HIDDEN__IMPS__FLAGS__CACHE__MISS, INTOBJ_INT(0) );
/* WITH_HIDDEN_IMPS_FLAGS_CACHE_HIT := 0; */
AssGVar( G_WITH__HIDDEN__IMPS__FLAGS__CACHE__HIT, INTOBJ_INT(0) );
/* IMPLICATIONS := [ ]; */
t_1 = NEW_PLIST( T_PLIST, 0 );
SET_LEN_PLIST( t_1, 0 );
AssGVar( G_IMPLICATIONS, t_1 );
/* WITH_IMPS_FLAGS_CACHE := [ ]; */
t_1 = NEW_PLIST( T_PLIST, 0 );
SET_LEN_PLIST( t_1, 0 );
AssGVar( G_WITH__IMPS__FLAGS__CACHE, t_1 );
/* WITH_IMPS_FLAGS_COUNT := 0; */
AssGVar( G_WITH__IMPS__FLAGS__COUNT, INTOBJ_INT(0) );
/* WITH_IMPS_FLAGS_CACHE_HIT := 0; */
AssGVar( G_WITH__IMPS__FLAGS__CACHE__HIT, INTOBJ_INT(0) );
/* WITH_IMPS_FLAGS_CACHE_MISS := 0; */
AssGVar( G_WITH__IMPS__FLAGS__CACHE__MISS, INTOBJ_INT(0) );
/* Unbind( CLEAR_IMP_CACHE ); */
AssGVar( G_CLEAR__IMP__CACHE, 0 );
/* BIND_GLOBAL( "CLEAR_IMP_CACHE", function ( )
WITH_IMPS_FLAGS_CACHE := [ ];
return;
end ); */
t_1 = GF_BIND__GLOBAL;
C_NEW_STRING( t_2, 15, "CLEAR_IMP_CACHE" );
t_3 = NewFunction( NameFunc[2], NargFunc[2], NamsFunc[2], HdlrFunc2 );
ENVI_FUNC( t_3 ) = TLS(CurrLVars);
t_4 = NewBag( T_BODY, NUMBER_HEADER_ITEMS_BODY*sizeof(Obj) );
STARTLINE_BODY(t_4) = INTOBJ_INT(39);
ENDLINE_BODY(t_4) = INTOBJ_INT(41);
FILENAME_BODY(t_4) = FileName;
BODY_FUNC(t_3) = t_4;
CHANGED_BAG( TLS(CurrLVars) );
CALL_2ARGS( t_1, t_2, t_3 );
/* BIND_GLOBAL( "WITH_IMPS_FLAGS", function ( flags )
local with, changed, imp, hash, hash2, i;
hash := HASH_FLAGS( flags ) mod 11001;
for i in [ 0 .. 3 ] do
hash2 := 2 * ((hash + 31 * i) mod 11001) + 1;
if IsBound( WITH_IMPS_FLAGS_CACHE[hash2] ) then
if IS_IDENTICAL_OBJ( WITH_IMPS_FLAGS_CACHE[hash2], flags ) then
WITH_IMPS_FLAGS_CACHE_HIT := WITH_IMPS_FLAGS_CACHE_HIT + 1;
return WITH_IMPS_FLAGS_CACHE[hash2 + 1];
fi;
else
break;
fi;
od;
if i = 3 then
WITH_IMPS_FLAGS_COUNT := (WITH_IMPS_FLAGS_COUNT + 1) mod 4;
i := WITH_IMPS_FLAGS_COUNT;
hash2 := 2 * ((hash + 31 * i) mod 11001) + 1;
fi;
WITH_IMPS_FLAGS_CACHE_MISS := WITH_IMPS_FLAGS_CACHE_MISS + 1;
with := flags;
changed := true;
while changed do
changed := false;
for imp in IMPLICATIONS do
if IS_SUBSET_FLAGS( with, imp[2] ) and not IS_SUBSET_FLAGS( with, imp[1] ) then
with := AND_FLAGS( with, imp[1] );
changed := true;
fi;
od;
od;
WITH_IMPS_FLAGS_CACHE[hash2] := flags;
WITH_IMPS_FLAGS_CACHE[hash2 + 1] := with;
return with;
end ); */
t_1 = GF_BIND__GLOBAL;
C_NEW_STRING( t_2, 15, "WITH_IMPS_FLAGS" );
t_3 = NewFunction( NameFunc[3], NargFunc[3], NamsFunc[3], HdlrFunc3 );
ENVI_FUNC( t_3 ) = TLS(CurrLVars);
t_4 = NewBag( T_BODY, NUMBER_HEADER_ITEMS_BODY*sizeof(Obj) );
STARTLINE_BODY(t_4) = INTOBJ_INT(44);
ENDLINE_BODY(t_4) = INTOBJ_INT(83);
FILENAME_BODY(t_4) = FileName;
BODY_FUNC(t_3) = t_4;
CHANGED_BAG( TLS(CurrLVars) );
CALL_2ARGS( t_1, t_2, t_3 );
/* UNBIND_GLOBAL( "RANK_FILTER" ); */
t_1 = GF_UNBIND__GLOBAL;
C_NEW_STRING( t_2, 11, "RANK_FILTER" );
CALL_1ARGS( t_1, t_2 );
/* BIND_GLOBAL( "RANK_FILTER", function ( filter )
local rank, flags, i;
rank := 0;
if IS_FUNCTION( filter ) then
flags := FLAGS_FILTER( filter );
else
flags := filter;
fi;
for i in TRUES_FLAGS( WITH_HIDDEN_IMPS_FLAGS( flags ) ) do
if IsBound( RANK_FILTERS[i] ) then
rank := rank + RANK_FILTERS[i];
else
rank := rank + 1;
fi;
od;
return rank;
end ); */
t_1 = GF_BIND__GLOBAL;
C_NEW_STRING( t_2, 11, "RANK_FILTER" );
t_3 = NewFunction( NameFunc[4], NargFunc[4], NamsFunc[4], HdlrFunc4 );
ENVI_FUNC( t_3 ) = TLS(CurrLVars);
t_4 = NewBag( T_BODY, NUMBER_HEADER_ITEMS_BODY*sizeof(Obj) );
STARTLINE_BODY(t_4) = INTOBJ_INT(97);
ENDLINE_BODY(t_4) = INTOBJ_INT(114);
FILENAME_BODY(t_4) = FileName;
BODY_FUNC(t_3) = t_4;
CHANGED_BAG( TLS(CurrLVars) );
CALL_2ARGS( t_1, t_2, t_3 );
/* RankFilter := RANK_FILTER; */
t_1 = GC_RANK__FILTER;
CHECK_BOUND( t_1, "RANK_FILTER" )
AssGVar( G_RankFilter, t_1 );
/* UNBIND_GLOBAL( "RANK_FILTER_STORE" ); */
t_1 = GF_UNBIND__GLOBAL;
C_NEW_STRING( t_2, 17, "RANK_FILTER_STORE" );
CALL_1ARGS( t_1, t_2 );
/* BIND_GLOBAL( "RANK_FILTER_STORE", function ( filter )
local hash, rank, flags;
if IS_FUNCTION( filter ) then
flags := FLAGS_FILTER( filter );
else
flags := filter;
fi;
hash := HASH_FLAGS( flags );
rank := RANK_FILTER( flags );
ADD_LIST( RANK_FILTER_LIST_CURRENT, hash );
ADD_LIST( RANK_FILTER_LIST_CURRENT, rank );
return rank;
end ); */
t_1 = GF_BIND__GLOBAL;
C_NEW_STRING( t_2, 17, "RANK_FILTER_STORE" );
t_3 = NewFunction( NameFunc[5], NargFunc[5], NamsFunc[5], HdlrFunc5 );
ENVI_FUNC( t_3 ) = TLS(CurrLVars);
t_4 = NewBag( T_BODY, NUMBER_HEADER_ITEMS_BODY*sizeof(Obj) );
STARTLINE_BODY(t_4) = INTOBJ_INT(119);
ENDLINE_BODY(t_4) = INTOBJ_INT(133);
FILENAME_BODY(t_4) = FileName;
BODY_FUNC(t_3) = t_4;
CHANGED_BAG( TLS(CurrLVars) );
CALL_2ARGS( t_1, t_2, t_3 );
/* UNBIND_GLOBAL( "RANK_FILTER_COMPLETION" ); */
t_1 = GF_UNBIND__GLOBAL;
C_NEW_STRING( t_2, 22, "RANK_FILTER_COMPLETION" );
CALL_1ARGS( t_1, t_2 );
/* BIND_GLOBAL( "RANK_FILTER_COMPLETION", function ( filter )
local hash, flags;
if IS_FUNCTION( filter ) then
flags := FLAGS_FILTER( filter );
else
flags := filter;
fi;
hash := HASH_FLAGS( flags );
if hash <> RANK_FILTER_LIST[RANK_FILTER_COUNT] then
Error( "corrupted completion file" );
fi;
RANK_FILTER_COUNT := RANK_FILTER_COUNT + 2;
return RANK_FILTER_LIST[RANK_FILTER_COUNT - 1];
end ); */
t_1 = GF_BIND__GLOBAL;
C_NEW_STRING( t_2, 22, "RANK_FILTER_COMPLETION" );
t_3 = NewFunction( NameFunc[6], NargFunc[6], NamsFunc[6], HdlrFunc6 );
ENVI_FUNC( t_3 ) = TLS(CurrLVars);
t_4 = NewBag( T_BODY, NUMBER_HEADER_ITEMS_BODY*sizeof(Obj) );
STARTLINE_BODY(t_4) = INTOBJ_INT(136);
ENDLINE_BODY(t_4) = INTOBJ_INT(151);
FILENAME_BODY(t_4) = FileName;
BODY_FUNC(t_3) = t_4;
CHANGED_BAG( TLS(CurrLVars) );
CALL_2ARGS( t_1, t_2, t_3 );
/* return; */
RES_BRK_CURR_STAT();
SWITCH_TO_OLD_FRAME(oldFrame);
return 0;
/* return; */
RES_BRK_CURR_STAT();
SWITCH_TO_OLD_FRAME(oldFrame);
return 0;
}
/* handler for function 4 */
static Obj HdlrFunc4 (
Obj self )
{
Obj t_1 = 0;
Obj t_2 = 0;
Obj t_3 = 0;
Obj t_4 = 0;
Obj t_5 = 0;
Bag oldFrame;
/* allocate new stack frame */
SWITCH_TO_NEW_FRAME(self,0,0,oldFrame);
/* BreakOnError := false; */
t_1 = False;
AssGVar( G_BreakOnError, t_1 );
/* CALL_WITH_CATCH( range2, [ 1, 2 ^ 80 ] ); */
t_1 = GF_CALL__WITH__CATCH;
t_2 = GC_range2;
CHECK_BOUND( t_2, "range2" )
t_3 = NEW_PLIST( T_PLIST, 2 );
SET_LEN_PLIST( t_3, 2 );
SET_ELM_PLIST( t_3, 1, INTOBJ_INT(1) );
t_4 = POW( INTOBJ_INT(2), INTOBJ_INT(80) );
SET_ELM_PLIST( t_3, 2, t_4 );
CHANGED_BAG( t_3 );
CALL_2ARGS( t_1, t_2, t_3 );
/* CALL_WITH_CATCH( range2, [ - 2 ^ 80, 0 ] ); */
t_1 = GF_CALL__WITH__CATCH;
t_2 = GC_range2;
CHECK_BOUND( t_2, "range2" )
t_3 = NEW_PLIST( T_PLIST, 2 );
SET_LEN_PLIST( t_3, 2 );
t_5 = POW( INTOBJ_INT(2), INTOBJ_INT(80) );
C_AINV_FIA( t_4, t_5 )
SET_ELM_PLIST( t_3, 1, t_4 );
CHANGED_BAG( t_3 );
SET_ELM_PLIST( t_3, 2, INTOBJ_INT(0) );
CALL_2ARGS( t_1, t_2, t_3 );
/* CALL_WITH_CATCH( range3, [ 1, 2, 2 ^ 80 ] ); */
t_1 = GF_CALL__WITH__CATCH;
t_2 = GC_range3;
CHECK_BOUND( t_2, "range3" )
t_3 = NEW_PLIST( T_PLIST, 3 );
SET_LEN_PLIST( t_3, 3 );
SET_ELM_PLIST( t_3, 1, INTOBJ_INT(1) );
SET_ELM_PLIST( t_3, 2, INTOBJ_INT(2) );
t_4 = POW( INTOBJ_INT(2), INTOBJ_INT(80) );
SET_ELM_PLIST( t_3, 3, t_4 );
CHANGED_BAG( t_3 );
CALL_2ARGS( t_1, t_2, t_3 );
/* CALL_WITH_CATCH( range3, [ - 2 ^ 80, 0, 1 ] ); */
t_1 = GF_CALL__WITH__CATCH;
t_2 = GC_range3;
CHECK_BOUND( t_2, "range3" )
t_3 = NEW_PLIST( T_PLIST, 3 );
SET_LEN_PLIST( t_3, 3 );
t_5 = POW( INTOBJ_INT(2), INTOBJ_INT(80) );
C_AINV_FIA( t_4, t_5 )
SET_ELM_PLIST( t_3, 1, t_4 );
CHANGED_BAG( t_3 );
SET_ELM_PLIST( t_3, 2, INTOBJ_INT(0) );
SET_ELM_PLIST( t_3, 3, INTOBJ_INT(1) );
CALL_2ARGS( t_1, t_2, t_3 );
/* CALL_WITH_CATCH( range3, [ 0, 2 ^ 80, 2 ^ 81 ] ); */
t_1 = GF_CALL__WITH__CATCH;
t_2 = GC_range3;
CHECK_BOUND( t_2, "range3" )
t_3 = NEW_PLIST( T_PLIST, 3 );
SET_LEN_PLIST( t_3, 3 );
SET_ELM_PLIST( t_3, 1, INTOBJ_INT(0) );
t_4 = POW( INTOBJ_INT(2), INTOBJ_INT(80) );
SET_ELM_PLIST( t_3, 2, t_4 );
CHANGED_BAG( t_3 );
t_4 = POW( INTOBJ_INT(2), INTOBJ_INT(81) );
SET_ELM_PLIST( t_3, 3, t_4 );
CHANGED_BAG( t_3 );
CALL_2ARGS( t_1, t_2, t_3 );
/* Display( [ 1, 2 .. 2 ] ); */
t_1 = GF_Display;
t_2 = Range3Check( INTOBJ_INT(1), INTOBJ_INT(2), INTOBJ_INT(2) );
CALL_1ARGS( t_1, t_2 );
/* CALL_WITH_CATCH( range3, [ 2, 2, 2 ] ); */
t_1 = GF_CALL__WITH__CATCH;
t_2 = GC_range3;
CHECK_BOUND( t_2, "range3" )
t_3 = NEW_PLIST( T_PLIST, 3 );
SET_LEN_PLIST( t_3, 3 );
SET_ELM_PLIST( t_3, 1, INTOBJ_INT(2) );
SET_ELM_PLIST( t_3, 2, INTOBJ_INT(2) );
SET_ELM_PLIST( t_3, 3, INTOBJ_INT(2) );
CALL_2ARGS( t_1, t_2, t_3 );
/* Display( [ 2, 4 .. 6 ] ); */
t_1 = GF_Display;
t_2 = Range3Check( INTOBJ_INT(2), INTOBJ_INT(4), INTOBJ_INT(6) );
CALL_1ARGS( t_1, t_2 );
/* CALL_WITH_CATCH( range3, [ 2, 4, 7 ] ); */
t_1 = GF_CALL__WITH__CATCH;
t_2 = GC_range3;
CHECK_BOUND( t_2, "range3" )
t_3 = NEW_PLIST( T_PLIST, 3 );
SET_LEN_PLIST( t_3, 3 );
SET_ELM_PLIST( t_3, 1, INTOBJ_INT(2) );
SET_ELM_PLIST( t_3, 2, INTOBJ_INT(4) );
SET_ELM_PLIST( t_3, 3, INTOBJ_INT(7) );
CALL_2ARGS( t_1, t_2, t_3 );
/* Display( [ 2, 4 .. 2 ] ); */
t_1 = GF_Display;
t_2 = Range3Check( INTOBJ_INT(2), INTOBJ_INT(4), INTOBJ_INT(2) );
CALL_1ARGS( t_1, t_2 );
/* Display( [ 2, 4 .. 0 ] ); */
t_1 = GF_Display;
t_2 = Range3Check( INTOBJ_INT(2), INTOBJ_INT(4), INTOBJ_INT(0) );
CALL_1ARGS( t_1, t_2 );
/* CALL_WITH_CATCH( range3, [ 4, 2, 1 ] ); */
t_1 = GF_CALL__WITH__CATCH;
t_2 = GC_range3;
CHECK_BOUND( t_2, "range3" )
t_3 = NEW_PLIST( T_PLIST, 3 );
SET_LEN_PLIST( t_3, 3 );
SET_ELM_PLIST( t_3, 1, INTOBJ_INT(4) );
SET_ELM_PLIST( t_3, 2, INTOBJ_INT(2) );
SET_ELM_PLIST( t_3, 3, INTOBJ_INT(1) );
CALL_2ARGS( t_1, t_2, t_3 );
/* Display( [ 4, 2 .. 0 ] ); */
t_1 = GF_Display;
t_2 = Range3Check( INTOBJ_INT(4), INTOBJ_INT(2), INTOBJ_INT(0) );
CALL_1ARGS( t_1, t_2 );
/* Display( [ 4, 2 .. 8 ] ); */
t_1 = GF_Display;
t_2 = Range3Check( INTOBJ_INT(4), INTOBJ_INT(2), INTOBJ_INT(8) );
CALL_1ARGS( t_1, t_2 );
/* return; */
SWITCH_TO_OLD_FRAME(oldFrame);
return 0;
/* return; */
SWITCH_TO_OLD_FRAME(oldFrame);
return 0;
}
