Exemple #1
0
Obj FuncFREXP_MACFLOAT( Obj self, Obj f)
{
    int i;
    Obj d = NEW_MACFLOAT(frexp (VAL_MACFLOAT(f), &i));
    Obj l = NEW_PLIST(T_PLIST,2);
    SET_ELM_PLIST(l,1,d);
    SET_ELM_PLIST(l,2,INTOBJ_INT(i));
    SET_LEN_PLIST(l,2);
    return l;
}
    Obj operator()(const std::pair<T,U>& v) const
    {
        Obj list = NEW_PLIST(T_PLIST_DENSE, 2);
        SET_LEN_PLIST(list, 2);

        GAP_maker<T> m_t;
        SET_ELM_PLIST(list, 1, m_t(v.first));
        CHANGED_BAG(list);

        GAP_maker<U> m_u;
        SET_ELM_PLIST(list, 2, m_u(v.second));
        CHANGED_BAG(list);

        return list;
    }
Exemple #3
0
/****************************************************************************
**
*F  SCTableProduct( <table>, <list1>, <list2> ) . product wrt structure table
**
**  'SCTableProduct'  returns the product   of  the two elements <list1>  and
**  <list2> with respect to the structure constants table <table>.
*/
void SCTableProdAdd (
    Obj                 res,
    Obj                 coeff,
    Obj                 basis_coeffs,
    Int                 dim )
{
    Obj                 basis;
    Obj                 coeffs;
    Int                 len;
    Obj                 k;
    Obj                 c1, c2;
    Int                 l;

    basis  = ELM_LIST( basis_coeffs, 1 );
    coeffs = ELM_LIST( basis_coeffs, 2 );
    len = LEN_LIST( basis );
    if ( LEN_LIST( coeffs ) != len ) {
        ErrorQuit("SCTableProduct: corrupted <table>",0L,0L);
    }
    for ( l = 1; l <= len; l++ ) {
        k = ELM_LIST( basis, l );
        if ( ! IS_INTOBJ(k) || INT_INTOBJ(k) <= 0 || dim < INT_INTOBJ(k) ) {
            ErrorQuit("SCTableProduct: corrupted <table>",0L,0L);
        }
        c1 = ELM_LIST( coeffs, l );
        c1 = PROD( coeff, c1 );
        c2 = ELM_PLIST( res, INT_INTOBJ(k) );
        c2 = SUM( c2, c1 );
        SET_ELM_PLIST( res, INT_INTOBJ(k), c2 );
        CHANGED_BAG( res );
    }
}
Exemple #4
0
static inline void PushObj(Obj obj) {
  Obj stack = TLS(SerializationStack);
  UInt len = LEN_PLIST(stack);
  len++;
  GROW_PLIST(stack, len);
  SET_LEN_PLIST(stack, len);
  SET_ELM_PLIST(stack, len, obj);
}
Exemple #5
0
static inline Obj PopObj(void) {
  Obj stack = TLS(SerializationStack);
  UInt len = LEN_PLIST(stack);
  Obj result = ELM_PLIST(stack, len);
  SET_ELM_PLIST(stack, len, (Obj) 0);
  len--;
  SET_LEN_PLIST(stack, len);
  return result;
}
Exemple #6
0
Obj CopyObjWPObj (
    Obj                 obj,
    Int                 mut )
{
    Obj                 copy;           /* copy, result                    */
    Obj                 tmp;            /* temporary variable              */
    Obj                 elm;
    UInt                i;              /* loop variable                   */

    /* make a copy                                                         */
    if ( mut ) {
        copy = NewBag( T_WPOBJ, SIZE_OBJ(obj) );
        ADDR_OBJ(copy)[0] = ADDR_OBJ(obj)[0];
    }
    else {
        copy = NewBag( T_PLIST+IMMUTABLE, SIZE_OBJ(obj) );
        SET_LEN_PLIST(copy,LengthWPObj(obj));
    }

    /* leave a forwarding pointer                                          */
    tmp = NEW_PLIST( T_PLIST, 2 );
    SET_LEN_PLIST( tmp, 2 );
    SET_ELM_PLIST( tmp, 1, ADDR_OBJ(obj)[0] );
    SET_ELM_PLIST( tmp, 2, copy );
    ADDR_OBJ(obj)[0] = tmp;
    CHANGED_BAG(obj);

    /* now it is copied                                                    */
    RetypeBag( obj, T_WPOBJ + COPYING );

    /* copy the subvalues                                                  */
    for ( i =  SIZE_OBJ(obj)/sizeof(Obj)-1; i > 0; i-- ) {
        elm = ADDR_OBJ(obj)[i];
        if ( elm != 0  && !IS_WEAK_DEAD_BAG(elm)) {
            tmp = COPY_OBJ( elm, mut );
            ADDR_OBJ(copy)[i] = tmp;
            CHANGED_BAG( copy );
        }
    }

    /* return the copy                                                     */
    return copy;
}
Exemple #7
0
static inline Obj PopObj(void)
{
    Obj  stack = MODULE_STATE(Serialize).stack;
    UInt len = LEN_PLIST(stack);
    Obj  result = ELM_PLIST(stack, len);
    SET_ELM_PLIST(stack, len, (Obj)0);
    len--;
    SET_LEN_PLIST(stack, len);
    return result;
}
Exemple #8
0
/****************************************************************************
**
*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;
}
Exemple #9
0
static Obj FuncALL_RNAMES(Obj self)
{
    Obj                 copy, s;
    UInt                i;
    Obj                 name;
    const UInt          countRNam = LEN_PLIST(NamesRNam);

    copy = NEW_PLIST_IMM( T_PLIST, countRNam );
    for ( i = 1;  i <= countRNam;  i++ ) {
        name = NAME_RNAM( i );
        s = CopyToStringRep(name);
        SET_ELM_PLIST( copy, i, s );
    }
    SET_LEN_PLIST( copy, countRNam );
    return copy;
}
Exemple #10
0
Obj FuncALL_RNAMES (
    Obj                 self )
{
    Obj                 copy, s;
    UInt                i;
    Char*               name;

    copy = NEW_PLIST( T_PLIST+IMMUTABLE, CountRNam );
    for ( i = 1;  i <= CountRNam;  i++ ) {
        name = NAME_RNAM( i );
        C_NEW_STRING_DYN(s, name);
        SET_ELM_PLIST( copy, i, s );
    }
    SET_LEN_PLIST( copy, CountRNam );
    return copy;
}
Exemple #11
0
Obj ZeroVecFFE( Obj vec )
{
    UInt i, len;
    Obj res;
    Obj z;
    assert(TNUM_OBJ(vec) >= T_PLIST_FFE && \
    TNUM_OBJ(vec) <= T_PLIST_FFE + IMMUTABLE);
    len = LEN_PLIST(vec);
    assert(len);
    res  = NEW_PLIST(TNUM_OBJ(vec), len);
    SET_LEN_PLIST(res, len);
    z = ZERO(ELM_PLIST(vec, 1));
    for (i = 1; i <= len; i++)
        SET_ELM_PLIST(res, i, z);
    return res;
}
Exemple #12
0
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 );
  }

}
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;
}
Exemple #14
0
template<class Z> Obj dofplll(Obj gapmat, Obj lllargs, Obj svpargs)
{
  if (!IS_PLIST(gapmat)) return INTOBJ_INT(-1);
  Int numrows = LEN_PLIST(gapmat), numcols = -1;
  
  for (int i = 1; i <= numrows; i++) {
    Obj row = ELM_PLIST(gapmat,i);
    if (numcols == -1)
      numcols = LEN_PLIST(row);
    if (numcols != LEN_PLIST(row))
      return INTOBJ_INT(-1);
  }
  if (numcols <= 0)
    return INTOBJ_INT(-1);

  ZZ_mat<Z> mat(numrows, numcols);
  for (int i = 1; i <= numrows; i++)
    for (int j = 1; j <= numcols; j++)
      SET_INTOBJ(mat[i-1][j-1], ELM_PLIST(ELM_PLIST(gapmat,i),j));

  if (lllargs != Fail) {
    double delta = 0.99;
    double eta = 0.51;
    LLLMethod method = LM_WRAPPER;
    FloatType floatType = FT_DEFAULT;
    int precision = 0;
    int flags = LLL_DEFAULT;

    if (lllargs != True) {
      if (!IS_PLIST(lllargs) || LEN_PLIST(lllargs) != 6) return INTOBJ_INT(-20);

      Obj v = ELM_PLIST(lllargs,1);
      if (IS_MACFLOAT(v)) delta = VAL_MACFLOAT(v);
      else if (v != Fail) return INTOBJ_INT(-21);

      v = ELM_PLIST(lllargs,2);
      if (IS_MACFLOAT(v)) eta = VAL_MACFLOAT(v);
      else if (v != Fail) return INTOBJ_INT(-22);

      v = ELM_PLIST(lllargs,3);
      if (v == INTOBJ_INT(0)) method = LM_WRAPPER;
      else if (v == INTOBJ_INT(1)) method = LM_PROVED;
      else if (v == INTOBJ_INT(2)) method = LM_HEURISTIC;
      else if (v == INTOBJ_INT(3)) method = LM_FAST;
      else if (v != Fail) return INTOBJ_INT(-23);

      v = ELM_PLIST(lllargs,4);
      if (v == INTOBJ_INT(0)) floatType = FT_DEFAULT;
      else if (v == INTOBJ_INT(1)) floatType = FT_DOUBLE;
      else if (v == INTOBJ_INT(2)) floatType = FT_DPE;
      else if (v == INTOBJ_INT(3)) floatType = FT_MPFR;
      else if (v != Fail) return INTOBJ_INT(-24);

      v = ELM_PLIST(lllargs,5);
      if (IS_INTOBJ(v)) precision = INT_INTOBJ(v);
      else if (v != Fail) return INTOBJ_INT(-25);

      v = ELM_PLIST(lllargs,6);
      if (IS_INTOBJ(v)) flags = INT_INTOBJ(v);
      else if (v != Fail) return INTOBJ_INT(-26);
    }
    int result = lllReduction(mat, delta, eta, method, floatType, precision, flags);

    if (result != RED_SUCCESS)
      return INTOBJ_INT(10*result+1);
  }

  if (svpargs != Fail) {
    SVPMethod method = SVPM_PROVED;
    int flags = SVP_DEFAULT;

    // __asm__ ("int3");
    if (svpargs != True) {
      if (!IS_PLIST(svpargs) || LEN_PLIST(svpargs) != 2) return INTOBJ_INT(-30);

      Obj v = ELM_PLIST(svpargs,1);
      if (v == INTOBJ_INT(0)) method = SVPM_PROVED;
      else if (v == INTOBJ_INT(1)) method = SVPM_FAST;
      else if (v != Fail) return INTOBJ_INT(-31);

      v = ELM_PLIST(svpargs,2);
      if (IS_INTOBJ(v)) flags = INT_INTOBJ(v);
      else if (v != Fail) return INTOBJ_INT(-32);
    }

    vector<Integer> sol(numrows);
    IntMatrix svpmat(numrows,numcols);

    for (int i = 0; i < numrows; i++)
      for (int j = 0; j < numcols; j++)
	SET_Z(svpmat[i][j],mat[i][j]);

    int result = shortestVector(svpmat, sol, method, flags);

    if (result != RED_SUCCESS)
      return INTOBJ_INT(10*result+2);

    Obj gapvec;
    if (lllargs == Fail) { // return coordinates of shortest vector in mat
      gapvec = NEW_PLIST(T_PLIST,numrows);
      SET_LEN_PLIST(gapvec,numrows);
      for (int i = 1; i <= numrows; i++) {
	Obj v = GET_INTOBJ(sol[i-1]);
	SET_ELM_PLIST(gapvec,i,v);
      }
    } else { // return shortest vector
      gapvec = NEW_PLIST(T_PLIST,numcols);
      SET_LEN_PLIST(gapvec,numcols);
      for (int i = 1; i <= numcols; i++) {
	Integer s;
	s = 0;
	for (int j = 0; j < numrows; j++)
	  s.addmul(sol[j],svpmat[j][i-1]);
	Obj v = GET_INTOBJ(s);
	SET_ELM_PLIST(gapvec,i,v);
      }
    }
    return gapvec;
  }

  gapmat = NEW_PLIST(T_PLIST,numrows);
  SET_LEN_PLIST(gapmat,numrows);
  for (int i = 1; i <= numrows; i++) {
    Obj gaprow = NEW_PLIST(T_PLIST,numcols);
    SET_LEN_PLIST(gaprow,numcols);
    SET_ELM_PLIST(gapmat,i,gaprow);
    for (int j = 1; j <= numcols; j++) {
      Obj v = GET_INTOBJ(mat[i-1][j-1]);
      SET_ELM_PLIST(gaprow,j,v);
    }
  }
  return gapmat;
}
Exemple #15
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 );
    }
  }
Exemple #16
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);
}
Exemple #17
0
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 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;
}
Exemple #19
0
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;
}
Exemple #20
0
UInt RNamNameWithLen(const Char * name, UInt len)
{
    Obj                 rnam;           /* record name (as imm intobj)     */
    UInt                pos;            /* hash position                   */
    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>          */
    UInt                i;              /* loop variable                   */
    UInt                sizeRNam;

    if (len > 1023) {
        // Note: We can't pass 'name' here, as it might get moved by garbage collection
        ErrorQuit("Record names must consist of at most 1023 characters", 0, 0);
    }

    /* start looking in the table at the following hash position           */
    const UInt hash = HashString( name, len );

