Macros | Enumerations | Functions | Variables
ipshell.cc File Reference
#include <kernel/mod2.h>
#include <omalloc/omalloc.h>
#include <factory/factory.h>
#include <misc/auxiliary.h>
#include <misc/options.h>
#include <misc/mylimits.h>
#include <misc/intvec.h>
#include <misc/prime.h>
#include <coeffs/numbers.h>
#include <coeffs/coeffs.h>
#include <coeffs/rmodulon.h>
#include <coeffs/longrat.h>
#include <polys/monomials/ring.h>
#include <polys/monomials/maps.h>
#include <polys/prCopy.h>
#include <polys/matpol.h>
#include <polys/weight.h>
#include <polys/clapsing.h>
#include <polys/ext_fields/algext.h>
#include <polys/ext_fields/transext.h>
#include <kernel/polys.h>
#include <kernel/ideals.h>
#include <kernel/numeric/mpr_base.h>
#include <kernel/numeric/mpr_numeric.h>
#include <kernel/GBEngine/syz.h>
#include <kernel/GBEngine/kstd1.h>
#include <kernel/GBEngine/kutil.h>
#include <kernel/combinatorics/stairc.h>
#include <kernel/combinatorics/hutil.h>
#include <kernel/spectrum/semic.h>
#include <kernel/spectrum/splist.h>
#include <kernel/spectrum/spectrum.h>
#include <kernel/oswrapper/feread.h>
#include <Singular/lists.h>
#include <Singular/attrib.h>
#include <Singular/ipconv.h>
#include <Singular/links/silink.h>
#include <Singular/ipshell.h>
#include <Singular/maps_ip.h>
#include <Singular/tok.h>
#include <Singular/ipid.h>
#include <Singular/subexpr.h>
#include <Singular/fevoices.h>
#include <Singular/sdb.h>
#include <math.h>
#include <ctype.h>
#include <kernel/maps/gen_maps.h>
#include <Singular/number2.h>
#include <coeffs/bigintmat.h>
#include "libparse.h"

Go to the source code of this file.

Macros

#define BREAK_LINE_LENGTH   80
 

Enumerations

enum  semicState {
  semicOK, semicMulNegative, semicListTooShort, semicListTooLong,
  semicListFirstElementWrongType, semicListSecondElementWrongType, semicListThirdElementWrongType, semicListFourthElementWrongType,
  semicListFifthElementWrongType, semicListSixthElementWrongType, semicListNNegative, semicListWrongNumberOfNumerators,
  semicListWrongNumberOfDenominators, semicListWrongNumberOfMultiplicities, semicListMuNegative, semicListPgNegative,
  semicListNumNegative, semicListDenNegative, semicListMulNegative, semicListNotSymmetric,
  semicListNotMonotonous, semicListMilnorWrong, semicListPGWrong
}
 
enum  spectrumState {
  spectrumOK, spectrumZero, spectrumBadPoly, spectrumNoSingularity,
  spectrumNotIsolated, spectrumDegenerate, spectrumWrongRing, spectrumNoHC,
  spectrumUnspecErr
}
 

Functions

const char * iiTwoOps (int t)
 
int iiOpsTwoChar (const char *s)
 
