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 <coeffs/bigintmat.h>
#include "libparse.h"

Go to the source code of this file.

Macros

#define BREAK_LINE_LENGTH   80
 

Enumerations

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

Functions

const char * iiTwoOps (int t)
 
int iiOpsTwoChar (const char *s)
 
static void list1 (const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
 
void type_cmd (leftv v)
 
static void killlocals0 (int v, idhdl *localhdl, const ring r)
 
void killlocals_rec (idhdl *root, int v, ring r)
 
BOOLEAN killlocals_list (int v, lists L)
 
void killlocals (int v)
 
void list_cmd (int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname)
 
void test_cmd (int i)
 
int exprlist_length (leftv v)
 
BOOLEAN iiWRITE (leftv, leftv v)
 
leftv iiMap (map theMap, const char *what)
 
void iiMakeResolv (resolvente r, int length, int rlen, char *name, int typ0, intvec **weights)
 
static resolvente iiCopyRes (resolvente r, int l)
 
BOOLEAN jjMINRES (leftv res, leftv v)
 
BOOLEAN jjBETTI (leftv res, leftv u)
 
BOOLEAN jjBETTI2_ID (leftv res, leftv u, leftv v)
 
BOOLEAN jjBETTI2 (leftv res, leftv u, leftv v)
 
int iiRegularity (lists L)
 
void iiDebug ()
 
lists scIndIndset (ideal S, BOOLEAN all, ideal Q)
 
int iiDeclCommand (leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
 
BOOLEAN iiDefaultParameter (leftv p)
 
BOOLEAN iiBranchTo (leftv, leftv args)
 
BOOLEAN iiParameter (leftv p)
 
static BOOLEAN iiInternalExport (leftv v, int toLev)
 
BOOLEAN iiInternalExport (leftv v, int toLev, package rootpack)
 
BOOLEAN iiExport (leftv v, int toLev)
 
BOOLEAN iiExport (leftv v, int toLev, package pack)
 
BOOLEAN iiCheckRing (int i)
 
poly iiHighCorner (ideal I, int ak)
 
void iiCheckPack (package &p)
 
idhdl rDefault (const char *s)
 
idhdl rFindHdl (ring r, idhdl n)
 
void rDecomposeCF (leftv h, const ring r, const ring R)
 
static void rDecomposeC_41 (leftv h, const coeffs C)
 
static void rDecomposeC (leftv h, const ring R)
 
void rDecomposeRing_41 (leftv h, const coeffs C)
 
void rDecomposeRing (leftv h, const ring R)
 
BOOLEAN rDecompose_CF (leftv res, const coeffs C)
 
lists rDecompose_list_cf (const ring r)
 
lists rDecompose (const ring r)
 
void rComposeC (lists L, ring R)
 
void rComposeRing (lists L, ring R)
 
static void rRenameVars (ring R)
 
static BOOLEAN rComposeVar (const lists L, ring R)
 
static BOOLEAN rComposeOrder (const lists L, const BOOLEAN check_comp, ring R)
 
ring rCompose (const lists L, const BOOLEAN check_comp)
 
BOOLEAN mpJacobi (leftv res, leftv a)
 
BOOLEAN mpKoszul (leftv res, leftv c, leftv b, leftv id)
 
BOOLEAN syBetti2 (leftv res, leftv u, leftv w)
 
BOOLEAN syBetti1 (leftv res, leftv u)
 
lists syConvRes (syStrategy syzstr, BOOLEAN toDel, int add_row_shift)
 
syStrategy syConvList (lists li)
 
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 985 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 3339 of file ipshell.cc.

3340 {
3341  semicOK,
3343 
3346 
3353 
3358 
3364 
3367 
3370 
3371 } semicState;
semicState
Definition: ipshell.cc:3339

§ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3455 of file ipshell.cc.

Function Documentation

§ copy_deep()

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 3265 of file ipshell.cc.

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

§ exprlist_length()

int exprlist_length ( leftv  v)

Definition at line 546 of file ipshell.cc.

547 {
548  int rc = 0;
549  while (v!=NULL)
550  {
551  switch (v->Typ())
552  {
553  case INT_CMD:
554  case POLY_CMD:
555  case VECTOR_CMD:
556  case NUMBER_CMD:
557  rc++;
558  break;
559  case INTVEC_CMD:
560  case INTMAT_CMD:
561  rc += ((intvec *)(v->Data()))->length();
562  break;
563  case MATRIX_CMD:
564  case IDEAL_CMD:
565  case MODUL_CMD:
566  {
567  matrix mm = (matrix)(v->Data());
568  rc += mm->rows() * mm->cols();
569  }
570  break;
571  case LIST_CMD:
572  rc+=((lists)v->Data())->nr+1;
573  break;
574  default:
575  rc++;
576  }
577  v = v->next;
578  }
579  return rc;
580 }
int & rows()
Definition: matpol.h:24
Definition: tok.h:94
int Typ()
Definition: subexpr.cc:979
Definition: intvec.h:14
ip_smatrix * matrix
Definition: tok.h:99
leftv next
Definition: subexpr.h:88
int & cols()
Definition: matpol.h:25
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
void * Data()
Definition: subexpr.cc:1121
Definition: tok.h:116

§ getList()

lists getList ( spectrum spec)

Definition at line 3301 of file ipshell.cc.

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

6320 {
6321  memset(res,0,sizeof(sleftv));
6322  res->rtyp=a->Typ();
6323  switch (res->rtyp /*a->Typ()*/)
6324  {
6325  case INTVEC_CMD:
6326  case INTMAT_CMD:
6327  return iiApplyINTVEC(res,a,op,proc);
6328  case BIGINTMAT_CMD:
6329  return iiApplyBIGINTMAT(res,a,op,proc);
6330  case IDEAL_CMD:
6331  case MODUL_CMD:
6332  case MATRIX_CMD:
6333  return iiApplyIDEAL(res,a,op,proc);
6334  case LIST_CMD:
6335  return iiApplyLIST(res,a,op,proc);
6336  }
6337  WerrorS("first argument to `apply` must allow an index");
6338  return TRUE;
6339 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:84
#define TRUE
Definition: auxiliary.h:101
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:979
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6277
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6287
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6282
Definition: tok.h:99
int rtyp
Definition: subexpr.h:93
Definition: tok.h:116
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6245

§ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6277 of file ipshell.cc.

6278 {
6279  WerrorS("not implemented");
6280  return TRUE;
6281 }
#define TRUE
Definition: auxiliary.h:101
void WerrorS(const char *s)
Definition: feFopen.cc:24

§ iiApplyIDEAL()

BOOLEAN iiApplyIDEAL ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6282 of file ipshell.cc.

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

§ iiApplyINTVEC()

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

Definition at line 6245 of file ipshell.cc.

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

§ iiApplyLIST()

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

Definition at line 6287 of file ipshell.cc.

6288 {
6289  lists aa=(lists)a->Data();
6290  sleftv tmp_out;
6291  sleftv tmp_in;
6292  leftv curr=res;
6293  BOOLEAN bo=FALSE;
6294  for(int i=0;i<=aa->nr; i++)
6295  {
6296  memset(&tmp_in,0,sizeof(tmp_in));
6297  tmp_in.Copy(&(aa->m[i]));
6298  if (proc==NULL)
6299  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6300  else
6301  bo=jjPROC(&tmp_out,proc,&tmp_in);
6302  tmp_in.CleanUp();
6303  if (bo)
6304  {
6305  res->CleanUp(currRing);
6306  Werror("apply fails at index %d",i+1);
6307  return TRUE;
6308  }
6309  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6310  else
6311  {
6312  curr->next=(leftv)omAllocBin(sleftv_bin);
6313  curr=curr->next;
6314  memcpy(curr,&tmp_out,sizeof(tmp_out));
6315  }
6316  }
6317  return FALSE;
6318 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:84
Definition: lists.h:22
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:8422
#define FALSE
Definition: auxiliary.h:97
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1602
#define TRUE
Definition: auxiliary.h:101
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:660
omBin sleftv_bin
Definition: subexpr.cc:50
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:88
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:320
void * Data()
Definition: subexpr.cc:1121
int BOOLEAN
Definition: auxiliary.h:88
void Werror(const char *fmt,...)
Definition: reporter.cc:189

§ iiARROW()

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

Definition at line 6368 of file ipshell.cc.

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

§ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6402 of file ipshell.cc.

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

§ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  ,
leftv  args 
)

Definition at line 1181 of file ipshell.cc.

1182 {
1183  // <string1...stringN>,<proc>
1184  // known: args!=NULL, l>=1
1185  int l=args->listLength();
1186  int ll=0;
1187  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1188  if (ll!=(l-1)) return FALSE;
1189  leftv h=args;
1190  short *t=(short*)omAlloc(l*sizeof(short));
1191  t[0]=l-1;
1192  int b;
1193  int i;
1194  for(i=1;i<l;i++,h=h->next)
1195  {
1196  if (h->Typ()!=STRING_CMD)
1197  {
1198  omFree(t);
1199  Werror("arg %d is not a string",i);
1200  return TRUE;
1201  }
1202  int tt;
1203  b=IsCmd((char *)h->Data(),tt);
1204  if(b) t[i]=tt;
1205  else
1206  {
1207  omFree(t);
1208  Werror("arg %d is not a type name",i);
1209  return TRUE;
1210  }
1211  }
1212  if (h->Typ()!=PROC_CMD)
1213  {
1214  omFree(t);
1215  Werror("last arg (%d) is not a proc",i);
1216  return TRUE;
1217  }
1218  b=iiCheckTypes(iiCurrArgs,t,0);
1219  omFree(t);
1220  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1221  {
1222  BOOLEAN err;
1223  //Print("branchTo: %s\n",h->Name());
1224  iiCurrProc=(idhdl)h->data;
1226  if( pi->data.s.body==NULL )
1227  {
1229  if (pi->data.s.body==NULL) return TRUE;
1230  }
1231  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1232  {
1233  currPack=pi->pack;
1236  //Print("set pack=%s\n",IDID(currPackHdl));
1237  }
1238  err=iiAllStart(pi,pi->data.s.body,BT_proc,pi->data.s.body_lineno-(iiCurrArgs==NULL));
1240  if (iiCurrArgs!=NULL)
1241  {
1242  if (!err) Warn("too many arguments for %s",IDID(iiCurrProc));
1243  iiCurrArgs->CleanUp();
1245  iiCurrArgs=NULL;
1246  }
1247  return 2-err;
1248  }
1249  return FALSE;
1250 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:84
idhdl currPackHdl
Definition: ipid.cc:61
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:97
int listLength()
Definition: subexpr.cc:61
#define TRUE
Definition: auxiliary.h:101
void * ADDRESS
Definition: auxiliary.h:118
#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:79
#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:88
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:6460
package currPack
Definition: ipid.cc:63
leftv iiCurrArgs
Definition: ipshell.cc:78
void CleanUp(ring r=currRing)
Definition: subexpr.cc:320
idhdl packFindHdl(package r)
Definition: ipid.cc:730
void iiCheckPack(package &p)
Definition: ipshell.cc:1509
#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:88
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:8830
#define Warn
Definition: emacs.cc:80

§ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1509 of file ipshell.cc.

1510 {
1511  if (p!=basePack)
1512  {
1513  idhdl t=basePack->idroot;
1514  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1515  if (t==NULL)
1516  {
1517  WarnS("package not found\n");
1518  p=basePack;
1519  }
1520  }
1521 }
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 1465 of file ipshell.cc.

1466 {
1467  if (currRing==NULL)
1468  {
1469  #ifdef SIQ
1470  if (siq<=0)
1471  {
1472  #endif
1473  if (RingDependend(i))
1474  {
1475  WerrorS("no ring active");
1476  return TRUE;
1477  }
1478  #ifdef SIQ
1479  }
1480  #endif
1481  }
1482  return FALSE;
1483 }
#define FALSE
Definition: auxiliary.h:97
BOOLEAN siq
Definition: subexpr.cc:58
#define TRUE
Definition: auxiliary.h:101
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 6460 of file ipshell.cc.

6461 {
6462  if (args==NULL)
6463  {
6464  if (type_list[0]==0) return TRUE;
6465  else
6466  {
6467  if (report) WerrorS("no arguments expected");
6468  return FALSE;
6469  }
6470  }
6471  int l=args->listLength();
6472  if (l!=(int)type_list[0])
6473  {
6474  if (report) iiReportTypes(0,l,type_list);
6475  return FALSE;
6476  }
6477  for(int i=1;i<=l;i++,args=args->next)
6478  {
6479  short t=type_list[i];
6480  if (t!=ANY_TYPE)
6481  {
6482  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6483  || (t!=args->Typ()))
6484  {
6485  if (report) iiReportTypes(i,args->Typ(),type_list);
6486  return FALSE;
6487  }
6488  }
6489  }
6490  return TRUE;
6491 }
#define ANY_TYPE
Definition: tok.h:30
#define FALSE
Definition: auxiliary.h:97
int listLength()
Definition: subexpr.cc:61
#define TRUE
Definition: auxiliary.h:101
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:6442
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:88
#define NULL
Definition: omList.c:10
int l
Definition: cfEzgcd.cc:94

§ iiCopyRes()

static resolvente iiCopyRes ( resolvente  r,
int  l 
)
static

Definition at line 857 of file ipshell.cc.

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

§ iiDebug()

void iiDebug ( )

Definition at line 986 of file ipshell.cc.

987 {
988 #ifdef HAVE_SDB
989  sdb_flags=1;
990 #endif
991  Print("\n-- break point in %s --\n",VoiceName());
993  char * s;
995  s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
996  loop
997  {
998  memset(s,0,80);
1000  if (s[BREAK_LINE_LENGTH-1]!='\0')
1001  {
1002  Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
1003  }
1004  else
1005  break;
1006  }
1007  if (*s=='\n')
1008  {
1010  }
1011 #if MDEBUG
1012  else if(strncmp(s,"cont;",5)==0)
1013  {
1015  }
1016 #endif /* MDEBUG */
1017  else
1018  {
1019  strcat( s, "\n;~\n");
1020  newBuffer(s,BT_execute);
1021  }
1022 }
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:97
#define TRUE
Definition: auxiliary.h:101
#define omAlloc(size)
Definition: omAllocDecl.h:210
BOOLEAN iiDebugMarker
Definition: ipshell.cc:984
const char * VoiceName()
Definition: fevoices.cc:66
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:985
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 1124 of file ipshell.cc.

1125 {
1126  BOOLEAN res=FALSE;
1127  const char *id = name->name;
1128 
1129  memset(sy,0,sizeof(sleftv));
1130  if ((name->name==NULL)||(isdigit(name->name[0])))
1131  {
1132  WerrorS("object to declare is not a name");
1133  res=TRUE;
1134  }
1135  else
1136  {
1137  if (t==QRING_CMD) t=RING_CMD; // qring is always RING_CMD
1138 
1139  if (TEST_V_ALLWARN
1140  && (name->rtyp!=0)
1141  && (name->rtyp!=IDHDL)
1142  && (currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1143  {
1144  Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1146  }
1147  {
1148  sy->data = (char *)enterid(id,lev,t,root,init_b);
1149  }
1150  if (sy->data!=NULL)
1151  {
1152  sy->rtyp=IDHDL;
1153  currid=sy->name=IDID((idhdl)sy->data);
1154  // name->name=NULL; /* used in enterid */
1155  //sy->e = NULL;
1156  if (name->next!=NULL)
1157  {
1159  res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1160  }
1161  }
1162  else res=TRUE;
1163  }
1164  name->CleanUp();
1165  return res;
1166 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
Class used for (list of) interpreter objects.
Definition: subexpr.h:84
int yylineno
Definition: febase.cc:45
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:97
char * filename
Definition: fevoices.h:62
#define TRUE
Definition: auxiliary.h:101
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:90
poly res
Definition: myNF.cc:322
int myynest
Definition: febase.cc:46
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:259
char my_yylinebuf[80]
Definition: febase.cc:48
const char * name
Definition: subexpr.h:89
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:88
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition: ipshell.cc:1124
#define NULL
Definition: omList.c:10
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:128
Voice * currentVoice
Definition: fevoices.cc:57
int rtyp
Definition: subexpr.h:93
void CleanUp(ring r=currRing)
Definition: subexpr.cc:320
Definition: tok.h:155
int BOOLEAN
Definition: auxiliary.h:88
#define TEST_V_ALLWARN
Definition: options.h:135
#define Warn
Definition: emacs.cc:80

§ iiDefaultParameter()

BOOLEAN iiDefaultParameter ( leftv  p)

Definition at line 1168 of file ipshell.cc.

1169 {
1170  attr at=NULL;
1171  if (iiCurrProc!=NULL)
1172  at=iiCurrProc->attribute->get("default_arg");
1173  if (at==NULL)
1174  return FALSE;
1175  sleftv tmp;
1176  memset(&tmp,0,sizeof(sleftv));
1177  tmp.rtyp=at->atyp;
1178  tmp.data=at->CopyA();
1179  return iiAssign(p,&tmp);
1180 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:84
Definition: attrib.h:15
#define FALSE
Definition: auxiliary.h:97
idhdl iiCurrProc
Definition: ipshell.cc:79
void * data
Definition: subexpr.h:90
void * CopyA()
Definition: subexpr.cc:1941
#define NULL
Definition: omList.c:10
attr attribute
Definition: idrec.h:41
int rtyp
Definition: subexpr.h:93
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:1780

§ iiExport() [1/2]

BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1385 of file ipshell.cc.

1386 {
1387  BOOLEAN nok=FALSE;
1388  leftv r=v;
1389  while (v!=NULL)
1390  {
1391  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1392  {
1393  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1394  nok=TRUE;
1395  }
1396  else
1397  {
1398  if(iiInternalExport(v, toLev))
1399  {
1400  r->CleanUp();
1401  return TRUE;
1402  }
1403  }
1404  v=v->next;
1405  }
1406  r->CleanUp();
1407  return nok;
1408 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:84
Subexpr e
Definition: subexpr.h:107
#define FALSE
Definition: auxiliary.h:97
#define TRUE
Definition: auxiliary.h:101
const ring r
Definition: syzextra.cc:208
const char * name
Definition: subexpr.h:89
leftv next
Definition: subexpr.h:88
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1287
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:93
void CleanUp(ring r=currRing)
Definition: subexpr.cc:320
int BOOLEAN
Definition: auxiliary.h:88
void Werror(const char *fmt,...)
Definition: reporter.cc:189

§ iiExport() [2/2]

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

Definition at line 1411 of file ipshell.cc.

1412 {
1413 #ifdef SINGULAR_4_1
1414 // if ((pack==basePack)&&(pack!=currPack))
1415 // { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
1416 #endif
1417  BOOLEAN nok=FALSE;
1418  leftv rv=v;
1419  while (v!=NULL)
1420  {
1421  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
1422  )
1423  {
1424  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1425  nok=TRUE;
1426  }
1427  else
1428  {
1429  idhdl old=pack->idroot->get( v->name,toLev);
1430  if (old!=NULL)
1431  {
1432  if ((pack==currPack) && (old==(idhdl)v->data))
1433  {
1434  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
1435  break;
1436  }
1437  else if (IDTYP(old)==v->Typ())
1438  {
1439  if (BVERBOSE(V_REDEFINE))
1440  {
1441  Warn("redefining %s (%s)",IDID(old),my_yylinebuf);
1442  }
1443  v->name=omStrDup(v->name);
1444  killhdl2(old,&(pack->idroot),currRing);
1445  }
1446  else
1447  {
1448  rv->CleanUp();
1449  return TRUE;
1450  }
1451  }
1452  //Print("iiExport: pack=%s\n",IDID(root));
1453  if(iiInternalExport(v, toLev, pack))
1454  {
1455  rv->CleanUp();
1456  return TRUE;
1457  }
1458  }
1459  v=v->next;
1460  }
1461  rv->CleanUp();
1462  return nok;
1463 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:84
Subexpr e
Definition: subexpr.h:107
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:97
#define TRUE
Definition: auxiliary.h:101
int Typ()
Definition: subexpr.cc:979
Definition: idrec.h:34
idhdl get(const char *s, int lev)
Definition: ipid.cc:91
void * data
Definition: subexpr.h:90
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:403
char my_yylinebuf[80]
Definition: febase.cc:48
const char * name
Definition: subexpr.h:89
leftv next
Definition: subexpr.h:88
#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:1287
#define NULL
Definition: omList.c:10
package currPack
Definition: ipid.cc:63
int rtyp
Definition: subexpr.h:93
void CleanUp(ring r=currRing)
Definition: subexpr.cc:320
int BOOLEAN
Definition: auxiliary.h:88
#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 1485 of file ipshell.cc.

1486 {
1487  int i;
1488  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1489  poly po=NULL;
1491  {
1492  scComputeHC(I,currRing->qideal,ak,po);
1493  if (po!=NULL)
1494  {
1495  pGetCoeff(po)=nInit(1);
1496  for (i=rVar(currRing); i>0; i--)
1497  {
1498  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1499  }
1500  pSetComp(po,ak);
1501  pSetm(po);
1502  }
1503  }
1504  else
1505  po=pOne();
1506  return po;
1507 }
#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:163
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 1287 of file ipshell.cc.

1288 {
1289  idhdl h=(idhdl)v->data;
1290  //Print("iiInternalExport('%s',%d)%s\n", v->name, toLev,"");
1291  if (IDLEV(h)==0)
1292  {
1293  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(h));
1294  }
1295  else
1296  {
1297  h=IDROOT->get(v->name,toLev);
1298  idhdl *root=&IDROOT;
1299  if ((h==NULL)&&(currRing!=NULL))
1300  {
1301  h=currRing->idroot->get(v->name,toLev);
1302  root=&currRing->idroot;
1303  }
1304  BOOLEAN keepring=FALSE;
1305  if ((h!=NULL)&&(IDLEV(h)==toLev))
1306  {
1307  if (IDTYP(h)==v->Typ())
1308  {
1309  if ((IDTYP(h)==RING_CMD)
1310  && (v->Data()==IDDATA(h)))
1311  {
1312  IDRING(h)->ref++;
1313  keepring=TRUE;
1314  IDLEV(h)=toLev;
1315  //WarnS("keepring");
1316  return FALSE;
1317  }
1318  if (BVERBOSE(V_REDEFINE))
1319  {
1320  Warn("redefining %s (%s)",IDID(h),my_yylinebuf);
1321  }
1322  if (iiLocalRing[0]==IDRING(h) && (!keepring)) iiLocalRing[0]=NULL;
1323  killhdl2(h,root,currRing);
1324  }
1325  else
1326  {
1327  return TRUE;
1328  }
1329  }
1330  h=(idhdl)v->data;
1331  IDLEV(h)=toLev;
1332  if (keepring) IDRING(h)->ref--;
1334  //Print("export %s\n",IDID(h));
1335  }
1336  return FALSE;
1337 }
if(0 > strat->sl)
Definition: myNF.cc:73
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:97
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:101
int Typ()
Definition: subexpr.cc:979
Definition: idrec.h:34
void * data
Definition: subexpr.h:90
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:403
char my_yylinebuf[80]
Definition: febase.cc:48
const char * name
Definition: subexpr.h:89
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:82
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:1121
#define IDDATA(a)
Definition: ipid.h:123
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:88
#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 1339 of file ipshell.cc.

1340 {
1341  idhdl h=(idhdl)v->data;
1342  if(h==NULL)
1343  {
1344  Warn("'%s': no such identifier\n", v->name);
1345  return FALSE;
1346  }
1347  package frompack=v->req_packhdl;
1348  if (frompack==NULL) frompack=currPack;
1349  if ((RingDependend(IDTYP(h)))
1350  || ((IDTYP(h)==LIST_CMD)
1351  && (lRingDependend(IDLIST(h)))
1352  )
1353  )
1354  {
1355  //Print("// ==> Ringdependent set nesting to 0\n");
1356  return (iiInternalExport(v, toLev));
1357  }
1358  else
1359  {
1360  IDLEV(h)=toLev;
1361  v->req_packhdl=rootpack;
1362  if (h==frompack->idroot)
1363  {
1364  frompack->idroot=h->next;
1365  }
1366  else
1367  {
1368  idhdl hh=frompack->idroot;
1369  while ((hh!=NULL) && (hh->next!=h))
1370  hh=hh->next;
1371  if ((hh!=NULL) && (hh->next==h))
1372  hh->next=h->next;
1373  else
1374  {
1375  Werror("`%s` not found",v->Name());
1376  return TRUE;
1377  }
1378  }
1379  h->next=rootpack->idroot;
1380  rootpack->idroot=h;
1381  }
1382  return FALSE;
1383 }
#define IDLIST(a)
Definition: ipid.h:134
#define FALSE
Definition: auxiliary.h:97
#define TRUE
Definition: auxiliary.h:101
const char * Name()
Definition: subexpr.h:122
Definition: idrec.h:34
void * data
Definition: subexpr.h:90
#define IDTYP(a)
Definition: ipid.h:116
int RingDependend(int t)
Definition: gentable.cc:23
const char * name
Definition: subexpr.h:89
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:1287
#define NULL
Definition: omList.c:10
package req_packhdl
Definition: subexpr.h:108
package currPack
Definition: ipid.cc:63
Definition: tok.h:116
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 768 of file ipshell.cc.

770 {
771  lists L=liMakeResolv(r,length,rlen,typ0,weights);
772  int i=0;
773  idhdl h;
774  char * s=(char *)omAlloc(strlen(name)+5);
775 
776  while (i<=L->nr)
777  {
778  sprintf(s,"%s(%d)",name,i+1);
779  if (i==0)
780  h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
781  else
782  h=enterid(s,myynest,MODUL_CMD,&(currRing->idroot), FALSE);
783  if (h!=NULL)
784  {
785  h->data.uideal=(ideal)L->m[i].data;
786  h->attribute=L->m[i].attribute;
788  Print("//defining: %s as %d-th syzygy module\n",s,i+1);
789  }
790  else
791  {
792  idDelete((ideal *)&(L->m[i].data));
793  Warn("cannot define %s",s);
794  }
795  //L->m[i].data=NULL;
796  //L->m[i].rtyp=0;
797  //L->m[i].attribute=NULL;
798  i++;
799  }
800  omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
802  omFreeSize((ADDRESS)s,strlen(name)+5);
803 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:84
#define Print
Definition: emacs.cc:83
#define idDelete(H)
delete an ideal
Definition: ideals.h:31
Definition: lists.h:22
if(0 > strat->sl)
Definition: myNF.cc:73
#define FALSE
Definition: auxiliary.h:97
#define V_DEF_RES
Definition: options.h:48
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:118
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: idrec.h:34
void * data
Definition: subexpr.h:90
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:259
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:91
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 609 of file ipshell.cc.

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

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

§ iiParameter()

BOOLEAN iiParameter ( leftv  p)

Definition at line 1251 of file ipshell.cc.

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

§ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 958 of file ipshell.cc.

959 {
960  int len,reg,typ0;
961 
962  resolvente r=liFindRes(L,&len,&typ0);
963 
964  if (r==NULL)
965  return -2;
966  intvec *weights=NULL;
967  int add_row_shift=0;
968  intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
969  if (ww!=NULL)
970  {
971  weights=ivCopy(ww);
972  add_row_shift = ww->min_in();
973  (*weights) -= add_row_shift;
974  }
975  //Print("attr:%x\n",weights);
976 
977  intvec *dummy=syBetti(r,len,&reg,weights);
978  if (weights!=NULL) delete weights;
979  delete dummy;
980  omFreeSize((ADDRESS)r,len*sizeof(ideal));
981  return reg+1+add_row_shift;
982 }
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:118
int min_in()
Definition: intvec.h:113
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
Definition: tok.h:99
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:135
#define NULL
Definition: omList.c:10
ideal * resolvente
Definition: ideals.h:20
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:791

§ iiReportTypes()

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

Definition at line 6442 of file ipshell.cc.

6443 {
6444  char *buf=(char*)omAlloc(250);
6445  buf[0]='\0';
6446  if (nr==0)
6447  sprintf(buf,"wrong length of parameters(%d), expected ",t);
6448  else
6449  sprintf(buf,"par. %d is of type `%s`, expected ",nr,Tok2Cmdname(t));
6450  for(int i=1;i<=T[0];i++)
6451  {
6452  strcat(buf,"`");
6453  strcat(buf,Tok2Cmdname(T[i]));
6454  strcat(buf,"`");
6455  if (i<T[0]) strcat(buf,",");
6456  }
6457  WerrorS(buf);
6458 }
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define omAlloc(size)
Definition: omAllocDecl.h:210
int status int void * buf
Definition: si_signals.h:59
int i
Definition: cfEzgcd.cc:123
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:128
static jList * T
Definition: janet.cc:37

§ iiTestAssume()

BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6341 of file ipshell.cc.

6342 {
6343  // assume a: level
6344  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6345  {
6346  if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6347  char assume_yylinebuf[80];
6348  strncpy(assume_yylinebuf,my_yylinebuf,79);
6349  int lev=(long)a->Data();
6350  int startlev=0;
6351  idhdl h=ggetid("assumeLevel");
6352  if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6353  if(lev <=startlev)
6354  {
6355  BOOLEAN bo=b->Eval();
6356  if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6357  if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6358  if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6359  }
6360  }
6361  b->CleanUp();
6362  a->CleanUp();
6363  return FALSE;
6364 }
int Eval()
Definition: subexpr.cc:1744
Definition: tok.h:94
#define FALSE
Definition: auxiliary.h:97
#define TRUE
Definition: auxiliary.h:101
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define WarnS
Definition: emacs.cc:81
int Typ()
Definition: subexpr.cc:979
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:320
void * Data()
Definition: subexpr.cc:1121
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:88
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:490

§ iiTwoOps()

const char* iiTwoOps ( int  t)

Definition at line 86 of file ipshell.cc.

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

§ iiWRITE()

BOOLEAN iiWRITE ( leftv  ,
leftv  v 
)

Definition at line 582 of file ipshell.cc.

583 {
584  sleftv vf;
585  if (iiConvert(v->Typ(),LINK_CMD,iiTestConvert(v->Typ(),LINK_CMD),v,&vf))
586  {
587  WerrorS("link expected");
588  return TRUE;
589  }
590  si_link l=(si_link)vf.Data();
591  if (vf.next == NULL)
592  {
593  WerrorS("write: need at least two arguments");
594  return TRUE;
595  }
596 
597  BOOLEAN b=slWrite(l,vf.next); /* iiConvert preserves next */
598  if (b)
599  {
600  const char *s;
601  if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
602  else s=sNoName;
603  Werror("cannot write to %s",s);
604  }
605  vf.CleanUp();
606  return b;
607 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
int iiTestConvert(int inputType, int outputType)
Definition: gentable.cc:292
Class used for (list of) interpreter objects.
Definition: subexpr.h:84
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, const struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:360
const char sNoName[]
Definition: subexpr.cc:56
#define TRUE
Definition: auxiliary.h:101
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:979
leftv next
Definition: subexpr.h:88
Definition: tok.h:115
#define NULL
Definition: omList.c:10
void CleanUp(ring r=currRing)
Definition: subexpr.cc:320
void * Data()
Definition: subexpr.cc:1121
int BOOLEAN
Definition: auxiliary.h:88
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 888 of file ipshell.cc.

889 {
890  sleftv tmp;
891  memset(&tmp,0,sizeof(tmp));
892  tmp.rtyp=INT_CMD;
893  tmp.data=(void *)1;
894  if ((u->Typ()==IDEAL_CMD)
895  || (u->Typ()==MODUL_CMD))
896  return jjBETTI2_ID(res,u,&tmp);
897  else
898  return jjBETTI2(res,u,&tmp);
899 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:84
Definition: tok.h:94
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:922
int Typ()
Definition: subexpr.cc:979
void * data
Definition: subexpr.h:90
int rtyp
Definition: subexpr.h:93
BOOLEAN jjBETTI2_ID(leftv res, leftv u, leftv v)
Definition: ipshell.cc:901

§ jjBETTI2()

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

Definition at line 922 of file ipshell.cc.

923 {
924  resolvente r;
925  int len;
926  int reg,typ0;
927  lists l=(lists)u->Data();
928 
929  intvec *weights=NULL;
930  int add_row_shift=0;
931  intvec *ww=NULL;
932  if (l->nr>=0) ww=(intvec *)atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
933  if (ww!=NULL)
934  {
935  weights=ivCopy(ww);
936  add_row_shift = ww->min_in();
937  (*weights) -= add_row_shift;
938  }
939  //Print("attr:%x\n",weights);
940 
941  r=liFindRes(l,&len,&typ0);
942  if (r==NULL) return TRUE;
943  intvec* res_im=syBetti(r,len,&reg,weights,(int)(long)v->Data());
944  res->data=(void*)res_im;
945  omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
946  //Print("rowShift: %d ",add_row_shift);
947  for(int i=1;i<=res_im->rows();i++)
948  {
949  if (IMATELEM(*res_im,1,i)==0) { add_row_shift--; }
950  else break;
951  }
952  //Print(" %d\n",add_row_shift);
953  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
954  if (weights!=NULL) delete weights;
955  return FALSE;
956 }
sleftv * m
Definition: lists.h:45
void atSet(idhdl root, const char *name, void *data, int typ)
Definition: attrib.cc:156
Definition: tok.h:94
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:312
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:97
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:101
void * ADDRESS
Definition: auxiliary.h:118
int min_in()
Definition: intvec.h:113
void * data
Definition: subexpr.h:90
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
int i
Definition: cfEzgcd.cc:123
Definition: tok.h:99
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:1121
ideal * resolvente
Definition: ideals.h:20
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 901 of file ipshell.cc.

902 {
904  l->Init(1);
905  l->m[0].rtyp=u->Typ();
906  l->m[0].data=u->Data();
907  attr *a=u->Attribute();
908  if (a!=NULL)
909  l->m[0].attribute=*a;
910  sleftv tmp2;
911  memset(&tmp2,0,sizeof(tmp2));
912  tmp2.rtyp=LIST_CMD;
913  tmp2.data=(void *)l;
914  BOOLEAN r=jjBETTI2(res,&tmp2,v);
915  l->m[0].data=NULL;
916  l->m[0].attribute=NULL;
917  l->m[0].rtyp=DEF_CMD;
918  l->Clean();
919  return r;
920 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:84
const poly a
Definition: syzextra.cc:212
Definition: attrib.h:15
Definition: lists.h:22
attr * Attribute()
Definition: subexpr.cc:1376
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:922
int Typ()
Definition: subexpr.cc:979
void * data
Definition: subexpr.h:90
const ring r
Definition: syzextra.cc:208
Definition: tok.h:57
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:93
void Clean(ring r=currRing)
Definition: lists.h:25
void * Data()
Definition: subexpr.cc:1121
Definition: tok.h:116
attr attribute
Definition: subexpr.h:91
omBin slists_bin
Definition: lists.cc:23
int BOOLEAN
Definition: auxiliary.h:88
int l
Definition: cfEzgcd.cc:94

§ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3252 of file ipshell.cc.

3253 {
3254  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3255  return (res->data==NULL);
3256 }
void * data
Definition: subexpr.h:90
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:1121

§ jjINT_S_TO_ID()

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

Definition at line 6184 of file ipshell.cc.

6185 {
6186  if (n==0) n=1;
6187  ideal l=idInit(n,1);
6188  int i;
6189  poly p;
6190  for(i=rVar(currRing);i>0;i--)
6191  {
6192  if (e[i]>0)
6193  {
6194  n--;
6195  p=pOne();
6196  pSetExp(p,i,1);
6197  pSetm(p);
6198  l->m[n]=p;
6199  if (n==0) break;
6200  }
6201  }
6202  res->data=(char*)l;
6203  setFlag(res,FLAG_STD);
6204  omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
6205 }
#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:118
void * data
Definition: subexpr.h:90
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 867 of file ipshell.cc.

868 {
869  int len=0;
870  int typ0;
871  lists L=(lists)v->Data();
872  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
873  int add_row_shift = 0;
874  if (weights==NULL)
875  weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
876  if (weights!=NULL) add_row_shift=weights->min_in();
877  resolvente rr=liFindRes(L,&len,&typ0);
878  if (rr==NULL) return TRUE;
879  resolvente r=iiCopyRes(rr,len);
880 
881  syMinimizeResolvente(r,len,0);
882  omFreeSize((ADDRESS)rr,len*sizeof(ideal));
883  len++;
884  res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
885  return FALSE;
886 }
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:97
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:101
void * ADDRESS
Definition: auxiliary.h:118
int min_in()
Definition: intvec.h:113
void * data
Definition: subexpr.h:90
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
static resolvente iiCopyRes(resolvente r, int l)
Definition: ipshell.cc:857
Definition: tok.h:99
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:1121
ideal * resolvente
Definition: ideals.h:20

§ 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:84
Subexpr e
Definition: subexpr.h:107
#define FALSE
Definition: auxiliary.h:97
sleftv iiRETURNEXPR
Definition: iplib.cc:471
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define TRUE
Definition: auxiliary.h:101
void Init()
Definition: subexpr.h:109
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:31
void * data
Definition: subexpr.h:90
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:108
package currPack
Definition: ipid.cc:63
int rtyp
Definition: subexpr.h:93
void * Data()
Definition: subexpr.cc:1121
int typ
Definition: idrec.h:43
const char * id
Definition: idrec.h:39
int BOOLEAN
Definition: auxiliary.h:88
#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 3245 of file ipshell.cc.

3246 {
3247  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3248  (poly)w->CopyD(), currRing);
3249  return errorreported;
3250 }
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition: clapsing.cc:317
void * data
Definition: subexpr.h:90
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:679

§ jjVARIABLES_ID()

BOOLEAN jjVARIABLES_ID ( leftv  res,
leftv  u 
)

Definition at line 6214 of file ipshell.cc.

6215 {
6216  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6217  ideal I=(ideal)u->Data();
6218  int i;
6219  int n=0;
6220  for(i=I->nrows*I->ncols-1;i>=0;i--)
6221  {
6222  int n0=pGetVariables(I->m[i],e);
6223  if (n0>n) n=n0;
6224  }
6225  jjINT_S_TO_ID(n,e,res);
6226  return FALSE;
6227 }
#define FALSE
Definition: auxiliary.h:97
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:6184
#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:1121
#define omAlloc0(size)
Definition: omAllocDecl.h:211

§ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6206 of file ipshell.cc.

6207 {
6208  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6209  int n=pGetVariables((poly)u->Data(),e);
6210  jjINT_S_TO_ID(n,e,res);
6211  return FALSE;
6212 }
#define FALSE
Definition: auxiliary.h:97
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:6184
#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:1121
polyrec * poly
Definition: hilb.h:10
#define omAlloc0(size)
Definition: omAllocDecl.h:211

§ kGroebner()

ideal kGroebner ( ideal  F,
ideal  Q 
)

Definition at line 6139 of file ipshell.cc.

6140 {
6141  //test|=Sy_bit(OPT_PROT);
6142  idhdl save_ringhdl=currRingHdl;
6143  ideal resid;
6144  idhdl new_ring=NULL;
6145  if ((currRingHdl==NULL) || (IDRING(currRingHdl)!=currRing))
6146  {
6147  currRingHdl=enterid(omStrDup(" GROEBNERring"),0,RING_CMD,&IDROOT,FALSE);
6148  new_ring=currRingHdl;
6150  }
6151  sleftv v; memset(&v,0,sizeof(v)); v.rtyp=IDEAL_CMD; v.data=(char *) F;
6152  idhdl h=ggetid("groebner");
6153  sleftv u; memset(&u,0,sizeof(u)); u.rtyp=IDHDL; u.data=(char *) h;
6154  u.name=IDID(h);
6155 
6156  sleftv res; memset(&res,0,sizeof(res));
6157  if(jjPROC(&res,&u,&v))
6158  {
6159  resid=kStd(F,Q,testHomog,NULL);
6160  }
6161  else
6162  {
6163  //printf("typ:%d\n",res.rtyp);
6164  resid=(ideal)(res.data);
6165  }
6166  // cleanup GROEBNERring, save_ringhdl, u,v,(res )
6167  if (new_ring!=NULL)
6168  {
6169  idhdl h=IDROOT;
6170  if (h==new_ring) IDROOT=h->next;
6171  else
6172  {
6173  while ((h!=NULL) &&(h->next!=new_ring)) h=h->next;
6174  if (h!=NULL) h->next=h->next->next;
6175  }
6176  if (h!=NULL) omFreeSize(h,sizeof(*h));
6177  }
6178  currRingHdl=save_ringhdl;
6179  u.CleanUp();
6180  v.CleanUp();
6181  return resid;
6182 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:84
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:97
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:90
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:259
const char * name
Definition: subexpr.h:89
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:93
void CleanUp(ring r=currRing)
Definition: subexpr.cc:320
static Poly * h
Definition: janet.cc:978
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:490
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ killlocals()

void killlocals ( int  v)

Definition at line 376 of file ipshell.cc.

377 {
378  BOOLEAN changed=FALSE;
379  idhdl sh=currRingHdl;
380  ring cr=currRing;
381  if (sh!=NULL) changed=((IDLEV(sh)<v) || (IDRING(sh)->ref>0));
382  //if (changed) Print("currRing=%s(%x), lev=%d,ref=%d\n",IDID(sh),IDRING(sh),IDLEV(sh),IDRING(sh)->ref);
383 
384  killlocals_rec(&(basePack->idroot),v,currRing);
385 
387  {
388  int t=iiRETURNEXPR.Typ();
389  if (/*iiRETURNEXPR.Typ()*/ t==RING_CMD)
390  {
392  if (((ring)h->data)->idroot!=NULL)
393  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
394  }
395  else if (/*iiRETURNEXPR.Typ()*/ t==LIST_CMD)
396  {
397  leftv h=&iiRETURNEXPR;
398  changed |=killlocals_list(v,(lists)h->data);
399  }
400  }
401  if (changed)
402  {
404  if (currRingHdl==NULL)
405  currRing=NULL;
406  else if(cr!=currRing)
407  rChangeCurrRing(cr);
408  }
409 
410  if (myynest<=1) iiNoKeepRing=TRUE;
411  //Print("end killlocals >= %d\n",v);
412  //listall();
413 }
int iiRETURNEXPR_len
Definition: iplib.cc:472
Class used for (list of) interpreter objects.
Definition: subexpr.h:84
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:97
sleftv iiRETURNEXPR
Definition: iplib.cc:471
#define TRUE
Definition: auxiliary.h:101
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:320
int Typ()
Definition: subexpr.cc:979
Definition: idrec.h:34
void * data
Definition: subexpr.h:90
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:356
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:82
idhdl currRingHdl
Definition: ipid.cc:65
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1568
#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:116
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:88
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:285

§ killlocals0()

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

Definition at line 285 of file ipshell.cc.

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

357 {
358  if (L==NULL) return FALSE;
359  BOOLEAN changed=FALSE;
360  int n=L->nr;
361  for(;n>=0;n--)
362  {
363  leftv h=&(L->m[n]);
364  void *d=h->data;
365  if ((h->rtyp==RING_CMD)
366  && (((ring)d)->idroot!=NULL))
367  {
368  if (d!=currRing) {changed=TRUE;rChangeCurrRing((ring)d);}
369  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
370  }
371  else if (h->rtyp==LIST_CMD)
372  changed|=killlocals_list(v,(lists)d);
373  }
374  return changed;
375 }
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:84
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:97
#define TRUE
Definition: auxiliary.h:101
void * data
Definition: subexpr.h:90
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:356
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:93
Definition: tok.h:116
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:88
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:285

§ killlocals_rec()

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

Definition at line 320 of file ipshell.cc.

321 {
322  idhdl h=*root;
323  while (h!=NULL)
324  {
325  if (IDLEV(h)>=v)
326  {
327 // Print("kill %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
328  idhdl n=IDNEXT(h);
329  killhdl2(h,root,r);
330  h=n;
331  }
332  else if (IDTYP(h)==PACKAGE_CMD)
333  {
334  // Print("into pack %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
335  if (IDPACKAGE(h)!=basePack)
336  killlocals_rec(&(IDRING(h)->idroot),v,r);
337  h=IDNEXT(h);
338  }
339  else if (IDTYP(h)==RING_CMD)
340  {
341  if ((IDRING(h)!=NULL) && (IDRING(h)->idroot!=NULL))
342  // we have to test IDRING(h)!=NULL: qring Q=groebner(...): killlocals
343  {
344  // Print("into ring %s, lev %d for lev %d\n",IDID(h),IDLEV(h),v);
345  killlocals_rec(&(IDRING(h)->idroot),v,IDRING(h));
346  }
347  h=IDNEXT(h);
348  }
349  else
350  {
351 // Print("skip %s lev %d for lev %d\n",IDID(h),IDLEV(h),v);
352  h=IDNEXT(h);
353  }
354  }
355 }
#define IDNEXT(a)
Definition: ipid.h:115
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:320
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:403
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 3228 of file ipshell.cc.

3229 {
3230  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3231  if (res->data==NULL)
3232  res->data=(char *)new intvec(rVar(currRing));
3233  return FALSE;
3234 }
#define FALSE
Definition: auxiliary.h:97
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:90
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:1121

§ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3206 of file ipshell.cc.

3207 {
3208  ideal F=(ideal)id->Data();
3209  intvec * iv = new intvec(rVar(currRing));
3210  polyset s;
3211  int sl, n, i;
3212  int *x;
3213 
3214  res->data=(char *)iv;
3215  s = F->m;
3216  sl = IDELEMS(F) - 1;
3217  n = rVar(currRing);
3218  double wNsqr = (double)2.0 / (double)n;
3220  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3221  wCall(s, sl, x, wNsqr, currRing);
3222  for (i = n; i!=0; i--)
3223  (*iv)[i-1] = x[i + n + 1];
3224  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3225  return FALSE;
3226 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define FALSE
Definition: auxiliary.h:97
#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:118
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:90
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:1121
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 147 of file ipshell.cc.

148 {
149  char buffer[22];
150  int l;
151  char buf2[128];
152 
153  if(fullname) sprintf(buf2, "%s::%s", "", IDID(h));
154  else sprintf(buf2, "%s", IDID(h));
155 
156  Print("%s%-30.30s [%d] ",s,buf2,IDLEV(h));
157  if (h == currRingHdl) PrintS("*");
158  PrintS(Tok2Cmdname((int)IDTYP(h)));
159 
160  ipListFlag(h);
161  switch(IDTYP(h))
162  {
163  case ALIAS_CMD: Print(" for %s",IDID((idhdl)IDDATA(h))); break;
164  case INT_CMD: Print(" %d",IDINT(h)); break;
165  case INTVEC_CMD:Print(" (%d)",IDINTVEC(h)->length()); break;
166  case INTMAT_CMD:Print(" %d x %d",IDINTVEC(h)->rows(),IDINTVEC(h)->cols());
167  break;
168  case POLY_CMD:
169  case VECTOR_CMD:if (c)
170  {
171  PrintS(" ");wrp(IDPOLY(h));
172  if(IDPOLY(h) != NULL)
173  {
174  Print(", %d monomial(s)",pLength(IDPOLY(h)));
175  }
176  }
177  break;
178  case MODUL_CMD: Print(", rk %d", (int)(IDIDEAL(h)->rank));
179  case IDEAL_CMD: Print(", %u generator(s)",
180  IDELEMS(IDIDEAL(h))); break;
181  case MAP_CMD:
182  Print(" from %s",IDMAP(h)->preimage); break;
183  case MATRIX_CMD:Print(" %u x %u"
184  ,MATROWS(IDMATRIX(h))
185  ,MATCOLS(IDMATRIX(h))
186  );
187  break;
188  case PACKAGE_CMD:
189  paPrint(IDID(h),IDPACKAGE(h));
190  break;
191  case PROC_CMD: if((IDPROC(h)->libname!=NULL)
192  && (strlen(IDPROC(h)->libname)>0))
193  Print(" from %s",IDPROC(h)->libname);
194  if(IDPROC(h)->is_static)
195  PrintS(" (static)");
196  break;
197  case STRING_CMD:
198  {
199  char *s;
200  l=strlen(IDSTRING(h));
201  memset(buffer,0,22);
202  strncpy(buffer,IDSTRING(h),si_min(l,20));
203  if ((s=strchr(buffer,'\n'))!=NULL)
204  {
205  *s='\0';
206  }
207  PrintS(" ");
208  PrintS(buffer);
209  if((s!=NULL) ||(l>20))
210  {
211  Print("..., %d char(s)",l);
212  }
213  break;
214  }
215  case LIST_CMD: Print(", size: %d",IDLIST(h)->nr+1);
216  break;
217  case RING_CMD:
218  if ((IDRING(h)==currRing) && (currRingHdl!=h))
219  PrintS("(*)"); /* this is an alias to currRing */
220 #ifdef RDEBUG
222  Print(" <%lx>",(long)(IDRING(h)));
223 #endif
224  break;
225 #ifdef SINGULAR_4_1
226  case CNUMBER_CMD:
227  { number2 n=(number2)IDDATA(h);
228  Print(" (%s)",nCoeffName(n->cf));
229  break;
230  }
231  case CMATRIX_CMD:
232  { bigintmat *b=(bigintmat*)IDDATA(h);
233  Print(" %d x %d (%s)",
234  b->rows(),b->cols(),
235  nCoeffName(b->basecoeffs()));
236  break;
237  }
238 #endif
239  /*default: break;*/
240  }
241  PrintLn();
242 }
#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:94
#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:124
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
static int pLength(poly a)
Definition: p_polys.h:189
Definition: idrec.h:34
void ipListFlag(idhdl h)
Definition: ipid.cc:519
#define IDPACKAGE(a)
Definition: ipid.h: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
Definition: tok.h:99
#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:6229
#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:128
#define IDPOLY(a)
Definition: ipid.h:127
coeffs basecoeffs() const
Definition: bigintmat.h:147
#define IDRING(a)
Definition: ipid.h:124
Definition: tok.h:116
#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 415 of file ipshell.cc.

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

§ list_error()

void list_error ( semicState  state)

Definition at line 3373 of file ipshell.cc.

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

§ list_is_spectrum()

semicState list_is_spectrum ( lists  l)

Definition at line 4158 of file ipshell.cc.

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

§ listOfRoots()

lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 4970 of file ipshell.cc.

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

§ loNewtonP()

BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4468 of file ipshell.cc.

4469 {
4470  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4471  return FALSE;
4472 }
#define FALSE
Definition: auxiliary.h:97
ideal loNewtonPolytope(const ideal id)
Definition: mpr_base.cc:3190
void * data
Definition: subexpr.h:90
void * Data()
Definition: subexpr.cc:1121

§ loSimplex()

BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4474 of file ipshell.cc.

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

§ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 2976 of file ipshell.cc.

2977 {
2978  int i,j;
2979  matrix result;
2980  ideal id=(ideal)a->Data();
2981 
2982  result =mpNew(IDELEMS(id),rVar(currRing));
2983  for (i=1; i<=IDELEMS(id); i++)
2984  {
2985  for (j=1; j<=rVar(currRing); j++)
2986  {
2987  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
2988  }
2989  }
2990  res->data=(char *)result;
2991  return FALSE;
2992 }
#define FALSE
Definition: auxiliary.h:97
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:580
void * data
Definition: subexpr.h:90
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:48
void * Data()
Definition: subexpr.cc:1121
#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 2998 of file ipshell.cc.

2999 {
3000  int n=(int)(long)b->Data();
3001  int d=(int)(long)c->Data();
3002  int k,l,sign,row,col;
3003  matrix result;
3004  ideal temp;
3005  BOOLEAN bo;
3006  poly p;
3007 
3008  if ((d>n) || (d<1) || (n<1))
3009  {
3010  res->data=(char *)mpNew(1,1);
3011  return FALSE;
3012  }
3013  int *choise = (int*)omAlloc(d*sizeof(int));
3014  if (id==NULL)
3015  temp=idMaxIdeal(1);
3016  else
3017  temp=(ideal)id->Data();
3018 
3019  k = binom(n,d);
3020  l = k*d;
3021  l /= n-d+1;
3022  result =mpNew(l,k);
3023  col = 1;
3024  idInitChoise(d,1,n,&bo,choise);
3025  while (!bo)
3026  {
3027  sign = 1;
3028  for (l=1;l<=d;l++)
3029  {
3030  if (choise[l-1]<=IDELEMS(temp))
3031  {
3032  p = pCopy(temp->m[choise[l-1]-1]);
3033  if (sign == -1) p = pNeg(p);
3034  sign *= -1;
3035  row = idGetNumberOfChoise(l-1,d,1,n,choise);
3036  MATELEM(result,row,col) = p;
3037  }
3038  }
3039  col++;
3040  idGetNextChoise(d,n,&bo,choise);
3041  }
3042  if (id==NULL) idDelete(&temp);
3043 
3044  res->data=(char *)result;
3045  return FALSE;
3046 }
#define idMaxIdeal(D)
initialise the maximal ideal (at 0)
Definition: ideals.h:35
#define idDelete(H)
delete an ideal
Definition: ideals.h:31
#define FALSE
Definition: auxiliary.h:97
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:90
void idGetNextChoise(int r, int end, BOOLEAN *endch, int *choise)
#define IDELEMS(i)
Definition: simpleideals.h:24
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:48
#define NULL
Definition: omList.c:10
void idInitChoise(int r, int beg, int end, BOOLEAN *endch, int *choise)
void * Data()
Definition: subexpr.cc:1121
int idGetNumberOfChoise(int t, int d, int begin, int end, int *choise)
polyrec * poly
Definition: hilb.h:10
int BOOLEAN
Definition: auxiliary.h:88
static int sign(int x)
Definition: ring.cc:3412
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 4583 of file ipshell.cc.

4584 {
4585 
4586  poly gls;
4587  gls= (poly)(arg1->Data());
4588  int howclean= (int)(long)arg3->Data();
4589 
4590  if ( !(rField_is_R(currRing) ||
4591  rField_is_Q(currRing) ||
4594  {
4595  WerrorS("Ground field not implemented!");
4596  return TRUE;
4597  }
4598 
4601  {
4602  unsigned long int ii = (unsigned long int)arg2->Data();
4603  setGMPFloatDigits( ii, ii );
4604  }
4605 
4606  if ( gls == NULL || pIsConstant( gls ) )
4607  {
4608  WerrorS("Input polynomial is constant!");
4609  return TRUE;
4610  }
4611 
4612  int ldummy;
4613  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4614  int i,vpos=0;
4615  poly piter;
4616  lists elist;
4617  lists rlist;
4618 
4619  elist= (lists)omAlloc( sizeof(slists) );
4620  elist->Init( 0 );
4621 
4622  if ( rVar(currRing) > 1 )
4623  {
4624  piter= gls;
4625  for ( i= 1; i <= rVar(currRing); i++ )
4626  if ( pGetExp( piter, i ) )
4627  {
4628  vpos= i;
4629  break;
4630  }
4631  while ( piter )
4632  {
4633  for ( i= 1; i <= rVar(currRing); i++ )
4634  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4635  {
4636  WerrorS("The input polynomial must be univariate!");
4637  return TRUE;
4638  }
4639  pIter( piter );
4640  }
4641  }
4642 
4643  rootContainer * roots= new rootContainer();
4644  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4645  piter= gls;
4646  for ( i= deg; i >= 0; i-- )
4647  {
4648  if ( piter && pTotaldegree(piter) == i )
4649  {
4650  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4651  //nPrint( pcoeffs[i] );PrintS(" ");
4652  pIter( piter );
4653  }
4654  else
4655  {
4656  pcoeffs[i]= nInit(0);
4657  }
4658  }
4659 
4660 #ifdef mprDEBUG_PROT
4661  for (i=deg; i >= 0; i--)
4662  {
4663  nPrint( pcoeffs[i] );PrintS(" ");
4664  }
4665  PrintLn();
4666 #endif
4667 
4668  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4669  roots->solver( howclean );
4670 
4671  int elem= roots->getAnzRoots();
4672  char *dummy;
4673  int j;
4674 
4675  rlist= (lists)omAlloc( sizeof(slists) );
4676  rlist->Init( elem );
4677 
4679  {
4680  for ( j= 0; j < elem; j++ )
4681  {
4682  rlist->m[j].rtyp=NUMBER_CMD;
4683  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4684  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4685  }
4686  }
4687  else
4688  {
4689  for ( j= 0; j < elem; j++ )
4690  {
4691  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4692  rlist->m[j].rtyp=STRING_CMD;
4693  rlist->m[j].data=(void *)dummy;
4694  }
4695  }
4696 
4697  elist->Clean();
4698  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4699 
4700  // this is (via fillContainer) the same data as in root
4701  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4702  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4703 
4704  delete roots;
4705 
4706  res->rtyp= LIST_CMD;
4707  res->data= (void*)rlist;
4708 
4709  return FALSE;
4710 }
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:97
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:101
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:90
#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:93
#define nCopy(n)
Definition: numbers.h:15
void Clean(ring r=currRing)
Definition: lists.h:25
void * Data()
Definition: subexpr.cc:1121
Definition: tok.h:116
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition: mpr_complex.cc:717
size_t gmp_output_digits
Definition: mpr_complex.cc:44
void setGMPFloatDigits(size_t digits, size_t rest)
Set size of mantissa digits - the number of output digits (basis 10) the size of mantissa consists of...
Definition: mpr_complex.cc:62
polyrec * poly
Definition: hilb.h:10
#define nInit(i)
Definition: numbers.h:24

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

4561 {
4562  ideal gls = (ideal)(arg1->Data());
4563  int imtype= (int)(long)arg2->Data();
4564 
4565  uResultant::resMatType mtype= determineMType( imtype );
4566 
4567  // check input ideal ( = polynomial system )
4568  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4569  {
4570  return TRUE;
4571  }
4572 
4573  uResultant *resMat= new uResultant( gls, mtype, false );
4574  if (resMat!=NULL)
4575  {
4576  res->rtyp = MODUL_CMD;
4577  res->data= (void*)resMat->accessResMat()->getMatrix();
4578  if (!errorreported) delete resMat;
4579  }
4580  return errorreported;
4581 }
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:101
uResultant::resMatType determineMType(int imtype)
const char * Name()
Definition: subexpr.h:122
Definition: mpr_base.h:98
void * data
Definition: subexpr.h:90
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:93
void * Data()
Definition: subexpr.cc:1121

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

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

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

6230 {
6231  Print(" %s (",n);
6232  switch (p->language)
6233  {
6234  case LANG_SINGULAR: PrintS("S"); break;
6235  case LANG_C: PrintS("C"); break;
6236  case LANG_TOP: PrintS("T"); break;
6237  case LANG_NONE: PrintS("N"); break;
6238  default: PrintS("U");
6239  }
6240  if(p->libname!=NULL)
6241  Print(",%s", p->libname);
6242  PrintS(")");
6243 }
#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 2708 of file ipshell.cc.

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

§ rComposeC()

void rComposeC ( lists  L,
ring  R 
)

Definition at line 2208 of file ipshell.cc.

2210 {
2211  // ----------------------------------------
2212  // 0: char/ cf - ring
2213  if ((L->m[0].rtyp!=INT_CMD) || (L->m[0].data!=(char *)0))
2214  {
2215  WerrorS("invalid coeff. field description, expecting 0");
2216  return;
2217  }
2218 // R->cf->ch=0;
2219  // ----------------------------------------
2220  // 1:
2221  if (L->m[1].rtyp!=LIST_CMD)
2222  {
2223  WerrorS("invalid coeff. field description, expecting precision list");
2224  return;
2225  }
2226  lists LL=(lists)L->m[1].data;
2227  if (((LL->nr!=2)
2228  || (LL->m[0].rtyp!=INT_CMD)
2229  || (LL->m[1].rtyp!=INT_CMD))
2230  && ((LL->nr!=1)
2231  || (LL->m[0].rtyp!=INT_CMD)))
2232  {
2233  WerrorS("invalid coeff. field description list");
2234  return;
2235  }
2236  int r1=(int)(long)LL->m[0].data;
2237  int r2=(int)(long)LL->m[1].data;
2238  if (L->nr==2) // complex
2239  R->cf = nInitChar(n_long_C, NULL);
2240  else if ((r1<=SHORT_REAL_LENGTH)
2241  && (r2=SHORT_REAL_LENGTH))
2242  R->cf = nInitChar(n_R, NULL);
2243  else
2244  {
2246  p->float_len=r1;
2247  p->float_len2=r2;
2248  R->cf = nInitChar(n_long_R, NULL);
2249  }
2250 
2251  if ((r1<=SHORT_REAL_LENGTH) // should go into nInitChar
2252  && (r2=SHORT_REAL_LENGTH))
2253  {
2254  R->cf->float_len=SHORT_REAL_LENGTH/2;
2255  R->cf->float_len2=SHORT_REAL_LENGTH;
2256  }
2257  else
2258  {
2259  R->cf->float_len=si_min(r1,32767);
2260  R->cf->float_len2=si_min(r2,32767);
2261  }
2262  // ----------------------------------------
2263  // 2: list (par)
2264  if (L->nr==2)
2265  {
2266  //R->cf->extRing->N=1;
2267  if (L->m[2].rtyp!=STRING_CMD)
2268  {
2269  WerrorS("invalid coeff. field description, expecting parameter name");
2270  return;
2271  }
2272  //(rParameter(R))=(char**)omAlloc0(rPar(R)*sizeof(char_ptr));
2273  rParameter(R)[0]=omStrDup((char *)L->m[2].data);
2274  }
2275  // ----------------------------------------
2276 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:94
#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:124
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:90
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:93
Definition: tok.h:116
#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:329
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ rComposeOrder()

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

Definition at line 2458 of file ipshell.cc.

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

2281 {
2282  // ----------------------------------------
2283  // 0: string: integer
2284  // no further entries --> Z
2285  mpz_ptr modBase = NULL;
2286  unsigned int modExponent = 1;
2287 
2288  modBase = (mpz_ptr) omAlloc(sizeof(mpz_t));
2289  if (L->nr == 0)
2290  {
2291  mpz_init_set_ui(modBase,0);
2292  modExponent = 1;
2293  }
2294  // ----------------------------------------
2295  // 1:
2296  else
2297  {
2298  if (L->m[1].rtyp!=LIST_CMD) WerrorS("invalid data, expecting list of numbers");
2299  lists LL=(lists)L->m[1].data;
2300  if ((LL->nr >= 0) && LL->m[0].rtyp == BIGINT_CMD)
2301  {
2302  number tmp= (number) LL->m[0].data; // never use CopyD() on list elements
2303  // assume that tmp is integer, not rational
2304  n_MPZ (modBase, tmp, coeffs_BIGINT);
2305  }
2306  else if (LL->nr >= 0 && LL->m[0].rtyp == INT_CMD)
2307  {
2308  mpz_init_set_ui(modBase,(unsigned long) LL->m[0].data);
2309  }
2310  else
2311  {
2312  mpz_init_set_ui(modBase,0);
2313  }
2314  if (LL->nr >= 1)
2315  {
2316  modExponent = (unsigned long) LL->m[1].data;
2317  }
2318  else
2319  {
2320  modExponent = 1;
2321  }
2322  }
2323  // ----------------------------------------
2324  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_cmp_ui(modBase, 0) < 0))
2325  {
2326  WerrorS("Wrong ground ring specification (module is 1)");
2327  return;
2328  }
2329  if (modExponent < 1)
2330  {
2331  WerrorS("Wrong ground ring specification (exponent smaller than 1)");
2332  return;
2333  }
2334  // module is 0 ---> integers
2335  if (mpz_cmp_ui(modBase, 0) == 0)
2336  {
2337  R->cf=nInitChar(n_Z,NULL);
2338  }
2339  // we have an exponent
2340  else if (modExponent > 1)
2341  {
2342  //R->cf->ch = R->cf->modExponent;
2343  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
2344  {
2345  /* this branch should be active for modExponent = 2..32 resp. 2..64,
2346  depending on the size of a long on the respective platform */
2347  R->cf=nInitChar(n_Z2m,(void*)(long)modExponent); // Use Z/2^ch
2348  omFreeSize (modBase, sizeof(mpz_t));
2349  }
2350  else
2351  {
2352  //ringtype 3
2353  ZnmInfo info;
2354  info.base= modBase;
2355  info.exp= modExponent;
2356  R->cf=nInitChar(n_Znm,(void*) &info);
2357  }
2358  }
2359  // just a module m > 1
2360  else
2361  {
2362  //ringtype = 2;
2363  //const int ch = mpz_get_ui(modBase);
2364  ZnmInfo info;
2365  info.base= modBase;
2366  info.exp= modExponent;
2367  R->cf=nInitChar(n_Zn,(void*) &info);
2368  }
2369 }
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:94
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:90
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:93
Definition: tok.h:116
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:329

§ rComposeVar()

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

Definition at line 2413 of file ipshell.cc.

2414 {
2415  assume(R!=NULL);
2416  if (L->m[1].Typ()==LIST_CMD)
2417  {
2418  lists v=(lists)L->m[1].Data();
2419  R->N = v->nr+1;
2420  if (R->N<=0)
2421  {
2422  WerrorS("no ring variables");
2423  return TRUE;
2424  }
2425  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
2426  int i;
2427  for(i=0;i<R->N;i++)
2428  {
2429  if (v->m[i].Typ()==STRING_CMD)
2430  R->names[i]=omStrDup((char *)v->m[i].Data());
2431  else if (v->m[i].Typ()==POLY_CMD)
2432  {
2433  poly p=(poly)v->m[i].Data();
2434  int nr=pIsPurePower(p);
2435  if (nr>0)
2436  R->names[i]=omStrDup(currRing->names[nr-1]);
2437  else
2438  {
2439  Werror("var name %d must be a string or a ring variable",i+1);
2440  return TRUE;
2441  }
2442  }
2443  else
2444  {
2445  Werror("var name %d must be `string`",i+1);
2446  return TRUE;
2447  }
2448  }
2449  }
2450  else
2451  {
2452  WerrorS("variable must be given as `list`");
2453  return TRUE;
2454  }
2455  return FALSE;
2456 }
#define pIsPurePower(p)
Definition: polys.h:231
sleftv * m
Definition: lists.h:45
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:97
return P p
Definition: myNF.cc:203
#define TRUE
Definition: auxiliary.h:101
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:979
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:1121
Definition: tok.h:116
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 2023 of file ipshell.cc.

2024 {
2025  assume( r != NULL );
2026  const coeffs C = r->cf;
2027  assume( C != NULL );
2028 
2029  // sanity check: require currRing==r for rings with polynomial data
2030  if ( (r!=currRing) && (
2031  (nCoeff_is_algExt(C) && (C != currRing->cf))
2032  || (r->qideal != NULL)
2033 #ifdef HAVE_PLURAL
2034  || (rIsPluralRing(r))
2035 #endif
2036  )
2037  )
2038  {
2039  WerrorS("ring with polynomial data must be the base ring or compatible");
2040  return NULL;
2041  }
2042  // 0: char/ cf - ring
2043  // 1: list (var)
2044  // 2: list (ord)
2045  // 3: qideal
2046  // possibly:
2047  // 4: C
2048  // 5: D
2050  if (rIsPluralRing(r))
2051  L->Init(6);
2052  else
2053  L->Init(4);
2054  // ----------------------------------------
2055  // 0: char/ cf - ring
2056  if (rField_is_numeric(r))
2057  {
2058  rDecomposeC(&(L->m[0]),r);
2059  }
2060  else if (rField_is_Ring(r))
2061  {
2062  rDecomposeRing(&(L->m[0]),r);
2063  }
2064  else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2065  {
2066  rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2067  }
2068  else if(rField_is_GF(r))
2069  {
2071  Lc->Init(4);
2072  // char:
2073  Lc->m[0].rtyp=INT_CMD;
2074  Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2075  // var:
2077  Lv->Init(1);
2078  Lv->m[0].rtyp=STRING_CMD;
2079  Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2080  Lc->m[1].rtyp=LIST_CMD;
2081  Lc->m[1].data=(void*)Lv;
2082  // ord:
2084  Lo->Init(1);
2086  Loo->Init(2);
2087  Loo->m[0].rtyp=STRING_CMD;
2088  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2089 
2090  intvec *iv=new intvec(1); (*iv)[0]=1;
2091  Loo->m[1].rtyp=INTVEC_CMD;
2092  Loo->m[1].data=(void *)iv;
2093 
2094  Lo->m[0].rtyp=LIST_CMD;
2095  Lo->m[0].data=(void*)Loo;
2096 
2097  Lc->m[2].rtyp=LIST_CMD;
2098  Lc->m[2].data=(void*)Lo;
2099  // q-ideal:
2100  Lc->m[3].rtyp=IDEAL_CMD;
2101  Lc->m[3].data=(void *)idInit(1,1);
2102  // ----------------------
2103  L->m[0].rtyp=LIST_CMD;
2104  L->m[0].data=(void*)Lc;
2105  }
2106  else
2107  {
2108  L->m[0].rtyp=INT_CMD;
2109  L->m[0].data=(void *)(long)r->cf->ch;
2110  }
2111  // ----------------------------------------
2112  // 1: list (var)
2114  LL->Init(r->N);
2115  int i;
2116  for(i=0; i<r->N; i++)
2117  {
2118  LL->m[i].rtyp=STRING_CMD;
2119  LL->m[i].data=(void *)omStrDup(r->names[i]);
2120  }
2121  L->m[1].rtyp=LIST_CMD;
2122  L->m[1].data=(void *)LL;
2123  // ----------------------------------------
2124  // 2: list (ord)
2126  i=rBlocks(r)-1;
2127  LL->Init(i);
2128  i--;
2129  lists LLL;
2130  for(; i>=0; i--)
2131  {
2132  intvec *iv;
2133  int j;
2134  LL->m[i].rtyp=LIST_CMD;
2136  LLL->Init(2);
2137  LLL->m[0].rtyp=STRING_CMD;
2138  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2139 
2140  if(r->order[i] == ringorder_IS) // || r->order[i] == ringorder_s || r->order[i] == ringorder_S)
2141  {
2142  assume( r->block0[i] == r->block1[i] );
2143  const int s = r->block0[i];
2144  assume( -2 < s && s < 2);
2145 
2146  iv=new intvec(1);
2147  (*iv)[0] = s;
2148  }
2149  else if (r->block1[i]-r->block0[i] >=0 )
2150  {
2151  int bl=j=r->block1[i]-r->block0[i];
2152  if (r->order[i]==ringorder_M)
2153  {
2154  j=(j+1)*(j+1)-1;
2155  bl=j+1;
2156  }
2157  else if (r->order[i]==ringorder_am)
2158  {
2159  j+=r->wvhdl[i][bl+1];
2160  }
2161  iv=new intvec(j+1);
2162  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2163  {
2164  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2165  }
2166  else switch (r->order[i])
2167  {
2168  case ringorder_dp:
2169  case ringorder_Dp:
2170  case ringorder_ds:
2171  case ringorder_Ds:
2172  case ringorder_lp:
2173  for(;j>=0; j--) (*iv)[j]=1;
2174  break;
2175  default: /* do nothing */;
2176  }
2177  }
2178  else
2179  {
2180  iv=new intvec(1);
2181  }
2182  LLL->m[1].rtyp=INTVEC_CMD;
2183  LLL->m[1].data=(void *)iv;
2184  LL->m[i].data=(void *)LLL;
2185  }
2186  L->m[2].rtyp=LIST_CMD;
2187  L->m[2].data=(void *)LL;
2188  // ----------------------------------------
2189  // 3: qideal
2190  L->m[3].rtyp=IDEAL_CMD;
2191  if (r->qideal==NULL)
2192  L->m[3].data=(void *)idInit(1,1);
2193  else
2194  L->m[3].data=(void *)idCopy(r->qideal);
2195  // ----------------------------------------
2196 #ifdef HAVE_PLURAL // NC! in rDecompose
2197  if (rIsPluralRing(r))
2198  {
2199  L->m[4].rtyp=MATRIX_CMD;
2200  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2201  L->m[5].rtyp=MATRIX_CMD;
2202  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2203  }
2204 #endif
2205  return L;
2206 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:45
Definition: tok.h:94
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:90
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1594
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:1718
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:88
int i
Definition: cfEzgcd.cc:123
Induced (Schreyer) ordering.
Definition: ring.h:101
Definition: tok.h:99
ideal idCopy(ideal A)
Definition: ideals.h:62
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:1784
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:93
Definition: tok.h:116
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:75
omBin slists_bin
Definition: lists.cc:23
static BOOLEAN rField_is_numeric(const ring r)
Definition: ring.h:504
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1817 of file ipshell.cc.

1818 {
1819  assume( C != NULL );
1820 
1821  // sanity check: require currRing==r for rings with polynomial data
1822  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1823  {
1824  WerrorS("ring with polynomial data must be the base ring or compatible");
1825  return TRUE;
1826  }
1827  if (nCoeff_is_numeric(C))
1828  {
1829  rDecomposeC_41(res,C);
1830  }
1831 #ifdef HAVE_RINGS
1832  else if (nCoeff_is_Ring(C))
1833  {
1834  rDecomposeRing_41(res,C);
1835  }
1836 #endif
1837  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1838  {
1839  rDecomposeCF(res, C->extRing, currRing);
1840  }
1841  else if(nCoeff_is_GF(C))
1842  {
1844  Lc->Init(4);
1845  // char:
1846  Lc->m[0].rtyp=INT_CMD;
1847  Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1848  // var:
1850  Lv->Init(1);
1851  Lv->m[0].rtyp=STRING_CMD;
1852  Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1853  Lc->m[1].rtyp=LIST_CMD;
1854  Lc->m[1].data=(void*)Lv;
1855  // ord:
1857  Lo->Init(1);
1859  Loo->Init(2);
1860  Loo->m[0].rtyp=STRING_CMD;
1861  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1862 
1863  intvec *iv=new intvec(1); (*iv)[0]=1;
1864  Loo->m[1].rtyp=INTVEC_CMD;
1865  Loo->m[1].data=(void *)iv;
1866 
1867  Lo->m[0].rtyp=LIST_CMD;
1868  Lo->m[0].data=(void*)Loo;
1869 
1870  Lc->m[2].rtyp=LIST_CMD;
1871  Lc->m[2].data=(void*)Lo;
1872  // q-ideal:
1873  Lc->m[3].rtyp=IDEAL_CMD;
1874  Lc->m[3].data=(void *)idInit(1,1);
1875  // ----------------------
1876  res->rtyp=LIST_CMD;
1877  res->data=(void*)Lc;
1878  }
1879  else
1880  {
1881  res->rtyp=INT_CMD;
1882  res->data=(void *)(long)C->ch;
1883  }
1884  // ----------------------------------------
1885  return FALSE;
1886 }
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:94
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:97
#define TRUE
Definition: auxiliary.h:101
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:1755
void * data
Definition: subexpr.h:90
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1594
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
Definition: tok.h:99
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:1683
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:93
Definition: tok.h:116
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 1890 of file ipshell.cc.

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

§ rDecomposeC()

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

Definition at line 1718 of file ipshell.cc.

1720 {
1722  if (rField_is_long_C(R)) L->Init(3);
1723  else L->Init(2);
1724  h->rtyp=LIST_CMD;
1725  h->data=(void *)L;
1726  // 0: char/ cf - ring
1727  // 1: list (var)
1728  // 2: list (ord)
1729  // ----------------------------------------
1730  // 0: char/ cf - ring
1731  L->m[0].rtyp=INT_CMD;
1732  L->m[0].data=(void *)0;
1733  // ----------------------------------------
1734  // 1:
1736  LL->Init(2);
1737  LL->m[0].rtyp=INT_CMD;
1738  LL->m[0].data=(void *)(long)si_max(R->cf->float_len,SHORT_REAL_LENGTH/2);
1739  LL->m[1].rtyp=INT_CMD;
1740  LL->m[1].data=(void *)(long)si_max(R->cf->float_len2,SHORT_REAL_LENGTH);
1741  L->m[1].rtyp=LIST_CMD;
1742  L->m[1].data=(void *)LL;
1743  // ----------------------------------------
1744  // 2: list (par)
1745  if (rField_is_long_C(R))
1746  {
1747  L->m[2].rtyp=STRING_CMD;
1748  L->m[2].data=(void *)omStrDup(*rParameter(R));
1749  }
1750  // ----------------------------------------
1751 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:94
#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:90
const ring R
Definition: DebugPrint.cc:36
static int si_max(const int a, const int b)
Definition: auxiliary.h:123
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:93
Definition: tok.h:116
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 1683 of file ipshell.cc.

1685 {
1687  if (nCoeff_is_long_C(C)) L->Init(3);
1688  else L->Init(2);
1689  h->rtyp=LIST_CMD;
1690  h->data=(void *)L;
1691  // 0: char/ cf - ring
1692  // 1: list (var)
1693  // 2: list (ord)
1694  // ----------------------------------------
1695  // 0: char/ cf - ring
1696  L->m[0].rtyp=INT_CMD;
1697  L->m[0].data=(void *)0;
1698  // ----------------------------------------
1699  // 1:
1701  LL->Init(2);
1702  LL->m[0].rtyp=INT_CMD;
1703  LL->m[0].data=(void *)(long)si_max(C->float_len,SHORT_REAL_LENGTH/2);
1704  LL->m[1].rtyp=INT_CMD;
1705  LL->m[1].data=(void *)(long)si_max(C->float_len2,SHORT_REAL_LENGTH);
1706  L->m[1].rtyp=LIST_CMD;
1707  L->m[1].data=(void *)LL;
1708  // ----------------------------------------
1709  // 2: list (par)
1710  if (nCoeff_is_long_C(C))
1711  {
1712  L->m[2].rtyp=STRING_CMD;
1713  L->m[2].data=(void *)omStrDup(*n_ParameterNames(C));
1714  }
1715  // ----------------------------------------
1716 }
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:94
#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:90
static int si_max(const int a, const int b)
Definition: auxiliary.h:123
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:93
Definition: tok.h:116
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 1594 of file ipshell.cc.

1595 {
1597  L->Init(4);
1598  h->rtyp=LIST_CMD;
1599  h->data=(void *)L;
1600  // 0: char/ cf - ring
1601  // 1: list (var)
1602  // 2: list (ord)
1603  // 3: qideal
1604  // ----------------------------------------
1605  // 0: char/ cf - ring
1606  L->m[0].rtyp=INT_CMD;
1607  L->m[0].data=(void *)(long)r->cf->ch;
1608  // ----------------------------------------
1609  // 1: list (var)
1611  LL->Init(r->N);
1612  int i;
1613  for(i=0; i<r->N; i++)
1614  {
1615  LL->m[i].rtyp=STRING_CMD;
1616  LL->m[i].data=(void *)omStrDup(r->names[i]);
1617  }
1618  L->m[1].rtyp=LIST_CMD;
1619  L->m[1].data=(void *)LL;
1620  // ----------------------------------------
1621  // 2: list (ord)
1623  i=rBlocks(r)-1;
1624  LL->Init(i);
1625  i--;
1626  lists LLL;
1627  for(; i>=0; i--)
1628  {
1629  intvec *iv;
1630  int j;
1631  LL->m[i].rtyp=LIST_CMD;
1633  LLL->Init(2);
1634  LLL->m[0].rtyp=STRING_CMD;
1635  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1636  if (r->block1[i]-r->block0[i] >=0 )
1637  {
1638  j=r->block1[i]-r->block0[i];
1639  if(r->order[i]==ringorder_M) j=(j+1)*(j+1)-1;
1640  iv=new intvec(j+1);
1641  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1642  {
1643  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j];
1644  }
1645  else switch (r->order[i])
1646  {
1647  case ringorder_dp:
1648  case ringorder_Dp:
1649  case ringorder_ds:
1650  case ringorder_Ds:
1651  case ringorder_lp:
1652  for(;j>=0; j--) (*iv)[j]=1;
1653  break;
1654  default: /* do nothing */;
1655  }
1656  }
1657  else
1658  {
1659  iv=new intvec(1);
1660  }
1661  LLL->m[1].rtyp=INTVEC_CMD;
1662  LLL->m[1].data=(void *)iv;
1663  LL->m[i].data=(void *)LLL;
1664  }
1665  L->m[2].rtyp=LIST_CMD;
1666  L->m[2].data=(void *)LL;
1667  // ----------------------------------------
1668  // 3: qideal
1669  L->m[3].rtyp=IDEAL_CMD;
1670  if (nCoeff_is_transExt(R->cf))
1671  L->m[3].data=(void *)idInit(1,1);
1672  else
1673  {
1674  ideal q=idInit(IDELEMS(r->qideal));
1675  q->m[0]=p_Init(R);
1676  pSetCoeff0(q->m[0],(number)(r->qideal->m[0]));
1677  L->m[3].data=(void *)q;
1678 // I->m[0] = pNSet(R->minpoly);
1679  }
1680  // ----------------------------------------
1681 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:94
Definition: lists.h:22
void * data
Definition: subexpr.h:90
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
Definition: tok.h:99
#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:93
#define pSetCoeff0(p, n)
Definition: monomials.h:67
Definition: tok.h:116
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 1784 of file ipshell.cc.

1786 {
1787 #ifdef HAVE_RINGS
1789  if (rField_is_Ring_Z(R)) L->Init(1);
1790  else L->Init(2);
1791  h->rtyp=LIST_CMD;
1792  h->data=(void *)L;
1793  // 0: char/ cf - ring
1794  // 1: list (module)
1795  // ----------------------------------------
1796  // 0: char/ cf - ring
1797  L->m[0].rtyp=STRING_CMD;
1798  L->m[0].data=(void *)omStrDup("integer");
1799  // ----------------------------------------
1800  // 1: module
1801  if (rField_is_Ring_Z(R)) return;
1803  LL->Init(2);
1804  LL->m[0].rtyp=BIGINT_CMD;
1805  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); ?
1806  LL->m[1].rtyp=INT_CMD;
1807  LL->m[1].data=(void *) R->cf->modExponent;
1808  L->m[1].rtyp=LIST_CMD;
1809  L->m[1].data=(void *)LL;
1810 #else
1811  WerrorS("rDecomposeRing");
1812 #endif
1813 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:94
Definition: lists.h:22
Definition: tok.h:38
void WerrorS(const char *s)
Definition: feFopen.cc:24
void * data
Definition: subexpr.h:90
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:93
Definition: tok.h:116
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 1755 of file ipshell.cc.

1757 {
1759  if (nCoeff_is_Ring(C)) L->Init(1);
1760  else L->Init(2);
1761  h->rtyp=LIST_CMD;
1762  h->data=(void *)L;
1763  // 0: char/ cf - ring
1764  // 1: list (module)
1765  // ----------------------------------------
1766  // 0: char/ cf - ring
1767  L->m[0].rtyp=STRING_CMD;
1768  L->m[0].data=(void *)omStrDup("integer");
1769  // ----------------------------------------
1770  // 1: modulo
1771  if (nCoeff_is_Ring_Z(C)) return;
1773  LL->Init(2);
1774  LL->m[0].rtyp=BIGINT_CMD;
1775  LL->m[0].data=nlMapGMP((number) C->modBase, C, coeffs_BIGINT);
1776  LL->m[1].rtyp=INT_CMD;
1777  LL->m[1].data=(void *) C->modExponent;
1778  L->m[1].rtyp=LIST_CMD;
1779  L->m[1].data=(void *)LL;
1780 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:94
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:90
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:93
Definition: tok.h:116
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 1523 of file ipshell.cc.

1524 {
1525  idhdl tmp=NULL;
1526 
1527  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
1528  if (tmp==NULL) return NULL;
1529 
1530 // if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
1532  {
1534  memset(&sLastPrinted,0,sizeof(sleftv));
1535  }
1536 
1537  ring r = IDRING(tmp) = (ring) omAlloc0Bin(sip_sring_bin);
1538 
1539  r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1540  r->N = 3;
1541  /*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
1542  /*names*/
1543  r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
1544  r->names[0] = omStrDup("x");
1545  r->names[1] = omStrDup("y");
1546  r->names[2] = omStrDup("z");
1547  /*weights: entries for 3 blocks: NULL*/
1548  r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1549  /*order: dp,C,0*/
1550  r->order = (int *) omAlloc(3 * sizeof(int *));
1551  r->block0 = (int *)omAlloc0(3 * sizeof(int *));
1552  r->block1 = (int *)omAlloc0(3 * sizeof(int *));
1553  /* ringorder dp for the first block: var 1..3 */
1554  r->order[0] = ringorder_dp;
1555  r->block0[0] = 1;
1556  r->block1[0] = 3;
1557  /* ringorder C for the second block: no vars */
1558  r->order[1] = ringorder_C;
1559  /* the last block: everything is 0 */
1560  r->order[2] = 0;
1561 
1562  /* complete ring intializations */
1563  rComplete(r);
1564  rSetHdl(tmp);
1565  return currRingHdl;
1566 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Class used for (list of) interpreter objects.
Definition: subexpr.h:84
{p < 2^31}
Definition: coeffs.h:30
#define IDROOT
Definition: ipid.h:20
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: idrec.h:34
int myynest
Definition: febase.cc:46
char * char_ptr
Definition: structs.h:56
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:259
const ring r
Definition: syzextra.cc:208
BOOLEAN RingDependend()
Definition: subexpr.cc:391
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:3435
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:320
void rSetHdl(idhdl h)
Definition: ipshell.cc:5017
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:329
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1568 of file ipshell.cc.

1569 {
1571  if (h!=NULL) return h;
1572  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1573  if (h!=NULL) return h;
1575  while(p!=NULL)
1576  {
1577  if ((p->cPack!=basePack)
1578  && (p->cPack!=currPack))
1579  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1580  if (h!=NULL) return h;
1581  p=p->next;
1582  }
1583  idhdl tmp=basePack->idroot;
1584  while (tmp!=NULL)
1585  {
1586  if (IDTYP(tmp)==PACKAGE_CMD)
1587  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1588  if (h!=NULL) return h;
1589  tmp=IDNEXT(tmp);
1590  }
1591  return NULL;
1592 }
idhdl rSimpleFindHdl(ring r, idhdl root, idhdl n)
Definition: ipshell.cc:6121
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 5503 of file ipshell.cc.

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

§ rKill() [1/2]

void rKill ( ring  r)

Definition at line 6044 of file ipshell.cc.

6045 {
6046  if ((r->ref<=0)&&(r->order!=NULL))
6047  {
6048 #ifdef RDEBUG
6049  if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6050 #endif
6051  if (r->qideal!=NULL)
6052  {
6053  id_Delete(&r->qideal, r);
6054  r->qideal = NULL;
6055  }
6056  int j;
6057  for (j=0;j<myynest;j++)
6058  {
6059  if (iiLocalRing[j]==r)
6060  {
6061  if (j==0) WarnS("killing the basering for level 0");
6062  iiLocalRing[j]=NULL;
6063  }
6064  }
6065 // any variables depending on r ?
6066  while (r->idroot!=NULL)
6067  {
6068  r->idroot->lev=myynest; // avoid warning about kill global objects
6069  killhdl2(r->idroot,&(r->idroot),r);
6070  }
6071  if (r==currRing)
6072  {
6073  // all dependend stuff is done, clean global vars:
6074  if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6076  {
6078  }
6079  //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6080  //{
6081  // WerrorS("return value depends on local ring variable (export missing ?)");
6082  // iiRETURNEXPR.CleanUp();
6083  //}
6084  currRing=NULL;
6085  currRingHdl=NULL;
6086  }
6087 
6088  /* nKillChar(r); will be called from inside of rDelete */
6089  rDelete(r);
6090  return;
6091  }
6092  r->ref--;
6093 }
#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:403
const ring r
Definition: syzextra.cc:208
BOOLEAN RingDependend()
Definition: subexpr.cc:391
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:320

§ rKill() [2/2]

void rKill ( idhdl  h)

Definition at line 6095 of file ipshell.cc.

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

§ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 5071 of file ipshell.cc.

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

§ rRenameVars()

static void rRenameVars ( ring  R)
static

Definition at line 2372 of file ipshell.cc.

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

§ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5017 of file ipshell.cc.

5018 {
5019  ring rg = NULL;
5020  if (h!=NULL)
5021  {
5022 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5023  rg = IDRING(h);
5024  if (rg==NULL) return; //id <>NULL, ring==NULL
5025  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5026  if (IDID(h)) // OB: ????
5027  omCheckAddr((ADDRESS)IDID(h));
5028  rTest(rg);
5029  }
5030 
5031  // clean up history
5033  {
5035  memset(&sLastPrinted,0,sizeof(sleftv));
5036  }
5037 
5038  if ((rg!=currRing)&&(currRing!=NULL))
5039  {
5041  if (DENOMINATOR_LIST!=NULL)
5042  {
5043  if (TEST_V_ALLWARN)
5044  Warn("deleting denom_list for ring change to %s",IDID(h));
5045  do
5046  {
5047  n_Delete(&(dd->n),currRing->cf);
5048  dd=dd->next;
5050  DENOMINATOR_LIST=dd;
5051  } while(DENOMINATOR_LIST!=NULL);
5052  }
5053  }
5054 
5055  // test for valid "currRing":
5056  if ((rg!=NULL) && (rg->idroot==NULL))
5057  {
5058  ring old=rg;
5059  rg=rAssure_HasComp(rg);
5060  if (old!=rg)
5061  {
5062  rKill(old);
5063  IDRING(h)=rg;
5064  }
5065  }
5066  /*------------ change the global ring -----------------------*/
5067  rChangeCurrRing(rg);
5068  currRingHdl = h;
5069 }
#define omCheckAddrSize(addr, size)
Definition: omAllocDecl.h:327
Class used for (list of) interpreter objects.
Definition: subexpr.h:84
#define IDID(a)
Definition: ipid.h:119
denominator_list DENOMINATOR_LIST
Definition: kutil.cc:89
void * ADDRESS
Definition: auxiliary.h:118
ring rAssure_HasComp(const ring r)
Definition: ring.cc:4557
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:391
void rKill(ring r)
Definition: ipshell.cc:6044
#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:320
#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 6121 of file ipshell.cc.

6122 {
6123  idhdl h=root;
6124  while (h!=NULL)
6125  {
6126  if ((IDTYP(h)==RING_CMD)
6127  && (h!=n)
6128  && (IDRING(h)==r)
6129  )
6130  {
6131  return h;
6132  }
6133  h=IDNEXT(h);
6134  }
6135  return NULL;
6136 }
#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 5455 of file ipshell.cc.

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

§ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 5183 of file ipshell.cc.

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

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

1025 {
1026  int i;
1027  indset save;
1029 
1030  hexist = hInit(S, Q, &hNexist, currRing);
1031  if (hNexist == 0)
1032  {
1033  intvec *iv=new intvec(rVar(currRing));
1034  for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1035  res->Init(1);
1036  res->m[0].rtyp=INTVEC_CMD;
1037  res->m[0].data=(intvec*)iv;
1038  return res;
1039  }
1040  else if (hisModule!=0)
1041  {
1042  res->Init(0);
1043  return res;
1044  }
1045  save = ISet = (indset)omAlloc0Bin(indlist_bin);
1046  hMu = 0;
1047  hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1048  hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1049  hpure = (scmon)omAlloc((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1050  hrad = hexist;
1051  hNrad = hNexist;
1052  radmem = hCreate(rVar(currRing) - 1);
1053  hCo = rVar(currRing) + 1;
1054  hNvar = rVar(currRing);
1055  hRadical(hrad, &hNrad, hNvar);
1056  hSupp(hrad, hNrad, hvar, &hNvar);
1057  if (hNvar)
1058  {
1059  hCo = hNvar;
1060  memset(hpure, 0, (rVar(currRing) + 1) * sizeof(long));
1061  hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1062  hLexR(hrad, hNrad, hvar, hNvar);
1064  }
1065  if (hCo && (hCo < rVar(currRing)))
1066  {
1068  }
1069  if (hMu!=0)
1070  {
1071  ISet = save;
1072  hMu2 = 0;
1073  if (all && (hCo+1 < rVar(currRing)))
1074  {
1077  i=hMu+hMu2;
1078  res->Init(i);
1079  if (hMu2 == 0)
1080  {
1082  }
1083  }
1084  else
1085  {
1086  res->Init(hMu);
1087  }
1088  for (i=0;i<hMu;i++)
1089  {
1090  res->m[i].data = (void *)save->set;
1091  res->m[i].rtyp = INTVEC_CMD;
1092  ISet = save;
1093  save = save->nx;
1095  }
1096  omFreeBin((ADDRESS)save, indlist_bin);
1097  if (hMu2 != 0)
1098  {
1099  save = JSet;
1100  for (i=hMu;i<hMu+hMu2;i++)
1101  {
1102  res->m[i].data = (void *)save->set;
1103  res->m[i].rtyp = INTVEC_CMD;
1104  JSet = save;
1105  save = save->nx;
1107  }
1108  omFreeBin((ADDRESS)save, indlist_bin);
1109  }
1110  }
1111  else
1112  {
1113  res->Init(0);
1115  }
1116  hKill(radmem, rVar(currRing) - 1);
1117  omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1118  omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1119  omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1121  return res;
1122 }
int hMu2
Definition: hdegree.cc:22
sleftv * m
Definition: lists.h:45
void hDimSolve(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:29
scfmon hwork
Definition: hutil.cc:19
void hIndAllMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:496
int hNexist
Definition: hutil.cc:22
int * varset
Definition: hutil.h:21
int hCo
Definition: hdegree.cc:22
Definition: lists.h:22
scmon * scfmon
Definition: hutil.h:20
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
scfmon hexist
Definition: hutil.cc:19
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:580
monf hCreate(int Nvar)
Definition: hutil.cc:1002
int hNvar
Definition: hutil.cc:22
void * ADDRESS
Definition: auxiliary.h:118
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:90
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:33
void hPure(scfmon stc, int a, int *Nstc, varset var, int Nvar, scmon pure, int *Npure)
Definition: hutil.cc:627
omBin indlist_bin
Definition: hdegree.cc:23
indset JSet
Definition: hdegree.cc:279
int * scmon
Definition: hutil.h:19
int i
Definition: cfEzgcd.cc:123
Definition: tok.h:99
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:93
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 4456 of file ipshell.cc.

4457 {
4458  sleftv tmp;
4459  memset(&tmp,0,sizeof(tmp));
4460  tmp.rtyp=INT_CMD;
4461  /* tmp.data = (void *)0; -- done by memset */
4462 
4463  return semicProc3(res,u,v,&tmp);
4464 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:84
Definition: tok.h:94
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4416
int rtyp
Definition: subexpr.h:93

§ semicProc3()

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

Definition at line 4416 of file ipshell.cc.

4417 {
4418  semicState state;
4419  BOOLEAN qh=(((int)(long)w->Data())==1);
4420 
4421  // -----------------
4422  // check arguments
4423  // -----------------
4424 
4425  lists l1 = (lists)u->Data( );
4426  lists l2 = (lists)v->Data( );
4427 
4428  if( (state=list_is_spectrum( l1 ))!=semicOK )
4429  {
4430  WerrorS( "first argument is not a spectrum" );
4431  list_error( state );
4432  }
4433  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4434  {
4435  WerrorS( "second argument is not a spectrum" );
4436  list_error( state );
4437  }
4438  else
4439  {
4440  spectrum s1= spectrumFromList( l1 );
4441  spectrum s2= spectrumFromList( l2 );
4442 
4443  res->rtyp = INT_CMD;
4444  if (qh)
4445  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4446  else
4447  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4448  }
4449 
4450  // -----------------
4451  // check status
4452  // -----------------
4453 
4454  return (state!=semicOK);
4455 }
Definition: tok.h:94
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3289
void list_error(semicState state)
Definition: ipshell.cc:3373
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
void * data
Definition: subexpr.h:90
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4158
int mult_spectrumh(spectrum &)
Definition: semic.cc:425
semicState
Definition: ipshell.cc:3339
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:93
void * Data()
Definition: subexpr.cc:1121
int BOOLEAN
Definition: auxiliary.h:88
int mult_spectrum(spectrum &)
Definition: semic.cc:396

§ spaddProc()

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

Definition at line 4333 of file ipshell.cc.

4334 {
4335  semicState state;
4336 
4337  // -----------------
4338  // check arguments
4339  // -----------------
4340 
4341  lists l1 = (lists)first->Data( );
4342  lists l2 = (lists)second->Data( );
4343 
4344  if( (state=list_is_spectrum( l1 )) != semicOK )
4345  {
4346  WerrorS( "first argument is not a spectrum:" );
4347  list_error( state );
4348  }
4349  else if( (state=list_is_spectrum( l2 )) != semicOK )
4350  {
4351  WerrorS( "second argument is not a spectrum:" );
4352  list_error( state );
4353  }
4354  else
4355  {
4356  spectrum s1= spectrumFromList ( l1 );
4357  spectrum s2= spectrumFromList ( l2 );
4358  spectrum sum( s1+s2 );
4359 
4360  result->rtyp = LIST_CMD;
4361  result->data = (char*)(getList(sum));
4362  }
4363 
4364  return (state!=semicOK);
4365 }
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3289
void list_error(semicState state)
Definition: ipshell.cc:3373
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
lists getList(spectrum &spec)
Definition: ipshell.cc:3301
void * data
Definition: subexpr.h:90
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4158
semicState
Definition: ipshell.cc:3339
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:93
void * Data()
Definition: subexpr.cc:1121
Definition: tok.h:116

§ spectrumCompute()

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

Definition at line 3715 of file ipshell.cc.

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

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

§ spectrumFromList()

spectrum spectrumFromList ( lists  l)

Definition at line 3289 of file ipshell.cc.

3290 {
3291  spectrum result;
3292  copy_deep( result, l );
3293  return result;
3294 }
Definition: semic.h:63
void copy_deep(spectrum &spec, lists l)
Definition: ipshell.cc:3265
return result
Definition: facAbsBiFact.cc:76

§ spectrumPrintError()

void spectrumPrintError ( spectrumState  state)

Definition at line 4007 of file ipshell.cc.

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

§ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4038 of file ipshell.cc.

4039 {
4040  spectrumState state = spectrumOK;
4041 
4042  // -------------------
4043  // check consistency
4044  // -------------------
4045 
4046  // check for a local ring
4047 
4048  if( !ringIsLocal(currRing ) )
4049  {
4050  WerrorS( "only works for local orderings" );
4051  state = spectrumWrongRing;
4052  }
4053 
4054  // no quotient rings are allowed
4055 
4056  else if( currRing->qideal != NULL )
4057  {
4058  WerrorS( "does not work in quotient rings" );
4059  state = spectrumWrongRing;
4060  }
4061  else
4062  {
4063  lists L = (lists)NULL;
4064  int flag = 1; // weight corner optimization is safe
4065 
4066  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4067 
4068  if( state==spectrumOK )
4069  {
4070  result->rtyp = LIST_CMD;
4071  result->data = (char*)L;
4072  }
4073  else
4074  {
4075  spectrumPrintError(state);
4076  }
4077  }
4078 
4079  return (state!=spectrumOK);
4080 }
spectrumState
Definition: ipshell.cc:3455
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:24
void * data
Definition: subexpr.h:90
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:4007
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3715
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:93
void * Data()
Definition: subexpr.cc:1121
Definition: tok.h:116
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 3474 of file ipshell.cc.

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

4376 {
4377  semicState state;
4378 
4379  // -----------------
4380  // check arguments
4381  // -----------------
4382 
4383  lists l = (lists)first->Data( );
4384  int k = (int)(long)second->Data( );
4385 
4386  if( (state=list_is_spectrum( l ))!=semicOK )
4387  {
4388  WerrorS( "first argument is not a spectrum" );
4389  list_error( state );
4390  }
4391  else if( k < 0 )
4392  {
4393  WerrorS( "second argument should be positive" );
4394  state = semicMulNegative;
4395  }
4396  else
4397  {
4398  spectrum s= spectrumFromList( l );
4399  spectrum product( k*s );
4400 
4401  result->rtyp = LIST_CMD;
4402  result->data = (char*)getList(product);
4403  }
4404 
4405  return (state!=semicOK);
4406 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3289
void list_error(semicState state)
Definition: ipshell.cc:3373
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:3301
void * data
Definition: subexpr.h:90
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4158
semicState
Definition: ipshell.cc:3339
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:93
void * Data()
Definition: subexpr.cc:1121
Definition: tok.h:116
int l
Definition: cfEzgcd.cc:94

§ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3076 of file ipshell.cc.

3077 {
3078  sleftv tmp;
3079  memset(&tmp,0,sizeof(tmp));
3080  tmp.rtyp=INT_CMD;
3081  tmp.data=(void *)1;
3082  return syBetti2(res,u,&tmp);
3083 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:84
Definition: tok.h:94
void * data
Definition: subexpr.h:90
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3053
int rtyp
Definition: subexpr.h:93

§ syBetti2()

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

Definition at line 3053 of file ipshell.cc.

3054 {
3055  syStrategy syzstr=(syStrategy)u->Data();
3056 
3057  BOOLEAN minim=(int)(long)w->Data();
3058  int row_shift=0;
3059  int add_row_shift=0;
3060  intvec *weights=NULL;
3061  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3062  if (ww!=NULL)
3063  {
3064  weights=ivCopy(ww);
3065  add_row_shift = ww->min_in();
3066  (*weights) -= add_row_shift;
3067  }
3068 
3069  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3070  //row_shift += add_row_shift;
3071  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3072  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3073 
3074  return FALSE;
3075 }
void atSet(idhdl root, const char *name, void *data, int typ)
Definition: attrib.cc:156
Definition: tok.h:94
#define FALSE
Definition: auxiliary.h:97
intvec * ivCopy(const intvec *o)
Definition: intvec.h:126
int min_in()
Definition: intvec.h:113
void * data
Definition: subexpr.h:90
Definition: intvec.h:14
Definition: tok.h:99
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:135
#define NULL
Definition: omList.c:10
intvec * syBettiOfComputation(syStrategy syzstr, BOOLEAN minim=TRUE, int *row_shift=NULL, intvec *weights=NULL)
Definition: syz1.cc:1767
void * Data()
Definition: subexpr.cc:1121
int BOOLEAN
Definition: auxiliary.h:88
ssyStrategy * syStrategy
Definition: syz.h:35
#define omStrDup(s)
Definition: omAllocDecl.h:263

§ syConvList()

syStrategy syConvList ( lists  li)

Definition at line 3161 of file ipshell.cc.

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

§ syConvRes()

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

Definition at line 3088 of file ipshell.cc.

3089 {
3090  resolvente fullres = syzstr->fullres;
3091  resolvente minres = syzstr->minres;
3092 
3093  const int length = syzstr->length;
3094 
3095  if ((fullres==NULL) && (minres==NULL))
3096  {
3097  if (syzstr->hilb_coeffs==NULL)
3098  { // La Scala
3099  fullres = syReorder(syzstr->res, length, syzstr);
3100  }
3101  else
3102  { // HRES
3103  minres = syReorder(syzstr->orderedRes, length, syzstr);
3104  syKillEmptyEntres(minres, length);
3105  }
3106  }
3107 
3108  resolvente tr;
3109  int typ0=IDEAL_CMD;
3110 
3111  if (minres!=NULL)
3112  tr = minres;
3113  else
3114  tr = fullres;
3115 
3116  resolvente trueres=NULL; intvec ** w=NULL;
3117 
3118  if (length>0)
3119  {
3120  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3121  for (int i=(length)-1;i>=0;i--)
3122  {
3123  if (tr[i]!=NULL)
3124  {
3125  trueres[i] = idCopy(tr[i]);
3126  }
3127  }
3128  if ( id_RankFreeModule(trueres[0], currRing) > 0)
3129  typ0 = MODUL_CMD;
3130  if (syzstr->weights!=NULL)
3131  {
3132  w = (intvec**)omAlloc0(length*sizeof(intvec*));
3133  for (int i=length-1;i>=0;i--)
3134  {
3135  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3136  }
3137  }
3138  }
3139 
3140  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3141  w, add_row_shift);
3142 
3143  if (w != NULL) omFreeSize(w, length*sizeof(intvec*));
3144 
3145  if (toDel)
3146  syKillComputation(syzstr);
3147  else
3148  {
3149  if( fullres != NULL && syzstr->fullres == NULL )
3150  syzstr->fullres = fullres;
3151 
3152  if( minres != NULL && syzstr->minres == NULL )
3153  syzstr->minres = minres;
3154  }
3155  return li;
3156 }
int length
Definition: syz.h:60
intvec ** weights
Definition: syz.h:45
resolvente syReorder(resolvente res, int length, syStrategy syzstr, BOOLEAN toCopy=TRUE, resolvente totake=NULL)
Definition: syz1.cc:1653
Definition: lists.h:22
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * ivCopy(const intvec *o)
Definition: intvec.h:126
resolvente res
Definition: syz.h:47
intvec ** hilb_coeffs
Definition: syz.h:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc: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:62
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:20
void syKillEmptyEntres(resolvente res, int length)
Definition: syz1.cc:2209
void syKillComputation(syStrategy syzstr, ring r=currRing)
Definition: syz1.cc:1497
#define omAlloc0(size)
Definition: omAllocDecl.h:211

§ syForceMin()

syStrategy syForceMin ( lists  li)

Definition at line 3190 of file ipshell.cc.

3191 {
3192  int typ0;
3194 
3195  resolvente fr = liFindRes(li,&(result->length),&typ0);
3196  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3197  for (int i=result->length-1;i>=0;i--)
3198  {
3199  if (fr[i]!=NULL)
3200  result->minres[i] = idCopy(fr[i]);
3201  }
3202  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3203  return result;
3204 }
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:118
int i
Definition: cfEzgcd.cc:123
ideal idCopy(ideal A)
Definition: ideals.h:62
resolvente minres
Definition: syz.h:58
#define NULL
Definition: omList.c:10
ideal * resolvente
Definition: ideals.h:20
#define omAlloc0(size)
Definition: omAllocDecl.h:211
return result
Definition: facAbsBiFact.cc:76
ssyStrategy * syStrategy
Definition: syz.h:35

§ test_cmd()

void test_cmd ( int  i)

Definition at line 508 of file ipshell.cc.

509 {
510  int ii;
511 
512  if (i<0)
513  {
514  ii= -i;
515  if (ii < 32)
516  {
517  si_opt_1 &= ~Sy_bit(ii);
518  }
519  else if (ii < 64)
520  {
521  si_opt_2 &= ~Sy_bit(ii-32);
522  }
523  else
524  WerrorS("out of bounds\n");
525  }
526  else if (i<32)
527  {
528  ii=i;
529  if (Sy_bit(ii) & kOptions)
530  {
531  Warn("Gerhard, use the option command");
532  si_opt_1 |= Sy_bit(ii);
533  }
534  else if (Sy_bit(ii) & validOpts)
535  si_opt_1 |= Sy_bit(ii);
536  }
537  else if (i<64)
538  {
539  ii=i-32;
540  si_opt_2 |= Sy_bit(ii);
541  }
542  else
543  WerrorS("out of bounds\n");
544 }
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 244 of file ipshell.cc.

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

Variable Documentation

§ iiCurrArgs

leftv iiCurrArgs =NULL

Definition at line 78 of file ipshell.cc.

§ iiCurrProc

idhdl iiCurrProc =NULL

Definition at line 79 of file ipshell.cc.

§ iiDebugMarker

BOOLEAN iiDebugMarker =TRUE

Definition at line 984 of file ipshell.cc.

§ iiNoKeepRing

BOOLEAN iiNoKeepRing =TRUE
static

Definition at line 82 of file ipshell.cc.

§ lastreserved

const char* lastreserved =NULL

Definition at line 80 of file ipshell.cc.

§ MAX_SHORT

const short MAX_SHORT = 32767

Definition at line 5491 of file ipshell.cc.