#ifdef HPCGAP
    HPC_LockNames(0); /* try a read lock first */
#endif

    /* look through the table until we find a free slot or the global      */
    sizeRNam = LEN_PLIST(HashRNam);
    pos = (hash % sizeRNam) + 1;
    while ( (rnam = ELM_PLIST( HashRNam, pos )) != 0
         && !EqString( NAME_RNAM( INT_INTOBJ(rnam) ), name, len ) ) {
        pos = (pos % sizeRNam) + 1;
    }
    if (rnam != 0) {
#ifdef HPCGAP
      HPC_UnlockNames();
#endif
      return INT_INTOBJ(rnam);
    }
#ifdef HPCGAP
    if (!PreThreadCreation) {
      HPC_UnlockNames(); /* switch to a write lock */
      HPC_LockNames(1);
      /* look through the table until we find a free slot or the global      */
      sizeRNam = LEN_PLIST(HashRNam);
      pos = (hash % sizeRNam) + 1;
      while ( (rnam = ELM_PLIST( HashRNam, pos )) != 0
           && !EqString( NAME_RNAM( INT_INTOBJ(rnam) ), name, len ) ) {
          pos = (pos % sizeRNam) + 1;
      }
    }
    if (rnam != 0) {
      HPC_UnlockNames();
      return INT_INTOBJ(rnam);
    }