static void list1 (const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
 
void type_cmd (leftv v)
 
static void killlocals0 (int v, idhdl *localhdl, const ring r)
 
void killlocals_rec (idhdl *root, int v, ring r)
 
BOOLEAN killlocals_list (int v, lists L)
 
void killlocals (int v)
 
void list_cmd (int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname)
 
void test_cmd (int i)
 
int exprlist_length (leftv v)
 
BOOLEAN iiWRITE (leftv, leftv v)
 
leftv iiMap (map theMap, const char *what)
 
void iiMakeResolv (resolvente r, int length, int rlen, char *name, int typ0, intvec **weights)
 
static resolvente iiCopyRes (resolvente r, int l)
 
BOOLEAN jjMINRES (leftv res, leftv v)
 
BOOLEAN jjBETTI (leftv res, leftv u)
 
BOOLEAN jjBETTI2_ID (leftv res, leftv u, leftv v)
 
BOOLEAN jjBETTI2 (leftv res, leftv u, leftv v)
 
int iiRegularity (lists L)
 
void iiDebug ()
 
lists scIndIndset (ideal S, BOOLEAN all, ideal Q)
 
int iiDeclCommand (leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
 
BOOLEAN iiDefaultParameter (leftv p)
 
BOOLEAN iiBranchTo (leftv, leftv args)
 
BOOLEAN iiParameter (leftv p)
 
static BOOLEAN iiInternalExport (leftv v, int toLev)
 
BOOLEAN iiInternalExport (leftv v, int toLev, package rootpack)
 
BOOLEAN iiExport (leftv v, int toLev)
 
BOOLEAN iiExport (leftv v, int toLev, package pack)
 
BOOLEAN iiCheckRing (int i)
 
poly iiHighCorner (ideal I, int ak)
 
void iiCheckPack (package &p)
 
idhdl rDefault (const char *s)
 
idhdl rFindHdl (ring r, idhdl n)
 
void rDecomposeCF (leftv h, const ring r, const ring R)
 
static void rDecomposeC_41 (leftv h, const coeffs C)
 
static void rDecomposeC (leftv h, const ring R)
 
void rDecomposeRing_41 (leftv h, const coeffs C)
 
void rDecomposeRing (leftv h, const ring R)
 
BOOLEAN rDecompose_CF (leftv res, const coeffs C)
 
lists rDecompose_list_cf (const ring r)
 
lists rDecompose (const ring r)
 
void rComposeC (lists L, ring R)
 
void rComposeRing (lists L, ring R)
 
static void rRenameVars (ring R)
 
static BOOLEAN rComposeVar (const lists L, ring R)
 
static BOOLEAN rComposeOrder (const lists L, const BOOLEAN check_comp, ring R)
 
ring rCompose (const lists L, const BOOLEAN check_comp)
 
BOOLEAN mpJacobi (leftv res, leftv a)
 
BOOLEAN mpKoszul (leftv res, leftv c, leftv b, leftv id)
 
BOOLEAN syBetti2 (leftv res, leftv u, leftv w)
 
BOOLEAN syBetti1 (leftv res, leftv u)
 
lists syConvRes (syStrategy syzstr, BOOLEAN toDel, int add_row_shift)
 
syStrategy syConvList (lists li, BOOLEAN toDel)
 
syStrategy syForceMin (lists li)
 
BOOLEAN kWeight (leftv res, leftv id)
 
BOOLEAN kQHWeight (leftv res, leftv v)
 
BOOLEAN jjRESULTANT (leftv res, leftv u, leftv v, leftv w)
 
BOOLEAN jjCHARSERIES (leftv res, leftv u)
 
void copy_deep (spectrum &spec, lists l)
 
spectrum spectrumFromList (lists l)
 
lists getList (spectrum &spec)
 
void list_error (semicState state)
 
spectrumState spectrumStateFromList (spectrumPolyList &speclist, lists *L, int fast)
 
spectrumState spectrumCompute (poly h, lists *L, int fast)
 
void spectrumPrintError (spectrumState state)
 
BOOLEAN spectrumProc (leftv result, leftv first)
 
BOOLEAN spectrumfProc (leftv result, leftv first)
 
semicState list_is_spectrum (lists l)
 
BOOLEAN spaddProc (leftv result, leftv first, leftv second)
 
BOOLEAN spmulProc (leftv result, leftv first, leftv second)
 
BOOLEAN semicProc3 (leftv res, leftv u, leftv v, leftv w)
 
BOOLEAN semicProc (leftv res, leftv u, leftv v)
 
BOOLEAN loNewtonP (leftv res, leftv arg1)
 compute Newton Polytopes of input polynomials More...
 
BOOLEAN loSimplex (leftv res, leftv args)
 Implementation of the Simplex Algorithm. More...
 
BOOLEAN nuMPResMat (leftv res, leftv arg1, leftv arg2)
 returns module representing the multipolynomial resultant matrix Arguments 2: ideal i, int k k=0: use sparse resultant matrix of Gelfand, Kapranov and Zelevinsky k=1: use resultant matrix of Macaulay (k=0 is default) More...
 
BOOLEAN nuLagSolve (leftv res, leftv arg1, leftv arg2, leftv arg3)
 find the (complex) roots an univariate polynomial Determines the roots of an univariate polynomial using Laguerres' root-solver. More...
 
BOOLEAN nuVanderSys (leftv res, leftv arg1, leftv arg2, leftv arg3)
 COMPUTE: polynomial p with values given by v at points p1,..,pN derived from p; more precisely: consider p as point in K^n and v as N elements in K, let p1,..,pN be the points in K^n obtained by evaluating all monomials of degree 0,1,...,N at p in lexicographical order, then the procedure computes the polynomial f satisfying f(pi) = v[i] RETURN: polynomial f of degree d. More...
 
BOOLEAN nuUResSolve (leftv res, leftv args)
 solve a multipolynomial system using the u-resultant Input ideal must be 0-dimensional and (currRing->N) == IDELEMS(ideal). More...
 
lists listOfRoots (rootArranger *self, const unsigned int oprec)
 
void rSetHdl (idhdl h)
 
static leftv rOptimizeOrdAsSleftv (leftv ord)
 
BOOLEAN rSleftvOrdering2Ordering (sleftv *ord, ring R)
 
static BOOLEAN rSleftvList2StringArray (leftv sl, char **p)
 
ring rInit (leftv pn, leftv rv, leftv ord)
 
ring rSubring (ring org_ring, sleftv *rv)
 
void rKill (ring r)
 
void rKill (idhdl h)
 
idhdl rSimpleFindHdl (ring r, idhdl root, idhdl n)
 
BOOLEAN jjPROC (leftv res, leftv u, leftv v)
 
ideal kGroebner (ideal F, ideal Q)
 
static void jjINT_S_TO_ID (int n, int *e, leftv res)
 
BOOLEAN jjVARIABLES_P (leftv res, leftv u)
 
BOOLEAN jjVARIABLES_ID (leftv res, leftv u)
 
void paPrint (const char *n, package p)
 
BOOLEAN iiApplyINTVEC (leftv res, leftv a, int op, leftv proc)
 
BOOLEAN iiApplyBIGINTMAT (leftv, leftv, int, leftv)
 
BOOLEAN iiApplyIDEAL (leftv, leftv, int, leftv)
 
BOOLEAN iiApplyLIST (leftv res, leftv a, int op, leftv proc)
 
BOOLEAN iiApply (leftv res, leftv a, int op, leftv proc)
 
BOOLEAN iiTestAssume (leftv a, leftv b)
 
BOOLEAN iiARROW (leftv r, char *a, char *s)
 
BOOLEAN iiAssignCR (leftv r, leftv arg)
 
static void iiReportTypes (int nr, int t, const short *T)
 
BOOLEAN iiCheckTypes (leftv args, const short *type_list, int report)
 check a list of arguemys against a given field of types return TRUE if the types match return FALSE (and, if report) report an error via Werror otherwise More...
 

Variables

leftv iiCurrArgs =NULL
 
idhdl iiCurrProc =NULL
 
const char * lastreserved =NULL
 
static BOOLEAN iiNoKeepRing =TRUE
 
BOOLEAN iiDebugMarker =TRUE
 
const short MAX_SHORT = 32767
 

Macro Definition Documentation

#define BREAK_LINE_LENGTH   80

Definition at line 984 of file ipshell.cc.

Enumeration Type Documentation

enum semicState
Enumerator
semicOK 
semicMulNegative 
semicListTooShort 
semicListTooLong 
semicListFirstElementWrongType 
semicListSecondElementWrongType 
semicListThirdElementWrongType 
semicListFourthElementWrongType 
semicListFifthElementWrongType 
semicListSixthElementWrongType 
semicListNNegative 
semicListWrongNumberOfNumerators 
semicListWrongNumberOfDenominators 
semicListWrongNumberOfMultiplicities 
semicListMuNegative 
semicListPgNegative 
semicListNumNegative 
semicListDenNegative 
semicListMulNegative 
semicListNotSymmetric 
semicListNotMonotonous 
semicListMilnorWrong 
semicListPGWrong 

Definition at line 3349 of file ipshell.cc.

3350 {
3351  semicOK,
3353 
3356 
3363 
3368 
3374 
3377 
3380 
3381 } semicState;
semicState
Definition: ipshell.cc:3349
Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3465 of file ipshell.cc.

Function Documentation

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 3275 of file ipshell.cc.

3276 {
3277  spec.mu = (int)(long)(l->m[0].Data( ));
3278  spec.pg = (int)(long)(l->m[1].Data( ));
3279  spec.n = (int)(long)(l->m[2].Data( ));
3280 
3281  spec.copy_new( spec.n );
3282 
3283  intvec *num = (intvec*)l->m[3].Data( );
3284  intvec *den = (intvec*)l->m[4].Data( );
3285  intvec *mul = (intvec*)l->m[5].Data( );
3286 
3287  for( int i=0; i<spec.n; i++ )
3288  {
3289  spec.s[i] = (Rational)((*num)[i])/(Rational)((*den)[i]);
3290  spec.w[i] = (*mul)[i];
3291  }
3292 }
sleftv * m
Definition: lists.h:45
CanonicalForm num(const CanonicalForm &f)
Rational * s
Definition: semic.h:70
int pg
Definition: semic.h:68
Definition: intvec.h:14
int i
Definition: cfEzgcd.cc:123
int n
Definition: semic.h:69
int mu
Definition: semic.h:67
CanonicalForm den(const CanonicalForm &f)
void copy_new(int)
Definition: semic.cc:54
void * Data()
Definition: subexpr.cc:1118
int * w
Definition: semic.h:71
int exprlist_length ( leftv  v)

Definition at line 554 of file ipshell.cc.

555 {
556  int rc = 0;
557  while (v!=NULL)
558  {
559  switch (v->Typ())
560  {
561  case INT_CMD:
562  case POLY_CMD:
563  case VECTOR_CMD:
564  case NUMBER_CMD:
565  rc++;
566  break;
567  case INTVEC_CMD:
568  case INTMAT_CMD:
569  rc += ((intvec *)(v->Data()))->length();
570  break;
571  case MATRIX_CMD:
572  case IDEAL_CMD:
573  case MODUL_CMD:
574  {
575  matrix mm = (matrix)(v->Data());
576  rc += mm->rows() * mm->cols();
577  }
578  break;
579  case LIST_CMD:
580  rc+=((lists)v->Data())->nr+1;
581  break;
582  default:
583  rc++;
584  }
585  v = v->next;
586  }
587  return rc;
588 }
int & rows()
Definition: matpol.h:24
Definition: tok.h:98
int Typ()
Definition: subexpr.cc:976
Definition: intvec.h:14
ip_smatrix * matrix
leftv next
Definition: subexpr.h:87
int & cols()
Definition: matpol.h:25
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
void * Data()
Definition: subexpr.cc:1118
Definition: tok.h:120
lists getList ( spectrum spec)

Definition at line 3311 of file ipshell.cc.

3312 {
3314 
3315  L->Init( 6 );
3316 
3317  intvec *num = new intvec( spec.n );
3318  intvec *den = new intvec( spec.n );
3319  intvec *mult = new intvec( spec.n );
3320 
3321  for( int i=0; i<spec.n; i++ )
3322  {
3323  (*num) [i] = spec.s[i].get_num_si( );
3324  (*den) [i] = spec.s[i].get_den_si( );
3325  (*mult)[i] = spec.w[i];
3326  }
3327 
3328  L->m[0].rtyp = INT_CMD; // milnor number
3329  L->m[1].rtyp = INT_CMD; // geometrical genus
3330  L->m[2].rtyp = INT_CMD; // # of spectrum numbers
3331  L->m[3].rtyp = INTVEC_CMD; // numerators
3332  L->m[4].rtyp = INTVEC_CMD; // denomiantors
3333  L->m[5].rtyp = INTVEC_CMD; // multiplicities
3334 
3335  L->m[0].data = (void*)(long)spec.mu;
3336  L->m[1].data = (void*)(long)spec.pg;
3337  L->m[2].data = (void*)(long)spec.n;
3338  L->m[3].data = (void*)num;
3339  L->m[4].data = (void*)den;
3340  L->m[5].data = (void*)mult;
3341 
3342  return L;
3343 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
sleftv * m
Definition: lists.h:45
Definition: tok.h:98
Definition: lists.h:22
CanonicalForm num(const CanonicalForm &f)
Rational * s
Definition: semic.h:70
int pg
Definition: semic.h:68
int get_den_si()
Definition: GMPrat.cc:159
int get_num_si()
Definition: GMPrat.cc:145
void * data
Definition: subexpr.h:89
Definition: intvec.h:14
int i
Definition: cfEzgcd.cc:123
int n
Definition: semic.h:69
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
int mu
Definition: semic.h:67
void mult(unsigned long *result, unsigned long *a, unsigned long *b, unsigned long p, int dega, int degb)
Definition: minpoly.cc:649
slists * lists
Definition: mpr_numeric.h:146
CanonicalForm den(const CanonicalForm &f)
int rtyp
Definition: subexpr.h:92
int * w
Definition: semic.h:71
omBin slists_bin
Definition: lists.cc:23
BOOLEAN iiApply ( leftv  res,
leftv  a,
int  op,
leftv  proc 
)

Definition at line 6351 of file ipshell.cc.

6352 {
6353  memset(res,0,sizeof(sleftv));
6354  res->rtyp=a->Typ();
6355  switch (res->rtyp /*a->Typ()*/)
6356  {
6357  case INTVEC_CMD:
6358  case INTMAT_CMD:
6359  return iiApplyINTVEC(res,a,op,proc);
6360  case BIGINTMAT_CMD:
6361  return iiApplyBIGINTMAT(res,a,op,proc);
6362  case IDEAL_CMD:
6363  case MODUL_CMD:
6364  case MATRIX_CMD:
6365  return iiApplyIDEAL(res,a,op,proc);
6366  case LIST_CMD:
6367  return iiApplyLIST(res,a,op,proc);
6368  }
6369  WerrorS("first argument to `apply` must allow an index");
6370  return TRUE;
6371 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:976
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6309
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6319
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6314
int rtyp
Definition: subexpr.h:92
Definition: tok.h:120
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6277
BOOLEAN iiApplyBIGINTMAT ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6309 of file ipshell.cc.

6310 {
6311  WerrorS("not implemented");
6312  return TRUE;
6313 }
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
BOOLEAN iiApplyIDEAL ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6314 of file ipshell.cc.

6315 {
6316  WerrorS("not implemented");
6317  return TRUE;
6318 }
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
BOOLEAN iiApplyINTVEC ( leftv  res,
leftv  a,
int  op,
leftv  proc 
)

Definition at line 6277 of file ipshell.cc.

6278 {
6279  intvec *aa=(intvec*)a->Data();
6280  sleftv tmp_out;
6281  sleftv tmp_in;
6282  leftv curr=res;
6283  BOOLEAN bo=FALSE;
6284  for(int i=0;i<aa->length(); i++)
6285  {
6286  memset(&tmp_in,0,sizeof(tmp_in));
6287  tmp_in.rtyp=INT_CMD;
6288  tmp_in.data=(void*)(long)(*aa)[i];
6289  if (proc==NULL)
6290  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6291  else
6292  bo=jjPROC(&tmp_out,proc,&tmp_in);
6293  if (bo)
6294  {
6295  res->CleanUp(currRing);
6296  Werror("apply fails at index %d",i+1);
6297  return TRUE;
6298  }
6299  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6300  else
6301  {
6302  curr->next=(leftv)omAllocBin(sleftv_bin);
6303  curr=curr->next;
6304  memcpy(curr,&tmp_out,sizeof(tmp_out));
6305  }
6306  }
6307  return FALSE;
6308 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:98
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:8414
#define FALSE
Definition: auxiliary.h:140
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1598
#define TRUE
Definition: auxiliary.h:144
int length() const
Definition: intvec.h:86
sleftv * leftv
Definition: structs.h:60
void * data
Definition: subexpr.h:89
poly res
Definition: myNF.cc:322
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
Definition: intvec.h:14
omBin sleftv_bin
Definition: subexpr.cc:50
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:87
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
void * Data()
Definition: subexpr.cc:1118
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
BOOLEAN iiApplyLIST ( leftv  res,
leftv  a,
int  op,
leftv  proc 
)

Definition at line 6319 of file ipshell.cc.

6320 {
6321  lists aa=(lists)a->Data();
6322  sleftv tmp_out;
6323  sleftv tmp_in;
6324  leftv curr=res;
6325  BOOLEAN bo=FALSE;
6326  for(int i=0;i<=aa->nr; i++)
6327  {
6328  memset(&tmp_in,0,sizeof(tmp_in));
6329  tmp_in.Copy(&(aa->m[i]));
6330  if (proc==NULL)
6331  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6332  else
6333  bo=jjPROC(&tmp_out,proc,&tmp_in);
6334  tmp_in.CleanUp();
6335  if (bo)
6336  {
6337  res->CleanUp(currRing);
6338  Werror("apply fails at index %d",i+1);
6339  return TRUE;
6340  }
6341  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6342  else
6343  {
6344  curr->next=(leftv)omAllocBin(sleftv_bin);
6345  curr=curr->next;
6346  memcpy(curr,&tmp_out,sizeof(tmp_out));
6347  }
6348  }
6349  return FALSE;
6350 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: lists.h:22
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:8414
#define FALSE
Definition: auxiliary.h:140
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1598
#define TRUE
Definition: auxiliary.h:144
sleftv * leftv
Definition: structs.h:60
poly res
Definition: myNF.cc:322
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void Copy(leftv e)
Definition: subexpr.cc:657
omBin sleftv_bin
Definition: subexpr.cc:50
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:87
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
void * Data()
Definition: subexpr.cc:1118
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
BOOLEAN iiARROW ( leftv  r,
char *  a,
char *  s 
)

Definition at line 6400 of file ipshell.cc.

6401 {
6402  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6403  // find end of s:
6404  int end_s=strlen(s);
6405  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6406  s[end_s+1]='\0';
6407  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6408  sprintf(name,"%s->%s",a,s);
6409  // find start of last expression
6410  int start_s=end_s-1;
6411  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6412  if (start_s<0) // ';' not found
6413  {
6414  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6415  }
6416  else // s[start_s] is ';'
6417  {
6418  s[start_s]='\0';
6419  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6420  }
6421  memset(r,0,sizeof(*r));
6422  // now produce procinfo for PROC_CMD:
6423  r->data = (void *)omAlloc0Bin(procinfo_bin);
6424  ((procinfo *)(r->data))->language=LANG_NONE;
6425  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6426  ((procinfo *)r->data)->data.s.body=ss;
6427  omFree(name);
6428  r->rtyp=PROC_CMD;
6429  //r->rtyp=STRING_CMD;
6430  //r->data=ss;
6431  return FALSE;
6432 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
const poly a
Definition: syzextra.cc:212
procinfo * iiInitSingularProcinfo(procinfov pi, const char *libname, const char *procname, int line, long pos, BOOLEAN pstatic)
Definition: iplib.cc:968
#define FALSE
Definition: auxiliary.h:140
#define omAlloc(size)
Definition: omAllocDecl.h:210
omBin procinfo_bin
Definition: subexpr.cc:51
void * data
Definition: subexpr.h:89
#define omFree(addr)
Definition: omAllocDecl.h:261
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
char name(const Variable &v)
Definition: variable.h:95
int rtyp
Definition: subexpr.h:92
BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6434 of file ipshell.cc.

6435 {
6436  int t=arg->Typ();
6437  char* ring_name=omStrDup((char*)r->Name());
6438  if ((t==RING_CMD) ||(t==QRING_CMD))
6439  {
6440  sleftv tmp;
6441  memset(&tmp,0,sizeof(tmp));
6442  tmp.rtyp=IDHDL;
6443  tmp.data=(char*)rDefault(ring_name);
6444  if (tmp.data!=NULL)
6445  {
6446  BOOLEAN b=iiAssign(&tmp,arg);
6447  if (b) return TRUE;
6448  rSetHdl(ggetid(ring_name));
6449  omFree(ring_name);
6450  return FALSE;
6451  }
6452  else
6453  return TRUE;
6454  }
6455  #ifdef SINGULAR_4_1
6456  else if (t==CRING_CMD)
6457  {
6458  sleftv tmp;
6459  sleftv n;
6460  memset(&n,0,sizeof(n));
6461  n.name=ring_name;
6462  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6463  if (iiAssign(&tmp,arg)) return TRUE;
6464  //Print("create %s\n",r->Name());
6465  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6466  return FALSE;
6467  }
6468  #endif
6469  //Print("create %s\n",r->Name());
6470  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6471  return TRUE;// not handled -> error for now
6472 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define FALSE
Definition: auxiliary.h:140
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:144
int Typ()
Definition: subexpr.cc:976
const char * Name()
Definition: subexpr.h:121
#define IDHDL
Definition: tok.h:35
idhdl rDefault(const char *s)
Definition: ipshell.cc:1532
void * data
Definition: subexpr.h:89
int myynest
Definition: febase.cc:46
Definition: tok.h:59
const char * name
Definition: subexpr.h:88
#define omFree(addr)
Definition: omAllocDecl.h:261
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition: ipshell.cc:1123
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
Definition: tok.h:159
void rSetHdl(idhdl h)
Definition: ipshell.cc:5030
int BOOLEAN
Definition: auxiliary.h:131
const poly b
Definition: syzextra.cc:213
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:490
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1783
#define omStrDup(s)
Definition: omAllocDecl.h:263
BOOLEAN iiBranchTo ( leftv  ,
leftv  args 
)

Definition at line 1178 of file ipshell.cc.

1179 {
1180  // <string1...stringN>,<proc>
1181  // known: args!=NULL, l>=1
1182  int l=args->listLength();
1183  int ll=0;
1184  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1185  if (ll!=(l-1)) return FALSE;
1186  leftv h=args;
1187  short *t=(short*)omAlloc(l*sizeof(short));
1188  t[0]=l-1;
1189  int b;
1190  int i;
1191  for(i=1;i<l;i++,h=h->next)
1192  {
1193  if (h->Typ()!=STRING_CMD)
1194  {
1195  omFree(t);
1196  Werror("arg %d is not a string",i);
1197  return TRUE;
1198  }
1199  int tt;
1200  b=IsCmd((char *)h->Data(),tt);
1201  if(b) t[i]=tt;
1202  else
1203  {
1204  omFree(t);
1205  Werror("arg %d is not a type name",i);
1206  return TRUE;
1207  }
1208  }
1209  if (h->Typ()!=PROC_CMD)
1210  {
1211  omFree(t);
1212  Werror("last arg (%d) is not a proc",i);
1213  return TRUE;
1214  }
1215  b=iiCheckTypes(iiCurrArgs,t,0);
1216  omFree(t);
1217  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1218  {
1219  BOOLEAN err;
1220  //Print("branchTo: %s\n",h->Name());
1221  iiCurrProc=(idhdl)h->data;
1223  if( pi->data.s.body==NULL )
1224  {
1226  if (pi->data.s.body==NULL) return TRUE;
1227  }
1228  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1229  {
1230  currPack=pi->pack;
1233  //Print("set pack=%s\n",IDID(currPackHdl));
1234  }
1235  err=iiAllStart(pi,pi->data.s.body,BT_proc,pi->data.s.body_lineno-(iiCurrArgs==NULL));
1237  if (iiCurrArgs!=NULL)
1238  {
1239  if (!err) Warn("too many arguments for %s",IDID(iiCurrProc));
1240  iiCurrArgs->CleanUp();
1242  iiCurrArgs=NULL;
1243  }
1244  return 2-err;
1245  }
1246  return FALSE;
1247 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
idhdl currPackHdl
Definition: ipid.cc:61
#define IDID(a)
Definition: ipid.h:121
#define FALSE
Definition: auxiliary.h:140
int listLength()
Definition: subexpr.cc:61
#define TRUE
Definition: auxiliary.h:144
void * ADDRESS
Definition: auxiliary.h:161
#define omAlloc(size)
Definition: omAllocDecl.h:210
BOOLEAN exitBuffer(feBufferTypes typ)
Definition: fevoices.cc:241
#define IDHDL
Definition: tok.h:35
idhdl iiCurrProc
Definition: ipshell.cc:80
#define omFree(addr)
Definition: omAllocDecl.h:261
idrec * idhdl
Definition: ring.h:18
omBin sleftv_bin
Definition: subexpr.cc:50
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:87
BOOLEAN iiAllStart(procinfov pi, char *p, feBufferTypes t, int l)
Definition: iplib.cc:312
#define IDPROC(a)
Definition: ipid.h:139
#define pi
Definition: libparse.cc:1143
#define NULL
Definition: omList.c:10
BOOLEAN iiCheckTypes(leftv args, const short *type_list, int report)
check a list of arguemys against a given field of types return TRUE if the types match return FALSE (...
Definition: ipshell.cc:6492
package currPack
Definition: ipid.cc:63
leftv iiCurrArgs
Definition: ipshell.cc:79
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
idhdl packFindHdl(package r)
Definition: ipid.cc:732
void iiCheckPack(package &p)
Definition: ipshell.cc:1516
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:211
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
const poly b
Definition: syzextra.cc:213
void Werror(const char *fmt,...)
Definition: reporter.cc:199
int l
Definition: cfEzgcd.cc:94
utypes data
Definition: idrec.h:40
int IsCmd(const char *n, int &tok)
Definition: iparith.cc:8822
#define Warn
Definition: emacs.cc:80
void iiCheckPack ( package p)

Definition at line 1516 of file ipshell.cc.

1517 {
1518  if (p==basePack) return;
1519 
1520  idhdl t=basePack->idroot;
1521 
1522  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1523 
1524  if (t==NULL)
1525  {
1526  WarnS("package not found\n");
1527  p=basePack;
1528  }
1529  return;
1530 }
return P p
Definition: myNF.cc:203
#define WarnS
Definition: emacs.cc:81
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:138
#define IDTYP(a)
Definition: ipid.h:118
idhdl next
Definition: idrec.h:38
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
BOOLEAN iiCheckRing ( int  i)

Definition at line 1472 of file ipshell.cc.

1473 {
1474  if (currRing==NULL)
1475  {
1476  #ifdef SIQ
1477  if (siq<=0)
1478  {
1479  #endif
1480  if (RingDependend(i))
1481  {
1482  WerrorS("no ring active");
1483  return TRUE;
1484  }
1485  #ifdef SIQ
1486  }
1487  #endif
1488  }
1489  return FALSE;
1490 }
#define FALSE
Definition: auxiliary.h:140
BOOLEAN siq
Definition: subexpr.cc:58
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
int RingDependend(int t)
Definition: gentable.cc:23
int i
Definition: cfEzgcd.cc:123
#define NULL
Definition: omList.c:10
BOOLEAN iiCheckTypes ( leftv  args,
const short *  type_list,
int  report 
)

check a list of arguemys against a given field of types return TRUE if the types match return FALSE (and, if report) report an error via Werror otherwise

Parameters
type_list< [in] argument list (may be NULL) [in] field of types len, t1,t2,...
report;in] report error?

Definition at line 6492 of file ipshell.cc.

6493 {
6494  if (args==NULL)
6495  {
6496  if (type_list[0]==0) return TRUE;
6497  else
6498  {
6499  if (report) WerrorS("no arguments expected");
6500  return FALSE;
6501  }
6502  }
6503  int l=args->listLength();
6504  if (l!=(int)type_list[0])
6505  {
6506  if (report) iiReportTypes(0,l,type_list);
6507  return FALSE;
6508  }
6509  for(int i=1;i<=l;i++,args=args->next)
6510  {
6511  short t=type_list[i];
6512  if (t!=ANY_TYPE)
6513  {
6514  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6515  || (t!=args->Typ()))
6516  {
6517  if (report) iiReportTypes(i,args->Typ(),type_list);
6518  return FALSE;
6519  }
6520  }
6521  }
6522  return TRUE;
6523 }
#define ANY_TYPE
Definition: tok.h:34
#define FALSE
Definition: auxiliary.h:140
int listLength()
Definition: subexpr.cc:61
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define IDHDL
Definition: tok.h:35
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6474
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:87
#define NULL
Definition: omList.c:10
int l
Definition: cfEzgcd.cc:94
static resolvente iiCopyRes ( resolvente  r,
int  l 
)
static

Definition at line 865 of file ipshell.cc.

866 {
867  int i;
868  resolvente res=(ideal *)omAlloc0((l+1)*sizeof(ideal));
869 
870  for (i=0; i<l; i++)
871  if (r[i]!=NULL) res[i]=idCopy(r[i]);
872  return res;
873 }
poly res
Definition: myNF.cc:322
const ring r
Definition: syzextra.cc:208
int i
Definition: cfEzgcd.cc:123
ideal idCopy(ideal A)
Definition: ideals.h:73
#define NULL
Definition: omList.c:10
ideal * resolvente
Definition: ideals.h:20
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:94
void iiDebug ( )

Definition at line 985 of file ipshell.cc.

986 {
987 #ifdef HAVE_SDB
988  sdb_flags=1;
989 #endif
990  Print("\n-- break point in %s --\n",VoiceName());
992  char * s;
994  s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
995  loop
996  {
997  memset(s,0,80);
999  if (s[BREAK_LINE_LENGTH-1]!='\0')
1000  {
1001  Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
1002  }
1003  else
1004  break;
1005  }
1006  if (*s=='\n')
1007  {
1009  }
1010 #if MDEBUG
1011  else if(strncmp(s,"cont;",5)==0)
1012  {
1014  }
1015 #endif /* MDEBUG */
1016  else
1017  {
1018  strcat( s, "\n;~\n");
1019  newBuffer(s,BT_execute);
1020  }
1021 }
void VoiceBackTrack()
Definition: fevoices.cc:77
const CanonicalForm int s
Definition: facAbsFact.cc:55
char *(* fe_fgets_stdin)(const char *pr, char *s, int size)
Definition: feread.cc:33
int sdb_flags
Definition: sdb.cc:32
#define Print
Definition: emacs.cc:83
loop
Definition: myNF.cc:98
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
#define omAlloc(size)
Definition: omAllocDecl.h:210
BOOLEAN iiDebugMarker
Definition: ipshell.cc:983
const char * VoiceName()
Definition: fevoices.cc:66
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:984
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:171
int iiDeclCommand ( leftv  sy,
leftv  name,
int  lev,
int  t,
idhdl root,
BOOLEAN  isring,
BOOLEAN  init_b 
)

Definition at line 1123 of file ipshell.cc.

1124 {
1125  BOOLEAN res=FALSE;
1126  const char *id = name->name;
1127 
1128  memset(sy,0,sizeof(sleftv));
1129  if ((name->name==NULL)||(isdigit(name->name[0])))
1130  {
1131  WerrorS("object to declare is not a name");
1132  res=TRUE;
1133  }
1134  else
1135  {
1136  if (TEST_V_ALLWARN
1137  && (name->rtyp!=0)
1138  && (name->rtyp!=IDHDL)
1139  && (currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1140  {
1141  Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1143  }
1144  {
1145  sy->data = (char *)enterid(id,lev,t,root,init_b);
1146  }
1147  if (sy->data!=NULL)
1148  {
1149  sy->rtyp=IDHDL;
1150  currid=sy->name=IDID((idhdl)sy->data);
1151  // name->name=NULL; /* used in enterid */
1152  //sy->e = NULL;
1153  if (name->next!=NULL)
1154  {
1156  res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1157  }
1158  }
1159  else res=TRUE;
1160  }
1161  name->CleanUp();
1162  return res;
1163 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
int yylineno
Definition: febase.cc:45
#define IDID(a)
Definition: ipid.h:121
#define FALSE
Definition: auxiliary.h:140
char * filename
Definition: fevoices.h:62
#define TRUE
Definition: auxiliary.h:144
sleftv * leftv
Definition: structs.h:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:35
const char * currid
Definition: grammar.cc:172
void * data
Definition: subexpr.h:89
poly res
Definition: myNF.cc:322
int myynest
Definition: febase.cc:46
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:259
char my_yylinebuf[80]
Definition: febase.cc:48
const char * name
Definition: subexpr.h:88
idhdl currRingHdl
Definition: ipid.cc:65
omBin sleftv_bin
Definition: subexpr.cc:50
#define IDLEV(a)
Definition: ipid.h:120
leftv next
Definition: subexpr.h:87
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition: ipshell.cc:1123
#define NULL
Definition: omList.c:10
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:128
Voice * currentVoice
Definition: fevoices.cc:57
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
int BOOLEAN
Definition: auxiliary.h:131
#define TEST_V_ALLWARN
Definition: options.h:135
#define Warn
Definition: emacs.cc:80
BOOLEAN iiDefaultParameter ( leftv  p)

Definition at line 1165 of file ipshell.cc.

1166 {
1167  attr at=NULL;
1168  if (iiCurrProc!=NULL)
1169  at=iiCurrProc->attribute->get("default_arg");
1170  if (at==NULL)
1171  return FALSE;
1172  sleftv tmp;
1173  memset(&tmp,0,sizeof(sleftv));
1174  tmp.rtyp=at->atyp;
1175  tmp.data=at->CopyA();
1176  return iiAssign(p,&tmp);
1177 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: attrib.h:15
#define FALSE
Definition: auxiliary.h:140
idhdl iiCurrProc
Definition: ipshell.cc:80
void * data
Definition: subexpr.h:89
void * CopyA()
Definition: subexpr.cc:1938
#define NULL
Definition: omList.c:10
attr attribute
Definition: idrec.h:41
int rtyp
Definition: subexpr.h:92
attr get(const char *s)
Definition: attrib.cc:96
int atyp
Definition: attrib.h:22
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1783
BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1392 of file ipshell.cc.

1393 {
1394  BOOLEAN nok=FALSE;
1395  leftv r=v;
1396  while (v!=NULL)
1397  {
1398  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1399  {
1400  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1401  nok=TRUE;
1402  }
1403  else
1404  {
1405  if(iiInternalExport(v, toLev))
1406  {
1407  r->CleanUp();
1408  return TRUE;
1409  }
1410  }
1411  v=v->next;
1412  }
1413  r->CleanUp();
1414  return nok;
1415 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Subexpr e
Definition: subexpr.h:106
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
const ring r
Definition: syzextra.cc:208
const char * name
Definition: subexpr.h:88
leftv next
Definition: subexpr.h:87
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1284
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
BOOLEAN iiExport ( leftv  v,
int  toLev,
package  pack 
)

Definition at line 1418 of file ipshell.cc.

1419 {
1420 #ifdef SINGULAR_4_1
1421  if ((pack==basePack)&&(pack!=currPack))
1422  { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
1423 #endif
1424  BOOLEAN nok=FALSE;
1425  leftv rv=v;
1426  while (v!=NULL)
1427  {
1428  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
1429  )
1430  {
1431  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1432  nok=TRUE;
1433  }
1434  else
1435  {
1436  idhdl old=pack->idroot->get( v->name,toLev);
1437  if (old!=NULL)
1438  {
1439  if ((pack==currPack) && (old==(idhdl)v->data))
1440  {
1441  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
1442  break;
1443  }
1444  else if (IDTYP(old)==v->Typ())
1445  {
1446  if (BVERBOSE(V_REDEFINE))
1447  {
1448  Warn("redefining %s",IDID(old));
1449  }
1450  v->name=omStrDup(v->name);
1451  killhdl2(old,&(pack->idroot),currRing);
1452  }
1453  else
1454  {
1455  rv->CleanUp();
1456  return TRUE;
1457  }
1458  }
1459  //Print("iiExport: pack=%s\n",IDID(root));
1460  if(iiInternalExport(v, toLev, pack))
1461  {
1462  rv->CleanUp();
1463  return TRUE;
1464  }
1465  }
1466  v=v->next;
1467  }
1468  rv->CleanUp();
1469  return nok;
1470 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Subexpr e
Definition: subexpr.h:106
#define IDID(a)
Definition: ipid.h:121
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
int Typ()
Definition: subexpr.cc:976
Definition: idrec.h:34
idhdl get(const char *s, int lev)
Definition: ipid.cc:91
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define IDTYP(a)
Definition: ipid.h:118
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:403
char my_yylinebuf[80]
Definition: febase.cc:48
const char * name
Definition: subexpr.h:88
leftv next
Definition: subexpr.h:87
#define BVERBOSE(a)
Definition: options.h:33
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1284
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
package currPack
Definition: ipid.cc:63
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
int BOOLEAN
Definition: auxiliary.h:131
#define V_REDEFINE
Definition: options.h:43
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263
poly iiHighCorner ( ideal  I,
int  ak 
)

Definition at line 1492 of file ipshell.cc.

1493 {
1494  int i;
1495  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1496  poly po=NULL;
1498  {
1499  scComputeHC(I,currRing->qideal,ak,po);
1500  if (po!=NULL)
1501  {
1502  pGetCoeff(po)=nInit(1);
1503  for (i=rVar(currRing); i>0; i--)
1504  {
1505  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1506  }
1507  pSetComp(po,ak);
1508  pSetm(po);
1509  }
1510  }
1511  else
1512  po=pOne();
1513  return po;
1514 }
#define pSetm(p)
Definition: polys.h:241
#define pDecrExp(p, i)
Definition: polys.h:44
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:537
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge, ring tailRing)
Definition: hdegree.cc:1005
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy ...
Definition: monomials.h:51
static BOOLEAN idIsZeroDim(ideal i)
Definition: ideals.h:173
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
#define pSetComp(p, v)
Definition: polys.h:38
int i
Definition: cfEzgcd.cc:123
#define pOne()
Definition: polys.h:286
#define rHasLocalOrMixedOrdering_currRing()
Definition: ring.h:757
#define NULL
Definition: omList.c:10
strat ak
Definition: myNF.cc:321
polyrec * poly
Definition: hilb.h:10
#define nInit(i)
Definition: numbers.h:24
static BOOLEAN iiInternalExport ( leftv  v,
int  toLev 
)
static

Definition at line 1284 of file ipshell.cc.

1285 {
1286  idhdl h=(idhdl)v->data;
1287  //Print("iiInternalExport('%s',%d)%s\n", v->name, toLev,"");
1288  if (IDLEV(h)==0)
1289  {
1290  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(h));
1291  }
1292  else
1293  {
1294  h=IDROOT->get(v->name,toLev);
1295  idhdl *root=&IDROOT;
1296  if ((h==NULL)&&(currRing!=NULL))
1297  {
1298  h=currRing->idroot->get(v->name,toLev);
1299  root=&currRing->idroot;
1300  }
1301  BOOLEAN keepring=FALSE;
1302  if ((h!=NULL)&&(IDLEV(h)==toLev))
1303  {
1304  if (IDTYP(h)==v->Typ())
1305  {
1306  if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
1307  && (v->Data()==IDDATA(h)))
1308  {
1309  IDRING(h)->ref++;
1310  keepring=TRUE;
1311  IDLEV(h)=toLev;
1312  //WarnS("keepring");
1313  return FALSE;
1314  }
1315  if (BVERBOSE(V_REDEFINE))
1316  {
1317  Warn("redefining %s",IDID(h));
1318  }
1319 #ifdef USE_IILOCALRING
1320  if (iiLocalRing[0]==IDRING(h) && (!keepring)) iiLocalRing[0]=NULL;
1321 #else
1323  while (p->next!=NULL) p=p->next;
1324  if ((p->cRing==IDRING(h)) && (!keepring))
1325  {
1326  p->cRing=NULL;
1327  p->cRingHdl=NULL;
1328  }
1329 #endif
1330  killhdl2(h,root,currRing);
1331  }
1332  else
1333  {
1334  return TRUE;
1335  }
1336  }
1337  h=(idhdl)v->data;
1338  IDLEV(h)=toLev;
1339  if (keepring) IDRING(h)->ref--;
1341  //Print("export %s\n",IDID(h));
1342  }
1343  return FALSE;
1344 }
if(0 > strat->sl)
Definition: myNF.cc:73
#define IDID(a)
Definition: ipid.h:121
#define FALSE
Definition: auxiliary.h:140
return P p
Definition: myNF.cc:203
proclevel * procstack
Definition: ipid.cc:58
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:144
int Typ()
Definition: subexpr.cc:976
idhdl cRingHdl
Definition: ipid.h:60
Definition: idrec.h:34
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define IDTYP(a)
Definition: ipid.h:118
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:403
Definition: ipid.h:56
const char * name
Definition: subexpr.h:88
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:83
proclevel * next
Definition: ipid.h:59
idrec * idhdl
Definition: ring.h:18
#define IDLEV(a)
Definition: ipid.h:120
#define BVERBOSE(a)
Definition: options.h:33
ring * iiLocalRing
Definition: iplib.cc:515
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:126
ring cRing
Definition: ipid.h:61
void * Data()
Definition: subexpr.cc:1118
Definition: tok.h:159
#define IDDATA(a)
Definition: ipid.h:125
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
#define V_REDEFINE
Definition: options.h:43
#define Warn
Definition: emacs.cc:80
BOOLEAN iiInternalExport ( leftv  v,
int  toLev,
package  rootpack 
)

Definition at line 1346 of file ipshell.cc.

1347 {
1348  idhdl h=(idhdl)v->data;
1349  if(h==NULL)
1350  {
1351  Warn("'%s': no such identifier\n", v->name);
1352  return FALSE;
1353  }
1354  package frompack=v->req_packhdl;
1355  if (frompack==NULL) frompack=currPack;
1356  if ((RingDependend(IDTYP(h)))
1357  || ((IDTYP(h)==LIST_CMD)
1358  && (lRingDependend(IDLIST(h)))
1359  )
1360  )
1361  {
1362  //Print("// ==> Ringdependent set nesting to 0\n");
1363  return (iiInternalExport(v, toLev));
1364  }
1365  else
1366  {
1367  IDLEV(h)=toLev;
1368  v->req_packhdl=rootpack;
1369  if (h==frompack->idroot)
1370  {
1371  frompack->idroot=h->next;
1372  }
1373  else
1374  {
1375  idhdl hh=frompack->idroot;
1376  while ((hh!=NULL) && (hh->next!=h))
1377  hh=hh->next;
1378  if ((hh!=NULL) && (hh->next==h))
1379  hh->next=h->next;
1380  else
1381  {
1382  Werror("`%s` not found",v->Name());
1383  return TRUE;
1384  }
1385  }
1386  h->next=rootpack->idroot;
1387  rootpack->idroot=h;
1388  }
1389  return FALSE;
1390 }
#define IDLIST(a)
Definition: ipid.h:136
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
const char * Name()
Definition: subexpr.h:121
Definition: idrec.h:34
void * data
Definition: subexpr.h:89
#define IDTYP(a)
Definition: ipid.h:118
int RingDependend(int t)
Definition: gentable.cc:23
const char * name
Definition: subexpr.h:88
idrec * idhdl
Definition: ring.h:18
idhdl next
Definition: idrec.h:38
#define IDLEV(a)
Definition: ipid.h:120
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1284
#define NULL
Definition: omList.c:10
package req_packhdl
Definition: subexpr.h:107
package currPack
Definition: ipid.cc:63
Definition: tok.h:120
static Poly * h
Definition: janet.cc:978
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:199
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define Warn
Definition: emacs.cc:80
void iiMakeResolv ( resolvente  r,
int  length,
int  rlen,
char *  name,
int  typ0,
intvec **  weights 
)

Definition at line 776 of file ipshell.cc.

778 {
779  lists L=liMakeResolv(r,length,rlen,typ0,weights);
780  int i=0;
781  idhdl h;
782  char * s=(char *)omAlloc(strlen(name)+5);
783 
784  while (i<=L->nr)
785  {
786  sprintf(s,"%s(%d)",name,i+1);
787  if (i==0)
788  h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
789  else
790  h=enterid(s,myynest,MODUL_CMD,&(currRing->idroot), FALSE);
791  if (h!=NULL)
792  {
793  h->data.uideal=(ideal)L->m[i].data;
794  h->attribute=L->m[i].attribute;
796  Print("//defining: %s as %d-th syzygy module\n",s,i+1);
797  }
798  else
799  {
800  idDelete((ideal *)&(L->m[i].data));
801  Warn("cannot define %s",s);
802  }
803  //L->m[i].data=NULL;
804  //L->m[i].rtyp=0;
805  //L->m[i].attribute=NULL;
806  i++;
807  }
808  omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
810  omFreeSize((ADDRESS)s,strlen(name)+5);
811 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define Print
Definition: emacs.cc:83
#define idDelete(H)
delete an ideal
Definition: ideals.h:31
Definition: lists.h:22
if(0 > strat->sl)
Definition: myNF.cc:73
#define FALSE
Definition: auxiliary.h:140
#define V_DEF_RES
Definition: options.h:48
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:161
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: idrec.h:34
void * data
Definition: subexpr.h:89
int myynest
Definition: febase.cc:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:259
const ring r
Definition: syzextra.cc:208
int i
Definition: cfEzgcd.cc:123
#define BVERBOSE(a)
Definition: options.h:33
int nr
Definition: lists.h:43
char name(const Variable &v)
Definition: variable.h:95
#define NULL
Definition: omList.c:10
attr attribute
Definition: idrec.h:41
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:216
attr attribute
Definition: subexpr.h:90
omBin slists_bin
Definition: lists.cc:23
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
static Poly * h
Definition: janet.cc:978
utypes data
Definition: idrec.h:40
#define Warn
Definition: emacs.cc:80
leftv iiMap ( map  theMap,
const char *  what 
)

Definition at line 617 of file ipshell.cc.

618 {
619  idhdl w,r;
620  leftv v;
621  int i;
622  nMapFunc nMap;
623 
624  r=IDROOT->get(theMap->preimage,myynest);
625  if ((currPack!=basePack)
626  &&((r==NULL) || ((r->typ != RING_CMD) && (r->typ != QRING_CMD))))
627  r=basePack->idroot->get(theMap->preimage,myynest);
628  if ((r==NULL) && (currRingHdl!=NULL)
629  && (strcmp(theMap->preimage,IDID(currRingHdl))==0))
630  {
631  r=currRingHdl;
632  }
633  if ((r!=NULL) && ((r->typ == RING_CMD) || (r->typ== QRING_CMD)))
634  {
635  ring src_ring=IDRING(r);
636  if ((nMap=n_SetMap(src_ring->cf, currRing->cf))==NULL)
637  {
638  Werror("can not map from ground field of %s to current ground field",
639  theMap->preimage);
640  return NULL;
641  }
642  if (IDELEMS(theMap)<src_ring->N)
643  {
644  theMap->m=(polyset)omReallocSize((ADDRESS)theMap->m,
645  IDELEMS(theMap)*sizeof(poly),
646  (src_ring->N)*sizeof(poly));
647  for(i=IDELEMS(theMap);i<src_ring->N;i++)
648  theMap->m[i]=NULL;
649  IDELEMS(theMap)=src_ring->N;
650  }
651  if (what==NULL)
652  {
653  WerrorS("argument of a map must have a name");
654  }
655  else if ((w=src_ring->idroot->get(what,myynest))!=NULL)
656  {
657  char *save_r=NULL;
659  sleftv tmpW;
660  memset(&tmpW,0,sizeof(sleftv));
661  tmpW.rtyp=IDTYP(w);
662  if (tmpW.rtyp==MAP_CMD)
663  {
664  tmpW.rtyp=IDEAL_CMD;
665  save_r=IDMAP(w)->preimage;
666  IDMAP(w)->preimage=0;
667  }
668  tmpW.data=IDDATA(w);
669  // check overflow
670  BOOLEAN overflow=FALSE;
671  if ((tmpW.rtyp==IDEAL_CMD)
672  || (tmpW.rtyp==MODUL_CMD)
673  || (tmpW.rtyp==MAP_CMD))
674  {
675  ideal id=(ideal)tmpW.data;
676  long *degs=(long*)omAlloc(IDELEMS(id)*sizeof(long));
677  for(int i=IDELEMS(id)-1;i>=0;i--)
678  {
679  poly p=id->m[i];
680  if (p!=NULL) degs[i]=p_Totaldegree(p,src_ring);
681  else degs[i]=0;
682  }
683  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
684  {
685  if (theMap->m[j]!=NULL)
686  {
687  long deg_monexp=pTotaldegree(theMap->m[j]);
688 
689  for(int i=IDELEMS(id)-1;i>=0;i--)
690  {
691  poly p=id->m[i];
692  if ((p!=NULL) && (degs[i]!=0) &&
693  ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)degs[i])/2)))
694  {
695  overflow=TRUE;
696  break;
697  }
698  }
699  }
700  }
701  omFreeSize(degs,IDELEMS(id)*sizeof(long));
702  }
703  else if (tmpW.rtyp==POLY_CMD)
704  {
705  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
706  {
707  if (theMap->m[j]!=NULL)
708  {
709  long deg_monexp=pTotaldegree(theMap->m[j]);
710  poly p=(poly)tmpW.data;
711  long deg=0;
712  if ((p!=NULL) && ((deg=p_Totaldegree(p,src_ring))!=0) &&
713  ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)deg)/2)))
714  {
715  overflow=TRUE;
716  break;
717  }
718  }
719  }
720  }
721  if (overflow)
722  Warn("possible OVERFLOW in map, max exponent is %ld",currRing->bitmask/2);
723 #if 0
724  if (((tmpW.rtyp==IDEAL_CMD)||(tmpW.rtyp==MODUL_CMD)) && idIs0(IDIDEAL(w)))
725  {
726  v->rtyp=tmpW.rtyp;
727  v->data=idInit(IDELEMS(IDIDEAL(w)),IDIDEAL(w)->rank);
728  }
729  else
730 #endif
731  {
732  if ((tmpW.rtyp==IDEAL_CMD)
733  ||(tmpW.rtyp==MODUL_CMD)
734  ||(tmpW.rtyp==MATRIX_CMD)
735  ||(tmpW.rtyp==MAP_CMD))
736  {
737  v->rtyp=tmpW.rtyp;
738  char *tmp = theMap->preimage;
739  theMap->preimage=(char*)1L;
740  // map gets 1 as its rank (as an ideal)
741  v->data=maMapIdeal(IDIDEAL(w), src_ring, (ideal)theMap, currRing,nMap);
742  theMap->preimage=tmp; // map gets its preimage back
743  }
744  if (v->data==NULL) /*i.e. not IDEAL_CMD/MODUL_CMD/MATRIX_CMD/MAP */
745  {
746  if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,src_ring,NULL,NULL,0,nMap))
747  {
748  Werror("cannot map %s(%d)",Tok2Cmdname(w->typ),w->typ);
750  if (save_r!=NULL) IDMAP(w)->preimage=save_r;
751  return NULL;
752  }
753  }
754  }
755  if (save_r!=NULL)
756  {
757  IDMAP(w)->preimage=save_r;
758  IDMAP((idhdl)v)->preimage=omStrDup(save_r);
759  v->rtyp=MAP_CMD;
760  }
761  return v;
762  }
763  else
764  {
765  Werror("%s undefined in %s",what,theMap->preimage);
766  }
767  }
768  else
769  {
770  Werror("cannot find preimage %s",theMap->preimage);
771  }
772  return NULL;
773 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
if(0 > strat->sl)
Definition: myNF.cc:73
#define IDID(a)
Definition: ipid.h:121
#define FALSE
Definition: auxiliary.h:140
return P p
Definition: myNF.cc:203
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:144
BOOLEAN maApplyFetch(int what, map theMap, leftv res, leftv w, ring preimage_r, int *perm, int *par_perm, int P, nMapFunc nMap)
Definition: maps_ip.cc:49
#define IDIDEAL(a)
Definition: ipid.h:132
static long p_Totaldegree(poly p, const ring r)
Definition: p_polys.h:1436
void * ADDRESS
Definition: auxiliary.h:161
sleftv * leftv
Definition: structs.h:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: idrec.h:34
idhdl get(const char *s, int lev)
Definition: ipid.cc:91
void * data
Definition: subexpr.h:89
int myynest
Definition: febase.cc:46
#define omReallocSize(addr, o_size, size)
Definition: omAllocDecl.h:220
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define IDTYP(a)
Definition: ipid.h:118
const ring r
Definition: syzextra.cc:208
ideal maMapIdeal(const ideal map_id, const ring preimage_r, const ideal image_id, const ring image_r, const nMapFunc nMap)
polynomial map for ideals/module/matrix map_id: the ideal to map map_r: the base ring for map_id imag...
Definition: gen_maps.cc:88
int j
Definition: myNF.cc:70
static long pTotaldegree(poly p)
Definition: polys.h:253
number(* nMapFunc)(number a, const coeffs src, const coeffs dst)
maps "a", which lives in src, into dst
Definition: coeffs.h:72
idhdl currRingHdl
Definition: ipid.cc:65
omBin sleftv_bin
Definition: subexpr.cc:50
int i
Definition: cfEzgcd.cc:123
#define IDELEMS(i)
Definition: simpleideals.h:24
static FORCE_INLINE nMapFunc n_SetMap(const coeffs src, const coeffs dst)
set the mapping function pointers for translating numbers from src to dst
Definition: coeffs.h:722
#define IDMAP(a)
Definition: ipid.h:134
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
poly * polyset
Definition: hutil.h:15
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:128
package basePack
Definition: ipid.cc:64
#define IDRING(a)
Definition: ipid.h:126
const CanonicalForm & w
Definition: facAbsFact.cc:55
package currPack
Definition: ipid.cc:63
int rtyp
Definition: subexpr.h:92
int typ
Definition: idrec.h:43
Definition: tok.h:159
polyrec * poly
Definition: hilb.h:10
#define IDDATA(a)
Definition: ipid.h:125
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
int BOOLEAN
Definition: auxiliary.h:131
BOOLEAN idIs0(ideal h)
returns true if h is the zero ideal
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263
int iiOpsTwoChar ( const char *  s)

Definition at line 120 of file ipshell.cc.

121 {
122 /* not handling: &&, ||, ** */
123  if (s[1]=='\0') return s[0];
124  else if (s[2]!='\0') return 0;
125  switch(s[0])
126  {
127  case '.': if (s[1]=='.') return DOTDOT;
128  else return 0;
129  case ':': if (s[1]==':') return COLONCOLON;
130  else return 0;
131  case '-': if (s[1]=='-') return MINUSMINUS;
132  else return 0;
133  case '+': if (s[1]=='+') return PLUSPLUS;
134  else return 0;
135  case '=': if (s[1]=='=') return EQUAL_EQUAL;
136  else return 0;
137  case '<': if (s[1]=='=') return LE;
138  else if (s[1]=='>') return NOTEQUAL;
139  else return 0;
140  case '>': if (s[1]=='=') return GE;
141  else return 0;
142  case '!': if (s[1]=='=') return NOTEQUAL;
143  else return 0;
144  }
145  return 0;
146 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Definition: grammar.cc:271
Definition: grammar.cc:270
BOOLEAN iiParameter ( leftv  p)

Definition at line 1248 of file ipshell.cc.

1249 {
1250  if (iiCurrArgs==NULL)
1251  {
1252  if (strcmp(p->name,"#")==0)
1253  return iiDefaultParameter(p);
1254  Werror("not enough arguments for proc %s",VoiceName());
1255  p->CleanUp();
1256  return TRUE;
1257  }
1258  leftv h=iiCurrArgs;
1259  leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1260  BOOLEAN is_default_list=FALSE;
1261  if (strcmp(p->name,"#")==0)
1262  {
1263  is_default_list=TRUE;
1264  rest=NULL;
1265  }
1266  else
1267  {
1268  h->next=NULL;
1269  }
1270  BOOLEAN res=iiAssign(p,h);
1271  if (is_default_list)
1272  {
1273  iiCurrArgs=NULL;
1274  }
1275  else
1276  {
1277  iiCurrArgs=rest;
1278  }
1279  h->CleanUp();
1281  return res;
1282 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
void * ADDRESS
Definition: auxiliary.h:161
poly res
Definition: myNF.cc:322
const char * name
Definition: subexpr.h:88
omBin sleftv_bin
Definition: subexpr.cc:50
const char * VoiceName()
Definition: fevoices.cc:66
leftv next
Definition: subexpr.h:87
#define NULL
Definition: omList.c:10
BOOLEAN iiDefaultParameter(leftv p)
Definition: ipshell.cc:1165
leftv iiCurrArgs
Definition: ipshell.cc:79
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1783
int iiRegularity ( lists  L)

Definition at line 957 of file ipshell.cc.

958 {
959  int len,reg,typ0;
960 
961  resolvente r=liFindRes(L,&len,&typ0);
962 
963  if (r==NULL)
964  return -2;
965  intvec *weights=NULL;
966  int add_row_shift=0;
967  intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
968  if (ww!=NULL)
969  {
970  weights=ivCopy(ww);
971  add_row_shift = ww->min_in();
972  (*weights) -= add_row_shift;
973  }
974  //Print("attr:%x\n",weights);
975 
976  intvec *dummy=syBetti(r,len,&reg,weights);
977  if (weights!=NULL) delete weights;
978  delete dummy;
979  omFreeSize((ADDRESS)r,len*sizeof(ideal));
980  return reg+1+add_row_shift;
981 }
sleftv * m
Definition: lists.h:45
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:313
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * ivCopy(const intvec *o)
Definition: intvec.h:126
void * ADDRESS
Definition: auxiliary.h:161
int min_in()
Definition: intvec.h:113
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:135
#define NULL
Definition: omList.c:10
ideal * resolvente
Definition: ideals.h:20
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:793
static void iiReportTypes ( int  nr,
int  t,
const short *  T 
)
static

Definition at line 6474 of file ipshell.cc.

6475 {
6476  char *buf=(char*)omAlloc(250);
6477  buf[0]='\0';
6478  if (nr==0)
6479  sprintf(buf,"wrong length of parameters(%d), expected ",t);
6480  else
6481  sprintf(buf,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
6482  for(int i=1;i<=T[0];i++)
6483  {
6484  strcat(buf,"`");
6485  strcat(buf,Tok2Cmdname(T[i]));
6486  strcat(buf,"`");
6487  if (i<T[0]) strcat(buf,",");
6488  }
6489  WerrorS(buf);
6490 }
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define omAlloc(size)
Definition: omAllocDecl.h:210
int status int void * buf
Definition: si_signals.h:59
int i
Definition: cfEzgcd.cc:123
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:128
static jList * T
Definition: janet.cc:37
BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6373 of file ipshell.cc.

6374 {
6375  // assume a: level
6376  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6377  {
6378  if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6379  char assume_yylinebuf[80];
6380  strncpy(assume_yylinebuf,my_yylinebuf,79);
6381  int lev=(long)a->Data();
6382  int startlev=0;
6383  idhdl h=ggetid("assumeLevel");
6384  if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6385  if(lev <=startlev)
6386  {
6387  BOOLEAN bo=b->Eval();
6388  if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6389  if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6390  if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6391  }
6392  }
6393  b->CleanUp();
6394  a->CleanUp();
6395  return FALSE;
6396 }
int Eval()
Definition: subexpr.cc:1741
Definition: tok.h:98
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define WarnS
Definition: emacs.cc:81
int Typ()
Definition: subexpr.cc:976
Definition: idrec.h:34
int myynest
Definition: febase.cc:46
#define IDTYP(a)
Definition: ipid.h:118
char my_yylinebuf[80]
Definition: febase.cc:48
#define NULL
Definition: omList.c:10
#define IDINT(a)
Definition: ipid.h:124
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
void * Data()
Definition: subexpr.cc:1118
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define TEST_V_ALLWARN
Definition: options.h:135
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:490
const char* iiTwoOps ( int  t)

Definition at line 87 of file ipshell.cc.

88 {
89  if (t<127)
90  {
91  static char ch[2];
92  switch (t)
93  {
94  case '&':
95  return "and";
96  case '|':
97  return "or";
98  default:
99  ch[0]=t;
100  ch[1]='\0';
101  return ch;
102  }
103  }
104  switch (t)
105  {
106  case COLONCOLON: return "::";
107  case DOTDOT: return "..";
108  //case PLUSEQUAL: return "+=";
109  //case MINUSEQUAL: return "-=";
110  case MINUSMINUS: return "--";
111  case PLUSPLUS: return "++";
112  case EQUAL_EQUAL: return "==";
113  case LE: return "<=";
114  case GE: return ">=";
115  case NOTEQUAL: return "<>";
116  default: return Tok2Cmdname(t);
117  }
118 }
Definition: grammar.cc:271
Definition: grammar.cc:270
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:128
BOOLEAN iiWRITE ( leftv  ,
leftv  v 
)

Definition at line 590 of file ipshell.cc.

591 {
592  sleftv vf;
593  if (iiConvert(v->Typ(),LINK_CMD,iiTestConvert(v->Typ(),LINK_CMD),v,&vf))
594  {
595  WerrorS("link expected");
596  return TRUE;
597  }
598  si_link l=(si_link)vf.Data();
599  if (vf.next == NULL)
600  {
601  WerrorS("write: need at least two arguments");
602  return TRUE;
603  }
604 
605  BOOLEAN b=slWrite(l,vf.next); /* iiConvert preserves next */
606  if (b)
607  {
608  const char *s;
609  if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
610  else s=sNoName;
611  Werror("cannot write to %s",s);
612  }
613  vf.CleanUp();
614  return b;
615 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
int iiTestConvert(int inputType, int outputType)
Definition: gentable.cc:292
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, const struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:358
const char sNoName[]
Definition: subexpr.cc:56
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:976
leftv next
Definition: subexpr.h:87
Definition: tok.h:119
#define NULL
Definition: omList.c:10
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
void * Data()
Definition: subexpr.cc:1118
int BOOLEAN
Definition: auxiliary.h:131
const poly b
Definition: syzextra.cc:213
void Werror(const char *fmt,...)
Definition: reporter.cc:199
int l
Definition: cfEzgcd.cc:94
BOOLEAN jjBETTI ( leftv  res,
leftv  u 
)

Definition at line 896 of file ipshell.cc.

897 {
898  sleftv tmp;
899  memset(&tmp,0,sizeof(tmp));
900  tmp.rtyp=INT_CMD;
901  tmp.data=(void *)1;
902  if ((u->Typ()==IDEAL_CMD)
903  || (u->Typ()==MODUL_CMD))
904  return jjBETTI2_ID(res,u,&tmp);
905  else
906  return jjBETTI2(res,u,&tmp);
907 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:98
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:930
int Typ()
Definition: subexpr.cc:976
void * data
Definition: subexpr.h:89
int rtyp
Definition: subexpr.h:92
BOOLEAN jjBETTI2_ID(leftv res, leftv u, leftv v)
Definition: ipshell.cc:909
BOOLEAN jjBETTI2 ( leftv  res,
leftv  u,
leftv  v 
)

Definition at line 930 of file ipshell.cc.

931 {
932  resolvente r;
933  int len;
934  int reg,typ0;
935  lists l=(lists)u->Data();
936 
937  intvec *weights=NULL;
938  int add_row_shift=0;
939  intvec *ww=(intvec *)atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
940  if (ww!=NULL)
941  {
942  weights=ivCopy(ww);
943  add_row_shift = ww->min_in();
944  (*weights) -= add_row_shift;
945  }
946  //Print("attr:%x\n",weights);
947 
948  r=liFindRes(l,&len,&typ0);
949  if (r==NULL) return TRUE;
950  res->data=(char *)syBetti(r,len,&reg,weights,(int)(long)v->Data());
951  omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
952  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
953  if (weights!=NULL) delete weights;
954  return FALSE;
955 }
sleftv * m
Definition: lists.h:45
void atSet(idhdl root, const char *name, void *data, int typ)
Definition: attrib.cc:156
Definition: tok.h:98
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:313
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * ivCopy(const intvec *o)
Definition: intvec.h:126
#define TRUE
Definition: auxiliary.h:144
void * ADDRESS
Definition: auxiliary.h:161
int min_in()
Definition: intvec.h:113
void * data
Definition: subexpr.h:89
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:135
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
void * Data()
Definition: subexpr.cc:1118
ideal * resolvente
Definition: ideals.h:20
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:793
int l
Definition: cfEzgcd.cc:94
#define omStrDup(s)
Definition: omAllocDecl.h:263
BOOLEAN jjBETTI2_ID ( leftv  res,
leftv  u,
leftv  v 
)

Definition at line 909 of file ipshell.cc.

910 {
912  l->Init(1);
913  l->m[0].rtyp=u->Typ();
914  l->m[0].data=u->Data();
915  attr *a=u->Attribute();
916  if (a!=NULL)
917  l->m[0].attribute=*a;
918  sleftv tmp2;
919  memset(&tmp2,0,sizeof(tmp2));
920  tmp2.rtyp=LIST_CMD;
921  tmp2.data=(void *)l;
922  BOOLEAN r=jjBETTI2(res,&tmp2,v);
923  l->m[0].data=NULL;
924  l->m[0].attribute=NULL;
925  l->m[0].rtyp=DEF_CMD;
926  l->Clean();
927  return r;
928 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
const poly a
Definition: syzextra.cc:212
Definition: attrib.h:15
Definition: lists.h:22
attr * Attribute()
Definition: subexpr.cc:1373
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:930
int Typ()
Definition: subexpr.cc:976
void * data
Definition: subexpr.h:89
const ring r
Definition: syzextra.cc:208
Definition: tok.h:61
CFList tmp2
Definition: facFqBivar.cc:70
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void Clean(ring r=currRing)
Definition: lists.h:25
void * Data()
Definition: subexpr.cc:1118
Definition: tok.h:120
attr attribute
Definition: subexpr.h:90
omBin slists_bin
Definition: lists.cc:23
int BOOLEAN
Definition: auxiliary.h:131
int l
Definition: cfEzgcd.cc:94
BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3262 of file ipshell.cc.

3263 {
3264  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3265  return (res->data==NULL);
3266 }
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition: clapsing.cc:1398
#define NULL
Definition: omList.c:10
void * Data()
Definition: subexpr.cc:1118
static void jjINT_S_TO_ID ( int  n,
int *  e,
leftv  res 
)
static

Definition at line 6216 of file ipshell.cc.

6217 {
6218  if (n==0) n=1;
6219  ideal l=idInit(n,1);
6220  int i;
6221  poly p;
6222  for(i=rVar(currRing);i>0;i--)
6223  {
6224  if (e[i]>0)
6225  {
6226  n--;
6227  p=pOne();
6228  pSetExp(p,i,1);
6229  pSetm(p);
6230  l->m[n]=p;
6231  if (n==0) break;
6232  }
6233  }
6234  res->data=(char*)l;
6235  setFlag(res,FLAG_STD);
6236  omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
6237 }
#define pSetm(p)
Definition: polys.h:241
#define pSetExp(p, i, v)
Definition: polys.h:42
return P p
Definition: myNF.cc:203
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:537
void * ADDRESS
Definition: auxiliary.h:161
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define setFlag(A, F)
Definition: ipid.h:112
int i
Definition: cfEzgcd.cc:123
#define pOne()
Definition: polys.h:286
#define FLAG_STD
Definition: ipid.h:108
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
polyrec * poly
Definition: hilb.h:10
int l
Definition: cfEzgcd.cc:94
BOOLEAN jjMINRES ( leftv  res,
leftv  v 
)

Definition at line 875 of file ipshell.cc.

876 {
877  int len=0;
878  int typ0;
879  lists L=(lists)v->Data();
880  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
881  int add_row_shift = 0;
882  if (weights==NULL)
883  weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
884  if (weights!=NULL) add_row_shift=weights->min_in();
885  resolvente rr=liFindRes(L,&len,&typ0);
886  if (rr==NULL) return TRUE;
887  resolvente r=iiCopyRes(rr,len);
888 
889  syMinimizeResolvente(r,len,0);
890  omFreeSize((ADDRESS)rr,len*sizeof(ideal));
891  len++;
892  res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
893  return FALSE;
894 }
sleftv * m
Definition: lists.h:45
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:313
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
void syMinimizeResolvente(resolvente res, int length, int first)
Definition: syz.cc:360
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define TRUE
Definition: auxiliary.h:144
void * ADDRESS
Definition: auxiliary.h:161
int min_in()
Definition: intvec.h:113
void * data
Definition: subexpr.h:89
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
static resolvente iiCopyRes(resolvente r, int l)
Definition: ipshell.cc:865
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:135
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:216
void * Data()
Definition: subexpr.cc:1118
ideal * resolvente
Definition: ideals.h:20
BOOLEAN jjPROC ( leftv  res,
leftv  u,
leftv  v 
)

Definition at line 1598 of file iparith.cc.

1599 {
1600  void *d;
1601  Subexpr e;
1602  int typ;
1603  BOOLEAN t=FALSE;
1604  idhdl tmp_proc=NULL;
1605  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1606  {
1607  tmp_proc=(idhdl)omAlloc0(sizeof(idrec));
1608  tmp_proc->id="_auto";
1609  tmp_proc->typ=PROC_CMD;
1610  tmp_proc->data.pinf=(procinfo *)u->Data();
1611  tmp_proc->ref=1;
1612  d=u->data; u->data=(void *)tmp_proc;
1613  e=u->e; u->e=NULL;
1614  t=TRUE;
1615  typ=u->rtyp; u->rtyp=IDHDL;
1616  }
1617  BOOLEAN sl;
1618  if (u->req_packhdl==currPack)
1619  sl = iiMake_proc((idhdl)u->data,NULL,v);
1620  else
1621  sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1622  if (t)
1623  {
1624  u->rtyp=typ;
1625  u->data=d;
1626  u->e=e;
1627  omFreeSize(tmp_proc,sizeof(idrec));
1628  }
1629  if (sl) return TRUE;
1630  memcpy(res,&iiRETURNEXPR,sizeof(sleftv));
1631  iiRETURNEXPR.Init();
1632  return FALSE;
1633 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Subexpr e
Definition: subexpr.h:106
#define FALSE
Definition: auxiliary.h:140
sleftv iiRETURNEXPR
Definition: iplib.cc:517
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define TRUE
Definition: auxiliary.h:144
void Init()
Definition: subexpr.h:108
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:35
void * data
Definition: subexpr.h:89
BOOLEAN iiMake_proc(idhdl pn, package pack, sleftv *sl)
Definition: iplib.cc:563
short ref
Definition: idrec.h:46
idrec * idhdl
Definition: ring.h:18
#define NULL
Definition: omList.c:10
package req_packhdl
Definition: subexpr.h:107
package currPack
Definition: ipid.cc:63
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1118
int typ
Definition: idrec.h:43
const char * id
Definition: idrec.h:39
int BOOLEAN
Definition: auxiliary.h:131
#define omAlloc0(size)
Definition: omAllocDecl.h:211
utypes data
Definition: idrec.h:40
BOOLEAN jjRESULTANT ( leftv  res,
leftv  u,
leftv  v,
leftv  w 
)

Definition at line 3255 of file ipshell.cc.

3256 {
3257  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3258  (poly)w->CopyD(), currRing);
3259  return errorreported;
3260 }
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition: clapsing.cc:317
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
short errorreported
Definition: feFopen.cc:23
polyrec * poly
Definition: hilb.h:10
void * CopyD(int t)
Definition: subexpr.cc:676
BOOLEAN jjVARIABLES_ID ( leftv  res,
leftv  u 
)

Definition at line 6246 of file ipshell.cc.

6247 {
6248  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6249  ideal I=(ideal)u->Data();
6250  int i;
6251  int n=0;
6252  for(i=I->nrows*I->ncols-1;i>=0;i--)
6253  {
6254  int n0=pGetVariables(I->m[i],e);
6255  if (n0>n) n=n0;
6256  }
6257  jjINT_S_TO_ID(n,e,res);
6258  return FALSE;
6259 }
#define FALSE
Definition: auxiliary.h:140
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:537
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6216
#define pGetVariables(p, e)
Definition: polys.h:222
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
int i
Definition: cfEzgcd.cc:123
void * Data()
Definition: subexpr.cc:1118
#define omAlloc0(size)
Definition: omAllocDecl.h:211
BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6238 of file ipshell.cc.

6239 {
6240  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6241  int n=pGetVariables((poly)u->Data(),e);
6242  jjINT_S_TO_ID(n,e,res);
6243  return FALSE;
6244 }
#define FALSE
Definition: auxiliary.h:140
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:537
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6216
#define pGetVariables(p, e)
Definition: polys.h:222
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void * Data()
Definition: subexpr.cc:1118
polyrec * poly
Definition: hilb.h:10
#define omAlloc0(size)
Definition: omAllocDecl.h:211
ideal kGroebner ( ideal  F,
ideal  Q 
)

Definition at line 6171 of file ipshell.cc.

6172 {
6173  //test|=Sy_bit(OPT_PROT);
6174  idhdl save_ringhdl=currRingHdl;
6175  ideal resid;
6176  idhdl new_ring=NULL;
6177  if ((currRingHdl==NULL) || (IDRING(currRingHdl)!=currRing))
6178  {
6179  currRingHdl=enterid(omStrDup(" GROEBNERring"),0,RING_CMD,&IDROOT,FALSE);
6180  new_ring=currRingHdl;
6182  }
6183  sleftv v; memset(&v,0,sizeof(v)); v.rtyp=IDEAL_CMD; v.data=(char *) F;
6184  idhdl h=ggetid("groebner");
6185  sleftv u; memset(&u,0,sizeof(u)); u.rtyp=IDHDL; u.data=(char *) h;
6186  u.name=IDID(h);
6187 
6188  sleftv res; memset(&res,0,sizeof(res));
6189  if(jjPROC(&res,&u,&v))
6190  {
6191  resid=kStd(F,Q,testHomog,NULL);
6192  }
6193  else
6194  {
6195  //printf("typ:%d\n",res.rtyp);
6196  resid=(ideal)(res.data);
6197  }
6198  // cleanup GROEBNERring, save_ringhdl, u,v,(res )
6199  if (new_ring!=NULL)
6200  {
6201  idhdl h=IDROOT;
6202  if (h==new_ring) IDROOT=h->next;
6203  else
6204  {
6205  while ((h!=NULL) &&(h->next!=new_ring)) h=h->next;
6206  if (h!=NULL) h->next=h->next->next;
6207  }
6208  if (h!=NULL) omFreeSize(h,sizeof(*h));
6209  }
6210  currRingHdl=save_ringhdl;
6211  u.CleanUp();
6212  v.CleanUp();
6213  return resid;
6214 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define IDID(a)
Definition: ipid.h:121
#define FALSE
Definition: auxiliary.h:140
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1598
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define IDROOT
Definition: ipid.h:20
ideal kStd(ideal F, ideal Q, tHomog h, intvec **w, intvec *hilb, int syzComp, int newIdeal, intvec *vw, s_poly_proc_t sp)
Definition: kstd1.cc:2225
#define Q
Definition: sirandom.c:25
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:35
void * data
Definition: subexpr.h:89
poly res
Definition: myNF.cc:322
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:259
const char * name
Definition: subexpr.h:88
idhdl currRingHdl
Definition: ipid.cc:65
idhdl next
Definition: idrec.h:38
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:126
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
static Poly * h
Definition: janet.cc:978
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:490
#define omStrDup(s)
Definition: omAllocDecl.h:263
void killlocals ( int  v)

Definition at line 380 of file ipshell.cc.

381 {
382  BOOLEAN changed=FALSE;
383  idhdl sh=currRingHdl;
384  ring cr=currRing;
385  if (sh!=NULL) changed=((IDLEV(sh)<v) || (IDRING(sh)->ref>0));
386  //if (changed) Print("currRing=%s(%x), lev=%d,ref=%d\n",IDID(sh),IDRING(sh),IDLEV(sh),IDRING(sh)->ref);
387 
388  killlocals_rec(&(basePack->idroot),v,currRing);
389 
391  {
392  int t=iiRETURNEXPR.Typ();
393  if ((/*iiRETURNEXPR.Typ()*/ t==RING_CMD)
394  || (/*iiRETURNEXPR.Typ()*/ t==QRING_CMD))
395  {
397  if (((ring)h->data)->idroot!=NULL)
398  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
399  }
400  else if (/*iiRETURNEXPR.Typ()*/ t==LIST_CMD)
401  {
402  leftv h=&iiRETURNEXPR;
403  changed |=killlocals_list(v,(lists)h->data);
404  }
405  }
406  if (changed)
407  {
409  if (currRingHdl==NULL)
410  currRing=NULL;
411  else if(cr!=currRing)
412  rChangeCurrRing(cr);
413  }
414 
415  if (myynest<=1) iiNoKeepRing=TRUE;
416  //Print("end killlocals >= %d\n",v);
417  //listall();
418 }
int iiRETURNEXPR_len
Definition: iplib.cc:518
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
sleftv iiRETURNEXPR
Definition: iplib.cc:517
#define TRUE
Definition: auxiliary.h:144
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:323
int Typ()
Definition: subexpr.cc:976
Definition: idrec.h:34
void * data
Definition: subexpr.h:89
int myynest
Definition: febase.cc:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:360
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:83
idhdl currRingHdl
Definition: ipid.cc:65
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1577
#define IDLEV(a)
Definition: ipid.h:120
void rChangeCurrRing(ring r)
Definition: polys.cc:14
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
#define IDRING(a)
Definition: ipid.h:126
Definition: tok.h:120
Definition: tok.h:159
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:288
static void killlocals0 ( int  v,
idhdl localhdl,
const ring  r 
)
static

Definition at line 288 of file ipshell.cc.

289 {
290  idhdl h = *localhdl;
291  while (h!=NULL)
292  {
293  int vv;
294  //Print("consider %s, lev: %d:",IDID(h),IDLEV(h));
295  if ((vv=IDLEV(h))>0)
296  {
297  if (vv < v)
298  {
299  if (iiNoKeepRing)
300  {
301  //PrintS(" break\n");
302  return;
303  }
304  h = IDNEXT(h);
305  //PrintLn();
306  }
307  else //if (vv >= v)
308  {
309  idhdl nexth = IDNEXT(h);
310  killhdl2(h,localhdl,r);
311  h = nexth;
312  //PrintS("kill\n");
313  }
314  }
315  else
316  {
317  h = IDNEXT(h);
318  //PrintLn();
319  }
320  }
321 }
#define IDNEXT(a)
Definition: ipid.h:117
Definition: idrec.h:34
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:403
const ring r
Definition: syzextra.cc:208
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:83
#define IDLEV(a)
Definition: ipid.h:120
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
static Poly * h
Definition: janet.cc:978
BOOLEAN killlocals_list ( int  v,
lists  L 
)

Definition at line 360 of file ipshell.cc.

361 {
362  if (L==NULL) return FALSE;
363  BOOLEAN changed=FALSE;
364  int n=L->nr;
365  for(;n>=0;n--)
366  {
367  leftv h=&(L->m[n]);
368  void *d=h->data;
369  if (((h->rtyp==RING_CMD) || (h->rtyp==QRING_CMD))
370  && (((ring)d)->idroot!=NULL))
371  {
372  if (d!=currRing) {changed=TRUE;rChangeCurrRing((ring)d);}
373  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
374  }
375  else if (h->rtyp==LIST_CMD)
376  changed|=killlocals_list(v,(lists)d);
377  }
378  return changed;
379 }
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:360
void rChangeCurrRing(ring r)
Definition: polys.cc:14
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
Definition: tok.h:120
Definition: tok.h:159
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:288
void killlocals_rec ( idhdl root,
int  v,
ring  r 
)

Definition at line 323 of file ipshell.cc.

324 {
325  idhdl h=*root;
326  while (h!=NULL)
327  {
328  if (IDLEV(h)>=v)
329  {
330 // Print("kill %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
331  idhdl n=IDNEXT(h);
332  killhdl2(h,root,r);
333  h=n;
334  }
335  else if (IDTYP(h)==PACKAGE_CMD)
336  {
337  // Print("into pack %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
338  if (IDPACKAGE(h)!=basePack)
339  killlocals_rec(&(IDRING(h)->idroot),v,r);
340  h=IDNEXT(h);
341  }
342  else if ((IDTYP(h)==RING_CMD)
343  ||(IDTYP(h)==QRING_CMD))
344  {
345  if ((IDRING(h)!=NULL) && (IDRING(h)->idroot!=NULL))
346  // we have to test IDRING(h)!=NULL: qring Q=groebner(...): killlocals
347  {
348  // Print("into ring %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
349  killlocals_rec(&(IDRING(h)->idroot),v,IDRING(h));
350  }
351  h=IDNEXT(h);
352  }
353  else
354  {
355 // Print("skip %s lev %d for lev %d\n",IDID(h),IDLEV(h),v);
356  h=IDNEXT(h);
357  }
358  }
359 }
#define IDNEXT(a)
Definition: ipid.h:117
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:323
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:138
#define IDTYP(a)
Definition: ipid.h:118
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:403
const ring r
Definition: syzextra.cc:208
#define IDLEV(a)
Definition: ipid.h:120
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
#define IDRING(a)
Definition: ipid.h:126
Definition: tok.h:159
static Poly * h
Definition: janet.cc:978
BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3238 of file ipshell.cc.

3239 {
3240  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3241  if (res->data==NULL)
3242  res->data=(char *)new intvec(rVar(currRing));
3243  return FALSE;
3244 }
#define FALSE
Definition: auxiliary.h:140
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:537
intvec * id_QHomWeight(ideal id, const ring r)
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
Definition: intvec.h:14
#define NULL
Definition: omList.c:10
void * Data()
Definition: subexpr.cc:1118
BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3216 of file ipshell.cc.

3217 {
3218  ideal F=(ideal)id->Data();
3219  intvec * iv = new intvec(rVar(currRing));
3220  polyset s;
3221  int sl, n, i;
3222  int *x;
3223 
3224  res->data=(char *)iv;
3225  s = F->m;
3226  sl = IDELEMS(F) - 1;
3227  n = rVar(currRing);
3228  double wNsqr = (double)2.0 / (double)n;
3230  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3231  wCall(s, sl, x, wNsqr, currRing);
3232  for (i = n; i!=0; i--)
3233  (*iv)[i-1] = x[i + n + 1];
3234  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3235  return FALSE;
3236 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define FALSE
Definition: auxiliary.h:140
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:537
void * ADDRESS
Definition: auxiliary.h:161
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
Definition: intvec.h:14
double(* wFunctional)(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight.cc:28
int i
Definition: cfEzgcd.cc:123
#define IDELEMS(i)
Definition: simpleideals.h:24
poly * polyset
Definition: hutil.h:15
void wCall(poly *s, int sl, int *x, double wNsqr, const ring R)
Definition: weight.cc:116
Variable x
Definition: cfModGcd.cc:4023
void * Data()
Definition: subexpr.cc:1118
double wFunctionalBuch(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight0.c:82
static void list1 ( const char *  s,
idhdl  h,
BOOLEAN  c,
BOOLEAN  fullname 
)
static

Definition at line 148 of file ipshell.cc.

149 {
150  char buffer[22];
151  int l;
152  char buf2[128];
153 
154  if(fullname) sprintf(buf2, "%s::%s", "", IDID(h));
155  else sprintf(buf2, "%s", IDID(h));
156 
157  Print("%s%-30.30s [%d] ",s,buf2,IDLEV(h));
158  if (h == currRingHdl) PrintS("*");
159  PrintS(Tok2Cmdname((int)IDTYP(h)));
160 
161  ipListFlag(h);
162  switch(IDTYP(h))
163  {
164  case ALIAS_CMD: Print(" for %s",IDID((idhdl)IDDATA(h))); break;
165  case INT_CMD: Print(" %d",IDINT(h)); break;
166  case INTVEC_CMD:Print(" (%d)",IDINTVEC(h)->length()); break;
167  case INTMAT_CMD:Print(" %d x %d",IDINTVEC(h)->rows(),IDINTVEC(h)->cols());
168  break;
169  case POLY_CMD:
170  case VECTOR_CMD:if (c)
171  {
172  PrintS(" ");wrp(IDPOLY(h));
173  if(IDPOLY(h) != NULL)
174  {
175  Print(", %d monomial(s)",pLength(IDPOLY(h)));
176  }
177  }
178  break;
179  case MODUL_CMD: Print(", rk %d", (int)(IDIDEAL(h)->rank));
180  case IDEAL_CMD: Print(", %u generator(s)",
181  IDELEMS(IDIDEAL(h))); break;
182  case MAP_CMD:
183  Print(" from %s",IDMAP(h)->preimage); break;
184  case MATRIX_CMD:Print(" %u x %u"
185  ,MATROWS(IDMATRIX(h))
186  ,MATCOLS(IDMATRIX(h))
187  );
188  break;
189  case PACKAGE_CMD:
190  paPrint(IDID(h),IDPACKAGE(h));
191  break;
192  case PROC_CMD: if((IDPROC(h)->libname!=NULL)
193  && (strlen(IDPROC(h)->libname)>0))
194  Print(" from %s",IDPROC(h)->libname);
195  if(IDPROC(h)->is_static)
196  PrintS(" (static)");
197  break;
198  case STRING_CMD:
199  {
200  char *s;
201  l=strlen(IDSTRING(h));
202  memset(buffer,0,22);
203  strncpy(buffer,IDSTRING(h),si_min(l,20));
204  if ((s=strchr(buffer,'\n'))!=NULL)
205  {
206  *s='\0';
207  }
208  PrintS(" ");
209  PrintS(buffer);
210  if((s!=NULL) ||(l>20))
211  {
212  Print("..., %d char(s)",l);
213  }
214  break;
215  }
216  case LIST_CMD: Print(", size: %d",IDLIST(h)->nr+1);
217  break;
218  case QRING_CMD:
219  case RING_CMD:
220  if ((IDRING(h)==currRing) && (currRingHdl!=h))
221  PrintS("(*)"); /* this is an alias to currRing */
222 #ifdef RDEBUG
224  Print(" <%lx>",(long)(IDRING(h)));
225 #endif
226  break;
227 #ifdef SINGULAR_4_1
228  case CNUMBER_CMD:
229  { number2 n=(number2)IDDATA(h);
230  Print(" (%s)",nCoeffName(n->cf));
231  break;
232  }
233  case CMATRIX_CMD:
234  { bigintmat *b=(bigintmat*)IDDATA(h);
235  Print(" %d x %d (%s)",
236  b->rows(),b->cols(),
237  nCoeffName(b->basecoeffs()));
238  break;
239  }
240 #endif
241  /*default: break;*/
242  }
243  PrintLn();
244 }
#define IDLIST(a)
Definition: ipid.h:136
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define TRACE_SHOW_RINGS
Definition: reporter.h:33
void PrintLn()
Definition: reporter.cc:327
#define Print
Definition: emacs.cc:83
Definition: tok.h:98
#define IDINTVEC(a)
Definition: ipid.h:127
#define IDID(a)
Definition: ipid.h:121
static int si_min(const int a, const int b)
Definition: auxiliary.h:167
Matrices of numbers.
Definition: bigintmat.h:51
char buffer[1024]
Definition: run.c:54
#define IDIDEAL(a)
Definition: ipid.h:132
int traceit
Definition: febase.cc:47
static int pLength(poly a)
Definition: p_polys.h:189
Definition: idrec.h:34
void ipListFlag(idhdl h)
Definition: ipid.cc:519
#define IDPACKAGE(a)
Definition: ipid.h:138
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define IDTYP(a)
Definition: ipid.h:118
static FORCE_INLINE char * nCoeffName(const coeffs cf)
Definition: coeffs.h:966
#define IDSTRING(a)
Definition: ipid.h:135
idhdl currRingHdl
Definition: ipid.cc:65
void PrintS(const char *s)
Definition: reporter.cc:294
#define IDELEMS(i)
Definition: simpleideals.h:24
#define IDLEV(a)
Definition: ipid.h:120
#define IDMAP(a)
Definition: ipid.h:134
int cols() const
Definition: bigintmat.h:145
CanonicalForm buf2
Definition: facFqBivar.cc:71
Definition: tok.h:38
#define IDPROC(a)
Definition: ipid.h:139
void paPrint(const char *n, package p)
Definition: ipshell.cc:6261
int rows() const
Definition: bigintmat.h:146
#define MATCOLS(i)
Definition: matpol.h:28
#define NULL
Definition: omList.c:10
#define IDINT(a)
Definition: ipid.h:124
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:128
#define IDPOLY(a)
Definition: ipid.h:129
coeffs basecoeffs() const
Definition: bigintmat.h:147
#define IDRING(a)
Definition: ipid.h:126
Definition: tok.h:120
Definition: tok.h:159
#define MATROWS(i)
Definition: matpol.h:27
void wrp(poly p)
Definition: polys.h:281
#define IDDATA(a)
Definition: ipid.h:125
const poly b
Definition: syzextra.cc:213
int l
Definition: cfEzgcd.cc:94
#define IDMATRIX(a)
Definition: ipid.h:133
void list_cmd ( int  typ,
const char *  what,
const char *  prefix,
BOOLEAN  iterate,
BOOLEAN  fullname 
)

Definition at line 420 of file ipshell.cc.

421 {
422  package savePack=currPack;
423  idhdl h,start;
424  BOOLEAN all = typ<0;
425  BOOLEAN really_all=FALSE;
426 
427  if ( typ==0 )
428  {
429  if (strcmp(what,"all")==0)
430  {
431  if (currPack!=basePack)
432  list_cmd(-1,NULL,prefix,iterate,fullname); // list current package
433  really_all=TRUE;
434  h=basePack->idroot;
435  }
436  else
437  {
438  h = ggetid(what);
439  if (h!=NULL)
440  {
441  if (iterate) list1(prefix,h,TRUE,fullname);
442  if (IDTYP(h)==ALIAS_CMD) PrintS("A");
443  if ((IDTYP(h)==RING_CMD)
444  || (IDTYP(h)==QRING_CMD)
445  //|| (IDTYP(h)==PACKE_CMD)
446  )
447  {
448  h=IDRING(h)->idroot;
449  }
450  else if(IDTYP(h)==PACKAGE_CMD)
451  {
452  currPack=IDPACKAGE(h);
453  //Print("list_cmd:package\n");
454  all=TRUE;typ=PROC_CMD;fullname=TRUE;really_all=TRUE;
455  h=IDPACKAGE(h)->idroot;
456  }
457  else
458  {
459  currPack=savePack;
460  return;
461  }
462  }
463  else
464  {
465  Werror("%s is undefined",what);
466  currPack=savePack;
467  return;
468  }
469  }
470  all=TRUE;
471  }
472  else if (RingDependend(typ))
473  {
474  h = currRing->idroot;
475  }
476  else
477  h = IDROOT;
478  start=h;
479  while (h!=NULL)
480  {
481  if ((all
482  && (IDTYP(h)!=PROC_CMD)
483  &&(IDTYP(h)!=PACKAGE_CMD)
484  #ifdef SINGULAR_4_1
485  &&(IDTYP(h)!=CRING_CMD)
486  #endif
487  )
488  || (typ == IDTYP(h))
489  #ifdef SINGULAR_4_1
490  || ((IDTYP(h)==CRING_CMD) && (typ==RING_CMD))
491  #else
492  || ((IDTYP(h)==QRING_CMD) && (typ==RING_CMD))
493  #endif
494  )
495  {
496  list1(prefix,h,start==currRingHdl, fullname);
497  if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
498  && (really_all || (all && (h==currRingHdl)))
499  && ((IDLEV(h)==0)||(IDLEV(h)==myynest)))
500  {
501  list_cmd(0,IDID(h),"// ",FALSE);
502  }
503  if (IDTYP(h)==PACKAGE_CMD && really_all)
504  {
505  package save_p=currPack;
506  currPack=IDPACKAGE(h);
507  list_cmd(0,IDID(h),"// ",FALSE);
508  currPack=save_p;
509  }
510  }
511  h = IDNEXT(h);
512  }
513  currPack=savePack;
514 }
#define IDID(a)
Definition: ipid.h:121
#define FALSE
Definition: auxiliary.h:140
#define IDNEXT(a)
Definition: ipid.h:117
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:144
static void list1(const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
Definition: ipshell.cc:148
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:138
int myynest
Definition: febase.cc:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define IDTYP(a)
Definition: ipid.h:118
Definition: tok.h:59
int RingDependend(int t)
Definition: gentable.cc:23
void list_cmd(int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname)
Definition: ipshell.cc:420
idhdl currRingHdl
Definition: ipid.cc:65
void PrintS(const char *s)
Definition: reporter.cc:294
#define IDLEV(a)
Definition: ipid.h:120
Definition: tok.h:38
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
#define IDRING(a)
Definition: ipid.h:126
package currPack
Definition: ipid.cc:63
Definition: tok.h:159
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:490
void list_error ( semicState  state)

Definition at line 3383 of file ipshell.cc.

3384 {
3385  switch( state )
3386  {
3387  case semicListTooShort:
3388  WerrorS( "the list is too short" );
3389  break;
3390  case semicListTooLong:
3391  WerrorS( "the list is too long" );
3392  break;
3393 
3395  WerrorS( "first element of the list should be int" );
3396  break;
3398  WerrorS( "second element of the list should be int" );
3399  break;
3401  WerrorS( "third element of the list should be int" );
3402  break;
3404  WerrorS( "fourth element of the list should be intvec" );
3405  break;
3407  WerrorS( "fifth element of the list should be intvec" );
3408  break;
3410  WerrorS( "sixth element of the list should be intvec" );
3411  break;
3412 
3413  case semicListNNegative:
3414  WerrorS( "first element of the list should be positive" );
3415  break;
3417  WerrorS( "wrong number of numerators" );
3418  break;
3420  WerrorS( "wrong number of denominators" );
3421  break;
3423  WerrorS( "wrong number of multiplicities" );
3424  break;
3425 
3426  case semicListMuNegative:
3427  WerrorS( "the Milnor number should be positive" );
3428  break;
3429  case semicListPgNegative:
3430  WerrorS( "the geometrical genus should be nonnegative" );
3431  break;
3432  case semicListNumNegative:
3433  WerrorS( "all numerators should be positive" );
3434  break;
3435  case semicListDenNegative:
3436  WerrorS( "all denominators should be positive" );
3437  break;
3438  case semicListMulNegative:
3439  WerrorS( "all multiplicities should be positive" );
3440  break;
3441 
3442  case semicListNotSymmetric:
3443  WerrorS( "it is not symmetric" );
3444  break;
3446  WerrorS( "it is not monotonous" );
3447  break;
3448 
3449  case semicListMilnorWrong:
3450  WerrorS( "the Milnor number is wrong" );
3451  break;
3452  case semicListPGWrong:
3453  WerrorS( "the geometrical genus is wrong" );
3454  break;
3455 
3456  default:
3457  WerrorS( "unspecific error" );
3458  break;
3459  }
3460 }
void WerrorS(const char *s)
Definition: feFopen.cc:24
semicState list_is_spectrum ( lists  l)

Definition at line 4168 of file ipshell.cc.

4169 {
4170  // -------------------
4171  // check list length
4172  // -------------------
4173 
4174  if( l->nr < 5 )
4175  {
4176  return semicListTooShort;
4177  }
4178  else if( l->nr > 5 )
4179  {
4180  return semicListTooLong;
4181  }
4182 
4183  // -------------
4184  // check types
4185  // -------------
4186 
4187  if( l->m[0].rtyp != INT_CMD )
4188  {
4190  }
4191  else if( l->m[1].rtyp != INT_CMD )
4192  {
4194  }
4195  else if( l->m[2].rtyp != INT_CMD )
4196  {
4198  }
4199  else if( l->m[3].rtyp != INTVEC_CMD )
4200  {
4202  }
4203  else if( l->m[4].rtyp != INTVEC_CMD )
4204  {
4206  }
4207  else if( l->m[5].rtyp != INTVEC_CMD )
4208  {
4210  }
4211 
4212  // -------------------------
4213  // check number of entries
4214  // -------------------------
4215 
4216  int mu = (int)(long)(l->m[0].Data( ));
4217  int pg = (int)(long)(l->m[1].Data( ));
4218  int n = (int)(long)(l->m[2].Data( ));
4219 
4220  if( n <= 0 )
4221  {
4222  return semicListNNegative;
4223  }
4224 
4225  intvec *num = (intvec*)l->m[3].Data( );
4226  intvec *den = (intvec*)l->m[4].Data( );
4227  intvec *mul = (intvec*)l->m[5].Data( );
4228 
4229  if( n != num->length( ) )
4230  {
4232  }
4233  else if( n != den->length( ) )
4234  {
4236  }
4237  else if( n != mul->length( ) )
4238  {
4240  }
4241 
4242  // --------
4243  // values
4244  // --------
4245 
4246  if( mu <= 0 )
4247  {
4248  return semicListMuNegative;
4249  }
4250  if( pg < 0 )
4251  {
4252  return semicListPgNegative;
4253  }
4254 
4255  int i;
4256 
4257  for( i=0; i<n; i++ )
4258  {
4259  if( (*num)[i] <= 0 )
4260  {
4261  return semicListNumNegative;
4262  }
4263  if( (*den)[i] <= 0 )
4264  {
4265  return semicListDenNegative;
4266  }
4267  if( (*mul)[i] <= 0 )
4268  {
4269  return semicListMulNegative;
4270  }
4271  }
4272 
4273  // ----------------
4274  // check symmetry
4275  // ----------------
4276 
4277  int j;
4278 
4279  for( i=0, j=n-1; i<=j; i++,j-- )
4280  {
4281  if( (*num)[i] != rVar(currRing)*((*den)[i]) - (*num)[j] ||
4282  (*den)[i] != (*den)[j] ||
4283  (*mul)[i] != (*mul)[j] )
4284  {
4285  return semicListNotSymmetric;
4286  }
4287  }
4288 
4289  // ----------------
4290  // check monotony
4291  // ----------------
4292 
4293  for( i=0, j=1; i<n/2; i++,j++ )
4294  {
4295  if( (*num)[i]*(*den)[j] >= (*num)[j]*(*den)[i] )
4296  {
4297  return semicListNotMonotonous;
4298  }
4299  }
4300 
4301  // ---------------------
4302  // check Milnor number
4303  // ---------------------
4304 
4305  for( mu=0, i=0; i<n; i++ )
4306  {
4307  mu += (*mul)[i];
4308  }
4309 
4310  if( mu != (int)(long)(l->m[0].Data( )) )
4311  {
4312  return semicListMilnorWrong;
4313  }
4314 
4315  // -------------------------
4316  // check geometrical genus
4317  // -------------------------
4318 
4319  for( pg=0, i=0; i<n; i++ )
4320  {
4321  if( (*num)[i]<=(*den)[i] )
4322  {
4323  pg += (*mul)[i];
4324  }
4325  }
4326 
4327  if( pg != (int)(long)(l->m[1].Data( )) )
4328  {
4329  return semicListPGWrong;
4330  }
4331 
4332  return semicOK;
4333 }
sleftv * m
Definition: lists.h:45
void mu(int **points, int sizePoints)
Definition: tok.h:98
CanonicalForm num(const CanonicalForm &f)
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:537
int length() const
Definition: intvec.h:86
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
Definition: intvec.h:14
int j
Definition: myNF.cc:70
int i
Definition: cfEzgcd.cc:123
int nr
Definition: lists.h:43
CanonicalForm den(const CanonicalForm &f)
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1118
lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 4983 of file ipshell.cc.

4984 {
4985  int i,j;
4986  int count= self->roots[0]->getAnzRoots(); // number of roots
4987  int elem= self->roots[0]->getAnzElems(); // number of koordinates per root
4988 
4989  lists listofroots= (lists)omAlloc( sizeof(slists) ); // must be done this way!
4990 
4991  if ( self->found_roots )
4992  {
4993  listofroots->Init( count );
4994 
4995  for (i=0; i < count; i++)
4996  {
4997  lists onepoint= (lists)omAlloc(sizeof(slists)); // must be done this way!
4998  onepoint->Init(elem);
4999  for ( j= 0; j < elem; j++ )
5000  {
5001  if ( !rField_is_long_C(currRing) )
5002  {
5003  onepoint->m[j].rtyp=STRING_CMD;
5004  onepoint->m[j].data=(void *)complexToStr((*self->roots[j])[i],oprec, currRing->cf);
5005  }
5006  else
5007  {
5008  onepoint->m[j].rtyp=NUMBER_CMD;
5009  onepoint->m[j].data=(void *)n_Copy((number)(self->roots[j]->getRoot(i)), currRing->cf);
5010  }
5011  onepoint->m[j].next= NULL;
5012  onepoint->m[j].name= NULL;
5013  }
5014  listofroots->m[i].rtyp=LIST_CMD;
5015  listofroots->m[i].data=(void *)onepoint;
5016  listofroots->m[j].next= NULL;
5017  listofroots->m[j].name= NULL;
5018  }
5019 
5020  }
5021  else
5022  {
5023  listofroots->Init( 0 );
5024  }
5025 
5026  return listofroots;
5027 }
int status int void size_t count
Definition: si_signals.h:59
sleftv * m
Definition: lists.h:45
Definition: lists.h:22
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
int j
Definition: myNF.cc:70
const char * name
Definition: subexpr.h:88
int i
Definition: cfEzgcd.cc:123
bool found_roots
Definition: mpr_numeric.h:172
leftv next
Definition: subexpr.h:87
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:491
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
static FORCE_INLINE number n_Copy(number n, const coeffs r)
return a copy of &#39;n&#39;
Definition: coeffs.h:452
int rtyp
Definition: subexpr.h:92
Definition: tok.h:120
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition: mpr_complex.cc:717
rootContainer ** roots
Definition: mpr_numeric.h:167
BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4478 of file ipshell.cc.

4479 {
4480  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4481  return FALSE;
4482 }
#define FALSE
Definition: auxiliary.h:140
ideal loNewtonPolytope(const ideal id)
Definition: mpr_base.cc:3192
void * data
Definition: subexpr.h:89
void * Data()
Definition: subexpr.cc:1118
BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4484 of file ipshell.cc.

4485 {
4486  if ( !(rField_is_long_R(currRing)) )
4487  {
4488  WerrorS("Ground field not implemented!");
4489  return TRUE;
4490  }
4491 
4492  simplex * LP;
4493  matrix m;
4494 
4495  leftv v= args;
4496  if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4497  return TRUE;
4498  else
4499  m= (matrix)(v->CopyD());
4500 
4501  LP = new simplex(MATROWS(m),MATCOLS(m));
4502  LP->mapFromMatrix(m);
4503 
4504  v= v->next;
4505  if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4506  return TRUE;
4507  else
4508  LP->m= (int)(long)(v->Data());
4509 
4510  v= v->next;
4511  if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4512  return TRUE;
4513  else
4514  LP->n= (int)(long)(v->Data());
4515 
4516  v= v->next;
4517  if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4518  return TRUE;
4519  else
4520  LP->m1= (int)(long)(v->Data());
4521 
4522  v= v->next;
4523  if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4524  return TRUE;
4525  else
4526  LP->m2= (int)(long)(v->Data());
4527 
4528  v= v->next;
4529  if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4530  return TRUE;
4531  else
4532  LP->m3= (int)(long)(v->Data());
4533 
4534 #ifdef mprDEBUG_PROT
4535  Print("m (constraints) %d\n",LP->m);
4536  Print("n (columns) %d\n",LP->n);
4537  Print("m1 (<=) %d\n",LP->m1);
4538  Print("m2 (>=) %d\n",LP->m2);
4539  Print("m3 (==) %d\n",LP->m3);
4540 #endif
4541 
4542  LP->compute();
4543 
4544  lists lres= (lists)omAlloc( sizeof(slists) );
4545  lres->Init( 6 );
4546 
4547  lres->m[0].rtyp= MATRIX_CMD; // output matrix
4548  lres->m[0].data=(void*)LP->mapToMatrix(m);
4549 
4550  lres->m[1].rtyp= INT_CMD; // found a solution?
4551  lres->m[1].data=(void*)(long)LP->icase;
4552 
4553  lres->m[2].rtyp= INTVEC_CMD;
4554  lres->m[2].data=(void*)LP->posvToIV();
4555 
4556  lres->m[3].rtyp= INTVEC_CMD;
4557  lres->m[3].data=(void*)LP->zrovToIV();
4558 
4559  lres->m[4].rtyp= INT_CMD;
4560  lres->m[4].data=(void*)(long)LP->m;
4561 
4562  lres->m[5].rtyp= INT_CMD;
4563  lres->m[5].data=(void*)(long)LP->n;
4564 
4565  res->data= (void*)lres;
4566 
4567  return FALSE;
4568 }
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
matrix mapToMatrix(matrix m)
void compute()
#define Print
Definition: emacs.cc:83
Definition: tok.h:98
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
Linear Programming / Linear Optimization using Simplex - Algorithm.
Definition: mpr_numeric.h:194
#define TRUE
Definition: auxiliary.h:144
intvec * zrovToIV()
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:976
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
intvec * posvToIV()
BOOLEAN mapFromMatrix(matrix m)
ip_smatrix * matrix
int m
Definition: cfEzgcd.cc:119
leftv next
Definition: subexpr.h:87
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define MATCOLS(i)
Definition: matpol.h:28
slists * lists
Definition: mpr_numeric.h:146
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:488
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1118
#define MATROWS(i)
Definition: matpol.h:27
int icase
Definition: mpr_numeric.h:201
void * CopyD(int t)
Definition: subexpr.cc:676
BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 2985 of file ipshell.cc.

2986 {
2987  int i,j;
2988  matrix result;
2989  ideal id=(ideal)a->Data();
2990 
2991  result =mpNew(IDELEMS(id),rVar(currRing));
2992  for (i=1; i<=IDELEMS(id); i++)
2993  {
2994  for (j=1; j<=rVar(currRing); j++)
2995  {
2996  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
2997  }
2998  }
2999  res->data=(char *)result;
3000  return FALSE;
3001 }
#define FALSE
Definition: auxiliary.h:140
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:537
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
int j
Definition: myNF.cc:70
int i
Definition: cfEzgcd.cc:123
#define IDELEMS(i)
Definition: simpleideals.h:24
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:48
void * Data()
Definition: subexpr.cc:1118
#define pDiff(a, b)
Definition: polys.h:267
return result
Definition: facAbsBiFact.cc:76
#define MATELEM(mat, i, j)
Definition: matpol.h:29
BOOLEAN mpKoszul ( leftv  res,
leftv  c,
leftv  b,
leftv  id 
)

Definition at line 3007 of file ipshell.cc.

3008 {
3009  int n=(int)(long)b->Data();
3010  int d=(int)(long)c->Data();
3011  int k,l,sign,row,col;
3012  matrix result;
3013  ideal temp;
3014  BOOLEAN bo;
3015  poly p;
3016 
3017  if ((d>n) || (d<1) || (n<1))
3018  {
3019  res->data=(char *)mpNew(1,1);
3020  return FALSE;
3021  }
3022  int *choise = (int*)omAlloc(d*sizeof(int));
3023  if (id==NULL)
3024  temp=idMaxIdeal(1);
3025  else
3026  temp=(ideal)id->Data();
3027 
3028  k = binom(n,d);
3029  l = k*d;
3030  l /= n-d+1;
3031  result =mpNew(l,k);
3032  col = 1;
3033  idInitChoise(d,1,n,&bo,choise);
3034  while (!bo)
3035  {
3036  sign = 1;
3037  for (l=1;l<=d;l++)
3038  {
3039  if (choise[l-1]<=IDELEMS(temp))
3040  {
3041  p = pCopy(temp->m[choise[l-1]-1]);
3042  if (sign == -1) p = pNeg(p);
3043  sign *= -1;
3044  row = idGetNumberOfChoise(l-1,d,1,n,choise);
3045  MATELEM(result,row,col) = p;
3046  }
3047  }
3048  col++;
3049  idGetNextChoise(d,n,&bo,choise);
3050  }
3051  if (id==NULL) idDelete(&temp);
3052 
3053  res->data=(char *)result;
3054  return FALSE;
3055 }
#define idMaxIdeal(D)
initialise the maximal ideal (at 0)
Definition: ideals.h:35
#define idDelete(H)
delete an ideal
Definition: ideals.h:31
#define FALSE
Definition: auxiliary.h:140
return P p
Definition: myNF.cc:203
#define pNeg(p)
Definition: polys.h:169
int k
Definition: cfEzgcd.cc:93
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:89
void idGetNextChoise(int r, int end, BOOLEAN *endch, int *choise)
#define IDELEMS(i)
Definition: simpleideals.h:24
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:48
#define NULL
Definition: omList.c:10
void idInitChoise(int r, int beg, int end, BOOLEAN *endch, int *choise)
void * Data()
Definition: subexpr.cc:1118
int idGetNumberOfChoise(int t, int d, int begin, int end, int *choise)
polyrec * poly
Definition: hilb.h:10
int BOOLEAN
Definition: auxiliary.h:131
int binom(int n, int r)
return result
Definition: facAbsBiFact.cc:76
int l
Definition: cfEzgcd.cc:94
int sign(const CanonicalForm &a)
#define pCopy(p)
return a copy of the poly
Definition: polys.h:156
#define MATELEM(mat, i, j)
Definition: matpol.h:29
BOOLEAN nuLagSolve ( leftv  res,
leftv  arg1,
leftv  arg2,
leftv  arg3 
)

find the (complex) roots an univariate polynomial Determines the roots of an univariate polynomial using Laguerres' root-solver.

Good for polynomials with low and middle degree (<40). Arguments 3: poly arg1 , int arg2 , int arg3 arg2>0: defines precision of fractional part if ground field is Q arg3: number of iterations for approximation of roots (default=2) Returns a list of all (complex) roots of the polynomial arg1

Definition at line 4593 of file ipshell.cc.

4594 {
4595 
4596  poly gls;
4597  gls= (poly)(arg1->Data());
4598  int howclean= (int)(long)arg3->Data();
4599 
4600  if ( !(rField_is_R(currRing) ||
4601  rField_is_Q(currRing) ||
4604  {
4605  WerrorS("Ground field not implemented!");
4606  return TRUE;
4607  }
4608 
4611  {
4612  unsigned long int ii = (unsigned long int)arg2->Data();
4613  setGMPFloatDigits( ii, ii );
4614  }
4615 
4616  if ( gls == NULL || pIsConstant( gls ) )
4617  {
4618  WerrorS("Input polynomial is constant!");
4619  return TRUE;
4620  }
4621 
4622  int ldummy;
4623  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4624  // int deg= pDeg( gls );
4625  // int len= pLength( gls );
4626  int i,vpos=0;
4627  poly piter;
4628  lists elist;
4629  lists rlist;
4630 
4631  elist= (lists)omAlloc( sizeof(slists) );
4632  elist->Init( 0 );
4633 
4634  if ( rVar(currRing) > 1 )
4635  {
4636  piter= gls;
4637  for ( i= 1; i <= rVar(currRing); i++ )
4638  if ( pGetExp( piter, i ) )
4639  {
4640  vpos= i;
4641  break;
4642  }
4643  while ( piter )
4644  {
4645  for ( i= 1; i <= rVar(currRing); i++ )
4646  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4647  {
4648  WerrorS("The input polynomial must be univariate!");
4649  return TRUE;
4650  }
4651  pIter( piter );
4652  }
4653  }
4654 
4655  rootContainer * roots= new rootContainer();
4656  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4657  piter= gls;
4658  for ( i= deg; i >= 0; i-- )
4659  {
4660  //if ( piter ) Print("deg %d, pDeg(piter) %d\n",i,pTotaldegree(piter));
4661  if ( piter && pTotaldegree(piter) == i )
4662  {
4663  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4664  //nPrint( pcoeffs[i] );PrintS(" ");
4665  pIter( piter );
4666  }
4667  else
4668  {
4669  pcoeffs[i]= nInit(0);
4670  }
4671  }
4672 
4673 #ifdef mprDEBUG_PROT
4674  for (i=deg; i >= 0; i--)
4675  {
4676  nPrint( pcoeffs[i] );PrintS(" ");
4677  }
4678  PrintLn();
4679 #endif
4680 
4681  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4682  roots->solver( howclean );
4683 
4684  int elem= roots->getAnzRoots();
4685  char *dummy;
4686  int j;
4687 
4688  rlist= (lists)omAlloc( sizeof(slists) );
4689  rlist->Init( elem );
4690 
4692  {
4693  for ( j= 0; j < elem; j++ )
4694  {
4695  rlist->m[j].rtyp=NUMBER_CMD;
4696  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4697  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4698  }
4699  }
4700  else
4701  {
4702  for ( j= 0; j < elem; j++ )
4703  {
4704  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4705  rlist->m[j].rtyp=STRING_CMD;
4706  rlist->m[j].data=(void *)dummy;
4707  }
4708  }
4709 
4710  elist->Clean();
4711  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4712 
4713  // this is (via fillContainer) the same data as in root
4714  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4715  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4716 
4717  delete roots;
4718 
4719  res->rtyp= LIST_CMD;
4720  res->data= (void*)rlist;
4721 
4722  return FALSE;
4723 }
complex root finder for univariate polynomials based on laguers algorithm
Definition: mpr_numeric.h:65
sleftv * m
Definition: lists.h:45
void PrintLn()
Definition: reporter.cc:327
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:464
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:537
#define TRUE
Definition: auxiliary.h:144
bool solver(const int polishmode=PM_NONE)
Definition: mpr_numeric.cc:450
void WerrorS(const char *s)
Definition: feFopen.cc:24
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy ...
Definition: monomials.h:51
#define omAlloc(size)
Definition: omAllocDecl.h:210
#define nPrint(a)
only for debug, over any initalized currRing
Definition: numbers.h:46
void * data
Definition: subexpr.h:89
#define pIter(p)
Definition: monomials.h:44
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
int j
Definition: myNF.cc:70
static long pTotaldegree(poly p)
Definition: polys.h:253
#define pIsConstant(p)
like above, except that Comp might be != 0
Definition: polys.h:209
void fillContainer(number *_coeffs, number *_ievpoint, const int _var, const int _tdg, const rootType _rt, const int _anz)
Definition: mpr_numeric.cc:313
int i
Definition: cfEzgcd.cc:123
void PrintS(const char *s)
Definition: reporter.cc:294
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:458
gmp_complex * getRoot(const int i)
Definition: mpr_numeric.h:88
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:491
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int getAnzRoots()
Definition: mpr_numeric.h:97
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:488
int rtyp
Definition: subexpr.h:92
#define nCopy(n)
Definition: numbers.h:15
void Clean(ring r=currRing)
Definition: lists.h:25
void * Data()
Definition: subexpr.cc:1118
Definition: tok.h:120
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition: mpr_complex.cc:717
size_t gmp_output_digits
Definition: mpr_complex.cc:44
void setGMPFloatDigits(size_t digits, size_t rest)
Set size of mantissa digits - the number of output digits (basis 10) the size of mantissa consists of...
Definition: mpr_complex.cc:62
polyrec * poly
Definition: hilb.h:10
#define nInit(i)
Definition: numbers.h:24
BOOLEAN nuMPResMat ( leftv  res,
leftv  arg1,
leftv  arg2 
)

returns module representing the multipolynomial resultant matrix Arguments 2: ideal i, int k k=0: use sparse resultant matrix of Gelfand, Kapranov and Zelevinsky k=1: use resultant matrix of Macaulay (k=0 is default)

Definition at line 4570 of file ipshell.cc.

4571 {
4572  ideal gls = (ideal)(arg1->Data());
4573  int imtype= (int)(long)arg2->Data();
4574 
4575  uResultant::resMatType mtype= determineMType( imtype );
4576 
4577  // check input ideal ( = polynomial system )
4578  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4579  {
4580  return TRUE;
4581  }
4582 
4583  uResultant *resMat= new uResultant( gls, mtype, false );
4584  if (resMat!=NULL)
4585  {
4586  res->rtyp = MODUL_CMD;
4587  res->data= (void*)resMat->accessResMat()->getMatrix();
4588  if (!errorreported) delete resMat;
4589  }
4590  return errorreported;
4591 }
Base class for solving 0-dim poly systems using u-resultant.
Definition: mpr_base.h:62
resMatrixBase * accessResMat()
Definition: mpr_base.h:78
#define TRUE
Definition: auxiliary.h:144
uResultant::resMatType determineMType(int imtype)
const char * Name()
Definition: subexpr.h:121
Definition: mpr_base.h:98
void * data
Definition: subexpr.h:89
virtual ideal getMatrix()
Definition: mpr_base.h:31
mprState mprIdealCheck(const ideal theIdeal, const char *name, uResultant::resMatType mtype, BOOLEAN rmatrix=false)
short errorreported
Definition: feFopen.cc:23
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1118
BOOLEAN nuUResSolve ( leftv  res,
leftv  args 
)

solve a multipolynomial system using the u-resultant Input ideal must be 0-dimensional and (currRing->N) == IDELEMS(ideal).

Resultant method can be MPR_DENSE, which uses Macaulay Resultant (good for dense homogeneous polynoms) or MPR_SPARSE, which uses Sparse Resultant (Gelfand, Kapranov, Zelevinsky). Arguments 4: ideal i, int k, int l, int m k=0: use sparse resultant matrix of Gelfand, Kapranov and Zelevinsky k=1: use resultant matrix of Macaulay (k=0 is default) l>0: defines precision of fractional part if ground field is Q m=0,1,2: number of iterations for approximation of roots (default=2) Returns a list containing the roots of the system.

Definition at line 4826 of file ipshell.cc.

4827 {
4828  leftv v= args;
4829 
4830  ideal gls;
4831  int imtype;
4832  int howclean;
4833 
4834  // get ideal
4835  if ( v->Typ() != IDEAL_CMD )
4836  return TRUE;
4837  else gls= (ideal)(v->Data());
4838  v= v->next;
4839 
4840  // get resultant matrix type to use (0,1)
4841  if ( v->Typ() != INT_CMD )
4842  return TRUE;
4843  else imtype= (int)(long)v->Data();
4844  v= v->next;
4845 
4846  if (imtype==0)
4847  {
4848  ideal test_id=idInit(1,1);
4849  int j;
4850  for(j=IDELEMS(gls)-1;j>=0;j--)
4851  {
4852  if (gls->m[j]!=NULL)
4853  {
4854  test_id->m[0]=gls->m[j];
4855  intvec *dummy_w=id_QHomWeight(test_id, currRing);
4856  if (dummy_w!=NULL)
4857  {
4858  WerrorS("Newton polytope not of expected dimension");
4859  delete dummy_w;
4860  return TRUE;
4861  }
4862  }
4863  }
4864  }
4865 
4866  // get and set precision in digits ( > 0 )
4867  if ( v->Typ() != INT_CMD )
4868  return TRUE;
4869  else if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
4871  {
4872  unsigned long int ii=(unsigned long int)v->Data();
4873  setGMPFloatDigits( ii, ii );
4874  }
4875  v= v->next;
4876 
4877  // get interpolation steps (0,1,2)
4878  if ( v->Typ() != INT_CMD )
4879  return TRUE;
4880  else howclean= (int)(long)v->Data();
4881 
4882  uResultant::resMatType mtype= determineMType( imtype );
4883  int i,count;
4884  lists listofroots= NULL;
4885  number smv= NULL;
4886  BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;
4887 
4888  //emptylist= (lists)omAlloc( sizeof(slists) );
4889  //emptylist->Init( 0 );
4890 
4891  //res->rtyp = LIST_CMD;
4892  //res->data= (void *)emptylist;
4893 
4894  // check input ideal ( = polynomial system )
4895  if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
4896  {
4897  return TRUE;
4898  }
4899 
4900  uResultant * ures;
4901  rootContainer ** iproots;
4902  rootContainer ** muiproots;
4903  rootArranger * arranger;
4904 
4905  // main task 1: setup of resultant matrix
4906  ures= new uResultant( gls, mtype );
4907  if ( ures->accessResMat()->initState() != resMatrixBase::ready )
4908  {
4909  WerrorS("Error occurred during matrix setup!");
4910  return TRUE;
4911  }
4912 
4913  // if dense resultant, check if minor nonsingular
4914  if ( mtype == uResultant::denseResMat )
4915  {
4916  smv= ures->accessResMat()->getSubDet();
4917 #ifdef mprDEBUG_PROT
4918  PrintS("// Determinant of submatrix: ");nPrint(smv);PrintLn();
4919 #endif
4920  if ( nIsZero(smv) )
4921  {
4922  WerrorS("Unsuitable input ideal: Minor of resultant matrix is singular!");
4923  return TRUE;
4924  }
4925  }
4926 
4927  // main task 2: Interpolate specialized resultant polynomials
4928  if ( interpolate_det )
4929  iproots= ures->interpolateDenseSP( false, smv );
4930  else
4931  iproots= ures->specializeInU( false, smv );
4932 
4933  // main task 3: Interpolate specialized resultant polynomials
4934  if ( interpolate_det )
4935  muiproots= ures->interpolateDenseSP( true, smv );
4936  else
4937  muiproots= ures->specializeInU( true, smv );
4938 
4939 #ifdef mprDEBUG_PROT
4940  int c= iproots[0]->getAnzElems();
4941  for (i=0; i < c; i++) pWrite(iproots[i]->getPoly());
4942  c= muiproots[0]->getAnzElems();
4943  for (i=0; i < c; i++) pWrite(muiproots[i]->getPoly());
4944 #endif
4945 
4946  // main task 4: Compute roots of specialized polys and match them up
4947  arranger= new rootArranger( iproots, muiproots, howclean );
4948  arranger->solve_all();
4949 
4950  // get list of roots
4951  if ( arranger->success() )
4952  {
4953  arranger->arrange();
4954  listofroots= listOfRoots(arranger, gmp_output_digits );
4955  }
4956  else
4957  {
4958  WerrorS("Solver was unable to find any roots!");
4959  return TRUE;
4960  }
4961 
4962  // free everything
4963  count= iproots[0]->getAnzElems();
4964  for (i=0; i < count; i++) delete iproots[i];
4965  omFreeSize( (ADDRESS) iproots, count * sizeof(rootContainer*) );
4966  count= muiproots[0]->getAnzElems();
4967  for (i=0; i < count; i++) delete muiproots[i];
4968  omFreeSize( (ADDRESS) muiproots, count * sizeof(rootContainer*) );
4969 
4970  delete ures;
4971  delete arranger;
4972  nDelete( &smv );
4973 
4974  res->data= (void *)listofroots;
4975 
4976  //emptylist->Clean();
4977  // omFreeSize( (ADDRESS) emptylist, sizeof(slists) );
4978 
4979  return FALSE;
4980 }
int status int void size_t count
Definition: si_signals.h:59
complex root finder for univariate polynomials based on laguers algorithm
Definition: mpr_numeric.h:65
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
void PrintLn()
Definition: reporter.cc:327
Base class for solving 0-dim poly systems using u-resultant.
Definition: mpr_base.h:62
Definition: tok.h:98
Definition: lists.h:22
virtual IStateType initState() const
Definition: mpr_base.h:41
#define FALSE
Definition: auxiliary.h:140
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:464
resMatrixBase * accessResMat()
Definition: mpr_base.h:78
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * id_QHomWeight(ideal id, const ring r)
#define TRUE
Definition: auxiliary.h:144
uResultant::resMatType determineMType(int imtype)
void * ADDRESS
Definition: auxiliary.h:161
void pWrite(poly p)
Definition: polys.h:279
void WerrorS(const char *s)
Definition: feFopen.cc:24
int getAnzElems()
Definition: mpr_numeric.h:95
rootContainer ** specializeInU(BOOLEAN matchUp=false, const number subDetVal=NULL)
Definition: mpr_base.cc:3060
int Typ()
Definition: subexpr.cc:976
const char * Name()
Definition: subexpr.h:121
Definition: mpr_base.h:98
#define nPrint(a)
only for debug, over any initalized currRing
Definition: numbers.h:46
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
Definition: intvec.h:14
int j
Definition: myNF.cc:70
bool success()
Definition: mpr_numeric.h:162
void arrange()
Definition: mpr_numeric.cc:896
int i
Definition: cfEzgcd.cc:123
void PrintS(const char *s)
Definition: reporter.cc:294
void solve_all()
Definition: mpr_numeric.cc:871
#define IDELEMS(i)
Definition: simpleideals.h:24
mprState mprIdealCheck(const ideal theIdeal, const char *name, uResultant::resMatType mtype, BOOLEAN rmatrix=false)
rootContainer ** interpolateDenseSP(BOOLEAN matchUp=false, const number subDetVal=NULL)
Definition: mpr_base.cc:2922
#define nDelete(n)
Definition: numbers.h:16
leftv next
Definition: subexpr.h:87
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:491
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define nIsZero(n)
Definition: numbers.h:19
#define NULL
Definition: omList.c:10
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:488
void * Data()
Definition: subexpr.cc:1118
size_t gmp_output_digits
Definition: mpr_complex.cc:44
void setGMPFloatDigits(size_t digits, size_t rest)
Set size of mantissa digits - the number of output digits (basis 10) the size of mantissa consists of...
Definition: mpr_complex.cc:62
int BOOLEAN
Definition: auxiliary.h:131
lists listOfRoots(rootArranger *self, const unsigned int oprec)
Definition: ipshell.cc:4983
virtual number getSubDet()
Definition: mpr_base.h:37
BOOLEAN nuVanderSys ( leftv  res,
leftv  arg1,
leftv  arg2,
leftv  arg3 
)

COMPUTE: polynomial p with values given by v at points p1,..,pN derived from p; more precisely: consider p as point in K^n and v as N elements in K, let p1,..,pN be the points in K^n obtained by evaluating all monomials of degree 0,1,...,N at p in lexicographical order, then the procedure computes the polynomial f satisfying f(pi) = v[i] RETURN: polynomial f of degree d.

Definition at line 4725 of file ipshell.cc.

4726 {
4727  int i;
4728  ideal p,w;
4729  p= (ideal)arg1->Data();
4730  w= (ideal)arg2->Data();
4731 
4732  // w[0] = f(p^0)
4733  // w[1] = f(p^1)
4734  // ...
4735  // p can be a vector of numbers (multivariate polynom)
4736  // or one number (univariate polynom)
4737  // tdg = deg(f)
4738 
4739  int n= IDELEMS( p );
4740  int m= IDELEMS( w );
4741  int tdg= (int)(long)arg3->Data();
4742 
4743  res->data= (void*)NULL;
4744 
4745  // check the input
4746  if ( tdg < 1 )
4747  {
4748  WerrorS("Last input parameter must be > 0!");
4749  return TRUE;
4750  }
4751  if ( n != rVar(currRing) )
4752  {
4753  Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
4754  return TRUE;
4755  }
4756  if ( m != (int)pow((double)tdg+1,(double)n) )
4757  {
4758  Werror("Size of second input ideal must be equal to %d!",
4759  (int)pow((double)tdg+1,(double)n));
4760  return TRUE;
4761  }
4762  if ( !(rField_is_Q(currRing) /* ||
4763  rField_is_R() || rField_is_long_R() ||
4764  rField_is_long_C()*/ ) )
4765  {
4766  WerrorS("Ground field not implemented!");
4767  return TRUE;
4768  }
4769 
4770  number tmp;
4771  number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
4772  for ( i= 0; i < n; i++ )
4773  {
4774  pevpoint[i]=nInit(0);
4775  if ( (p->m)[i] )
4776  {
4777  tmp = pGetCoeff( (p->m)[i] );
4778  if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
4779  {
4780  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4781  WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
4782  return TRUE;
4783  }
4784  } else tmp= NULL;
4785  if ( !nIsZero(tmp) )
4786  {
4787  if ( !pIsConstant((p->m)[i]))
4788  {
4789  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4790  WerrorS("Elements of first input ideal must be numbers!");
4791  return TRUE;
4792  }
4793  pevpoint[i]= nCopy( tmp );
4794  }
4795  }
4796 
4797  number *wresults= (number *)omAlloc( m * sizeof( number ) );
4798  for ( i= 0; i < m; i++ )
4799  {
4800  wresults[i]= nInit(0);
4801  if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
4802  {
4803  if ( !pIsConstant((w->m)[i]))
4804  {
4805  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4806  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4807  WerrorS("Elements of second input ideal must be numbers!");
4808  return TRUE;
4809  }
4810  wresults[i]= nCopy(pGetCoeff((w->m)[i]));
4811  }
4812  }
4813 
4814  vandermonde vm( m, n, tdg, pevpoint, FALSE );
4815  number *ncpoly= vm.interpolateDense( wresults );
4816  // do not free ncpoly[]!!
4817  poly rpoly= vm.numvec2poly( ncpoly );
4818 
4819  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4820  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4821 
4822  res->data= (void*)rpoly;
4823  return FALSE;
4824 }
vandermonde system solver for interpolating polynomials from their values
Definition: mpr_numeric.h:28
#define FALSE
Definition: auxiliary.h:140
return P p
Definition: myNF.cc:203
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:537
#define TRUE
Definition: auxiliary.h:144
#define nIsOne(n)
Definition: numbers.h:25
void * ADDRESS
Definition: auxiliary.h:161
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define nIsMOne(n)
Definition: numbers.h:26
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy ...
Definition: monomials.h:51
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
int m
Definition: cfEzgcd.cc:119
#define pIsConstant(p)
like above, except that Comp might be != 0
Definition: polys.h:209
int i
Definition: cfEzgcd.cc:123
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:458
#define IDELEMS(i)
Definition: simpleideals.h:24
#define nIsZero(n)
Definition: numbers.h:19
#define NULL
Definition: omList.c:10
const CanonicalForm & w
Definition: facAbsFact.cc:55
#define nCopy(n)
Definition: numbers.h:15
void * Data()
Definition: subexpr.cc:1118
polyrec * poly
Definition: hilb.h:10
#define nInit(i)
Definition: numbers.h:24
Rational pow(const Rational &a, int e)
Definition: GMPrat.cc:418
void Werror(const char *fmt,...)
Definition: reporter.cc:199
void paPrint ( const char *  n,
package  p 
)

Definition at line 6261 of file ipshell.cc.

6262 {
6263  Print(" %s (",n);
6264  switch (p->language)
6265  {
6266  case LANG_SINGULAR: PrintS("S"); break;
6267  case LANG_C: PrintS("C"); break;
6268  case LANG_TOP: PrintS("T"); break;
6269  case LANG_NONE: PrintS("N"); break;
6270  default: PrintS("U");
6271  }
6272  if(p->libname!=NULL)
6273  Print(",%s", p->libname);
6274  PrintS(")");
6275 }
#define Print
Definition: emacs.cc:83
return P p
Definition: myNF.cc:203
Definition: subexpr.h:20
void PrintS(const char *s)
Definition: reporter.cc:294
#define NULL
Definition: omList.c:10
ring rCompose ( const lists  L,
const BOOLEAN  check_comp 
)

Definition at line 2717 of file ipshell.cc.

2718 {
2719  if ((L->nr!=3)
2720 #ifdef HAVE_PLURAL
2721  &&(L->nr!=5)
2722 #endif
2723  )
2724  return NULL;
2725  int is_gf_char=0;
2726  // 0: char/ cf - ring
2727  // 1: list (var)
2728  // 2: list (ord)
2729  // 3: qideal
2730  // possibly:
2731  // 4: C
2732  // 5: D
2733 
2734  ring R = (ring) omAlloc0Bin(sip_sring_bin);
2735 
2736  // ------------------------------------------------------------------
2737  // 0: char:
2738 #ifdef SINGULAR_4_1
2739  if (L->m[0].Typ()==CRING_CMD)
2740  {
2741  R->cf=(coeffs)L->m[0].Data();
2742  R->cf->ref++;
2743  }
2744  else
2745 #endif
2746  if (L->m[0].Typ()==INT_CMD)
2747  {
2748  int ch = (int)(long)L->m[0].Data();
2749  assume( ch >= 0 );
2750 
2751  if (ch == 0) // Q?
2752  R->cf = nInitChar(n_Q, NULL);
2753  else
2754  {
2755  int l = IsPrime(ch); // Zp?
2756  if( l != ch )
2757  {
2758  Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
2759  ch = l;
2760  }
2761  R->cf = nInitChar(n_Zp, (void*)(long)ch);
2762  }
2763  }
2764  else if (L->m[0].Typ()==LIST_CMD) // something complicated...
2765  {
2766  lists LL=(lists)L->m[0].Data();
2767 
2768 #ifdef HAVE_RINGS
2769  if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
2770  {
2771  rComposeRing(LL, R); // Ring!?
2772  }
2773  else
2774 #endif
2775  if (LL->nr < 3)
2776  rComposeC(LL,R); // R, long_R, long_C
2777  else
2778  {
2779  if (LL->m[0].Typ()==INT_CMD)
2780  {
2781  int ch = (int)(long)LL->m[0].Data();
2782  while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
2783  if (fftable[is_gf_char]==0) is_gf_char=-1;
2784 
2785  if(is_gf_char!= -1)
2786  {
2787  GFInfo param;
2788 
2789  param.GFChar = ch;
2790  param.GFDegree = 1;
2791  param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
2792 
2793  // nfInitChar should be able to handle the case when ch is in fftables!
2794  R->cf = nInitChar(n_GF, (void*)&param);
2795  }
2796  }
2797 
2798  if( R->cf == NULL )
2799  {
2800  ring extRing = rCompose((lists)L->m[0].Data(),FALSE);
2801 
2802  if (extRing==NULL)
2803  {
2804  WerrorS("could not create the specified coefficient field");
2805  goto rCompose_err;
2806  }
2807 
2808  if( extRing->qideal != NULL ) // Algebraic extension
2809  {
2810  AlgExtInfo extParam;
2811 
2812  extParam.r = extRing;
2813 
2814  R->cf = nInitChar(n_algExt, (void*)&extParam);
2815  }
2816  else // Transcendental extension
2817  {
2818  TransExtInfo extParam;
2819  extParam.r = extRing;
2820  assume( extRing->qideal == NULL );
2821 
2822  R->cf = nInitChar(n_transExt, &extParam);
2823  }
2824  }
2825  }
2826  }
2827  else
2828  {
2829  WerrorS("coefficient field must be described by `int` or `list`");
2830  goto rCompose_err;
2831  }
2832 
2833  if( R->cf == NULL )
2834  {
2835  WerrorS("could not create coefficient field described by the input!");
2836  goto rCompose_err;
2837  }
2838 
2839  // ------------------------- VARS ---------------------------
2840  if (rComposeVar(L,R)) goto rCompose_err;
2841  // ------------------------ ORDER ------------------------------
2842  if (rComposeOrder(L,check_comp,R)) goto rCompose_err;
2843 
2844  // ------------------------ ??????? --------------------
2845 
2846  rRenameVars(R);
2847  rComplete(R);
2848 
2849  // ------------------------ Q-IDEAL ------------------------
2850 
2851  if (L->m[3].Typ()==IDEAL_CMD)
2852  {
2853  ideal q=(ideal)L->m[3].Data();
2854  if (q->m[0]!=NULL)
2855  {
2856  if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
2857  {
2858  #if 0
2859  WerrorS("coefficient fields must be equal if q-ideal !=0");
2860  goto rCompose_err;
2861  #else
2862  ring orig_ring=currRing;
2863  rChangeCurrRing(R);
2864  int *perm=NULL;
2865  int *par_perm=NULL;
2866  int par_perm_size=0;
2867  nMapFunc nMap;
2868 
2869  if ((nMap=nSetMap(orig_ring->cf))==NULL)
2870  {
2871  if (rEqual(orig_ring,currRing))
2872  {
2873  nMap=n_SetMap(currRing->cf, currRing->cf);
2874  }
2875  else
2876  // Allow imap/fetch to be make an exception only for:
2877  if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2880  ||
2881  (rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
2882  (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
2883  rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
2884  {
2885  par_perm_size=rPar(orig_ring);
2886 
2887 // if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
2888 // naSetChar(rInternalChar(orig_ring),orig_ring);
2889 // else ntSetChar(rInternalChar(orig_ring),orig_ring);
2890 
2891  nSetChar(currRing->cf);
2892  }
2893  else
2894  {
2895  WerrorS("coefficient fields must be equal if q-ideal !=0");
2896  goto rCompose_err;
2897  }
2898  }
2899  perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
2900  if (par_perm_size!=0)
2901  par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2902  int i;
2903  #if 0
2904  // use imap:
2905  maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
2906  currRing->names,currRing->N,currRing->parameter, currRing->P,
2907  perm,par_perm, currRing->ch);
2908  #else
2909  // use fetch
2910  if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
2911  {
2912  for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
2913  }
2914  else if (par_perm_size!=0)
2915  for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2916  for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
2917  #endif
2918  ideal dest_id=idInit(IDELEMS(q),1);
2919  for(i=IDELEMS(q)-1; i>=0; i--)
2920  {
2921  dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
2922  par_perm,par_perm_size);
2923  // PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
2924  pTest(dest_id->m[i]);
2925  }
2926  R->qideal=dest_id;
2927  if (perm!=NULL)
2928  omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
2929  if (par_perm!=NULL)
2930  omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2931  rChangeCurrRing(orig_ring);
2932  #endif
2933  }
2934  else
2935  R->qideal=idrCopyR(q,currRing,R);
2936  }
2937  }
2938  else
2939  {
2940  WerrorS("q-ideal must be given as `ideal`");
2941  goto rCompose_err;
2942  }
2943 
2944 
2945  // ---------------------------------------------------------------
2946  #ifdef HAVE_PLURAL
2947  if (L->nr==5)
2948  {
2949  if (nc_CallPlural((matrix)L->m[4].Data(),
2950  (matrix)L->m[5].Data(),
2951  NULL,NULL,
2952  R,
2953  true, // !!!
2954  true, false,
2955  currRing, FALSE)) goto rCompose_err;
2956  // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
2957  }
2958  #endif
2959  return R;
2960 
2961 rCompose_err:
2962  if (R->N>0)
2963  {
2964  int i;
2965  if (R->names!=NULL)
2966  {
2967  i=R->N-1;
2968  while (i>=0) { if (R->names[i]!=NULL) omFree(R->names[i]); i--; }
2969  omFree(R->names);
2970  }
2971  }
2972  if (R->order!=NULL) omFree(R->order);
2973  if (R->block0!=NULL) omFree(R->block0);
2974  if (R->block1!=NULL) omFree(R->block1);
2975  if (R->wvhdl!=NULL) omFree(R->wvhdl);
2976  omFree(R);
2977  return NULL;
2978 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:98
ring r
Definition: algext.h:40
static BOOLEAN rField_is_Zp_a(const ring r)
Definition: ring.h:475
static BOOLEAN rComposeVar(const lists L, ring R)
Definition: ipshell.cc:2422
Definition: lists.h:22
ring rCompose(const lists L, const BOOLEAN check_comp)
Definition: ipshell.cc:2717
used for all transcendental extensions, i.e., the top-most extension in an extension tower is transce...
Definition: coeffs.h:38
static int si_min(const int a, const int b)
Definition: auxiliary.h:167
#define FALSE
Definition: auxiliary.h:140
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:544
#define pTest(p)
Definition: polys.h:387
static FORCE_INLINE void nSetChar(const coeffs r)
initialisations after each ring change
Definition: coeffs.h:437
rational (GMP) numbers
Definition: coeffs.h:31
const char * GFPar_name
Definition: coeffs.h:95
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
{p < 2^31}
Definition: coeffs.h:30
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:537
static BOOLEAN rField_is_Q_a(const ring r)
Definition: ring.h:485
void * ADDRESS
Definition: auxiliary.h:161
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:976
void rComposeC(lists L, ring R)
Definition: ipshell.cc:2217
Creation data needed for finite fields.
Definition: coeffs.h:91
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
Definition: tok.h:59
poly p_PermPoly(poly p, const int *perm, const ring oldRing, const ring dst, nMapFunc nMap, const int *par_perm, int OldPar, BOOLEAN use_mult)
Definition: p_polys.cc:3937
static BOOLEAN rComposeOrder(const lists L, const BOOLEAN check_comp, ring R)
Definition: ipshell.cc:2467
BOOLEAN rComplete(ring r, int force)
this needs to be called whenever a new ring is created: new fields in ring are created (like VarOffse...
Definition: ring.cc:3436
#define omFree(addr)
Definition: omAllocDecl.h:261
#define assume(x)
Definition: mod2.h:405
The main handler for Singular numbers which are suitable for Singular polynomials.
int GFDegree
Definition: coeffs.h:94
number(* nMapFunc)(number a, const coeffs src, const coeffs dst)
maps "a", which lives in src, into dst
Definition: coeffs.h:72
const ring R
Definition: DebugPrint.cc:36
ip_smatrix * matrix
omBin sip_sring_bin
Definition: ring.cc:54
const unsigned short fftable[]
Definition: ffields.cc:61
struct for passing initialization parameters to naInitChar
Definition: transext.h:92
int i
Definition: cfEzgcd.cc:123
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:458
int IsPrime(int p)
Definition: prime.cc:61
#define IDELEMS(i)
Definition: simpleideals.h:24
BOOLEAN rEqual(ring r1, ring r2, BOOLEAN qr)
returns TRUE, if r1 equals r2 FALSE, otherwise Equality is determined componentwise, if qr == 1, then qrideal equality is tested, as well
Definition: ring.cc:1633
static FORCE_INLINE nMapFunc n_SetMap(const coeffs src, const coeffs dst)
set the mapping function pointers for translating numbers from src to dst
Definition: coeffs.h:722
static void rRenameVars(ring R)
Definition: ipshell.cc:2381
void rChangeCurrRing(ring r)
Definition: polys.cc:14
static BOOLEAN rField_is_Zp(const ring r)
Definition: ring.h:452
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
int GFChar
Definition: coeffs.h:93
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
BOOLEAN nc_CallPlural(matrix cc, matrix dd, poly cn, poly dn, ring r, bool bSetupQuotient, bool bCopyInput, bool bBeQuiet, ring curr, bool dummy_ring=false)
returns TRUE if there were errors analyze inputs, check them for consistency detects nc_type...
Definition: old.gring.cc:2747
int nr
Definition: lists.h:43
void maFindPerm(char const *const *const preim_names, int preim_n, char const *const *const preim_par, int preim_p, char const *const *const names, int n, char const *const *const par, int nop, int *perm, int *par_perm, n_coeffType ch)
Definition: maps.cc:169
void rComposeRing(lists L, ring R)
Definition: ipshell.cc:2288
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
{p^n < 2^16}
Definition: coeffs.h:33
struct for passing initialization parameters to naInitChar
Definition: algext.h:40
used for all algebraic extensions, i.e., the top-most extension in an extension tower is algebraic ...
Definition: coeffs.h:35
void * Data()
Definition: subexpr.cc:1118
#define nSetMap(R)
Definition: numbers.h:43
ideal idrCopyR(ideal id, ring src_r, ring dest_r)
Definition: prCopy.cc:193
static int rInternalChar(const ring r)
Definition: ring.h:634
Definition: tok.h:120
int perm[100]
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:94
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:327
#define Warn
Definition: emacs.cc:80
void rComposeC ( lists  L,
ring  R 
)

Definition at line 2217 of file ipshell.cc.

2219 {
2220  // ----------------------------------------
2221  // 0: char/ cf - ring
2222  if ((L->m[0].rtyp!=INT_CMD) || (L->m[0].data!=(char *)0))
2223  {
2224  Werror("invald coeff. field description, expecting 0");
2225  return;
2226  }
2227 // R->cf->ch=0;
2228  // ----------------------------------------
2229  // 1:
2230  if (L->m[1].rtyp!=LIST_CMD)
2231  {
2232  Werror("invald coeff. field description, expecting precision list");
2233  return;
2234  }
2235  lists LL=(lists)L->m[1].data;
2236  if (((LL->nr!=2)
2237  || (LL->m[0].rtyp!=INT_CMD)
2238  || (LL->m[1].rtyp!=INT_CMD))
2239  && ((LL->nr!=1)
2240  || (LL->m[0].rtyp!=INT_CMD)))
2241  {
2242  Werror("invald coeff. field description list");
2243  return;
2244  }
2245  int r1=(int)(long)LL->m[0].data;
2246  int r2=(int)(long)LL->m[1].data;
2247  if (L->nr==2) // complex
2248  R->cf = nInitChar(n_long_C, NULL);
2249  else if ((r1<=SHORT_REAL_LENGTH)
2250  && (r2=SHORT_REAL_LENGTH))
2251  R->cf = nInitChar(n_R, NULL);
2252  else
2253  {
2255  p->float_len=r1;
2256  p->float_len2=r2;
2257  R->cf = nInitChar(n_long_R, NULL);
2258  }
2259 
2260  if ((r1<=SHORT_REAL_LENGTH) // should go into nInitChar
2261  && (r2=SHORT_REAL_LENGTH))
2262  {
2263  R->cf->float_len=SHORT_REAL_LENGTH/2;
2264  R->cf->float_len2=SHORT_REAL_LENGTH;
2265  }
2266  else
2267  {
2268  R->cf->float_len=si_min(r1,32767);
2269  R->cf->float_len2=si_min(r2,32767);
2270  }
2271  // ----------------------------------------
2272  // 2: list (par)
2273  if (L->nr==2)
2274  {
2275  //R->cf->extRing->N=1;
2276  if (L->m[2].rtyp!=STRING_CMD)
2277  {
2278  Werror("invald coeff. field description, expecting parameter name");
2279  return;
2280  }
2281  //(rParameter(R))=(char**)omAlloc0(rPar(R)*sizeof(char_ptr));
2282  rParameter(R)[0]=omStrDup((char *)L->m[2].data);
2283  }
2284  // ----------------------------------------
2285 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:98
#define SHORT_REAL_LENGTH
Definition: numbers.h:54
Definition: lists.h:22
if(0 > strat->sl)
Definition: myNF.cc:73
static int si_min(const int a, const int b)
Definition: auxiliary.h:167
return P p
Definition: myNF.cc:203
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:570
real floating point (GMP) numbers
Definition: coeffs.h:34
short float_len2
additional char-flags, rInit
Definition: coeffs.h:101
void * data
Definition: subexpr.h:89
single prescision (6,6) real numbers
Definition: coeffs.h:32
short float_len
additional char-flags, rInit
Definition: coeffs.h:100
const ring R
Definition: DebugPrint.cc:36
complex floating point (GMP) numbers
Definition: coeffs.h:41
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
Definition: tok.h:120
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define omAlloc0(size)
Definition: omAllocDecl.h:211
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:327
#define omStrDup(s)
Definition: omAllocDecl.h:263
static BOOLEAN rComposeOrder ( const lists  L,
const BOOLEAN  check_comp,
ring  R 
)
inlinestatic

Definition at line 2467 of file ipshell.cc.

2468 {
2469  assume(R!=NULL);
2470  long bitmask=0L;
2471  if (L->m[2].Typ()==LIST_CMD)
2472  {
2473  lists v=(lists)L->m[2].Data();
2474  int n= v->nr+2;
2475  int j_in_R,j_in_L;
2476  // do we have an entry "L",... ?: set bitmask
2477  for (int j=0; j < n-1; j++)
2478  {
2479  if (v->m[j].Typ()==LIST_CMD)
2480  {
2481  lists vv=(lists)v->m[j].Data();
2482  if ((vv->nr==1)
2483  &&(vv->m[0].Typ()==STRING_CMD)
2484  &&(strcmp((char*)vv->m[0].Data(),"L")==0))
2485  {
2486  number nn=(number)vv->m[1].Data();
2487  if (vv->m[1].Typ()==BIGINT_CMD)
2488  bitmask=n_Int(nn,coeffs_BIGINT);
2489  else if (vv->m[1].Typ()==INT_CMD)
2490  bitmask=(long)nn;
2491  else
2492  {
2493  Werror("illegal argument for pseudo ordering L: %d",vv->m[1].Typ());
2494  return TRUE;
2495  }
2496  break;
2497  }
2498  }
2499  }
2500  if (bitmask!=0) n--;
2501 
2502  // initialize fields of R
2503  R->order=(int *)omAlloc0(n*sizeof(int));
2504  R->block0=(int *)omAlloc0(n*sizeof(int));
2505  R->block1=(int *)omAlloc0(n*sizeof(int));
2506  R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr));
2507  // init order, so that rBlocks works correctly
2508  for (j_in_R= n-2; j_in_R>=0; j_in_R--)
2509  R->order[j_in_R] = (int) ringorder_unspec;
2510  // orderings
2511  for(j_in_R=0,j_in_L=0;j_in_R<n-1;j_in_R++,j_in_L++)
2512  {
2513  // todo: a(..), M
2514  if (v->m[j_in_L].Typ()!=LIST_CMD)
2515  {
2516  WerrorS("ordering must be list of lists");
2517  return TRUE;
2518  }
2519  lists vv=(lists)v->m[j_in_L].Data();
2520  if ((vv->nr==1)
2521  && (vv->m[0].Typ()==STRING_CMD))
2522  {
2523  if (strcmp((char*)vv->m[0].Data(),"L")==0)
2524  {
2525  j_in_R--;
2526  continue;
2527  }
2528  if ((vv->m[1].Typ()!=INTVEC_CMD) && (vv->m[1].Typ()!=INT_CMD))
2529  {
2530  PrintS(lString(vv));
2531  WerrorS("ordering name must be a (string,intvec)(1)");
2532  return TRUE;
2533  }
2534  R->order[j_in_R]=rOrderName(omStrDup((char*)vv->m[0].Data())); // assume STRING
2535 
2536  if (j_in_R==0) R->block0[0]=1;
2537  else
2538  {
2539  int jj=j_in_R-1;
2540  while((jj>=0)
2541  && ((R->order[jj]== ringorder_a)
2542  || (R->order[jj]== ringorder_aa)
2543  || (R->order[jj]== ringorder_am)
2544  || (R->order[jj]== ringorder_c)
2545  || (R->order[jj]== ringorder_C)
2546  || (R->order[jj]== ringorder_s)
2547  || (R->order[jj]== ringorder_S)
2548  ))
2549  {
2550  //Print("jj=%, skip %s\n",rSimpleOrdStr(R->order[jj]));
2551  jj--;
2552  }
2553  if (jj<0) R->block0[j_in_R]=1;
2554  else R->block0[j_in_R]=R->block1[jj]+1;
2555  }
2556  intvec *iv;
2557  if (vv->m[1].Typ()==INT_CMD)
2558  iv=new intvec((int)(long)vv->m[1].Data(),(int)(long)vv->m[1].Data());
2559  else
2560  iv=ivCopy((intvec*)vv->m[1].Data()); //assume INTVEC
2561  int iv_len=iv->length();
2562  R->block1[j_in_R]=si_max(R->block0[j_in_R],R->block0[j_in_R]+iv_len-1);
2563  if (R->block1[j_in_R]>R->N)
2564  {
2565  R->block1[j_in_R]=R->N;
2566  iv_len=R->block1[j_in_R]-R->block0[j_in_R]+1;
2567  }
2568  //Print("block %d from %d to %d\n",j,R->block0[j], R->block1[j]);
2569  int i;
2570  switch (R->order[j_in_R])
2571  {
2572  case ringorder_ws:
2573  case ringorder_Ws:
2574  R->OrdSgn=-1;
2575  case ringorder_aa:
2576  case ringorder_a:
2577  case ringorder_wp:
2578  case ringorder_Wp:
2579  R->wvhdl[j_in_R] =( int *)omAlloc(iv_len*sizeof(int));
2580  for (i=0; i<iv_len;i++)
2581  {
2582  R->wvhdl[j_in_R][i]=(*iv)[i];
2583  }
2584  break;
2585  case ringorder_am:
2586  R->wvhdl[j_in_R] =( int *)omAlloc((iv->length()+1)*sizeof(int));
2587  for (i=0; i<iv_len;i++)
2588  {
2589  R->wvhdl[j_in_R][i]=(*iv)[i];
2590  }
2591  R->wvhdl[j_in_R][i]=iv->length() - iv_len;
2592  //printf("ivlen:%d,iv->len:%d,mod:%d\n",iv_len,iv->length(),R->wvhdl[j][i]);
2593  for (; i<iv->length(); i++)
2594  {
2595  R->wvhdl[j_in_R][i+1]=(*iv)[i];
2596  }
2597  break;
2598  case ringorder_M:
2599  R->wvhdl[j_in_R] =( int *)omAlloc((iv->length())*sizeof(int));
2600  for (i=0; i<iv->length();i++) R->wvhdl[j_in_R][i]=(*iv)[i];
2601  R->block1[j_in_R]=si_max(R->block0[j_in_R],R->block0[j_in_R]+(int)sqrt((double)(iv->length()-1)));
2602  if (R->block1[j_in_R]>R->N)
2603  {
2604  WerrorS("ordering matrix too big");
2605  return TRUE;
2606  }
2607  break;
2608  case ringorder_ls:
2609  case ringorder_ds:
2610  case ringorder_Ds:
2611  case ringorder_rs:
2612  R->OrdSgn=-1;
2613  case ringorder_lp:
2614  case ringorder_dp:
2615  case ringorder_Dp:
2616  case ringorder_rp:
2617  break;
2618  case ringorder_S:
2619  break;
2620  case ringorder_c:
2621  case ringorder_C:
2622  R->block1[j_in_R]=R->block0[j_in_R]=0;
2623  break;
2624 
2625  case ringorder_s:
2626  break;
2627 
2628  case ringorder_IS:
2629  {
2630  R->block1[j_in_R] = R->block0[j_in_R] = 0;
2631  if( iv->length() > 0 )
2632  {
2633  const int s = (*iv)[0];
2634  assume( -2 < s && s < 2 );
2635  R->block1[j_in_R] = R->block0[j_in_R] = s;
2636  }
2637  break;
2638  }
2639  case 0:
2640  case ringorder_unspec:
2641  break;
2642  }
2643  delete iv;
2644  }
2645  else
2646  {
2647  PrintS(lString(vv));
2648  WerrorS("ordering name must be a (string,intvec)");
2649  return TRUE;
2650  }
2651  }
2652  // sanity check
2653  j_in_R=n-2;
2654  if ((R->order[j_in_R]==ringorder_c)
2655  || (R->order[j_in_R]==ringorder_C)
2656  || (R->order[j_in_R]==ringorder_unspec)) j_in_R--;
2657  if (R->block1[j_in_R] != R->N)
2658  {
2659  if (((R->order[j_in_R]==ringorder_dp) ||
2660  (R->order[j_in_R]==ringorder_ds) ||
2661  (R->order[j_in_R]==ringorder_Dp) ||
2662  (R->order[j_in_R]==ringorder_Ds) ||
2663  (R->order[j_in_R]==ringorder_rp) ||
2664  (R->order[j_in_R]==ringorder_rs) ||
2665  (R->order[j_in_R]==ringorder_lp) ||
2666  (R->order[j_in_R]==ringorder_ls))
2667  &&
2668  R->block0[j_in_R] <= R->N)
2669  {
2670  R->block1[j_in_R] = R->N;
2671  }
2672  else
2673  {
2674  Werror("ordering incomplete: size (%d) should be %d",R->block1[j_in_R],R->N);
2675  return TRUE;
2676  }
2677  }
2678  if (R->block0[j_in_R]>R->N)
2679  {
2680  Werror("not enough variables (%d) for ordering block %d, scanned so far:",R->N,j_in_R+1);
2681  for(int ii=0;ii<=j_in_R;ii++)
2682  Werror("ord[%d]: %s from v%d to v%d",ii+1,rSimpleOrdStr(R->order[ii]),R->block0[ii],R->block1[ii]);
2683  return TRUE;
2684  }
2685  if (check_comp)
2686  {
2687  BOOLEAN comp_order=FALSE;
2688  int jj;
2689  for(jj=0;jj<n;jj++)
2690  {
2691  if ((R->order[jj]==ringorder_c) ||
2692  (R->order[jj]==ringorder_C)) { comp_order=TRUE; break; }
2693  }
2694  if (!comp_order)
2695  {
2696  R->order=(int*)omRealloc0Size(R->order,n*sizeof(int),(n+1)*sizeof(int));
2697  R->block0=(int*)omRealloc0Size(R->block0,n*sizeof(int),(n+1)*sizeof(int));
2698  R->block1=(int*)omRealloc0Size(R->block1,n*sizeof(int),(n+1)*sizeof(int));
2699  R->wvhdl=(int**)omRealloc0Size(R->wvhdl,n*sizeof(int_ptr),(n+1)*sizeof(int_ptr));
2700  R->order[n-1]=ringorder_C;
2701  R->block0[n-1]=0;
2702  R->block1[n-1]=0;
2703  R->wvhdl[n-1]=NULL;
2704  n++;
2705  }
2706  }
2707  }
2708  else
2709  {
2710  WerrorS("ordering must be given as `list`");
2711  return TRUE;
2712  }
2713  if (bitmask!=0) R->bitmask=bitmask*2;
2714  return FALSE;
2715 }
for idElimination, like a, except pFDeg, pWeigths ignore it
Definition: ring.h:690
#define omRealloc0Size(addr, o_size, size)
Definition: omAllocDecl.h:221
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:45
Definition: tok.h:98
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
Definition: tok.h:42
opposite of ls
Definition: ring.h:691
intvec * ivCopy(const intvec *o)
Definition: intvec.h:126
#define TRUE
Definition: auxiliary.h:144
int length() const
Definition: intvec.h:86
void WerrorS(const char *s)
Definition: feFopen.cc:24
char * lString(lists l, BOOLEAN typed, int dim)
Definition: lists.cc:377
coeffs coeffs_BIGINT
Definition: ipid.cc:54
int Typ()
Definition: subexpr.cc:976
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: intvec.h:14
static FORCE_INLINE long n_Int(number &n, const coeffs r)
conversion of n to an int; 0 if not possible in Z/pZ: the representing int lying in (-p/2 ...
Definition: coeffs.h:548
int j
Definition: myNF.cc:70
#define assume(x)
Definition: mod2.h:405
const ring R
Definition: DebugPrint.cc:36
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:88
gmp_float sqrt(const gmp_float &a)
Definition: mpr_complex.cc:329
int rOrderName(char *ordername)
Definition: ring.cc:508
static int si_max(const int a, const int b)
Definition: auxiliary.h:166
int i
Definition: cfEzgcd.cc:123
Induced (Schreyer) ordering.
Definition: ring.h:692
void PrintS(const char *s)
Definition: reporter.cc:294
S?
Definition: ring.h:674
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
void * Data()
Definition: subexpr.cc:1118
Definition: tok.h:120
int * int_ptr
Definition: structs.h:57
int BOOLEAN
Definition: auxiliary.h:131
s?
Definition: ring.h:675
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define omAlloc0(size)
Definition: omAllocDecl.h:211
#define omStrDup(s)
Definition: omAllocDecl.h:263
void rComposeRing ( lists  L,
ring  R 
)

Definition at line 2288 of file ipshell.cc.

2290 {
2291  // ----------------------------------------
2292  // 0: string: integer
2293  // no further entries --> Z
2294  mpz_ptr modBase = NULL;
2295  unsigned int modExponent = 1;
2296 
2297  modBase = (mpz_ptr) omAlloc(sizeof(mpz_t));
2298  if (L->nr == 0)
2299  {
2300  mpz_init_set_ui(modBase,0);
2301  modExponent = 1;
2302  }
2303  // ----------------------------------------
2304  // 1:
2305  else
2306  {
2307  if (L->m[1].rtyp!=LIST_CMD) Werror("invald data, expecting list of numbers");
2308  lists LL=(lists)L->m[1].data;
2309  if ((LL->nr >= 0) && LL->m[0].rtyp == BIGINT_CMD)
2310  {
2311  number tmp= (number) LL->m[0].data; // never use CopyD() on list elements
2312  // assume that tmp is integer, not rational
2313  n_MPZ (modBase, tmp, coeffs_BIGINT);
2314  }
2315  else if (LL->nr >= 0 && LL->m[0].rtyp == INT_CMD)
2316  {
2317  mpz_init_set_ui(modBase,(unsigned long) LL->m[0].data);
2318  }
2319  else
2320  {
2321  mpz_init_set_ui(modBase,0);
2322  }
2323  if (LL->nr >= 1)
2324  {
2325  modExponent = (unsigned long) LL->m[1].data;
2326  }
2327  else
2328  {
2329  modExponent = 1;
2330  }
2331  }
2332  // ----------------------------------------
2333  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_cmp_ui(modBase, 0) < 0))
2334  {
2335  Werror("Wrong ground ring specification (module is 1)");
2336  return;
2337  }
2338  if (modExponent < 1)
2339  {
2340  Werror("Wrong ground ring specification (exponent smaller than 1");
2341  return;
2342  }
2343  // module is 0 ---> integers
2344  if (mpz_cmp_ui(modBase, 0) == 0)
2345  {
2346  R->cf=nInitChar(n_Z,NULL);
2347  }
2348  // we have an exponent
2349  else if (modExponent > 1)
2350  {
2351  //R->cf->ch = R->cf->modExponent;
2352  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
2353  {
2354  /* this branch should be active for modExponent = 2..32 resp. 2..64,
2355  depending on the size of a long on the respective platform */
2356  R->cf=nInitChar(n_Z2m,(void*)(long)modExponent); // Use Z/2^ch
2357  omFreeSize (modBase, sizeof(mpz_t));
2358  }
2359  else
2360  {
2361  //ringtype 3
2362  ZnmInfo info;
2363  info.base= modBase;
2364  info.exp= modExponent;
2365  R->cf=nInitChar(n_Znm,(void*) &info);
2366  }
2367  }
2368  // just a module m > 1
2369  else
2370  {
2371  //ringtype = 2;
2372  //const int ch = mpz_get_ui(modBase);
2373  ZnmInfo info;
2374  info.base= modBase;
2375  info.exp= modExponent;
2376  R->cf=nInitChar(n_Zn,(void*) &info);
2377  }
2378 }
mpz_ptr base
Definition: rmodulon.h:18
sleftv * m
Definition: lists.h:45
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:43
Definition: tok.h:98
Definition: lists.h:22
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:45
if(0 > strat->sl)
Definition: myNF.cc:73
Definition: tok.h:42
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
coeffs coeffs_BIGINT
Definition: ipid.cc:54
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:89
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:44
const ExtensionInfo & info
< [in] sqrfree poly
const ring R
Definition: DebugPrint.cc:36
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:42
unsigned long exp
Definition: rmodulon.h:18
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
Definition: tok.h:120
void Werror(const char *fmt,...)
Definition: reporter.cc:199
static FORCE_INLINE void n_MPZ(mpz_t result, number &n, const coeffs r)
conversion of n to a GMP integer; 0 if not possible
Definition: coeffs.h:552
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:327
static BOOLEAN rComposeVar ( const lists  L,
ring  R 
)
inlinestatic

Definition at line 2422 of file ipshell.cc.

2423 {
2424  assume(R!=NULL);
2425  if (L->m[1].Typ()==LIST_CMD)
2426  {
2427  lists v=(lists)L->m[1].Data();
2428  R->N = v->nr+1;
2429  if (R->N<=0)
2430  {
2431  WerrorS("no ring variables");
2432  return TRUE;
2433  }
2434  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
2435  int i;
2436  for(i=0;i<R->N;i++)
2437  {
2438  if (v->m[i].Typ()==STRING_CMD)
2439  R->names[i]=omStrDup((char *)v->m[i].Data());
2440  else if (v->m[i].Typ()==POLY_CMD)
2441  {
2442  poly p=(poly)v->m[i].Data();
2443  int nr=pIsPurePower(p);
2444  if (nr>0)
2445  R->names[i]=omStrDup(currRing->names[nr-1]);
2446  else
2447  {
2448  Werror("var name %d must be a string or a ring variable",i+1);
2449  return TRUE;
2450  }
2451  }
2452  else
2453  {
2454  Werror("var name %d must be `string`",i+1);
2455  return TRUE;
2456  }
2457  }
2458  }
2459  else
2460  {
2461  WerrorS("variable must be given as `list`");
2462  return TRUE;
2463  }
2464  return FALSE;
2465 }
#define pIsPurePower(p)
Definition: polys.h:219
sleftv * m
Definition: lists.h:45
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
return P p
Definition: myNF.cc:203
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:976
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
char * char_ptr
Definition: structs.h:56
#define assume(x)
Definition: mod2.h:405
const ring R
Definition: DebugPrint.cc:36
int i
Definition: cfEzgcd.cc:123
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
void * Data()
Definition: subexpr.cc:1118
Definition: tok.h:120
polyrec * poly
Definition: hilb.h:10
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define omAlloc0(size)
Definition: omAllocDecl.h:211
#define omStrDup(s)
Definition: omAllocDecl.h:263
lists rDecompose ( const ring  r)

Definition at line 2030 of file ipshell.cc.

2031 {
2032  assume( r != NULL );
2033  const coeffs C = r->cf;
2034  assume( C != NULL );
2035 
2036  // sanity check: require currRing==r for rings with polynomial data
2037  if ( (r!=currRing) && (
2038  (nCoeff_is_algExt(C) && (C != currRing->cf))
2039  || (r->qideal != NULL)
2040 #ifdef HAVE_PLURAL
2041  || (rIsPluralRing(r))
2042 #endif
2043  )
2044  )
2045  {
2046  WerrorS("ring with polynomial data must be the base ring or compatible");
2047  return NULL;
2048  }
2049  // 0: char/ cf - ring
2050  // 1: list (var)
2051  // 2: list (ord)
2052  // 3: qideal
2053  // possibly:
2054  // 4: C
2055  // 5: D
2057  if (rIsPluralRing(r))
2058  L->Init(6);
2059  else
2060  L->Init(4);
2061  // ----------------------------------------
2062  // 0: char/ cf - ring
2063  if (rField_is_numeric(r))
2064  {
2065  rDecomposeC(&(L->m[0]),r);
2066  }
2067 #ifdef HAVE_RINGS
2068  else if (rField_is_Ring(r))
2069  {
2070  rDecomposeRing(&(L->m[0]),r);
2071  }
2072 #endif
2073  else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2074  {
2075  rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2076  }
2077  else if(rField_is_GF(r))
2078  {
2080  Lc->Init(4);
2081  // char:
2082  Lc->m[0].rtyp=INT_CMD;
2083  Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2084  // var:
2086  Lv->Init(1);
2087  Lv->m[0].rtyp=STRING_CMD;
2088  Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2089  Lc->m[1].rtyp=LIST_CMD;
2090  Lc->m[1].data=(void*)Lv;
2091  // ord:
2093  Lo->Init(1);
2095  Loo->Init(2);
2096  Loo->m[0].rtyp=STRING_CMD;
2097  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2098 
2099  intvec *iv=new intvec(1); (*iv)[0]=1;
2100  Loo->m[1].rtyp=INTVEC_CMD;
2101  Loo->m[1].data=(void *)iv;
2102 
2103  Lo->m[0].rtyp=LIST_CMD;
2104  Lo->m[0].data=(void*)Loo;
2105 
2106  Lc->m[2].rtyp=LIST_CMD;
2107  Lc->m[2].data=(void*)Lo;
2108  // q-ideal:
2109  Lc->m[3].rtyp=IDEAL_CMD;
2110  Lc->m[3].data=(void *)idInit(1,1);
2111  // ----------------------
2112  L->m[0].rtyp=LIST_CMD;
2113  L->m[0].data=(void*)Lc;
2114  }
2115  else
2116  {
2117  L->m[0].rtyp=INT_CMD;
2118  L->m[0].data=(void *)(long)r->cf->ch;
2119  }
2120  // ----------------------------------------
2121  // 1: list (var)
2123  LL->Init(r->N);
2124  int i;
2125  for(i=0; i<r->N; i++)
2126  {
2127  LL->m[i].rtyp=STRING_CMD;
2128  LL->m[i].data=(void *)omStrDup(r->names[i]);
2129  }
2130  L->m[1].rtyp=LIST_CMD;
2131  L->m[1].data=(void *)LL;
2132  // ----------------------------------------
2133  // 2: list (ord)
2135  i=rBlocks(r)-1;
2136  LL->Init(i);
2137  i--;
2138  lists LLL;
2139  for(; i>=0; i--)
2140  {
2141  intvec *iv;
2142  int j;
2143  LL->m[i].rtyp=LIST_CMD;
2145  LLL->Init(2);
2146  LLL->m[0].rtyp=STRING_CMD;
2147  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2148 
2149  if(r->order[i] == ringorder_IS) // || r->order[i] == ringorder_s || r->order[i] == ringorder_S)
2150  {
2151  assume( r->block0[i] == r->block1[i] );
2152  const int s = r->block0[i];
2153  assume( -2 < s && s < 2);
2154 
2155  iv=new intvec(1);
2156  (*iv)[0] = s;
2157  }
2158  else if (r->block1[i]-r->block0[i] >=0 )
2159  {
2160  int bl=j=r->block1[i]-r->block0[i];
2161  if (r->order[i]==ringorder_M)
2162  {
2163  j=(j+1)*(j+1)-1;
2164  bl=j+1;
2165  }
2166  else if (r->order[i]==ringorder_am)
2167  {
2168  j+=r->wvhdl[i][bl+1];
2169  }
2170  iv=new intvec(j+1);
2171  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2172  {
2173  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2174  }
2175  else switch (r->order[i])
2176  {
2177  case ringorder_dp:
2178  case ringorder_Dp:
2179  case ringorder_ds:
2180  case ringorder_Ds:
2181  case ringorder_lp:
2182  for(;j>=0; j--) (*iv)[j]=1;
2183  break;
2184  default: /* do nothing */;
2185  }
2186  }
2187  else
2188  {
2189  iv=new intvec(1);
2190  }
2191  LLL->m[1].rtyp=INTVEC_CMD;
2192  LLL->m[1].data=(void *)iv;
2193  LL->m[i].data=(void *)LLL;
2194  }
2195  L->m[2].rtyp=LIST_CMD;
2196  L->m[2].data=(void *)LL;
2197  // ----------------------------------------
2198  // 3: qideal
2199  L->m[3].rtyp=IDEAL_CMD;
2200  if (r->qideal==NULL)
2201  L->m[3].data=(void *)idInit(1,1);
2202  else
2203  L->m[3].data=(void *)idCopy(r->qideal);
2204  // ----------------------------------------
2205 #ifdef HAVE_PLURAL // NC! in rDecompose
2206  if (rIsPluralRing(r))
2207  {
2208  L->m[4].rtyp=MATRIX_CMD;
2209  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2210  L->m[5].rtyp=MATRIX_CMD;
2211  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2212  }
2213 #endif
2214  return L;
2215 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:45
Definition: tok.h:98
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:24
static BOOLEAN rField_is_GF(const ring r)
Definition: ring.h:467
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:570
CanonicalForm Lc(const CanonicalForm &f)
void * data
Definition: subexpr.h:89
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1603
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
static int rBlocks(ring r)
Definition: ring.h:513
const ring r
Definition: syzextra.cc:208
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:913
Definition: intvec.h:14
int j
Definition: myNF.cc:70
#define assume(x)
Definition: mod2.h:405
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:361
The main handler for Singular numbers which are suitable for Singular polynomials.
static void rDecomposeC(leftv h, const ring R)
Definition: ipshell.cc:1727
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:88
int i
Definition: cfEzgcd.cc:123
Induced (Schreyer) ordering.
Definition: ring.h:692
ideal idCopy(ideal A)
Definition: ideals.h:73
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
void rDecomposeRing(leftv h, const ring R)
Definition: ipshell.cc:1794
static BOOLEAN rField_is_Ring(const ring r)
Definition: ring.h:434
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
Definition: tok.h:120
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:75
omBin slists_bin
Definition: lists.cc:23
static BOOLEAN rField_is_numeric(const ring r)
Definition: ring.h:461
#define omStrDup(s)
Definition: omAllocDecl.h:263
BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1824 of file ipshell.cc.

1825 {
1826  assume( C != NULL );
1827 
1828  // sanity check: require currRing==r for rings with polynomial data
1829  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1830  {
1831  WerrorS("ring with polynomial data must be the base ring or compatible");
1832  return TRUE;
1833  }
1834  if (nCoeff_is_numeric(C))
1835  {
1836  rDecomposeC_41(res,C);
1837  }
1838 #ifdef HAVE_RINGS
1839  else if (nCoeff_is_Ring(C))
1840  {
1841  rDecomposeRing_41(res,C);
1842  }
1843 #endif
1844  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1845  {
1846  rDecomposeCF(res, C->extRing, currRing);
1847  }
1848  else if(nCoeff_is_GF(C))
1849  {
1851  Lc->Init(4);
1852  // char:
1853  Lc->m[0].rtyp=INT_CMD;
1854  Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1855  // var:
1857  Lv->Init(1);
1858  Lv->m[0].rtyp=STRING_CMD;
1859  Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1860  Lc->m[1].rtyp=LIST_CMD;
1861  Lc->m[1].data=(void*)Lv;
1862  // ord:
1864  Lo->Init(1);
1866  Loo->Init(2);
1867  Loo->m[0].rtyp=STRING_CMD;
1868  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1869 
1870  intvec *iv=new intvec(1); (*iv)[0]=1;
1871  Loo->m[1].rtyp=INTVEC_CMD;
1872  Loo->m[1].data=(void *)iv;
1873 
1874  Lo->m[0].rtyp=LIST_CMD;
1875  Lo->m[0].data=(void*)Loo;
1876 
1877  Lc->m[2].rtyp=LIST_CMD;
1878  Lc->m[2].data=(void*)Lo;
1879  // q-ideal:
1880  Lc->m[3].rtyp=IDEAL_CMD;
1881  Lc->m[3].data=(void *)idInit(1,1);
1882  // ----------------------
1883  res->rtyp=LIST_CMD;
1884  res->data=(void*)Lc;
1885  }
1886  else
1887  {
1888  res->rtyp=INT_CMD;
1889  res->data=(void *)(long)C->ch;
1890  }
1891  // ----------------------------------------
1892  return FALSE;
1893 }
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:801
sleftv * m
Definition: lists.h:45
static FORCE_INLINE BOOLEAN nCoeff_is_numeric(const coeffs r)
Definition: coeffs.h:835
Definition: tok.h:98
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
CanonicalForm Lc(const CanonicalForm &f)
static FORCE_INLINE BOOLEAN nCoeff_is_Ring(const coeffs r)
Definition: coeffs.h:758
void rDecomposeRing_41(leftv h, const coeffs C)
Definition: ipshell.cc:1764
void * data
Definition: subexpr.h:89
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1603
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:913
Definition: intvec.h:14
#define assume(x)
Definition: mod2.h:405
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:88
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition: coeffs.h:842
static void rDecomposeC_41(leftv h, const coeffs C)
Definition: ipshell.cc:1692
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
Definition: tok.h:120
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263
lists rDecompose_list_cf ( const ring  r)

Definition at line 1897 of file ipshell.cc.

1898 {
1899  assume( r != NULL );
1900  const coeffs C = r->cf;
1901  assume( C != NULL );
1902 
1903  // sanity check: require currRing==r for rings with polynomial data
1904  if ( (r!=currRing) && (
1905  (nCoeff_is_algExt(C) && (C != currRing->cf))
1906  || (r->qideal != NULL)
1907 #ifdef HAVE_PLURAL
1908  || (rIsPluralRing(r))
1909 #endif
1910  )
1911  )
1912  {
1913  WerrorS("ring with polynomial data must be the base ring or compatible");
1914  return NULL;
1915  }
1916  // 0: char/ cf - ring
1917  // 1: list (var)
1918  // 2: list (ord)
1919  // 3: qideal
1920  // possibly:
1921  // 4: C
1922  // 5: D
1924  if (rIsPluralRing(r))
1925  L->Init(6);
1926  else
1927  L->Init(4);
1928  // ----------------------------------------
1929  // 0: char/ cf - ring
1930  L->m[0].rtyp=CRING_CMD;
1931  L->m[0].data=(char*)r->cf; r->cf->ref++;
1932  // ----------------------------------------
1933  // 1: list (var)
1935  LL->Init(r->N);
1936  int i;
1937  for(i=0; i<r->N; i++)
1938  {
1939  LL->m[i].rtyp=STRING_CMD;
1940  LL->m[i].data=(void *)omStrDup(r->names[i]);
1941  }
1942  L->m[1].rtyp=LIST_CMD;
1943  L->m[1].data=(void *)LL;
1944  // ----------------------------------------
1945  // 2: list (ord)
1947  i=rBlocks(r)-1;
1948  LL->Init(i);
1949  i--;
1950  lists LLL;
1951  for(; i>=0; i--)
1952  {
1953  intvec *iv;
1954  int j;
1955  LL->m[i].rtyp=LIST_CMD;
1957  LLL->Init(2);
1958  LLL->m[0].rtyp=STRING_CMD;
1959  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1960 
1961  if(r->order[i] == ringorder_IS) // || r->order[i] == ringorder_s || r->order[i] == ringorder_S)
1962  {
1963  assume( r->block0[i] == r->block1[i] );
1964  const int s = r->block0[i];
1965  assume( -2 < s && s < 2);
1966 
1967  iv=new intvec(1);
1968  (*iv)[0] = s;
1969  }
1970  else if (r->block1[i]-r->block0[i] >=0 )
1971  {
1972  int bl=j=r->block1[i]-r->block0[i];
1973  if (r->order[i]==ringorder_M)
1974  {
1975  j=(j+1)*(j+1)-1;
1976  bl=j+1;
1977  }
1978  else if (r->order[i]==ringorder_am)
1979  {
1980  j+=r->wvhdl[i][bl+1];
1981  }
1982  iv=new intvec(j+1);
1983  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1984  {
1985  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
1986  }
1987  else switch (r->order[i])
1988  {
1989  case ringorder_dp:
1990  case ringorder_Dp:
1991  case ringorder_ds:
1992  case ringorder_Ds:
1993  case ringorder_lp:
1994  for(;j>=0; j--) (*iv)[j]=1;
1995  break;
1996  default: /* do nothing */;
1997  }
1998  }
1999  else
2000  {
2001  iv=new intvec(1);
2002  }
2003  LLL->m[1].rtyp=INTVEC_CMD;
2004  LLL->m[1].data=(void *)iv;
2005  LL->m[i].data=(void *)LLL;
2006  }
2007  L->m[2].rtyp=LIST_CMD;
2008  L->m[2].data=(void *)LL;
2009  // ----------------------------------------
2010  // 3: qideal
2011  L->m[3].rtyp=IDEAL_CMD;
2012  if (r->qideal==NULL)
2013  L->m[3].data=(void *)idInit(1,1);
2014  else
2015  L->m[3].data=(void *)idCopy(r->qideal);
2016  // ----------------------------------------
2017 #ifdef HAVE_PLURAL // NC! in rDecompose
2018  if (rIsPluralRing(r))
2019  {
2020  L->m[4].rtyp=MATRIX_CMD;
2021  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2022  L->m[5].rtyp=MATRIX_CMD;
2023  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2024  }
2025 #endif
2026  return L;
2027 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:45
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:24
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
static int rBlocks(ring r)
Definition: ring.h:513
Definition: tok.h:59
const ring r
Definition: syzextra.cc:208
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:913
Definition: intvec.h:14
int j
Definition: myNF.cc:70
#define assume(x)
Definition: mod2.h:405
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:361
The main handler for Singular numbers which are suitable for Singular polynomials.
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:88
int i
Definition: cfEzgcd.cc:123
Induced (Schreyer) ordering.
Definition: ring.h:692
ideal idCopy(ideal A)
Definition: ideals.h:73
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
Definition: tok.h:120
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:75
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263
static void rDecomposeC ( leftv  h,
const ring  R 
)
static

Definition at line 1727 of file ipshell.cc.

1729 {
1731  if (rField_is_long_C(R)) L->Init(3);
1732  else L->Init(2);
1733  h->rtyp=LIST_CMD;
1734  h->data=(void *)L;
1735  // 0: char/ cf - ring
1736  // 1: list (var)
1737  // 2: list (ord)
1738  // ----------------------------------------
1739  // 0: char/ cf - ring
1740  L->m[0].rtyp=INT_CMD;
1741  L->m[0].data=(void *)0;
1742  // ----------------------------------------
1743  // 1:
1745  LL->Init(2);
1746  LL->m[0].rtyp=INT_CMD;
1747  LL->m[0].data=(void *)(long)si_max(R->cf->float_len,SHORT_REAL_LENGTH/2);
1748  LL->m[1].rtyp=INT_CMD;
1749  LL->m[1].data=(void *)(long)si_max(R->cf->float_len2,SHORT_REAL_LENGTH);
1750  L->m[1].rtyp=LIST_CMD;
1751  L->m[1].data=(void *)LL;
1752  // ----------------------------------------
1753  // 2: list (par)
1754  if (rField_is_long_C(R))
1755  {
1756  L->m[2].rtyp=STRING_CMD;
1757  L->m[2].data=(void *)omStrDup(*rParameter(R));
1758  }
1759  // ----------------------------------------
1760 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:98
#define SHORT_REAL_LENGTH
Definition: numbers.h:54
Definition: lists.h:22
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:570
void * data
Definition: subexpr.h:89
const ring R
Definition: DebugPrint.cc:36
static int si_max(const int a, const int b)
Definition: auxiliary.h:166
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:491
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
Definition: tok.h:120
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263
static void rDecomposeC_41 ( leftv  h,
const coeffs  C 
)
static

Definition at line 1692 of file ipshell.cc.

1694 {
1696  if (nCoeff_is_long_C(C)) L->Init(3);
1697  else L->Init(2);
1698  h->rtyp=LIST_CMD;
1699  h->data=(void *)L;
1700  // 0: char/ cf - ring
1701  // 1: list (var)
1702  // 2: list (ord)
1703  // ----------------------------------------
1704  // 0: char/ cf - ring
1705  L->m[0].rtyp=INT_CMD;
1706  L->m[0].data=(void *)0;
1707  // ----------------------------------------
1708  // 1:
1710  LL->Init(2);
1711  LL->m[0].rtyp=INT_CMD;
1712  LL->m[0].data=(void *)(long)si_max(C->float_len,SHORT_REAL_LENGTH/2);
1713  LL->m[1].rtyp=INT_CMD;
1714  LL->m[1].data=(void *)(long)si_max(C->float_len2,SHORT_REAL_LENGTH);
1715  L->m[1].rtyp=LIST_CMD;
1716  L->m[1].data=(void *)LL;
1717  // ----------------------------------------
1718  // 2: list (par)
1719  if (nCoeff_is_long_C(C))
1720  {
1721  L->m[2].rtyp=STRING_CMD;
1722  L->m[2].data=(void *)omStrDup(*n_ParameterNames(C));
1723  }
1724  // ----------------------------------------
1725 }
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:801
sleftv * m
Definition: lists.h:45
Definition: tok.h:98
#define SHORT_REAL_LENGTH
Definition: numbers.h:54
Definition: lists.h:22
static FORCE_INLINE BOOLEAN nCoeff_is_long_C(const coeffs r)
Definition: coeffs.h:897
void * data
Definition: subexpr.h:89
static int si_max(const int a, const int b)
Definition: auxiliary.h:166
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
Definition: tok.h:120
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263
void rDecomposeCF ( leftv  h,
const ring  r,
const ring  R 
)

Definition at line 1603 of file ipshell.cc.

1604 {
1606  L->Init(4);
1607  h->rtyp=LIST_CMD;
1608  h->data=(void *)L;
1609  // 0: char/ cf - ring
1610  // 1: list (var)
1611  // 2: list (ord)
1612  // 3: qideal
1613  // ----------------------------------------
1614  // 0: char/ cf - ring
1615  L->m[0].rtyp=INT_CMD;
1616  L->m[0].data=(void *)(long)r->cf->ch;
1617  // ----------------------------------------
1618  // 1: list (var)
1620  LL->Init(r->N);
1621  int i;
1622  for(i=0; i<r->N; i++)
1623  {
1624  LL->m[i].rtyp=STRING_CMD;
1625  LL->m[i].data=(void *)omStrDup(r->names[i]);
1626  }
1627  L->m[1].rtyp=LIST_CMD;
1628  L->m[1].data=(void *)LL;
1629  // ----------------------------------------
1630  // 2: list (ord)
1632  i=rBlocks(r)-1;
1633  LL->Init(i);
1634  i--;
1635  lists LLL;
1636  for(; i>=0; i--)
1637  {
1638  intvec *iv;
1639  int j;
1640  LL->m[i].rtyp=LIST_CMD;
1642  LLL->Init(2);
1643  LLL->m[0].rtyp=STRING_CMD;
1644  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1645  if (r->block1[i]-r->block0[i] >=0 )
1646  {
1647  j=r->block1[i]-r->block0[i];
1648  if(r->order[i]==ringorder_M) j=(j+1)*(j+1)-1;
1649  iv=new intvec(j+1);
1650  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1651  {
1652  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j];
1653  }
1654  else switch (r->order[i])
1655  {
1656  case ringorder_dp:
1657  case ringorder_Dp:
1658  case ringorder_ds:
1659  case ringorder_Ds:
1660  case ringorder_lp:
1661  for(;j>=0; j--) (*iv)[j]=1;
1662  break;
1663  default: /* do nothing */;
1664  }
1665  }
1666  else
1667  {
1668  iv=new intvec(1);
1669  }
1670  LLL->m[1].rtyp=INTVEC_CMD;
1671  LLL->m[1].data=(void *)iv;
1672  LL->m[i].data=(void *)LLL;
1673  }
1674  L->m[2].rtyp=LIST_CMD;
1675  L->m[2].data=(void *)LL;
1676  // ----------------------------------------
1677  // 3: qideal
1678  L->m[3].rtyp=IDEAL_CMD;
1679  if (nCoeff_is_transExt(R->cf))
1680  L->m[3].data=(void *)idInit(1,1);
1681  else
1682  {
1683  ideal q=idInit(IDELEMS(r->qideal));
1684  q->m[0]=p_Init(R);
1685  pSetCoeff0(q->m[0],(number)(r->qideal->m[0]));
1686  L->m[3].data=(void *)q;
1687 // I->m[0] = pNSet(R->minpoly);
1688  }
1689  // ----------------------------------------
1690 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:98
Definition: lists.h:22
void * data
Definition: subexpr.h:89
static int rBlocks(ring r)
Definition: ring.h:513
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
int j
Definition: myNF.cc:70
const ring R
Definition: DebugPrint.cc:36
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:88
static FORCE_INLINE BOOLEAN nCoeff_is_transExt(const coeffs r)
TRUE iff r represents a transcendental extension field.
Definition: coeffs.h:921
int i
Definition: cfEzgcd.cc:123
#define IDELEMS(i)
Definition: simpleideals.h:24
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
#define pSetCoeff0(p, n)
Definition: monomials.h:67
Definition: tok.h:120
omBin slists_bin
Definition: lists.cc:23
static poly p_Init(const ring r, omBin bin)
Definition: p_polys.h:1249
#define omStrDup(s)
Definition: omAllocDecl.h:263
void rDecomposeRing ( leftv  h,
const ring  R 
)

Definition at line 1794 of file ipshell.cc.

1796 {
1798  if (rField_is_Ring_Z(R)) L->Init(1);
1799  else L->Init(2);
1800  h->rtyp=LIST_CMD;
1801  h->data=(void *)L;
1802  // 0: char/ cf - ring
1803  // 1: list (module)
1804  // ----------------------------------------
1805  // 0: char/ cf - ring
1806  L->m[0].rtyp=STRING_CMD;
1807  L->m[0].data=(void *)omStrDup("integer");
1808  // ----------------------------------------
1809  // 1: module
1810  if (rField_is_Ring_Z(R)) return;
1812  LL->Init(2);
1813  LL->m[0].rtyp=BIGINT_CMD;
1814  LL->m[0].data=nlMapGMP((number) R->cf->modBase, R->cf, R->cf); // TODO: what is this?? // extern number nlMapGMP(number from, const coeffs src, const coeffs dst); // FIXME: replace with n_InitMPZ(R->cf->modBase, coeffs_BIGINT); ?
1815  LL->m[1].rtyp=INT_CMD;
1816  LL->m[1].data=(void *) R->cf->modExponent;
1817  L->m[1].rtyp=LIST_CMD;
1818  L->m[1].data=(void *)LL;
1819 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:98
Definition: lists.h:22
Definition: tok.h:42
void * data
Definition: subexpr.h:89
const ring R
Definition: DebugPrint.cc:36
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
static BOOLEAN rField_is_Ring_Z(const ring r)
Definition: ring.h:431
int rtyp
Definition: subexpr.h:92
Definition: tok.h:120
number nlMapGMP(number from, const coeffs src, const coeffs dst)
Definition: longrat.cc:208
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263
void rDecomposeRing_41 ( leftv  h,
const coeffs  C 
)

Definition at line 1764 of file ipshell.cc.

1766 {
1768  if (nCoeff_is_Ring(C)) L->Init(1);
1769  else L->Init(2);
1770  h->rtyp=LIST_CMD;
1771  h->data=(void *)L;
1772  // 0: char/ cf - ring
1773  // 1: list (module)
1774  // ----------------------------------------
1775  // 0: char/ cf - ring
1776  L->m[0].rtyp=STRING_CMD;
1777  L->m[0].data=(void *)omStrDup("integer");
1778  // ----------------------------------------
1779  // 1: modulo
1780  if (nCoeff_is_Ring_Z(C)) return;
1782  LL->Init(2);
1783  LL->m[0].rtyp=BIGINT_CMD;
1784  LL->m[0].data=nlMapGMP((number) C->modBase, C, coeffs_BIGINT);
1785  LL->m[1].rtyp=INT_CMD;
1786  LL->m[1].data=(void *) C->modExponent;
1787  L->m[1].rtyp=LIST_CMD;
1788  L->m[1].data=(void *)LL;
1789 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:98
Definition: lists.h:22
Definition: tok.h:42
static FORCE_INLINE BOOLEAN nCoeff_is_Ring_Z(const coeffs r)
Definition: coeffs.h:755
coeffs coeffs_BIGINT
Definition: ipid.cc:54
static FORCE_INLINE BOOLEAN nCoeff_is_Ring(const coeffs r)
Definition: coeffs.h:758
void * data
Definition: subexpr.h:89
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
Definition: tok.h:120
number nlMapGMP(number from, const coeffs src, const coeffs dst)
Definition: longrat.cc:208
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263
idhdl rDefault ( const char *  s)

Definition at line 1532 of file ipshell.cc.

1533 {
1534  idhdl tmp=NULL;
1535 
1536  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
1537  if (tmp==NULL) return NULL;
1538 
1539 // if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
1541  {
1543  memset(&sLastPrinted,0,sizeof(sleftv));
1544  }
1545 
1546  ring r = IDRING(tmp);
1547 
1548  r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1549  r->N = 3;
1550  /*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
1551  /*names*/
1552  r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
1553  r->names[0] = omStrDup("x");
1554  r->names[1] = omStrDup("y");
1555  r->names[2] = omStrDup("z");
1556  /*weights: entries for 3 blocks: NULL*/
1557  r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1558  /*order: dp,C,0*/
1559  r->order = (int *) omAlloc(3 * sizeof(int *));
1560  r->block0 = (int *)omAlloc0(3 * sizeof(int *));
1561  r->block1 = (int *)omAlloc0(3 * sizeof(int *));
1562  /* ringorder dp for the first block: var 1..3 */
1563  r->order[0] = ringorder_dp;
1564  r->block0[0] = 1;
1565  r->block1[0] = 3;
1566  /* ringorder C for the second block: no vars */
1567  r->order[1] = ringorder_C;
1568  /* the last block: everything is 0 */
1569  r->order[2] = 0;
1570 
1571  /* complete ring intializations */
1572  rComplete(r);
1573  rSetHdl(tmp);
1574  return currRingHdl;
1575 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
{p < 2^31}
Definition: coeffs.h:30
#define IDROOT
Definition: ipid.h:20
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: idrec.h:34
int myynest
Definition: febase.cc:46
char * char_ptr
Definition: structs.h:56
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:259
const ring r
Definition: syzextra.cc:208
BOOLEAN RingDependend()
Definition: subexpr.cc:389
BOOLEAN rComplete(ring r, int force)
this needs to be called whenever a new ring is created: new fields in ring are created (like VarOffse...
Definition: ring.cc:3436
idhdl currRingHdl
Definition: ipid.cc:65
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:126
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
void rSetHdl(idhdl h)
Definition: ipshell.cc:5030
int * int_ptr
Definition: structs.h:57
#define omAlloc0(size)
Definition: omAllocDecl.h:211
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:327
#define omStrDup(s)
Definition: omAllocDecl.h:263
idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1577 of file ipshell.cc.

1578 {
1580  if (h!=NULL) return h;
1581  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1582  if (h!=NULL) return h;
1584  while(p!=NULL)
1585  {
1586  if ((p->cPack!=basePack)
1587  && (p->cPack!=currPack))
1588  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1589  if (h!=NULL) return h;
1590  p=p->next;
1591  }
1592  idhdl tmp=basePack->idroot;
1593  while (tmp!=NULL)
1594  {
1595  if (IDTYP(tmp)==PACKAGE_CMD)
1596  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1597  if (h!=NULL) return h;
1598  tmp=IDNEXT(tmp);
1599  }
1600  return NULL;
1601 }
idhdl rSimpleFindHdl(ring r, idhdl root, idhdl n)
Definition: ipshell.cc:6145
return P p
Definition: myNF.cc:203
#define IDNEXT(a)
Definition: ipid.h:117
proclevel * procstack
Definition: ipid.cc:58
#define IDROOT
Definition: ipid.h:20
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:138
#define IDTYP(a)
Definition: ipid.h:118
const ring r
Definition: syzextra.cc:208
Definition: ipid.h:56
proclevel * next
Definition: ipid.h:59
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
package currPack
Definition: ipid.cc:63
static Poly * h
Definition: janet.cc:978
package cPack
Definition: ipid.h:63
ring rInit ( leftv  pn,
leftv  rv,
leftv  ord 
)

Definition at line 5516 of file ipshell.cc.

5517 {
5518 #ifdef HAVE_RINGS
5519  //unsigned int ringtype = 0;
5520  mpz_ptr modBase = NULL;
5521  unsigned int modExponent = 1;
5522 #endif
5523  int float_len=0;
5524  int float_len2=0;
5525  ring R = NULL;
5526  //BOOLEAN ffChar=FALSE;
5527 
5528  /* ch -------------------------------------------------------*/
5529  // get ch of ground field
5530 
5531  // allocated ring
5532  R = (ring) omAlloc0Bin(sip_sring_bin);
5533 
5534  coeffs cf = NULL;
5535 
5536  assume( pn != NULL );
5537  const int P = pn->listLength();
5538 
5539  #ifdef SINGULAR_4_1
5540  if (pn->Typ()==CRING_CMD)
5541  {
5542  cf=(coeffs)pn->CopyD();
5543  leftv pnn=pn;
5544  if(P>1) /*parameter*/
5545  {
5546  pnn = pnn->next;
5547  const int pars = pnn->listLength();
5548  assume( pars > 0 );
5549  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5550 
5551  if (rSleftvList2StringArray(pnn, names))
5552  {
5553  WerrorS("parameter expected");
5554  goto rInitError;
5555  }
5556 
5557  TransExtInfo extParam;
5558 
5559  extParam.r = rDefault( cf, pars, names); // Q/Zp [ p_1, ... p_pars ]
5560  for(int i=pars-1; i>=0;i--)
5561  {
5562  omFree(names[i]);
5563  }
5564  omFree(names);
5565 
5566  cf = nInitChar(n_transExt, &extParam);
5567  }
5568  assume( cf != NULL );
5569  }
5570  else
5571  #endif
5572  if (pn->Typ()==INT_CMD)
5573  {
5574  int ch = (int)(long)pn->Data();
5575  leftv pnn=pn;
5576 
5577  /* parameter? -------------------------------------------------------*/
5578  pnn = pnn->next;
5579 
5580  if (pnn == NULL) // no params!?
5581  {
5582  if (ch!=0)
5583  {
5584  int ch2=IsPrime(ch);
5585  if ((ch<2)||(ch!=ch2))
5586  {
5587  Warn("%d is invalid as characteristic of the ground field. 32003 is used.", ch);
5588  ch=32003;
5589  }
5590  cf = nInitChar(n_Zp, (void*)(long)ch);
5591  }
5592  else
5593  cf = nInitChar(n_Q, (void*)(long)ch);
5594  }
5595  else
5596  {
5597  const int pars = pnn->listLength();
5598 
5599  assume( pars > 0 );
5600 
5601  // predefined finite field: (p^k, a)
5602  if ((ch!=0) && (ch!=IsPrime(ch)) && (pars == 1))
5603  {
5604  GFInfo param;
5605 
5606  param.GFChar = ch;
5607  param.GFDegree = 1;
5608  param.GFPar_name = pnn->name;
5609 
5610  cf = nInitChar(n_GF, &param);
5611  }
5612  else // (0/p, a, b, ..., z)
5613  {
5614  if ((ch!=0) && (ch!=IsPrime(ch)))
5615  {
5616  WerrorS("too many parameters");
5617  goto rInitError;
5618  }
5619 
5620  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5621 
5622  if (rSleftvList2StringArray(pnn, names))
5623  {
5624  WerrorS("parameter expected");
5625  goto rInitError;
5626  }
5627 
5628  TransExtInfo extParam;
5629 
5630  extParam.r = rDefault( ch, pars, names); // Q/Zp [ p_1, ... p_pars ]
5631  for(int i=pars-1; i>=0;i--)
5632  {
5633  omFree(names[i]);
5634  }
5635  omFree(names);
5636 
5637  cf = nInitChar(n_transExt, &extParam);
5638  }
5639  }
5640 
5641 // if (cf==NULL) goto rInitError;
5642  assume( cf != NULL );
5643  }
5644  else if ((pn->name != NULL)
5645  && ((strcmp(pn->name,"real")==0) || (strcmp(pn->name,"complex")==0)))
5646  {
5647  leftv pnn=pn->next;
5648  BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
5649  if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5650  {
5651  float_len=(int)(long)pnn->Data();
5652  float_len2=float_len;
5653  pnn=pnn->next;
5654  if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5655  {
5656  float_len2=(int)(long)pnn->Data();
5657  pnn=pnn->next;
5658  }
5659  }
5660 
5661  if (!complex_flag)
5662  complex_flag= (pnn!=NULL) && (pnn->name!=NULL);
5663  if( !complex_flag && (float_len2 <= (short)SHORT_REAL_LENGTH))
5664  cf=nInitChar(n_R, NULL);
5665  else // longR or longC?
5666  {
5667  LongComplexInfo param;
5668 
5669  param.float_len = si_min (float_len, 32767);
5670  param.float_len2 = si_min (float_len2, 32767);
5671 
5672  // set the parameter name
5673  if (complex_flag)
5674  {
5675  if (param.float_len < SHORT_REAL_LENGTH)
5676  {
5679  }
5680  if ((pnn == NULL) || (pnn->name == NULL))
5681  param.par_name=(const char*)"i"; //default to i
5682  else
5683  param.par_name = (const char*)pnn->name;
5684  }
5685 
5686  cf = nInitChar(complex_flag ? n_long_C: n_long_R, (void*)&param);
5687  }
5688  assume( cf != NULL );
5689  }
5690 #ifdef HAVE_RINGS
5691  else if ((pn->name != NULL) && (strcmp(pn->name, "integer") == 0))
5692  {
5693  // TODO: change to use coeffs_BIGINT!?
5694  modBase = (mpz_ptr) omAlloc(sizeof(mpz_t));
5695  mpz_init_set_si(modBase, 0);
5696  if (pn->next!=NULL)
5697  {
5698  leftv pnn=pn;
5699  if (pnn->next->Typ()==INT_CMD)
5700  {
5701  pnn=pnn->next;
5702  mpz_set_ui(modBase, (int)(long) pnn->Data());
5703  if ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5704  {
5705  pnn=pnn->next;
5706  modExponent = (long) pnn->Data();
5707  }
5708  while ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5709  {
5710  pnn=pnn->next;
5711  mpz_mul_ui(modBase, modBase, (int)(long) pnn->Data());
5712  }
5713  }
5714  else if (pnn->next->Typ()==BIGINT_CMD)
5715  {
5716  number p=(number)pnn->next->CopyD();
5717  nlGMP(p,(number)modBase,coeffs_BIGINT); // TODO? // extern void nlGMP(number &i, number n, const coeffs r); // FIXME: n_MPZ( modBase, p, coeffs_BIGINT); ?
5718  n_Delete(&p,coeffs_BIGINT);
5719  }
5720  }
5721  else
5722  cf=nInitChar(n_Z,NULL);
5723 
5724  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_cmp_ui(modBase, 0) < 0))
5725  {
5726  Werror("Wrong ground ring specification (module is 1)");
5727  goto rInitError;
5728  }
5729  if (modExponent < 1)
5730  {
5731  Werror("Wrong ground ring specification (exponent smaller than 1");
5732  goto rInitError;
5733  }
5734  // module is 0 ---> integers ringtype = 4;
5735  // we have an exponent
5736  if (modExponent > 1 && cf == NULL)
5737  {
5738  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
5739  {
5740  /* this branch should be active for modExponent = 2..32 resp. 2..64,
5741  depending on the size of a long on the respective platform */
5742  //ringtype = 1; // Use Z/2^ch
5743  cf=nInitChar(n_Z2m,(void*)(long)modExponent);
5744  mpz_clear(modBase);
5745  omFreeSize (modBase, sizeof (mpz_t));
5746  }
5747  else
5748  {
5749  if (mpz_cmp_ui(modBase,0)==0)
5750  {
5751  WerrorS("modulus must not be 0 or parameter not allowed");
5752  goto rInitError;
5753  }
5754  //ringtype = 3;
5755  ZnmInfo info;
5756  info.base= modBase;
5757  info.exp= modExponent;
5758  cf=nInitChar(n_Znm,(void*) &info); //exponent is missing
5759  }
5760  }
5761  // just a module m > 1
5762  else if (cf == NULL)
5763  {
5764  if (mpz_cmp_ui(modBase,0)==0)
5765  {
5766  WerrorS("modulus must not be 0 or parameter not allowed");
5767  goto rInitError;
5768  }
5769  //ringtype = 2;
5770  ZnmInfo info;
5771  info.base= modBase;
5772  info.exp= modExponent;
5773  cf=nInitChar(n_Zn,(void*) &info);
5774  }
5775  assume( cf != NULL );
5776  }
5777 #endif
5778  // ring NEW = OLD, (), (); where OLD is a polynomial ring...
5779  else if ((pn->Typ()==RING_CMD) && (P == 1))
5780  {
5781  TransExtInfo extParam;
5782  extParam.r = (ring)pn->Data();
5783  cf = nInitChar(n_transExt, &extParam);
5784  }
5785  else if ((pn->Typ()==QRING_CMD) && (P == 1)) // same for qrings - which should be fields!?
5786  {
5787  AlgExtInfo extParam;
5788  extParam.r = (ring)pn->Data();
5789 
5790  cf = nInitChar(n_algExt, &extParam); // Q[a]/<minideal>
5791  }
5792  else
5793  {
5794  Werror("Wrong or unknown ground field specification");
5795 #ifndef SING_NDEBUG
5796  sleftv* p = pn;
5797  while (p != NULL)
5798  {
5799  Print( "pn[%p]: type: %d [%s]: %p, name: %s", (void*)p, p->Typ(), Tok2Cmdname(p->Typ()), p->Data(), (p->name == NULL? "NULL" : p->name) );
5800  PrintLn();
5801  p = p->next;
5802  }
5803 #endif
5804  goto rInitError;
5805  }
5806 
5807  /*every entry in the new ring is initialized to 0*/
5808 
5809  /* characteristic -----------------------------------------------*/
5810  /* input: 0 ch=0 : Q parameter=NULL ffChar=FALSE float_len
5811  * 0 1 : Q(a,...) *names FALSE
5812  * 0 -1 : R NULL FALSE 0
5813  * 0 -1 : R NULL FALSE prec. >6
5814  * 0 -1 : C *names FALSE prec. 0..?
5815  * p p : Fp NULL FALSE
5816  * p -p : Fp(a) *names FALSE
5817  * q q : GF(q=p^n) *names TRUE
5818  */
5819  if (cf==NULL)
5820  {
5821  Werror("Invalid ground field specification");
5822  goto rInitError;
5823 // const int ch=32003;
5824 // cf=nInitChar(n_Zp, (void*)(long)ch);
5825  }
5826 
5827  assume( R != NULL );
5828 
5829  R->cf = cf;
5830 
5831  /* names and number of variables-------------------------------------*/
5832  {
5833  int l=rv->listLength();
5834 
5835  if (l>MAX_SHORT)
5836  {
5837  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5838  goto rInitError;
5839  }
5840  R->N = l; /*rv->listLength();*/
5841  }
5842  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
5843  if (rSleftvList2StringArray(rv, R->names))
5844  {
5845  WerrorS("name of ring variable expected");
5846  goto rInitError;
5847  }
5848 
5849  /* check names and parameters for conflicts ------------------------- */
5850  rRenameVars(R); // conflicting variables will be renamed
5851  /* ordering -------------------------------------------------------------*/
5852  if (rSleftvOrdering2Ordering(ord, R))
5853  goto rInitError;
5854 
5855  // Complete the initialization
5856  if (rComplete(R,1))
5857  goto rInitError;
5858 
5859 /*#ifdef HAVE_RINGS
5860 // currently, coefficients which are ring elements require a global ordering:
5861  if (rField_is_Ring(R) && (R->OrdSgn==-1))
5862  {
5863  WerrorS("global ordering required for these coefficients");
5864  goto rInitError;
5865  }
5866 #endif*/
5867 
5868  rTest(R);
5869 
5870  // try to enter the ring into the name list
5871  // need to clean up sleftv here, before this ring can be set to
5872  // new currRing or currRing can be killed beacuse new ring has
5873  // same name
5874  pn->CleanUp();
5875  rv->CleanUp();
5876  ord->CleanUp();
5877  //if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
5878  // goto rInitError;
5879 
5880  //memcpy(IDRING(tmp),R,sizeof(*R));
5881  // set current ring
5882  //omFreeBin(R, ip_sring_bin);
5883  //return tmp;
5884  return R;
5885 
5886  // error case:
5887  rInitError:
5888  if ((R != NULL)&&(R->cf!=NULL)) rDelete(R);
5889  pn->CleanUp();
5890  rv->CleanUp();
5891  ord->CleanUp();
5892  return NULL;
5893 }
mpz_ptr base
Definition: rmodulon.h:18
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
void PrintLn()
Definition: reporter.cc:327
#define Print
Definition: emacs.cc:83
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:43
Definition: tok.h:98
ring r
Definition: algext.h:40
#define SHORT_REAL_LENGTH
Definition: numbers.h:54
const short MAX_SHORT
Definition: ipshell.cc:5504
static BOOLEAN rSleftvList2StringArray(leftv sl, char **p)
Definition: ipshell.cc:5468
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:45
used for all transcendental extensions, i.e., the top-most extension in an extension tower is transce...
Definition: coeffs.h:38
static int si_min(const int a, const int b)
Definition: auxiliary.h:167
BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R)
Definition: ipshell.cc:5196
Definition: tok.h:42
return P p
Definition: myNF.cc:203
rational (GMP) numbers
Definition: coeffs.h:31
const char * GFPar_name
Definition: coeffs.h:95
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
{p < 2^31}
Definition: coeffs.h:30
int listLength()
Definition: subexpr.cc:61
void WerrorS(const char *s)
Definition: feFopen.cc:24
void nlGMP(number &i, number n, const coeffs r)
Definition: longrat.cc:1467
coeffs coeffs_BIGINT
Definition: ipid.cc:54
int Typ()
Definition: subexpr.cc:976
#define omAlloc(size)
Definition: omAllocDecl.h:210
Creation data needed for finite fields.
Definition: coeffs.h:91
idhdl rDefault(const char *s)
Definition: ipshell.cc:1532
real floating point (GMP) numbers
Definition: coeffs.h:34
short float_len2
additional char-flags, rInit
Definition: coeffs.h:101
char * char_ptr
Definition: structs.h:56
single prescision (6,6) real numbers
Definition: coeffs.h:32
Definition: tok.h:59
short float_len
additional char-flags, rInit
Definition: coeffs.h:100
BOOLEAN rComplete(ring r, int force)
this needs to be called whenever a new ring is created: new fields in ring are created (like VarOffse...
Definition: ring.cc:3436
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:44
const char * name
Definition: subexpr.h:88
#define omFree(addr)
Definition: omAllocDecl.h:261
#define assume(x)
Definition: mod2.h:405
The main handler for Singular numbers which are suitable for Singular polynomials.
int GFDegree
Definition: coeffs.h:94
const ExtensionInfo & info
< [in] sqrfree poly
const ring R
Definition: DebugPrint.cc:36
complex floating point (GMP) numbers
Definition: coeffs.h:41
#define rTest(r)
Definition: ring.h:778
omBin sip_sring_bin
Definition: ring.cc:54
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:42
struct for passing initialization parameters to naInitChar
Definition: transext.h:92
unsigned long exp
Definition: rmodulon.h:18
int i
Definition: cfEzgcd.cc:123
int IsPrime(int p)
Definition: prime.cc:61
static void rRenameVars(ring R)
Definition: ipshell.cc:2381
leftv next
Definition: subexpr.h:87
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
int GFChar
Definition: coeffs.h:93
CanonicalForm cf
Definition: cfModGcd.cc:4024
#define NULL
Definition: omList.c:10
{p^n < 2^16}
Definition: coeffs.h:33
struct for passing initialization parameters to naInitChar
Definition: algext.h:40
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:448
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:128
used for all algebraic extensions, i.e., the top-most extension in an extension tower is algebraic ...
Definition: coeffs.h:35
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
void * Data()
Definition: subexpr.cc:1118
const char * par_name
parameter name
Definition: coeffs.h:102
Definition: tok.h:159
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete &#39;p&#39;
Definition: coeffs.h:456
kBucketDestroy & P
Definition: myNF.cc:191
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
void * CopyD(int t)
Definition: subexpr.cc:676
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:94
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:327
#define Warn
Definition: emacs.cc:80
void rKill ( ring  r)

Definition at line 6057 of file ipshell.cc.

6058 {
6059  if ((r->ref<=0)&&(r->order!=NULL))
6060  {
6061 #ifdef RDEBUG
6062  if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6063 #endif
6064  if (r->qideal!=NULL)
6065  {
6066  id_Delete(&r->qideal, r);
6067  r->qideal = NULL;
6068  }
6069  int j;
6070 #ifdef USE_IILOCALRING
6071  for (j=0;j<myynest;j++)
6072  {
6073  if (iiLocalRing[j]==r)
6074  {
6075  if (j+1==myynest) Warn("killing the basering for level %d",j);
6076  iiLocalRing[j]=NULL;
6077  }
6078  }
6079 #else /* USE_IILOCALRING */
6080 //#endif /* USE_IILOCALRING */
6081  {
6082  proclevel * nshdl = procstack;
6083  int lev=myynest-1;
6084 
6085  for(; nshdl != NULL; nshdl = nshdl->next)
6086  {
6087  if (nshdl->cRing==r)
6088  {
6089  Warn("killing the basering for level %d",lev);
6090  nshdl->cRing=NULL;
6091  nshdl->cRingHdl=NULL;
6092  }
6093  }
6094  }
6095 #endif /* USE_IILOCALRING */
6096 // any variables depending on r ?
6097  while (r->idroot!=NULL)
6098  {
6099  r->idroot->lev=myynest; // avoid warning about kill global objects
6100  killhdl2(r->idroot,&(r->idroot),r);
6101  }
6102  if (r==currRing)
6103  {
6104  // all dependend stuff is done, clean global vars:
6105  if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6107  {
6109  }
6110  //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6111  //{
6112  // WerrorS("return value depends on local ring variable (export missing ?)");
6113  // iiRETURNEXPR.CleanUp();
6114  //}
6115  currRing=NULL;
6116  currRingHdl=NULL;
6117  }
6118 
6119  /* nKillChar(r); will be called from inside of rDelete */
6120  rDelete(r);
6121  return;
6122  }
6123  r->ref--;
6124 }
#define TRACE_SHOW_RINGS
Definition: reporter.h:33
#define Print
Definition: emacs.cc:83
proclevel * procstack
Definition: ipid.cc:58
void id_Delete(ideal *h, ring r)
deletes an ideal/module/matrix
int traceit
Definition: febase.cc:47
idhdl cRingHdl
Definition: ipid.h:60
int myynest
Definition: febase.cc:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:403
const ring r
Definition: syzextra.cc:208
BOOLEAN RingDependend()
Definition: subexpr.cc:389
int j
Definition: myNF.cc:70
Definition: ipid.h:56
idhdl currRingHdl
Definition: ipid.cc:65
proclevel * next
Definition: ipid.h:59
ring * iiLocalRing
Definition: iplib.cc:515
#define NULL
Definition: omList.c:10
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:448
#define pDelete(p_ptr)
Definition: polys.h:157
ring cRing
Definition: ipid.h:61
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
#define Warn
Definition: emacs.cc:80
void rKill ( idhdl  h)

Definition at line 6126 of file ipshell.cc.

6127 {
6128  ring r = IDRING(h);
6129  int ref=0;
6130  if (r!=NULL)
6131  {
6132  ref=r->ref;
6133  rKill(r);
6134  }
6135  if (h==currRingHdl)
6136  {
6137  if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6138  else
6139  {
6141  }
6142  }
6143 }
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
const ring r
Definition: syzextra.cc:208
void rKill(ring r)
Definition: ipshell.cc:6057
idhdl currRingHdl
Definition: ipid.cc:65
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1577
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:126
static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 5084 of file ipshell.cc.

5085 {
5086  // change some bad orderings/combination into better ones
5087  leftv h=ord;
5088  while(h!=NULL)
5089  {
5090  BOOLEAN change=FALSE;
5091  intvec *iv = (intvec *)(h->data);
5092  // ws(-i) -> wp(i)
5093  if ((*iv)[1]==ringorder_ws)
5094  {
5095  BOOLEAN neg=TRUE;
5096  for(int i=2;i<iv->length();i++)
5097  if((*iv)[i]>=0) { neg=FALSE; break; }
5098  if (neg)
5099  {
5100  (*iv)[1]=ringorder_wp;
5101  for(int i=2;i<iv->length();i++)
5102  (*iv)[i]= - (*iv)[i];
5103  change=TRUE;
5104  }
5105  }
5106  // Ws(-i) -> Wp(i)
5107  if ((*iv)[1]==ringorder_Ws)
5108  {
5109  BOOLEAN neg=TRUE;
5110  for(int i=2;i<iv->length();i++)
5111  if((*iv)[i]>=0) { neg=FALSE; break; }
5112  if (neg)
5113  {
5114  (*iv)[1]=ringorder_Wp;
5115  for(int i=2;i<iv->length();i++)
5116  (*iv)[i]= -(*iv)[i];
5117  change=TRUE;
5118  }
5119  }
5120  // wp(1) -> dp
5121  if ((*iv)[1]==ringorder_wp)
5122  {
5123  BOOLEAN all_one=TRUE;
5124  for(int i=2;i<iv->length();i++)
5125  if((*iv)[i]!=1) { all_one=FALSE; break; }
5126  if (all_one)
5127  {
5128  intvec *iv2=new intvec(3);
5129  (*iv2)[0]=1;
5130  (*iv2)[1]=ringorder_dp;
5131  (*iv2)[2]=iv->length()-2;
5132  delete iv;
5133  iv=iv2;
5134  h->data=iv2;
5135  change=TRUE;
5136  }
5137  }
5138  // Wp(1) -> Dp
5139  if ((*iv)[1]==ringorder_Wp)
5140  {
5141  BOOLEAN all_one=TRUE;
5142  for(int i=2;i<iv->length();i++)
5143  if((*iv)[i]!=1) { all_one=FALSE; break; }
5144  if (all_one)
5145  {
5146  intvec *iv2=new intvec(3);
5147  (*iv2)[0]=1;
5148  (*iv2)[1]=ringorder_Dp;
5149  (*iv2)[2]=iv->length()-2;
5150  delete iv;
5151  iv=iv2;
5152  h->data=iv2;
5153  change=TRUE;
5154  }
5155  }
5156  // dp(1)/Dp(1)/rp(1) -> lp(1)
5157  if (((*iv)[1]==ringorder_dp)
5158  || ((*iv)[1]==ringorder_Dp)
5159  || ((*iv)[1]==ringorder_rp))
5160  {
5161  if (iv->length()==3)
5162  {
5163  if ((*iv)[2]==1)
5164  {
5165  (*iv)[1]=ringorder_lp;
5166  change=TRUE;
5167  }
5168  }
5169  }
5170  // lp(i),lp(j) -> lp(i+j)
5171  if(((*iv)[1]==ringorder_lp)
5172  && (h->next!=NULL))
5173  {
5174  intvec *iv2 = (intvec *)(h->next->data);
5175  if ((*iv2)[1]==ringorder_lp)
5176  {
5177  leftv hh=h->next;
5178  h->next=hh->next;
5179  hh->next=NULL;
5180  if ((*iv2)[0]==1)
5181  (*iv)[2] += 1; // last block unspecified, at least 1
5182  else
5183  (*iv)[2] += (*iv2)[2];
5184  hh->CleanUp();
5185  omFree(hh);
5186  change=TRUE;
5187  }
5188  }
5189  // -------------------
5190  if (!change) h=h->next;
5191  }
5192  return ord;
5193 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
int length() const
Definition: intvec.h:86
void * data
Definition: subexpr.h:89
Definition: intvec.h:14
#define omFree(addr)
Definition: omAllocDecl.h:261
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:87
#define NULL
Definition: omList.c:10
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
static void rRenameVars ( ring  R)
static

Definition at line 2381 of file ipshell.cc.

2382 {
2383  int i,j;
2384  BOOLEAN ch;
2385  do
2386  {
2387  ch=0;
2388  for(i=0;i<R->N-1;i++)
2389  {
2390  for(j=i+1;j<R->N;j++)
2391  {
2392  if (strcmp(R->names[i],R->names[j])==0)
2393  {
2394  ch=TRUE;
2395  Warn("name conflict var(%d) and var(%d): `%s`, rename to `@%s`",i+1,j+1,R->names[i],R->names[i]);
2396  omFree(R->names[j]);
2397  R->names[j]=(char *)omAlloc(2+strlen(R->names[i]));
2398  sprintf(R->names[j],"@%s",R->names[i]);
2399  }
2400  }
2401  }
2402  }
2403  while (ch);
2404  for(i=0;i<rPar(R); i++)
2405  {
2406  for(j=0;j<R->N;j++)
2407  {
2408  if (strcmp(rParameter(R)[i],R->names[j])==0)
2409  {
2410  Warn("name conflict par(%d) and var(%d): `%s`, renaming the VARIABLE to `@@(%d)`",i+1,j+1,R->names[j],i+1);
2411 // omFree(rParameter(R)[i]);
2412 // rParameter(R)[i]=(char *)omAlloc(10);
2413 // sprintf(rParameter(R)[i],"@@(%d)",i+1);
2414  omFree(R->names[j]);
2415  R->names[j]=(char *)omAlloc(10);
2416  sprintf(R->names[j],"@@(%d)",i+1);
2417  }
2418  }
2419  }
2420 }
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:544
#define TRUE
Definition: auxiliary.h:144
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:570
#define omAlloc(size)
Definition: omAllocDecl.h:210
int j
Definition: myNF.cc:70
#define omFree(addr)
Definition: omAllocDecl.h:261
const ring R
Definition: DebugPrint.cc:36
int i
Definition: cfEzgcd.cc:123
int BOOLEAN
Definition: auxiliary.h:131
#define Warn
Definition: emacs.cc:80
void rSetHdl ( idhdl  h)

Definition at line 5030 of file ipshell.cc.

5031 {
5032  ring rg = NULL;
5033  if (h!=NULL)
5034  {
5035 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5036  rg = IDRING(h);
5037  if (rg==NULL) return; //id <>NULL, ring==NULL
5038  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5039  if (IDID(h)) // OB: ????
5040  omCheckAddr((ADDRESS)IDID(h));
5041  rTest(rg);
5042  }
5043 
5044  // clean up history
5046  {
5048  memset(&sLastPrinted,0,sizeof(sleftv));
5049  }
5050 
5051  if ((rg!=currRing)&&(currRing!=NULL))
5052  {
5054  if (DENOMINATOR_LIST!=NULL)
5055  {
5056  if (TEST_V_ALLWARN)
5057  Warn("deleting denom_list for ring change to %s",IDID(h));
5058  do
5059  {
5060  n_Delete(&(dd->n),currRing->cf);
5061  dd=dd->next;
5063  DENOMINATOR_LIST=dd;
5064  } while(DENOMINATOR_LIST!=NULL);
5065  }
5066  }
5067 
5068  // test for valid "currRing":
5069  if ((rg!=NULL) && (rg->idroot==NULL))
5070  {
5071  ring old=rg;
5072  rg=rAssure_HasComp(rg);
5073  if (old!=rg)
5074  {
5075  rKill(old);
5076  IDRING(h)=rg;
5077  }
5078  }
5079  /*------------ change the global ring -----------------------*/
5080  rChangeCurrRing(rg);
5081  currRingHdl = h;
5082 }
#define omCheckAddrSize(addr, size)
Definition: omAllocDecl.h:327
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define IDID(a)
Definition: ipid.h:121
denominator_list DENOMINATOR_LIST
Definition: kutil.cc:81
void * ADDRESS
Definition: auxiliary.h:161
ring rAssure_HasComp(const ring r)
Definition: ring.cc:4559
Definition: idrec.h:34
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
BOOLEAN RingDependend()
Definition: subexpr.cc:389
void rKill(ring r)
Definition: ipshell.cc:6057
#define omFree(addr)
Definition: omAllocDecl.h:261
#define rTest(r)
Definition: ring.h:778
idhdl currRingHdl
Definition: ipid.cc:65
void rChangeCurrRing(ring r)
Definition: polys.cc:14
#define NULL
Definition: omList.c:10
denominator_list next
Definition: kutil.h:67
#define IDRING(a)
Definition: ipid.h:126
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
#define omCheckAddr(addr)
Definition: omAllocDecl.h:328
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete &#39;p&#39;
Definition: coeffs.h:456
static Poly * h
Definition: janet.cc:978
#define TEST_V_ALLWARN
Definition: options.h:135
#define Warn
Definition: emacs.cc:80
idhdl rSimpleFindHdl ( ring  r,
idhdl  root,
idhdl  n 
)

Definition at line 6145 of file ipshell.cc.

6146 {
6147  //idhdl next_best=NULL;
6148  idhdl h=root;
6149  while (h!=NULL)
6150  {
6151  if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
6152  && (h!=n)
6153  && (IDRING(h)==r)
6154  )
6155  {
6156  // if (IDLEV(h)==myynest)
6157  // return h;
6158  // if ((IDLEV(h)==0) || (next_best==NULL))
6159  // next_best=h;
6160  // else if (IDLEV(next_best)<IDLEV(h))
6161  // next_best=h;
6162  return h;
6163  }
6164  h=IDNEXT(h);
6165  }
6166  //return next_best;
6167  return NULL;
6168 }
#define IDNEXT(a)
Definition: ipid.h:117
Definition: idrec.h:34
#define IDTYP(a)
Definition: ipid.h:118
const ring r
Definition: syzextra.cc:208
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:126
Definition: tok.h:159
static Poly * h
Definition: janet.cc:978
static BOOLEAN rSleftvList2StringArray ( leftv  sl,
char **  p 
)
static

Definition at line 5468 of file ipshell.cc.

5469 {
5470 
5471  while(sl!=NULL)
5472  {
5473  if ((sl->rtyp == IDHDL)||(sl->rtyp==ALIAS_CMD))
5474  {
5475  *p = omStrDup(sl->Name());
5476  }
5477  else if (sl->name!=NULL)
5478  {
5479  *p = (char*)sl->name;
5480  sl->name=NULL;
5481  }
5482  else if (sl->rtyp==POLY_CMD)
5483  {
5484  sleftv s_sl;
5485  iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl);
5486  if (s_sl.name != NULL)
5487  {
5488  *p = (char*)s_sl.name; s_sl.name=NULL;
5489  }
5490  else
5491  *p = NULL;
5492  sl->next = s_sl.next;
5493  s_sl.next = NULL;
5494  s_sl.CleanUp();
5495  if (*p == NULL) return TRUE;
5496  }
5497  else return TRUE;
5498  p++;
5499  sl=sl->next;
5500  }
5501  return FALSE;
5502 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define ANY_TYPE
Definition: tok.h:34
#define FALSE
Definition: auxiliary.h:140
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, const struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:358
return P p
Definition: myNF.cc:203
#define TRUE
Definition: auxiliary.h:144
const char * Name()
Definition: subexpr.h:121
#define IDHDL
Definition: tok.h:35
const char * name
Definition: subexpr.h:88
leftv next
Definition: subexpr.h:87
Definition: tok.h:38
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
#define omStrDup(s)
Definition: omAllocDecl.h:263
BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 5196 of file ipshell.cc.

5197 {
5198  int last = 0, o=0, n = 1, i=0, typ = 1, j;
5199  ord=rOptimizeOrdAsSleftv(ord);
5200  sleftv *sl = ord;
5201 
5202  // determine nBlocks
5203  while (sl!=NULL)
5204  {
5205  intvec *iv = (intvec *)(sl->data);
5206  if (((*iv)[1]==ringorder_c)||((*iv)[1]==ringorder_C))
5207  i++;
5208  else if ((*iv)[1]==ringorder_L)
5209  {
5210  R->bitmask=(*iv)[2];
5211  n--;
5212  }
5213  else if (((*iv)[1]!=ringorder_a)
5214  && ((*iv)[1]!=ringorder_a64)
5215  && ((*iv)[1]!=ringorder_am))
5216  o++;
5217  n++;
5218  sl=sl->next;
5219  }
5220  // check whether at least one real ordering
5221  if (o==0)
5222  {
5223  WerrorS("invalid combination of orderings");
5224  return TRUE;
5225  }
5226  // if no c/C ordering is given, increment n
5227  if (i==0) n++;
5228  else if (i != 1)
5229  {
5230  // throw error if more than one is given
5231  WerrorS("more than one ordering c/C specified");
5232  return TRUE;
5233  }
5234 
5235  // initialize fields of R
5236  R->order=(int *)omAlloc0(n*sizeof(int));
5237  R->block0=(int *)omAlloc0(n*sizeof(int));
5238  R->block1=(int *)omAlloc0(n*sizeof(int));
5239  R->wvhdl=(int**)omAlloc0(n*sizeof(int_ptr));
5240 
5241  int *weights=(int*)omAlloc0((R->N+1)*sizeof(int));
5242 
5243  // init order, so that rBlocks works correctly
5244  for (j=0; j < n-1; j++)
5245  R->order[j] = (int) ringorder_unspec;
5246  // set last _C order, if no c/C order was given
5247  if (i == 0) R->order[n-2] = ringorder_C;
5248 
5249  /* init orders */
5250  sl=ord;
5251  n=-1;
5252  while (sl!=NULL)
5253  {
5254  intvec *iv;
5255  iv = (intvec *)(sl->data);
5256  if ((*iv)[1]!=ringorder_L)
5257  {
5258  n++;
5259 
5260  /* the format of an ordering:
5261  * iv[0]: factor
5262  * iv[1]: ordering
5263  * iv[2..end]: weights
5264  */
5265  R->order[n] = (*iv)[1];
5266  typ=1;
5267  switch ((*iv)[1])
5268  {
5269  case ringorder_ws:
5270  case ringorder_Ws:
5271  typ=-1;
5272  case ringorder_wp:
5273  case ringorder_Wp:
5274  R->wvhdl[n]=(int*)omAlloc((iv->length()-1)*sizeof(int));
5275  R->block0[n] = last+1;
5276  for (i=2; i<iv->length(); i++)
5277  {
5278  R->wvhdl[n][i-2] = (*iv)[i];
5279  last++;
5280  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5281  }
5282  R->block1[n] = si_min(last,R->N);
5283  break;
5284  case ringorder_ls:
5285  case ringorder_ds:
5286  case ringorder_Ds:
5287  case ringorder_rs:
5288  typ=-1;
5289  case ringorder_lp:
5290  case ringorder_dp:
5291  case ringorder_Dp:
5292  case ringorder_rp:
5293  R->block0[n] = last+1;
5294  if (iv->length() == 3) last+=(*iv)[2];
5295  else last += (*iv)[0];
5296  R->block1[n] = si_min(last,R->N);
5297  if (rCheckIV(iv)) return TRUE;
5298  for(i=si_min(rVar(R),R->block1[n]);i>=R->block0[n];i--)
5299  {
5300  if (weights[i]==0) weights[i]=typ;
5301  }
5302  break;
5303 
5304  case ringorder_s: // no 'rank' params!
5305  {
5306 
5307  if(iv->length() > 3)
5308  return TRUE;
5309 
5310  if(iv->length() == 3)
5311  {
5312  const int s = (*iv)[2];
5313  R->block0[n] = s;
5314  R->block1[n] = s;
5315  }
5316  break;
5317  }
5318  case ringorder_IS:
5319  {
5320  if(iv->length() != 3) return TRUE;
5321 
5322  const int s = (*iv)[2];
5323 
5324  if( 1 < s || s < -1 ) return TRUE;
5325 
5326  R->block0[n] = s;
5327  R->block1[n] = s;
5328  break;
5329  }
5330  case ringorder_S:
5331  case ringorder_c:
5332  case ringorder_C:
5333  {
5334  if (rCheckIV(iv)) return TRUE;
5335  break;
5336  }
5337  case ringorder_aa:
5338  case ringorder_a:
5339  {
5340  R->block0[n] = last+1;
5341  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5342  R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int));
5343  for (i=2; i<iv->length(); i++)
5344  {
5345  R->wvhdl[n][i-2]=(*iv)[i];
5346  last++;
5347  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5348  }
5349  last=R->block0[n]-1;
5350  break;
5351  }
5352  case ringorder_am:
5353  {
5354  R->block0[n] = last+1;
5355  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5356  R->wvhdl[n] = (int*)omAlloc(iv->length()*sizeof(int));
5357  if (R->block1[n]- R->block0[n]+2>=iv->length())
5358  WarnS("missing module weights");
5359  for (i=2; i<=(R->block1[n]-R->block0[n]+2); i++)
5360  {
5361  R->wvhdl[n][i-2]=(*iv)[i];
5362  last++;
5363  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5364  }
5365  R->wvhdl[n][i-2]=iv->length() -3 -(R->block1[n]- R->block0[n]);
5366  for (; i<iv->length(); i++)
5367  {
5368  R->wvhdl[n][i-1]=(*iv)[i];
5369  }
5370  last=R->block0[n]-1;
5371  break;
5372  }
5373  case ringorder_a64:
5374  {
5375  R->block0[n] = last+1;
5376  R->block1[n] = si_min(last+iv->length()-2 , R->N);
5377  R->wvhdl[n] = (int*)omAlloc((iv->length()-1)*sizeof(int64));
5378  int64 *w=(int64 *)R->wvhdl[n];
5379  for (i=2; i<iv->length(); i++)
5380  {
5381  w[i-2]=(*iv)[i];
5382  last++;
5383  if (weights[last]==0) weights[last]=(*iv)[i]*typ;
5384  }
5385  last=R->block0[n]-1;
5386  break;
5387  }
5388  case ringorder_M:
5389  {
5390  int Mtyp=rTypeOfMatrixOrder(iv);
5391  if (Mtyp==0) return TRUE;
5392  if (Mtyp==-1) typ = -1;
5393 
5394  R->wvhdl[n] =( int *)omAlloc((iv->length()-1)*sizeof(int));
5395  for (i=2; i<iv->length();i++)
5396  R->wvhdl[n][i-2]=(*iv)[i];
5397 
5398  R->block0[n] = last+1;
5399  last += (int)sqrt((double)(iv->length()-2));
5400  R->block1[n] = si_min(last,R->N);
5401  for(i=R->block1[n];i>=R->block0[n];i--)
5402  {
5403  if (weights[i]==0) weights[i]=typ;
5404  }
5405  break;
5406  }
5407 
5408  case ringorder_no:
5409  R->order[n] = ringorder_unspec;
5410  return TRUE;
5411 
5412  default:
5413  Werror("Internal Error: Unknown ordering %d", (*iv)[1]);
5414  R->order[n] = ringorder_unspec;
5415  return TRUE;
5416  }
5417  }
5418  if (last>R->N)
5419  {
5420  Werror("mismatch of number of vars (%d) and ordering (>=%d vars)",
5421  R->N,last);
5422  return TRUE;
5423  }
5424  sl=sl->next;
5425  }
5426  // find OrdSgn:
5427  R->OrdSgn = 1;
5428  for(i=1;i<=R->N;i++)
5429  { if (weights[i]<0) { R->OrdSgn=-1;break; }}
5430  omFree(weights);
5431 
5432  // check for complete coverage
5433  while ( n >= 0 && (
5434  (R->order[n]==ringorder_c)
5435  || (R->order[n]==ringorder_C)
5436  || (R->order[n]==ringorder_s)
5437  || (R->order[n]==ringorder_S)
5438  || (R->order[n]==ringorder_IS)
5439  )) n--;
5440 
5441  assume( n >= 0 );
5442 
5443  if (R->block1[n] != R->N)
5444  {
5445  if (((R->order[n]==ringorder_dp) ||
5446  (R->order[n]==ringorder_ds) ||
5447  (R->order[n]==ringorder_Dp) ||
5448  (R->order[n]==ringorder_Ds) ||
5449  (R->order[n]==ringorder_rp) ||
5450  (R->order[n]==ringorder_rs) ||
5451  (R->order[n]==ringorder_lp) ||
5452  (R->order[n]==ringorder_ls))
5453  &&
5454  R->block0[n] <= R->N)
5455  {
5456  R->block1[n] = R->N;
5457  }
5458  else
5459  {
5460  Werror("mismatch of number of vars (%d) and ordering (%d vars)",
5461  R->N,R->block1[n]);
5462  return TRUE;
5463  }
5464  }
5465  return FALSE;
5466 }
for idElimination, like a, except pFDeg, pWeigths ignore it
Definition: ring.h:690
const CanonicalForm int s
Definition: facAbsFact.cc:55
for int64 weights
Definition: ring.h:670
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
static int si_min(const int a, const int b)
Definition: auxiliary.h:167
#define FALSE
Definition: auxiliary.h:140
opposite of ls
Definition: ring.h:691
static poly last
Definition: hdegree.cc:1075
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:537
long int64
Definition: auxiliary.h:112
#define TRUE
Definition: auxiliary.h:144
int length() const
Definition: intvec.h:86
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define WarnS
Definition: emacs.cc:81
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:89
Definition: intvec.h:14
for(int i=0;i< R->ExpL_Size;i++) Print("%09lx "
Definition: cfEzgcd.cc:66
int j
Definition: myNF.cc:70
#define omFree(addr)
Definition: omAllocDecl.h:261
static leftv rOptimizeOrdAsSleftv(leftv ord)
Definition: ipshell.cc:5084
#define assume(x)
Definition: mod2.h:405
const ring R
Definition: DebugPrint.cc:36
gmp_float sqrt(const gmp_float &a)
Definition: mpr_complex.cc:329
BOOLEAN rCheckIV(const intvec *iv)
Definition: ring.cc:185
int i
Definition: cfEzgcd.cc:123
Induced (Schreyer) ordering.
Definition: ring.h:692
S?
Definition: ring.h:674
leftv next
Definition: subexpr.h:87
#define NULL
Definition: omList.c:10
int rTypeOfMatrixOrder(const intvec *order)
Definition: ring.cc:195
const CanonicalForm & w
Definition: facAbsFact.cc:55
int * int_ptr
Definition: structs.h:57
s?
Definition: ring.h:675
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define omAlloc0(size)
Definition: omAllocDecl.h:211
ring rSubring ( ring  org_ring,
sleftv rv 
)

Definition at line 5895 of file ipshell.cc.

5896 {
5897  ring R = rCopy0(org_ring);
5898  int *perm=(int *)omAlloc0((org_ring->N+1)*sizeof(int));
5899  int n = rBlocks(org_ring), i=0, j;
5900 
5901  /* names and number of variables-------------------------------------*/
5902  {
5903  int l=rv->listLength();
5904  if (l>MAX_SHORT)
5905  {
5906  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5907  goto rInitError;
5908  }
5909  R->N = l; /*rv->listLength();*/
5910  }
5911  omFree(R->names);
5912  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
5913  if (rSleftvList2StringArray(rv, R->names))
5914  {
5915  WerrorS("name of ring variable expected");
5916  goto rInitError;
5917  }
5918 
5919  /* check names for subring in org_ring ------------------------- */
5920  {
5921  i=0;
5922 
5923  for(j=0;j<R->N;j++)
5924  {
5925  for(;i<org_ring->N;i++)
5926  {
5927  if (strcmp(org_ring->names[i],R->names[j])==0)
5928  {
5929  perm[i+1]=j+1;
5930  break;
5931  }
5932  }
5933  if (i>org_ring->N)
5934  {
5935  Werror("variable %d (%s) not in basering",j+1,R->names[j]);
5936  break;
5937  }
5938  }
5939  }
5940  //Print("perm=");
5941  //for(i=1;i<org_ring->N;i++) Print("v%d -> v%d\n",i,perm[i]);
5942  /* ordering -------------------------------------------------------------*/
5943 
5944  for(i=0;i<n;i++)
5945  {
5946  int min_var=-1;
5947  int max_var=-1;
5948  for(j=R->block0[i];j<=R->block1[i];j++)
5949  {
5950  if (perm[j]>0)
5951  {
5952  if (min_var==-1) min_var=perm[j];
5953  max_var=perm[j];
5954  }
5955  }
5956  if (min_var!=-1)
5957  {
5958  //Print("block %d: old %d..%d, now:%d..%d\n",
5959  // i,R->block0[i],R->block1[i],min_var,max_var);
5960  R->block0[i]=min_var;
5961  R->block1[i]=max_var;
5962  if (R->wvhdl[i]!=NULL)
5963  {
5964  omFree(R->wvhdl[i]);
5965  R->wvhdl[i]=(int*)omAlloc0((max_var-min_var+1)*sizeof(int));
5966  for(j=org_ring->block0[i];j<=org_ring->block1[i];j++)
5967  {
5968  if (perm[j]>0)
5969  {
5970  R->wvhdl[i][perm[j]-R->block0[i]]=
5971  org_ring->wvhdl[i][j-org_ring->block0[i]];
5972  //Print("w%d=%d (orig_w%d)\n",perm[j],R->wvhdl[i][perm[j]-R->block0[i]],j);
5973  }
5974  }
5975  }
5976  }
5977  else
5978  {
5979  if(R->block0[i]>0)
5980  {
5981  //Print("skip block %d\n",i);
5982  R->order[i]=ringorder_unspec;
5983  if (R->wvhdl[i] !=NULL) omFree(R->wvhdl[i]);
5984  R->wvhdl[i]=NULL;
5985  }
5986  //else Print("keep block %d\n",i);
5987  }
5988  }
5989  i=n-1;
5990  while(i>0)
5991  {
5992  // removed unneded blocks
5993  if(R->order[i-1]==ringorder_unspec)
5994  {
5995  for(j=i;j<=n;j++)
5996  {
5997  R->order[j-1]=R->order[j];
5998  R->block0[j-1]=R->block0[j];
5999  R->block1[j-1]=R->block1[j];
6000  if (R->wvhdl[j-1] !=NULL) omFree(R->wvhdl[j-1]);
6001  R->wvhdl[j-1]=R->wvhdl[j];
6002  }
6003  R->order[n]=ringorder_unspec;
6004  n--;
6005  }
6006  i--;
6007  }
6008  n=rBlocks(org_ring)-1;
6009  while (R->order[n]==0) n--;
6010  while (R->order[n]==ringorder_unspec) n--;
6011  if ((R->order[n]==ringorder_c) || (R->order[n]==ringorder_C)) n--;
6012  if (R->block1[n] != R->N)
6013  {
6014  if (((R->order[n]==ringorder_dp) ||
6015  (R->order[n]==ringorder_ds) ||
6016  (R->order[n]==ringorder_Dp) ||
6017  (R->order[n]==ringorder_Ds) ||
6018  (R->order[n]==ringorder_rp) ||
6019  (R->order[n]==ringorder_rs) ||
6020  (R->order[n]==ringorder_lp) ||
6021  (R->order[n]==ringorder_ls))
6022  &&
6023  R->block0[n] <= R->N)
6024  {
6025  R->block1[n] = R->N;
6026  }
6027  else
6028  {
6029  Werror("mismatch of number of vars (%d) and ordering (%d vars) in block %d",
6030  R->N,R->block1[n],n);
6031  return NULL;
6032  }
6033  }
6034  omFree(perm);
6035  // find OrdSgn:
6036  R->OrdSgn = org_ring->OrdSgn; // IMPROVE!
6037  //for(i=1;i<=R->N;i++)
6038  //{ if (weights[i]<0) { R->OrdSgn=-1;break; }}
6039  //omFree(weights);
6040  // Complete the initialization
6041  if (rComplete(R,1))
6042  goto rInitError;
6043 
6044  rTest(R);
6045 
6046  if (rv != NULL) rv->CleanUp();
6047 
6048  return R;
6049 
6050  // error case:
6051  rInitError:
6052  if (R != NULL) rDelete(R);
6053  if (rv != NULL) rv->CleanUp();
6054  return NULL;
6055 }
const short MAX_SHORT
Definition: ipshell.cc:5504
static BOOLEAN rSleftvList2StringArray(leftv sl, char **p)
Definition: ipshell.cc:5468
opposite of ls
Definition: ring.h:691
int listLength()
Definition: subexpr.cc:61
void WerrorS(const char *s)
Definition: feFopen.cc:24
char * char_ptr
Definition: structs.h:56
static int rBlocks(ring r)
Definition: ring.h:513
BOOLEAN rComplete(ring r, int force)
this needs to be called whenever a new ring is created: new fields in ring are created (like VarOffse...
Definition: ring.cc:3436
int j
Definition: myNF.cc:70
#define omFree(addr)
Definition: omAllocDecl.h:261
ring rCopy0(const ring r, BOOLEAN copy_qideal, BOOLEAN copy_ordering)
Definition: ring.cc:1318
const ring R
Definition: DebugPrint.cc:36
#define rTest(r)
Definition: ring.h:778
int i
Definition: cfEzgcd.cc:123
#define NULL
Definition: omList.c:10
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:448
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
int perm[100]
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:94
lists scIndIndset ( ideal  S,
BOOLEAN  all,
ideal  Q 
)

Definition at line 1023 of file ipshell.cc.

1024 {
1025  int i;
1026  indset save;
1028 
1029  hexist = hInit(S, Q, &hNexist, currRing);
1030  if (hNexist == 0)
1031  {
1032  intvec *iv=new intvec(rVar(currRing));
1033  for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1034  res->Init(1);
1035  res->m[0].rtyp=INTVEC_CMD;
1036  res->m[0].data=(intvec*)iv;
1037  return res;
1038  }
1039  else if (hisModule!=0)
1040  {
1041  res->Init(0);
1042  return res;
1043  }
1044  save = ISet = (indset)omAlloc0Bin(indlist_bin);
1045  hMu = 0;
1046  hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1047  hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1048  hpure = (scmon)omAlloc((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1049  hrad = hexist;
1050  hNrad = hNexist;
1051  radmem = hCreate(rVar(currRing) - 1);
1052  hCo = rVar(currRing) + 1;
1053  hNvar = rVar(currRing);
1054  hRadical(hrad, &hNrad, hNvar);
1055  hSupp(hrad, hNrad, hvar, &hNvar);
1056  if (hNvar)
1057  {
1058  hCo = hNvar;
1059  memset(hpure, 0, (rVar(currRing) + 1) * sizeof(long));
1060  hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1061  hLexR(hrad, hNrad, hvar, hNvar);
1063  }
1064  if (hCo && (hCo < rVar(currRing)))
1065  {
1067  }
1068  if (hMu!=0)
1069  {
1070  ISet = save;
1071  hMu2 = 0;
1072  if (all && (hCo+1 < rVar(currRing)))
1073  {
1076  i=hMu+hMu2;
1077  res->Init(i);
1078  if (hMu2 == 0)
1079  {
1081  }
1082  }
1083  else
1084  {
1085  res->Init(hMu);
1086  }
1087  for (i=0;i<hMu;i++)
1088  {
1089  res->m[i].data = (void *)save->set;
1090  res->m[i].rtyp = INTVEC_CMD;
1091  ISet = save;
1092  save = save->nx;
1094  }
1095  omFreeBin((ADDRESS)save, indlist_bin);
1096  if (hMu2 != 0)
1097  {
1098  save = JSet;
1099  for (i=hMu;i<hMu+hMu2;i++)
1100  {
1101  res->m[i].data = (void *)save->set;
1102  res->m[i].rtyp = INTVEC_CMD;
1103  JSet = save;
1104  save = save->nx;
1106  }
1107  omFreeBin((ADDRESS)save, indlist_bin);
1108  }
1109  }
1110  else
1111  {
1112  res->Init(0);
1114  }
1115  hKill(radmem, rVar(currRing) - 1);
1116  omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1117  omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1118  omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1120  return res;
1121 }
int hMu2
Definition: hdegree.cc:22
sleftv * m
Definition: lists.h:45
void hDimSolve(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:29
scfmon hwork
Definition: hutil.cc:19
void hIndAllMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:496
int hNexist
Definition: hutil.cc:22
int * varset
Definition: hutil.h:21
int hCo
Definition: hdegree.cc:22
Definition: lists.h:22
scmon * scfmon
Definition: hutil.h:20
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
scfmon hexist
Definition: hutil.cc:19
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:537
monf hCreate(int Nvar)
Definition: hutil.cc:1002
int hNvar
Definition: hutil.cc:22
void * ADDRESS
Definition: auxiliary.h:161
int hNrad
Definition: hutil.cc:22
int hNpure
Definition: hutil.cc:22
scmon hpure
Definition: hutil.cc:20
#define Q
Definition: sirandom.c:25
void hRadical(scfmon rad, int *Nrad, int Nvar)
Definition: hutil.cc:417
#define omAlloc(size)
Definition: omAllocDecl.h:210
scfmon hrad
Definition: hutil.cc:19
void * data
Definition: subexpr.h:89
void hDelete(scfmon ev, int ev_length)
Definition: hutil.cc:146
poly res
Definition: myNF.cc:322
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
indset ISet
Definition: hdegree.cc:279
Definition: intvec.h:14
void hKill(monf xmem, int Nvar)
Definition: hutil.cc:1016
varset hvar
Definition: hutil.cc:21
void hIndMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:313
indlist * indset
Definition: hutil.h:33
void hPure(scfmon stc, int a, int *Nstc, varset var, int Nvar, scmon pure, int *Npure)
Definition: hutil.cc:627
omBin indlist_bin
Definition: hdegree.cc:23
indset JSet
Definition: hdegree.cc:279
int * scmon
Definition: hutil.h:19
int i
Definition: cfEzgcd.cc:123
void hLexR(scfmon rad, int Nrad, varset var, int Nvar)
Definition: hutil.cc:571
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
monf radmem
Definition: hutil.cc:24
int rtyp
Definition: subexpr.h:92
omBin slists_bin
Definition: lists.cc:23
int hisModule
Definition: hutil.cc:23
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
scfmon hInit(ideal S, ideal Q, int *Nexist, ring tailRing)
Definition: hutil.cc:34
int hMu
Definition: hdegree.cc:22
void hSupp(scfmon stc, int Nstc, varset var, int *Nvar)
Definition: hutil.cc:180
BOOLEAN semicProc ( leftv  res,
leftv  u,
leftv  v 
)

Definition at line 4466 of file ipshell.cc.

4467 {
4468  sleftv tmp;
4469  memset(&tmp,0,sizeof(tmp));
4470  tmp.rtyp=INT_CMD;
4471  /* tmp.data = (void *)0; -- done by memset */
4472 
4473  return semicProc3(res,u,v,&tmp);
4474 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:98
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4426
int rtyp
Definition: subexpr.h:92
BOOLEAN semicProc3 ( leftv  res,
leftv  u,
leftv  v,
leftv  w 
)

Definition at line 4426 of file ipshell.cc.

4427 {
4428  semicState state;
4429  BOOLEAN qh=(((int)(long)w->Data())==1);
4430 
4431  // -----------------
4432  // check arguments
4433  // -----------------
4434 
4435  lists l1 = (lists)u->Data( );
4436  lists l2 = (lists)v->Data( );
4437 
4438  if( (state=list_is_spectrum( l1 ))!=semicOK )
4439  {
4440  WerrorS( "first argument is not a spectrum" );
4441  list_error( state );
4442  }
4443  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4444  {
4445  WerrorS( "second argument is not a spectrum" );
4446  list_error( state );
4447  }
4448  else
4449  {
4450  spectrum s1= spectrumFromList( l1 );
4451  spectrum s2= spectrumFromList( l2 );
4452 
4453  res->rtyp = INT_CMD;
4454  if (qh)
4455  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4456  else
4457  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4458  }
4459 
4460  // -----------------
4461  // check status
4462  // -----------------
4463 
4464  return (state!=semicOK);
4465 }
Definition: tok.h:98
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3299
void list_error(semicState state)
Definition: ipshell.cc:3383
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
void * data
Definition: subexpr.h:89
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4168
int mult_spectrumh(spectrum &)
Definition: semic.cc:425
semicState
Definition: ipshell.cc:3349
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1118
int BOOLEAN
Definition: auxiliary.h:131
int mult_spectrum(spectrum &)
Definition: semic.cc:396
BOOLEAN spaddProc ( leftv  result,
leftv  first,
leftv  second 
)

Definition at line 4343 of file ipshell.cc.

4344 {
4345  semicState state;
4346 
4347  // -----------------
4348  // check arguments
4349  // -----------------
4350 
4351  lists l1 = (lists)first->Data( );
4352  lists l2 = (lists)second->Data( );
4353 
4354  if( (state=list_is_spectrum( l1 )) != semicOK )
4355  {
4356  WerrorS( "first argument is not a spectrum:" );
4357  list_error( state );
4358  }
4359  else if( (state=list_is_spectrum( l2 )) != semicOK )
4360  {
4361  WerrorS( "second argument is not a spectrum:" );
4362  list_error( state );
4363  }
4364  else
4365  {
4366  spectrum s1= spectrumFromList ( l1 );
4367  spectrum s2= spectrumFromList ( l2 );
4368  spectrum sum( s1+s2 );
4369 
4370  result->rtyp = LIST_CMD;
4371  result->data = (char*)(getList(sum));
4372  }
4373 
4374  return (state!=semicOK);
4375 }
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3299
void list_error(semicState state)
Definition: ipshell.cc:3383
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
lists getList(spectrum &spec)
Definition: ipshell.cc:3311
void * data
Definition: subexpr.h:89
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4168
semicState
Definition: ipshell.cc:3349
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1118
Definition: tok.h:120
spectrumState spectrumCompute ( poly  h,
lists L,
int  fast 
)

Definition at line 3725 of file ipshell.cc.

3726 {
3727  int i;
3728 
3729  #ifdef SPECTRUM_DEBUG
3730  #ifdef SPECTRUM_PRINT
3731  #ifdef SPECTRUM_IOSTREAM
3732  cout << "spectrumCompute\n";
3733  if( fast==0 ) cout << " no optimization" << endl;
3734  if( fast==1 ) cout << " weight optimization" << endl;
3735  if( fast==2 ) cout << " symmetry optimization" << endl;
3736  #else
3737  fprintf( stdout,"spectrumCompute\n" );
3738  if( fast==0 ) fprintf( stdout," no optimization\n" );
3739  if( fast==1 ) fprintf( stdout," weight optimization\n" );
3740  if( fast==2 ) fprintf( stdout," symmetry optimization\n" );
3741  #endif
3742  #endif
3743  #endif
3744 
3745  // ----------------------
3746  // check if h is zero
3747  // ----------------------
3748 
3749  if( h==(poly)NULL )
3750  {
3751  return spectrumZero;
3752  }
3753 
3754  // ----------------------------------
3755  // check if h has a constant term
3756  // ----------------------------------
3757 
3758  if( hasConstTerm( h, currRing ) )
3759  {
3760  return spectrumBadPoly;
3761  }
3762 
3763  // --------------------------------
3764  // check if h has a linear term
3765  // --------------------------------
3766 
3767  if( hasLinearTerm( h, currRing ) )
3768  {
3769  *L = (lists)omAllocBin( slists_bin);
3770  (*L)->Init( 1 );
3771  (*L)->m[0].rtyp = INT_CMD; // milnor number
3772  /* (*L)->m[0].data = (void*)0;a -- done by Init */
3773 
3774  return spectrumNoSingularity;
3775  }
3776 
3777  // ----------------------------------
3778  // compute the jacobi ideal of (h)
3779  // ----------------------------------
3780 
3781  ideal J = NULL;
3782  J = idInit( rVar(currRing),1 );
3783 
3784  #ifdef SPECTRUM_DEBUG
3785  #ifdef SPECTRUM_PRINT
3786  #ifdef SPECTRUM_IOSTREAM
3787  cout << "\n computing the Jacobi ideal...\n";
3788  #else
3789  fprintf( stdout,"\n computing the Jacobi ideal...\n" );
3790  #endif
3791  #endif
3792  #endif
3793 
3794  for( i=0; i<rVar(currRing); i++ )
3795  {
3796  J->m[i] = pDiff( h,i+1); //j );
3797 
3798  #ifdef SPECTRUM_DEBUG
3799  #ifdef SPECTRUM_PRINT
3800  #ifdef SPECTRUM_IOSTREAM
3801  cout << " ";
3802  #else
3803  fprintf( stdout," " );
3804  #endif
3805  pWrite( J->m[i] );
3806  #endif
3807  #endif
3808  }
3809 
3810  // --------------------------------------------
3811  // compute a standard basis stdJ of jac(h)
3812  // --------------------------------------------
3813 
3814  #ifdef SPECTRUM_DEBUG
3815  #ifdef SPECTRUM_PRINT
3816  #ifdef SPECTRUM_IOSTREAM
3817  cout << endl;
3818  cout << " computing a standard basis..." << endl;
3819  #else
3820  fprintf( stdout,"\n" );
3821  fprintf( stdout," computing a standard basis...\n" );
3822  #endif
3823  #endif
3824  #endif
3825 
3826  ideal stdJ = kStd(J,currRing->qideal,isNotHomog,NULL);
3827  idSkipZeroes( stdJ );
3828 
3829  #ifdef SPECTRUM_DEBUG
3830  #ifdef SPECTRUM_PRINT
3831  for( i=0; i<IDELEMS(stdJ); i++ )
3832  {
3833  #ifdef SPECTRUM_IOSTREAM
3834  cout << " ";
3835  #else
3836  fprintf( stdout," " );
3837  #endif
3838 
3839  pWrite( stdJ->m[i] );
3840  }
3841  #endif
3842  #endif
3843 
3844  idDelete( &J );
3845 
3846  // ------------------------------------------
3847  // check if the h has a singularity
3848  // ------------------------------------------
3849 
3850  if( hasOne( stdJ, currRing ) )
3851  {
3852  // -------------------------------
3853  // h is smooth in the origin
3854  // return only the Milnor number
3855  // -------------------------------
3856 
3857  *L = (lists)omAllocBin( slists_bin);
3858  (*L)->Init( 1 );
3859  (*L)->m[0].rtyp = INT_CMD; // milnor number
3860  /* (*L)->m[0].data = (void*)0;a -- done by Init */
3861 
3862  return spectrumNoSingularity;
3863  }
3864 
3865  // ------------------------------------------
3866  // check if the singularity h is isolated
3867  // ------------------------------------------
3868 
3869  for( i=rVar(currRing); i>0; i-- )
3870  {
3871  if( hasAxis( stdJ,i, currRing )==FALSE )
3872  {
3873  return spectrumNotIsolated;
3874  }
3875  }
3876 
3877  // ------------------------------------------
3878  // compute the highest corner hc of stdJ
3879  // ------------------------------------------
3880 
3881  #ifdef SPECTRUM_DEBUG
3882  #ifdef SPECTRUM_PRINT
3883  #ifdef SPECTRUM_IOSTREAM
3884  cout << "\n computing the highest corner...\n";
3885  #else
3886  fprintf( stdout,"\n computing the highest corner...\n" );
3887  #endif
3888  #endif
3889  #endif
3890 
3891  poly hc = (poly)NULL;
3892 
3893  scComputeHC( stdJ,currRing->qideal, 0,hc );
3894 
3895  if( hc!=(poly)NULL )
3896  {
3897  pGetCoeff(hc) = nInit(1);
3898 
3899  for( i=rVar(currRing); i>0; i-- )
3900  {
3901  if( pGetExp( hc,i )>0 ) pDecrExp( hc,i );
3902  }
3903  pSetm( hc );
3904  }
3905  else
3906  {
3907  return spectrumNoHC;
3908  }
3909 
3910  #ifdef SPECTRUM_DEBUG
3911  #ifdef SPECTRUM_PRINT
3912  #ifdef SPECTRUM_IOSTREAM
3913  cout << " ";
3914  #else
3915  fprintf( stdout," " );
3916  #endif
3917  pWrite( hc );
3918  #endif
3919  #endif
3920 
3921  // ----------------------------------------
3922  // compute the Newton polygon nph of h
3923  // ----------------------------------------
3924 
3925  #ifdef SPECTRUM_DEBUG
3926  #ifdef SPECTRUM_PRINT
3927  #ifdef SPECTRUM_IOSTREAM
3928  cout << "\n computing the newton polygon...\n";
3929  #else
3930  fprintf( stdout,"\n computing the newton polygon...\n" );
3931  #endif
3932  #endif
3933  #endif
3934 
3935  newtonPolygon nph( h, currRing );
3936 
3937  #ifdef SPECTRUM_DEBUG
3938  #ifdef SPECTRUM_PRINT
3939  cout << nph;
3940  #endif
3941  #endif
3942 
3943  // -----------------------------------------------
3944  // compute the weight corner wc of (stdj,nph)
3945  // -----------------------------------------------
3946 
3947  #ifdef SPECTRUM_DEBUG
3948  #ifdef SPECTRUM_PRINT
3949  #ifdef SPECTRUM_IOSTREAM
3950  cout << "\n computing the weight corner...\n";
3951  #else
3952  fprintf( stdout,"\n computing the weight corner...\n" );
3953  #endif
3954  #endif
3955  #endif
3956 
3957  poly wc = ( fast==0 ? pCopy( hc ) :
3958  ( fast==1 ? computeWC( nph,(Rational)rVar(currRing), currRing ) :
3959  /* fast==2 */computeWC( nph,
3960  ((Rational)rVar(currRing))/(Rational)2, currRing ) ) );
3961 
3962  #ifdef SPECTRUM_DEBUG
3963  #ifdef SPECTRUM_PRINT
3964  #ifdef SPECTRUM_IOSTREAM
3965  cout << " ";
3966  #else
3967  fprintf( stdout," " );
3968  #endif
3969  pWrite( wc );
3970  #endif
3971  #endif
3972 
3973  // -------------
3974  // compute NF
3975  // -------------
3976 
3977  #ifdef SPECTRUM_DEBUG
3978  #ifdef SPECTRUM_PRINT
3979  #ifdef SPECTRUM_IOSTREAM
3980  cout << "\n computing NF...\n" << endl;
3981  #else
3982  fprintf( stdout,"\n computing NF...\n" );
3983  #endif
3984  #endif
3985  #endif
3986 
3987  spectrumPolyList NF( &nph );
3988 
3989  computeNF( stdJ,hc,wc,&NF, currRing );
3990 
3991  #ifdef SPECTRUM_DEBUG
3992  #ifdef SPECTRUM_PRINT
3993  cout << NF;
3994  #ifdef SPECTRUM_IOSTREAM
3995  cout << endl;
3996  #else
3997  fprintf( stdout,"\n" );
3998  #endif
3999  #endif
4000  #endif
4001 
4002  // ----------------------------
4003  // compute the spectrum of h
4004  // ----------------------------
4005 // spectrumState spectrumStateFromList( spectrumPolyList& speclist, lists *L, int fast );
4006 
4007  return spectrumStateFromList(NF, L, fast );
4008 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
#define pSetm(p)
Definition: polys.h:241
Definition: tok.h:98
#define idDelete(H)
delete an ideal
Definition: ideals.h:31
#define FALSE
Definition: auxiliary.h:140
#define pDecrExp(p, i)
Definition: polys.h:44
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:537
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge, ring tailRing)
Definition: hdegree.cc:1005
ideal kStd(ideal F, ideal Q, tHomog h, intvec **w, intvec *hilb, int syzComp, int newIdeal, intvec *vw, s_poly_proc_t sp)
Definition: kstd1.cc:2225
void pWrite(poly p)
Definition: polys.h:279
BOOLEAN hasConstTerm(poly h, const ring r)
Definition: spectrum.h:28
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy ...
Definition: monomials.h:51
int hasOne(ideal J, const ring r)
Definition: spectrum.cc:96
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
BOOLEAN hasLinearTerm(poly h, const ring r)
Definition: spectrum.h:30
spectrumState spectrumStateFromList(spectrumPolyList &speclist, lists *L, int fast)
Definition: ipshell.cc:3484
void computeNF(ideal stdJ, poly hc, poly wc, spectrumPolyList *NF, const ring r)
Definition: spectrum.cc:309
BOOLEAN hasAxis(ideal J, int k, const ring r)
Definition: spectrum.cc:81
int i
Definition: cfEzgcd.cc:123
#define IDELEMS(i)
Definition: simpleideals.h:24
void idSkipZeroes(ideal ide)
gives an ideal/module the minimal possible size
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
omBin slists_bin
Definition: lists.cc:23
#define pDiff(a, b)
Definition: polys.h:267
polyrec * poly
Definition: hilb.h:10
#define nInit(i)
Definition: numbers.h:24
static Poly * h
Definition: janet.cc:978
#define pCopy(p)
return a copy of the poly
Definition: polys.h:156
poly computeWC(const newtonPolygon &np, Rational max_weight, const ring r)
Definition: spectrum.cc:142
BOOLEAN spectrumfProc ( leftv  result,
leftv  first 
)

Definition at line 4099 of file ipshell.cc.

4100 {
4101  spectrumState state = spectrumOK;
4102 
4103  // -------------------
4104  // check consistency
4105  // -------------------
4106 
4107  // check for a local polynomial ring
4108 
4109  if( currRing->OrdSgn != -1 )
4110  // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4111  // or should we use:
4112  //if( !ringIsLocal( ) )
4113  {
4114  WerrorS( "only works for local orderings" );
4115  state = spectrumWrongRing;
4116  }
4117  else if( currRing->qideal != NULL )
4118  {
4119  WerrorS( "does not work in quotient rings" );
4120  state = spectrumWrongRing;
4121  }
4122  else
4123  {
4124  lists L = (lists)NULL;
4125  int flag = 2; // symmetric optimization
4126 
4127  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4128 
4129  if( state==spectrumOK )
4130  {
4131  result->rtyp = LIST_CMD;
4132  result->data = (char*)L;
4133  }
4134  else
4135  {
4136  spectrumPrintError(state);
4137  }
4138  }
4139 
4140  return (state!=spectrumOK);
4141 }
spectrumState
Definition: ipshell.cc:3465
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:24
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:4017
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3725
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1118
Definition: tok.h:120
polyrec * poly
Definition: hilb.h:10
spectrum spectrumFromList ( lists  l)

Definition at line 3299 of file ipshell.cc.

3300 {
3301  spectrum result;
3302  copy_deep( result, l );
3303  return result;
3304 }
Definition: semic.h:63
void copy_deep(spectrum &spec, lists l)
Definition: ipshell.cc:3275
return result
Definition: facAbsBiFact.cc:76
void spectrumPrintError ( spectrumState  state)

Definition at line 4017 of file ipshell.cc.

4018 {
4019  switch( state )
4020  {
4021  case spectrumZero:
4022  WerrorS( "polynomial is zero" );
4023  break;
4024  case spectrumBadPoly:
4025  WerrorS( "polynomial has constant term" );
4026  break;
4027  case spectrumNoSingularity:
4028  WerrorS( "not a singularity" );
4029  break;
4030  case spectrumNotIsolated:
4031  WerrorS( "the singularity is not isolated" );
4032  break;
4033  case spectrumNoHC:
4034  WerrorS( "highest corner cannot be computed" );
4035  break;
4036  case spectrumDegenerate:
4037  WerrorS( "principal part is degenerate" );
4038  break;
4039  case spectrumOK:
4040  break;
4041 
4042  default:
4043  WerrorS( "unknown error occurred" );
4044  break;
4045  }
4046 }
void WerrorS(const char *s)
Definition: feFopen.cc:24
BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4048 of file ipshell.cc.

4049 {
4050  spectrumState state = spectrumOK;
4051 
4052  // -------------------
4053  // check consistency
4054  // -------------------
4055 
4056  // check for a local ring
4057 
4058  if( !ringIsLocal(currRing ) )
4059  {
4060  WerrorS( "only works for local orderings" );
4061  state = spectrumWrongRing;
4062  }
4063 
4064  // no quotient rings are allowed
4065 
4066  else if( currRing->qideal != NULL )
4067  {
4068  WerrorS( "does not work in quotient rings" );
4069  state = spectrumWrongRing;
4070  }
4071  else
4072  {
4073  lists L = (lists)NULL;
4074  int flag = 1; // weight corner optimization is safe
4075 
4076  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4077 
4078  if( state==spectrumOK )
4079  {
4080  result->rtyp = LIST_CMD;
4081  result->data = (char*)L;
4082  }
4083  else
4084  {
4085  spectrumPrintError(state);
4086  }
4087  }
4088 
4089  return (state!=spectrumOK);
4090 }
spectrumState
Definition: ipshell.cc:3465
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:24
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:4017
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3725
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1118
Definition: tok.h:120
BOOLEAN ringIsLocal(const ring r)
Definition: spectrum.cc:461
polyrec * poly
Definition: hilb.h:10
spectrumState spectrumStateFromList ( spectrumPolyList speclist,
lists L,
int  fast 
)

Definition at line 3484 of file ipshell.cc.

3485 {
3486  spectrumPolyNode **node = &speclist.root;
3488 
3489  poly f,tmp;
3490  int found,cmp;
3491 
3492  Rational smax( ( fast==0 ? 0 : rVar(currRing) ),
3493  ( fast==2 ? 2 : 1 ) );
3494 
3495  Rational weight_prev( 0,1 );
3496 
3497  int mu = 0; // the milnor number
3498  int pg = 0; // the geometrical genus
3499  int n = 0; // number of different spectral numbers
3500  int z = 0; // number of spectral number equal to smax
3501 
3502  while( (*node)!=(spectrumPolyNode*)NULL &&
3503  ( fast==0 || (*node)->weight<=smax ) )
3504  {
3505  // ---------------------------------------
3506  // determine the first normal form which
3507  // contains the monomial node->mon
3508  // ---------------------------------------
3509 
3510  found = FALSE;
3511  search = *node;
3512 
3513  while( search!=(spectrumPolyNode*)NULL && found==FALSE )
3514  {
3515  if( search->nf!=(poly)NULL )
3516  {
3517  f = search->nf;
3518 
3519  do
3520  {
3521  // --------------------------------
3522  // look for (*node)->mon in f
3523  // --------------------------------
3524 
3525  cmp = pCmp( (*node)->mon,f );
3526 
3527  if( cmp<0 )
3528  {
3529  f = pNext( f );
3530  }
3531  else if( cmp==0 )
3532  {
3533  // -----------------------------
3534  // we have found a normal form
3535  // -----------------------------
3536 
3537  found = TRUE;
3538 
3539  // normalize coefficient
3540 
3541  number inv = nInvers( pGetCoeff( f ) );
3542  pMult_nn( search->nf,inv );
3543  nDelete( &inv );
3544 
3545  // exchange normal forms
3546 
3547  tmp = (*node)->nf;
3548  (*node)->nf = search->nf;
3549  search->nf = tmp;
3550  }
3551  }
3552  while( cmp<0 && f!=(poly)NULL );
3553  }
3554  search = search->next;
3555  }
3556 
3557  if( found==FALSE )
3558  {
3559  // ------------------------------------------------
3560  // the weight of node->mon is a spectrum number
3561  // ------------------------------------------------
3562 
3563  mu++;
3564 
3565  if( (*node)->weight<=(Rational)1 ) pg++;
3566  if( (*node)->weight==smax ) z++;
3567  if( (*node)->weight>weight_prev ) n++;
3568 
3569  weight_prev = (*node)->weight;
3570  node = &((*node)->next);
3571  }
3572  else
3573  {
3574  // -----------------------------------------------
3575  // determine all other normal form which contain
3576  // the monomial node->mon
3577  // replace for node->mon its normal form
3578  // -----------------------------------------------
3579 
3580  while( search!=(spectrumPolyNode*)NULL )
3581  {
3582  if( search->nf!=(poly)NULL )
3583  {
3584  f = search->nf;
3585 
3586  do
3587  {
3588  // --------------------------------
3589  // look for (*node)->mon in f
3590  // --------------------------------
3591 
3592  cmp = pCmp( (*node)->mon,f );
3593 
3594  if( cmp<0 )
3595  {
3596  f = pNext( f );
3597  }
3598  else if( cmp==0 )
3599  {
3600  search->nf = pSub( search->nf,
3601  ppMult_nn( (*node)->nf,pGetCoeff( f ) ) );
3602  pNorm( search->nf );
3603  }
3604  }
3605  while( cmp<0 && f!=(poly)NULL );
3606  }
3607  search = search->next;
3608  }
3609  speclist.delete_node( node );
3610  }
3611 
3612  }
3613 
3614  // --------------------------------------------------------
3615  // fast computation exploits the symmetry of the spectrum
3616  // --------------------------------------------------------
3617 
3618  if( fast==2 )
3619  {
3620  mu = 2*mu - z;
3621  n = ( z > 0 ? 2*n - 1 : 2*n );
3622  }
3623 
3624  // --------------------------------------------------------
3625  // compute the spectrum numbers with their multiplicities
3626  // --------------------------------------------------------
3627 
3628  intvec *nom = new intvec( n );
3629  intvec *den = new intvec( n );
3630  intvec *mult = new intvec( n );
3631 
3632  int count = 0;
3633  int multiplicity = 1;
3634 
3635  for( search=speclist.root; search!=(spectrumPolyNode*)NULL &&
3636  ( fast==0 || search->weight<=smax );
3637  search=search->next )
3638  {
3639  if( search->next==(spectrumPolyNode*)NULL ||
3640  search->weight<search->next->weight )
3641  {
3642  (*nom) [count] = search->weight.get_num_si( );
3643  (*den) [count] = search->weight.get_den_si( );
3644  (*mult)[count] = multiplicity;
3645 
3646  multiplicity=1;
3647  count++;
3648  }
3649  else
3650  {
3651  multiplicity++;
3652  }
3653  }
3654 
3655  // --------------------------------------------------------
3656  // fast computation exploits the symmetry of the spectrum
3657  // --------------------------------------------------------
3658 
3659  if( fast==2 )
3660  {
3661  int n1,n2;
3662  for( n1=0, n2=n-1; n1<n2; n1++, n2-- )
3663  {
3664  (*nom) [n2] = rVar(currRing)*(*den)[n1]-(*nom)[n1];
3665  (*den) [n2] = (*den)[n1];
3666  (*mult)[n2] = (*mult)[n1];
3667  }
3668  }
3669 
3670  // -----------------------------------
3671  // test if the spectrum is symmetric
3672  // -----------------------------------
3673 
3674  if( fast==0 || fast==1 )
3675  {
3676  int symmetric=TRUE;
3677 
3678  for( int n1=0, n2=n-1 ; n1<n2 && symmetric==TRUE; n1++, n2-- )
3679  {
3680  if( (*mult)[n1]!=(*mult)[n2] ||
3681  (*den) [n1]!= (*den)[n2] ||
3682  (*nom)[n1]+(*nom)[n2]!=rVar(currRing)*(*den) [n1] )
3683  {
3684  symmetric = FALSE;
3685  }
3686  }
3687 
3688  if( symmetric==FALSE )
3689  {
3690  // ---------------------------------------------
3691  // the spectrum is not symmetric => degenerate
3692  // principal part
3693  // ---------------------------------------------
3694 
3695  *L = (lists)omAllocBin( slists_bin);
3696  (*L)->Init( 1 );
3697  (*L)->m[0].rtyp = INT_CMD; // milnor number
3698  (*L)->m[0].data = (void*)(long)mu;
3699 
3700  return spectrumDegenerate;
3701  }
3702  }
3703 
3704  *L = (lists)omAllocBin( slists_bin);
3705 
3706  (*L)->Init( 6 );
3707 
3708  (*L)->m[0].rtyp = INT_CMD; // milnor number
3709  (*L)->m[1].rtyp = INT_CMD; // geometrical genus
3710  (*L)->m[2].rtyp = INT_CMD; // number of spectrum values
3711  (*L)->m[3].rtyp = INTVEC_CMD; // nominators
3712  (*L)->m[4].rtyp = INTVEC_CMD; // denomiantors
3713  (*L)->m[5].rtyp = INTVEC_CMD; // multiplicities
3714 
3715  (*L)->m[0].data = (void*)(long)mu;
3716  (*L)->m[1].data = (void*)(long)pg;
3717  (*L)->m[2].data = (void*)(long)n;
3718  (*L)->m[3].data = (void*)nom;
3719  (*L)->m[4].data = (void*)den;
3720  (*L)->m[5].data = (void*)mult;
3721 
3722  return spectrumOK;
3723 }
int status int void size_t count
Definition: si_signals.h:59
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
spectrumPolyNode * next
Definition: splist.h:39
void mu(int **points, int sizePoints)
Definition: tok.h:98
Rational weight
Definition: splist.h:41
#define FALSE
Definition: auxiliary.h:140
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:537
static int * multiplicity
int get_den_si()
Definition: GMPrat.cc:159
#define pCmp(p1, p2)
pCmp: args may be NULL returns: (p2==NULL ? 1 : (p1 == NULL ? -1 : p_LmCmp(p1, p2))) ...
Definition: polys.h:115
#define TRUE
Definition: auxiliary.h:144
int get_num_si()
Definition: GMPrat.cc:145
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy ...
Definition: monomials.h:51
bool found
Definition: facFactorize.cc:56
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
spectrumPolyNode * root
Definition: splist.h:60
Definition: intvec.h:14
#define pSub(a, b)
Definition: polys.h:258
int search(const CFArray &A, const CanonicalForm &F, int i, int j)
search for F in A between index i and j
#define pMult_nn(p, n)
Definition: polys.h:171
FILE * f
Definition: checklibs.c:7
#define nDelete(n)
Definition: numbers.h:16
#define nInvers(a)
Definition: numbers.h:33
#define ppMult_nn(p, n)
Definition: polys.h:170
void mult(unsigned long *result, unsigned long *a, unsigned long *b, unsigned long p, int dega, int degb)
Definition: minpoly.cc:649
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
CanonicalForm den(const CanonicalForm &f)
void pNorm(poly p, const ring R=currRing)
Definition: polys.h:334
#define pNext(p)
Definition: monomials.h:43
omBin slists_bin
Definition: lists.cc:23
polyrec * poly
Definition: hilb.h:10
void delete_node(spectrumPolyNode **)
Definition: splist.cc:256
BOOLEAN spmulProc ( leftv  result,
leftv  first,
leftv  second 
)

Definition at line 4385 of file ipshell.cc.

4386 {
4387  semicState state;
4388 
4389  // -----------------
4390  // check arguments
4391  // -----------------
4392 
4393  lists l = (lists)first->Data( );
4394  int k = (int)(long)second->Data( );
4395 
4396  if( (state=list_is_spectrum( l ))!=semicOK )
4397  {
4398  WerrorS( "first argument is not a spectrum" );
4399  list_error( state );
4400  }
4401  else if( k < 0 )
4402  {
4403  WerrorS( "second argument should be positive" );
4404  state = semicMulNegative;
4405  }
4406  else
4407  {
4408  spectrum s= spectrumFromList( l );
4409  spectrum product( k*s );
4410 
4411  result->rtyp = LIST_CMD;
4412  result->data = (char*)getList(product);
4413  }
4414 
4415  return (state!=semicOK);
4416 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3299
void list_error(semicState state)
Definition: ipshell.cc:3383
void WerrorS(const char *s)
Definition: feFopen.cc:24
int k
Definition: cfEzgcd.cc:93
Definition: semic.h:63
lists getList(spectrum &spec)
Definition: ipshell.cc:3311
void * data
Definition: subexpr.h:89
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4168
semicState
Definition: ipshell.cc:3349
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1118
Definition: tok.h:120
int l
Definition: cfEzgcd.cc:94
BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3085 of file ipshell.cc.

3086 {
3087  sleftv tmp;
3088  memset(&tmp,0,sizeof(tmp));
3089  tmp.rtyp=INT_CMD;
3090  tmp.data=(void *)1;
3091  return syBetti2(res,u,&tmp);
3092 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:98
void * data
Definition: subexpr.h:89
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3062
int rtyp
Definition: subexpr.h:92
BOOLEAN syBetti2 ( leftv  res,
leftv  u,
leftv  w 
)

Definition at line 3062 of file ipshell.cc.

3063 {
3064  syStrategy syzstr=(syStrategy)u->Data();
3065 
3066  BOOLEAN minim=(int)(long)w->Data();
3067  int row_shift=0;
3068  int add_row_shift=0;
3069  intvec *weights=NULL;
3070  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3071  if (ww!=NULL)
3072  {
3073  weights=ivCopy(ww);
3074  add_row_shift = ww->min_in();
3075  (*weights) -= add_row_shift;
3076  }
3077 
3078  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3079  //row_shift += add_row_shift;
3080  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3081  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3082 
3083  return FALSE;
3084 }
void atSet(idhdl root, const char *name, void *data, int typ)
Definition: attrib.cc:156
Definition: tok.h:98
#define FALSE
Definition: auxiliary.h:140
intvec * ivCopy(const intvec *o)
Definition: intvec.h:126
int min_in()
Definition: intvec.h:113
void * data
Definition: subexpr.h:89
Definition: intvec.h:14
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:135
#define NULL
Definition: omList.c:10
intvec * syBettiOfComputation(syStrategy syzstr, BOOLEAN minim=TRUE, int *row_shift=NULL, intvec *weights=NULL)
Definition: syz1.cc:1767
void * Data()
Definition: subexpr.cc:1118
int BOOLEAN
Definition: auxiliary.h:131
ssyStrategy * syStrategy
Definition: syz.h:35
#define omStrDup(s)
Definition: omAllocDecl.h:263
syStrategy syConvList ( lists  li,
BOOLEAN  toDel 
)

Definition at line 3170 of file ipshell.cc.

3171 {
3172  int typ0;
3174 
3175  resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3176  if (fr != NULL)
3177  {
3178 
3179  result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3180  for (int i=result->length-1;i>=0;i--)
3181  {
3182  if (fr[i]!=NULL)
3183  result->fullres[i] = idCopy(fr[i]);
3184  }
3185  result->list_length=result->length;
3186  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3187  }
3188  else
3189  {
3190  omFreeSize(result, sizeof(ssyStrategy));
3191  result = NULL;
3192  }
3193  if (toDel) li->Clean();
3194  return result;
3195 }
int length
Definition: syz.h:60
intvec ** weights
Definition: syz.h:45
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:313
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:161
int i
Definition: cfEzgcd.cc:123
resolvente fullres
Definition: syz.h:57
ideal idCopy(ideal A)
Definition: ideals.h:73
#define NULL
Definition: omList.c:10
void Clean(ring r=currRing)
Definition: lists.h:25
short list_length
Definition: syz.h:62
ideal * resolvente
Definition: ideals.h:20
#define omAlloc0(size)
Definition: omAllocDecl.h:211
return result
Definition: facAbsBiFact.cc:76
ssyStrategy * syStrategy
Definition: syz.h:35
lists syConvRes ( syStrategy  syzstr,
BOOLEAN  toDel,
int  add_row_shift 
)

Definition at line 3097 of file ipshell.cc.

3098 {
3099  resolvente fullres = syzstr->fullres;
3100  resolvente minres = syzstr->minres;
3101 
3102  const int length = syzstr->length;
3103 
3104  if ((fullres==NULL) && (minres==NULL))
3105  {
3106  if (syzstr->hilb_coeffs==NULL)
3107  { // La Scala
3108  fullres = syReorder(syzstr->res, length, syzstr);
3109  }
3110  else
3111  { // HRES
3112  minres = syReorder(syzstr->orderedRes, length, syzstr);
3113  syKillEmptyEntres(minres, length);
3114  }
3115  }
3116 
3117  resolvente tr;
3118  int typ0=IDEAL_CMD;
3119 
3120  if (minres!=NULL)
3121  tr = minres;
3122  else
3123  tr = fullres;
3124 
3125  resolvente trueres=NULL; intvec ** w=NULL;
3126 
3127  if (length>0)
3128  {
3129  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3130  for (int i=(length)-1;i>=0;i--)
3131  {
3132  if (tr[i]!=NULL)
3133  {
3134  trueres[i] = idCopy(tr[i]);
3135  }
3136  }
3137  if ( id_RankFreeModule(trueres[0], currRing) > 0)
3138  typ0 = MODUL_CMD;
3139  if (syzstr->weights!=NULL)
3140  {
3141  w = (intvec**)omAlloc0(length*sizeof(intvec*));
3142  for (int i=length-1;i>=0;i--)
3143  {
3144  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3145  }
3146  }
3147  }
3148 
3149  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3150  w, add_row_shift);
3151 
3152  if (w != NULL) omFreeSize(w, length*sizeof(intvec*));
3153 
3154  if (toDel)
3155  syKillComputation(syzstr);
3156  else
3157  {
3158  if( fullres != NULL && syzstr->fullres == NULL )
3159  syzstr->fullres = fullres;
3160 
3161  if( minres != NULL && syzstr->minres == NULL )
3162  syzstr->minres = minres;
3163  }
3164  return li;
3165 }
int length
Definition: syz.h:60
intvec ** weights
Definition: syz.h:45
resolvente syReorder(resolvente res, int length, syStrategy syzstr, BOOLEAN toCopy=TRUE, resolvente totake=NULL)
Definition: syz1.cc:1653
Definition: lists.h:22
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * ivCopy(const intvec *o)
Definition: intvec.h:126
resolvente res
Definition: syz.h:47
intvec ** hilb_coeffs
Definition: syz.h:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
resolvente orderedRes
Definition: syz.h:48
Definition: intvec.h:14
long id_RankFreeModule(ideal s, ring lmRing, ring tailRing)
return the maximal component number found in any polynomial in s
int i
Definition: cfEzgcd.cc:123
resolvente fullres
Definition: syz.h:57
ideal idCopy(ideal A)
Definition: ideals.h:73
resolvente minres
Definition: syz.h:58
#define NULL
Definition: omList.c:10
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:216
const CanonicalForm & w
Definition: facAbsFact.cc:55
short list_length
Definition: syz.h:62
ideal * resolvente
Definition: ideals.h:20
void syKillEmptyEntres(resolvente res, int length)
Definition: syz1.cc:2209
void syKillComputation(syStrategy syzstr, ring r=currRing)
Definition: syz1.cc:1497
#define omAlloc0(size)
Definition: omAllocDecl.h:211
syStrategy syForceMin ( lists  li)

Definition at line 3200 of file ipshell.cc.

3201 {
3202  int typ0;
3204 
3205  resolvente fr = liFindRes(li,&(result->length),&typ0);
3206  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3207  for (int i=result->length-1;i>=0;i--)
3208  {
3209  if (fr[i]!=NULL)
3210  result->minres[i] = idCopy(fr[i]);
3211  }
3212  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3213  return result;
3214 }
int length
Definition: syz.h:60
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:313
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:161
int i
Definition: cfEzgcd.cc:123
ideal idCopy(ideal A)
Definition: ideals.h:73
resolvente minres
Definition: syz.h:58
#define NULL
Definition: omList.c:10
ideal * resolvente
Definition: ideals.h:20
#define omAlloc0(size)
Definition: omAllocDecl.h:211
return result
Definition: facAbsBiFact.cc:76
ssyStrategy * syStrategy
Definition: syz.h:35
void test_cmd ( int  i)

Definition at line 516 of file ipshell.cc.

517 {
518  int ii;
519 
520  if (i<0)
521  {
522  ii= -i;
523  if (ii < 32)
524  {
525  si_opt_1 &= ~Sy_bit(ii);
526  }
527  else if (ii < 64)
528  {
529  si_opt_2 &= ~Sy_bit(ii-32);
530  }
531  else
532  WerrorS("out of bounds\n");
533  }
534  else if (i<32)
535  {
536  ii=i;
537  if (Sy_bit(ii) & kOptions)
538  {
539  Warn("Gerhard, use the option command");
540  si_opt_1 |= Sy_bit(ii);
541  }
542  else if (Sy_bit(ii) & validOpts)
543  si_opt_1 |= Sy_bit(ii);
544  }
545  else if (i<64)
546  {
547  ii=i-32;
548  si_opt_2 |= Sy_bit(ii);
549  }
550  else
551  WerrorS("out of bounds\n");
552 }
unsigned si_opt_1
Definition: options.c:5
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define Sy_bit(x)
Definition: options.h:30
BITSET validOpts
Definition: kstd1.cc:70
int i
Definition: cfEzgcd.cc:123
BITSET kOptions
Definition: kstd1.cc:55
unsigned si_opt_2
Definition: options.c:6
#define Warn
Definition: emacs.cc:80
void type_cmd ( leftv  v)

Definition at line 246 of file ipshell.cc.

247 {
248  BOOLEAN oldShortOut = FALSE;
249 
250  if (currRing != NULL)
251  {
252  oldShortOut = currRing->ShortOut;
253  currRing->ShortOut = 1;
254  }
255  int t=v->Typ();
256  Print("// %s %s ",v->Name(),Tok2Cmdname(t));
257  switch (t)
258  {
259  case MAP_CMD:Print(" from %s\n",((map)(v->Data()))->preimage); break;
260  case INTMAT_CMD: Print(" %d x %d\n",((intvec*)(v->Data()))->rows(),
261  ((intvec*)(v->Data()))->cols()); break;
262  case MATRIX_CMD:Print(" %u x %u\n" ,
263  MATROWS((matrix)(v->Data())),
264  MATCOLS((matrix)(v->Data())));break;
265  case MODUL_CMD: Print(", rk %d\n", (int)(((ideal)(v->Data()))->rank));break;
266  case LIST_CMD: Print(", size %d\n",((lists)(v->Data()))->nr+1); break;
267 
268  case PROC_CMD:
269  case RING_CMD:
270  case IDEAL_CMD:
271  case QRING_CMD: PrintLn(); break;
272 
273  //case INT_CMD:
274  //case STRING_CMD:
275  //case INTVEC_CMD:
276  //case POLY_CMD:
277  //case VECTOR_CMD:
278  //case PACKAGE_CMD:
279 
280  default:
281  break;
282  }
283  v->Print();
284  if (currRing != NULL)
285  currRing->ShortOut = oldShortOut;
286 }
CanonicalForm map(const CanonicalForm &primElem, const Variable &alpha, const CanonicalForm &F, const Variable &beta)
map from to such that is mapped onto
Definition: cf_map_ext.cc:400
void PrintLn()
Definition: reporter.cc:327
#define Print
Definition: emacs.cc:83
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
int Typ()
Definition: subexpr.cc:976
const char * Name()
Definition: subexpr.h:121
void Print(leftv store=NULL, int spaces=0)
Called by type_cmd (e.g. "r;") or as default in jPRINT.
Definition: subexpr.cc:73
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
Definition: intvec.h:14
#define MATCOLS(i)
Definition: matpol.h:28
#define NULL
Definition: omList.c:10
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:128
void * Data()
Definition: subexpr.cc:1118
Definition: tok.h:120
Definition: tok.h:159
#define MATROWS(i)
Definition: matpol.h:27
int BOOLEAN
Definition: auxiliary.h:131

Variable Documentation

leftv iiCurrArgs =NULL

Definition at line 79 of file ipshell.cc.

idhdl iiCurrProc =NULL

Definition at line 80 of file ipshell.cc.

BOOLEAN iiDebugMarker =TRUE

Definition at line 983 of file ipshell.cc.

BOOLEAN iiNoKeepRing =TRUE
static

Definition at line 83 of file ipshell.cc.

const char* lastreserved =NULL

Definition at line 81 of file ipshell.cc.

const short MAX_SHORT = 32767

Definition at line 5504 of file ipshell.cc.