Macros | Enumerations | Functions | Variables
ipshell.cc File Reference
#include <kernel/mod2.h>
#include <omalloc/omalloc.h>
#include <factory/factory.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 "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)
 
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

§ BREAK_LINE_LENGTH

#define BREAK_LINE_LENGTH   80

Definition at line 989 of file ipshell.cc.

Enumeration Type Documentation

§ semicState

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 3343 of file ipshell.cc.

3344 {
3345  semicOK,
3347 
3350 
3357 
3362 
3368 
3371 
3374 
3375 } semicState;
semicState
Definition: ipshell.cc:3343

§ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3459 of file ipshell.cc.

Function Documentation

§ copy_deep()

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 3269 of file ipshell.cc.

3270 {
3271  spec.mu = (int)(long)(l->m[0].Data( ));
3272  spec.pg = (int)(long)(l->m[1].Data( ));
3273  spec.n = (int)(long)(l->m[2].Data( ));
3274 
3275  spec.copy_new( spec.n );
3276 
3277  intvec *num = (intvec*)l->m[3].Data( );
3278  intvec *den = (intvec*)l->m[4].Data( );
3279  intvec *mul = (intvec*)l->m[5].Data( );
3280 
3281  for( int i=0; i<spec.n; i++ )
3282  {
3283  spec.s[i] = (Rational)((*num)[i])/(Rational)((*den)[i]);
3284  spec.w[i] = (*mul)[i];
3285  }
3286 }
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:1146
int * w
Definition: semic.h:71

§ exprlist_length()

int exprlist_length ( leftv  v)

Definition at line 550 of file ipshell.cc.

551 {
552  int rc = 0;
553  while (v!=NULL)
554  {
555  switch (v->Typ())
556  {
557  case INT_CMD:
558  case POLY_CMD:
559  case VECTOR_CMD:
560  case NUMBER_CMD:
561  rc++;
562  break;
563  case INTVEC_CMD:
564  case INTMAT_CMD:
565  rc += ((intvec *)(v->Data()))->length();
566  break;
567  case MATRIX_CMD:
568  case IDEAL_CMD:
569  case MODUL_CMD:
570  {
571  matrix mm = (matrix)(v->Data());
572  rc += mm->rows() * mm->cols();
573  }
574  break;
575  case LIST_CMD:
576  rc+=((lists)v->Data())->nr+1;
577  break;
578  default:
579  rc++;
580  }
581  v = v->next;
582  }
583  return rc;
584 }
int & rows()
Definition: matpol.h:24
Definition: tok.h:95
int Typ()
Definition: subexpr.cc:1004
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:1146
Definition: tok.h:117

§ getList()

lists getList ( spectrum spec)

Definition at line 3305 of file ipshell.cc.

3306 {
3308 
3309  L->Init( 6 );
3310 
3311  intvec *num = new intvec( spec.n );
3312  intvec *den = new intvec( spec.n );
3313  intvec *mult = new intvec( spec.n );
3314 
3315  for( int i=0; i<spec.n; i++ )
3316  {
3317  (*num) [i] = spec.s[i].get_num_si( );
3318  (*den) [i] = spec.s[i].get_den_si( );
3319  (*mult)[i] = spec.w[i];
3320  }
3321 
3322  L->m[0].rtyp = INT_CMD; // milnor number
3323  L->m[1].rtyp = INT_CMD; // geometrical genus
3324  L->m[2].rtyp = INT_CMD; // # of spectrum numbers
3325  L->m[3].rtyp = INTVEC_CMD; // numerators
3326  L->m[4].rtyp = INTVEC_CMD; // denomiantors
3327  L->m[5].rtyp = INTVEC_CMD; // multiplicities
3328 
3329  L->m[0].data = (void*)(long)spec.mu;
3330  L->m[1].data = (void*)(long)spec.pg;
3331  L->m[2].data = (void*)(long)spec.n;
3332  L->m[3].data = (void*)num;
3333  L->m[4].data = (void*)den;
3334  L->m[5].data = (void*)mult;
3335 
3336  return L;
3337 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
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)
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

§ iiApply()

BOOLEAN iiApply ( leftv  res,
leftv  a,
int  op,
leftv  proc 
)

Definition at line 6323 of file ipshell.cc.

6324 {
6325  memset(res,0,sizeof(sleftv));
6326  res->rtyp=a->Typ();
6327  switch (res->rtyp /*a->Typ()*/)
6328  {
6329  case INTVEC_CMD:
6330  case INTMAT_CMD:
6331  return iiApplyINTVEC(res,a,op,proc);
6332  case BIGINTMAT_CMD:
6333  return iiApplyBIGINTMAT(res,a,op,proc);
6334  case IDEAL_CMD:
6335  case MODUL_CMD:
6336  case MATRIX_CMD:
6337  return iiApplyIDEAL(res,a,op,proc);
6338  case LIST_CMD:
6339  return iiApplyLIST(res,a,op,proc);
6340  }
6341  WerrorS("first argument to `apply` must allow an index");
6342  return TRUE;
6343 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define TRUE
Definition: auxiliary.h:99
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:1004
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6281
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6291
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6286
int rtyp
Definition: subexpr.h:92
Definition: tok.h:117
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6249

§ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6281 of file ipshell.cc.

6282 {
6283  WerrorS("not implemented");
6284  return TRUE;
6285 }
#define TRUE
Definition: auxiliary.h:99
void WerrorS(const char *s)
Definition: feFopen.cc:24

§ iiApplyIDEAL()

BOOLEAN iiApplyIDEAL ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6286 of file ipshell.cc.

6287 {
6288  WerrorS("not implemented");
6289  return TRUE;
6290 }
#define TRUE
Definition: auxiliary.h:99
void WerrorS(const char *s)
Definition: feFopen.cc:24

§ iiApplyINTVEC()

BOOLEAN iiApplyINTVEC ( leftv  res,
leftv  a,
int  op,
leftv  proc 
)

Definition at line 6249 of file ipshell.cc.

6250 {
6251  intvec *aa=(intvec*)a->Data();
6252  sleftv tmp_out;
6253  sleftv tmp_in;
6254  leftv curr=res;
6255  BOOLEAN bo=FALSE;
6256  for(int i=0;i<aa->length(); i++)
6257  {
6258  memset(&tmp_in,0,sizeof(tmp_in));
6259  tmp_in.rtyp=INT_CMD;
6260  tmp_in.data=(void*)(long)(*aa)[i];
6261  if (proc==NULL)
6262  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6263  else
6264  bo=jjPROC(&tmp_out,proc,&tmp_in);
6265  if (bo)
6266  {
6267  res->CleanUp(currRing);
6268  Werror("apply fails at index %d",i+1);
6269  return TRUE;
6270  }
6271  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6272  else
6273  {
6274  curr->next=(leftv)omAllocBin(sleftv_bin);
6275  curr=curr->next;
6276  memcpy(curr,&tmp_out,sizeof(tmp_out));
6277  }
6278  }
6279  return FALSE;
6280 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:95
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:8284
#define FALSE
Definition: auxiliary.h:95
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1602
#define TRUE
Definition: auxiliary.h:99
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:10
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 length() const
Definition: intvec.h:86
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:335
void * Data()
Definition: subexpr.cc:1146
int BOOLEAN
Definition: auxiliary.h:86
void Werror(const char *fmt,...)
Definition: reporter.cc:189

§ iiApplyLIST()

BOOLEAN iiApplyLIST ( leftv  res,
leftv  a,
int  op,
leftv  proc 
)

Definition at line 6291 of file ipshell.cc.

6292 {
6293  lists aa=(lists)a->Data();
6294  sleftv tmp_out;
6295  sleftv tmp_in;
6296  leftv curr=res;
6297  BOOLEAN bo=FALSE;
6298  for(int i=0;i<=aa->nr; i++)
6299  {
6300  memset(&tmp_in,0,sizeof(tmp_in));
6301  tmp_in.Copy(&(aa->m[i]));
6302  if (proc==NULL)
6303  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6304  else
6305  bo=jjPROC(&tmp_out,proc,&tmp_in);
6306  tmp_in.CleanUp();
6307  if (bo)
6308  {
6309  res->CleanUp(currRing);
6310  Werror("apply fails at index %d",i+1);
6311  return TRUE;
6312  }
6313  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6314  else
6315  {
6316  curr->next=(leftv)omAllocBin(sleftv_bin);
6317  curr=curr->next;
6318  memcpy(curr,&tmp_out,sizeof(tmp_out));
6319  }
6320  }
6321  return FALSE;
6322 }
#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:8284
#define FALSE
Definition: auxiliary.h:95
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1602
#define TRUE
Definition: auxiliary.h:99
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:10
void Copy(leftv e)
Definition: subexpr.cc:695
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:335
void * Data()
Definition: subexpr.cc:1146
int BOOLEAN
Definition: auxiliary.h:86
void Werror(const char *fmt,...)
Definition: reporter.cc:189

§ iiARROW()

BOOLEAN iiARROW ( leftv  r,
char *  a,
char *  s 
)

Definition at line 6372 of file ipshell.cc.

6373 {
6374  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6375  // find end of s:
6376  int end_s=strlen(s);
6377  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6378  s[end_s+1]='\0';
6379  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6380  sprintf(name,"%s->%s",a,s);
6381  // find start of last expression
6382  int start_s=end_s-1;
6383  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6384  if (start_s<0) // ';' not found
6385  {
6386  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6387  }
6388  else // s[start_s] is ';'
6389  {
6390  s[start_s]='\0';
6391  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6392  }
6393  memset(r,0,sizeof(*r));
6394  // now produce procinfo for PROC_CMD:
6395  r->data = (void *)omAlloc0Bin(procinfo_bin);
6396  ((procinfo *)(r->data))->language=LANG_NONE;
6397  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6398  ((procinfo *)r->data)->data.s.body=ss;
6399  omFree(name);
6400  r->rtyp=PROC_CMD;
6401  //r->rtyp=STRING_CMD;
6402  //r->data=ss;
6403  return FALSE;
6404 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
const poly a
Definition: syzextra.cc:212
#define FALSE
Definition: auxiliary.h:95
procinfo * iiInitSingularProcinfo(procinfov pi, const char *libname, const char *procname, int, long pos, BOOLEAN pstatic)
Definition: iplib.cc:883
#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
char name(const Variable &v)
Definition: factory.h:178
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
int rtyp
Definition: subexpr.h:92

§ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6406 of file ipshell.cc.

6407 {
6408  char* ring_name=omStrDup((char*)r->Name());
6409  int t=arg->Typ();
6410  if (t==RING_CMD)
6411  {
6412  sleftv tmp;
6413  memset(&tmp,0,sizeof(tmp));
6414  tmp.rtyp=IDHDL;
6415  tmp.data=(char*)rDefault(ring_name);
6416  if (tmp.data!=NULL)
6417  {
6418  BOOLEAN b=iiAssign(&tmp,arg);
6419  if (b) return TRUE;
6420  rSetHdl(ggetid(ring_name));
6421  omFree(ring_name);
6422  return FALSE;
6423  }
6424  else
6425  return TRUE;
6426  }
6427  #ifdef SINGULAR_4_1
6428  else if (t==CRING_CMD)
6429  {
6430  sleftv tmp;
6431  sleftv n;
6432  memset(&n,0,sizeof(n));
6433  n.name=ring_name;
6434  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6435  if (iiAssign(&tmp,arg)) return TRUE;
6436  //Print("create %s\n",r->Name());
6437  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6438  return FALSE;
6439  }
6440  #endif
6441  //Print("create %s\n",r->Name());
6442  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6443  return TRUE;// not handled -> error for now
6444 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define FALSE
Definition: auxiliary.h:95
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:99
int Typ()
Definition: subexpr.cc:1004
const char * Name()
Definition: subexpr.h:121
#define IDHDL
Definition: tok.h:31
idhdl rDefault(const char *s)
Definition: ipshell.cc:1527
void * data
Definition: subexpr.h:89
int myynest
Definition: febase.cc:46
Definition: tok.h:56
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:1128
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
void rSetHdl(idhdl h)
Definition: ipshell.cc:5021
int BOOLEAN
Definition: auxiliary.h:86
const poly b
Definition: syzextra.cc:213
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:498
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1792
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  ,
leftv  args 
)

Definition at line 1185 of file ipshell.cc.

1186 {
1187  // <string1...stringN>,<proc>
1188  // known: args!=NULL, l>=1
1189  int l=args->listLength();
1190  int ll=0;
1191  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1192  if (ll!=(l-1)) return FALSE;
1193  leftv h=args;
1194  short *t=(short*)omAlloc(l*sizeof(short));
1195  t[0]=l-1;
1196  int b;
1197  int i;
1198  for(i=1;i<l;i++,h=h->next)
1199  {
1200  if (h->Typ()!=STRING_CMD)
1201  {
1202  omFree(t);
1203  Werror("arg %d is not a string",i);
1204  return TRUE;
1205  }
1206  int tt;
1207  b=IsCmd((char *)h->Data(),tt);
1208  if(b) t[i]=tt;
1209  else
1210  {
1211  omFree(t);
1212  Werror("arg %d is not a type name",i);
1213  return TRUE;
1214  }
1215  }
1216  if (h->Typ()!=PROC_CMD)
1217  {
1218  omFree(t);
1219  Werror("last arg (%d) is not a proc",i);
1220  return TRUE;
1221  }
1222  b=iiCheckTypes(iiCurrArgs,t,0);
1223  omFree(t);
1224  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1225  {
1226  BOOLEAN err;
1227  //Print("branchTo: %s\n",h->Name());
1228  iiCurrProc=(idhdl)h->data;
1230  if( pi->data.s.body==NULL )
1231  {
1233  if (pi->data.s.body==NULL) return TRUE;
1234  }
1235  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1236  {
1237  currPack=pi->pack;
1240  //Print("set pack=%s\n",IDID(currPackHdl));
1241  }
1242  err=iiAllStart(pi,pi->data.s.body,BT_proc,pi->data.s.body_lineno-(iiCurrArgs==NULL));
1244  if (iiCurrArgs!=NULL)
1245  {
1246  if (!err) Warn("too many arguments for %s",IDID(iiCurrProc));
1247  iiCurrArgs->CleanUp();
1249  iiCurrArgs=NULL;
1250  }
1251  return 2-err;
1252  }
1253  return FALSE;
1254 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
idhdl currPackHdl
Definition: ipid.cc:61
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:95
int listLength()
Definition: subexpr.cc:61
#define TRUE
Definition: auxiliary.h:99
void * ADDRESS
Definition: auxiliary.h:116
#define omAlloc(size)
Definition: omAllocDecl.h:210
BOOLEAN exitBuffer(feBufferTypes typ)
Definition: fevoices.cc:241
#define IDHDL
Definition: tok.h:31
idhdl iiCurrProc
Definition: ipshell.cc:81
#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:311
#define IDPROC(a)
Definition: ipid.h:137
#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:6464
package currPack
Definition: ipid.cc:63
leftv iiCurrArgs
Definition: ipshell.cc:80
void CleanUp(ring r=currRing)
Definition: subexpr.cc:335
idhdl packFindHdl(package r)
Definition: ipid.cc:738
void iiCheckPack(package &p)
Definition: ipshell.cc:1513
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:210
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:86
const poly b
Definition: syzextra.cc:213
void Werror(const char *fmt,...)
Definition: reporter.cc:189
int l
Definition: cfEzgcd.cc:94
utypes data
Definition: idrec.h:40
int IsCmd(const char *n, int &tok)
Definition: iparith.cc:8688
#define Warn
Definition: emacs.cc:80

§ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1513 of file ipshell.cc.

1514 {
1515  if (p!=basePack)
1516  {
1517  idhdl t=basePack->idroot;
1518  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1519  if (t==NULL)
1520  {
1521  WarnS("package not found\n");
1522  p=basePack;
1523  }
1524  }
1525 }
return P p
Definition: myNF.cc:203
#define WarnS
Definition: emacs.cc:81
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:136
#define IDTYP(a)
Definition: ipid.h:116
idhdl next
Definition: idrec.h:38
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64

§ iiCheckRing()

BOOLEAN iiCheckRing ( int  i)

Definition at line 1469 of file ipshell.cc.

1470 {
1471  if (currRing==NULL)
1472  {
1473  #ifdef SIQ
1474  if (siq<=0)
1475  {
1476  #endif
1477  if (RingDependend(i))
1478  {
1479  WerrorS("no ring active");
1480  return TRUE;
1481  }
1482  #ifdef SIQ
1483  }
1484  #endif
1485  }
1486  return FALSE;
1487 }
#define FALSE
Definition: auxiliary.h:95
BOOLEAN siq
Definition: subexpr.cc:58
#define TRUE
Definition: auxiliary.h:99
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:10
int RingDependend(int t)
Definition: gentable.cc:23
int i
Definition: cfEzgcd.cc:123
#define NULL
Definition: omList.c:10

§ iiCheckTypes()

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 6464 of file ipshell.cc.

6465 {
6466  if (args==NULL)
6467  {
6468  if (type_list[0]==0) return TRUE;
6469  else
6470  {
6471  if (report) WerrorS("no arguments expected");
6472  return FALSE;
6473  }
6474  }
6475  int l=args->listLength();
6476  if (l!=(int)type_list[0])
6477  {
6478  if (report) iiReportTypes(0,l,type_list);
6479  return FALSE;
6480  }
6481  for(int i=1;i<=l;i++,args=args->next)
6482  {
6483  short t=type_list[i];
6484  if (t!=ANY_TYPE)
6485  {
6486  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6487  || (t!=args->Typ()))
6488  {
6489  if (report) iiReportTypes(i,args->Typ(),type_list);
6490  return FALSE;
6491  }
6492  }
6493  }
6494  return TRUE;
6495 }
#define ANY_TYPE
Definition: tok.h:30
#define FALSE
Definition: auxiliary.h:95
int listLength()
Definition: subexpr.cc:61
#define TRUE
Definition: auxiliary.h:99
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define IDHDL
Definition: tok.h:31
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6446
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:87
#define NULL
Definition: omList.c:10
int l
Definition: cfEzgcd.cc:94

§ iiCopyRes()

static resolvente iiCopyRes ( resolvente  r,
int  l 
)
static

Definition at line 861 of file ipshell.cc.

862 {
863  int i;
864  resolvente res=(ideal *)omAlloc0((l+1)*sizeof(ideal));
865 
866  for (i=0; i<l; i++)
867  if (r[i]!=NULL) res[i]=idCopy(r[i]);
868  return res;
869 }
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:60
#define NULL
Definition: omList.c:10
ideal * resolvente
Definition: ideals.h:18
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:94

§ iiDebug()

void iiDebug ( )

Definition at line 990 of file ipshell.cc.

991 {
992 #ifdef HAVE_SDB
993  sdb_flags=1;
994 #endif
995  Print("\n-- break point in %s --\n",VoiceName());
997  char * s;
999  s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
1000  loop
1001  {
1002  memset(s,0,80);
1004  if (s[BREAK_LINE_LENGTH-1]!='\0')
1005  {
1006  Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
1007  }
1008  else
1009  break;
1010  }
1011  if (*s=='\n')
1012  {
1014  }
1015 #if MDEBUG
1016  else if(strncmp(s,"cont;",5)==0)
1017  {
1019  }
1020 #endif /* MDEBUG */
1021  else
1022  {
1023  strcat( s, "\n;~\n");
1024  newBuffer(s,BT_execute);
1025  }
1026 }
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:95
#define TRUE
Definition: auxiliary.h:99
#define omAlloc(size)
Definition: omAllocDecl.h:210
BOOLEAN iiDebugMarker
Definition: ipshell.cc:988
const char * VoiceName()
Definition: fevoices.cc:66
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:989
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:171

§ iiDeclCommand()

int iiDeclCommand ( leftv  sy,
leftv  name,
int  lev,
int  t,
idhdl root,
BOOLEAN  isring,
BOOLEAN  init_b 
)

Definition at line 1128 of file ipshell.cc.

1129 {
1130  BOOLEAN res=FALSE;
1131  const char *id = name->name;
1132 
1133  memset(sy,0,sizeof(sleftv));
1134  if ((name->name==NULL)||(isdigit(name->name[0])))
1135  {
1136  WerrorS("object to declare is not a name");
1137  res=TRUE;
1138  }
1139  else
1140  {
1141  if (t==QRING_CMD) t=RING_CMD; // qring is always RING_CMD
1142 
1143  if (TEST_V_ALLWARN
1144  && (name->rtyp!=0)
1145  && (name->rtyp!=IDHDL)
1146  && (currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1147  {
1148  Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1150  }
1151  {
1152  sy->data = (char *)enterid(id,lev,t,root,init_b);
1153  }
1154  if (sy->data!=NULL)
1155  {
1156  sy->rtyp=IDHDL;
1157  currid=sy->name=IDID((idhdl)sy->data);
1158  // name->name=NULL; /* used in enterid */
1159  //sy->e = NULL;
1160  if (name->next!=NULL)
1161  {
1163  res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1164  }
1165  }
1166  else res=TRUE;
1167  }
1168  name->CleanUp();
1169  return res;
1170 }
#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:119
#define FALSE
Definition: auxiliary.h:95
char * filename
Definition: fevoices.h:62
#define TRUE
Definition: auxiliary.h:99
sleftv * leftv
Definition: structs.h:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:31
const char * currid
Definition: grammar.cc:171
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:261
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:118
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:1128
#define NULL
Definition: omList.c:10
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:130
Voice * currentVoice
Definition: fevoices.cc:57
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:335
Definition: tok.h:157
int BOOLEAN
Definition: auxiliary.h:86
#define TEST_V_ALLWARN
Definition: options.h:135
#define Warn
Definition: emacs.cc:80

§ iiDefaultParameter()

BOOLEAN iiDefaultParameter ( leftv  p)

Definition at line 1172 of file ipshell.cc.

1173 {
1174  attr at=NULL;
1175  if (iiCurrProc!=NULL)
1176  at=iiCurrProc->attribute->get("default_arg");
1177  if (at==NULL)
1178  return FALSE;
1179  sleftv tmp;
1180  memset(&tmp,0,sizeof(sleftv));
1181  tmp.rtyp=at->atyp;
1182  tmp.data=at->CopyA();
1183  return iiAssign(p,&tmp);
1184 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: attrib.h:15
#define FALSE
Definition: auxiliary.h:95
idhdl iiCurrProc
Definition: ipshell.cc:81
void * data
Definition: subexpr.h:89
void * CopyA()
Definition: subexpr.cc:1966
#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:1792

§ iiExport() [1/2]

BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1389 of file ipshell.cc.

1390 {
1391  BOOLEAN nok=FALSE;
1392  leftv r=v;
1393  while (v!=NULL)
1394  {
1395  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1396  {
1397  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1398  nok=TRUE;
1399  }
1400  else
1401  {
1402  if(iiInternalExport(v, toLev))
1403  {
1404  r->CleanUp();
1405  return TRUE;
1406  }
1407  }
1408  v=v->next;
1409  }
1410  r->CleanUp();
1411  return nok;
1412 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Subexpr e
Definition: subexpr.h:106
#define FALSE
Definition: auxiliary.h:95
#define TRUE
Definition: auxiliary.h:99
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:1291
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:335
int BOOLEAN
Definition: auxiliary.h:86
void Werror(const char *fmt,...)
Definition: reporter.cc:189

§ iiExport() [2/2]

BOOLEAN iiExport ( leftv  v,
int  toLev,
package  pack 
)

Definition at line 1415 of file ipshell.cc.

1416 {
1417 #ifdef SINGULAR_4_1
1418 // if ((pack==basePack)&&(pack!=currPack))
1419 // { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
1420 #endif
1421  BOOLEAN nok=FALSE;
1422  leftv rv=v;
1423  while (v!=NULL)
1424  {
1425  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
1426  )
1427  {
1428  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1429  nok=TRUE;
1430  }
1431  else
1432  {
1433  idhdl old=pack->idroot->get( v->name,toLev);
1434  if (old!=NULL)
1435  {
1436  if ((pack==currPack) && (old==(idhdl)v->data))
1437  {
1438  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
1439  break;
1440  }
1441  else if (IDTYP(old)==v->Typ())
1442  {
1443  if (BVERBOSE(V_REDEFINE))
1444  {
1445  Warn("redefining %s (%s)",IDID(old),my_yylinebuf);
1446  }
1447  v->name=omStrDup(v->name);
1448  killhdl2(old,&(pack->idroot),currRing);
1449  }
1450  else
1451  {
1452  rv->CleanUp();
1453  return TRUE;
1454  }
1455  }
1456  //Print("iiExport: pack=%s\n",IDID(root));
1457  if(iiInternalExport(v, toLev, pack))
1458  {
1459  rv->CleanUp();
1460  return TRUE;
1461  }
1462  }
1463  v=v->next;
1464  }
1465  rv->CleanUp();
1466  return nok;
1467 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Subexpr e
Definition: subexpr.h:106
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:95
#define TRUE
Definition: auxiliary.h:99
int Typ()
Definition: subexpr.cc:1004
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:10
#define IDTYP(a)
Definition: ipid.h:116
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:411
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:1291
#define NULL
Definition: omList.c:10
package currPack
Definition: ipid.cc:63
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:335
int BOOLEAN
Definition: auxiliary.h:86
#define V_REDEFINE
Definition: options.h:43
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ iiHighCorner()

poly iiHighCorner ( ideal  I,
int  ak 
)

Definition at line 1489 of file ipshell.cc.

1490 {
1491  int i;
1492  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1493  poly po=NULL;
1495  {
1496  scComputeHC(I,currRing->qideal,ak,po);
1497  if (po!=NULL)
1498  {
1499  pGetCoeff(po)=nInit(1);
1500  for (i=rVar(currRing); i>0; i--)
1501  {
1502  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1503  }
1504  pSetComp(po,ak);
1505  pSetm(po);
1506  }
1507  }
1508  else
1509  po=pOne();
1510  return po;
1511 }
#define pSetm(p)
Definition: polys.h:253
#define pDecrExp(p, i)
Definition: polys.h:44
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:580
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:161
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
#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:298
#define rHasLocalOrMixedOrdering_currRing()
Definition: ring.h:754
#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

§ iiInternalExport() [1/2]

static BOOLEAN iiInternalExport ( leftv  v,
int  toLev 
)
static

Definition at line 1291 of file ipshell.cc.

1292 {
1293  idhdl h=(idhdl)v->data;
1294  //Print("iiInternalExport('%s',%d)%s\n", v->name, toLev,"");
1295  if (IDLEV(h)==0)
1296  {
1297  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(h));
1298  }
1299  else
1300  {
1301  h=IDROOT->get(v->name,toLev);
1302  idhdl *root=&IDROOT;
1303  if ((h==NULL)&&(currRing!=NULL))
1304  {
1305  h=currRing->idroot->get(v->name,toLev);
1306  root=&currRing->idroot;
1307  }
1308  BOOLEAN keepring=FALSE;
1309  if ((h!=NULL)&&(IDLEV(h)==toLev))
1310  {
1311  if (IDTYP(h)==v->Typ())
1312  {
1313  if ((IDTYP(h)==RING_CMD)
1314  && (v->Data()==IDDATA(h)))
1315  {
1316  IDRING(h)->ref++;
1317  keepring=TRUE;
1318  IDLEV(h)=toLev;
1319  //WarnS("keepring");
1320  return FALSE;
1321  }
1322  if (BVERBOSE(V_REDEFINE))
1323  {
1324  Warn("redefining %s (%s)",IDID(h),my_yylinebuf);
1325  }
1326  if (iiLocalRing[0]==IDRING(h) && (!keepring)) iiLocalRing[0]=NULL;
1327  killhdl2(h,root,currRing);
1328  }
1329  else
1330  {
1331  return TRUE;
1332  }
1333  }
1334  h=(idhdl)v->data;
1335  IDLEV(h)=toLev;
1336  if (keepring) IDRING(h)->ref--;
1338  //Print("export %s\n",IDID(h));
1339  }
1340  return FALSE;
1341 }
if(0 > strat->sl)
Definition: myNF.cc:73
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:95
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:99
int Typ()
Definition: subexpr.cc:1004
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:10
#define IDTYP(a)
Definition: ipid.h:116
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:411
char my_yylinebuf[80]
Definition: febase.cc:48
const char * name
Definition: subexpr.h:88
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:84
idrec * idhdl
Definition: ring.h:18
#define IDLEV(a)
Definition: ipid.h:118
#define BVERBOSE(a)
Definition: options.h:33
ring * iiLocalRing
Definition: iplib.cc:470
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:124
void * Data()
Definition: subexpr.cc:1146
#define IDDATA(a)
Definition: ipid.h:123
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:86
#define V_REDEFINE
Definition: options.h:43
#define Warn
Definition: emacs.cc:80

§ iiInternalExport() [2/2]

BOOLEAN iiInternalExport ( leftv  v,
int  toLev,
package  rootpack 
)

Definition at line 1343 of file ipshell.cc.

1344 {
1345  idhdl h=(idhdl)v->data;
1346  if(h==NULL)
1347  {
1348  Warn("'%s': no such identifier\n", v->name);
1349  return FALSE;
1350  }
1351  package frompack=v->req_packhdl;
1352  if (frompack==NULL) frompack=currPack;
1353  if ((RingDependend(IDTYP(h)))
1354  || ((IDTYP(h)==LIST_CMD)
1355  && (lRingDependend(IDLIST(h)))
1356  )
1357  )
1358  {
1359  //Print("// ==> Ringdependent set nesting to 0\n");
1360  return (iiInternalExport(v, toLev));
1361  }
1362  else
1363  {
1364  IDLEV(h)=toLev;
1365  v->req_packhdl=rootpack;
1366  if (h==frompack->idroot)
1367  {
1368  frompack->idroot=h->next;
1369  }
1370  else
1371  {
1372  idhdl hh=frompack->idroot;
1373  while ((hh!=NULL) && (hh->next!=h))
1374  hh=hh->next;
1375  if ((hh!=NULL) && (hh->next==h))
1376  hh->next=h->next;
1377  else
1378  {
1379  Werror("`%s` not found",v->Name());
1380  return TRUE;
1381  }
1382  }
1383  h->next=rootpack->idroot;
1384  rootpack->idroot=h;
1385  }
1386  return FALSE;
1387 }
#define IDLIST(a)
Definition: ipid.h:134
#define FALSE
Definition: auxiliary.h:95
#define TRUE
Definition: auxiliary.h:99
const char * Name()
Definition: subexpr.h:121
Definition: idrec.h:34
void * data
Definition: subexpr.h:89
#define IDTYP(a)
Definition: ipid.h:116
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:118
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1291
#define NULL
Definition: omList.c:10
package req_packhdl
Definition: subexpr.h:107
package currPack
Definition: ipid.cc:63
Definition: tok.h:117
static Poly * h
Definition: janet.cc:978
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:199
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define Warn
Definition: emacs.cc:80

§ iiMakeResolv()

void iiMakeResolv ( resolvente  r,
int  length,
int  rlen,
char *  name,
int  typ0,
intvec **  weights 
)

Definition at line 772 of file ipshell.cc.

774 {
775  lists L=liMakeResolv(r,length,rlen,typ0,weights);
776  int i=0;
777  idhdl h;
778  char * s=(char *)omAlloc(strlen(name)+5);
779 
780  while (i<=L->nr)
781  {
782  sprintf(s,"%s(%d)",name,i+1);
783  if (i==0)
784  h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
785  else
786  h=enterid(s,myynest,MODUL_CMD,&(currRing->idroot), FALSE);
787  if (h!=NULL)
788  {
789  h->data.uideal=(ideal)L->m[i].data;
790  h->attribute=L->m[i].attribute;
792  Print("//defining: %s as %d-th syzygy module\n",s,i+1);
793  }
794  else
795  {
796  idDelete((ideal *)&(L->m[i].data));
797  Warn("cannot define %s",s);
798  }
799  //L->m[i].data=NULL;
800  //L->m[i].rtyp=0;
801  //L->m[i].attribute=NULL;
802  i++;
803  }
804  omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
806  omFreeSize((ADDRESS)s,strlen(name)+5);
807 }
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:29
Definition: lists.h:22
if(0 > strat->sl)
Definition: myNF.cc:73
#define FALSE
Definition: auxiliary.h:95
#define V_DEF_RES
Definition: options.h:48
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:116
#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:10
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:261
const ring r
Definition: syzextra.cc:208
int i
Definition: cfEzgcd.cc:123
char name(const Variable &v)
Definition: factory.h:178
#define BVERBOSE(a)
Definition: options.h:33
int nr
Definition: lists.h:43
#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:215
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

§ iiMap()

leftv iiMap ( map  theMap,
const char *  what 
)

Definition at line 613 of file ipshell.cc.

614 {
615  idhdl w,r;
616  leftv v;
617  int i;
618  nMapFunc nMap;
619 
620  r=IDROOT->get(theMap->preimage,myynest);
621  if ((currPack!=basePack)
622  &&((r==NULL) || ((r->typ != RING_CMD) )))
623  r=basePack->idroot->get(theMap->preimage,myynest);
624  if ((r==NULL) && (currRingHdl!=NULL)
625  && (strcmp(theMap->preimage,IDID(currRingHdl))==0))
626  {
627  r=currRingHdl;
628  }
629  if ((r!=NULL) && (r->typ == RING_CMD))
630  {
631  ring src_ring=IDRING(r);
632  if ((nMap=n_SetMap(src_ring->cf, currRing->cf))==NULL)
633  {
634  Werror("can not map from ground field of %s to current ground field",
635  theMap->preimage);
636  return NULL;
637  }
638  if (IDELEMS(theMap)<src_ring->N)
639  {
640  theMap->m=(polyset)omReallocSize((ADDRESS)theMap->m,
641  IDELEMS(theMap)*sizeof(poly),
642  (src_ring->N)*sizeof(poly));
643  for(i=IDELEMS(theMap);i<src_ring->N;i++)
644  theMap->m[i]=NULL;
645  IDELEMS(theMap)=src_ring->N;
646  }
647  if (what==NULL)
648  {
649  WerrorS("argument of a map must have a name");
650  }
651  else if ((w=src_ring->idroot->get(what,myynest))!=NULL)
652  {
653  char *save_r=NULL;
655  sleftv tmpW;
656  memset(&tmpW,0,sizeof(sleftv));
657  tmpW.rtyp=IDTYP(w);
658  if (tmpW.rtyp==MAP_CMD)
659  {
660  tmpW.rtyp=IDEAL_CMD;
661  save_r=IDMAP(w)->preimage;
662  IDMAP(w)->preimage=0;
663  }
664  tmpW.data=IDDATA(w);
665  // check overflow
666  BOOLEAN overflow=FALSE;
667  if ((tmpW.rtyp==IDEAL_CMD)
668  || (tmpW.rtyp==MODUL_CMD)
669  || (tmpW.rtyp==MAP_CMD))
670  {
671  ideal id=(ideal)tmpW.data;
672  long *degs=(long*)omAlloc(IDELEMS(id)*sizeof(long));
673  for(int i=IDELEMS(id)-1;i>=0;i--)
674  {
675  poly p=id->m[i];
676  if (p!=NULL) degs[i]=p_Totaldegree(p,src_ring);
677  else degs[i]=0;
678  }
679  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
680  {
681  if (theMap->m[j]!=NULL)
682  {
683  long deg_monexp=pTotaldegree(theMap->m[j]);
684 
685  for(int i=IDELEMS(id)-1;i>=0;i--)
686  {
687  poly p=id->m[i];
688  if ((p!=NULL) && (degs[i]!=0) &&
689  ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)degs[i])/2)))
690  {
691  overflow=TRUE;
692  break;
693  }
694  }
695  }
696  }
697  omFreeSize(degs,IDELEMS(id)*sizeof(long));
698  }
699  else if (tmpW.rtyp==POLY_CMD)
700  {
701  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
702  {
703  if (theMap->m[j]!=NULL)
704  {
705  long deg_monexp=pTotaldegree(theMap->m[j]);
706  poly p=(poly)tmpW.data;
707  long deg=0;
708  if ((p!=NULL) && ((deg=p_Totaldegree(p,src_ring))!=0) &&
709  ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)deg)/2)))
710  {
711  overflow=TRUE;
712  break;
713  }
714  }
715  }
716  }
717  if (overflow)
718  Warn("possible OVERFLOW in map, max exponent is %ld",currRing->bitmask/2);
719 #if 0
720  if (((tmpW.rtyp==IDEAL_CMD)||(tmpW.rtyp==MODUL_CMD)) && idIs0(IDIDEAL(w)))
721  {
722  v->rtyp=tmpW.rtyp;
723  v->data=idInit(IDELEMS(IDIDEAL(w)),IDIDEAL(w)->rank);
724  }
725  else
726 #endif
727  {
728  if ((tmpW.rtyp==IDEAL_CMD)
729  ||(tmpW.rtyp==MODUL_CMD)
730  ||(tmpW.rtyp==MATRIX_CMD)
731  ||(tmpW.rtyp==MAP_CMD))
732  {
733  v->rtyp=tmpW.rtyp;
734  char *tmp = theMap->preimage;
735  theMap->preimage=(char*)1L;
736  // map gets 1 as its rank (as an ideal)
737  v->data=maMapIdeal(IDIDEAL(w), src_ring, (ideal)theMap, currRing,nMap);
738  theMap->preimage=tmp; // map gets its preimage back
739  }
740  if (v->data==NULL) /*i.e. not IDEAL_CMD/MODUL_CMD/MATRIX_CMD/MAP */
741  {
742  if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,src_ring,NULL,NULL,0,nMap))
743  {
744  Werror("cannot map %s(%d)",Tok2Cmdname(w->typ),w->typ);
746  if (save_r!=NULL) IDMAP(w)->preimage=save_r;
747  return NULL;
748  }
749  }
750  }
751  if (save_r!=NULL)
752  {
753  IDMAP(w)->preimage=save_r;
754  IDMAP((idhdl)v)->preimage=omStrDup(save_r);
755  v->rtyp=MAP_CMD;
756  }
757  return v;
758  }
759  else
760  {
761  Werror("%s undefined in %s",what,theMap->preimage);
762  }
763  }
764  else
765  {
766  Werror("cannot find preimage %s",theMap->preimage);
767  }
768  return NULL;
769 }
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:119
#define FALSE
Definition: auxiliary.h:95
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:99
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:130
static long p_Totaldegree(poly p, const ring r)
Definition: p_polys.h:1430
void * ADDRESS
Definition: auxiliary.h:116
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:10
#define IDTYP(a)
Definition: ipid.h:116
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:265
number(* nMapFunc)(number a, const coeffs src, const coeffs dst)
maps "a", which lives in src, into dst
Definition: coeffs.h:73
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:725
#define IDMAP(a)
Definition: ipid.h:132
#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:130
package basePack
Definition: ipid.cc:64
#define IDRING(a)
Definition: ipid.h:124
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
polyrec * poly
Definition: hilb.h:10
#define IDDATA(a)
Definition: ipid.h:123
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
int BOOLEAN
Definition: auxiliary.h:86
BOOLEAN idIs0(ideal h)
returns true if h is the zero ideal
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ iiOpsTwoChar()

