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 "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 res, 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 983 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 3354 of file ipshell.cc.

3355 {
3356  semicOK,
3358 
3361 
3368 
3373 
3379 
3382 
3385 
3386 } semicState;
semicState
Definition: ipshell.cc:3354

◆ spectrumState

Enumerator
spectrumOK 
spectrumZero 
spectrumBadPoly 
spectrumNoSingularity 
spectrumNotIsolated 
spectrumDegenerate 
spectrumWrongRing 
spectrumNoHC 
spectrumUnspecErr 

Definition at line 3470 of file ipshell.cc.

Function Documentation

◆ copy_deep()

void copy_deep ( spectrum spec,
lists  l 
)

Definition at line 3280 of file ipshell.cc.

3281 {
3282  spec.mu = (int)(long)(l->m[0].Data( ));
3283  spec.pg = (int)(long)(l->m[1].Data( ));
3284  spec.n = (int)(long)(l->m[2].Data( ));
3285 
3286  spec.copy_new( spec.n );
3287 
3288  intvec *num = (intvec*)l->m[3].Data( );
3289  intvec *den = (intvec*)l->m[4].Data( );
3290  intvec *mul = (intvec*)l->m[5].Data( );
3291 
3292  for( int i=0; i<spec.n; i++ )
3293  {
3294  spec.s[i] = (Rational)((*num)[i])/(Rational)((*den)[i]);
3295  spec.w[i] = (*mul)[i];
3296  }
3297 }
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:1137
int * w
Definition: semic.h:71

◆ exprlist_length()

int exprlist_length ( leftv  v)

Definition at line 544 of file ipshell.cc.

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

◆ getList()

lists getList ( spectrum spec)

Definition at line 3316 of file ipshell.cc.

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

◆ iiApply()

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

Definition at line 6331 of file ipshell.cc.