#endif

    /* 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)     */
    memcpy( namx, name, len );
    namx[len] = 0;
    string = MakeImmString(namx);

    const UInt countRNam = PushPlist(NamesRNam, string);
    rnam = INTOBJ_INT(countRNam);
    SET_ELM_PLIST( HashRNam, pos, rnam );

    /* if the table is too crowded, 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 );
#ifdef HPCGAP
        /* The list is briefly non-public, but this is safe, because
         * the mutex protects it from being accessed by other threads.
         */
        MakeBagPublic(HashRNam);
#endif
        for ( i = 1; i <= (sizeRNam-1)/2; i++ ) {
            rnam2 = ELM_PLIST( table, i );
            if ( rnam2 == 0 )  continue;
            string = NAME_RNAM( INT_INTOBJ(rnam2) );
            pos = HashString( CONST_CSTR_STRING( string ), GET_LEN_STRING( string) );
            pos = (pos % sizeRNam) + 1;
            while ( ELM_PLIST( HashRNam, pos ) != 0 ) {
                pos = (pos % sizeRNam) + 1;
            }
            SET_ELM_PLIST( HashRNam, pos, rnam2 );
        }
    }
#ifdef HPCGAP
    HPC_UnlockNames();
#endif

    /* return the record name                                              */
    return INT_INTOBJ(rnam);
}
Exemple #21
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;
}
/* 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;
}