int iiOpsTwoChar ( const char *  s)

Definition at line 121 of file ipshell.cc.

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

§ iiParameter()

BOOLEAN iiParameter ( leftv  p)

Definition at line 1255 of file ipshell.cc.

1256 {
1257  if (iiCurrArgs==NULL)
1258  {
1259  if (strcmp(p->name,"#")==0)
1260  return iiDefaultParameter(p);
1261  Werror("not enough arguments for proc %s",VoiceName());
1262  p->CleanUp();
1263  return TRUE;
1264  }
1265  leftv h=iiCurrArgs;
1266  leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1267  BOOLEAN is_default_list=FALSE;
1268  if (strcmp(p->name,"#")==0)
1269  {
1270  is_default_list=TRUE;
1271  rest=NULL;
1272  }
1273  else
1274  {
1275  h->next=NULL;
1276  }
1277  BOOLEAN res=iiAssign(p,h);
1278  if (is_default_list)
1279  {
1280  iiCurrArgs=NULL;
1281  }
1282  else
1283  {
1284  iiCurrArgs=rest;
1285  }
1286  h->CleanUp();
1288  return res;
1289 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define FALSE
Definition: auxiliary.h:95
#define TRUE
Definition: auxiliary.h:99
void * ADDRESS
Definition: auxiliary.h:116
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:1172
leftv iiCurrArgs
Definition: ipshell.cc:80
void CleanUp(ring r=currRing)
Definition: subexpr.cc:335
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:86
void Werror(const char *fmt,...)
Definition: reporter.cc:189
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1792

§ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 962 of file ipshell.cc.

963 {
964  int len,reg,typ0;
965 
966  resolvente r=liFindRes(L,&len,&typ0);
967 
968  if (r==NULL)
969  return -2;
970  intvec *weights=NULL;
971  int add_row_shift=0;
972  intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
973  if (ww!=NULL)
974  {
975  weights=ivCopy(ww);
976  add_row_shift = ww->min_in();
977  (*weights) -= add_row_shift;
978  }
979  //Print("attr:%x\n",weights);
980 
981  intvec *dummy=syBetti(r,len,&reg,weights);
982  if (weights!=NULL) delete weights;
983  delete dummy;
984  omFreeSize((ADDRESS)r,len*sizeof(ideal));
985  return reg+1+add_row_shift;
986 }
sleftv * m
Definition: lists.h:45
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:312
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * ivCopy(const intvec *o)
Definition: intvec.h:126
void * ADDRESS
Definition: auxiliary.h:116
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:18
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:791

§ iiReportTypes()

static void iiReportTypes ( int  nr,
int  t,
const short *  T 
)
static

Definition at line 6446 of file ipshell.cc.

6447 {
6448  char *buf=(char*)omAlloc(250);
6449  buf[0]='\0';
6450  if (nr==0)
6451  sprintf(buf,"wrong length of parameters(%d), expected ",t);
6452  else
6453  sprintf(buf,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
6454  for(int i=1;i<=T[0];i++)
6455  {
6456  strcat(buf,"`");
6457  strcat(buf,Tok2Cmdname(T[i]));
6458  strcat(buf,"`");
6459  if (i<T[0]) strcat(buf,",");
6460  }
6461  WerrorS(buf);
6462 }
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:130
static jList * T
Definition: janet.cc:37

§ iiTestAssume()

BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6345 of file ipshell.cc.

6346 {
6347  // assume a: level
6348  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6349  {
6350  if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6351  char assume_yylinebuf[80];
6352  strncpy(assume_yylinebuf,my_yylinebuf,79);
6353  int lev=(long)a->Data();
6354  int startlev=0;
6355  idhdl h=ggetid("assumeLevel");
6356  if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6357  if(lev <=startlev)
6358  {
6359  BOOLEAN bo=b->Eval();
6360  if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6361  if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6362  if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6363  }
6364  }
6365  b->CleanUp();
6366  a->CleanUp();
6367  return FALSE;
6368 }
int Eval()
Definition: subexpr.cc:1769
Definition: tok.h:95
#define FALSE
Definition: auxiliary.h:95
#define TRUE
Definition: auxiliary.h:99
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define WarnS
Definition: emacs.cc:81
int Typ()
Definition: subexpr.cc:1004
Definition: idrec.h:34
int myynest
Definition: febase.cc:46
#define IDTYP(a)
Definition: ipid.h:116
char my_yylinebuf[80]
Definition: febase.cc:48
#define NULL
Definition: omList.c:10
#define IDINT(a)
Definition: ipid.h:122
void CleanUp(ring r=currRing)
Definition: subexpr.cc:335
void * Data()
Definition: subexpr.cc:1146
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:86
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define TEST_V_ALLWARN
Definition: options.h:135
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:498

§ iiTwoOps()

const char* iiTwoOps ( int  t)

Definition at line 88 of file ipshell.cc.

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

§ iiWRITE()

BOOLEAN iiWRITE ( leftv  ,
leftv  v 
)

Definition at line 586 of file ipshell.cc.

587 {
588  sleftv vf;
589  if (iiConvert(v->Typ(),LINK_CMD,iiTestConvert(v->Typ(),LINK_CMD),v,&vf))
590  {
591  WerrorS("link expected");
592  return TRUE;
593  }
594  si_link l=(si_link)vf.Data();
595  if (vf.next == NULL)
596  {
597  WerrorS("write: need at least two arguments");
598  return TRUE;
599  }
600 
601  BOOLEAN b=slWrite(l,vf.next); /* iiConvert preserves next */
602  if (b)
603  {
604  const char *s;
605  if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
606  else s=sNoName;
607  Werror("cannot write to %s",s);
608  }
609  vf.CleanUp();
610  return b;
611 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
int iiTestConvert(int inputType, int outputType)
Definition: gentable.cc:294
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:401
const char sNoName[]
Definition: subexpr.cc:56
#define TRUE
Definition: auxiliary.h:99
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:1004
leftv next
Definition: subexpr.h:87
Definition: tok.h:116
#define NULL
Definition: omList.c:10
void CleanUp(ring r=currRing)
Definition: subexpr.cc:335
void * Data()
Definition: subexpr.cc:1146
int BOOLEAN
Definition: auxiliary.h:86
const poly b
Definition: syzextra.cc:213
void Werror(const char *fmt,...)
Definition: reporter.cc:189
int l
Definition: cfEzgcd.cc:94

§ jjBETTI()

BOOLEAN jjBETTI ( leftv  res,
leftv  u 
)

Definition at line 892 of file ipshell.cc.

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

§ jjBETTI2()

BOOLEAN jjBETTI2 ( leftv  res,
leftv  u,
leftv  v 
)

Definition at line 926 of file ipshell.cc.

927 {
928  resolvente r;
929  int len;
930  int reg,typ0;
931  lists l=(lists)u->Data();
932 
933  intvec *weights=NULL;
934  int add_row_shift=0;
935  intvec *ww=NULL;
936  if (l->nr>=0) ww=(intvec *)atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
937  if (ww!=NULL)
938  {
939  weights=ivCopy(ww);
940  add_row_shift = ww->min_in();
941  (*weights) -= add_row_shift;
942  }
943  //Print("attr:%x\n",weights);
944 
945  r=liFindRes(l,&len,&typ0);
946  if (r==NULL) return TRUE;
947  intvec* res_im=syBetti(r,len,&reg,weights,(int)(long)v->Data());
948  res->data=(void*)res_im;
949  omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
950  //Print("rowShift: %d ",add_row_shift);
951  for(int i=1;i<=res_im->rows();i++)
952  {
953  if (IMATELEM(*res_im,1,i)==0) { add_row_shift--; }
954  else break;
955  }
956  //Print(" %d\n",add_row_shift);
957  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
958  if (weights!=NULL) delete weights;
959  return FALSE;
960 }
sleftv * m
Definition: lists.h:45
void atSet(idhdl root, const char *name, void *data, int typ)
Definition: attrib.cc:156
Definition: tok.h:95
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:312
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:95
int rows() const
Definition: intvec.h:88
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * ivCopy(const intvec *o)
Definition: intvec.h:126
#define TRUE
Definition: auxiliary.h:99
void * ADDRESS
Definition: auxiliary.h:116
int min_in()
Definition: intvec.h:113
void * data
Definition: subexpr.h:89
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
int i
Definition: cfEzgcd.cc:123
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:135
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
void * Data()
Definition: subexpr.cc:1146
ideal * resolvente
Definition: ideals.h:18
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:791
#define IMATELEM(M, I, J)
Definition: intvec.h:77
int l
Definition: cfEzgcd.cc:94
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ jjBETTI2_ID()

BOOLEAN jjBETTI2_ID ( leftv  res,
leftv  u,
leftv  v 
)

Definition at line 905 of file ipshell.cc.

906 {
908  l->Init(1);
909  l->m[0].rtyp=u->Typ();
910  l->m[0].data=u->Data();
911  attr *a=u->Attribute();
912  if (a!=NULL)
913  l->m[0].attribute=*a;
914  sleftv tmp2;
915  memset(&tmp2,0,sizeof(tmp2));
916  tmp2.rtyp=LIST_CMD;
917  tmp2.data=(void *)l;
918  BOOLEAN r=jjBETTI2(res,&tmp2,v);
919  l->m[0].data=NULL;
920  l->m[0].attribute=NULL;
921  l->m[0].rtyp=DEF_CMD;
922  l->Clean();
923  return r;
924 }
#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:1401
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:926
int Typ()
Definition: subexpr.cc:1004
void * data
Definition: subexpr.h:89
const ring r
Definition: syzextra.cc:208
Definition: tok.h:58
CFList tmp2
Definition: facFqBivar.cc:70
INLINE_THIS void Init(int l=0)
#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:1146
Definition: tok.h:117
attr attribute
Definition: subexpr.h:90
omBin slists_bin
Definition: lists.cc:23
int BOOLEAN
Definition: auxiliary.h:86
int l
Definition: cfEzgcd.cc:94

§ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3256 of file ipshell.cc.

3257 {
3258  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3259  return (res->data==NULL);
3260 }
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:10
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition: clapsing.cc:1398
#define NULL
Definition: omList.c:10
void * Data()
Definition: subexpr.cc:1146

§ jjINT_S_TO_ID()

static void jjINT_S_TO_ID ( int  n,
int *  e,
leftv  res 
)
static

Definition at line 6188 of file ipshell.cc.

6189 {
6190  if (n==0) n=1;
6191  ideal l=idInit(n,1);
6192  int i;
6193  poly p;
6194  for(i=rVar(currRing);i>0;i--)
6195  {
6196  if (e[i]>0)
6197  {
6198  n--;
6199  p=pOne();
6200  pSetExp(p,i,1);
6201  pSetm(p);
6202  l->m[n]=p;
6203  if (n==0) break;
6204  }
6205  }
6206  res->data=(char*)l;
6207  setFlag(res,FLAG_STD);
6208  omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
6209 }
#define pSetm(p)
Definition: polys.h:253
#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:580
void * ADDRESS
Definition: auxiliary.h:116
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:10
#define setFlag(A, F)
Definition: ipid.h:110
int i
Definition: cfEzgcd.cc:123
#define pOne()
Definition: polys.h:298
#define FLAG_STD
Definition: ipid.h:106
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

§ jjMINRES()

BOOLEAN jjMINRES ( leftv  res,
leftv  v 
)

Definition at line 871 of file ipshell.cc.

872 {
873  int len=0;
874  int typ0;
875  lists L=(lists)v->Data();
876  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
877  int add_row_shift = 0;
878  if (weights==NULL)
879  weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
880  if (weights!=NULL) add_row_shift=weights->min_in();
881  resolvente rr=liFindRes(L,&len,&typ0);
882  if (rr==NULL) return TRUE;
883  resolvente r=iiCopyRes(rr,len);
884 
885  syMinimizeResolvente(r,len,0);
886  omFreeSize((ADDRESS)rr,len*sizeof(ideal));
887  len++;
888  res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
889  return FALSE;
890 }
sleftv * m
Definition: lists.h:45
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:312
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:95
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:99
void * ADDRESS
Definition: auxiliary.h:116
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:861
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:215
void * Data()
Definition: subexpr.cc:1146
ideal * resolvente
Definition: ideals.h:18

§ jjPROC()

BOOLEAN jjPROC ( leftv  res,
leftv  u,
leftv  v 
)

Definition at line 1602 of file iparith.cc.

1603 {
1604  void *d;
1605  Subexpr e;
1606  int typ;
1607  BOOLEAN t=FALSE;
1608  idhdl tmp_proc=NULL;
1609  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1610  {
1611  tmp_proc=(idhdl)omAlloc0(sizeof(idrec));
1612  tmp_proc->id="_auto";
1613  tmp_proc->typ=PROC_CMD;
1614  tmp_proc->data.pinf=(procinfo *)u->Data();
1615  tmp_proc->ref=1;
1616  d=u->data; u->data=(void *)tmp_proc;
1617  e=u->e; u->e=NULL;
1618  t=TRUE;
1619  typ=u->rtyp; u->rtyp=IDHDL;
1620  }
1621  BOOLEAN sl;
1622  if (u->req_packhdl==currPack)
1623  sl = iiMake_proc((idhdl)u->data,NULL,v);
1624  else
1625  sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1626  if (t)
1627  {
1628  u->rtyp=typ;
1629  u->data=d;
1630  u->e=e;
1631  omFreeSize(tmp_proc,sizeof(idrec));
1632  }
1633  if (sl) return TRUE;
1634  memcpy(res,&iiRETURNEXPR,sizeof(sleftv));
1635  iiRETURNEXPR.Init();
1636  return FALSE;
1637 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Subexpr e
Definition: subexpr.h:106
#define FALSE
Definition: auxiliary.h:95
sleftv iiRETURNEXPR
Definition: iplib.cc:471
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define TRUE
Definition: auxiliary.h:99
void Init()
Definition: subexpr.h:108
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:31
void * data
Definition: subexpr.h:89
BOOLEAN iiMake_proc(idhdl pn, package pack, sleftv *sl)
Definition: iplib.cc:501
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:1146
int typ
Definition: idrec.h:43
const char * id
Definition: idrec.h:39
int BOOLEAN
Definition: auxiliary.h:86
#define omAlloc0(size)
Definition: omAllocDecl.h:211
utypes data
Definition: idrec.h:40

§ jjRESULTANT()

BOOLEAN jjRESULTANT ( leftv  res,
leftv  u,
leftv  v,
leftv  w 
)

Definition at line 3249 of file ipshell.cc.

3250 {
3251  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3252  (poly)w->CopyD(), currRing);
3253  return errorreported;
3254 }
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:10
short errorreported
Definition: feFopen.cc:23
polyrec * poly
Definition: hilb.h:10
void * CopyD(int t)
Definition: subexpr.cc:714

§ jjVARIABLES_ID()

BOOLEAN jjVARIABLES_ID ( leftv  res,
leftv  u 
)

Definition at line 6218 of file ipshell.cc.

6219 {
6220  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6221  ideal I=(ideal)u->Data();
6222  int i;
6223  int n=0;
6224  for(i=I->nrows*I->ncols-1;i>=0;i--)
6225  {
6226  int n0=pGetVariables(I->m[i],e);
6227  if (n0>n) n=n0;
6228  }
6229  jjINT_S_TO_ID(n,e,res);
6230  return FALSE;
6231 }
#define FALSE
Definition: auxiliary.h:95
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:580
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6188
#define pGetVariables(p, e)
Definition: polys.h:234
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
int i
Definition: cfEzgcd.cc:123
void * Data()
Definition: subexpr.cc:1146
#define omAlloc0(size)
Definition: omAllocDecl.h:211

§ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6210 of file ipshell.cc.

6211 {
6212  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6213  int n=pGetVariables((poly)u->Data(),e);
6214  jjINT_S_TO_ID(n,e,res);
6215  return FALSE;
6216 }
#define FALSE
Definition: auxiliary.h:95
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:580
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6188
#define pGetVariables(p, e)
Definition: polys.h:234
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
void * Data()
Definition: subexpr.cc:1146
polyrec * poly
Definition: hilb.h:10
#define omAlloc0(size)
Definition: omAllocDecl.h:211

§ kGroebner()

ideal kGroebner ( ideal  F,
ideal  Q 
)

Definition at line 6143 of file ipshell.cc.

6144 {
6145  //test|=Sy_bit(OPT_PROT);
6146  idhdl save_ringhdl=currRingHdl;
6147  ideal resid;
6148  idhdl new_ring=NULL;
6149  if ((currRingHdl==NULL) || (IDRING(currRingHdl)!=currRing))
6150  {
6151  currRingHdl=enterid(omStrDup(" GROEBNERring"),0,RING_CMD,&IDROOT,FALSE);
6152  new_ring=currRingHdl;
6154  }
6155  sleftv v; memset(&v,0,sizeof(v)); v.rtyp=IDEAL_CMD; v.data=(char *) F;
6156  idhdl h=ggetid("groebner");
6157  sleftv u; memset(&u,0,sizeof(u)); u.rtyp=IDHDL; u.data=(char *) h;
6158  u.name=IDID(h);
6159 
6160  sleftv res; memset(&res,0,sizeof(res));
6161  if(jjPROC(&res,&u,&v))
6162  {
6163  resid=kStd(F,Q,testHomog,NULL);
6164  }
6165  else
6166  {
6167  //printf("typ:%d\n",res.rtyp);
6168  resid=(ideal)(res.data);
6169  }
6170  // cleanup GROEBNERring, save_ringhdl, u,v,(res )
6171  if (new_ring!=NULL)
6172  {
6173  idhdl h=IDROOT;
6174  if (h==new_ring) IDROOT=h->next;
6175  else
6176  {
6177  while ((h!=NULL) &&(h->next!=new_ring)) h=h->next;
6178  if (h!=NULL) h->next=h->next->next;
6179  }
6180  if (h!=NULL) omFreeSize(h,sizeof(*h));
6181  }
6182  currRingHdl=save_ringhdl;
6183  u.CleanUp();
6184  v.CleanUp();
6185  return resid;
6186 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:95
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1602
#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:2231
#define Q
Definition: sirandom.c:25
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:31
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:10
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:261
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:124
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:335
static Poly * h
Definition: janet.cc:978
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:498
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ killlocals()

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  {
396  if (((ring)h->data)->idroot!=NULL)
397  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
398  }
399  else if (/*iiRETURNEXPR.Typ()*/ t==LIST_CMD)
400  {
401  leftv h=&iiRETURNEXPR;
402  changed |=killlocals_list(v,(lists)h->data);
403  }
404  }
405  if (changed)
406  {
408  if (currRingHdl==NULL)
409  currRing=NULL;
410  else if(cr!=currRing)
411  rChangeCurrRing(cr);
412  }
413 
414  if (myynest<=1) iiNoKeepRing=TRUE;
415  //Print("end killlocals >= %d\n",v);
416  //listall();
417 }
int iiRETURNEXPR_len
Definition: iplib.cc:472
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:95
sleftv iiRETURNEXPR
Definition: iplib.cc:471
#define TRUE
Definition: auxiliary.h:99
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:324
int Typ()
Definition: subexpr.cc:1004
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:10
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:360
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:84
idhdl currRingHdl
Definition: ipid.cc:65
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1572
#define IDLEV(a)
Definition: ipid.h:118
void rChangeCurrRing(ring r)
Definition: polys.cc:12
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:124
Definition: tok.h:117
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:86
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:289

§ killlocals0()

static void killlocals0 ( int  v,
idhdl localhdl,
const ring  r 
)
static

Definition at line 289 of file ipshell.cc.

290 {
291  idhdl h = *localhdl;
292  while (h!=NULL)
293  {
294  int vv;
295  //Print("consider %s, lev: %d:",IDID(h),IDLEV(h));
296  if ((vv=IDLEV(h))>0)
297  {
298  if (vv < v)
299  {
300  if (iiNoKeepRing)
301  {
302  //PrintS(" break\n");
303  return;
304  }
305  h = IDNEXT(h);
306  //PrintLn();
307  }
308  else //if (vv >= v)
309  {
310  idhdl nexth = IDNEXT(h);
311  killhdl2(h,localhdl,r);
312  h = nexth;
313  //PrintS("kill\n");
314  }
315  }
316  else
317  {
318  h = IDNEXT(h);
319  //PrintLn();
320  }
321  }
322 }
#define IDNEXT(a)
Definition: ipid.h:115
Definition: idrec.h:34
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:411
const ring r
Definition: syzextra.cc:208
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:84
#define IDLEV(a)
Definition: ipid.h:118
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

§ killlocals_list()

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)
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:95
#define TRUE
Definition: auxiliary.h:99
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:10
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:360
void rChangeCurrRing(ring r)
Definition: polys.cc:12
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:117
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:86
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:289

§ killlocals_rec()

void killlocals_rec ( idhdl root,
int  v,
ring  r 
)

Definition at line 324 of file ipshell.cc.

325 {
326  idhdl h=*root;
327  while (h!=NULL)
328  {
329  if (IDLEV(h)>=v)
330  {
331 // Print("kill %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
332  idhdl n=IDNEXT(h);
333  killhdl2(h,root,r);
334  h=n;
335  }
336  else if (IDTYP(h)==PACKAGE_CMD)
337  {
338  // Print("into pack %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
339  if (IDPACKAGE(h)!=basePack)
340  killlocals_rec(&(IDRING(h)->idroot),v,r);
341  h=IDNEXT(h);
342  }
343  else if (IDTYP(h)==RING_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:115
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:324
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:136
#define IDTYP(a)
Definition: ipid.h:116
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:411
const ring r
Definition: syzextra.cc:208
#define IDLEV(a)
Definition: ipid.h:118
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:124
static Poly * h
Definition: janet.cc:978

§ kQHWeight()

BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3232 of file ipshell.cc.

3233 {
3234  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3235  if (res->data==NULL)
3236  res->data=(char *)new intvec(rVar(currRing));
3237  return FALSE;
3238 }
#define FALSE
Definition: auxiliary.h:95
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:580
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:10
Definition: intvec.h:14
#define NULL
Definition: omList.c:10
void * Data()
Definition: subexpr.cc:1146

§ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3210 of file ipshell.cc.

3211 {
3212  ideal F=(ideal)id->Data();
3213  intvec * iv = new intvec(rVar(currRing));
3214  polyset s;
3215  int sl, n, i;
3216  int *x;
3217 
3218  res->data=(char *)iv;
3219  s = F->m;
3220  sl = IDELEMS(F) - 1;
3221  n = rVar(currRing);
3222  double wNsqr = (double)2.0 / (double)n;
3224  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3225  wCall(s, sl, x, wNsqr, currRing);
3226  for (i = n; i!=0; i--)
3227  (*iv)[i-1] = x[i + n + 1];
3228  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3229  return FALSE;
3230 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define FALSE
Definition: auxiliary.h:95
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:580
void * ADDRESS
Definition: auxiliary.h:116
#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:10
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:1146
double wFunctionalBuch(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight0.c:78

§ list1()

static void list1 ( const char *  s,
idhdl  h,
BOOLEAN  c,
BOOLEAN  fullname 
)
static

Definition at line 149 of file ipshell.cc.

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

§ list_cmd()

void list_cmd ( int  typ,
const char *  what,
const char *  prefix,
BOOLEAN  iterate,
BOOLEAN  fullname 
)

Definition at line 419 of file ipshell.cc.

420 {
421  package savePack=currPack;
422  idhdl h,start;
423  BOOLEAN all = typ<0;
424  BOOLEAN really_all=FALSE;
425 
426  if ( typ==0 )
427  {
428  if (strcmp(what,"all")==0)
429  {
430  if (currPack!=basePack)
431  list_cmd(-1,NULL,prefix,iterate,fullname); // list current package
432  really_all=TRUE;
433  h=basePack->idroot;
434  }
435  else
436  {
437  h = ggetid(what);
438  if (h!=NULL)
439  {
440  if (iterate) list1(prefix,h,TRUE,fullname);
441  if (IDTYP(h)==ALIAS_CMD) PrintS("A");
442  if ((IDTYP(h)==RING_CMD)
443  //|| (IDTYP(h)==PACKE_CMD)
444  )
445  {
446  h=IDRING(h)->idroot;
447  }
448  else if(IDTYP(h)==PACKAGE_CMD)
449  {
450  currPack=IDPACKAGE(h);
451  //Print("list_cmd:package\n");
452  all=TRUE;typ=PROC_CMD;fullname=TRUE;really_all=TRUE;
453  h=IDPACKAGE(h)->idroot;
454  }
455  else
456  {
457  currPack=savePack;
458  return;
459  }
460  }
461  else
462  {
463  Werror("%s is undefined",what);
464  currPack=savePack;
465  return;
466  }
467  }
468  all=TRUE;
469  }
470  else if (RingDependend(typ))
471  {
472  h = currRing->idroot;
473  }
474  else
475  h = IDROOT;
476  start=h;
477  while (h!=NULL)
478  {
479  if ((all
480  && (IDTYP(h)!=PROC_CMD)
481  &&(IDTYP(h)!=PACKAGE_CMD)
482  #ifdef SINGULAR_4_1
483  &&(IDTYP(h)!=CRING_CMD)
484  #endif
485  )
486  || (typ == IDTYP(h))
487  #ifdef SINGULAR_4_1
488  || ((IDTYP(h)==CRING_CMD) && (typ==RING_CMD))
489  #endif
490  )
491  {
492  list1(prefix,h,start==currRingHdl, fullname);
493  if ((IDTYP(h)==RING_CMD)
494  && (really_all || (all && (h==currRingHdl)))
495  && ((IDLEV(h)==0)||(IDLEV(h)==myynest)))
496  {
497  list_cmd(0,IDID(h),"// ",FALSE);
498  }
499  if (IDTYP(h)==PACKAGE_CMD && really_all)
500  {
501  package save_p=currPack;
502  currPack=IDPACKAGE(h);
503  list_cmd(0,IDID(h),"// ",FALSE);
504  currPack=save_p;
505  }
506  }
507  h = IDNEXT(h);
508  }
509  currPack=savePack;
510 }
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:95
#define IDNEXT(a)
Definition: ipid.h:115
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:99
static void list1(const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
Definition: ipshell.cc:149
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:136
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:10
#define IDTYP(a)
Definition: ipid.h:116
Definition: tok.h:56
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:419
idhdl currRingHdl
Definition: ipid.cc:65
void PrintS(const char *s)
Definition: reporter.cc:284
#define IDLEV(a)
Definition: ipid.h:118
Definition: tok.h:34
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
#define IDRING(a)
Definition: ipid.h:124
package currPack
Definition: ipid.cc:63
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:86
void Werror(const char *fmt,...)
Definition: reporter.cc:189
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:498

§ list_error()

void list_error ( semicState  state)

Definition at line 3377 of file ipshell.cc.

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

§ list_is_spectrum()

semicState list_is_spectrum ( lists  l)

Definition at line 4162 of file ipshell.cc.

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

§ listOfRoots()

lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 4974 of file ipshell.cc.

4975 {
4976  int i,j;
4977  int count= self->roots[0]->getAnzRoots(); // number of roots
4978  int elem= self->roots[0]->getAnzElems(); // number of koordinates per root
4979 
4980  lists listofroots= (lists)omAlloc( sizeof(slists) ); // must be done this way!
4981 
4982  if ( self->found_roots )
4983  {
4984  listofroots->Init( count );
4985 
4986  for (i=0; i < count; i++)
4987  {
4988  lists onepoint= (lists)omAlloc(sizeof(slists)); // must be done this way!
4989  onepoint->Init(elem);
4990  for ( j= 0; j < elem; j++ )
4991  {
4992  if ( !rField_is_long_C(currRing) )
4993  {
4994  onepoint->m[j].rtyp=STRING_CMD;
4995  onepoint->m[j].data=(void *)complexToStr((*self->roots[j])[i],oprec, currRing->cf);
4996  }
4997  else
4998  {
4999  onepoint->m[j].rtyp=NUMBER_CMD;
5000  onepoint->m[j].data=(void *)n_Copy((number)(self->roots[j]->getRoot(i)), currRing->cf);
5001  }
5002  onepoint->m[j].next= NULL;
5003  onepoint->m[j].name= NULL;
5004  }
5005  listofroots->m[i].rtyp=LIST_CMD;
5006  listofroots->m[i].data=(void *)onepoint;
5007  listofroots->m[j].next= NULL;
5008  listofroots->m[j].name= NULL;
5009  }
5010 
5011  }
5012  else
5013  {
5014  listofroots->Init( 0 );
5015  }
5016 
5017  return listofroots;
5018 }
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:10
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:534
INLINE_THIS void Init(int l=0)
#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:455
int rtyp
Definition: subexpr.h:92
Definition: tok.h:117
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition: mpr_complex.cc:706
rootContainer ** roots
Definition: mpr_numeric.h:167

§ loNewtonP()

BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4472 of file ipshell.cc.

4473 {
4474  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4475  return FALSE;
4476 }
#define FALSE
Definition: auxiliary.h:95
ideal loNewtonPolytope(const ideal id)
Definition: mpr_base.cc:3190
void * data
Definition: subexpr.h:89
void * Data()
Definition: subexpr.cc:1146

§ loSimplex()

BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4478 of file ipshell.cc.

4479 {
4480  if ( !(rField_is_long_R(currRing)) )
4481  {
4482  WerrorS("Ground field not implemented!");
4483  return TRUE;
4484  }
4485 
4486  simplex * LP;
4487  matrix m;
4488 
4489  leftv v= args;
4490  if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4491  return TRUE;
4492  else
4493  m= (matrix)(v->CopyD());
4494 
4495  LP = new simplex(MATROWS(m),MATCOLS(m));
4496  LP->mapFromMatrix(m);
4497 
4498  v= v->next;
4499  if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4500  return TRUE;
4501  else
4502  LP->m= (int)(long)(v->Data());
4503 
4504  v= v->next;
4505  if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4506  return TRUE;
4507  else
4508  LP->n= (int)(long)(v->Data());
4509 
4510  v= v->next;
4511  if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4512  return TRUE;
4513  else
4514  LP->m1= (int)(long)(v->Data());
4515 
4516  v= v->next;
4517  if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4518  return TRUE;
4519  else
4520  LP->m2= (int)(long)(v->Data());
4521 
4522  v= v->next;
4523  if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4524  return TRUE;
4525  else
4526  LP->m3= (int)(long)(v->Data());
4527 
4528 #ifdef mprDEBUG_PROT
4529  Print("m (constraints) %d\n",LP->m);
4530  Print("n (columns) %d\n",LP->n);
4531  Print("m1 (<=) %d\n",LP->m1);
4532  Print("m2 (>=) %d\n",LP->m2);
4533  Print("m3 (==) %d\n",LP->m3);
4534 #endif
4535 
4536  LP->compute();
4537 
4538  lists lres= (lists)omAlloc( sizeof(slists) );
4539  lres->Init( 6 );
4540 
4541  lres->m[0].rtyp= MATRIX_CMD; // output matrix
4542  lres->m[0].data=(void*)LP->mapToMatrix(m);
4543 
4544  lres->m[1].rtyp= INT_CMD; // found a solution?
4545  lres->m[1].data=(void*)(long)LP->icase;
4546 
4547  lres->m[2].rtyp= INTVEC_CMD;
4548  lres->m[2].data=(void*)LP->posvToIV();
4549 
4550  lres->m[3].rtyp= INTVEC_CMD;
4551  lres->m[3].data=(void*)LP->zrovToIV();
4552 
4553  lres->m[4].rtyp= INT_CMD;
4554  lres->m[4].data=(void*)(long)LP->m;
4555 
4556  lres->m[5].rtyp= INT_CMD;
4557  lres->m[5].data=(void*)(long)LP->n;
4558 
4559  res->data= (void*)lres;
4560 
4561  return FALSE;
4562 }
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:95
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:95
Linear Programming / Linear Optimization using Simplex - Algorithm.
Definition: mpr_numeric.h:194
#define TRUE
Definition: auxiliary.h:99
intvec * zrovToIV()
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:1004
#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:10
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)
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:531
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1146
#define MATROWS(i)
Definition: matpol.h:27
int icase
Definition: mpr_numeric.h:201
void * CopyD(int t)
Definition: subexpr.cc:714

§ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 2980 of file ipshell.cc.

2981 {
2982  int i,j;
2983  matrix result;
2984  ideal id=(ideal)a->Data();
2985 
2986  result =mpNew(IDELEMS(id),rVar(currRing));
2987  for (i=1; i<=IDELEMS(id); i++)
2988  {
2989  for (j=1; j<=rVar(currRing); j++)
2990  {
2991  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
2992  }
2993  }
2994  res->data=(char *)result;
2995  return FALSE;
2996 }
#define FALSE
Definition: auxiliary.h:95
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:580
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:10
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:47
void * Data()
Definition: subexpr.cc:1146
#define pDiff(a, b)
Definition: polys.h:279
return result
Definition: facAbsBiFact.cc:76
#define MATELEM(mat, i, j)
Definition: matpol.h:29

§ mpKoszul()

BOOLEAN mpKoszul ( leftv  res,
leftv  c,
leftv  b,
leftv  id 
)

Definition at line 3002 of file ipshell.cc.

3003 {
3004  int n=(int)(long)b->Data();
3005  int d=(int)(long)c->Data();
3006  int k,l,sign,row,col;
3007  matrix result;
3008  ideal temp;
3009  BOOLEAN bo;
3010  poly p;
3011 
3012  if ((d>n) || (d<1) || (n<1))
3013  {
3014  res->data=(char *)mpNew(1,1);
3015  return FALSE;
3016  }
3017  int *choise = (int*)omAlloc(d*sizeof(int));
3018  if (id==NULL)
3019  temp=idMaxIdeal(1);
3020  else
3021  temp=(ideal)id->Data();
3022 
3023  k = binom(n,d);
3024  l = k*d;
3025  l /= n-d+1;
3026  result =mpNew(l,k);
3027  col = 1;
3028  idInitChoise(d,1,n,&bo,choise);
3029  while (!bo)
3030  {
3031  sign = 1;
3032  for (l=1;l<=d;l++)
3033  {
3034  if (choise[l-1]<=IDELEMS(temp))
3035  {
3036  p = pCopy(temp->m[choise[l-1]-1]);
3037  if (sign == -1) p = pNeg(p);
3038  sign *= -1;
3039  row = idGetNumberOfChoise(l-1,d,1,n,choise);
3040  MATELEM(result,row,col) = p;
3041  }
3042  }
3043  col++;
3044  idGetNextChoise(d,n,&bo,choise);
3045  }
3046  if (id==NULL) idDelete(&temp);
3047 
3048  res->data=(char *)result;
3049  return FALSE;
3050 }
#define idMaxIdeal(D)
initialise the maximal ideal (at 0)
Definition: ideals.h:33
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
#define FALSE
Definition: auxiliary.h:95
return P p
Definition: myNF.cc:203
#define pNeg(p)
Definition: polys.h:181
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:47
#define NULL
Definition: omList.c:10
void idInitChoise(int r, int beg, int end, BOOLEAN *endch, int *choise)
void * Data()
Definition: subexpr.cc:1146
int idGetNumberOfChoise(int t, int d, int begin, int end, int *choise)
polyrec * poly
Definition: hilb.h:10
int BOOLEAN
Definition: auxiliary.h:86
static int sign(int x)
Definition: ring.cc:3328
int binom(int n, int r)
return result
Definition: facAbsBiFact.cc:76
int l
Definition: cfEzgcd.cc:94
#define pCopy(p)
return a copy of the poly
Definition: polys.h:168
#define MATELEM(mat, i, j)
Definition: matpol.h:29

§ nuLagSolve()

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 4587 of file ipshell.cc.

4588 {
4589 
4590  poly gls;
4591  gls= (poly)(arg1->Data());
4592  int howclean= (int)(long)arg3->Data();
4593 
4594  if ( !(rField_is_R(currRing) ||
4595  rField_is_Q(currRing) ||
4598  {
4599  WerrorS("Ground field not implemented!");
4600  return TRUE;
4601  }
4602 
4605  {
4606  unsigned long int ii = (unsigned long int)arg2->Data();
4607  setGMPFloatDigits( ii, ii );
4608  }
4609 
4610  if ( gls == NULL || pIsConstant( gls ) )
4611  {
4612  WerrorS("Input polynomial is constant!");
4613  return TRUE;
4614  }
4615 
4616  int ldummy;
4617  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4618  int i,vpos=0;
4619  poly piter;
4620  lists elist;
4621  lists rlist;
4622 
4623  elist= (lists)omAlloc( sizeof(slists) );
4624  elist->Init( 0 );
4625 
4626  if ( rVar(currRing) > 1 )
4627  {
4628  piter= gls;
4629  for ( i= 1; i <= rVar(currRing); i++ )
4630  if ( pGetExp( piter, i ) )
4631  {
4632  vpos= i;
4633  break;
4634  }
4635  while ( piter )
4636  {
4637  for ( i= 1; i <= rVar(currRing); i++ )
4638  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4639  {
4640  WerrorS("The input polynomial must be univariate!");
4641  return TRUE;
4642  }
4643  pIter( piter );
4644  }
4645  }
4646 
4647  rootContainer * roots= new rootContainer();
4648  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4649  piter= gls;
4650  for ( i= deg; i >= 0; i-- )
4651  {
4652  if ( piter && pTotaldegree(piter) == i )
4653  {
4654  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4655  //nPrint( pcoeffs[i] );PrintS(" ");
4656  pIter( piter );
4657  }
4658  else
4659  {
4660  pcoeffs[i]= nInit(0);
4661  }
4662  }
4663 
4664 #ifdef mprDEBUG_PROT
4665  for (i=deg; i >= 0; i--)
4666  {
4667  nPrint( pcoeffs[i] );PrintS(" ");
4668  }
4669  PrintLn();
4670 #endif
4671 
4672  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4673  roots->solver( howclean );
4674 
4675  int elem= roots->getAnzRoots();
4676  char *dummy;
4677  int j;
4678 
4679  rlist= (lists)omAlloc( sizeof(slists) );
4680  rlist->Init( elem );
4681 
4683  {
4684  for ( j= 0; j < elem; j++ )
4685  {
4686  rlist->m[j].rtyp=NUMBER_CMD;
4687  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4688  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4689  }
4690  }
4691  else
4692  {
4693  for ( j= 0; j < elem; j++ )
4694  {
4695  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4696  rlist->m[j].rtyp=STRING_CMD;
4697  rlist->m[j].data=(void *)dummy;
4698  }
4699  }
4700 
4701  elist->Clean();
4702  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4703 
4704  // this is (via fillContainer) the same data as in root
4705  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4706  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4707 
4708  delete roots;
4709 
4710  res->rtyp= LIST_CMD;
4711  res->data= (void*)rlist;
4712 
4713  return FALSE;
4714 }
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:310
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:95
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:507
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:580
#define TRUE
Definition: auxiliary.h:99
bool solver(const int polishmode=PM_NONE)
Definition: mpr_numeric.cc:449
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:10
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
int j
Definition: myNF.cc:70
static long pTotaldegree(poly p)
Definition: polys.h:265
#define pIsConstant(p)
like above, except that Comp might be != 0
Definition: polys.h:221
void fillContainer(number *_coeffs, number *_ievpoint, const int _var, const int _tdg, const rootType _rt, const int _anz)
Definition: mpr_numeric.cc:312
int i
Definition: cfEzgcd.cc:123
void PrintS(const char *s)
Definition: reporter.cc:284
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:501
gmp_complex * getRoot(const int i)
Definition: mpr_numeric.h:88
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:534
INLINE_THIS void Init(int l=0)
#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:531
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:1146
Definition: tok.h:117
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition: mpr_complex.cc:706
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

§ nuMPResMat()

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 4564 of file ipshell.cc.

4565 {
4566  ideal gls = (ideal)(arg1->Data());
4567  int imtype= (int)(long)arg2->Data();
4568 
4569  uResultant::resMatType mtype= determineMType( imtype );
4570 
4571  // check input ideal ( = polynomial system )
4572  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4573  {
4574  return TRUE;
4575  }
4576 
4577  uResultant *resMat= new uResultant( gls, mtype, false );
4578  if (resMat!=NULL)
4579  {
4580  res->rtyp = MODUL_CMD;
4581  res->data= (void*)resMat->accessResMat()->getMatrix();
4582  if (!errorreported) delete resMat;
4583  }
4584  return errorreported;
4585 }
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:99
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:1146

§ nuUResSolve()

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 4817 of file ipshell.cc.

4818 {
4819  leftv v= args;
4820 
4821  ideal gls;
4822  int imtype;
4823  int howclean;
4824 
4825  // get ideal
4826  if ( v->Typ() != IDEAL_CMD )
4827  return TRUE;
4828  else gls= (ideal)(v->Data());
4829  v= v->next;
4830 
4831  // get resultant matrix type to use (0,1)
4832  if ( v->Typ() != INT_CMD )
4833  return TRUE;
4834  else imtype= (int)(long)v->Data();
4835  v= v->next;
4836 
4837  if (imtype==0)
4838  {
4839  ideal test_id=idInit(1,1);
4840  int j;
4841  for(j=IDELEMS(gls)-1;j>=0;j--)
4842  {
4843  if (gls->m[j]!=NULL)
4844  {
4845  test_id->m[0]=gls->m[j];
4846  intvec *dummy_w=id_QHomWeight(test_id, currRing);
4847  if (dummy_w!=NULL)
4848  {
4849  WerrorS("Newton polytope not of expected dimension");
4850  delete dummy_w;
4851  return TRUE;
4852  }
4853  }
4854  }
4855  }
4856 
4857  // get and set precision in digits ( > 0 )
4858  if ( v->Typ() != INT_CMD )
4859  return TRUE;
4860  else if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
4862  {
4863  unsigned long int ii=(unsigned long int)v->Data();
4864  setGMPFloatDigits( ii, ii );
4865  }
4866  v= v->next;
4867 
4868  // get interpolation steps (0,1,2)
4869  if ( v->Typ() != INT_CMD )
4870  return TRUE;
4871  else howclean= (int)(long)v->Data();
4872 
4873  uResultant::resMatType mtype= determineMType( imtype );
4874  int i,count;
4875  lists listofroots= NULL;
4876  number smv= NULL;
4877  BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;
4878 
4879  //emptylist= (lists)omAlloc( sizeof(slists) );
4880  //emptylist->Init( 0 );
4881 
4882  //res->rtyp = LIST_CMD;
4883  //res->data= (void *)emptylist;
4884 
4885  // check input ideal ( = polynomial system )
4886  if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
4887  {
4888  return TRUE;
4889  }
4890 
4891  uResultant * ures;
4892  rootContainer ** iproots;
4893  rootContainer ** muiproots;
4894  rootArranger * arranger;
4895 
4896  // main task 1: setup of resultant matrix
4897  ures= new uResultant( gls, mtype );
4898  if ( ures->accessResMat()->initState() != resMatrixBase::ready )
4899  {
4900  WerrorS("Error occurred during matrix setup!");
4901  return TRUE;
4902  }
4903 
4904  // if dense resultant, check if minor nonsingular
4905  if ( mtype == uResultant::denseResMat )
4906  {
4907  smv= ures->accessResMat()->getSubDet();
4908 #ifdef mprDEBUG_PROT
4909  PrintS("// Determinant of submatrix: ");nPrint(smv);PrintLn();
4910 #endif
4911  if ( nIsZero(smv) )
4912  {
4913  WerrorS("Unsuitable input ideal: Minor of resultant matrix is singular!");
4914  return TRUE;
4915  }
4916  }
4917 
4918  // main task 2: Interpolate specialized resultant polynomials
4919  if ( interpolate_det )
4920  iproots= ures->interpolateDenseSP( false, smv );
4921  else
4922  iproots= ures->specializeInU( false, smv );
4923 
4924  // main task 3: Interpolate specialized resultant polynomials
4925  if ( interpolate_det )
4926  muiproots= ures->interpolateDenseSP( true, smv );
4927  else
4928  muiproots= ures->specializeInU( true, smv );
4929 
4930 #ifdef mprDEBUG_PROT
4931  int c= iproots[0]->getAnzElems();
4932  for (i=0; i < c; i++) pWrite(iproots[i]->getPoly());
4933  c= muiproots[0]->getAnzElems();
4934  for (i=0; i < c; i++) pWrite(muiproots[i]->getPoly());
4935 #endif
4936 
4937  // main task 4: Compute roots of specialized polys and match them up
4938  arranger= new rootArranger( iproots, muiproots, howclean );
4939  arranger->solve_all();
4940 
4941  // get list of roots
4942  if ( arranger->success() )
4943  {
4944  arranger->arrange();
4945  listofroots= listOfRoots(arranger, gmp_output_digits );
4946  }
4947  else
4948  {
4949  WerrorS("Solver was unable to find any roots!");
4950  return TRUE;
4951  }
4952 
4953  // free everything
4954  count= iproots[0]->getAnzElems();
4955  for (i=0; i < count; i++) delete iproots[i];
4956  omFreeSize( (ADDRESS) iproots, count * sizeof(rootContainer*) );
4957  count= muiproots[0]->getAnzElems();
4958  for (i=0; i < count; i++) delete muiproots[i];
4959  omFreeSize( (ADDRESS) muiproots, count * sizeof(rootContainer*) );
4960 
4961  delete ures;
4962  delete arranger;
4963  nDelete( &smv );
4964 
4965  res->data= (void *)listofroots;
4966 
4967  //emptylist->Clean();
4968  // omFreeSize( (ADDRESS) emptylist, sizeof(slists) );
4969 
4970  return FALSE;
4971 }
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:310
Base class for solving 0-dim poly systems using u-resultant.
Definition: mpr_base.h:62
Definition: tok.h:95
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:95
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:507
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:99
uResultant::resMatType determineMType(int imtype)
void * ADDRESS
Definition: auxiliary.h:116
void pWrite(poly p)
Definition: polys.h:291
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:3059
int Typ()
Definition: subexpr.cc:1004
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:10
Definition: intvec.h:14
int j
Definition: myNF.cc:70
bool success()
Definition: mpr_numeric.h:162
void arrange()
Definition: mpr_numeric.cc:895
int i
Definition: cfEzgcd.cc:123
void PrintS(const char *s)
Definition: reporter.cc:284
void solve_all()
Definition: mpr_numeric.cc:870
#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:2921
#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:534
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:531
void * Data()
Definition: subexpr.cc:1146
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
virtual IStateType initState() const
Definition: mpr_base.h:41
int BOOLEAN
Definition: auxiliary.h:86
lists listOfRoots(rootArranger *self, const unsigned int oprec)
Definition: ipshell.cc:4974
virtual number getSubDet()
Definition: mpr_base.h:37

§ nuVanderSys()

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 4716 of file ipshell.cc.

4717 {
4718  int i;
4719  ideal p,w;
4720  p= (ideal)arg1->Data();
4721  w= (ideal)arg2->Data();
4722 
4723  // w[0] = f(p^0)
4724  // w[1] = f(p^1)
4725  // ...
4726  // p can be a vector of numbers (multivariate polynom)
4727  // or one number (univariate polynom)
4728  // tdg = deg(f)
4729 
4730  int n= IDELEMS( p );
4731  int m= IDELEMS( w );
4732  int tdg= (int)(long)arg3->Data();
4733 
4734  res->data= (void*)NULL;
4735 
4736  // check the input
4737  if ( tdg < 1 )
4738  {
4739  WerrorS("Last input parameter must be > 0!");
4740  return TRUE;
4741  }
4742  if ( n != rVar(currRing) )
4743  {
4744  Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
4745  return TRUE;
4746  }
4747  if ( m != (int)pow((double)tdg+1,(double)n) )
4748  {
4749  Werror("Size of second input ideal must be equal to %d!",
4750  (int)pow((double)tdg+1,(double)n));
4751  return TRUE;
4752  }
4753  if ( !(rField_is_Q(currRing) /* ||
4754  rField_is_R() || rField_is_long_R() ||
4755  rField_is_long_C()*/ ) )
4756  {
4757  WerrorS("Ground field not implemented!");
4758  return TRUE;
4759  }
4760 
4761  number tmp;
4762  number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
4763  for ( i= 0; i < n; i++ )
4764  {
4765  pevpoint[i]=nInit(0);
4766  if ( (p->m)[i] )
4767  {
4768  tmp = pGetCoeff( (p->m)[i] );
4769  if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
4770  {
4771  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4772  WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
4773  return TRUE;
4774  }
4775  } else tmp= NULL;
4776  if ( !nIsZero(tmp) )
4777  {
4778  if ( !pIsConstant((p->m)[i]))
4779  {
4780  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4781  WerrorS("Elements of first input ideal must be numbers!");
4782  return TRUE;
4783  }
4784  pevpoint[i]= nCopy( tmp );
4785  }
4786  }
4787 
4788  number *wresults= (number *)omAlloc( m * sizeof( number ) );
4789  for ( i= 0; i < m; i++ )
4790  {
4791  wresults[i]= nInit(0);
4792  if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
4793  {
4794  if ( !pIsConstant((w->m)[i]))
4795  {
4796  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4797  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4798  WerrorS("Elements of second input ideal must be numbers!");
4799  return TRUE;
4800  }
4801  wresults[i]= nCopy(pGetCoeff((w->m)[i]));
4802  }
4803  }
4804 
4805  vandermonde vm( m, n, tdg, pevpoint, FALSE );
4806  number *ncpoly= vm.interpolateDense( wresults );
4807  // do not free ncpoly[]!!
4808  poly rpoly= vm.numvec2poly( ncpoly );
4809 
4810  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4811  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4812 
4813  res->data= (void*)rpoly;
4814  return FALSE;
4815 }
vandermonde system solver for interpolating polynomials from their values
Definition: mpr_numeric.h:28
#define FALSE
Definition: auxiliary.h:95
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:580
#define TRUE
Definition: auxiliary.h:99
#define nIsOne(n)
Definition: numbers.h:25
void * ADDRESS
Definition: auxiliary.h:116
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:10
int m
Definition: cfEzgcd.cc:119
#define pIsConstant(p)
like above, except that Comp might be != 0
Definition: polys.h:221
int i
Definition: cfEzgcd.cc:123
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:501
#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:1146
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:189

§ paPrint()

void paPrint ( const char *  n,
package  p 
)

Definition at line 6233 of file ipshell.cc.

6234 {
6235  Print(" %s (",n);
6236  switch (p->language)
6237  {
6238  case LANG_SINGULAR: PrintS("S"); break;
6239  case LANG_C: PrintS("C"); break;
6240  case LANG_TOP: PrintS("T"); break;
6241  case LANG_NONE: PrintS("N"); break;
6242  default: PrintS("U");
6243  }
6244  if(p->libname!=NULL)
6245  Print(",%s", p->libname);
6246  PrintS(")");
6247 }
#define Print
Definition: emacs.cc:83
return P p
Definition: myNF.cc:203
Definition: subexpr.h:21
void PrintS(const char *s)
Definition: reporter.cc:284
#define NULL
Definition: omList.c:10

§ rCompose()

ring rCompose ( const lists  L,
const BOOLEAN  check_comp 
)

Definition at line 2712 of file ipshell.cc.

2713 {
2714  if ((L->nr!=3)
2715 #ifdef HAVE_PLURAL
2716  &&(L->nr!=5)
2717 #endif
2718  )
2719  return NULL;
2720  int is_gf_char=0;
2721  // 0: char/ cf - ring
2722  // 1: list (var)
2723  // 2: list (ord)
2724  // 3: qideal
2725  // possibly:
2726  // 4: C
2727  // 5: D
2728 
2729  ring R = (ring) omAlloc0Bin(sip_sring_bin);
2730 
2731  // ------------------------------------------------------------------
2732  // 0: char:
2733 #ifdef SINGULAR_4_1
2734  if (L->m[0].Typ()==CRING_CMD)
2735  {
2736  R->cf=(coeffs)L->m[0].Data();
2737  R->cf->ref++;
2738  }
2739  else
2740 #endif
2741  if (L->m[0].Typ()==INT_CMD)
2742  {
2743  int ch = (int)(long)L->m[0].Data();
2744  assume( ch >= 0 );
2745 
2746  if (ch == 0) // Q?
2747  R->cf = nInitChar(n_Q, NULL);
2748  else
2749  {
2750  int l = IsPrime(ch); // Zp?
2751  if( l != ch )
2752  {
2753  Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
2754  ch = l;
2755  }
2756  R->cf = nInitChar(n_Zp, (void*)(long)ch);
2757  }
2758  }
2759  else if (L->m[0].Typ()==LIST_CMD) // something complicated...
2760  {
2761  lists LL=(lists)L->m[0].Data();
2762 
2763 #ifdef HAVE_RINGS
2764  if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
2765  {
2766  rComposeRing(LL, R); // Ring!?
2767  }
2768  else
2769 #endif
2770  if (LL->nr < 3)
2771  rComposeC(LL,R); // R, long_R, long_C
2772  else
2773  {
2774  if (LL->m[0].Typ()==INT_CMD)
2775  {
2776  int ch = (int)(long)LL->m[0].Data();
2777  while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
2778  if (fftable[is_gf_char]==0) is_gf_char=-1;
2779 
2780  if(is_gf_char!= -1)
2781  {
2782  GFInfo param;
2783 
2784  param.GFChar = ch;
2785  param.GFDegree = 1;
2786  param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
2787 
2788  // nfInitChar should be able to handle the case when ch is in fftables!
2789  R->cf = nInitChar(n_GF, (void*)&param);
2790  }
2791  }
2792 
2793  if( R->cf == NULL )
2794  {
2795  ring extRing = rCompose((lists)L->m[0].Data(),FALSE);
2796 
2797  if (extRing==NULL)
2798  {
2799  WerrorS("could not create the specified coefficient field");
2800  goto rCompose_err;
2801  }
2802 
2803  if( extRing->qideal != NULL ) // Algebraic extension
2804  {
2805  AlgExtInfo extParam;
2806 
2807  extParam.r = extRing;
2808 
2809  R->cf = nInitChar(n_algExt, (void*)&extParam);
2810  }
2811  else // Transcendental extension
2812  {
2813  TransExtInfo extParam;
2814  extParam.r = extRing;
2815  assume( extRing->qideal == NULL );
2816 
2817  R->cf = nInitChar(n_transExt, &extParam);
2818  }
2819  }
2820  }
2821  }
2822  else
2823  {
2824  WerrorS("coefficient field must be described by `int` or `list`");
2825  goto rCompose_err;
2826  }
2827 
2828  if( R->cf == NULL )
2829  {
2830  WerrorS("could not create coefficient field described by the input!");
2831  goto rCompose_err;
2832  }
2833 
2834  // ------------------------- VARS ---------------------------
2835  if (rComposeVar(L,R)) goto rCompose_err;
2836  // ------------------------ ORDER ------------------------------
2837  if (rComposeOrder(L,check_comp,R)) goto rCompose_err;
2838 
2839  // ------------------------ ??????? --------------------
2840 
2841  rRenameVars(R);
2842  rComplete(R);
2843 
2844  // ------------------------ Q-IDEAL ------------------------
2845 
2846  if (L->m[3].Typ()==IDEAL_CMD)
2847  {
2848  ideal q=(ideal)L->m[3].Data();
2849  if (q->m[0]!=NULL)
2850  {
2851  if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
2852  {
2853  #if 0
2854  WerrorS("coefficient fields must be equal if q-ideal !=0");
2855  goto rCompose_err;
2856  #else
2857  ring orig_ring=currRing;
2858  rChangeCurrRing(R);
2859  int *perm=NULL;
2860  int *par_perm=NULL;
2861  int par_perm_size=0;
2862  nMapFunc nMap;
2863 
2864  if ((nMap=nSetMap(orig_ring->cf))==NULL)
2865  {
2866  if (rEqual(orig_ring,currRing))
2867  {
2868  nMap=n_SetMap(currRing->cf, currRing->cf);
2869  }
2870  else
2871  // Allow imap/fetch to be make an exception only for:
2872  if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2875  ||
2876  (rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
2877  (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
2878  rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
2879  {
2880  par_perm_size=rPar(orig_ring);
2881 
2882 // if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
2883 // naSetChar(rInternalChar(orig_ring),orig_ring);
2884 // else ntSetChar(rInternalChar(orig_ring),orig_ring);
2885 
2886  nSetChar(currRing->cf);
2887  }
2888  else
2889  {
2890  WerrorS("coefficient fields must be equal if q-ideal !=0");
2891  goto rCompose_err;
2892  }
2893  }
2894  perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
2895  if (par_perm_size!=0)
2896  par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2897  int i;
2898  #if 0
2899  // use imap:
2900  maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
2901  currRing->names,currRing->N,currRing->parameter, currRing->P,
2902  perm,par_perm, currRing->ch);
2903  #else
2904  // use fetch
2905  if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
2906  {
2907  for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
2908  }
2909  else if (par_perm_size!=0)
2910  for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2911  for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
2912  #endif
2913  ideal dest_id=idInit(IDELEMS(q),1);
2914  for(i=IDELEMS(q)-1; i>=0; i--)
2915  {
2916  dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
2917  par_perm,par_perm_size);
2918  // PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
2919  pTest(dest_id->m[i]);
2920  }
2921  R->qideal=dest_id;
2922  if (perm!=NULL)
2923  omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
2924  if (par_perm!=NULL)
2925  omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2926  rChangeCurrRing(orig_ring);
2927  #endif
2928  }
2929  else
2930  R->qideal=idrCopyR(q,currRing,R);
2931  }
2932  }
2933  else
2934  {
2935  WerrorS("q-ideal must be given as `ideal`");
2936  goto rCompose_err;
2937  }
2938 
2939 
2940  // ---------------------------------------------------------------
2941  #ifdef HAVE_PLURAL
2942  if (L->nr==5)
2943  {
2944  if (nc_CallPlural((matrix)L->m[4].Data(),
2945  (matrix)L->m[5].Data(),
2946  NULL,NULL,
2947  R,
2948  true, // !!!
2949  true, false,
2950  currRing, FALSE)) goto rCompose_err;
2951  // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
2952  }
2953  #endif
2954  return R;
2955 
2956 rCompose_err:
2957  if (R->N>0)
2958  {
2959  int i;
2960  if (R->names!=NULL)
2961  {
2962  i=R->N-1;
2963  while (i>=0) { if (R->names[i]!=NULL) omFree(R->names[i]); i--; }
2964  omFree(R->names);
2965  }
2966  }
2967  if (R->order!=NULL) omFree(R->order);
2968  if (R->block0!=NULL) omFree(R->block0);
2969  if (R->block1!=NULL) omFree(R->block1);
2970  if (R->wvhdl!=NULL) omFree(R->wvhdl);
2971  omFree(R);
2972  return NULL;
2973 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
ring r
Definition: algext.h:40
static BOOLEAN rField_is_Zp_a(const ring r)
Definition: ring.h:518
static BOOLEAN rComposeVar(const lists L, ring R)
Definition: ipshell.cc:2417
Definition: lists.h:22
ring rCompose(const lists L, const BOOLEAN check_comp)
Definition: ipshell.cc:2712
used for all transcendental extensions, i.e., the top-most extension in an extension tower is transce...
Definition: coeffs.h:39
static int si_min(const int a, const int b)
Definition: auxiliary.h:122
#define FALSE
Definition: auxiliary.h:95
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:587
#define pTest(p)
Definition: polys.h:399
static FORCE_INLINE void nSetChar(const coeffs r)
initialisations after each ring change
Definition: coeffs.h:440
rational (GMP) numbers
Definition: coeffs.h:31
const char * GFPar_name
Definition: coeffs.h:96
#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:580
static BOOLEAN rField_is_Q_a(const ring r)
Definition: ring.h:528
void * ADDRESS
Definition: auxiliary.h:116
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:1004
void rComposeC(lists L, ring R)
Definition: ipshell.cc:2212
Creation data needed for finite fields.
Definition: coeffs.h:92
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
Definition: tok.h:56
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:3938
static BOOLEAN rComposeOrder(const lists L, const BOOLEAN check_comp, ring R)
Definition: ipshell.cc:2462
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:3351
#define omFree(addr)
Definition: omAllocDecl.h:261
#define assume(x)
Definition: mod2.h:403
The main handler for Singular numbers which are suitable for Singular polynomials.
int GFDegree
Definition: coeffs.h:95
number(* nMapFunc)(number a, const coeffs src, const coeffs dst)
maps "a", which lives in src, into dst
Definition: coeffs.h:73
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:501
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:1627
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:725
static void rRenameVars(ring R)
Definition: ipshell.cc:2376
void rChangeCurrRing(ring r)
Definition: polys.cc:12
static BOOLEAN rField_is_Zp(const ring r)
Definition: ring.h:495
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
int GFChar
Definition: coeffs.h:94
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:2746
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:2283
#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:36
void * Data()
Definition: subexpr.cc:1146
#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:677
Definition: tok.h:117
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:334
#define Warn
Definition: emacs.cc:80

§ rComposeC()

void rComposeC ( lists  L,
ring  R 
)

Definition at line 2212 of file ipshell.cc.

2214 {
2215  // ----------------------------------------
2216  // 0: char/ cf - ring
2217  if ((L->m[0].rtyp!=INT_CMD) || (L->m[0].data!=(char *)0))
2218  {
2219  WerrorS("invalid coeff. field description, expecting 0");
2220  return;
2221  }
2222 // R->cf->ch=0;
2223  // ----------------------------------------
2224  // 1:
2225  if (L->m[1].rtyp!=LIST_CMD)
2226  {
2227  WerrorS("invalid coeff. field description, expecting precision list");
2228  return;
2229  }
2230  lists LL=(lists)L->m[1].data;
2231  if (((LL->nr!=2)
2232  || (LL->m[0].rtyp!=INT_CMD)
2233  || (LL->m[1].rtyp!=INT_CMD))
2234  && ((LL->nr!=1)
2235  || (LL->m[0].rtyp!=INT_CMD)))
2236  {
2237  WerrorS("invalid coeff. field description list");
2238  return;
2239  }
2240  int r1=(int)(long)LL->m[0].data;
2241  int r2=(int)(long)LL->m[1].data;
2242  if (L->nr==2) // complex
2243  R->cf = nInitChar(n_long_C, NULL);
2244  else if ((r1<=SHORT_REAL_LENGTH)
2245  && (r2=SHORT_REAL_LENGTH))
2246  R->cf = nInitChar(n_R, NULL);
2247  else
2248  {
2250  p->float_len=r1;
2251  p->float_len2=r2;
2252  R->cf = nInitChar(n_long_R, NULL);
2253  }
2254 
2255  if ((r1<=SHORT_REAL_LENGTH) // should go into nInitChar
2256  && (r2=SHORT_REAL_LENGTH))
2257  {
2258  R->cf->float_len=SHORT_REAL_LENGTH/2;
2259  R->cf->float_len2=SHORT_REAL_LENGTH;
2260  }
2261  else
2262  {
2263  R->cf->float_len=si_min(r1,32767);
2264  R->cf->float_len2=si_min(r2,32767);
2265  }
2266  // ----------------------------------------
2267  // 2: list (par)
2268  if (L->nr==2)
2269  {
2270  //R->cf->extRing->N=1;
2271  if (L->m[2].rtyp!=STRING_CMD)
2272  {
2273  WerrorS("invalid coeff. field description, expecting parameter name");
2274  return;
2275  }
2276  //(rParameter(R))=(char**)omAlloc0(rPar(R)*sizeof(char_ptr));
2277  rParameter(R)[0]=omStrDup((char *)L->m[2].data);
2278  }
2279  // ----------------------------------------
2280 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
#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:122
return P p
Definition: myNF.cc:203
void WerrorS(const char *s)
Definition: feFopen.cc:24
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:613
real floating point (GMP) numbers
Definition: coeffs.h:34
short float_len2
additional char-flags, rInit
Definition: coeffs.h:102
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:101
const ring R
Definition: DebugPrint.cc:36
complex floating point (GMP) numbers
Definition: coeffs.h:42
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:117
#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:334
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ rComposeOrder()

static BOOLEAN rComposeOrder ( const lists  L,
const BOOLEAN  check_comp,
ring  R 
)
inlinestatic

Definition at line 2462 of file ipshell.cc.

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

§ rComposeRing()

void rComposeRing ( lists  L,
ring  R 
)

Definition at line 2283 of file ipshell.cc.

2285 {
2286  // ----------------------------------------
2287  // 0: string: integer
2288  // no further entries --> Z
2289  mpz_ptr modBase = NULL;
2290  unsigned int modExponent = 1;
2291 
2292  modBase = (mpz_ptr) omAlloc(sizeof(mpz_t));
2293  if (L->nr == 0)
2294  {
2295  mpz_init_set_ui(modBase,0);
2296  modExponent = 1;
2297  }
2298  // ----------------------------------------
2299  // 1:
2300  else
2301  {
2302  if (L->m[1].rtyp!=LIST_CMD) WerrorS("invalid data, expecting list of numbers");
2303  lists LL=(lists)L->m[1].data;
2304  if ((LL->nr >= 0) && LL->m[0].rtyp == BIGINT_CMD)
2305  {
2306  number tmp= (number) LL->m[0].data; // never use CopyD() on list elements
2307  // assume that tmp is integer, not rational
2308  n_MPZ (modBase, tmp, coeffs_BIGINT);
2309  }
2310  else if (LL->nr >= 0 && LL->m[0].rtyp == INT_CMD)
2311  {
2312  mpz_init_set_ui(modBase,(unsigned long) LL->m[0].data);
2313  }
2314  else
2315  {
2316  mpz_init_set_ui(modBase,0);
2317  }
2318  if (LL->nr >= 1)
2319  {
2320  modExponent = (unsigned long) LL->m[1].data;
2321  }
2322  else
2323  {
2324  modExponent = 1;
2325  }
2326  }
2327  // ----------------------------------------
2328  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_cmp_ui(modBase, 0) < 0))
2329  {
2330  WerrorS("Wrong ground ring specification (module is 1)");
2331  return;
2332  }
2333  if (modExponent < 1)
2334  {
2335  WerrorS("Wrong ground ring specification (exponent smaller than 1)");
2336  return;
2337  }
2338  // module is 0 ---> integers
2339  if (mpz_cmp_ui(modBase, 0) == 0)
2340  {
2341  R->cf=nInitChar(n_Z,NULL);
2342  }
2343  // we have an exponent
2344  else if (modExponent > 1)
2345  {
2346  //R->cf->ch = R->cf->modExponent;
2347  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
2348  {
2349  /* this branch should be active for modExponent = 2..32 resp. 2..64,
2350  depending on the size of a long on the respective platform */
2351  R->cf=nInitChar(n_Z2m,(void*)(long)modExponent); // Use Z/2^ch
2352  omFreeSize (modBase, sizeof(mpz_t));
2353  }
2354  else
2355  {
2356  //ringtype 3
2357  ZnmInfo info;
2358  info.base= modBase;
2359  info.exp= modExponent;
2360  R->cf=nInitChar(n_Znm,(void*) &info);
2361  }
2362  }
2363  // just a module m > 1
2364  else
2365  {
2366  //ringtype = 2;
2367  //const int ch = mpz_get_ui(modBase);
2368  ZnmInfo info;
2369  info.base= modBase;
2370  info.exp= modExponent;
2371  R->cf=nInitChar(n_Zn,(void*) &info);
2372  }
2373 }
mpz_ptr base
Definition: rmodulon.h:19
sleftv * m
Definition: lists.h:45
only used if HAVE_RINGS is defined
Definition: coeffs.h:44
Definition: tok.h:95
Definition: lists.h:22
only used if HAVE_RINGS is defined
Definition: coeffs.h:46
if(0 > strat->sl)
Definition: myNF.cc:73
Definition: tok.h:38
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void WerrorS(const char *s)
Definition: feFopen.cc:24
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:45
const ExtensionInfo & info
< [in] sqrfree poly
const ring R
Definition: DebugPrint.cc:36
only used if HAVE_RINGS is defined
Definition: coeffs.h:43
unsigned long exp
Definition: rmodulon.h:19
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:117
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:555
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:334

§ rComposeVar()

static BOOLEAN rComposeVar ( const lists  L,
ring  R 
)
inlinestatic

Definition at line 2417 of file ipshell.cc.

2418 {
2419  assume(R!=NULL);
2420  if (L->m[1].Typ()==LIST_CMD)
2421  {
2422  lists v=(lists)L->m[1].Data();
2423  R->N = v->nr+1;
2424  if (R->N<=0)
2425  {
2426  WerrorS("no ring variables");
2427  return TRUE;
2428  }
2429  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
2430  int i;
2431  for(i=0;i<R->N;i++)
2432  {
2433  if (v->m[i].Typ()==STRING_CMD)
2434  R->names[i]=omStrDup((char *)v->m[i].Data());
2435  else if (v->m[i].Typ()==POLY_CMD)
2436  {
2437  poly p=(poly)v->m[i].Data();
2438  int nr=pIsPurePower(p);
2439  if (nr>0)
2440  R->names[i]=omStrDup(currRing->names[nr-1]);
2441  else
2442  {
2443  Werror("var name %d must be a string or a ring variable",i+1);
2444  return TRUE;
2445  }
2446  }
2447  else
2448  {
2449  Werror("var name %d must be `string`",i+1);
2450  return TRUE;
2451  }
2452  }
2453  }
2454  else
2455  {
2456  WerrorS("variable must be given as `list`");
2457  return TRUE;
2458  }
2459  return FALSE;
2460 }
#define pIsPurePower(p)
Definition: polys.h:231
sleftv * m
Definition: lists.h:45
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:95
return P p
Definition: myNF.cc:203
#define TRUE
Definition: auxiliary.h:99
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:1004
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
char * char_ptr
Definition: structs.h:56
#define assume(x)
Definition: mod2.h:403
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:1146
Definition: tok.h:117
polyrec * poly
Definition: hilb.h:10
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define omAlloc0(size)
Definition: omAllocDecl.h:211
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2027 of file ipshell.cc.

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

§ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1821 of file ipshell.cc.

1822 {
1823  assume( C != NULL );
1824 
1825  // sanity check: require currRing==r for rings with polynomial data
1826  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1827  {
1828  WerrorS("ring with polynomial data must be the base ring or compatible");
1829  return TRUE;
1830  }
1831  if (nCoeff_is_numeric(C))
1832  {
1833  rDecomposeC_41(res,C);
1834  }
1835 #ifdef HAVE_RINGS
1836  else if (nCoeff_is_Ring(C))
1837  {
1838  rDecomposeRing_41(res,C);
1839  }
1840 #endif
1841  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1842  {
1843  rDecomposeCF(res, C->extRing, currRing);
1844  }
1845  else if(nCoeff_is_GF(C))
1846  {
1848  Lc->Init(4);
1849  // char:
1850  Lc->m[0].rtyp=INT_CMD;
1851  Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1852  // var:
1854  Lv->Init(1);
1855  Lv->m[0].rtyp=STRING_CMD;
1856  Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1857  Lc->m[1].rtyp=LIST_CMD;
1858  Lc->m[1].data=(void*)Lv;
1859  // ord:
1861  Lo->Init(1);
1863  Loo->Init(2);
1864  Loo->m[0].rtyp=STRING_CMD;
1865  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1866 
1867  intvec *iv=new intvec(1); (*iv)[0]=1;
1868  Loo->m[1].rtyp=INTVEC_CMD;
1869  Loo->m[1].data=(void *)iv;
1870 
1871  Lo->m[0].rtyp=LIST_CMD;
1872  Lo->m[0].data=(void*)Loo;
1873 
1874  Lc->m[2].rtyp=LIST_CMD;
1875  Lc->m[2].data=(void*)Lo;
1876  // q-ideal:
1877  Lc->m[3].rtyp=IDEAL_CMD;
1878  Lc->m[3].data=(void *)idInit(1,1);
1879  // ----------------------
1880  res->rtyp=LIST_CMD;
1881  res->data=(void*)Lc;
1882  }
1883  else
1884  {
1885  res->rtyp=INT_CMD;
1886  res->data=(void *)(long)C->ch;
1887  }
1888  // ----------------------------------------
1889  return FALSE;
1890 }
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:812
sleftv * m
Definition: lists.h:45
static FORCE_INLINE BOOLEAN nCoeff_is_numeric(const coeffs r)
Definition: coeffs.h:846
Definition: tok.h:95
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:95
#define TRUE
Definition: auxiliary.h:99
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:762
void rDecomposeRing_41(leftv h, const coeffs C)
Definition: ipshell.cc:1759
void * data
Definition: subexpr.h:89
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1598
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:924
Definition: intvec.h:14
#define assume(x)
Definition: mod2.h:403
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:88
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition: coeffs.h:853
static void rDecomposeC_41(leftv h, const coeffs C)
Definition: ipshell.cc:1687
INLINE_THIS void Init(int l=0)
#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:117
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 1894 of file ipshell.cc.

1895 {
1896  assume( r != NULL );
1897  const coeffs C = r->cf;
1898  assume( C != NULL );
1899 
1900  // sanity check: require currRing==r for rings with polynomial data
1901  if ( (r!=currRing) && (
1902  (nCoeff_is_algExt(C) && (C != currRing->cf))
1903  || (r->qideal != NULL)
1904 #ifdef HAVE_PLURAL
1905  || (rIsPluralRing(r))
1906 #endif
1907  )
1908  )
1909  {
1910  WerrorS("ring with polynomial data must be the base ring or compatible");
1911  return NULL;
1912  }
1913  // 0: char/ cf - ring
1914  // 1: list (var)
1915  // 2: list (ord)
1916  // 3: qideal
1917  // possibly:
1918  // 4: C
1919  // 5: D
1921  if (rIsPluralRing(r))
1922  L->Init(6);
1923  else
1924  L->Init(4);
1925  // ----------------------------------------
1926  // 0: char/ cf - ring
1927  L->m[0].rtyp=CRING_CMD;
1928  L->m[0].data=(char*)r->cf; r->cf->ref++;
1929  // ----------------------------------------
1930  // 1: list (var)
1932  LL->Init(r->N);
1933  int i;
1934  for(i=0; i<r->N; i++)
1935  {
1936  LL->m[i].rtyp=STRING_CMD;
1937  LL->m[i].data=(void *)omStrDup(r->names[i]);
1938  }
1939  L->m[1].rtyp=LIST_CMD;
1940  L->m[1].data=(void *)LL;
1941  // ----------------------------------------
1942  // 2: list (ord)
1944  i=rBlocks(r)-1;
1945  LL->Init(i);
1946  i--;
1947  lists LLL;
1948  for(; i>=0; i--)
1949  {
1950  intvec *iv;
1951  int j;
1952  LL->m[i].rtyp=LIST_CMD;
1954  LLL->Init(2);
1955  LLL->m[0].rtyp=STRING_CMD;
1956  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1957 
1958  if(r->order[i] == ringorder_IS) // || r->order[i] == ringorder_s || r->order[i] == ringorder_S)
1959  {
1960  assume( r->block0[i] == r->block1[i] );
1961  const int s = r->block0[i];
1962  assume( -2 < s && s < 2);
1963 
1964  iv=new intvec(1);
1965  (*iv)[0] = s;
1966  }
1967  else if (r->block1[i]-r->block0[i] >=0 )
1968  {
1969  int bl=j=r->block1[i]-r->block0[i];
1970  if (r->order[i]==ringorder_M)
1971  {
1972  j=(j+1)*(j+1)-1;
1973  bl=j+1;
1974  }
1975  else if (r->order[i]==ringorder_am)
1976  {
1977  j+=r->wvhdl[i][bl+1];
1978  }
1979  iv=new intvec(j+1);
1980  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1981  {
1982  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
1983  }
1984  else switch (r->order[i])
1985  {
1986  case ringorder_dp:
1987  case ringorder_Dp:
1988  case ringorder_ds:
1989  case ringorder_Ds:
1990  case ringorder_lp:
1991  for(;j>=0; j--) (*iv)[j]=1;
1992  break;
1993  default: /* do nothing */;
1994  }
1995  }
1996  else
1997  {
1998  iv=new intvec(1);
1999  }
2000  LLL->m[1].rtyp=INTVEC_CMD;
2001  LLL->m[1].data=(void *)iv;
2002  LL->m[i].data=(void *)LLL;
2003  }
2004  L->m[2].rtyp=LIST_CMD;
2005  L->m[2].data=(void *)LL;
2006  // ----------------------------------------
2007  // 3: qideal
2008  L->m[3].rtyp=IDEAL_CMD;
2009  if (r->qideal==NULL)
2010  L->m[3].data=(void *)idInit(1,1);
2011  else
2012  L->m[3].data=(void *)idCopy(r->qideal);
2013  // ----------------------------------------
2014 #ifdef HAVE_PLURAL // NC! in rDecompose
2015  if (rIsPluralRing(r))
2016  {
2017  L->m[4].rtyp=MATRIX_CMD;
2018  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2019  L->m[5].rtyp=MATRIX_CMD;
2020  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2021  }
2022 #endif
2023  return L;
2024 }
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:10
static int rBlocks(ring r)
Definition: ring.h:556
Definition: tok.h:56
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:924
Definition: intvec.h:14
int j
Definition: myNF.cc:70
#define assume(x)
Definition: mod2.h:403
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:404
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:101
ideal idCopy(ideal A)
Definition: ideals.h:60
INLINE_THIS void Init(int l=0)
#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:117
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:74
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ rDecomposeC()

static void rDecomposeC ( leftv  h,
const ring  R 
)
static

Definition at line 1722 of file ipshell.cc.

1724 {
1726  if (rField_is_long_C(R)) L->Init(3);
1727  else L->Init(2);
1728  h->rtyp=LIST_CMD;
1729  h->data=(void *)L;
1730  // 0: char/ cf - ring
1731  // 1: list (var)
1732  // 2: list (ord)
1733  // ----------------------------------------
1734  // 0: char/ cf - ring
1735  L->m[0].rtyp=INT_CMD;
1736  L->m[0].data=(void *)0;
1737  // ----------------------------------------
1738  // 1:
1740  LL->Init(2);
1741  LL->m[0].rtyp=INT_CMD;
1742  LL->m[0].data=(void *)(long)si_max(R->cf->float_len,SHORT_REAL_LENGTH/2);
1743  LL->m[1].rtyp=INT_CMD;
1744  LL->m[1].data=(void *)(long)si_max(R->cf->float_len2,SHORT_REAL_LENGTH);
1745  L->m[1].rtyp=LIST_CMD;
1746  L->m[1].data=(void *)LL;
1747  // ----------------------------------------
1748  // 2: list (par)
1749  if (rField_is_long_C(R))
1750  {
1751  L->m[2].rtyp=STRING_CMD;
1752  L->m[2].data=(void *)omStrDup(*rParameter(R));
1753  }
1754  // ----------------------------------------
1755 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
#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:613
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:121
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:534
INLINE_THIS void Init(int l=0)
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
Definition: tok.h:117
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ rDecomposeC_41()

static void rDecomposeC_41 ( leftv  h,
const coeffs  C 
)
static

Definition at line 1687 of file ipshell.cc.

1689 {
1691  if (nCoeff_is_long_C(C)) L->Init(3);
1692  else L->Init(2);
1693  h->rtyp=LIST_CMD;
1694  h->data=(void *)L;
1695  // 0: char/ cf - ring
1696  // 1: list (var)
1697  // 2: list (ord)
1698  // ----------------------------------------
1699  // 0: char/ cf - ring
1700  L->m[0].rtyp=INT_CMD;
1701  L->m[0].data=(void *)0;
1702  // ----------------------------------------
1703  // 1:
1705  LL->Init(2);
1706  LL->m[0].rtyp=INT_CMD;
1707  LL->m[0].data=(void *)(long)si_max(C->float_len,SHORT_REAL_LENGTH/2);
1708  LL->m[1].rtyp=INT_CMD;
1709  LL->m[1].data=(void *)(long)si_max(C->float_len2,SHORT_REAL_LENGTH);
1710  L->m[1].rtyp=LIST_CMD;
1711  L->m[1].data=(void *)LL;
1712  // ----------------------------------------
1713  // 2: list (par)
1714  if (nCoeff_is_long_C(C))
1715  {
1716  L->m[2].rtyp=STRING_CMD;
1717  L->m[2].data=(void *)omStrDup(*n_ParameterNames(C));
1718  }
1719  // ----------------------------------------
1720 }
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:812
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
#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:908
void * data
Definition: subexpr.h:89
static int si_max(const int a, const int b)
Definition: auxiliary.h:121
INLINE_THIS void Init(int l=0)
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
Definition: tok.h:117
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ rDecomposeCF()

void rDecomposeCF ( leftv  h,
const ring  r,
const ring  R 
)

Definition at line 1598 of file ipshell.cc.

1599 {
1601  L->Init(4);
1602  h->rtyp=LIST_CMD;
1603  h->data=(void *)L;
1604  // 0: char/ cf - ring
1605  // 1: list (var)
1606  // 2: list (ord)
1607  // 3: qideal
1608  // ----------------------------------------
1609  // 0: char/ cf - ring
1610  L->m[0].rtyp=INT_CMD;
1611  L->m[0].data=(void *)(long)r->cf->ch;
1612  // ----------------------------------------
1613  // 1: list (var)
1615  LL->Init(r->N);
1616  int i;
1617  for(i=0; i<r->N; i++)
1618  {
1619  LL->m[i].rtyp=STRING_CMD;
1620  LL->m[i].data=(void *)omStrDup(r->names[i]);
1621  }
1622  L->m[1].rtyp=LIST_CMD;
1623  L->m[1].data=(void *)LL;
1624  // ----------------------------------------
1625  // 2: list (ord)
1627  i=rBlocks(r)-1;
1628  LL->Init(i);
1629  i--;
1630  lists LLL;
1631  for(; i>=0; i--)
1632  {
1633  intvec *iv;
1634  int j;
1635  LL->m[i].rtyp=LIST_CMD;
1637  LLL->Init(2);
1638  LLL->m[0].rtyp=STRING_CMD;
1639  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1640  if (r->block1[i]-r->block0[i] >=0 )
1641  {
1642  j=r->block1[i]-r->block0[i];
1643  if(r->order[i]==ringorder_M) j=(j+1)*(j+1)-1;
1644  iv=new intvec(j+1);
1645  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1646  {
1647  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j];
1648  }
1649  else switch (r->order[i])
1650  {
1651  case ringorder_dp:
1652  case ringorder_Dp:
1653  case ringorder_ds:
1654  case ringorder_Ds:
1655  case ringorder_lp:
1656  for(;j>=0; j--) (*iv)[j]=1;
1657  break;
1658  default: /* do nothing */;
1659  }
1660  }
1661  else
1662  {
1663  iv=new intvec(1);
1664  }
1665  LLL->m[1].rtyp=INTVEC_CMD;
1666  LLL->m[1].data=(void *)iv;
1667  LL->m[i].data=(void *)LLL;
1668  }
1669  L->m[2].rtyp=LIST_CMD;
1670  L->m[2].data=(void *)LL;
1671  // ----------------------------------------
1672  // 3: qideal
1673  L->m[3].rtyp=IDEAL_CMD;
1674  if (nCoeff_is_transExt(R->cf))
1675  L->m[3].data=(void *)idInit(1,1);
1676  else
1677  {
1678  ideal q=idInit(IDELEMS(r->qideal));
1679  q->m[0]=p_Init(R);
1680  pSetCoeff0(q->m[0],(number)(r->qideal->m[0]));
1681  L->m[3].data=(void *)q;
1682 // I->m[0] = pNSet(R->minpoly);
1683  }
1684  // ----------------------------------------
1685 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
Definition: lists.h:22
void * data
Definition: subexpr.h:89
static int rBlocks(ring r)
Definition: ring.h:556
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:932
int i
Definition: cfEzgcd.cc:123
#define IDELEMS(i)
Definition: simpleideals.h:24
INLINE_THIS void Init(int l=0)
#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:117
omBin slists_bin
Definition: lists.cc:23
static poly p_Init(const ring r, omBin bin)
Definition: p_polys.h:1243
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ rDecomposeRing()

void rDecomposeRing ( leftv  h,
const ring  R 
)

Definition at line 1788 of file ipshell.cc.

1790 {
1791 #ifdef HAVE_RINGS
1793  if (rField_is_Ring_Z(R)) L->Init(1);
1794  else L->Init(2);
1795  h->rtyp=LIST_CMD;
1796  h->data=(void *)L;
1797  // 0: char/ cf - ring
1798  // 1: list (module)
1799  // ----------------------------------------
1800  // 0: char/ cf - ring
1801  L->m[0].rtyp=STRING_CMD;
1802  L->m[0].data=(void *)omStrDup("integer");
1803  // ----------------------------------------
1804  // 1: module
1805  if (rField_is_Ring_Z(R)) return;
1807  LL->Init(2);
1808  LL->m[0].rtyp=BIGINT_CMD;
1809  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); ?
1810  LL->m[1].rtyp=INT_CMD;
1811  LL->m[1].data=(void *) R->cf->modExponent;
1812  L->m[1].rtyp=LIST_CMD;
1813  L->m[1].data=(void *)LL;
1814 #else
1815  WerrorS("rDecomposeRing");
1816 #endif
1817 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
Definition: lists.h:22
Definition: tok.h:38
void WerrorS(const char *s)
Definition: feFopen.cc:24
void * data
Definition: subexpr.h:89
const ring R
Definition: DebugPrint.cc:36
INLINE_THIS void Init(int l=0)
#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:474
int rtyp
Definition: subexpr.h:92
Definition: tok.h:117
number nlMapGMP(number from, const coeffs src, const coeffs dst)
Definition: longrat.cc:206
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ rDecomposeRing_41()

void rDecomposeRing_41 ( leftv  h,
const coeffs  C 
)

Definition at line 1759 of file ipshell.cc.

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

§ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1527 of file ipshell.cc.

1528 {
1529  idhdl tmp=NULL;
1530 
1531  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
1532  if (tmp==NULL) return NULL;
1533 
1534 // if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
1536  {
1538  memset(&sLastPrinted,0,sizeof(sleftv));
1539  }
1540 
1541  ring r = IDRING(tmp) = (ring) omAlloc0Bin(sip_sring_bin);
1542 
1543  r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1544  r->N = 3;
1545  /*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
1546  /*names*/
1547  r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
1548  r->names[0] = omStrDup("x");
1549  r->names[1] = omStrDup("y");
1550  r->names[2] = omStrDup("z");
1551  /*weights: entries for 3 blocks: NULL*/
1552  r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1553  /*order: dp,C,0*/
1554  r->order = (int *) omAlloc(3 * sizeof(int *));
1555  r->block0 = (int *)omAlloc0(3 * sizeof(int *));
1556  r->block1 = (int *)omAlloc0(3 * sizeof(int *));
1557  /* ringorder dp for the first block: var 1..3 */
1558  r->order[0] = ringorder_dp;
1559  r->block0[0] = 1;
1560  r->block1[0] = 3;
1561  /* ringorder C for the second block: no vars */
1562  r->order[1] = ringorder_C;
1563  /* the last block: everything is 0 */
1564  r->order[2] = 0;
1565 
1566  /* complete ring intializations */
1567  rComplete(r);
1568  rSetHdl(tmp);
1569  return currRingHdl;
1570 }
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:261
const ring r
Definition: syzextra.cc:208
BOOLEAN RingDependend()
Definition: subexpr.cc:405
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:3351
idhdl currRingHdl
Definition: ipid.cc:65
omBin sip_sring_bin
Definition: ring.cc:54
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:124
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:335
void rSetHdl(idhdl h)
Definition: ipshell.cc:5021
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:334
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1572 of file ipshell.cc.

1573 {
1575  if (h!=NULL) return h;
1576  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1577  if (h!=NULL) return h;
1579  while(p!=NULL)
1580  {
1581  if ((p->cPack!=basePack)
1582  && (p->cPack!=currPack))
1583  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1584  if (h!=NULL) return h;
1585  p=p->next;
1586  }
1587  idhdl tmp=basePack->idroot;
1588  while (tmp!=NULL)
1589  {
1590  if (IDTYP(tmp)==PACKAGE_CMD)
1591  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1592  if (h!=NULL) return h;
1593  tmp=IDNEXT(tmp);
1594  }
1595  return NULL;
1596 }
idhdl rSimpleFindHdl(ring r, idhdl root, idhdl n)
Definition: ipshell.cc:6125
return P p
Definition: myNF.cc:203
#define IDNEXT(a)
Definition: ipid.h:115
proclevel * procstack
Definition: ipid.cc:58
#define IDROOT
Definition: ipid.h:20
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:136
#define IDTYP(a)
Definition: ipid.h:116
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:61

§ rInit()

ring rInit ( leftv  pn,
leftv  rv,
leftv  ord 
)

Definition at line 5507 of file ipshell.cc.

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

§ rKill() [1/2]

void rKill ( ring  r)

Definition at line 6048 of file ipshell.cc.

6049 {
6050  if ((r->ref<=0)&&(r->order!=NULL))
6051  {
6052 #ifdef RDEBUG
6053  if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6054 #endif
6055  if (r->qideal!=NULL)
6056  {
6057  id_Delete(&r->qideal, r);
6058  r->qideal = NULL;
6059  }
6060  int j;
6061  for (j=0;j<myynest;j++)
6062  {
6063  if (iiLocalRing[j]==r)
6064  {
6065  if (j==0) WarnS("killing the basering for level 0");
6066  iiLocalRing[j]=NULL;
6067  }
6068  }
6069 // any variables depending on r ?
6070  while (r->idroot!=NULL)
6071  {
6072  r->idroot->lev=myynest; // avoid warning about kill global objects
6073  killhdl2(r->idroot,&(r->idroot),r);
6074  }
6075  if (r==currRing)
6076  {
6077  // all dependend stuff is done, clean global vars:
6078  if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6080  {
6082  }
6083  //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6084  //{
6085  // WerrorS("return value depends on local ring variable (export missing ?)");
6086  // iiRETURNEXPR.CleanUp();
6087  //}
6088  currRing=NULL;
6089  currRingHdl=NULL;
6090  }
6091 
6092  /* nKillChar(r); will be called from inside of rDelete */
6093  rDelete(r);
6094  return;
6095  }
6096  r->ref--;
6097 }
#define TRACE_SHOW_RINGS
Definition: reporter.h:35
#define Print
Definition: emacs.cc:83
void id_Delete(ideal *h, ring r)
deletes an ideal/module/matrix
int traceit
Definition: febase.cc:47
#define WarnS
Definition: emacs.cc:81
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:10
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:411
const ring r
Definition: syzextra.cc:208
BOOLEAN RingDependend()
Definition: subexpr.cc:405
int j
Definition: myNF.cc:70
idhdl currRingHdl
Definition: ipid.cc:65
ring * iiLocalRing
Definition: iplib.cc:470
#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:169
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:335

§ rKill() [2/2]

void rKill ( idhdl  h)

Definition at line 6099 of file ipshell.cc.

6100 {
6101  ring r = IDRING(h);
6102  int ref=0;
6103  if (r!=NULL)
6104  {
6105  // avoid, that sLastPrinted is the last reference to the base ring:
6106  // clean up before killing the last "named" refrence:
6107  if ((sLastPrinted.rtyp==RING_CMD)
6108  && (sLastPrinted.data==(void*)r))
6109  {
6110  sLastPrinted.CleanUp(r);
6111  }
6112  ref=r->ref;
6113  rKill(r);
6114  }
6115  if (h==currRingHdl)
6116  {
6117  if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6118  else
6119  {
6121  }
6122  }
6123 }
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:10
const ring r
Definition: syzextra.cc:208
void rKill(ring r)
Definition: ipshell.cc:6048
idhdl currRingHdl
Definition: ipid.cc:65
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1572
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:124
int rtyp
Definition: subexpr.h:92
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:335

§ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 5075 of file ipshell.cc.

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

§ rRenameVars()

static void rRenameVars ( ring  R)
static

Definition at line 2376 of file ipshell.cc.

2377 {
2378  int i,j;
2379  BOOLEAN ch;
2380  do
2381  {
2382  ch=0;
2383  for(i=0;i<R->N-1;i++)
2384  {
2385  for(j=i+1;j<R->N;j++)
2386  {
2387  if (strcmp(R->names[i],R->names[j])==0)
2388  {
2389  ch=TRUE;
2390  Warn("name conflict var(%d) and var(%d): `%s`, rename to `@%s`",i+1,j+1,R->names[i],R->names[i]);
2391  omFree(R->names[j]);
2392  R->names[j]=(char *)omAlloc(2+strlen(R->names[i]));
2393  sprintf(R->names[j],"@%s",R->names[i]);
2394  }
2395  }
2396  }
2397  }
2398  while (ch);
2399  for(i=0;i<rPar(R); i++)
2400  {
2401  for(j=0;j<R->N;j++)
2402  {
2403  if (strcmp(rParameter(R)[i],R->names[j])==0)
2404  {
2405  Warn("name conflict par(%d) and var(%d): `%s`, renaming the VARIABLE to `@@(%d)`",i+1,j+1,R->names[j],i+1);
2406 // omFree(rParameter(R)[i]);
2407 // rParameter(R)[i]=(char *)omAlloc(10);
2408 // sprintf(rParameter(R)[i],"@@(%d)",i+1);
2409  omFree(R->names[j]);
2410  R->names[j]=(char *)omAlloc(10);
2411  sprintf(R->names[j],"@@(%d)",i+1);
2412  }
2413  }
2414  }
2415 }
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:587
#define TRUE
Definition: auxiliary.h:99
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:613
#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:86
#define Warn
Definition: emacs.cc:80

§ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5021 of file ipshell.cc.

5022 {
5023  ring rg = NULL;
5024  if (h!=NULL)
5025  {
5026 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5027  rg = IDRING(h);
5028  if (rg==NULL) return; //id <>NULL, ring==NULL
5029  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5030  if (IDID(h)) // OB: ????
5031  omCheckAddr((ADDRESS)IDID(h));
5032  rTest(rg);
5033  }
5034 
5035  // clean up history
5037  {
5039  memset(&sLastPrinted,0,sizeof(sleftv));
5040  }
5041 
5042  if ((rg!=currRing)&&(currRing!=NULL))
5043  {
5045  if (DENOMINATOR_LIST!=NULL)
5046  {
5047  if (TEST_V_ALLWARN)
5048  Warn("deleting denom_list for ring change to %s",IDID(h));
5049  do
5050  {
5051  n_Delete(&(dd->n),currRing->cf);
5052  dd=dd->next;
5054  DENOMINATOR_LIST=dd;
5055  } while(DENOMINATOR_LIST!=NULL);
5056  }
5057  }
5058 
5059  // test for valid "currRing":
5060  if ((rg!=NULL) && (rg->idroot==NULL))
5061  {
5062  ring old=rg;
5063  rg=rAssure_HasComp(rg);
5064  if (old!=rg)
5065  {
5066  rKill(old);
5067  IDRING(h)=rg;
5068  }
5069  }
5070  /*------------ change the global ring -----------------------*/
5071  rChangeCurrRing(rg);
5072  currRingHdl = h;
5073 }
#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:119
denominator_list DENOMINATOR_LIST
Definition: kutil.cc:89
void * ADDRESS
Definition: auxiliary.h:116
ring rAssure_HasComp(const ring r)
Definition: ring.cc:4522
Definition: idrec.h:34
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
BOOLEAN RingDependend()
Definition: subexpr.cc:405
void rKill(ring r)
Definition: ipshell.cc:6048
#define omFree(addr)
Definition: omAllocDecl.h:261
#define rTest(r)
Definition: ring.h:775
idhdl currRingHdl
Definition: ipid.cc:65
void rChangeCurrRing(ring r)
Definition: polys.cc:12
#define NULL
Definition: omList.c:10
denominator_list next
Definition: kutil.h:67
#define IDRING(a)
Definition: ipid.h:124
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:335
#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:459
static Poly * h
Definition: janet.cc:978
#define TEST_V_ALLWARN
Definition: options.h:135
#define Warn
Definition: emacs.cc:80

§ rSimpleFindHdl()

idhdl rSimpleFindHdl ( ring  r,
idhdl  root,
idhdl  n 
)

Definition at line 6125 of file ipshell.cc.

6126 {
6127  idhdl h=root;
6128  while (h!=NULL)
6129  {
6130  if ((IDTYP(h)==RING_CMD)
6131  && (h!=n)
6132  && (IDRING(h)==r)
6133  )
6134  {
6135  return h;
6136  }
6137  h=IDNEXT(h);
6138  }
6139  return NULL;
6140 }
#define IDNEXT(a)
Definition: ipid.h:115
Definition: idrec.h:34
#define IDTYP(a)
Definition: ipid.h:116
const ring r
Definition: syzextra.cc:208
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:124
static Poly * h
Definition: janet.cc:978

§ rSleftvList2StringArray()

static BOOLEAN rSleftvList2StringArray ( leftv  sl,
char **  p 
)
static

Definition at line 5459 of file ipshell.cc.

5460 {
5461 
5462  while(sl!=NULL)
5463  {
5464  if ((sl->rtyp == IDHDL)||(sl->rtyp==ALIAS_CMD))
5465  {
5466  *p = omStrDup(sl->Name());
5467  }
5468  else if (sl->name!=NULL)
5469  {
5470  *p = (char*)sl->name;
5471  sl->name=NULL;
5472  }
5473  else if (sl->rtyp==POLY_CMD)
5474  {
5475  sleftv s_sl;
5476  iiConvert(POLY_CMD,ANY_TYPE,-1,sl,&s_sl);
5477  if (s_sl.name != NULL)
5478  {
5479  *p = (char*)s_sl.name; s_sl.name=NULL;
5480  }
5481  else
5482  *p = NULL;
5483  sl->next = s_sl.next;
5484  s_sl.next = NULL;
5485  s_sl.CleanUp();
5486  if (*p == NULL) return TRUE;
5487  }
5488  else return TRUE;
5489  p++;
5490  sl=sl->next;
5491  }
5492  return FALSE;
5493 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define ANY_TYPE
Definition: tok.h:30
#define FALSE
Definition: auxiliary.h:95
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, const struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:401
return P p
Definition: myNF.cc:203
#define TRUE
Definition: auxiliary.h:99
const char * Name()
Definition: subexpr.h:121
#define IDHDL
Definition: tok.h:31
const char * name
Definition: subexpr.h:88
leftv next
Definition: subexpr.h:87
Definition: tok.h:34
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:335
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 5187 of file ipshell.cc.

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

§ rSubring()

ring rSubring ( ring  org_ring,
sleftv rv 
)

Definition at line 5886 of file ipshell.cc.

5887 {
5888  ring R = rCopy0(org_ring);
5889  int *perm=(int *)omAlloc0((org_ring->N+1)*sizeof(int));
5890  int n = rBlocks(org_ring), i=0, j;
5891 
5892  /* names and number of variables-------------------------------------*/
5893  {
5894  int l=rv->listLength();
5895  if (l>MAX_SHORT)
5896  {
5897  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5898  goto rInitError;
5899  }
5900  R->N = l; /*rv->listLength();*/
5901  }
5902  omFree(R->names);
5903  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
5904  if (rSleftvList2StringArray(rv, R->names))
5905  {
5906  WerrorS("name of ring variable expected");
5907  goto rInitError;
5908  }
5909 
5910  /* check names for subring in org_ring ------------------------- */
5911  {
5912  i=0;
5913 
5914  for(j=0;j<R->N;j++)
5915  {
5916  for(;i<org_ring->N;i++)
5917  {
5918  if (strcmp(org_ring->names[i],R->names[j])==0)
5919  {
5920  perm[i+1]=j+1;
5921  break;
5922  }
5923  }
5924  if (i>org_ring->N)
5925  {
5926  Werror("variable %d (%s) not in basering",j+1,R->names[j]);
5927  break;
5928  }
5929  }
5930  }
5931  //Print("perm=");
5932  //for(i=1;i<org_ring->N;i++) Print("v%d -> v%d\n",i,perm[i]);
5933  /* ordering -------------------------------------------------------------*/
5934 
5935  for(i=0;i<n;i++)
5936  {
5937  int min_var=-1;
5938  int max_var=-1;
5939  for(j=R->block0[i];j<=R->block1[i];j++)
5940  {
5941  if (perm[j]>0)
5942  {
5943  if (min_var==-1) min_var=perm[j];
5944  max_var=perm[j];
5945  }
5946  }
5947  if (min_var!=-1)
5948  {
5949  //Print("block %d: old %d..%d, now:%d..%d\n",
5950  // i,R->block0[i],R->block1[i],min_var,max_var);
5951  R->block0[i]=min_var;
5952  R->block1[i]=max_var;
5953  if (R->wvhdl[i]!=NULL)
5954  {
5955  omFree(R->wvhdl[i]);
5956  R->wvhdl[i]=(int*)omAlloc0((max_var-min_var+1)*sizeof(int));
5957  for(j=org_ring->block0[i];j<=org_ring->block1[i];j++)
5958  {
5959  if (perm[j]>0)
5960  {
5961  R->wvhdl[i][perm[j]-R->block0[i]]=
5962  org_ring->wvhdl[i][j-org_ring->block0[i]];
5963  //Print("w%d=%d (orig_w%d)\n",perm[j],R->wvhdl[i][perm[j]-R->block0[i]],j);
5964  }
5965  }
5966  }
5967  }
5968  else
5969  {
5970  if(R->block0[i]>0)
5971  {
5972  //Print("skip block %d\n",i);
5973  R->order[i]=ringorder_unspec;
5974  if (R->wvhdl[i] !=NULL) omFree(R->wvhdl[i]);
5975  R->wvhdl[i]=NULL;
5976  }
5977  //else Print("keep block %d\n",i);
5978  }
5979  }
5980  i=n-1;
5981  while(i>0)
5982  {
5983  // removed unneded blocks
5984  if(R->order[i-1]==ringorder_unspec)
5985  {
5986  for(j=i;j<=n;j++)
5987  {
5988  R->order[j-1]=R->order[j];
5989  R->block0[j-1]=R->block0[j];
5990  R->block1[j-1]=R->block1[j];
5991  if (R->wvhdl[j-1] !=NULL) omFree(R->wvhdl[j-1]);
5992  R->wvhdl[j-1]=R->wvhdl[j];
5993  }
5994  R->order[n]=ringorder_unspec;
5995  n--;
5996  }
5997  i--;
5998  }
5999  n=rBlocks(org_ring)-1;
6000  while (R->order[n]==0) n--;
6001  while (R->order[n]==ringorder_unspec) n--;
6002  if ((R->order[n]==ringorder_c) || (R->order[n]==ringorder_C)) n--;
6003  if (R->block1[n] != R->N)
6004  {
6005  if (((R->order[n]==ringorder_dp) ||
6006  (R->order[n]==ringorder_ds) ||
6007  (R->order[n]==ringorder_Dp) ||
6008  (R->order[n]==ringorder_Ds) ||
6009  (R->order[n]==ringorder_rp) ||
6010  (R->order[n]==ringorder_rs) ||
6011  (R->order[n]==ringorder_lp) ||
6012  (R->order[n]==ringorder_ls))
6013  &&
6014  R->block0[n] <= R->N)
6015  {
6016  R->block1[n] = R->N;
6017  }
6018  else
6019  {
6020  Werror("mismatch of number of vars (%d) and ordering (%d vars) in block %d",
6021  R->N,R->block1[n],n);
6022  return NULL;
6023  }
6024  }
6025  omFree(perm);
6026  // find OrdSgn:
6027  R->OrdSgn = org_ring->OrdSgn; // IMPROVE!
6028  //for(i=1;i<=R->N;i++)
6029  //{ if (weights[i]<0) { R->OrdSgn=-1;break; }}
6030  //omFree(weights);
6031  // Complete the initialization
6032  if (rComplete(R,1))
6033  goto rInitError;
6034 
6035  rTest(R);
6036 
6037  if (rv != NULL) rv->CleanUp();
6038 
6039  return R;
6040 
6041  // error case:
6042  rInitError:
6043  if (R != NULL) rDelete(R);
6044  if (rv != NULL) rv->CleanUp();
6045  return NULL;
6046 }
const short MAX_SHORT
Definition: ipshell.cc:5495
static BOOLEAN rSleftvList2StringArray(leftv sl, char **p)
Definition: ipshell.cc:5459
opposite of ls
Definition: ring.h:100
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:556
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:3351
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:1321
const ring R
Definition: DebugPrint.cc:36
#define rTest(r)
Definition: ring.h:775
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:335
int perm[100]
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:94

§ scIndIndset()

lists scIndIndset ( ideal  S,
BOOLEAN  all,
ideal  Q 
)

Definition at line 1028 of file ipshell.cc.

1029 {
1030  int i;
1031  indset save;
1033 
1034  hexist = hInit(S, Q, &hNexist, currRing);
1035  if (hNexist == 0)
1036  {
1037  intvec *iv=new intvec(rVar(currRing));
1038  for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1039  res->Init(1);
1040  res->m[0].rtyp=INTVEC_CMD;
1041  res->m[0].data=(intvec*)iv;
1042  return res;
1043  }
1044  else if (hisModule!=0)
1045  {
1046  res->Init(0);
1047  return res;
1048  }
1049  save = ISet = (indset)omAlloc0Bin(indlist_bin);
1050  hMu = 0;
1051  hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1052  hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1053  hpure = (scmon)omAlloc((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1054  hrad = hexist;
1055  hNrad = hNexist;
1056  radmem = hCreate(rVar(currRing) - 1);
1057  hCo = rVar(currRing) + 1;
1058  hNvar = rVar(currRing);
1059  hRadical(hrad, &hNrad, hNvar);
1060  hSupp(hrad, hNrad, hvar, &hNvar);
1061  if (hNvar)
1062  {
1063  hCo = hNvar;
1064  memset(hpure, 0, (rVar(currRing) + 1) * sizeof(long));
1065  hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1066  hLexR(hrad, hNrad, hvar, hNvar);
1068  }
1069  if (hCo && (hCo < rVar(currRing)))
1070  {
1072  }
1073  if (hMu!=0)
1074  {
1075  ISet = save;
1076  hMu2 = 0;
1077  if (all && (hCo+1 < rVar(currRing)))
1078  {
1081  i=hMu+hMu2;
1082  res->Init(i);
1083  if (hMu2 == 0)
1084  {
1086  }
1087  }
1088  else
1089  {
1090  res->Init(hMu);
1091  }
1092  for (i=0;i<hMu;i++)
1093  {
1094  res->m[i].data = (void *)save->set;
1095  res->m[i].rtyp = INTVEC_CMD;
1096  ISet = save;
1097  save = save->nx;
1099  }
1100  omFreeBin((ADDRESS)save, indlist_bin);
1101  if (hMu2 != 0)
1102  {
1103  save = JSet;
1104  for (i=hMu;i<hMu+hMu2;i++)
1105  {
1106  res->m[i].data = (void *)save->set;
1107  res->m[i].rtyp = INTVEC_CMD;
1108  JSet = save;
1109  save = save->nx;
1111  }
1112  omFreeBin((ADDRESS)save, indlist_bin);
1113  }
1114  }
1115  else
1116  {
1117  res->Init(0);
1119  }
1120  hKill(radmem, rVar(currRing) - 1);
1121  omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1122  omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1123  omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1125  return res;
1126 }
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:19
int hCo
Definition: hdegree.cc:22
Definition: lists.h:22
scmon * scfmon
Definition: hutil.h:18
#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:580
monf hCreate(int Nvar)
Definition: hutil.cc:1002
int hNvar
Definition: hutil.cc:22
void * ADDRESS
Definition: auxiliary.h:116
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:10
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:31
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:17
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)
#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

§ semicProc()

BOOLEAN semicProc ( leftv  res,
leftv  u,
leftv  v 
)

Definition at line 4460 of file ipshell.cc.

4461 {
4462  sleftv tmp;
4463  memset(&tmp,0,sizeof(tmp));
4464  tmp.rtyp=INT_CMD;
4465  /* tmp.data = (void *)0; -- done by memset */
4466 
4467  return semicProc3(res,u,v,&tmp);
4468 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:95
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4420
int rtyp
Definition: subexpr.h:92

§ semicProc3()

BOOLEAN semicProc3 ( leftv  res,
leftv  u,
leftv  v,
leftv  w 
)

Definition at line 4420 of file ipshell.cc.

4421 {
4422  semicState state;
4423  BOOLEAN qh=(((int)(long)w->Data())==1);
4424 
4425  // -----------------
4426  // check arguments
4427  // -----------------
4428 
4429  lists l1 = (lists)u->Data( );
4430  lists l2 = (lists)v->Data( );
4431 
4432  if( (state=list_is_spectrum( l1 ))!=semicOK )
4433  {
4434  WerrorS( "first argument is not a spectrum" );
4435  list_error( state );
4436  }
4437  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4438  {
4439  WerrorS( "second argument is not a spectrum" );
4440  list_error( state );
4441  }
4442  else
4443  {
4444  spectrum s1= spectrumFromList( l1 );
4445  spectrum s2= spectrumFromList( l2 );
4446 
4447  res->rtyp = INT_CMD;
4448  if (qh)
4449  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4450  else
4451  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4452  }
4453 
4454  // -----------------
4455  // check status
4456  // -----------------
4457 
4458  return (state!=semicOK);
4459 }
Definition: tok.h:95
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3293
void list_error(semicState state)
Definition: ipshell.cc:3377
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:4162
int mult_spectrumh(spectrum &)
Definition: semic.cc:425
semicState
Definition: ipshell.cc:3343
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1146
int BOOLEAN
Definition: auxiliary.h:86
int mult_spectrum(spectrum &)
Definition: semic.cc:396

§ spaddProc()

BOOLEAN spaddProc ( leftv  result,
leftv  first,
leftv  second 
)

Definition at line 4337 of file ipshell.cc.

4338 {
4339  semicState state;
4340 
4341  // -----------------
4342  // check arguments
4343  // -----------------
4344 
4345  lists l1 = (lists)first->Data( );
4346  lists l2 = (lists)second->Data( );
4347 
4348  if( (state=list_is_spectrum( l1 )) != semicOK )
4349  {
4350  WerrorS( "first argument is not a spectrum:" );
4351  list_error( state );
4352  }
4353  else if( (state=list_is_spectrum( l2 )) != semicOK )
4354  {
4355  WerrorS( "second argument is not a spectrum:" );
4356  list_error( state );
4357  }
4358  else
4359  {
4360  spectrum s1= spectrumFromList ( l1 );
4361  spectrum s2= spectrumFromList ( l2 );
4362  spectrum sum( s1+s2 );
4363 
4364  result->rtyp = LIST_CMD;
4365  result->data = (char*)(getList(sum));
4366  }
4367 
4368  return (state!=semicOK);
4369 }
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3293
void list_error(semicState state)
Definition: ipshell.cc:3377
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
lists getList(spectrum &spec)
Definition: ipshell.cc:3305
void * data
Definition: subexpr.h:89
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4162
semicState
Definition: ipshell.cc:3343
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1146
Definition: tok.h:117

§ spectrumCompute()

spectrumState spectrumCompute ( poly  h,
lists L,
int  fast 
)

Definition at line 3719 of file ipshell.cc.

3720 {
3721  int i;
3722 
3723  #ifdef SPECTRUM_DEBUG
3724  #ifdef SPECTRUM_PRINT
3725  #ifdef SPECTRUM_IOSTREAM
3726  cout << "spectrumCompute\n";
3727  if( fast==0 ) cout << " no optimization" << endl;
3728  if( fast==1 ) cout << " weight optimization" << endl;
3729  if( fast==2 ) cout << " symmetry optimization" << endl;
3730  #else
3731  fprintf( stdout,"spectrumCompute\n" );
3732  if( fast==0 ) fprintf( stdout," no optimization\n" );
3733  if( fast==1 ) fprintf( stdout," weight optimization\n" );
3734  if( fast==2 ) fprintf( stdout," symmetry optimization\n" );
3735  #endif
3736  #endif
3737  #endif
3738 
3739  // ----------------------
3740  // check if h is zero
3741  // ----------------------
3742 
3743  if( h==(poly)NULL )
3744  {
3745  return spectrumZero;
3746  }
3747 
3748  // ----------------------------------
3749  // check if h has a constant term
3750  // ----------------------------------
3751 
3752  if( hasConstTerm( h, currRing ) )
3753  {
3754  return spectrumBadPoly;
3755  }
3756 
3757  // --------------------------------
3758  // check if h has a linear term
3759  // --------------------------------
3760 
3761  if( hasLinearTerm( h, currRing ) )
3762  {
3763  *L = (lists)omAllocBin( slists_bin);
3764  (*L)->Init( 1 );
3765  (*L)->m[0].rtyp = INT_CMD; // milnor number
3766  /* (*L)->m[0].data = (void*)0;a -- done by Init */
3767 
3768  return spectrumNoSingularity;
3769  }
3770 
3771  // ----------------------------------
3772  // compute the jacobi ideal of (h)
3773  // ----------------------------------
3774 
3775  ideal J = NULL;
3776  J = idInit( rVar(currRing),1 );
3777 
3778  #ifdef SPECTRUM_DEBUG
3779  #ifdef SPECTRUM_PRINT
3780  #ifdef SPECTRUM_IOSTREAM
3781  cout << "\n computing the Jacobi ideal...\n";
3782  #else
3783  fprintf( stdout,"\n computing the Jacobi ideal...\n" );
3784  #endif
3785  #endif
3786  #endif
3787 
3788  for( i=0; i<rVar(currRing); i++ )
3789  {
3790  J->m[i] = pDiff( h,i+1); //j );
3791 
3792  #ifdef SPECTRUM_DEBUG
3793  #ifdef SPECTRUM_PRINT
3794  #ifdef SPECTRUM_IOSTREAM
3795  cout << " ";
3796  #else
3797  fprintf( stdout," " );
3798  #endif
3799  pWrite( J->m[i] );
3800  #endif
3801  #endif
3802  }
3803 
3804  // --------------------------------------------
3805  // compute a standard basis stdJ of jac(h)
3806  // --------------------------------------------
3807 
3808  #ifdef SPECTRUM_DEBUG
3809  #ifdef SPECTRUM_PRINT
3810  #ifdef SPECTRUM_IOSTREAM
3811  cout << endl;
3812  cout << " computing a standard basis..." << endl;
3813  #else
3814  fprintf( stdout,"\n" );
3815  fprintf( stdout," computing a standard basis...\n" );
3816  #endif
3817  #endif
3818  #endif
3819 
3820  ideal stdJ = kStd(J,currRing->qideal,isNotHomog,NULL);
3821  idSkipZeroes( stdJ );
3822 
3823  #ifdef SPECTRUM_DEBUG
3824  #ifdef SPECTRUM_PRINT
3825  for( i=0; i<IDELEMS(stdJ); i++ )
3826  {
3827  #ifdef SPECTRUM_IOSTREAM
3828  cout << " ";
3829  #else
3830  fprintf( stdout," " );
3831  #endif
3832 
3833  pWrite( stdJ->m[i] );
3834  }
3835  #endif
3836  #endif
3837 
3838  idDelete( &J );
3839 
3840  // ------------------------------------------
3841  // check if the h has a singularity
3842  // ------------------------------------------
3843 
3844  if( hasOne( stdJ, currRing ) )
3845  {
3846  // -------------------------------
3847  // h is smooth in the origin
3848  // return only the Milnor number
3849  // -------------------------------
3850 
3851  *L = (lists)omAllocBin( slists_bin);
3852  (*L)->Init( 1 );
3853  (*L)->m[0].rtyp = INT_CMD; // milnor number
3854  /* (*L)->m[0].data = (void*)0;a -- done by Init */
3855 
3856  return spectrumNoSingularity;
3857  }
3858 
3859  // ------------------------------------------
3860  // check if the singularity h is isolated
3861  // ------------------------------------------
3862 
3863  for( i=rVar(currRing); i>0; i-- )
3864  {
3865  if( hasAxis( stdJ,i, currRing )==FALSE )
3866  {
3867  return spectrumNotIsolated;
3868  }
3869  }
3870 
3871  // ------------------------------------------
3872  // compute the highest corner hc of stdJ
3873  // ------------------------------------------
3874 
3875  #ifdef SPECTRUM_DEBUG
3876  #ifdef SPECTRUM_PRINT
3877  #ifdef SPECTRUM_IOSTREAM
3878  cout << "\n computing the highest corner...\n";
3879  #else
3880  fprintf( stdout,"\n computing the highest corner...\n" );
3881  #endif
3882  #endif
3883  #endif
3884 
3885  poly hc = (poly)NULL;
3886 
3887  scComputeHC( stdJ,currRing->qideal, 0,hc );
3888 
3889  if( hc!=(poly)NULL )
3890  {
3891  pGetCoeff(hc) = nInit(1);
3892 
3893  for( i=rVar(currRing); i>0; i-- )
3894  {
3895  if( pGetExp( hc,i )>0 ) pDecrExp( hc,i );
3896  }
3897  pSetm( hc );
3898  }
3899  else
3900  {
3901  return spectrumNoHC;
3902  }
3903 
3904  #ifdef SPECTRUM_DEBUG
3905  #ifdef SPECTRUM_PRINT
3906  #ifdef SPECTRUM_IOSTREAM
3907  cout << " ";
3908  #else
3909  fprintf( stdout," " );
3910  #endif
3911  pWrite( hc );
3912  #endif
3913  #endif
3914 
3915  // ----------------------------------------
3916  // compute the Newton polygon nph of h
3917  // ----------------------------------------
3918 
3919  #ifdef SPECTRUM_DEBUG
3920  #ifdef SPECTRUM_PRINT
3921  #ifdef SPECTRUM_IOSTREAM
3922  cout << "\n computing the newton polygon...\n";
3923  #else
3924  fprintf( stdout,"\n computing the newton polygon...\n" );
3925  #endif
3926  #endif
3927  #endif
3928 
3929  newtonPolygon nph( h, currRing );
3930 
3931  #ifdef SPECTRUM_DEBUG
3932  #ifdef SPECTRUM_PRINT
3933  cout << nph;
3934  #endif
3935  #endif
3936 
3937  // -----------------------------------------------
3938  // compute the weight corner wc of (stdj,nph)
3939  // -----------------------------------------------
3940 
3941  #ifdef SPECTRUM_DEBUG
3942  #ifdef SPECTRUM_PRINT
3943  #ifdef SPECTRUM_IOSTREAM
3944  cout << "\n computing the weight corner...\n";
3945  #else
3946  fprintf( stdout,"\n computing the weight corner...\n" );
3947  #endif
3948  #endif
3949  #endif
3950 
3951  poly wc = ( fast==0 ? pCopy( hc ) :
3952  ( fast==1 ? computeWC( nph,(Rational)rVar(currRing), currRing ) :
3953  /* fast==2 */computeWC( nph,
3954  ((Rational)rVar(currRing))/(Rational)2, currRing ) ) );
3955 
3956  #ifdef SPECTRUM_DEBUG
3957  #ifdef SPECTRUM_PRINT
3958  #ifdef SPECTRUM_IOSTREAM
3959  cout << " ";
3960  #else
3961  fprintf( stdout," " );
3962  #endif
3963  pWrite( wc );
3964  #endif
3965  #endif
3966 
3967  // -------------
3968  // compute NF
3969  // -------------
3970 
3971  #ifdef SPECTRUM_DEBUG
3972  #ifdef SPECTRUM_PRINT
3973  #ifdef SPECTRUM_IOSTREAM
3974  cout << "\n computing NF...\n" << endl;
3975  #else
3976  fprintf( stdout,"\n computing NF...\n" );
3977  #endif
3978  #endif
3979  #endif
3980 
3981  spectrumPolyList NF( &nph );
3982 
3983  computeNF( stdJ,hc,wc,&NF, currRing );
3984 
3985  #ifdef SPECTRUM_DEBUG
3986  #ifdef SPECTRUM_PRINT
3987  cout << NF;
3988  #ifdef SPECTRUM_IOSTREAM
3989  cout << endl;
3990  #else
3991  fprintf( stdout,"\n" );
3992  #endif
3993  #endif
3994  #endif
3995 
3996  // ----------------------------
3997  // compute the spectrum of h
3998  // ----------------------------
3999 // spectrumState spectrumStateFromList( spectrumPolyList& speclist, lists *L, int fast );
4000 
4001  return spectrumStateFromList(NF, L, fast );
4002 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
#define pSetm(p)
Definition: polys.h:253
Definition: tok.h:95
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
#define FALSE
Definition: auxiliary.h:95
#define pDecrExp(p, i)
Definition: polys.h:44
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:580
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:2231
void pWrite(poly p)
Definition: polys.h:291
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:10
#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:3478
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:279
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:168
poly computeWC(const newtonPolygon &np, Rational max_weight, const ring r)
Definition: spectrum.cc:142

§ spectrumfProc()

BOOLEAN spectrumfProc ( leftv  result,
leftv  first 
)

Definition at line 4093 of file ipshell.cc.

4094 {
4095  spectrumState state = spectrumOK;
4096 
4097  // -------------------
4098  // check consistency
4099  // -------------------
4100 
4101  // check for a local polynomial ring
4102 
4103  if( currRing->OrdSgn != -1 )
4104  // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4105  // or should we use:
4106  //if( !ringIsLocal( ) )
4107  {
4108  WerrorS( "only works for local orderings" );
4109  state = spectrumWrongRing;
4110  }
4111  else if( currRing->qideal != NULL )
4112  {
4113  WerrorS( "does not work in quotient rings" );
4114  state = spectrumWrongRing;
4115  }
4116  else
4117  {
4118  lists L = (lists)NULL;
4119  int flag = 2; // symmetric optimization
4120 
4121  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4122 
4123  if( state==spectrumOK )
4124  {
4125  result->rtyp = LIST_CMD;
4126  result->data = (char*)L;
4127  }
4128  else
4129  {
4130  spectrumPrintError(state);
4131  }
4132  }
4133 
4134  return (state!=spectrumOK);
4135 }
spectrumState
Definition: ipshell.cc:3459
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:10
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:4011
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3719
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1146
Definition: tok.h:117
polyrec * poly
Definition: hilb.h:10

§ spectrumFromList()

spectrum spectrumFromList ( lists  l)

Definition at line 3293 of file ipshell.cc.

3294 {
3295  spectrum result;
3296  copy_deep( result, l );
3297  return result;
3298 }
Definition: semic.h:63
void copy_deep(spectrum &spec, lists l)
Definition: ipshell.cc:3269
return result
Definition: facAbsBiFact.cc:76

§ spectrumPrintError()

void spectrumPrintError ( spectrumState  state)

Definition at line 4011 of file ipshell.cc.

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

§ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4042 of file ipshell.cc.

4043 {
4044  spectrumState state = spectrumOK;
4045 
4046  // -------------------
4047  // check consistency
4048  // -------------------
4049 
4050  // check for a local ring
4051 
4052  if( !ringIsLocal(currRing ) )
4053  {
4054  WerrorS( "only works for local orderings" );
4055  state = spectrumWrongRing;
4056  }
4057 
4058  // no quotient rings are allowed
4059 
4060  else if( currRing->qideal != NULL )
4061  {
4062  WerrorS( "does not work in quotient rings" );
4063  state = spectrumWrongRing;
4064  }
4065  else
4066  {
4067  lists L = (lists)NULL;
4068  int flag = 1; // weight corner optimization is safe
4069 
4070  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4071 
4072  if( state==spectrumOK )
4073  {
4074  result->rtyp = LIST_CMD;
4075  result->data = (char*)L;
4076  }
4077  else
4078  {
4079  spectrumPrintError(state);
4080  }
4081  }
4082 
4083  return (state!=spectrumOK);
4084 }
spectrumState
Definition: ipshell.cc:3459
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:10
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:4011
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3719
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1146
Definition: tok.h:117
BOOLEAN ringIsLocal(const ring r)
Definition: spectrum.cc:461
polyrec * poly
Definition: hilb.h:10

§ spectrumStateFromList()

spectrumState spectrumStateFromList ( spectrumPolyList speclist,
lists L,
int  fast 
)

Definition at line 3478 of file ipshell.cc.

3479 {
3480  spectrumPolyNode **node = &speclist.root;
3482 
3483  poly f,tmp;
3484  int found,cmp;
3485 
3486  Rational smax( ( fast==0 ? 0 : rVar(currRing) ),
3487  ( fast==2 ? 2 : 1 ) );
3488 
3489  Rational weight_prev( 0,1 );
3490 
3491  int mu = 0; // the milnor number
3492  int pg = 0; // the geometrical genus
3493  int n = 0; // number of different spectral numbers
3494  int z = 0; // number of spectral number equal to smax
3495 
3496  while( (*node)!=(spectrumPolyNode*)NULL &&
3497  ( fast==0 || (*node)->weight<=smax ) )
3498  {
3499  // ---------------------------------------
3500  // determine the first normal form which
3501  // contains the monomial node->mon
3502  // ---------------------------------------
3503 
3504  found = FALSE;
3505  search = *node;
3506 
3507  while( search!=(spectrumPolyNode*)NULL && found==FALSE )
3508  {
3509  if( search->nf!=(poly)NULL )
3510  {
3511  f = search->nf;
3512 
3513  do
3514  {
3515  // --------------------------------
3516  // look for (*node)->mon in f
3517  // --------------------------------
3518 
3519  cmp = pCmp( (*node)->mon,f );
3520 
3521  if( cmp<0 )
3522  {
3523  f = pNext( f );
3524  }
3525  else if( cmp==0 )
3526  {
3527  // -----------------------------
3528  // we have found a normal form
3529  // -----------------------------
3530 
3531  found = TRUE;
3532 
3533  // normalize coefficient
3534 
3535  number inv = nInvers( pGetCoeff( f ) );
3536  pMult_nn( search->nf,inv );
3537  nDelete( &inv );
3538 
3539  // exchange normal forms
3540 
3541  tmp = (*node)->nf;
3542  (*node)->nf = search->nf;
3543  search->nf = tmp;
3544  }
3545  }
3546  while( cmp<0 && f!=(poly)NULL );
3547  }
3548  search = search->next;
3549  }
3550 
3551  if( found==FALSE )
3552  {
3553  // ------------------------------------------------
3554  // the weight of node->mon is a spectrum number
3555  // ------------------------------------------------
3556 
3557  mu++;
3558 
3559  if( (*node)->weight<=(Rational)1 ) pg++;
3560  if( (*node)->weight==smax ) z++;
3561  if( (*node)->weight>weight_prev ) n++;
3562 
3563  weight_prev = (*node)->weight;
3564  node = &((*node)->next);
3565  }
3566  else
3567  {
3568  // -----------------------------------------------
3569  // determine all other normal form which contain
3570  // the monomial node->mon
3571  // replace for node->mon its normal form
3572  // -----------------------------------------------
3573 
3574  while( search!=(spectrumPolyNode*)NULL )
3575  {
3576  if( search->nf!=(poly)NULL )
3577  {
3578  f = search->nf;
3579 
3580  do
3581  {
3582  // --------------------------------
3583  // look for (*node)->mon in f
3584  // --------------------------------
3585 
3586  cmp = pCmp( (*node)->mon,f );
3587 
3588  if( cmp<0 )
3589  {
3590  f = pNext( f );
3591  }
3592  else if( cmp==0 )
3593  {
3594  search->nf = pSub( search->nf,
3595  ppMult_nn( (*node)->nf,pGetCoeff( f ) ) );
3596  pNorm( search->nf );
3597  }
3598  }
3599  while( cmp<0 && f!=(poly)NULL );
3600  }
3601  search = search->next;
3602  }
3603  speclist.delete_node( node );
3604  }
3605 
3606  }
3607 
3608  // --------------------------------------------------------
3609  // fast computation exploits the symmetry of the spectrum
3610  // --------------------------------------------------------
3611 
3612  if( fast==2 )
3613  {
3614  mu = 2*mu - z;
3615  n = ( z > 0 ? 2*n - 1 : 2*n );
3616  }
3617 
3618  // --------------------------------------------------------
3619  // compute the spectrum numbers with their multiplicities
3620  // --------------------------------------------------------
3621 
3622  intvec *nom = new intvec( n );
3623  intvec *den = new intvec( n );
3624  intvec *mult = new intvec( n );
3625 
3626  int count = 0;
3627  int multiplicity = 1;
3628 
3629  for( search=speclist.root; search!=(spectrumPolyNode*)NULL &&
3630  ( fast==0 || search->weight<=smax );
3631  search=search->next )
3632  {
3633  if( search->next==(spectrumPolyNode*)NULL ||
3634  search->weight<search->next->weight )
3635  {
3636  (*nom) [count] = search->weight.get_num_si( );
3637  (*den) [count] = search->weight.get_den_si( );
3638  (*mult)[count] = multiplicity;
3639 
3640  multiplicity=1;
3641  count++;
3642  }
3643  else
3644  {
3645  multiplicity++;
3646  }
3647  }
3648 
3649  // --------------------------------------------------------
3650  // fast computation exploits the symmetry of the spectrum
3651  // --------------------------------------------------------
3652 
3653  if( fast==2 )
3654  {
3655  int n1,n2;
3656  for( n1=0, n2=n-1; n1<n2; n1++, n2-- )
3657  {
3658  (*nom) [n2] = rVar(currRing)*(*den)[n1]-(*nom)[n1];
3659  (*den) [n2] = (*den)[n1];
3660  (*mult)[n2] = (*mult)[n1];
3661  }
3662  }
3663 
3664  // -----------------------------------
3665  // test if the spectrum is symmetric
3666  // -----------------------------------
3667 
3668  if( fast==0 || fast==1 )
3669  {
3670  int symmetric=TRUE;
3671 
3672  for( int n1=0, n2=n-1 ; n1<n2 && symmetric==TRUE; n1++, n2-- )
3673  {
3674  if( (*mult)[n1]!=(*mult)[n2] ||
3675  (*den) [n1]!= (*den)[n2] ||
3676  (*nom)[n1]+(*nom)[n2]!=rVar(currRing)*(*den) [n1] )
3677  {
3678  symmetric = FALSE;
3679  }
3680  }
3681 
3682  if( symmetric==FALSE )
3683  {
3684  // ---------------------------------------------
3685  // the spectrum is not symmetric => degenerate
3686  // principal part
3687  // ---------------------------------------------
3688 
3689  *L = (lists)omAllocBin( slists_bin);
3690  (*L)->Init( 1 );
3691  (*L)->m[0].rtyp = INT_CMD; // milnor number
3692  (*L)->m[0].data = (void*)(long)mu;
3693 
3694  return spectrumDegenerate;
3695  }
3696  }
3697 
3698  *L = (lists)omAllocBin( slists_bin);
3699 
3700  (*L)->Init( 6 );
3701 
3702  (*L)->m[0].rtyp = INT_CMD; // milnor number
3703  (*L)->m[1].rtyp = INT_CMD; // geometrical genus
3704  (*L)->m[2].rtyp = INT_CMD; // number of spectrum values
3705  (*L)->m[3].rtyp = INTVEC_CMD; // nominators
3706  (*L)->m[4].rtyp = INTVEC_CMD; // denomiantors
3707  (*L)->m[5].rtyp = INTVEC_CMD; // multiplicities
3708 
3709  (*L)->m[0].data = (void*)(long)mu;
3710  (*L)->m[1].data = (void*)(long)pg;
3711  (*L)->m[2].data = (void*)(long)n;
3712  (*L)->m[3].data = (void*)nom;
3713  (*L)->m[4].data = (void*)den;
3714  (*L)->m[5].data = (void*)mult;
3715 
3716  return spectrumOK;
3717 }
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:95
Rational weight
Definition: splist.h:41
#define FALSE
Definition: auxiliary.h:95
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:580
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:99
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:10
spectrumPolyNode * root
Definition: splist.h:60
Definition: intvec.h:14
#define pSub(a, b)
Definition: polys.h:270
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:183
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:182
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:346
#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

§ spmulProc()

BOOLEAN spmulProc ( leftv  result,
leftv  first,
leftv  second 
)

Definition at line 4379 of file ipshell.cc.

4380 {
4381  semicState state;
4382 
4383  // -----------------
4384  // check arguments
4385  // -----------------
4386 
4387  lists l = (lists)first->Data( );
4388  int k = (int)(long)second->Data( );
4389 
4390  if( (state=list_is_spectrum( l ))!=semicOK )
4391  {
4392  WerrorS( "first argument is not a spectrum" );
4393  list_error( state );
4394  }
4395  else if( k < 0 )
4396  {
4397  WerrorS( "second argument should be positive" );
4398  state = semicMulNegative;
4399  }
4400  else
4401  {
4402  spectrum s= spectrumFromList( l );
4403  spectrum product( k*s );
4404 
4405  result->rtyp = LIST_CMD;
4406  result->data = (char*)getList(product);
4407  }
4408 
4409  return (state!=semicOK);
4410 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3293
void list_error(semicState state)
Definition: ipshell.cc:3377
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:3305
void * data
Definition: subexpr.h:89
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4162
semicState
Definition: ipshell.cc:3343
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1146
Definition: tok.h:117
int l
Definition: cfEzgcd.cc:94

§ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3080 of file ipshell.cc.

3081 {
3082  sleftv tmp;
3083  memset(&tmp,0,sizeof(tmp));
3084  tmp.rtyp=INT_CMD;
3085  tmp.data=(void *)1;
3086  return syBetti2(res,u,&tmp);
3087 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:95
void * data
Definition: subexpr.h:89
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3057
int rtyp
Definition: subexpr.h:92

§ syBetti2()

BOOLEAN syBetti2 ( leftv  res,
leftv  u,
leftv  w 
)

Definition at line 3057 of file ipshell.cc.

3058 {
3059  syStrategy syzstr=(syStrategy)u->Data();
3060 
3061  BOOLEAN minim=(int)(long)w->Data();
3062  int row_shift=0;
3063  int add_row_shift=0;
3064  intvec *weights=NULL;
3065  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3066  if (ww!=NULL)
3067  {
3068  weights=ivCopy(ww);
3069  add_row_shift = ww->min_in();
3070  (*weights) -= add_row_shift;
3071  }
3072 
3073  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3074  //row_shift += add_row_shift;
3075  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3076  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3077 
3078  return FALSE;
3079 }
void atSet(idhdl root, const char *name, void *data, int typ)
Definition: attrib.cc:156
Definition: tok.h:95
#define FALSE
Definition: auxiliary.h:95
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:1757
void * Data()
Definition: subexpr.cc:1146
int BOOLEAN
Definition: auxiliary.h:86
ssyStrategy * syStrategy
Definition: syz.h:35
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ syConvList()

syStrategy syConvList ( lists  li)

Definition at line 3165 of file ipshell.cc.

3166 {
3167  int typ0;
3169 
3170  resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3171  if (fr != NULL)
3172  {
3173 
3174  result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3175  for (int i=result->length-1;i>=0;i--)
3176  {
3177  if (fr[i]!=NULL)
3178  result->fullres[i] = idCopy(fr[i]);
3179  }
3180  result->list_length=result->length;
3181  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3182  }
3183  else
3184  {
3185  omFreeSize(result, sizeof(ssyStrategy));
3186  result = NULL;
3187  }
3188  return result;
3189 }
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:312
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:116
int i
Definition: cfEzgcd.cc:123
resolvente fullres
Definition: syz.h:57
ideal idCopy(ideal A)
Definition: ideals.h:60
#define NULL
Definition: omList.c:10
short list_length
Definition: syz.h:62
ideal * resolvente
Definition: ideals.h:18
#define omAlloc0(size)
Definition: omAllocDecl.h:211
return result
Definition: facAbsBiFact.cc:76
ssyStrategy * syStrategy
Definition: syz.h:35

§ syConvRes()

lists syConvRes ( syStrategy  syzstr,
BOOLEAN  toDel,
int  add_row_shift 
)

Definition at line 3092 of file ipshell.cc.

3093 {
3094  resolvente fullres = syzstr->fullres;
3095  resolvente minres = syzstr->minres;
3096 
3097  const int length = syzstr->length;
3098 
3099  if ((fullres==NULL) && (minres==NULL))
3100  {
3101  if (syzstr->hilb_coeffs==NULL)
3102  { // La Scala
3103  fullres = syReorder(syzstr->res, length, syzstr);
3104  }
3105  else
3106  { // HRES
3107  minres = syReorder(syzstr->orderedRes, length, syzstr);
3108  syKillEmptyEntres(minres, length);
3109  }
3110  }
3111 
3112  resolvente tr;
3113  int typ0=IDEAL_CMD;
3114 
3115  if (minres!=NULL)
3116  tr = minres;
3117  else
3118  tr = fullres;
3119 
3120  resolvente trueres=NULL; intvec ** w=NULL;
3121 
3122  if (length>0)
3123  {
3124  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3125  for (int i=(length)-1;i>=0;i--)
3126  {
3127  if (tr[i]!=NULL)
3128  {
3129  trueres[i] = idCopy(tr[i]);
3130  }
3131  }
3132  if ( id_RankFreeModule(trueres[0], currRing) > 0)
3133  typ0 = MODUL_CMD;
3134  if (syzstr->weights!=NULL)
3135  {
3136  w = (intvec**)omAlloc0(length*sizeof(intvec*));
3137  for (int i=length-1;i>=0;i--)
3138  {
3139  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3140  }
3141  }
3142  }
3143 
3144  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3145  w, add_row_shift);
3146 
3147  if (w != NULL) omFreeSize(w, length*sizeof(intvec*));
3148 
3149  if (toDel)
3150  syKillComputation(syzstr);
3151  else
3152  {
3153  if( fullres != NULL && syzstr->fullres == NULL )
3154  syzstr->fullres = fullres;
3155 
3156  if( minres != NULL && syzstr->minres == NULL )
3157  syzstr->minres = minres;
3158  }
3159  return li;
3160 }
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:1643
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:10
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:60
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:215
const CanonicalForm & w
Definition: facAbsFact.cc:55
short list_length
Definition: syz.h:62
ideal * resolvente
Definition: ideals.h:18
void syKillEmptyEntres(resolvente res, int length)
Definition: syz1.cc:2199
void syKillComputation(syStrategy syzstr, ring r=currRing)
Definition: syz1.cc:1497
#define omAlloc0(size)
Definition: omAllocDecl.h:211

§ syForceMin()

syStrategy syForceMin ( lists  li)

Definition at line 3194 of file ipshell.cc.

3195 {
3196  int typ0;
3198 
3199  resolvente fr = liFindRes(li,&(result->length),&typ0);
3200  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3201  for (int i=result->length-1;i>=0;i--)
3202  {
3203  if (fr[i]!=NULL)
3204  result->minres[i] = idCopy(fr[i]);
3205  }
3206  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3207  return result;
3208 }
int length
Definition: syz.h:60
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:312
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:116
int i
Definition: cfEzgcd.cc:123
ideal idCopy(ideal A)
Definition: ideals.h:60
resolvente minres
Definition: syz.h:58
#define NULL
Definition: omList.c:10
ideal * resolvente
Definition: ideals.h:18
#define omAlloc0(size)
Definition: omAllocDecl.h:211
return result
Definition: facAbsBiFact.cc:76
ssyStrategy * syStrategy
Definition: syz.h:35

§ test_cmd()

void test_cmd ( int  i)

Definition at line 512 of file ipshell.cc.

513 {
514  int ii;
515 
516  if (i<0)
517  {
518  ii= -i;
519  if (ii < 32)
520  {
521  si_opt_1 &= ~Sy_bit(ii);
522  }
523  else if (ii < 64)
524  {
525  si_opt_2 &= ~Sy_bit(ii-32);
526  }
527  else
528  WerrorS("out of bounds\n");
529  }
530  else if (i<32)
531  {
532  ii=i;
533  if (Sy_bit(ii) & kOptions)
534  {
535  Warn("Gerhard, use the option command");
536  si_opt_1 |= Sy_bit(ii);
537  }
538  else if (Sy_bit(ii) & validOpts)
539  si_opt_1 |= Sy_bit(ii);
540  }
541  else if (i<64)
542  {
543  ii=i-32;
544  si_opt_2 |= Sy_bit(ii);
545  }
546  else
547  WerrorS("out of bounds\n");
548 }
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:63
int i
Definition: cfEzgcd.cc:123
BITSET kOptions
Definition: kstd1.cc:48
unsigned si_opt_2
Definition: options.c:6
#define Warn
Definition: emacs.cc:80

§ type_cmd()

void type_cmd ( leftv  v)

Definition at line 248 of file ipshell.cc.

249 {
250  BOOLEAN oldShortOut = FALSE;
251 
252  if (currRing != NULL)
253  {
254  oldShortOut = currRing->ShortOut;
255  currRing->ShortOut = 1;
256  }
257  int t=v->Typ();
258  Print("// %s %s ",v->Name(),Tok2Cmdname(t));
259  switch (t)
260  {
261  case MAP_CMD:Print(" from %s\n",((map)(v->Data()))->preimage); break;
262  case INTMAT_CMD: Print(" %d x %d\n",((intvec*)(v->Data()))->rows(),
263  ((intvec*)(v->Data()))->cols()); break;
264  case MATRIX_CMD:Print(" %u x %u\n" ,
265  MATROWS((matrix)(v->Data())),
266  MATCOLS((matrix)(v->Data())));break;
267  case MODUL_CMD: Print(", rk %d\n", (int)(((ideal)(v->Data()))->rank));break;
268  case LIST_CMD: Print(", size %d\n",((lists)(v->Data()))->nr+1); break;
269 
270  case PROC_CMD:
271  case RING_CMD:
272  case IDEAL_CMD: PrintLn(); break;
273 
274  //case INT_CMD:
275  //case STRING_CMD:
276  //case INTVEC_CMD:
277  //case POLY_CMD:
278  //case VECTOR_CMD:
279  //case PACKAGE_CMD:
280 
281  default:
282  break;
283  }
284  v->Print();
285  if (currRing != NULL)
286  currRing->ShortOut = oldShortOut;
287 }
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:310
#define Print
Definition: emacs.cc:83
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:95
int Typ()
Definition: subexpr.cc:1004
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:10
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:130
void * Data()
Definition: subexpr.cc:1146
Definition: tok.h:117
#define MATROWS(i)
Definition: matpol.h:27
int BOOLEAN
Definition: auxiliary.h:86

Variable Documentation

§ iiCurrArgs

leftv iiCurrArgs =NULL

Definition at line 80 of file ipshell.cc.

§ iiCurrProc

idhdl iiCurrProc =NULL

Definition at line 81 of file ipshell.cc.

§ iiDebugMarker

BOOLEAN iiDebugMarker =TRUE

Definition at line 988 of file ipshell.cc.

§ iiNoKeepRing

BOOLEAN iiNoKeepRing =TRUE
static

Definition at line 84 of file ipshell.cc.

§ lastreserved

const char* lastreserved =NULL

Definition at line 82 of file ipshell.cc.

§ MAX_SHORT

const short MAX_SHORT = 32767

Definition at line 5495 of file ipshell.cc.