6332 {
6333  memset(res,0,sizeof(sleftv));
6334  res->rtyp=a->Typ();
6335  switch (res->rtyp /*a->Typ()*/)
6336  {
6337  case INTVEC_CMD:
6338  case INTMAT_CMD:
6339  return iiApplyINTVEC(res,a,op,proc);
6340  case BIGINTMAT_CMD:
6341  return iiApplyBIGINTMAT(res,a,op,proc);
6342  case IDEAL_CMD:
6343  case MODUL_CMD:
6344  case MATRIX_CMD:
6345  return iiApplyIDEAL(res,a,op,proc);
6346  case LIST_CMD:
6347  return iiApplyLIST(res,a,op,proc);
6348  }
6349  WerrorS("first argument to `apply` must allow an index");
6350  return TRUE;
6351 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:995
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6289
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6299
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6294
int rtyp
Definition: subexpr.h:92
Definition: tok.h:117
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6257

◆ iiApplyBIGINTMAT()

BOOLEAN iiApplyBIGINTMAT ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6289 of file ipshell.cc.

6290 {
6291  WerrorS("not implemented");
6292  return TRUE;
6293 }
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24

◆ iiApplyIDEAL()

BOOLEAN iiApplyIDEAL ( leftv  ,
leftv  ,
int  ,
leftv   
)

Definition at line 6294 of file ipshell.cc.

6295 {
6296  WerrorS("not implemented");
6297  return TRUE;
6298 }
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24

◆ iiApplyINTVEC()

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

Definition at line 6257 of file ipshell.cc.

6258 {
6259  intvec *aa=(intvec*)a->Data();
6260  sleftv tmp_out;
6261  sleftv tmp_in;
6262  leftv curr=res;
6263  BOOLEAN bo=FALSE;
6264  for(int i=0;i<aa->length(); i++)
6265  {
6266  memset(&tmp_in,0,sizeof(tmp_in));
6267  tmp_in.rtyp=INT_CMD;
6268  tmp_in.data=(void*)(long)(*aa)[i];
6269  if (proc==NULL)
6270  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6271  else
6272  bo=jjPROC(&tmp_out,proc,&tmp_in);
6273  if (bo)
6274  {
6275  res->CleanUp(currRing);
6276  Werror("apply fails at index %d",i+1);
6277  return TRUE;
6278  }
6279  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6280  else
6281  {
6282  curr->next=(leftv)omAllocBin(sleftv_bin);
6283  curr=curr->next;
6284  memcpy(curr,&tmp_out,sizeof(tmp_out));
6285  }
6286  }
6287  return FALSE;
6288 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:95
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:8215
#define FALSE
Definition: auxiliary.h:94
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1599
#define TRUE
Definition: auxiliary.h:98
sleftv * leftv
Definition: structs.h:60
void * data
Definition: subexpr.h:89
poly res
Definition: myNF.cc:322
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
Definition: intvec.h:14
omBin sleftv_bin
Definition: subexpr.cc:50
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:87
#define NULL
Definition: omList.c:10
int length() const
Definition: intvec.h:86
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
void * Data()
Definition: subexpr.cc:1137
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189

◆ iiApplyLIST()

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

Definition at line 6299 of file ipshell.cc.

6300 {
6301  lists aa=(lists)a->Data();
6302  sleftv tmp_out;
6303  sleftv tmp_in;
6304  leftv curr=res;
6305  BOOLEAN bo=FALSE;
6306  for(int i=0;i<=aa->nr; i++)
6307  {
6308  memset(&tmp_in,0,sizeof(tmp_in));
6309  tmp_in.Copy(&(aa->m[i]));
6310  if (proc==NULL)
6311  bo=iiExprArith1(&tmp_out,&tmp_in,op);
6312  else
6313  bo=jjPROC(&tmp_out,proc,&tmp_in);
6314  tmp_in.CleanUp();
6315  if (bo)
6316  {
6317  res->CleanUp(currRing);
6318  Werror("apply fails at index %d",i+1);
6319  return TRUE;
6320  }
6321  if (i==0) { memcpy(res,&tmp_out,sizeof(tmp_out)); }
6322  else
6323  {
6324  curr->next=(leftv)omAllocBin(sleftv_bin);
6325  curr=curr->next;
6326  memcpy(curr,&tmp_out,sizeof(tmp_out));
6327  }
6328  }
6329  return FALSE;
6330 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: lists.h:22
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:8215
#define FALSE
Definition: auxiliary.h:94
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1599
#define TRUE
Definition: auxiliary.h:98
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:688
omBin sleftv_bin
Definition: subexpr.cc:50
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:87
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
void * Data()
Definition: subexpr.cc:1137
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189

◆ iiARROW()

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

Definition at line 6380 of file ipshell.cc.

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

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6414 of file ipshell.cc.

6415 {
6416  char* ring_name=omStrDup((char*)r->Name());
6417  int t=arg->Typ();
6418  if (t==RING_CMD)
6419  {
6420  sleftv tmp;
6421  memset(&tmp,0,sizeof(tmp));
6422  tmp.rtyp=IDHDL;
6423  tmp.data=(char*)rDefault(ring_name);
6424  if (tmp.data!=NULL)
6425  {
6426  BOOLEAN b=iiAssign(&tmp,arg);
6427  if (b) return TRUE;
6428  rSetHdl(ggetid(ring_name));
6429  omFree(ring_name);
6430  return FALSE;
6431  }
6432  else
6433  return TRUE;
6434  }
6435  else if (t==CRING_CMD)
6436  {
6437  sleftv tmp;
6438  sleftv n;
6439  memset(&n,0,sizeof(n));
6440  n.name=ring_name;
6441  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6442  if (iiAssign(&tmp,arg)) return TRUE;
6443  //Print("create %s\n",r->Name());
6444  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6445  return FALSE;
6446  }
6447  //Print("create %s\n",r->Name());
6448  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6449  return TRUE;// not handled -> error for now
6450 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define FALSE
Definition: auxiliary.h:94
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:98
int Typ()
Definition: subexpr.cc:995
const char * Name()
Definition: subexpr.h:121
#define IDHDL
Definition: tok.h:31
idhdl rDefault(const char *s)
Definition: ipshell.cc:1549
void * data
Definition: subexpr.h:89
int myynest
Definition: febase.cc:46
Definition: tok.h:56
const char * name
Definition: subexpr.h:88
#define omFree(addr)
Definition: omAllocDecl.h:261
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition: ipshell.cc:1122
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
void rSetHdl(idhdl h)
Definition: ipshell.cc:5032
int BOOLEAN
Definition: auxiliary.h:85
const poly b
Definition: syzextra.cc:213
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:495
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1793
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  res,
leftv  args 
)

Definition at line 1179 of file ipshell.cc.

1180 {
1181  // must be inside a proc, as we simultae an proc_end at the end
1182  if (myynest==0)
1183  {
1184  WerrorS("branchTo can only occur in a proc");
1185  return TRUE;
1186  }
1187  // <string1...stringN>,<proc>
1188  // known: args!=NULL, l>=1
1189  int l=args->listLength();
1190  int ll=0;
1191  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1192  if (ll!=(l-1)) return FALSE;
1193  leftv h=args;
1194  // set up the table for type test:
1195  short *t=(short*)omAlloc(l*sizeof(short));
1196  t[0]=l-1;
1197  int b;
1198  int i;
1199  for(i=1;i<l;i++,h=h->next)
1200  {
1201  if (h->Typ()!=STRING_CMD)
1202  {
1203  omFree(t);
1204  Werror("arg %d is not a string",i);
1205  return TRUE;
1206  }
1207  int tt;
1208  b=IsCmd((char *)h->Data(),tt);
1209  if(b) t[i]=tt;
1210  else
1211  {
1212  omFree(t);
1213  Werror("arg %d is not a type name",i);
1214  return TRUE;
1215  }
1216  }
1217  if (h->Typ()!=PROC_CMD)
1218  {
1219  omFree(t);
1220  Werror("last arg (%d) is not a proc(%d), nest=%d",i,h->Typ(),myynest);
1221  return TRUE;
1222  }
1223  b=iiCheckTypes(iiCurrArgs,t,0);
1224  omFree(t);
1225  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1226  {
1227  // get the proc:
1228  iiCurrProc=(idhdl)h->data;
1230  // already loaded ?
1231  if( pi->data.s.body==NULL )
1232  {
1234  if (pi->data.s.body==NULL) return TRUE;
1235  }
1236  // set currPackHdl/currPack
1237  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1238  {
1239  currPack=pi->pack;
1242  //Print("set pack=%s\n",IDID(currPackHdl));
1243  }
1244  // see iiAllStart:
1245  BITSET save1=si_opt_1;
1246  BITSET save2=si_opt_2;
1247  newBuffer( omStrDup(pi->data.s.body), BT_proc,
1248  pi, pi->data.s.body_lineno-(iiCurrArgs==NULL) );
1249  BOOLEAN err=yyparse();
1250  si_opt_1=save1;
1251  si_opt_2=save2;
1252  // now save the return-expr.
1254  memcpy(&sLastPrinted,&iiRETURNEXPR,sizeof(sleftv));
1255  iiRETURNEXPR.Init();
1256  // warning about args.:
1257  if (iiCurrArgs!=NULL)
1258  {
1259  if (err==0) Warn("too many arguments for %s",IDID(iiCurrProc));
1260  iiCurrArgs->CleanUp();
1262  iiCurrArgs=NULL;
1263  }
1264  // similate proc_end:
1265  // - leave input
1266  void myychangebuffer();
1267  myychangebuffer();
1268  // - set the current buffer to its end (this is a pointer in a buffer,
1269  // not a file ptr) "branchTo" is only valid in proc)
1271  // - kill local vars
1273  // - return
1274  newBuffer(omStrDup("\n;return(_);\n"),BT_execute);
1275  return (err!=0);
1276  }
1277  return FALSE;
1278 }
long fptr
Definition: fevoices.h:70
void myychangebuffer()
Definition: scanner.cc:2333
unsigned si_opt_1
Definition: options.c:5
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
idhdl currPackHdl
Definition: ipid.cc:61
char * buffer
Definition: fevoices.h:69
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:471
int listLength()
Definition: subexpr.cc:60
#define TRUE
Definition: auxiliary.h:98
void Init()
Definition: subexpr.h:108
void * ADDRESS
Definition: auxiliary.h:115
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define BITSET
Definition: structs.h:18
#define omAlloc(size)
Definition: omAllocDecl.h:210
#define IDHDL
Definition: tok.h:31
idhdl iiCurrProc
Definition: ipshell.cc:79
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 omFree(addr)
Definition: omAllocDecl.h:261
void killlocals(int v)
Definition: ipshell.cc:378
idrec * idhdl
Definition: ring.h:18
omBin sleftv_bin
Definition: subexpr.cc:50
int i
Definition: cfEzgcd.cc:123
int yyparse(void)
Definition: grammar.cc:2101
leftv next
Definition: subexpr.h:87
#define IDPROC(a)
Definition: ipid.h:137
#define pi
Definition: libparse.cc:1143
#define NULL
Definition: omList.c:10
Voice * currentVoice
Definition: fevoices.cc:57
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:6470
package currPack
Definition: ipid.cc:63
leftv iiCurrArgs
Definition: ipshell.cc:78
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:171
idhdl packFindHdl(package r)
Definition: ipid.cc:738
void iiCheckPack(package &p)
Definition: ipshell.cc:1535
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
unsigned si_opt_2
Definition: options.c:6
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:210
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:85
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:8628
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1535 of file ipshell.cc.

1536 {
1537  if (p!=basePack)
1538  {
1539  idhdl t=basePack->idroot;
1540  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1541  if (t==NULL)
1542  {
1543  WarnS("package not found\n");
1544  p=basePack;
1545  }
1546  }
1547 }
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 1491 of file ipshell.cc.

1492 {
1493  if (currRing==NULL)
1494  {
1495  #ifdef SIQ
1496  if (siq<=0)
1497  {
1498  #endif
1499  if (RingDependend(i))
1500  {
1501  WerrorS("no ring active");
1502  return TRUE;
1503  }
1504  #ifdef SIQ
1505  }
1506  #endif
1507  }
1508  return FALSE;
1509 }
#define FALSE
Definition: auxiliary.h:94
BOOLEAN siq
Definition: subexpr.cc:57
#define TRUE
Definition: auxiliary.h:98
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 6470 of file ipshell.cc.

6471 {
6472  if (args==NULL)
6473  {
6474  if (type_list[0]==0) return TRUE;
6475  else
6476  {
6477  if (report) WerrorS("no arguments expected");
6478  return FALSE;
6479  }
6480  }
6481  int l=args->listLength();
6482  if (l!=(int)type_list[0])
6483  {
6484  if (report) iiReportTypes(0,l,type_list);
6485  return FALSE;
6486  }
6487  for(int i=1;i<=l;i++,args=args->next)
6488  {
6489  short t=type_list[i];
6490  if (t!=ANY_TYPE)
6491  {
6492  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6493  || (t!=args->Typ()))
6494  {
6495  if (report) iiReportTypes(i,args->Typ(),type_list);
6496  return FALSE;
6497  }
6498  }
6499  }
6500  return TRUE;
6501 }
#define ANY_TYPE
Definition: tok.h:30
#define FALSE
Definition: auxiliary.h:94
int listLength()
Definition: subexpr.cc:60
#define TRUE
Definition: auxiliary.h:98
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:6452
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:87
#define NULL
Definition: omList.c:10
int l
Definition: cfEzgcd.cc:94

◆ iiCopyRes()

static resolvente iiCopyRes ( resolvente  r,
int  l 
)
static

Definition at line 855 of file ipshell.cc.

856 {
857  int i;
858  resolvente res=(ideal *)omAlloc0((l+1)*sizeof(ideal));
859 
860  for (i=0; i<l; i++)
861  if (r[i]!=NULL) res[i]=idCopy(r[i]);
862  return res;
863 }
poly res
Definition: myNF.cc:322
const ring r
Definition: syzextra.cc:208
int i
Definition: cfEzgcd.cc:123
ideal idCopy(ideal A)
Definition: ideals.h:60
#define NULL
Definition: omList.c:10
ideal * resolvente
Definition: ideals.h:18
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:94

◆ iiDebug()

void iiDebug ( )

Definition at line 984 of file ipshell.cc.

985 {
986 #ifdef HAVE_SDB
987  sdb_flags=1;
988 #endif
989  Print("\n-- break point in %s --\n",VoiceName());
991  char * s;
993  s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
994  loop
995  {
996  memset(s,0,80);
998  if (s[BREAK_LINE_LENGTH-1]!='\0')
999  {
1000  Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
1001  }
1002  else
1003  break;
1004  }
1005  if (*s=='\n')
1006  {
1008  }
1009 #if MDEBUG
1010  else if(strncmp(s,"cont;",5)==0)
1011  {
1013  }
1014 #endif /* MDEBUG */
1015  else
1016  {
1017  strcat( s, "\n;~\n");
1018  newBuffer(s,BT_execute);
1019  }
1020 }
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:34
int sdb_flags
Definition: sdb.cc:32
#define Print
Definition: emacs.cc:83
loop
Definition: myNF.cc:98
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
#define omAlloc(size)
Definition: omAllocDecl.h:210
BOOLEAN iiDebugMarker
Definition: ipshell.cc:982
const char * VoiceName()
Definition: fevoices.cc:66
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:983
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 1122 of file ipshell.cc.

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

◆ iiDefaultParameter()

BOOLEAN iiDefaultParameter ( leftv  p)

Definition at line 1166 of file ipshell.cc.

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

◆ iiExport() [1/2]

BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1413 of file ipshell.cc.

1414 {
1415  BOOLEAN nok=FALSE;
1416  leftv r=v;
1417  while (v!=NULL)
1418  {
1419  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1420  {
1421  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1422  nok=TRUE;
1423  }
1424  else
1425  {
1426  if(iiInternalExport(v, toLev))
1427  {
1428  r->CleanUp();
1429  return TRUE;
1430  }
1431  }
1432  v=v->next;
1433  }
1434  r->CleanUp();
1435  return nok;
1436 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Subexpr e
Definition: subexpr.h:106
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
const ring r
Definition: syzextra.cc:208
const char * name
Definition: subexpr.h:88
leftv next
Definition: subexpr.h:87
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1315
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189

◆ iiExport() [2/2]

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

Definition at line 1439 of file ipshell.cc.

1440 {
1441 // if ((pack==basePack)&&(pack!=currPack))
1442 // { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
1443  BOOLEAN nok=FALSE;
1444  leftv rv=v;
1445  while (v!=NULL)
1446  {
1447  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
1448  )
1449  {
1450  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1451  nok=TRUE;
1452  }
1453  else
1454  {
1455  idhdl old=pack->idroot->get( v->name,toLev);
1456  if (old!=NULL)
1457  {
1458  if ((pack==currPack) && (old==(idhdl)v->data))
1459  {
1460  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
1461  break;
1462  }
1463  else if (IDTYP(old)==v->Typ())
1464  {
1465  if (BVERBOSE(V_REDEFINE))
1466  {
1467  Warn("redefining %s (%s)",IDID(old),my_yylinebuf);
1468  }
1469  v->name=omStrDup(v->name);
1470  killhdl2(old,&(pack->idroot),currRing);
1471  }
1472  else
1473  {
1474  rv->CleanUp();
1475  return TRUE;
1476  }
1477  }
1478  //Print("iiExport: pack=%s\n",IDID(root));
1479  if(iiInternalExport(v, toLev, pack))
1480  {
1481  rv->CleanUp();
1482  return TRUE;
1483  }
1484  }
1485  v=v->next;
1486  }
1487  rv->CleanUp();
1488  return nok;
1489 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Subexpr e
Definition: subexpr.h:106
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
int Typ()
Definition: subexpr.cc:995
Definition: idrec.h:34
idhdl get(const char *s, int lev)
Definition: ipid.cc:90
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
#define IDTYP(a)
Definition: ipid.h:116
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:408
char my_yylinebuf[80]
Definition: febase.cc:48
const char * name
Definition: subexpr.h:88
leftv next
Definition: subexpr.h:87
#define BVERBOSE(a)
Definition: options.h:33
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1315
#define NULL
Definition: omList.c:10
package currPack
Definition: ipid.cc:63
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
int BOOLEAN
Definition: auxiliary.h:85
#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 1511 of file ipshell.cc.

1512 {
1513  int i;
1514  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1515  poly po=NULL;
1517  {
1518  scComputeHC(I,currRing->qideal,ak,po);
1519  if (po!=NULL)
1520  {
1521  pGetCoeff(po)=nInit(1);
1522  for (i=rVar(currRing); i>0; i--)
1523  {
1524  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1525  }
1526  pSetComp(po,ak);
1527  pSetm(po);
1528  }
1529  }
1530  else
1531  po=pOne();
1532  return po;
1533 }
#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:583
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge, ring tailRing)
Definition: hdegree.cc:1005
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy ...
Definition: monomials.h:51
static BOOLEAN idIsZeroDim(ideal i)
Definition: ideals.h:161
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
#define pSetComp(p, v)
Definition: polys.h:38
int i
Definition: cfEzgcd.cc:123
#define pOne()
Definition: polys.h:297
#define rHasLocalOrMixedOrdering_currRing()
Definition: ring.h:758
#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 1315 of file ipshell.cc.

1316 {
1317  idhdl h=(idhdl)v->data;
1318  //Print("iiInternalExport('%s',%d)%s\n", v->name, toLev,"");
1319  if (IDLEV(h)==0)
1320  {
1321  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(h));
1322  }
1323  else
1324  {
1325  h=IDROOT->get(v->name,toLev);
1326  idhdl *root=&IDROOT;
1327  if ((h==NULL)&&(currRing!=NULL))
1328  {
1329  h=currRing->idroot->get(v->name,toLev);
1330  root=&currRing->idroot;
1331  }
1332  BOOLEAN keepring=FALSE;
1333  if ((h!=NULL)&&(IDLEV(h)==toLev))
1334  {
1335  if (IDTYP(h)==v->Typ())
1336  {
1337  if ((IDTYP(h)==RING_CMD)
1338  && (v->Data()==IDDATA(h)))
1339  {
1340  IDRING(h)->ref++;
1341  keepring=TRUE;
1342  IDLEV(h)=toLev;
1343  //WarnS("keepring");
1344  return FALSE;
1345  }
1346  if (BVERBOSE(V_REDEFINE))
1347  {
1348  Warn("redefining %s (%s)",IDID(h),my_yylinebuf);
1349  }
1350  if (iiLocalRing[0]==IDRING(h) && (!keepring)) iiLocalRing[0]=NULL;
1351  killhdl2(h,root,currRing);
1352  }
1353  else
1354  {
1355  return TRUE;
1356  }
1357  }
1358  h=(idhdl)v->data;
1359  IDLEV(h)=toLev;
1360  if (keepring) IDRING(h)->ref--;
1362  //Print("export %s\n",IDID(h));
1363  }
1364  return FALSE;
1365 }
if(0 > strat->sl)
Definition: myNF.cc:73
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:94
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:98
int Typ()
Definition: subexpr.cc:995
Definition: idrec.h:34
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
#define IDTYP(a)
Definition: ipid.h:116
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:408
char my_yylinebuf[80]
Definition: febase.cc:48
const char * name
Definition: subexpr.h:88
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:1137
#define IDDATA(a)
Definition: ipid.h:123
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:85
#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 1367 of file ipshell.cc.

1368 {
1369  idhdl h=(idhdl)v->data;
1370  if(h==NULL)
1371  {
1372  Warn("'%s': no such identifier\n", v->name);
1373  return FALSE;
1374  }
1375  package frompack=v->req_packhdl;
1376  if (frompack==NULL) frompack=currPack;
1377  if ((RingDependend(IDTYP(h)))
1378  || ((IDTYP(h)==LIST_CMD)
1379  && (lRingDependend(IDLIST(h)))
1380  )
1381  )
1382  {
1383  //Print("// ==> Ringdependent set nesting to 0\n");
1384  return (iiInternalExport(v, toLev));
1385  }
1386  else
1387  {
1388  IDLEV(h)=toLev;
1389  v->req_packhdl=rootpack;
1390  if (h==frompack->idroot)
1391  {
1392  frompack->idroot=h->next;
1393  }
1394  else
1395  {
1396  idhdl hh=frompack->idroot;
1397  while ((hh!=NULL) && (hh->next!=h))
1398  hh=hh->next;
1399  if ((hh!=NULL) && (hh->next==h))
1400  hh->next=h->next;
1401  else
1402  {
1403  Werror("`%s` not found",v->Name());
1404  return TRUE;
1405  }
1406  }
1407  h->next=rootpack->idroot;
1408  rootpack->idroot=h;
1409  }
1410  return FALSE;
1411 }
#define IDLIST(a)
Definition: ipid.h:134
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
const char * Name()
Definition: subexpr.h:121
Definition: idrec.h:34
void * data
Definition: subexpr.h:89
#define IDTYP(a)
Definition: ipid.h:116
int RingDependend(int t)
Definition: gentable.cc:23
const char * name
Definition: subexpr.h:88
idrec * idhdl
Definition: ring.h:18
idhdl next
Definition: idrec.h:38
#define IDLEV(a)
Definition: ipid.h:118
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1315
#define NULL
Definition: omList.c:10
package req_packhdl
Definition: subexpr.h:107
package currPack
Definition: ipid.cc:63
Definition: tok.h:117
static Poly * h
Definition: janet.cc:978
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:199
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define Warn
Definition: emacs.cc:80

◆ iiMakeResolv()

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

Definition at line 766 of file ipshell.cc.

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

◆ iiMap()

leftv iiMap ( map  theMap,
const char *  what 
)

Definition at line 607 of file ipshell.cc.

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

1280 {
1281  if (iiCurrArgs==NULL)
1282  {
1283  if (strcmp(p->name,"#")==0)
1284  return iiDefaultParameter(p);
1285  Werror("not enough arguments for proc %s",VoiceName());
1286  p->CleanUp();
1287  return TRUE;
1288  }
1289  leftv h=iiCurrArgs;
1290  leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1291  BOOLEAN is_default_list=FALSE;
1292  if (strcmp(p->name,"#")==0)
1293  {
1294  is_default_list=TRUE;
1295  rest=NULL;
1296  }
1297  else
1298  {
1299  h->next=NULL;
1300  }
1301  BOOLEAN res=iiAssign(p,h);
1302  if (is_default_list)
1303  {
1304  iiCurrArgs=NULL;
1305  }
1306  else
1307  {
1308  iiCurrArgs=rest;
1309  }
1310  h->CleanUp();
1312  return res;
1313 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
void * ADDRESS
Definition: auxiliary.h:115
poly res
Definition: myNF.cc:322
const char * name
Definition: subexpr.h:88
omBin sleftv_bin
Definition: subexpr.cc:50
const char * VoiceName()
Definition: fevoices.cc:66
leftv next
Definition: subexpr.h:87
#define NULL
Definition: omList.c:10
BOOLEAN iiDefaultParameter(leftv p)
Definition: ipshell.cc:1166
leftv iiCurrArgs
Definition: ipshell.cc:78
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1793

◆ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 956 of file ipshell.cc.

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

◆ iiReportTypes()

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

Definition at line 6452 of file ipshell.cc.

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

◆ iiTestAssume()

BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6353 of file ipshell.cc.

6354 {
6355  // assume a: level
6356  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6357  {
6358  if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6359  char assume_yylinebuf[80];
6360  strncpy(assume_yylinebuf,my_yylinebuf,79);
6361  int lev=(long)a->Data();
6362  int startlev=0;
6363  idhdl h=ggetid("assumeLevel");
6364  if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6365  if(lev <=startlev)
6366  {
6367  BOOLEAN bo=b->Eval();
6368  if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6369  if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6370  if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6371  }
6372  }
6373  b->CleanUp();
6374  a->CleanUp();
6375  return FALSE;
6376 }
int Eval()
Definition: subexpr.cc:1760
Definition: tok.h:95
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define WarnS
Definition: emacs.cc:81
int Typ()
Definition: subexpr.cc:995
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:332
void * Data()
Definition: subexpr.cc:1137
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:85
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:495

◆ 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:132

◆ iiWRITE()

BOOLEAN iiWRITE ( leftv  ,
leftv  v 
)

Definition at line 580 of file ipshell.cc.

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

887 {
888  sleftv tmp;
889  memset(&tmp,0,sizeof(tmp));
890  tmp.rtyp=INT_CMD;
891  tmp.data=(void *)1;
892  if ((u->Typ()==IDEAL_CMD)
893  || (u->Typ()==MODUL_CMD))
894  return jjBETTI2_ID(res,u,&tmp);
895  else
896  return jjBETTI2(res,u,&tmp);
897 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:95
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:920
int Typ()
Definition: subexpr.cc:995
void * data
Definition: subexpr.h:89
int rtyp
Definition: subexpr.h:92
BOOLEAN jjBETTI2_ID(leftv res, leftv u, leftv v)
Definition: ipshell.cc:899

◆ jjBETTI2()

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

Definition at line 920 of file ipshell.cc.

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

◆ jjBETTI2_ID()

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

Definition at line 899 of file ipshell.cc.

900 {
902  l->Init(1);
903  l->m[0].rtyp=u->Typ();
904  l->m[0].data=u->Data();
905  attr *a=u->Attribute();
906  if (a!=NULL)
907  l->m[0].attribute=*a;
908  sleftv tmp2;
909  memset(&tmp2,0,sizeof(tmp2));
910  tmp2.rtyp=LIST_CMD;
911  tmp2.data=(void *)l;
912  BOOLEAN r=jjBETTI2(res,&tmp2,v);
913  l->m[0].data=NULL;
914  l->m[0].attribute=NULL;
915  l->m[0].rtyp=DEF_CMD;
916  l->Clean();
917  return r;
918 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
const poly a
Definition: syzextra.cc:212
Definition: attrib.h:15
Definition: lists.h:22
attr * Attribute()
Definition: subexpr.cc:1392
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:920
int Typ()
Definition: subexpr.cc:995
void * data
Definition: subexpr.h:89
const ring r
Definition: syzextra.cc:208
Definition: tok.h:58
CFList tmp2
Definition: facFqBivar.cc:70
INLINE_THIS void Init(int l=0)
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void Clean(ring r=currRing)
Definition: lists.h:25
void * Data()
Definition: subexpr.cc:1137
Definition: tok.h:117
attr attribute
Definition: subexpr.h:90
omBin slists_bin
Definition: lists.cc:23
int BOOLEAN
Definition: auxiliary.h:85
int l
Definition: cfEzgcd.cc:94

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3267 of file ipshell.cc.

3268 {
3269  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3270  return (res->data==NULL);
3271 }
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition: clapsing.cc:1385
#define NULL
Definition: omList.c:10
void * Data()
Definition: subexpr.cc:1137

◆ jjINT_S_TO_ID()

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

Definition at line 6196 of file ipshell.cc.

6197 {
6198  if (n==0) n=1;
6199  ideal l=idInit(n,1);
6200  int i;
6201  poly p;
6202  for(i=rVar(currRing);i>0;i--)
6203  {
6204  if (e[i]>0)
6205  {
6206  n--;
6207  p=pOne();
6208  pSetExp(p,i,1);
6209  pSetm(p);
6210  l->m[n]=p;
6211  if (n==0) break;
6212  }
6213  }
6214  res->data=(char*)l;
6215  setFlag(res,FLAG_STD);
6216  omFreeSize((ADDRESS)e,(rVar(currRing)+1)*sizeof(int));
6217 }
#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:583
void * ADDRESS
Definition: auxiliary.h:115
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
#define setFlag(A, F)
Definition: ipid.h:110
int i
Definition: cfEzgcd.cc:123
#define pOne()
Definition: polys.h:297
#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 865 of file ipshell.cc.

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

◆ jjPROC()

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

Definition at line 1599 of file iparith.cc.

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

3261 {
3262  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3263  (poly)w->CopyD(), currRing);
3264  return errorreported;
3265 }
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition: clapsing.cc:304
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
short errorreported
Definition: feFopen.cc:23
polyrec * poly
Definition: hilb.h:10
void * CopyD(int t)
Definition: subexpr.cc:707

◆ jjVARIABLES_ID()

BOOLEAN jjVARIABLES_ID ( leftv  res,
leftv  u 
)

Definition at line 6226 of file ipshell.cc.

6227 {
6228  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6229  ideal I=(ideal)u->Data();
6230  int i;
6231  int n=0;
6232  for(i=I->nrows*I->ncols-1;i>=0;i--)
6233  {
6234  int n0=pGetVariables(I->m[i],e);
6235  if (n0>n) n=n0;
6236  }
6237  jjINT_S_TO_ID(n,e,res);
6238  return FALSE;
6239 }
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6196
#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:1137
#define omAlloc0(size)
Definition: omAllocDecl.h:211

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6218 of file ipshell.cc.

6219 {
6220  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6221  int n=pGetVariables((poly)u->Data(),e);
6222  jjINT_S_TO_ID(n,e,res);
6223  return FALSE;
6224 }
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6196
#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:1137
polyrec * poly
Definition: hilb.h:10
#define omAlloc0(size)
Definition: omAllocDecl.h:211

◆ kGroebner()

ideal kGroebner ( ideal  F,
ideal  Q 
)

Definition at line 6151 of file ipshell.cc.

6152 {
6153  //test|=Sy_bit(OPT_PROT);
6154  idhdl save_ringhdl=currRingHdl;
6155  ideal resid;
6156  idhdl new_ring=NULL;
6157  if ((currRingHdl==NULL) || (IDRING(currRingHdl)!=currRing))
6158  {
6159  currRingHdl=enterid(omStrDup(" GROEBNERring"),0,RING_CMD,&IDROOT,FALSE);
6160  new_ring=currRingHdl;
6162  }
6163  sleftv v; memset(&v,0,sizeof(v)); v.rtyp=IDEAL_CMD; v.data=(char *) F;
6164  idhdl h=ggetid("groebner");
6165  sleftv u; memset(&u,0,sizeof(u)); u.rtyp=IDHDL; u.data=(char *) h;
6166  u.name=IDID(h);
6167 
6168  sleftv res; memset(&res,0,sizeof(res));
6169  if(jjPROC(&res,&u,&v))
6170  {
6171  resid=kStd(F,Q,testHomog,NULL);
6172  }
6173  else
6174  {
6175  //printf("typ:%d\n",res.rtyp);
6176  resid=(ideal)(res.data);
6177  }
6178  // cleanup GROEBNERring, save_ringhdl, u,v,(res )
6179  if (new_ring!=NULL)
6180  {
6181  idhdl h=IDROOT;
6182  if (h==new_ring) IDROOT=h->next;
6183  else
6184  {
6185  while ((h!=NULL) &&(h->next!=new_ring)) h=h->next;
6186  if (h!=NULL) h->next=h->next->next;
6187  }
6188  if (h!=NULL) omFreeSize(h,sizeof(*h));
6189  }
6190  currRingHdl=save_ringhdl;
6191  u.CleanUp();
6192  v.CleanUp();
6193  return resid;
6194 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:94
BOOLEAN jjPROC(leftv res, leftv u, leftv v)
Definition: iparith.cc:1599
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define IDROOT
Definition: ipid.h:20
ideal kStd(ideal F, ideal Q, tHomog h, intvec **w, intvec *hilb, int syzComp, int newIdeal, intvec *vw, s_poly_proc_t sp)
Definition: kstd1.cc:2231
#define Q
Definition: sirandom.c:25
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:31
void * data
Definition: subexpr.h:89
poly res
Definition: myNF.cc:322
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:258
const char * name
Definition: subexpr.h:88
idhdl currRingHdl
Definition: ipid.cc:65
idhdl next
Definition: idrec.h:38
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:124
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
static Poly * h
Definition: janet.cc:978
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:495
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ killlocals()

void killlocals ( int  v)

Definition at line 378 of file ipshell.cc.

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

◆ killlocals0()

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

Definition at line 287 of file ipshell.cc.

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

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

◆ killlocals_rec()

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

Definition at line 322 of file ipshell.cc.

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

3244 {
3245  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3246  if (res->data==NULL)
3247  res->data=(char *)new intvec(rVar(currRing));
3248  return FALSE;
3249 }
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
intvec * id_QHomWeight(ideal id, const ring r)
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
Definition: intvec.h:14
#define NULL
Definition: omList.c:10
void * Data()
Definition: subexpr.cc:1137

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3221 of file ipshell.cc.

3222 {
3223  ideal F=(ideal)id->Data();
3224  intvec * iv = new intvec(rVar(currRing));
3225  polyset s;
3226  int sl, n, i;
3227  int *x;
3228 
3229  res->data=(char *)iv;
3230  s = F->m;
3231  sl = IDELEMS(F) - 1;
3232  n = rVar(currRing);
3233  double wNsqr = (double)2.0 / (double)n;
3235  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3236  wCall(s, sl, x, wNsqr, currRing);
3237  for (i = n; i!=0; i--)
3238  (*iv)[i-1] = x[i + n + 1];
3239  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3240  return FALSE;
3241 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define FALSE
Definition: auxiliary.h:94
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
void * ADDRESS
Definition: auxiliary.h:115
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
Definition: intvec.h:14
double(* wFunctional)(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight.cc:28
int i
Definition: cfEzgcd.cc:123
#define IDELEMS(i)
Definition: simpleideals.h:24
poly * polyset
Definition: hutil.h:15
void wCall(poly *s, int sl, int *x, double wNsqr, const ring R)
Definition: weight.cc:116
Variable x
Definition: cfModGcd.cc:4023
void * Data()
Definition: subexpr.cc:1137
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)->language==LANG_C)
195  PrintS(" (C)");
196  if(IDPROC(h)->is_static)
197  PrintS(" (static)");
198  break;
199  case STRING_CMD:
200  {
201  char *s;
202  l=strlen(IDSTRING(h));
203  memset(buffer,0,22);
204  strncpy(buffer,IDSTRING(h),si_min(l,20));
205  if ((s=strchr(buffer,'\n'))!=NULL)
206  {
207  *s='\0';
208  }
209  PrintS(" ");
210  PrintS(buffer);
211  if((s!=NULL) ||(l>20))
212  {
213  Print("..., %d char(s)",l);
214  }
215  break;
216  }
217  case LIST_CMD: Print(", size: %d",IDLIST(h)->nr+1);
218  break;
219  case RING_CMD:
220  if ((IDRING(h)==currRing) && (currRingHdl!=h))
221  PrintS("(*)"); /* this is an alias to currRing */
222 #ifdef RDEBUG
224  Print(" <%lx>",(long)(IDRING(h)));
225 #endif
226  break;
227 #ifdef SINGULAR_4_2
228  case CNUMBER_CMD:
229  { number2 n=(number2)IDDATA(h);
230  Print(" (%s)",nCoeffName(n->cf));
231  break;
232  }
233  case CMATRIX_CMD:
234  { bigintmat *b=(bigintmat*)IDDATA(h);
235  Print(" %d x %d (%s)",
236  b->rows(),b->cols(),
237  nCoeffName(b->basecoeffs()));
238  break;
239  }
240 #endif
241  /*default: break;*/
242  }
243  PrintLn();
244 }
#define IDLIST(a)
Definition: ipid.h:134
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define TRACE_SHOW_RINGS
Definition: reporter.h:35
void PrintLn()
Definition: reporter.cc:310
#define Print
Definition: emacs.cc:83
Definition: tok.h:95
#define IDINTVEC(a)
Definition: ipid.h:125
#define IDID(a)
Definition: ipid.h:119
static int si_min(const int a, const int b)
Definition: auxiliary.h:121
Matrices of numbers.
Definition: bigintmat.h:51
int rows() const
Definition: bigintmat.h:146
#define IDIDEAL(a)
Definition: ipid.h:130
int traceit
Definition: febase.cc:47
Definition: idrec.h:34
void ipListFlag(idhdl h)
Definition: ipid.cc:524
Definition: subexpr.h:22
#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:980
#define IDSTRING(a)
Definition: ipid.h:133
idhdl currRingHdl
Definition: ipid.cc:65
int cols() const
Definition: bigintmat.h:145
void PrintS(const char *s)
Definition: reporter.cc:284
static unsigned pLength(poly a)
Definition: p_polys.h:189
#define IDELEMS(i)
Definition: simpleideals.h:24
#define IDLEV(a)
Definition: ipid.h:118
#define IDMAP(a)
Definition: ipid.h:132
CanonicalForm buf2
Definition: facFqBivar.cc:71
Definition: tok.h:34
#define IDPROC(a)
Definition: ipid.h:137
void paPrint(const char *n, package p)
Definition: ipshell.cc:6241
#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:132
#define IDPOLY(a)
Definition: ipid.h:127
coeffs basecoeffs() const
Definition: bigintmat.h:147
#define IDRING(a)
Definition: ipid.h:124
Definition: tok.h:117
#define MATROWS(i)
Definition: matpol.h:27
void wrp(poly p)
Definition: polys.h:292
#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 417 of file ipshell.cc.

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

◆ list_error()

void list_error ( semicState  state)

Definition at line 3388 of file ipshell.cc.

3389 {
3390  switch( state )
3391  {
3392  case semicListTooShort:
3393  WerrorS( "the list is too short" );
3394  break;
3395  case semicListTooLong:
3396  WerrorS( "the list is too long" );
3397  break;
3398 
3400  WerrorS( "first element of the list should be int" );
3401  break;
3403  WerrorS( "second element of the list should be int" );
3404  break;
3406  WerrorS( "third element of the list should be int" );
3407  break;
3409  WerrorS( "fourth element of the list should be intvec" );
3410  break;
3412  WerrorS( "fifth element of the list should be intvec" );
3413  break;
3415  WerrorS( "sixth element of the list should be intvec" );
3416  break;
3417 
3418  case semicListNNegative:
3419  WerrorS( "first element of the list should be positive" );
3420  break;
3422  WerrorS( "wrong number of numerators" );
3423  break;
3425  WerrorS( "wrong number of denominators" );
3426  break;
3428  WerrorS( "wrong number of multiplicities" );
3429  break;
3430 
3431  case semicListMuNegative:
3432  WerrorS( "the Milnor number should be positive" );
3433  break;
3434  case semicListPgNegative:
3435  WerrorS( "the geometrical genus should be nonnegative" );
3436  break;
3437  case semicListNumNegative:
3438  WerrorS( "all numerators should be positive" );
3439  break;
3440  case semicListDenNegative:
3441  WerrorS( "all denominators should be positive" );
3442  break;
3443  case semicListMulNegative:
3444  WerrorS( "all multiplicities should be positive" );
3445  break;
3446 
3447  case semicListNotSymmetric:
3448  WerrorS( "it is not symmetric" );
3449  break;
3451  WerrorS( "it is not monotonous" );
3452  break;
3453 
3454  case semicListMilnorWrong:
3455  WerrorS( "the Milnor number is wrong" );
3456  break;
3457  case semicListPGWrong:
3458  WerrorS( "the geometrical genus is wrong" );
3459  break;
3460 
3461  default:
3462  WerrorS( "unspecific error" );
3463  break;
3464  }
3465 }
void WerrorS(const char *s)
Definition: feFopen.cc:24

◆ list_is_spectrum()

semicState list_is_spectrum ( lists  l)

Definition at line 4173 of file ipshell.cc.

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

◆ listOfRoots()

lists listOfRoots ( rootArranger self,
const unsigned int  oprec 
)

Definition at line 4985 of file ipshell.cc.

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

◆ loNewtonP()

BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4483 of file ipshell.cc.

4484 {
4485  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4486  return FALSE;
4487 }
#define FALSE
Definition: auxiliary.h:94
ideal loNewtonPolytope(const ideal id)
Definition: mpr_base.cc:3190
void * data
Definition: subexpr.h:89
void * Data()
Definition: subexpr.cc:1137

◆ loSimplex()

BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4489 of file ipshell.cc.

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

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 2991 of file ipshell.cc.

2992 {
2993  int i,j;
2994  matrix result;
2995  ideal id=(ideal)a->Data();
2996 
2997  result =mpNew(IDELEMS(id),rVar(currRing));
2998  for (i=1; i<=IDELEMS(id); i++)
2999  {
3000  for (j=1; j<=rVar(currRing); j++)
3001  {
3002  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
3003  }
3004  }
3005  res->data=(char *)result;
3006  return FALSE;
3007 }
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
int j
Definition: myNF.cc:70
int i
Definition: cfEzgcd.cc:123
#define IDELEMS(i)
Definition: simpleideals.h:24
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:47
void * Data()
Definition: subexpr.cc:1137
#define pDiff(a, b)
Definition: polys.h:278
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 3013 of file ipshell.cc.

3014 {
3015  int n=(int)(long)b->Data();
3016  int d=(int)(long)c->Data();
3017  int k,l,sign,row,col;
3018  matrix result;
3019  ideal temp;
3020  BOOLEAN bo;
3021  poly p;
3022 
3023  if ((d>n) || (d<1) || (n<1))
3024  {
3025  res->data=(char *)mpNew(1,1);
3026  return FALSE;
3027  }
3028  int *choise = (int*)omAlloc(d*sizeof(int));
3029  if (id==NULL)
3030  temp=idMaxIdeal(1);
3031  else
3032  temp=(ideal)id->Data();
3033 
3034  k = binom(n,d);
3035  l = k*d;
3036  l /= n-d+1;
3037  result =mpNew(l,k);
3038  col = 1;
3039  idInitChoise(d,1,n,&bo,choise);
3040  while (!bo)
3041  {
3042  sign = 1;
3043  for (l=1;l<=d;l++)
3044  {
3045  if (choise[l-1]<=IDELEMS(temp))
3046  {
3047  p = pCopy(temp->m[choise[l-1]-1]);
3048  if (sign == -1) p = pNeg(p);
3049  sign *= -1;
3050  row = idGetNumberOfChoise(l-1,d,1,n,choise);
3051  MATELEM(result,row,col) = p;
3052  }
3053  }
3054  col++;
3055  idGetNextChoise(d,n,&bo,choise);
3056  }
3057  if (id==NULL) idDelete(&temp);
3058 
3059  res->data=(char *)result;
3060  return FALSE;
3061 }
#define idMaxIdeal(D)
initialise the maximal ideal (at 0)
Definition: ideals.h:33
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
#define FALSE
Definition: auxiliary.h:94
return P p
Definition: myNF.cc:203
#define pNeg(p)
Definition: polys.h:181
int k
Definition: cfEzgcd.cc:93
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:89
void idGetNextChoise(int r, int end, BOOLEAN *endch, int *choise)
#define IDELEMS(i)
Definition: simpleideals.h:24
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:47
#define NULL
Definition: omList.c:10
void idInitChoise(int r, int beg, int end, BOOLEAN *endch, int *choise)
void * Data()
Definition: subexpr.cc:1137
int idGetNumberOfChoise(int t, int d, int begin, int end, int *choise)
polyrec * poly
Definition: hilb.h:10
int BOOLEAN
Definition: auxiliary.h:85
static int sign(int x)
Definition: ring.cc:3333
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 4598 of file ipshell.cc.

4599 {
4600 
4601  poly gls;
4602  gls= (poly)(arg1->Data());
4603  int howclean= (int)(long)arg3->Data();
4604 
4605  if ( !(rField_is_R(currRing) ||
4606  rField_is_Q(currRing) ||
4609  {
4610  WerrorS("Ground field not implemented!");
4611  return TRUE;
4612  }
4613 
4616  {
4617  unsigned long int ii = (unsigned long int)arg2->Data();
4618  setGMPFloatDigits( ii, ii );
4619  }
4620 
4621  if ( gls == NULL || pIsConstant( gls ) )
4622  {
4623  WerrorS("Input polynomial is constant!");
4624  return TRUE;
4625  }
4626 
4627  int ldummy;
4628  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4629  int i,vpos=0;
4630  poly piter;
4631  lists elist;
4632  lists rlist;
4633 
4634  elist= (lists)omAlloc( sizeof(slists) );
4635  elist->Init( 0 );
4636 
4637  if ( rVar(currRing) > 1 )
4638  {
4639  piter= gls;
4640  for ( i= 1; i <= rVar(currRing); i++ )
4641  if ( pGetExp( piter, i ) )
4642  {
4643  vpos= i;
4644  break;
4645  }
4646  while ( piter )
4647  {
4648  for ( i= 1; i <= rVar(currRing); i++ )
4649  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4650  {
4651  WerrorS("The input polynomial must be univariate!");
4652  return TRUE;
4653  }
4654  pIter( piter );
4655  }
4656  }
4657 
4658  rootContainer * roots= new rootContainer();
4659  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4660  piter= gls;
4661  for ( i= deg; i >= 0; i-- )
4662  {
4663  if ( piter && pTotaldegree(piter) == i )
4664  {
4665  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4666  //nPrint( pcoeffs[i] );PrintS(" ");
4667  pIter( piter );
4668  }
4669  else
4670  {
4671  pcoeffs[i]= nInit(0);
4672  }
4673  }
4674 
4675 #ifdef mprDEBUG_PROT
4676  for (i=deg; i >= 0; i--)
4677  {
4678  nPrint( pcoeffs[i] );PrintS(" ");
4679  }
4680  PrintLn();
4681 #endif
4682 
4683  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4684  roots->solver( howclean );
4685 
4686  int elem= roots->getAnzRoots();
4687  char *dummy;
4688  int j;
4689 
4690  rlist= (lists)omAlloc( sizeof(slists) );
4691  rlist->Init( elem );
4692 
4694  {
4695  for ( j= 0; j < elem; j++ )
4696  {
4697  rlist->m[j].rtyp=NUMBER_CMD;
4698  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4699  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4700  }
4701  }
4702  else
4703  {
4704  for ( j= 0; j < elem; j++ )
4705  {
4706  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4707  rlist->m[j].rtyp=STRING_CMD;
4708  rlist->m[j].data=(void *)dummy;
4709  }
4710  }
4711 
4712  elist->Clean();
4713  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4714 
4715  // this is (via fillContainer) the same data as in root
4716  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4717  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4718 
4719  delete roots;
4720 
4721  res->rtyp= LIST_CMD;
4722  res->data= (void*)rlist;
4723 
4724  return FALSE;
4725 }
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:94
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:510
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
#define TRUE
Definition: auxiliary.h:98
bool solver(const int polishmode=PM_NONE)
Definition: mpr_numeric.cc:449
void WerrorS(const char *s)
Definition: feFopen.cc:24
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy ...
Definition: monomials.h:51
#define omAlloc(size)
Definition: omAllocDecl.h:210
#define nPrint(a)
only for debug, over any initalized currRing
Definition: numbers.h:46
void * data
Definition: subexpr.h:89
#define pIter(p)
Definition: monomials.h:44
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
int j
Definition: myNF.cc:70
static long pTotaldegree(poly p)
Definition: polys.h:264
#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:537
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:534
int rtyp
Definition: subexpr.h:92
#define nCopy(n)
Definition: numbers.h:15
void Clean(ring r=currRing)
Definition: lists.h:25
void * Data()
Definition: subexpr.cc:1137
Definition: tok.h:117
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition: mpr_complex.cc:706
size_t gmp_output_digits
Definition: mpr_complex.cc:44
void setGMPFloatDigits(size_t digits, size_t rest)
Set size of mantissa digits - the number of output digits (basis 10) the size of mantissa consists of...
Definition: mpr_complex.cc:62
polyrec * poly
Definition: hilb.h:10
#define nInit(i)
Definition: numbers.h:24

◆ nuMPResMat()

BOOLEAN nuMPResMat ( leftv  res,
leftv  arg1,
leftv  arg2 
)

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

Definition at line 4575 of file ipshell.cc.

4576 {
4577  ideal gls = (ideal)(arg1->Data());
4578  int imtype= (int)(long)arg2->Data();
4579 
4580  uResultant::resMatType mtype= determineMType( imtype );
4581 
4582  // check input ideal ( = polynomial system )
4583  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4584  {
4585  return TRUE;
4586  }
4587 
4588  uResultant *resMat= new uResultant( gls, mtype, false );
4589  if (resMat!=NULL)
4590  {
4591  res->rtyp = MODUL_CMD;
4592  res->data= (void*)resMat->accessResMat()->getMatrix();
4593  if (!errorreported) delete resMat;
4594  }
4595  return errorreported;
4596 }
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:98
uResultant::resMatType determineMType(int imtype)
const char * Name()
Definition: subexpr.h:121
Definition: mpr_base.h:98
void * data
Definition: subexpr.h:89
virtual ideal getMatrix()
Definition: mpr_base.h:31
mprState mprIdealCheck(const ideal theIdeal, const char *name, uResultant::resMatType mtype, BOOLEAN rmatrix=false)
short errorreported
Definition: feFopen.cc:23
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1137

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

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

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

6242 {
6243  Print(" %s (",n);
6244  switch (p->language)
6245  {
6246  case LANG_SINGULAR: PrintS("S"); break;
6247  case LANG_C: PrintS("C"); break;
6248  case LANG_TOP: PrintS("T"); break;
6249  case LANG_NONE: PrintS("N"); break;
6250  default: PrintS("U");
6251  }
6252  if(p->libname!=NULL)
6253  Print(",%s", p->libname);
6254  PrintS(")");
6255 }
#define Print
Definition: emacs.cc:83
return P p
Definition: myNF.cc:203
Definition: subexpr.h:22
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 2725 of file ipshell.cc.

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

◆ rComposeC()

void rComposeC ( lists  L,
ring  R 
)

Definition at line 2225 of file ipshell.cc.

2227 {
2228  // ----------------------------------------
2229  // 0: char/ cf - ring
2230  if ((L->m[0].rtyp!=INT_CMD) || (L->m[0].data!=(char *)0))
2231  {
2232  WerrorS("invalid coeff. field description, expecting 0");
2233  return;
2234  }
2235 // R->cf->ch=0;
2236  // ----------------------------------------
2237  // 1:
2238  if (L->m[1].rtyp!=LIST_CMD)
2239  {
2240  WerrorS("invalid coeff. field description, expecting precision list");
2241  return;
2242  }
2243  lists LL=(lists)L->m[1].data;
2244  if (((LL->nr!=2)
2245  || (LL->m[0].rtyp!=INT_CMD)
2246  || (LL->m[1].rtyp!=INT_CMD))
2247  && ((LL->nr!=1)
2248  || (LL->m[0].rtyp!=INT_CMD)))
2249  {
2250  WerrorS("invalid coeff. field description list");
2251  return;
2252  }
2253  int r1=(int)(long)LL->m[0].data;
2254  int r2=(int)(long)LL->m[1].data;
2255  if (L->nr==2) // complex
2256  R->cf = nInitChar(n_long_C, NULL);
2257  else if ((r1<=SHORT_REAL_LENGTH)
2258  && (r2=SHORT_REAL_LENGTH))
2259  R->cf = nInitChar(n_R, NULL);
2260  else
2261  {
2263  p->float_len=r1;
2264  p->float_len2=r2;
2265  R->cf = nInitChar(n_long_R, NULL);
2266  }
2267 
2268  if ((r1<=SHORT_REAL_LENGTH) // should go into nInitChar
2269  && (r2=SHORT_REAL_LENGTH))
2270  {
2271  R->cf->float_len=SHORT_REAL_LENGTH/2;
2272  R->cf->float_len2=SHORT_REAL_LENGTH;
2273  }
2274  else
2275  {
2276  R->cf->float_len=si_min(r1,32767);
2277  R->cf->float_len2=si_min(r2,32767);
2278  }
2279  // ----------------------------------------
2280  // 2: list (par)
2281  if (L->nr==2)
2282  {
2283  //R->cf->extRing->N=1;
2284  if (L->m[2].rtyp!=STRING_CMD)
2285  {
2286  WerrorS("invalid coeff. field description, expecting parameter name");
2287  return;
2288  }
2289  //(rParameter(R))=(char**)omAlloc0(rPar(R)*sizeof(char_ptr));
2290  rParameter(R)[0]=omStrDup((char *)L->m[2].data);
2291  }
2292  // ----------------------------------------
2293 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
#define SHORT_REAL_LENGTH
Definition: numbers.h:54
Definition: lists.h:22
if(0 > strat->sl)
Definition: myNF.cc:73
static int si_min(const int a, const int b)
Definition: auxiliary.h:121
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:616
real floating point (GMP) numbers
Definition: coeffs.h:34
short float_len2
additional char-flags, rInit
Definition: coeffs.h:102
void * data
Definition: subexpr.h:89
single prescision (6,6) real numbers
Definition: coeffs.h:32
short float_len
additional char-flags, rInit
Definition: coeffs.h:101
const ring R
Definition: DebugPrint.cc:36
complex floating point (GMP) numbers
Definition: coeffs.h:42
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
Definition: tok.h:117
#define omAlloc0(size)
Definition: omAllocDecl.h:211
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:341
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rComposeOrder()

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

Definition at line 2475 of file ipshell.cc.

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

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

◆ rComposeVar()

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

Definition at line 2430 of file ipshell.cc.

2431 {
2432  assume(R!=NULL);
2433  if (L->m[1].Typ()==LIST_CMD)
2434  {
2435  lists v=(lists)L->m[1].Data();
2436  R->N = v->nr+1;
2437  if (R->N<=0)
2438  {
2439  WerrorS("no ring variables");
2440  return TRUE;
2441  }
2442  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
2443  int i;
2444  for(i=0;i<R->N;i++)
2445  {
2446  if (v->m[i].Typ()==STRING_CMD)
2447  R->names[i]=omStrDup((char *)v->m[i].Data());
2448  else if (v->m[i].Typ()==POLY_CMD)
2449  {
2450  poly p=(poly)v->m[i].Data();
2451  int nr=pIsPurePower(p);
2452  if (nr>0)
2453  R->names[i]=omStrDup(currRing->names[nr-1]);
2454  else
2455  {
2456  Werror("var name %d must be a string or a ring variable",i+1);
2457  return TRUE;
2458  }
2459  }
2460  else
2461  {
2462  Werror("var name %d must be `string`",i+1);
2463  return TRUE;
2464  }
2465  }
2466  }
2467  else
2468  {
2469  WerrorS("variable must be given as `list`");
2470  return TRUE;
2471  }
2472  return FALSE;
2473 }
#define pIsPurePower(p)
Definition: polys.h:231
sleftv * m
Definition: lists.h:45
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
return P p
Definition: myNF.cc:203
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:995
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:394
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:1137
Definition: tok.h:117
polyrec * poly
Definition: hilb.h:10
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define omAlloc0(size)
Definition: omAllocDecl.h:211
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2040 of file ipshell.cc.

2041 {
2042  assume( r != NULL );
2043  const coeffs C = r->cf;
2044  assume( C != NULL );
2045 
2046  // sanity check: require currRing==r for rings with polynomial data
2047  if ( (r!=currRing) && (
2048  (nCoeff_is_algExt(C) && (C != currRing->cf))
2049  || (r->qideal != NULL)
2050 #ifdef HAVE_PLURAL
2051  || (rIsPluralRing(r))
2052 #endif
2053  )
2054  )
2055  {
2056  WerrorS("ring with polynomial data must be the base ring or compatible");
2057  return NULL;
2058  }
2059  // 0: char/ cf - ring
2060  // 1: list (var)
2061  // 2: list (ord)
2062  // 3: qideal
2063  // possibly:
2064  // 4: C
2065  // 5: D
2067  if (rIsPluralRing(r))
2068  L->Init(6);
2069  else
2070  L->Init(4);
2071  // ----------------------------------------
2072  // 0: char/ cf - ring
2073  if (rField_is_numeric(r))
2074  {
2075  rDecomposeC(&(L->m[0]),r);
2076  }
2077  else if (rField_is_Ring(r))
2078  {
2079  rDecomposeRing(&(L->m[0]),r);
2080  }
2081  else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2082  {
2083  rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2084  }
2085  else if(rField_is_GF(r))
2086  {
2088  Lc->Init(4);
2089  // char:
2090  Lc->m[0].rtyp=INT_CMD;
2091  Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2092  // var:
2094  Lv->Init(1);
2095  Lv->m[0].rtyp=STRING_CMD;
2096  Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2097  Lc->m[1].rtyp=LIST_CMD;
2098  Lc->m[1].data=(void*)Lv;
2099  // ord:
2101  Lo->Init(1);
2103  Loo->Init(2);
2104  Loo->m[0].rtyp=STRING_CMD;
2105  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2106 
2107  intvec *iv=new intvec(1); (*iv)[0]=1;
2108  Loo->m[1].rtyp=INTVEC_CMD;
2109  Loo->m[1].data=(void *)iv;
2110 
2111  Lo->m[0].rtyp=LIST_CMD;
2112  Lo->m[0].data=(void*)Loo;
2113 
2114  Lc->m[2].rtyp=LIST_CMD;
2115  Lc->m[2].data=(void*)Lo;
2116  // q-ideal:
2117  Lc->m[3].rtyp=IDEAL_CMD;
2118  Lc->m[3].data=(void *)idInit(1,1);
2119  // ----------------------
2120  L->m[0].rtyp=LIST_CMD;
2121  L->m[0].data=(void*)Lc;
2122  }
2123  else
2124  {
2125  L->m[0].rtyp=INT_CMD;
2126  L->m[0].data=(void *)(long)r->cf->ch;
2127  }
2128  // ----------------------------------------
2129  // 1: list (var)
2131  LL->Init(r->N);
2132  int i;
2133  for(i=0; i<r->N; i++)
2134  {
2135  LL->m[i].rtyp=STRING_CMD;
2136  LL->m[i].data=(void *)omStrDup(r->names[i]);
2137  }
2138  L->m[1].rtyp=LIST_CMD;
2139  L->m[1].data=(void *)LL;
2140  // ----------------------------------------
2141  // 2: list (ord)
2143  i=rBlocks(r)-1;
2144  LL->Init(i);
2145  i--;
2146  lists LLL;
2147  for(; i>=0; i--)
2148  {
2149  intvec *iv;
2150  int j;
2151  LL->m[i].rtyp=LIST_CMD;
2153  LLL->Init(2);
2154  LLL->m[0].rtyp=STRING_CMD;
2155  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2156 
2157  if(r->order[i] == ringorder_IS) // || r->order[i] == ringorder_s || r->order[i] == ringorder_S)
2158  {
2159  assume( r->block0[i] == r->block1[i] );
2160  const int s = r->block0[i];
2161  assume( -2 < s && s < 2);
2162 
2163  iv=new intvec(1);
2164  (*iv)[0] = s;
2165  }
2166  else if (r->block1[i]-r->block0[i] >=0 )
2167  {
2168  int bl=j=r->block1[i]-r->block0[i];
2169  if (r->order[i]==ringorder_M)
2170  {
2171  j=(j+1)*(j+1)-1;
2172  bl=j+1;
2173  }
2174  else if (r->order[i]==ringorder_am)
2175  {
2176  j+=r->wvhdl[i][bl+1];
2177  }
2178  iv=new intvec(j+1);
2179  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2180  {
2181  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2182  }
2183  else switch (r->order[i])
2184  {
2185  case ringorder_dp:
2186  case ringorder_Dp:
2187  case ringorder_ds:
2188  case ringorder_Ds:
2189  case ringorder_lp:
2190  for(;j>=0; j--) (*iv)[j]=1;
2191  break;
2192  default: /* do nothing */;
2193  }
2194  }
2195  else
2196  {
2197  iv=new intvec(1);
2198  }
2199  LLL->m[1].rtyp=INTVEC_CMD;
2200  LLL->m[1].data=(void *)iv;
2201  LL->m[i].data=(void *)LLL;
2202  }
2203  L->m[2].rtyp=LIST_CMD;
2204  L->m[2].data=(void *)LL;
2205  // ----------------------------------------
2206  // 3: qideal
2207  L->m[3].rtyp=IDEAL_CMD;
2208  if (r->qideal==NULL)
2209  L->m[3].data=(void *)idInit(1,1);
2210  else
2211  L->m[3].data=(void *)idCopy(r->qideal);
2212  // ----------------------------------------
2213 #ifdef HAVE_PLURAL // NC! in rDecompose
2214  if (rIsPluralRing(r))
2215  {
2216  L->m[4].rtyp=MATRIX_CMD;
2217  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2218  L->m[5].rtyp=MATRIX_CMD;
2219  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2220  }
2221 #endif
2222  return L;
2223 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:24
static BOOLEAN rField_is_GF(const ring r)
Definition: ring.h:513
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:616
CanonicalForm Lc(const CanonicalForm &f)
void * data
Definition: subexpr.h:89
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1620
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:559
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:927
Definition: intvec.h:14
int j
Definition: myNF.cc:70
#define assume(x)
Definition: mod2.h:394
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:1742
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:88
int i
Definition: cfEzgcd.cc:123
Induced (Schreyer) ordering.
Definition: ring.h:101
ideal idCopy(ideal A)
Definition: ideals.h:60
INLINE_THIS void Init(int l=0)
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
void rDecomposeRing(leftv h, const ring R)
Definition: ipshell.cc:1806
static BOOLEAN rField_is_Ring(const ring r)
Definition: ring.h:477
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
Definition: tok.h:117
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:74
omBin slists_bin
Definition: lists.cc:23
static BOOLEAN rField_is_numeric(const ring r)
Definition: ring.h:507
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1838 of file ipshell.cc.

1839 {
1840  assume( C != NULL );
1841 
1842  // sanity check: require currRing==r for rings with polynomial data
1843  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1844  {
1845  WerrorS("ring with polynomial data must be the base ring or compatible");
1846  return TRUE;
1847  }
1848  if (nCoeff_is_numeric(C))
1849  {
1850  rDecomposeC_41(res,C);
1851  }
1852 #ifdef HAVE_RINGS
1853  else if (nCoeff_is_Ring(C))
1854  {
1855  rDecomposeRing_41(res,C);
1856  }
1857 #endif
1858  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1859  {
1860  rDecomposeCF(res, C->extRing, currRing);
1861  }
1862  else if(nCoeff_is_GF(C))
1863  {
1865  Lc->Init(4);
1866  // char:
1867  Lc->m[0].rtyp=INT_CMD;
1868  Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1869  // var:
1871  Lv->Init(1);
1872  Lv->m[0].rtyp=STRING_CMD;
1873  Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1874  Lc->m[1].rtyp=LIST_CMD;
1875  Lc->m[1].data=(void*)Lv;
1876  // ord:
1878  Lo->Init(1);
1880  Loo->Init(2);
1881  Loo->m[0].rtyp=STRING_CMD;
1882  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1883 
1884  intvec *iv=new intvec(1); (*iv)[0]=1;
1885  Loo->m[1].rtyp=INTVEC_CMD;
1886  Loo->m[1].data=(void *)iv;
1887 
1888  Lo->m[0].rtyp=LIST_CMD;
1889  Lo->m[0].data=(void*)Loo;
1890 
1891  Lc->m[2].rtyp=LIST_CMD;
1892  Lc->m[2].data=(void*)Lo;
1893  // q-ideal:
1894  Lc->m[3].rtyp=IDEAL_CMD;
1895  Lc->m[3].data=(void *)idInit(1,1);
1896  // ----------------------
1897  res->rtyp=LIST_CMD;
1898  res->data=(void*)Lc;
1899  }
1900  else
1901  {
1902  res->rtyp=INT_CMD;
1903  res->data=(void *)(long)C->ch;
1904  }
1905  // ----------------------------------------
1906  return FALSE;
1907 }
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:849
Definition: tok.h:95
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
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:1778
void * data
Definition: subexpr.h:89
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1620
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:927
Definition: intvec.h:14
#define assume(x)
Definition: mod2.h:394
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:88
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition: coeffs.h:856
static void rDecomposeC_41(leftv h, const coeffs C)
Definition: ipshell.cc:1708
INLINE_THIS void Init(int l=0)
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
Definition: tok.h:117
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 1909 of file ipshell.cc.

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

◆ rDecomposeC()

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

Definition at line 1742 of file ipshell.cc.

1744 {
1746  if (rField_is_long_C(R)) L->Init(3);
1747  else L->Init(2);
1748  h->rtyp=LIST_CMD;
1749  h->data=(void *)L;
1750  // 0: char/ cf - ring
1751  // 1: list (var)
1752  // 2: list (ord)
1753  // ----------------------------------------
1754  // 0: char/ cf - ring
1755  L->m[0].rtyp=INT_CMD;
1756  L->m[0].data=(void *)0;
1757  // ----------------------------------------
1758  // 1:
1760  LL->Init(2);
1761  LL->m[0].rtyp=INT_CMD;
1762  LL->m[0].data=(void *)(long)si_max(R->cf->float_len,SHORT_REAL_LENGTH/2);
1763  LL->m[1].rtyp=INT_CMD;
1764  LL->m[1].data=(void *)(long)si_max(R->cf->float_len2,SHORT_REAL_LENGTH);
1765  L->m[1].rtyp=LIST_CMD;
1766  L->m[1].data=(void *)LL;
1767  // ----------------------------------------
1768  // 2: list (par)
1769  if (rField_is_long_C(R))
1770  {
1771  L->m[2].rtyp=STRING_CMD;
1772  L->m[2].data=(void *)omStrDup(*rParameter(R));
1773  }
1774  // ----------------------------------------
1775 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
#define SHORT_REAL_LENGTH
Definition: numbers.h:54
Definition: lists.h:22
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:616
void * data
Definition: subexpr.h:89
const ring R
Definition: DebugPrint.cc:36
static int si_max(const int a, const int b)
Definition: auxiliary.h:120
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:537
INLINE_THIS void Init(int l=0)
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
Definition: tok.h:117
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDecomposeC_41()

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

Definition at line 1708 of file ipshell.cc.

1710 {
1712  if (nCoeff_is_long_C(C)) L->Init(3);
1713  else L->Init(2);
1714  h->rtyp=LIST_CMD;
1715  h->data=(void *)L;
1716  // 0: char/ cf - ring
1717  // 1: list (var)
1718  // 2: list (ord)
1719  // ----------------------------------------
1720  // 0: char/ cf - ring
1721  L->m[0].rtyp=INT_CMD;
1722  L->m[0].data=(void *)0;
1723  // ----------------------------------------
1724  // 1:
1726  LL->Init(2);
1727  LL->m[0].rtyp=INT_CMD;
1728  LL->m[0].data=(void *)(long)si_max(C->float_len,SHORT_REAL_LENGTH/2);
1729  LL->m[1].rtyp=INT_CMD;
1730  LL->m[1].data=(void *)(long)si_max(C->float_len2,SHORT_REAL_LENGTH);
1731  L->m[1].rtyp=LIST_CMD;
1732  L->m[1].data=(void *)LL;
1733  // ----------------------------------------
1734  // 2: list (par)
1735  if (nCoeff_is_long_C(C))
1736  {
1737  L->m[2].rtyp=STRING_CMD;
1738  L->m[2].data=(void *)omStrDup(*n_ParameterNames(C));
1739  }
1740  // ----------------------------------------
1741 }
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:812
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
#define SHORT_REAL_LENGTH
Definition: numbers.h:54
Definition: lists.h:22
static FORCE_INLINE BOOLEAN nCoeff_is_long_C(const coeffs r)
Definition: coeffs.h:911
void * data
Definition: subexpr.h:89
static int si_max(const int a, const int b)
Definition: auxiliary.h:120
INLINE_THIS void Init(int l=0)
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
Definition: tok.h:117
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDecomposeCF()

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

Definition at line 1620 of file ipshell.cc.

1621 {
1623  L->Init(4);
1624  h->rtyp=LIST_CMD;
1625  h->data=(void *)L;
1626  // 0: char/ cf - ring
1627  // 1: list (var)
1628  // 2: list (ord)
1629  // 3: qideal
1630  // ----------------------------------------
1631  // 0: char/ cf - ring
1632  L->m[0].rtyp=INT_CMD;
1633  L->m[0].data=(void *)(long)r->cf->ch;
1634  // ----------------------------------------
1635  // 1: list (var)
1637  LL->Init(r->N);
1638  int i;
1639  for(i=0; i<r->N; i++)
1640  {
1641  LL->m[i].rtyp=STRING_CMD;
1642  LL->m[i].data=(void *)omStrDup(r->names[i]);
1643  }
1644  L->m[1].rtyp=LIST_CMD;
1645  L->m[1].data=(void *)LL;
1646  // ----------------------------------------
1647  // 2: list (ord)
1649  i=rBlocks(r)-1;
1650  LL->Init(i);
1651  i--;
1652  lists LLL;
1653  for(; i>=0; i--)
1654  {
1655  intvec *iv;
1656  int j;
1657  LL->m[i].rtyp=LIST_CMD;
1659  LLL->Init(2);
1660  LLL->m[0].rtyp=STRING_CMD;
1661  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1662  if (r->block1[i]-r->block0[i] >=0 )
1663  {
1664  j=r->block1[i]-r->block0[i];
1665  if(r->order[i]==ringorder_M) j=(j+1)*(j+1)-1;
1666  iv=new intvec(j+1);
1667  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1668  {
1669  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j];
1670  }
1671  else switch (r->order[i])
1672  {
1673  case ringorder_dp:
1674  case ringorder_Dp:
1675  case ringorder_ds:
1676  case ringorder_Ds:
1677  case ringorder_lp:
1678  for(;j>=0; j--) (*iv)[j]=1;
1679  break;
1680  default: /* do nothing */;
1681  }
1682  }
1683  else
1684  {
1685  iv=new intvec(1);
1686  }
1687  LLL->m[1].rtyp=INTVEC_CMD;
1688  LLL->m[1].data=(void *)iv;
1689  LL->m[i].data=(void *)LLL;
1690  }
1691  L->m[2].rtyp=LIST_CMD;
1692  L->m[2].data=(void *)LL;
1693  // ----------------------------------------
1694  // 3: qideal
1695  L->m[3].rtyp=IDEAL_CMD;
1696  if (nCoeff_is_transExt(R->cf))
1697  L->m[3].data=(void *)idInit(1,1);
1698  else
1699  {
1700  ideal q=idInit(IDELEMS(r->qideal));
1701  q->m[0]=p_Init(R);
1702  pSetCoeff0(q->m[0],(number)(r->qideal->m[0]));
1703  L->m[3].data=(void *)q;
1704 // I->m[0] = pNSet(R->minpoly);
1705  }
1706  // ----------------------------------------
1707 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
Definition: lists.h:22
void * data
Definition: subexpr.h:89
static int rBlocks(ring r)
Definition: ring.h:559
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:935
int i
Definition: cfEzgcd.cc:123
#define IDELEMS(i)
Definition: simpleideals.h:24
INLINE_THIS void Init(int l=0)
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
#define pSetCoeff0(p, n)
Definition: monomials.h:67
Definition: tok.h:117
omBin slists_bin
Definition: lists.cc:23
static poly p_Init(const ring r, omBin bin)
Definition: p_polys.h:1243
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDecomposeRing()

void rDecomposeRing ( leftv  h,
const ring  R 
)

Definition at line 1806 of file ipshell.cc.

1808 {
1809 #ifdef HAVE_RINGS
1811  if (rField_is_Ring_Z(R)) L->Init(1);
1812  else L->Init(2);
1813  h->rtyp=LIST_CMD;
1814  h->data=(void *)L;
1815  // 0: char/ cf - ring
1816  // 1: list (module)
1817  // ----------------------------------------
1818  // 0: char/ cf - ring
1819  L->m[0].rtyp=STRING_CMD;
1820  L->m[0].data=(void *)omStrDup("integer");
1821  // ----------------------------------------
1822  // 1: module
1823  if (rField_is_Ring_Z(R)) return;
1825  LL->Init(2);
1826  LL->m[0].rtyp=BIGINT_CMD;
1827  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); ?
1828  LL->m[1].rtyp=INT_CMD;
1829  LL->m[1].data=(void *) R->cf->modExponent;
1830  L->m[1].rtyp=LIST_CMD;
1831  L->m[1].data=(void *)LL;
1832 #else
1833  WerrorS("rDecomposeRing");
1834 #endif
1835 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
Definition: lists.h:22
Definition: tok.h:38
void WerrorS(const char *s)
Definition: feFopen.cc:24
void * data
Definition: subexpr.h:89
const ring R
Definition: DebugPrint.cc:36
INLINE_THIS void Init(int l=0)
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
static BOOLEAN rField_is_Ring_Z(const ring r)
Definition: ring.h:474
int rtyp
Definition: subexpr.h:92
Definition: tok.h:117
number nlMapGMP(number from, const coeffs src, const coeffs dst)
Definition: longrat.cc:205
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 1778 of file ipshell.cc.

1780 {
1782  if (nCoeff_is_Ring(C)) L->Init(1);
1783  else L->Init(2);
1784  h->rtyp=LIST_CMD;
1785  h->data=(void *)L;
1786  // 0: char/ cf - ring
1787  // 1: list (module)
1788  // ----------------------------------------
1789  // 0: char/ cf - ring
1790  L->m[0].rtyp=STRING_CMD;
1791  L->m[0].data=(void *)omStrDup("integer");
1792  // ----------------------------------------
1793  // 1: modulo
1794  if (nCoeff_is_Ring_Z(C)) return;
1796  LL->Init(2);
1797  LL->m[0].rtyp=BIGINT_CMD;
1798  LL->m[0].data=nlMapGMP((number) C->modBase, C, coeffs_BIGINT);
1799  LL->m[1].rtyp=INT_CMD;
1800  LL->m[1].data=(void *) C->modExponent;
1801  L->m[1].rtyp=LIST_CMD;
1802  L->m[1].data=(void *)LL;
1803 }
sleftv * m
Definition: lists.h:45
Definition: tok.h:95
Definition: lists.h:22
Definition: tok.h:38
static FORCE_INLINE BOOLEAN nCoeff_is_Ring_Z(const coeffs r)
Definition: coeffs.h:759
coeffs coeffs_BIGINT
Definition: ipid.cc:54
static FORCE_INLINE BOOLEAN nCoeff_is_Ring(const coeffs r)
Definition: coeffs.h:762
void * data
Definition: subexpr.h:89
INLINE_THIS void Init(int l=0)
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
Definition: tok.h:117
number nlMapGMP(number from, const coeffs src, const coeffs dst)
Definition: longrat.cc:205
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1549 of file ipshell.cc.

1550 {
1551  idhdl tmp=NULL;
1552 
1553  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
1554  if (tmp==NULL) return NULL;
1555 
1556 // if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
1558  {
1560  memset(&sLastPrinted,0,sizeof(sleftv));
1561  }
1562 
1563  ring r = IDRING(tmp) = (ring) omAlloc0Bin(sip_sring_bin);
1564 
1565  r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1566  r->N = 3;
1567  /*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
1568  /*names*/
1569  r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
1570  r->names[0] = omStrDup("x");
1571  r->names[1] = omStrDup("y");
1572  r->names[2] = omStrDup("z");
1573  /*weights: entries for 3 blocks: NULL*/
1574  r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1575  /*order: dp,C,0*/
1576  r->order = (rRingOrder_t *) omAlloc(3 * sizeof(rRingOrder_t *));
1577  r->block0 = (int *)omAlloc0(3 * sizeof(int *));
1578  r->block1 = (int *)omAlloc0(3 * sizeof(int *));
1579  /* ringorder dp for the first block: var 1..3 */
1580  r->order[0] = ringorder_dp;
1581  r->block0[0] = 1;
1582  r->block1[0] = 3;
1583  /* ringorder C for the second block: no vars */
1584  r->order[1] = ringorder_C;
1585  /* the last block: everything is 0 */
1586  r->order[2] = (rRingOrder_t)0;
1587 
1588  /* complete ring intializations */
1589  rComplete(r);
1590  rSetHdl(tmp);
1591  return currRingHdl;
1592 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
{p < 2^31}
Definition: coeffs.h:30
#define IDROOT
Definition: ipid.h:20
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: idrec.h:34
int myynest
Definition: febase.cc:46
char * char_ptr
Definition: structs.h:56
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:258
const ring r
Definition: syzextra.cc:208
BOOLEAN RingDependend()
Definition: subexpr.cc:402
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:3356
rRingOrder_t
order stuff
Definition: ring.h:75
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:332
void rSetHdl(idhdl h)
Definition: ipshell.cc:5032
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:341
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1594 of file ipshell.cc.

1595 {
1597  if (h!=NULL) return h;
1598  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1599  if (h!=NULL) return h;
1601  while(p!=NULL)
1602  {
1603  if ((p->cPack!=basePack)
1604  && (p->cPack!=currPack))
1605  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1606  if (h!=NULL) return h;
1607  p=p->next;
1608  }
1609  idhdl tmp=basePack->idroot;
1610  while (tmp!=NULL)
1611  {
1612  if (IDTYP(tmp)==PACKAGE_CMD)
1613  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1614  if (h!=NULL) return h;
1615  tmp=IDNEXT(tmp);
1616  }
1617  return NULL;
1618 }
idhdl rSimpleFindHdl(ring r, idhdl root, idhdl n)
Definition: ipshell.cc:6133
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 5518 of file ipshell.cc.

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

◆ rKill() [1/2]

void rKill ( ring  r)

Definition at line 6056 of file ipshell.cc.

6057 {
6058  if ((r->ref<=0)&&(r->order!=NULL))
6059  {
6060 #ifdef RDEBUG
6061  if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6062 #endif
6063  if (r->qideal!=NULL)
6064  {
6065  id_Delete(&r->qideal, r);
6066  r->qideal = NULL;
6067  }
6068  int j;
6069  for (j=0;j<myynest;j++)
6070  {
6071  if (iiLocalRing[j]==r)
6072  {
6073  if (j==0) WarnS("killing the basering for level 0");
6074  iiLocalRing[j]=NULL;
6075  }
6076  }
6077 // any variables depending on r ?
6078  while (r->idroot!=NULL)
6079  {
6080  r->idroot->lev=myynest; // avoid warning about kill global objects
6081  killhdl2(r->idroot,&(r->idroot),r);
6082  }
6083  if (r==currRing)
6084  {
6085  // all dependend stuff is done, clean global vars:
6086  if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6088  {
6090  }
6091  //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6092  //{
6093  // WerrorS("return value depends on local ring variable (export missing ?)");
6094  // iiRETURNEXPR.CleanUp();
6095  //}
6096  currRing=NULL;
6097  currRingHdl=NULL;
6098  }
6099 
6100  /* nKillChar(r); will be called from inside of rDelete */
6101  rDelete(r);
6102  return;
6103  }
6104  r->ref--;
6105 }
#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:408
const ring r
Definition: syzextra.cc:208
BOOLEAN RingDependend()
Definition: subexpr.cc:402
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:450
#define pDelete(p_ptr)
Definition: polys.h:169
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332

◆ rKill() [2/2]

void rKill ( idhdl  h)

Definition at line 6107 of file ipshell.cc.

6108 {
6109  ring r = IDRING(h);
6110  int ref=0;
6111  if (r!=NULL)
6112  {
6113  // avoid, that sLastPrinted is the last reference to the base ring:
6114  // clean up before killing the last "named" refrence:
6115  if ((sLastPrinted.rtyp==RING_CMD)
6116  && (sLastPrinted.data==(void*)r))
6117  {
6118  sLastPrinted.CleanUp(r);
6119  }
6120  ref=r->ref;
6121  rKill(r);
6122  }
6123  if (h==currRingHdl)
6124  {
6125  if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6126  else
6127  {
6129  }
6130  }
6131 }
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
const ring r
Definition: syzextra.cc:208
void rKill(ring r)
Definition: ipshell.cc:6056
idhdl currRingHdl
Definition: ipid.cc:65
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1594
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:124
int rtyp
Definition: subexpr.h:92
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332

◆ rOptimizeOrdAsSleftv()

static leftv rOptimizeOrdAsSleftv ( leftv  ord)
static

Definition at line 5086 of file ipshell.cc.

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

◆ rRenameVars()

static void rRenameVars ( ring  R)
static

Definition at line 2389 of file ipshell.cc.

2390 {
2391  int i,j;
2392  BOOLEAN ch;
2393  do
2394  {
2395  ch=0;
2396  for(i=0;i<R->N-1;i++)
2397  {
2398  for(j=i+1;j<R->N;j++)
2399  {
2400  if (strcmp(R->names[i],R->names[j])==0)
2401  {
2402  ch=TRUE;
2403  Warn("name conflict var(%d) and var(%d): `%s`, rename to `@%s`",i+1,j+1,R->names[i],R->names[i]);
2404  omFree(R->names[j]);
2405  R->names[j]=(char *)omAlloc(2+strlen(R->names[i]));
2406  sprintf(R->names[j],"@%s",R->names[i]);
2407  }
2408  }
2409  }
2410  }
2411  while (ch);
2412  for(i=0;i<rPar(R); i++)
2413  {
2414  for(j=0;j<R->N;j++)
2415  {
2416  if (strcmp(rParameter(R)[i],R->names[j])==0)
2417  {
2418  Warn("name conflict par(%d) and var(%d): `%s`, renaming the VARIABLE to `@@(%d)`",i+1,j+1,R->names[j],i+1);
2419 // omFree(rParameter(R)[i]);
2420 // rParameter(R)[i]=(char *)omAlloc(10);
2421 // sprintf(rParameter(R)[i],"@@(%d)",i+1);
2422  omFree(R->names[j]);
2423  R->names[j]=(char *)omAlloc(10);
2424  sprintf(R->names[j],"@@(%d)",i+1);
2425  }
2426  }
2427  }
2428 }
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:590
#define TRUE
Definition: auxiliary.h:98
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:616
#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:85
#define Warn
Definition: emacs.cc:80

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5032 of file ipshell.cc.

5033 {
5034  ring rg = NULL;
5035  if (h!=NULL)
5036  {
5037 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5038  rg = IDRING(h);
5039  if (rg==NULL) return; //id <>NULL, ring==NULL
5040  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5041  if (IDID(h)) // OB: ????
5042  omCheckAddr((ADDRESS)IDID(h));
5043  rTest(rg);
5044  }
5045 
5046  // clean up history
5048  {
5050  memset(&sLastPrinted,0,sizeof(sleftv));
5051  }
5052 
5053  if ((rg!=currRing)&&(currRing!=NULL))
5054  {
5056  if (DENOMINATOR_LIST!=NULL)
5057  {
5058  if (TEST_V_ALLWARN)
5059  Warn("deleting denom_list for ring change to %s",IDID(h));
5060  do
5061  {
5062  n_Delete(&(dd->n),currRing->cf);
5063  dd=dd->next;
5065  DENOMINATOR_LIST=dd;
5066  } while(DENOMINATOR_LIST!=NULL);
5067  }
5068  }
5069 
5070  // test for valid "currRing":
5071  if ((rg!=NULL) && (rg->idroot==NULL))
5072  {
5073  ring old=rg;
5074  rg=rAssure_HasComp(rg);
5075  if (old!=rg)
5076  {
5077  rKill(old);
5078  IDRING(h)=rg;
5079  }
5080  }
5081  /*------------ change the global ring -----------------------*/
5082  rChangeCurrRing(rg);
5083  currRingHdl = h;
5084 }
#define omCheckAddrSize(addr, size)
Definition: omAllocDecl.h:327
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define IDID(a)
Definition: ipid.h:119
denominator_list DENOMINATOR_LIST
Definition: kutil.cc:89
void * ADDRESS
Definition: auxiliary.h:115
ring rAssure_HasComp(const ring r)
Definition: ring.cc:4527
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:402
void rKill(ring r)
Definition: ipshell.cc:6056
#define omFree(addr)
Definition: omAllocDecl.h:261
#define rTest(r)
Definition: ring.h:779
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:332
#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 6133 of file ipshell.cc.

6134 {
6135  idhdl h=root;
6136  while (h!=NULL)
6137  {
6138  if ((IDTYP(h)==RING_CMD)
6139  && (h!=n)
6140  && (IDRING(h)==r)
6141  )
6142  {
6143  return h;
6144  }
6145  h=IDNEXT(h);
6146  }
6147  return NULL;
6148 }
#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 5470 of file ipshell.cc.

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

◆ rSleftvOrdering2Ordering()

BOOLEAN rSleftvOrdering2Ordering ( sleftv ord,
ring  R 
)

Definition at line 5198 of file ipshell.cc.

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

◆ rSubring()

ring rSubring ( ring  org_ring,
sleftv rv 
)

Definition at line 5894 of file ipshell.cc.

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

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

◆ semicProc()

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

Definition at line 4471 of file ipshell.cc.

4472 {
4473  sleftv tmp;
4474  memset(&tmp,0,sizeof(tmp));
4475  tmp.rtyp=INT_CMD;
4476  /* tmp.data = (void *)0; -- done by memset */
4477 
4478  return semicProc3(res,u,v,&tmp);
4479 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:95
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4431
int rtyp
Definition: subexpr.h:92

◆ semicProc3()

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

Definition at line 4431 of file ipshell.cc.

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

◆ spaddProc()

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

Definition at line 4348 of file ipshell.cc.

4349 {
4350  semicState state;
4351 
4352  // -----------------
4353  // check arguments
4354  // -----------------
4355 
4356  lists l1 = (lists)first->Data( );
4357  lists l2 = (lists)second->Data( );
4358 
4359  if( (state=list_is_spectrum( l1 )) != semicOK )
4360  {
4361  WerrorS( "first argument is not a spectrum:" );
4362  list_error( state );
4363  }
4364  else if( (state=list_is_spectrum( l2 )) != semicOK )
4365  {
4366  WerrorS( "second argument is not a spectrum:" );
4367  list_error( state );
4368  }
4369  else
4370  {
4371  spectrum s1= spectrumFromList ( l1 );
4372  spectrum s2= spectrumFromList ( l2 );
4373  spectrum sum( s1+s2 );
4374 
4375  result->rtyp = LIST_CMD;
4376  result->data = (char*)(getList(sum));
4377  }
4378 
4379  return (state!=semicOK);
4380 }
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3304
void list_error(semicState state)
Definition: ipshell.cc:3388
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
lists getList(spectrum &spec)
Definition: ipshell.cc:3316
void * data
Definition: subexpr.h:89
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4173
semicState
Definition: ipshell.cc:3354
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1137
Definition: tok.h:117

◆ spectrumCompute()

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

Definition at line 3730 of file ipshell.cc.

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

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

◆ spectrumFromList()

spectrum spectrumFromList ( lists  l)

Definition at line 3304 of file ipshell.cc.

3305 {
3306  spectrum result;
3307  copy_deep( result, l );
3308  return result;
3309 }
Definition: semic.h:63
void copy_deep(spectrum &spec, lists l)
Definition: ipshell.cc:3280
return result
Definition: facAbsBiFact.cc:76

◆ spectrumPrintError()

void spectrumPrintError ( spectrumState  state)

Definition at line 4022 of file ipshell.cc.

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

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4053 of file ipshell.cc.

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

◆ spectrumStateFromList()

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

Definition at line 3489 of file ipshell.cc.

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

4391 {
4392  semicState state;
4393 
4394  // -----------------
4395  // check arguments
4396  // -----------------
4397 
4398  lists l = (lists)first->Data( );
4399  int k = (int)(long)second->Data( );
4400 
4401  if( (state=list_is_spectrum( l ))!=semicOK )
4402  {
4403  WerrorS( "first argument is not a spectrum" );
4404  list_error( state );
4405  }
4406  else if( k < 0 )
4407  {
4408  WerrorS( "second argument should be positive" );
4409  state = semicMulNegative;
4410  }
4411  else
4412  {
4413  spectrum s= spectrumFromList( l );
4414  spectrum product( k*s );
4415 
4416  result->rtyp = LIST_CMD;
4417  result->data = (char*)getList(product);
4418  }
4419 
4420  return (state!=semicOK);
4421 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3304
void list_error(semicState state)
Definition: ipshell.cc:3388
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:3316
void * data
Definition: subexpr.h:89
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4173
semicState
Definition: ipshell.cc:3354
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1137
Definition: tok.h:117
int l
Definition: cfEzgcd.cc:94

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3091 of file ipshell.cc.

3092 {
3093  sleftv tmp;
3094  memset(&tmp,0,sizeof(tmp));
3095  tmp.rtyp=INT_CMD;
3096  tmp.data=(void *)1;
3097  return syBetti2(res,u,&tmp);
3098 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:95
void * data
Definition: subexpr.h:89
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3068
int rtyp
Definition: subexpr.h:92

◆ syBetti2()

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

Definition at line 3068 of file ipshell.cc.

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

◆ syConvList()

syStrategy syConvList ( lists  li)

Definition at line 3176 of file ipshell.cc.

3177 {
3178  int typ0;
3180 
3181  resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3182  if (fr != NULL)
3183  {
3184 
3185  result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3186  for (int i=result->length-1;i>=0;i--)
3187  {
3188  if (fr[i]!=NULL)
3189  result->fullres[i] = idCopy(fr[i]);
3190  }
3191  result->list_length=result->length;
3192  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3193  }
3194  else
3195  {
3196  omFreeSize(result, sizeof(ssyStrategy));
3197  result = NULL;
3198  }
3199  return result;
3200 }
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:115
int i
Definition: cfEzgcd.cc:123
resolvente fullres
Definition: syz.h:57
ideal idCopy(ideal A)
Definition: ideals.h:60
#define NULL
Definition: omList.c:10
short list_length
Definition: syz.h:62
ideal * resolvente
Definition: ideals.h:18
#define omAlloc0(size)
Definition: omAllocDecl.h:211
return result
Definition: facAbsBiFact.cc:76
ssyStrategy * syStrategy
Definition: syz.h:35

◆ syConvRes()

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

Definition at line 3103 of file ipshell.cc.

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

◆ syForceMin()

syStrategy syForceMin ( lists  li)

Definition at line 3205 of file ipshell.cc.

3206 {
3207  int typ0;
3209 
3210  resolvente fr = liFindRes(li,&(result->length),&typ0);
3211  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3212  for (int i=result->length-1;i>=0;i--)
3213  {
3214  if (fr[i]!=NULL)
3215  result->minres[i] = idCopy(fr[i]);
3216  }
3217  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3218  return result;
3219 }
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:115
int i
Definition: cfEzgcd.cc:123
ideal idCopy(ideal A)
Definition: ideals.h:60
resolvente minres
Definition: syz.h:58
#define NULL
Definition: omList.c:10
ideal * resolvente
Definition: ideals.h:18
#define omAlloc0(size)
Definition: omAllocDecl.h:211
return result
Definition: facAbsBiFact.cc:76
ssyStrategy * syStrategy
Definition: syz.h:35

◆ test_cmd()

void test_cmd ( int  i)

Definition at line 506 of file ipshell.cc.

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

247 {
248  BOOLEAN oldShortOut = FALSE;
249 
250  if (currRing != NULL)
251  {
252  oldShortOut = currRing->ShortOut;
253  currRing->ShortOut = 1;
254  }
255  int t=v->Typ();
256  Print("// %s %s ",v->Name(),Tok2Cmdname(t));
257  switch (t)
258  {
259  case MAP_CMD:Print(" from %s\n",((map)(v->Data()))->preimage); break;
260  case INTMAT_CMD: Print(" %d x %d\n",((intvec*)(v->Data()))->rows(),
261  ((intvec*)(v->Data()))->cols()); break;
262  case MATRIX_CMD:Print(" %u x %u\n" ,
263  MATROWS((matrix)(v->Data())),
264  MATCOLS((matrix)(v->Data())));break;
265  case MODUL_CMD: Print(", rk %d\n", (int)(((ideal)(v->Data()))->rank));break;
266  case LIST_CMD: Print(", size %d\n",((lists)(v->Data()))->nr+1); break;
267 
268  case PROC_CMD:
269  case RING_CMD:
270  case IDEAL_CMD: PrintLn(); break;
271 
272  //case INT_CMD:
273  //case STRING_CMD:
274  //case INTVEC_CMD:
275  //case POLY_CMD:
276  //case VECTOR_CMD:
277  //case PACKAGE_CMD:
278 
279  default:
280  break;
281  }
282  v->Print();
283  if (currRing != NULL)
284  currRing->ShortOut = oldShortOut;
285 }
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:94
int Typ()
Definition: subexpr.cc:995
const char * Name()
Definition: subexpr.h:121
void Print(leftv store=NULL, int spaces=0)
Called by type_cmd (e.g. "r;") or as default in jPRINT.
Definition: subexpr.cc:72
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:132
void * Data()
Definition: subexpr.cc:1137
Definition: tok.h:117
#define MATROWS(i)
Definition: matpol.h:27
int BOOLEAN
Definition: auxiliary.h:85

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