Data Structures | Typedefs | Functions | Variables
ipshell.h File Reference
#include <stdio.h>
#include <kernel/ideals.h>
#include <Singular/lists.h>
#include <Singular/fevoices.h>

Go to the source code of this file.

Data Structures

struct  sValCmd1
 
struct  sValCmd2
 
struct  sValCmd3
 
struct  sValCmdM
 
struct  sValAssign_sys
 
struct  sValAssign
 

Typedefs

typedef BOOLEAN(* proc1) (leftv, leftv)
 
typedef BOOLEAN(* proc2) (leftv, leftv, leftv)
 
typedef BOOLEAN(* proc3) (leftv, leftv, leftv, leftv)
 
typedef BOOLEAN(* proci) (leftv, leftv, Subexpr)
 

Functions

BOOLEAN spectrumProc (leftv, leftv)
 
BOOLEAN spectrumfProc (leftv, leftv)
 
BOOLEAN spaddProc (leftv, leftv, leftv)
 
BOOLEAN spmulProc (leftv, leftv, leftv)
 
BOOLEAN semicProc (leftv, leftv, leftv)
 
BOOLEAN semicProc3 (leftv, leftv, leftv, leftv)
 
BOOLEAN iiAssignCR (leftv, leftv)
 
BOOLEAN iiARROW (leftv, char *, char *)
 
int IsCmd (const char *n, int &tok)
 
BOOLEAN iiPStart (idhdl pn, leftv sl)
 
BOOLEAN iiEStart (char *example, procinfo *pi)
 
BOOLEAN iiAllStart (procinfov pi, char *p, feBufferTypes t, int l)
 
void type_cmd (leftv v)
 
void test_cmd (int i)
 
void list_cmd (int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname=FALSE)
 
void killlocals (int v)
 
int exprlist_length (leftv v)
 
const char * Tok2Cmdname (int i)
 
const char * iiTwoOps (int t)
 
int iiOpsTwoChar (const char *s)
 
BOOLEAN iiWRITE (leftv res, leftv exprlist)
 
BOOLEAN iiExport (leftv v, int toLev)
 
BOOLEAN iiExport (leftv v, int toLev, package pack)
 
BOOLEAN iiInternalExport (leftv v, int toLev, package pack)
 
char * iiGetLibName (procinfov v)
 
char * iiGetLibProcBuffer (procinfov pi, int part=1)
 
char * iiProcName (char *buf, char &ct, char *&e)
 
char * iiProcArgs (char *e, BOOLEAN withParenth)
 
BOOLEAN iiLibCmd (char *newlib, BOOLEAN autoexport, BOOLEAN tellerror, BOOLEAN force)
 
BOOLEAN jjLOAD (const char *s, BOOLEAN autoexport=FALSE)
 load lib/module given in v More...
 
BOOLEAN jjLOAD_TRY (const char *s)
 
BOOLEAN iiLocateLib (const char *lib, char *where)
 
leftv iiMap (map theMap, const char *what)
 
void iiMakeResolv (resolvente r, int length, int rlen, char *name, int typ0, intvec **weights=NULL)
 
BOOLEAN jjMINRES (leftv res, leftv v)
 
BOOLEAN jjBETTI (leftv res, leftv v)
 
BOOLEAN jjBETTI2 (leftv res, leftv u, leftv v)
 
BOOLEAN jjBETTI2_ID (leftv res, leftv u, leftv v)
 
BOOLEAN jjIMPORTFROM (leftv res, leftv u, leftv v)
 
BOOLEAN jjLIST_PL (leftv res, leftv v)
 
BOOLEAN jjVARIABLES_P (leftv res, leftv u)
 
BOOLEAN jjVARIABLES_ID (leftv res, leftv u)
 
int iiRegularity (lists L)
 
leftv singular_system (sleftv h)
 
BOOLEAN jjSYSTEM (leftv res, leftv v)
 
void iiDebug ()
 
BOOLEAN iiCheckRing (int i)
 
poly iiHighCorner (ideal i, int ak)
 
char * iiConvName (const char *libname)
 
BOOLEAN iiLoadLIB (FILE *fp, const char *libnamebuf, const char *newlib, idhdl pl, BOOLEAN autoexport, BOOLEAN tellerror)
 
lists syConvRes (syStrategy syzstr, BOOLEAN toDel=FALSE, int add_row_shift=0)
 
syStrategy syForceMin (lists li)
 
syStrategy syConvList (lists li)
 
BOOLEAN syBetti1 (leftv res, leftv u)
 
BOOLEAN syBetti2 (leftv res, leftv u, leftv w)
 
BOOLEAN iiExprArith1 (leftv res, sleftv *a, int op)
 
BOOLEAN iiExprArith2 (leftv res, sleftv *a, int op, sleftv *b, BOOLEAN proccall=FALSE)
 
BOOLEAN iiExprArith3 (leftv res, int op, leftv a, leftv b, leftv c)
 
BOOLEAN iiExprArithM (leftv res, sleftv *a, int op)
 
BOOLEAN iiApply (leftv res, leftv a, int op, leftv proc)
 
BOOLEAN iiAssign (leftv left, leftv right, BOOLEAN toplevel=TRUE)
 
BOOLEAN iiParameter (leftv p)
 
BOOLEAN iiAlias (leftv p)
 
int iiTokType (int op)
 
int iiDeclCommand (leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring=FALSE, BOOLEAN init_b=TRUE)
 
BOOLEAN iiMake_proc (idhdl pn, package pack, leftv sl)
 
void * iiCallLibProc1 (const char *n, void *arg, int arg_type, BOOLEAN &err)
 
void * iiCallLibProcM (const char *n, void **args, int *arg_types, BOOLEAN &err)
 args: NULL terminated arry of arguments arg_types: 0 terminated array of corresponding types More...
 
char * showOption ()
 
BOOLEAN setOption (leftv res, leftv v)
 
char * versionString ()
 
void singular_example (char *str)
 
BOOLEAN iiTryLoadLib (leftv v, const char *id)
 
int iiAddCproc (const char *libname, const char *procname, BOOLEAN pstatic, BOOLEAN(*func)(leftv res, leftv v))
 
void iiCheckPack (package &p)
 
void rSetHdl (idhdl h)
 
ring rInit (leftv pn, leftv rv, leftv ord)
 
idhdl rDefault (const char *s)
 
idhdl rSimpleFindHdl (ring r, idhdl root, idhdl n=NULL)
 
idhdl rFindHdl (ring r, idhdl n)
 
void rKill (idhdl h)
 
void rKill (ring r)
 
lists scIndIndset (ideal S, BOOLEAN all, ideal Q)
 
BOOLEAN mpKoszul (leftv res, leftv c, leftv b, leftv id)
 
BOOLEAN mpJacobi (leftv res, leftv a)
 
BOOLEAN jjRESULTANT (leftv res, leftv u, leftv v, leftv w)
 
BOOLEAN kQHWeight (leftv res, leftv v)
 
BOOLEAN kWeight (leftv res, leftv id)
 
BOOLEAN loSimplex (leftv res, leftv args)
 Implementation of the Simplex Algorithm. More...
 
BOOLEAN loNewtonP (leftv res, leftv arg1)
 compute Newton Polytopes of input polynomials 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...
 
BOOLEAN jjCHARSERIES (leftv res, leftv u)
 
void paPrint (const char *n, package p)
 
BOOLEAN iiTestAssume (leftv a, leftv b)
 
BOOLEAN iiExprArith1Tab (leftv res, leftv a, int op, const struct sValCmd1 *dA1, int at, const struct sConvertTypes *dConvertTypes)
 apply an operation 'op' to an argument a return TRUE on failure More...
 
BOOLEAN iiExprArith2Tab (leftv res, leftv a, int op, const struct sValCmd2 *dA2, int at, const struct sConvertTypes *dConvertTypes)
 apply an operation 'op' to arguments a and a->next return TRUE on failure More...
 
BOOLEAN iiExprArith3Tab (leftv res, leftv a, int op, const struct sValCmd3 *dA3, int at, const struct sConvertTypes *dConvertTypes)
 apply an operation 'op' to arguments a, a->next and a->next->next return TRUE on failure More...
 
BOOLEAN iiCheckTypes (leftv args, const short *type_list, int report=0)
 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...
 
BOOLEAN iiBranchTo (leftv r, leftv args)
 
lists rDecompose (const ring r)
 
lists rDecompose_list_cf (const ring r)
 
BOOLEAN rDecompose_CF (leftv res, const coeffs C)
 

Variables

leftv iiCurrArgs
 
idhdl iiCurrProc
 
int iiOp
 
const char * currid
 
int iiRETURNEXPR_len
 
sleftv iiRETURNEXPR
 
ring * iiLocalRing
 
const char * lastreserved
 
int myynest
 
int printlevel
 
int si_echo
 
BOOLEAN yyInRingConstruction
 
const struct sValCmd2 dArith2 []
 
const struct sValCmd1 dArith1 []
 
const struct sValCmd3 dArith3 []
 
const struct sValCmdM dArithM []
 

Data Structure Documentation

◆ sValCmd1

struct sValCmd1

Definition at line 70 of file gentable.cc.

Data Fields
short arg
short cmd
int p
proc1 p
short res
short valid_for

◆ sValCmd2

struct sValCmd2

Definition at line 61 of file gentable.cc.

Data Fields
short arg1
short arg2
short cmd
int p
proc2 p
short res
short valid_for

◆ sValCmd3

struct sValCmd3

Definition at line 78 of file gentable.cc.

Data Fields
short arg1
short arg2
short arg3
short cmd
int p
proc3 p
short res
short valid_for

◆ sValCmdM

struct sValCmdM

Definition at line 88 of file gentable.cc.

Data Fields
short cmd
short number_of_args
int p
proc1 p
short res
short valid_for

◆ sValAssign_sys

struct sValAssign_sys

Definition at line 96 of file gentable.cc.

Data Fields
short arg
int p
proc1 p
short res

◆ sValAssign

struct sValAssign

Definition at line 103 of file gentable.cc.

Data Fields
short arg
int p
proci p
short res

Typedef Documentation

◆ proc1

typedef BOOLEAN(* proc1) (leftv, leftv)

Definition at line 120 of file ipshell.h.

◆ proc2

typedef BOOLEAN(* proc2) (leftv, leftv, leftv)

Definition at line 132 of file ipshell.h.

◆ proc3

typedef BOOLEAN(* proc3) (leftv, leftv, leftv, leftv)

Definition at line 143 of file ipshell.h.

◆ proci

typedef BOOLEAN(* proci) (leftv, leftv, Subexpr)

Definition at line 172 of file ipshell.h.

Function Documentation

◆ 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
Definition: intvec.h:14
ip_smatrix * matrix
Variable next() const
Definition: factory.h:135
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
int & cols()
Definition: matpol.h:25
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
Definition: tok.h:117

◆ iiAddCproc()

int iiAddCproc ( const char *  libname,
const char *  procname,
BOOLEAN  pstatic,
BOOLEAN(*)(leftv res, leftv v func 
)

Definition at line 1023 of file iplib.cc.

1025 {
1026  procinfov pi;
1027  idhdl h;
1028 
1029  #ifndef SING_NDEBUG
1030  int dummy;
1031  if (IsCmd(procname,dummy))
1032  {
1033  Werror(">>%s< is a reserved name",procname);
1034  return 0;
1035  }
1036  #endif
1037 
1038  h=IDROOT->get(procname,0);
1039  if ((h!=NULL)
1040  && (IDTYP(h)==PROC_CMD))
1041  {
1042  pi = IDPROC(h);
1043  if ((pi->language == LANG_SINGULAR)
1044  &&(BVERBOSE(V_REDEFINE)))
1045  Warn("extend `%s`",procname);
1046  }
1047  else
1048  {
1049  h = enterid(procname,0, PROC_CMD, &IDROOT, TRUE);
1050  }
1051  if ( h!= NULL )
1052  {
1053  pi = IDPROC(h);
1054  if((pi->language == LANG_SINGULAR)
1055  ||(pi->language == LANG_NONE))
1056  {
1057  omfree(pi->libname);
1058  pi->libname = omStrDup(libname);
1059  omfree(pi->procname);
1060  pi->procname = omStrDup(procname);
1061  pi->language = LANG_C;
1062  pi->ref = 1;
1063  pi->is_static = pstatic;
1064  pi->data.o.function = func;
1065  }
1066  else if(pi->language == LANG_C)
1067  {
1068  if(pi->data.o.function == func)
1069  {
1070  pi->ref++;
1071  }
1072  else
1073  {
1074  omfree(pi->libname);
1075  pi->libname = omStrDup(libname);
1076  omfree(pi->procname);
1077  pi->procname = omStrDup(procname);
1078  pi->language = LANG_C;
1079  pi->ref = 1;
1080  pi->is_static = pstatic;
1081  pi->data.o.function = func;
1082  }
1083  }
1084  else
1085  Warn("internal error: unknown procedure type %d",pi->language);
1086  return(1);
1087  }
1088  else
1089  {
1090  WarnS("iiAddCproc: failed.");
1091  }
1092  return(0);
1093 }
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:98
#define WarnS
Definition: emacs.cc:81
Definition: idrec.h:34
Definition: subexpr.h:22
#define IDTYP(a)
Definition: ipid.h:116
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:258
#define omfree(addr)
Definition: omAllocDecl.h:237
#define BVERBOSE(a)
Definition: options.h:33
#define IDPROC(a)
Definition: ipid.h:137
#define pi
Definition: libparse.cc:1143
#define NULL
Definition: omList.c:10
static Poly * h
Definition: janet.cc:978
#define V_REDEFINE
Definition: options.h:43
void Werror(const char *fmt,...)
Definition: reporter.cc:189
int IsCmd(const char *n, int &tok)
Definition: iparith.cc:8729
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiAlias()

BOOLEAN iiAlias ( leftv  p)

Definition at line 752 of file ipid.cc.

753 {
754  if (iiCurrArgs==NULL)
755  {
756  Werror("not enough arguments for proc %s",VoiceName());
757  p->CleanUp();
758  return TRUE;
759  }
761  iiCurrArgs=h->next;
762  h->next=NULL;
763  if (h->rtyp!=IDHDL)
764  {
766  h->CleanUp();
768  return res;
769  }
770  if ((h->Typ()!=p->Typ()) &&(p->Typ()!=DEF_CMD))
771  {
772  WerrorS("type mismatch");
773  return TRUE;
774  }
775  idhdl pp=(idhdl)p->data;
776  switch(pp->typ)
777  {
778  case CRING_CMD:
779  nKillChar((coeffs)pp);
780  break;
781  case DEF_CMD:
782  case INT_CMD:
783  break;
784  case INTVEC_CMD:
785  case INTMAT_CMD:
786  delete IDINTVEC(pp);
787  break;
788  case NUMBER_CMD:
789  nDelete(&IDNUMBER(pp));
790  break;
791  case BIGINT_CMD:
793  break;
794  case MAP_CMD:
795  {
796  map im = IDMAP(pp);
797  omFree((ADDRESS)im->preimage);
798  }
799  // continue as ideal:
800  case IDEAL_CMD:
801  case MODUL_CMD:
802  case MATRIX_CMD:
803  idDelete(&IDIDEAL(pp));
804  break;
805  case PROC_CMD:
806  case RESOLUTION_CMD:
807  case STRING_CMD:
809  break;
810  case LIST_CMD:
811  IDLIST(pp)->Clean();
812  break;
813  case LINK_CMD:
815  break;
816  // case ring: cannot happen
817  default:
818  Werror("unknown type %d",p->Typ());
819  return TRUE;
820  }
821  pp->typ=ALIAS_CMD;
822  IDDATA(pp)=(char*)h->data;
823  int eff_typ=h->Typ();
824  if ((RingDependend(eff_typ))
825  || ((eff_typ==LIST_CMD) && (lRingDependend((lists)h->Data()))))
826  {
827  ipSwapId(pp,IDROOT,currRing->idroot);
828  }
829  h->CleanUp();
831  return FALSE;
832 }
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
#define IDLIST(a)
Definition: ipid.h:134
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: tok.h:95
#define IDLINK(a)
Definition: ipid.h:135
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
Definition: lists.h:22
#define IDINTVEC(a)
Definition: ipid.h:125
#define FALSE
Definition: auxiliary.h:94
Definition: tok.h:38
return P p
Definition: myNF.cc:203
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:98
#define IDIDEAL(a)
Definition: ipid.h:130
void * ADDRESS
Definition: auxiliary.h:115
void WerrorS(const char *s)
Definition: feFopen.cc:24
coeffs coeffs_BIGINT
Definition: ipid.cc:54
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:31
poly pp
Definition: myNF.cc:296
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
int RingDependend(int t)
Definition: gentable.cc:23
Definition: tok.h:56
Definition: tok.h:58
#define omFree(addr)
Definition: omAllocDecl.h:261
The main handler for Singular numbers which are suitable for Singular polynomials.
#define IDSTRING(a)
Definition: ipid.h:133
idrec * idhdl
Definition: ring.h:18
omBin sleftv_bin
Definition: subexpr.cc:50
const char * VoiceName()
Definition: fevoices.cc:66
#define nDelete(n)
Definition: numbers.h:16
#define IDMAP(a)
Definition: ipid.h:132
#define IDNUMBER(a)
Definition: ipid.h:129
Definition: tok.h:34
Definition: tok.h:116
#define NULL
Definition: omList.c:10
leftv iiCurrArgs
Definition: ipshell.cc:78
Definition: tok.h:117
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete &#39;p&#39;
Definition: coeffs.h:459
#define IDDATA(a)
Definition: ipid.h:123
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:85
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:199
static int ipSwapId(idhdl tomove, idhdl &root1, idhdl &root2)
Definition: ipid.cc:585
void nKillChar(coeffs r)
undo all initialisations
Definition: numbers.cc:504
void Werror(const char *fmt,...)
Definition: reporter.cc:189
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1793

◆ iiAllStart()

BOOLEAN iiAllStart ( procinfov  pi,
char *  p,
feBufferTypes  t,
int  l 
)

Definition at line 311 of file iplib.cc.

312 {
313  // see below:
314  BITSET save1=si_opt_1;
315  BITSET save2=si_opt_2;
316  newBuffer( omStrDup(p /*pi->data.s.body*/), t /*BT_proc*/,
317  pi, l );
318  BOOLEAN err=yyparse();
319  if (sLastPrinted.rtyp!=0)
320  {
322  }
323  // the access to optionStruct and verboseStruct do not work
324  // on x86_64-Linux for pic-code
325  if ((TEST_V_ALLWARN) &&
326  (t==BT_proc) &&
327  ((save1!=si_opt_1)||(save2!=si_opt_2)) &&
328  (pi->libname!=NULL) && (pi->libname[0]!='\0'))
329  {
330  if ((pi->libname!=NULL) && (pi->libname[0]!='\0'))
331  Warn("option changed in proc %s from %s",pi->procname,pi->libname);
332  else
333  Warn("option changed in proc %s",pi->procname);
334  int i;
335  for (i=0; optionStruct[i].setval!=0; i++)
336  {
337  if ((optionStruct[i].setval & si_opt_1)
338  && (!(optionStruct[i].setval & save1)))
339  {
340  Print(" +%s",optionStruct[i].name);
341  }
342  if (!(optionStruct[i].setval & si_opt_1)
343  && ((optionStruct[i].setval & save1)))
344  {
345  Print(" -%s",optionStruct[i].name);
346  }
347  }
348  for (i=0; verboseStruct[i].setval!=0; i++)
349  {
350  if ((verboseStruct[i].setval & si_opt_2)
351  && (!(verboseStruct[i].setval & save2)))
352  {
353  Print(" +%s",verboseStruct[i].name);
354  }
355  if (!(verboseStruct[i].setval & si_opt_2)
356  && ((verboseStruct[i].setval & save2)))
357  {
358  Print(" -%s",verboseStruct[i].name);
359  }
360  }
361  PrintLn();
362  }
363  return err;
364 }
const struct soptionStruct optionStruct[]
Definition: misc_ip.cc:516
unsigned si_opt_1
Definition: options.c:5
void PrintLn()
Definition: reporter.cc:310
#define Print
Definition: emacs.cc:83
return P p
Definition: myNF.cc:203
unsigned setval
Definition: ipid.h:152
#define BITSET
Definition: structs.h:18
int i
Definition: cfEzgcd.cc:123
char name(const Variable &v)
Definition: factory.h:178
int yyparse(void)
Definition: grammar.cc:2101
#define pi
Definition: libparse.cc:1143
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:91
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
const struct soptionStruct verboseStruct[]
Definition: misc_ip.cc:546
unsigned si_opt_2
Definition: options.c:6
int BOOLEAN
Definition: auxiliary.h:85
#define TEST_V_ALLWARN
Definition: options.h:135
int l
Definition: cfEzgcd.cc:94
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiApply()

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

Definition at line 6327 of file ipshell.cc.

6328 {
6329  memset(res,0,sizeof(sleftv));
6330  res->rtyp=a->Typ();
6331  switch (res->rtyp /*a->Typ()*/)
6332  {
6333  case INTVEC_CMD:
6334  case INTMAT_CMD:
6335  return iiApplyINTVEC(res,a,op,proc);
6336  case BIGINTMAT_CMD:
6337  return iiApplyBIGINTMAT(res,a,op,proc);
6338  case IDEAL_CMD:
6339  case MODUL_CMD:
6340  case MATRIX_CMD:
6341  return iiApplyIDEAL(res,a,op,proc);
6342  case LIST_CMD:
6343  return iiApplyLIST(res,a,op,proc);
6344  }
6345  WerrorS("first argument to `apply` must allow an index");
6346  return TRUE;
6347 }
unsigned char * proc[NUM_PROC]
Definition: checklibs.c:16
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
const poly a
Definition: syzextra.cc:212
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6285
poly res
Definition: myNF.cc:322
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6295
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6290
Definition: tok.h:117
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6253

◆ iiARROW()

BOOLEAN iiARROW ( leftv  ,
char *  ,
char *   
)

Definition at line 6376 of file ipshell.cc.

6377 {
6378  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6379  // find end of s:
6380  int end_s=strlen(s);
6381  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6382  s[end_s+1]='\0';
6383  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6384  sprintf(name,"%s->%s",a,s);
6385  // find start of last expression
6386  int start_s=end_s-1;
6387  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6388  if (start_s<0) // ';' not found
6389  {
6390  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6391  }
6392  else // s[start_s] is ';'
6393  {
6394  s[start_s]='\0';
6395  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6396  }
6397  memset(r,0,sizeof(*r));
6398  // now produce procinfo for PROC_CMD:
6399  r->data = (void *)omAlloc0Bin(procinfo_bin);
6400  ((procinfo *)(r->data))->language=LANG_NONE;
6401  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6402  ((procinfo *)r->data)->data.s.body=ss;
6403  omFree(name);
6404  r->rtyp=PROC_CMD;
6405  //r->rtyp=STRING_CMD;
6406  //r->data=ss;
6407  return FALSE;
6408 }
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:1009
#define omAlloc(size)
Definition: omAllocDecl.h:210
omBin procinfo_bin
Definition: subexpr.cc:51
const ring r
Definition: syzextra.cc:208
#define omFree(addr)
Definition: omAllocDecl.h:261
char name(const Variable &v)
Definition: factory.h:178
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206

◆ iiAssign()

BOOLEAN iiAssign ( leftv  left,
leftv  right,
BOOLEAN  toplevel = TRUE 
)

Definition at line 1793 of file ipassign.cc.

1794 {
1795  if (errorreported) return TRUE;
1796  int ll=l->listLength();
1797  int rl;
1798  int lt=l->Typ();
1799  int rt=NONE;
1800  BOOLEAN b;
1801  if (l->rtyp==ALIAS_CMD)
1802  {
1803  Werror("`%s` is read-only",l->Name());
1804  }
1805 
1806  if (l->rtyp==IDHDL)
1807  {
1808  atKillAll((idhdl)l->data);
1809  IDFLAG((idhdl)l->data)=0;
1810  l->attribute=NULL;
1811  toplevel=FALSE;
1812  }
1813  else if (l->attribute!=NULL)
1814  atKillAll((idhdl)l);
1815  l->flag=0;
1816  if (ll==1)
1817  {
1818  /* l[..] = ... */
1819  if(l->e!=NULL)
1820  {
1821  BOOLEAN like_lists=0;
1822  blackbox *bb=NULL;
1823  int bt;
1824  if (((bt=l->rtyp)>MAX_TOK)
1825  || ((l->rtyp==IDHDL) && ((bt=IDTYP((idhdl)l->data))>MAX_TOK)))
1826  {
1827  bb=getBlackboxStuff(bt);
1828  like_lists=BB_LIKE_LIST(bb); // bb like a list
1829  }
1830  else if (((l->rtyp==IDHDL) && (IDTYP((idhdl)l->data)==LIST_CMD))
1831  || (l->rtyp==LIST_CMD))
1832  {
1833  like_lists=2; // bb in a list
1834  }
1835  if(like_lists)
1836  {
1837  if (traceit&TRACE_ASSIGN) PrintS("assign list[..]=...or similar\n");
1838  if (like_lists==1)
1839  {
1840  // check blackbox/newtype type:
1841  if(bb->blackbox_CheckAssign(bb,l,r)) return TRUE;
1842  }
1843  b=jiAssign_list(l,r);
1844  if((!b) && (like_lists==2))
1845  {
1846  //Print("jjA_L_LIST: - 2 \n");
1847  if((l->rtyp==IDHDL) && (l->data!=NULL))
1848  {
1849  ipMoveId((idhdl)l->data);
1850  l->attribute=IDATTR((idhdl)l->data);
1851  l->flag=IDFLAG((idhdl)l->data);
1852  }
1853  }
1854  r->CleanUp();
1855  Subexpr h;
1856  while (l->e!=NULL)
1857  {
1858  h=l->e->next;
1860  l->e=h;
1861  }
1862  return b;
1863  }
1864  }
1865  if (lt>MAX_TOK)
1866  {
1867  blackbox *bb=getBlackboxStuff(lt);
1868 #ifdef BLACKBOX_DEVEL
1869  Print("bb-assign: bb=%lx\n",bb);
1870 #endif
1871  return (bb==NULL) || bb->blackbox_Assign(l,r);
1872  }
1873  // end of handling elems of list and similar
1874  rl=r->listLength();
1875  if (rl==1)
1876  {
1877  /* system variables = ... */
1878  if(((l->rtyp>=VECHO)&&(l->rtyp<=VPRINTLEVEL))
1879  ||((l->rtyp>=VALTVARS)&&(l->rtyp<=VMINPOLY)))
1880  {
1881  b=iiAssign_sys(l,r);
1882  r->CleanUp();
1883  //l->CleanUp();
1884  return b;
1885  }
1886  rt=r->Typ();
1887  /* a = ... */
1888  if ((lt!=MATRIX_CMD)
1889  &&(lt!=BIGINTMAT_CMD)
1890  &&(lt!=CMATRIX_CMD)
1891  &&(lt!=INTMAT_CMD)
1892  &&((lt==rt)||(lt!=LIST_CMD)))
1893  {
1894  b=jiAssign_1(l,r,toplevel);
1895  if (l->rtyp==IDHDL)
1896  {
1897  if ((lt==DEF_CMD)||(lt==LIST_CMD))
1898  {
1899  ipMoveId((idhdl)l->data);
1900  }
1901  l->attribute=IDATTR((idhdl)l->data);
1902  l->flag=IDFLAG((idhdl)l->data);
1903  l->CleanUp();
1904  }
1905  r->CleanUp();
1906  return b;
1907  }
1908  if (((lt!=LIST_CMD)
1909  &&((rt==MATRIX_CMD)
1910  ||(rt==BIGINTMAT_CMD)
1911  ||(rt==CMATRIX_CMD)
1912  ||(rt==INTMAT_CMD)
1913  ||(rt==INTVEC_CMD)
1914  ||(rt==MODUL_CMD)))
1915  ||((lt==LIST_CMD)
1916  &&(rt==RESOLUTION_CMD))
1917  )
1918  {
1919  b=jiAssign_1(l,r,toplevel);
1920  if((l->rtyp==IDHDL)&&(l->data!=NULL))
1921  {
1922  if ((lt==DEF_CMD) || (lt==LIST_CMD))
1923  {
1924  //Print("ipAssign - 3.0\n");
1925  ipMoveId((idhdl)l->data);
1926  }
1927  l->attribute=IDATTR((idhdl)l->data);
1928  l->flag=IDFLAG((idhdl)l->data);
1929  }
1930  r->CleanUp();
1931  Subexpr h;
1932  while (l->e!=NULL)
1933  {
1934  h=l->e->next;
1936  l->e=h;
1937  }
1938  return b;
1939  }
1940  }
1941  if (rt==NONE) rt=r->Typ();
1942  }
1943  else if (ll==(rl=r->listLength()))
1944  {
1945  b=jiAssign_rec(l,r);
1946  return b;
1947  }
1948  else
1949  {
1950  if (rt==NONE) rt=r->Typ();
1951  if (rt==INTVEC_CMD)
1952  return jiA_INTVEC_L(l,r);
1953  else if (rt==VECTOR_CMD)
1954  return jiA_VECTOR_L(l,r);
1955  else if ((rt==IDEAL_CMD)||(rt==MATRIX_CMD))
1956  return jiA_MATRIX_L(l,r);
1957  else if ((rt==STRING_CMD)&&(rl==1))
1958  return jiA_STRING_L(l,r);
1959  Werror("length of lists in assignment does not match (l:%d,r:%d)",
1960  ll,rl);
1961  return TRUE;
1962  }
1963 
1964  leftv hh=r;
1965  BOOLEAN nok=FALSE;
1966  BOOLEAN map_assign=FALSE;
1967  switch (lt)
1968  {
1969  case INTVEC_CMD:
1970  nok=jjA_L_INTVEC(l,r,new intvec(exprlist_length(r)));
1971  break;
1972  case INTMAT_CMD:
1973  {
1974  nok=jjA_L_INTVEC(l,r,new intvec(IDINTVEC((idhdl)l->data)));
1975  break;
1976  }
1977  case BIGINTMAT_CMD:
1978  {
1979  nok=jjA_L_BIGINTMAT(l, r, new bigintmat(IDBIMAT((idhdl)l->data)));
1980  break;
1981  }
1982  case MAP_CMD:
1983  {
1984  // first element in the list sl (r) must be a ring
1985  if ((rt == RING_CMD)&&(r->e==NULL))
1986  {
1987  omFree((ADDRESS)IDMAP((idhdl)l->data)->preimage);
1988  IDMAP((idhdl)l->data)->preimage = omStrDup (r->Fullname());
1989  /* advance the expressionlist to get the next element after the ring */
1990  hh = r->next;
1991  }
1992  else
1993  {
1994  WerrorS("expected ring-name");
1995  nok=TRUE;
1996  break;
1997  }
1998  if (hh==NULL) /* map-assign: map f=r; */
1999  {
2000  WerrorS("expected image ideal");
2001  nok=TRUE;
2002  break;
2003  }
2004  if ((hh->next==NULL)&&(hh->Typ()==IDEAL_CMD))
2005  return jiAssign_1(l,hh,toplevel); /* map-assign: map f=r,i; */
2006  //no break, handle the rest like an ideal:
2007  map_assign=TRUE;
2008  }
2009  case MATRIX_CMD:
2010  case IDEAL_CMD:
2011  case MODUL_CMD:
2012  {
2013  sleftv t;
2014  matrix olm = (matrix)l->Data();
2015  int rk;
2016  char *pr=((map)olm)->preimage;
2017  BOOLEAN module_assign=(/*l->Typ()*/ lt==MODUL_CMD);
2018  matrix lm ;
2019  int num;
2020  int j,k;
2021  int i=0;
2022  int mtyp=MATRIX_CMD; /*Type of left side object*/
2023  int etyp=POLY_CMD; /*Type of elements of left side object*/
2024 
2025  if (lt /*l->Typ()*/==MATRIX_CMD)
2026  {
2027  rk=olm->rows();
2028  num=olm->cols()*rk /*olm->rows()*/;
2029  lm=mpNew(olm->rows(),olm->cols());
2030  int el;
2031  if ((traceit&TRACE_ASSIGN) && (num!=(el=exprlist_length(hh))))
2032  {
2033  Warn("expression list length(%d) does not match matrix size(%d)",el,num);
2034  }
2035  }
2036  else /* IDEAL_CMD or MODUL_CMD */
2037  {
2038  num=exprlist_length(hh);
2039  lm=(matrix)idInit(num,1);
2040  if (module_assign)
2041  {
2042  rk=0;
2043  mtyp=MODUL_CMD;
2044  etyp=VECTOR_CMD;
2045  }
2046  else
2047  rk=1;
2048  }
2049 
2050  int ht;
2051  loop
2052  {
2053  if (hh==NULL)
2054  break;
2055  else
2056  {
2057  matrix rm;
2058  ht=hh->Typ();
2059  if ((j=iiTestConvert(ht,etyp))!=0)
2060  {
2061  nok=iiConvert(ht,etyp,j,hh,&t);
2062  hh->next=t.next;
2063  if (nok) break;
2064  lm->m[i]=(poly)t.CopyD(etyp);
2065  pNormalize(lm->m[i]);
2066  if (module_assign) rk=si_max(rk,(int)pMaxComp(lm->m[i]));
2067  i++;
2068  }
2069  else
2070  if ((j=iiTestConvert(ht,mtyp))!=0)
2071  {
2072  nok=iiConvert(ht,mtyp,j,hh,&t);
2073  hh->next=t.next;
2074  if (nok) break;
2075  rm = (matrix)t.CopyD(mtyp);
2076  if (module_assign)
2077  {
2078  j = si_min(num,rm->cols());
2079  rk=si_max(rk,(int)rm->rank);
2080  }
2081  else
2082  j = si_min(num-i,rm->rows() * rm->cols());
2083  for(k=0;k<j;k++,i++)
2084  {
2085  lm->m[i]=rm->m[k];
2086  pNormalize(lm->m[i]);
2087  rm->m[k]=NULL;
2088  }
2089  idDelete((ideal *)&rm);
2090  }
2091  else
2092  {
2093  nok=TRUE;
2094  break;
2095  }
2096  t.next=NULL;t.CleanUp();
2097  if (i==num) break;
2098  hh=hh->next;
2099  }
2100  }
2101  if (nok)
2102  idDelete((ideal *)&lm);
2103  else
2104  {
2105  idDelete((ideal *)&olm);
2106  if (module_assign) lm->rank=rk;
2107  else if (map_assign) ((map)lm)->preimage=pr;
2108  l=l->LData();
2109  if (l->rtyp==IDHDL)
2110  IDMATRIX((idhdl)l->data)=lm;
2111  else
2112  l->data=(char *)lm;
2113  }
2114  break;
2115  }
2116  case STRING_CMD:
2117  nok=jjA_L_STRING(l,r);
2118  break;
2119  //case DEF_CMD:
2120  case LIST_CMD:
2121  nok=jjA_L_LIST(l,r);
2122  break;
2123  case NONE:
2124  case 0:
2125  Werror("cannot assign to %s",l->Fullname());
2126  nok=TRUE;
2127  break;
2128  default:
2129  WerrorS("assign not impl.");
2130  nok=TRUE;
2131  break;
2132  } /* end switch: typ */
2133  if (nok && (!errorreported)) WerrorS("incompatible type in list assignment");
2134  r->CleanUp();
2135  return nok;
2136 }
int & rows()
Definition: matpol.h:24
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
static BOOLEAN jiA_INTVEC_L(leftv l, leftv r)
Definition: ipassign.cc:1324
void ipMoveId(idhdl tomove)
Definition: ipid.cc:610
int iiTestConvert(int inputType, int outputType)
Definition: gentable.cc:293
Definition: tok.h:203
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define TRACE_ASSIGN
Definition: reporter.h:45
static BOOLEAN jjA_L_INTVEC(leftv l, leftv r, intvec *iv)
Definition: ipassign.cc:1456
#define Print
Definition: emacs.cc:83
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
CanonicalForm num(const CanonicalForm &f)
#define IDINTVEC(a)
Definition: ipid.h:125
#define pMaxComp(p)
Definition: polys.h:281
loop
Definition: myNF.cc:98
static int si_min(const int a, const int b)
Definition: auxiliary.h:121
#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
int exprlist_length(leftv v)
Definition: ipshell.cc:544
Matrices of numbers.
Definition: bigintmat.h:51
static BOOLEAN jiAssign_list(leftv l, leftv r)
Definition: ipassign.cc:1700
Definition: tok.h:213
static BOOLEAN jiAssign_1(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1086
#define BB_LIKE_LIST(B)
Definition: blackbox.h:54
#define TRUE
Definition: auxiliary.h:98
void * ADDRESS
Definition: auxiliary.h:115
#define IDBIMAT(a)
Definition: ipid.h:126
void WerrorS(const char *s)
Definition: feFopen.cc:24
int k
Definition: cfEzgcd.cc:93
int traceit
Definition: febase.cc:47
int Typ()
Definition: subexpr.cc:995
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:31
static BOOLEAN jjA_L_BIGINTMAT(leftv l, leftv r, bigintmat *bim)
Definition: ipassign.cc:1505
static BOOLEAN iiAssign_sys(leftv l, leftv r)
Definition: ipassign.cc:1250
#define IDTYP(a)
Definition: ipid.h:116
poly * m
Definition: matpol.h:19
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
int j
Definition: myNF.cc:70
Definition: tok.h:58
#define omFree(addr)
Definition: omAllocDecl.h:261
pNormalize(P.p)
static BOOLEAN jiA_VECTOR_L(leftv l, leftv r)
Definition: ipassign.cc:1350
omBin sSubexpr_bin
Definition: subexpr.cc:49
ip_smatrix * matrix
static BOOLEAN jjA_L_STRING(leftv l, leftv r)
Definition: ipassign.cc:1554
static int si_max(const int a, const int b)
Definition: auxiliary.h:120
int i
Definition: cfEzgcd.cc:123
void PrintS(const char *s)
Definition: reporter.cc:284
#define IDMAP(a)
Definition: ipid.h:132
short errorreported
Definition: feFopen.cc:23
leftv next
Definition: subexpr.h:86
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:44
Definition: tok.h:34
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
#define atKillAll(H)
Definition: attrib.h:42
static BOOLEAN jiA_STRING_L(leftv l, leftv r)
Definition: ipassign.cc:1664
int & cols()
Definition: matpol.h:25
#define NULL
Definition: omList.c:10
static BOOLEAN jiAssign_rec(leftv l, leftv r)
Definition: ipassign.cc:1770
static BOOLEAN jiA_MATRIX_L(leftv l, leftv r)
Definition: ipassign.cc:1588
static BOOLEAN jjA_L_LIST(leftv l, leftv r)
Definition: ipassign.cc:1391
#define IDFLAG(a)
Definition: ipid.h:117
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
#define IDATTR(a)
Definition: ipid.h:120
Definition: tok.h:117
polyrec * poly
Definition: hilb.h:10
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:85
const poly b
Definition: syzextra.cc:213
#define NONE
Definition: tok.h:216
void Werror(const char *fmt,...)
Definition: reporter.cc:189
void * CopyD(int t)
Definition: subexpr.cc:707
int l
Definition: cfEzgcd.cc:94
long rank
Definition: matpol.h:20
#define IDMATRIX(a)
Definition: ipid.h:131
blackbox * getBlackboxStuff(const int t)
return the structure to the type given by t
Definition: blackbox.cc:16
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  ,
leftv   
)

Definition at line 6410 of file ipshell.cc.

6411 {
6412  char* ring_name=omStrDup((char*)r->Name());
6413  int t=arg->Typ();
6414  if (t==RING_CMD)
6415  {
6416  sleftv tmp;
6417  memset(&tmp,0,sizeof(tmp));
6418  tmp.rtyp=IDHDL;
6419  tmp.data=(char*)rDefault(ring_name);
6420  if (tmp.data!=NULL)
6421  {
6422  BOOLEAN b=iiAssign(&tmp,arg);
6423  if (b) return TRUE;
6424  rSetHdl(ggetid(ring_name));
6425  omFree(ring_name);
6426  return FALSE;
6427  }
6428  else
6429  return TRUE;
6430  }
6431  else if (t==CRING_CMD)
6432  {
6433  sleftv tmp;
6434  sleftv n;
6435  memset(&n,0,sizeof(n));
6436  n.name=ring_name;
6437  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6438  if (iiAssign(&tmp,arg)) return TRUE;
6439  //Print("create %s\n",r->Name());
6440  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6441  return FALSE;
6442  }
6443  //Print("create %s\n",r->Name());
6444  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6445  return TRUE;// not handled -> error for now
6446 }
idhdl ggetid(const char *n)
Definition: ipid.cc:510
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define FALSE
Definition: auxiliary.h:94
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:98
#define IDHDL
Definition: tok.h:31
idhdl rDefault(const char *s)
Definition: ipshell.cc:1549
void * data
Definition: subexpr.h:88
int myynest
Definition: febase.cc:46
Definition: tok.h:56
const ring r
Definition: syzextra.cc:208
const char * name
Definition: subexpr.h:87
#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:91
void rSetHdl(idhdl h)
Definition: ipshell.cc:5038
int BOOLEAN
Definition: auxiliary.h:85
const poly b
Definition: syzextra.cc:213
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1793
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  r,
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:82
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:473
int listLength()
Definition: subexpr.cc:60
#define TRUE
Definition: auxiliary.h:98
void Init()
Definition: subexpr.h:107
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
#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:6466
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:739
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
int IsCmd(const char *n, int &tok)
Definition: iparith.cc:8729
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiCallLibProc1()

void* iiCallLibProc1 ( const char *  n,
void *  arg,
int  arg_type,
BOOLEAN err 
)

Definition at line 631 of file iplib.cc.

632 {
633  idhdl h=ggetid(n);
634  if ((h==NULL)
635  || (IDTYP(h)!=PROC_CMD))
636  {
637  err=2;
638  return NULL;
639  }
640  // ring handling
641  idhdl save_ringhdl=currRingHdl;
642  ring save_ring=currRing;
644  // argument:
645  sleftv tmp;
646  tmp.Init();
647  tmp.data=arg;
648  tmp.rtyp=arg_type;
649  // call proc
650  err=iiMake_proc(h,currPack,&tmp);
651  // clean up ring
652  iiCallLibProcEnd(save_ringhdl,save_ring);
653  // return
654  if (err==FALSE)
655  {
656  void*r=iiRETURNEXPR.data;
659  return r;
660  }
661  return NULL;
662 }
idhdl ggetid(const char *n)
Definition: ipid.cc:510
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:473
static void iiCallLibProcEnd(idhdl save_ringhdl, ring save_ring)
Definition: iplib.cc:606
void Init()
Definition: subexpr.h:107
Definition: idrec.h:34
void * data
Definition: subexpr.h:88
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
idhdl currRingHdl
Definition: ipid.cc:65
static void iiCallLibProcBegin()
Definition: iplib.cc:588
BOOLEAN iiMake_proc(idhdl pn, package pack, leftv sl)
Definition: iplib.cc:503
#define NULL
Definition: omList.c:10
package currPack
Definition: ipid.cc:63
int rtyp
Definition: subexpr.h:91
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
static Poly * h
Definition: janet.cc:978

◆ iiCallLibProcM()

void* iiCallLibProcM ( const char *  n,
void **  args,
int *  arg_types,
BOOLEAN err 
)

args: NULL terminated arry of arguments arg_types: 0 terminated array of corresponding types

Definition at line 665 of file iplib.cc.

666 {
667  idhdl h=ggetid(n);
668  if ((h==NULL)
669  || (IDTYP(h)!=PROC_CMD))
670  {
671  err=2;
672  return NULL;
673  }
674  // ring handling
675  idhdl save_ringhdl=currRingHdl;
676  ring save_ring=currRing;
678  // argument:
679  if (arg_types[0]!=0)
680  {
681  sleftv tmp;
682  leftv tt=&tmp;
683  int i=1;
684  tmp.Init();
685  tmp.data=args[0];
686  tmp.rtyp=arg_types[0];
687  while(arg_types[i]!=0)
688  {
689  tt->next=(leftv)omAlloc0(sizeof(sleftv));
690  tt=tt->next;
691  tt->rtyp=arg_types[i];
692  tt->data=args[i];
693  i++;
694  }
695  // call proc
696  err=iiMake_proc(h,currPack,&tmp);
697  }
698  else
699  // call proc
700  err=iiMake_proc(h,currPack,NULL);
701  // clean up ring
702  iiCallLibProcEnd(save_ringhdl,save_ring);
703  // return
704  if (err==FALSE)
705  {
706  void*r=iiRETURNEXPR.data;
709  return r;
710  }
711  return NULL;
712 }
idhdl ggetid(const char *n)
Definition: ipid.cc:510
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:473
static void iiCallLibProcEnd(idhdl save_ringhdl, ring save_ring)
Definition: iplib.cc:606
void Init()
Definition: subexpr.h:107
sleftv * leftv
Definition: structs.h:60
Definition: idrec.h:34
void * data
Definition: subexpr.h:88
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
idhdl currRingHdl
Definition: ipid.cc:65
int i
Definition: cfEzgcd.cc:123
static void iiCallLibProcBegin()
Definition: iplib.cc:588
leftv next
Definition: subexpr.h:86
BOOLEAN iiMake_proc(idhdl pn, package pack, leftv sl)
Definition: iplib.cc:503
#define NULL
Definition: omList.c:10
package currPack
Definition: ipid.cc:63
int rtyp
Definition: subexpr.h:91
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
static Poly * h
Definition: janet.cc:978
#define omAlloc0(size)
Definition: omAllocDecl.h:211

◆ 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 = 0 
)

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

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

◆ iiConvName()

char* iiConvName ( const char *  libname)

Definition at line 1340 of file iplib.cc.

1341 {
1342  char *tmpname = omStrDup(libname);
1343  char *p = strrchr(tmpname, DIR_SEP);
1344  char *r;
1345  if(p==NULL) p = tmpname;
1346  else p++;
1347  r = (char *)strchr(p, '.');
1348  if( r!= NULL) *r = '\0';
1349  r = omStrDup(p);
1350  *r = mytoupper(*r);
1351  // printf("iiConvName: '%s' '%s' => '%s'\n", libname, tmpname, r);
1352  omFree((ADDRESS)tmpname);
1353 
1354  return(r);
1355 }
char mytoupper(char c)
Definition: iplib.cc:1321
return P p
Definition: myNF.cc:203
void * ADDRESS
Definition: auxiliary.h:115
#define DIR_SEP
Definition: feResource.h:6
const ring r
Definition: syzextra.cc:208
#define omFree(addr)
Definition: omAllocDecl.h:261
#define NULL
Definition: omList.c:10
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ 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");
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 = FALSE,
BOOLEAN  init_b = TRUE 
)

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:82
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:88
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:87
idhdl currRingHdl
Definition: ipid.cc:65
omBin sleftv_bin
Definition: subexpr.cc:50
char name(const Variable &v)
Definition: factory.h:178
#define IDLEV(a)
Definition: ipid.h:118
leftv next
Definition: subexpr.h:86
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:91
Definition: tok.h:157
int BOOLEAN
Definition: auxiliary.h:85
#define TEST_V_ALLWARN
Definition: options.h:135
#define Warn
Definition: emacs.cc:80

◆ iiEStart()

BOOLEAN iiEStart ( char *  example,
procinfo pi 
)

Definition at line 717 of file iplib.cc.

718 {
719  BOOLEAN err;
720  int old_echo=si_echo;
721 
722  iiCheckNest();
723  procstack->push(example);
726  {
727  if (traceit&TRACE_SHOW_LINENO) printf("\n");
728  printf("entering example (level %d)\n",myynest);
729  }
730  myynest++;
731 
732  err=iiAllStart(pi,example,BT_example,(pi != NULL ? pi->data.s.example_lineno: 0));
733 
735  myynest--;
736  si_echo=old_echo;
738  {
739  if (traceit&TRACE_SHOW_LINENO) printf("\n");
740  printf("leaving -example- (level %d)\n",myynest);
741  }
742  if (iiLocalRing[myynest] != currRing)
743  {
744  if (iiLocalRing[myynest]!=NULL)
745  {
748  }
749  else
750  {
752  currRing=NULL;
753  }
754  }
755  procstack->pop();
756  return err;
757 }
#define TRACE_SHOW_LINENO
Definition: reporter.h:30
proclevel * procstack
Definition: ipid.cc:58
int traceit
Definition: febase.cc:47
static void iiCheckNest()
Definition: iplib.cc:492
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 killlocals(int v)
Definition: ipshell.cc:378
idhdl currRingHdl
Definition: ipid.cc:65
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1594
BOOLEAN iiAllStart(procinfov pi, char *p, feBufferTypes t, int l)
Definition: iplib.cc:311
#define pi
Definition: libparse.cc:1143
ring * iiLocalRing
Definition: iplib.cc:472
#define NULL
Definition: omList.c:10
#define TRACE_SHOW_PROC
Definition: reporter.h:28
void rSetHdl(idhdl h)
Definition: ipshell.cc:5038
void push(char *)
Definition: ipid.cc:711
void pop()
Definition: ipid.cc:721
int BOOLEAN
Definition: auxiliary.h:85
int si_echo
Definition: febase.cc:41

◆ 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:82
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
const ring r
Definition: syzextra.cc:208
Variable next() const
Definition: factory.h:135
char name() const
Definition: variable.cc:122
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 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:82
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
Definition: idrec.h:34
idhdl get(const char *s, int lev)
Definition: ipid.cc:90
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
#define IDTYP(a)
Definition: ipid.h:116
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:408
char my_yylinebuf[80]
Definition: febase.cc:48
Variable next() const
Definition: factory.h:135
char name() const
Definition: variable.cc:122
#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
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

◆ iiExprArith1()

BOOLEAN iiExprArith1 ( leftv  res,
sleftv a,
int  op 
)

◆ iiExprArith1Tab()

BOOLEAN iiExprArith1Tab ( leftv  res,
leftv  a,
int  op,
const struct sValCmd1 dA1,
int  at,
const struct sConvertTypes dConvertTypes 
)

apply an operation 'op' to an argument a return TRUE on failure

Parameters
[out]respre-allocated result
[in]aargument
[in]opoperation
[in]dA1table of possible proc assumes dArith1[0].cmd==op
[in]ata->Typ()
[in]dConvertTypestable of type conversions

Definition at line 8189 of file iparith.cc.

8190 {
8191  memset(res,0,sizeof(sleftv));
8192  BOOLEAN call_failed=FALSE;
8193 
8194  if (!errorreported)
8195  {
8196  BOOLEAN failed=FALSE;
8197  iiOp=op;
8198  int i = 0;
8199  while (dA1[i].cmd==op)
8200  {
8201  if (at==dA1[i].arg)
8202  {
8203  if (currRing!=NULL)
8204  {
8205  if (check_valid(dA1[i].valid_for,op)) break;
8206  }
8207  else
8208  {
8209  if (RingDependend(dA1[i].res))
8210  {
8211  WerrorS("no ring active");
8212  break;
8213  }
8214  }
8215  if (traceit&TRACE_CALL)
8216  Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
8217  res->rtyp=dA1[i].res;
8218  if ((call_failed=dA1[i].p(res,a)))
8219  {
8220  break;// leave loop, goto error handling
8221  }
8222  if (a->Next()!=NULL)
8223  {
8224  res->next=(leftv)omAllocBin(sleftv_bin);
8225  failed=iiExprArith1(res->next,a->next,op);
8226  }
8227  a->CleanUp();
8228  return failed;
8229  }
8230  i++;
8231  }
8232  // implicite type conversion --------------------------------------------
8233  if (dA1[i].cmd!=op)
8234  {
8236  i=0;
8237  //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
8238  while (dA1[i].cmd==op)
8239  {
8240  int ai;
8241  //Print("test %s\n",Tok2Cmdname(dA1[i].arg));
8242  if ((dA1[i].valid_for & NO_CONVERSION)==0)
8243  {
8244  if ((ai=iiTestConvert(at,dA1[i].arg,dConvertTypes))!=0)
8245  {
8246  if (currRing!=NULL)
8247  {
8248  if (check_valid(dA1[i].valid_for,op)) break;
8249  }
8250  else
8251  {
8252  if (RingDependend(dA1[i].res))
8253  {
8254  WerrorS("no ring active");
8255  break;
8256  }
8257  }
8258  if (traceit&TRACE_CALL)
8259  Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(dA1[i].arg));
8260  res->rtyp=dA1[i].res;
8261  failed= ((iiConvert(at,dA1[i].arg,ai,a,an,dConvertTypes))
8262  || (call_failed=dA1[i].p(res,an)));
8263  // everything done, clean up temp. variables
8264  if (failed)
8265  {
8266  // leave loop, goto error handling
8267  break;
8268  }
8269  else
8270  {
8271  if (an->Next() != NULL)
8272  {
8273  res->next = (leftv)omAllocBin(sleftv_bin);
8274  failed=iiExprArith1(res->next,an->next,op);
8275  }
8276  // everything ok, clean up and return
8277  an->CleanUp();
8279  return failed;
8280  }
8281  }
8282  }
8283  i++;
8284  }
8285  an->CleanUp();
8287  }
8288  // error handling
8289  if (!errorreported)
8290  {
8291  if ((at==0) && (a->Fullname()!=sNoName_fe))
8292  {
8293  Werror("`%s` is not defined",a->Fullname());
8294  }
8295  else
8296  {
8297  i=0;
8298  const char *s = iiTwoOps(op);
8299  Werror("%s(`%s`) failed"
8300  ,s,Tok2Cmdname(at));
8301  if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8302  {
8303  while (dA1[i].cmd==op)
8304  {
8305  if ((dA1[i].res!=0)
8306  && (dA1[i].p!=jjWRONG))
8307  Werror("expected %s(`%s`)"
8308  ,s,Tok2Cmdname(dA1[i].arg));
8309  i++;
8310  }
8311  }
8312  }
8313  }
8314  res->rtyp = UNKNOWN;
8315  }
8316  a->CleanUp();
8317  return TRUE;
8318 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
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:82
const poly a
Definition: syzextra.cc:212
#define Print
Definition: emacs.cc:83
const struct sConvertTypes dConvertTypes[]
Definition: table.h:1186
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:8319
#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
const char sNoName_fe[]
Definition: fevoices.cc:65
#define TRUE
Definition: auxiliary.h:98
#define UNKNOWN
Definition: tok.h:217
void * ADDRESS
Definition: auxiliary.h:115
sleftv * leftv
Definition: structs.h:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
int traceit
Definition: febase.cc:47
short res
Definition: gentable.cc:74
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
#define V_SHOW_USE
Definition: options.h:50
static BOOLEAN check_valid(const int p, const int op)
Definition: iparith.cc:9126
const char * Tok2Cmdname(int tok)
Definition: iparith.cc:8851
int RingDependend(int t)
Definition: gentable.cc:23
const char * iiTwoOps(int t)
Definition: gentable.cc:253
static BOOLEAN jjWRONG(leftv, leftv)
Definition: iparith.cc:3485
leftv Next()
Definition: subexpr.h:136
omBin sleftv_bin
Definition: subexpr.cc:50
int i
Definition: cfEzgcd.cc:123
#define TRACE_CALL
Definition: reporter.h:43
short errorreported
Definition: feFopen.cc:23
leftv next
Definition: subexpr.h:86
#define BVERBOSE(a)
Definition: options.h:33
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
#define NULL
Definition: omList.c:10
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
#define NO_CONVERSION
Definition: iparith.cc:124
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
int iiOp
Definition: iparith.cc:224
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189

◆ iiExprArith2()

BOOLEAN iiExprArith2 ( leftv  res,
sleftv a,
int  op,
sleftv b,
BOOLEAN  proccall = FALSE 
)

◆ iiExprArith2Tab()

BOOLEAN iiExprArith2Tab ( leftv  res,
leftv  a,
int  op,
const struct sValCmd2 dA2,
int  at,
const struct sConvertTypes dConvertTypes 
)

apply an operation 'op' to arguments a and a->next return TRUE on failure

Parameters
[out]respre-allocated result
[in]a2 arguments
[in]opoperation
[in]dA2table of possible proc assumes dA2[0].cmd==op
[in]ata->Typ()
[in]dConvertTypestable of type conversions

Definition at line 8117 of file iparith.cc.

8121 {
8122  leftv b=a->next;
8123  a->next=NULL;
8124  int bt=b->Typ();
8126  a->next=b;
8127  a->CleanUp(); // to clean up the chain, content already done in iiExprArith2TabIntern
8128  return bo;
8129 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
const poly a
Definition: syzextra.cc:212
const struct sConvertTypes dConvertTypes[]
Definition: table.h:1186
#define TRUE
Definition: auxiliary.h:98
static BOOLEAN iiExprArith2TabIntern(leftv res, leftv a, int op, leftv b, BOOLEAN proccall, const struct sValCmd2 *dA2, int at, int bt, const struct sConvertTypes *dConvertTypes)
Definition: iparith.cc:7957
poly res
Definition: myNF.cc:322
#define NULL
Definition: omList.c:10
int BOOLEAN
Definition: auxiliary.h:85
const poly b
Definition: syzextra.cc:213

◆ iiExprArith3()

BOOLEAN iiExprArith3 ( leftv  res,
int  op,
leftv  a,
leftv  b,
leftv  c 
)

Definition at line 8531 of file iparith.cc.

8532 {
8533  memset(res,0,sizeof(sleftv));
8534 
8535  if (!errorreported)
8536  {
8537 #ifdef SIQ
8538  if (siq>0)
8539  {
8540  //Print("siq:%d\n",siq);
8542  memcpy(&d->arg1,a,sizeof(sleftv));
8543  a->Init();
8544  memcpy(&d->arg2,b,sizeof(sleftv));
8545  b->Init();
8546  memcpy(&d->arg3,c,sizeof(sleftv));
8547  c->Init();
8548  d->op=op;
8549  d->argc=3;
8550  res->data=(char *)d;
8551  res->rtyp=COMMAND;
8552  return FALSE;
8553  }
8554 #endif
8555  int at=a->Typ();
8556  // handling bb-objects ----------------------------------------------
8557  if (at>MAX_TOK)
8558  {
8559  blackbox *bb=getBlackboxStuff(at);
8560  if (bb!=NULL)
8561  {
8562  if(!bb->blackbox_Op3(op,res,a,b,c)) return FALSE;
8563  if (errorreported) return TRUE;
8564  // else: no op defined
8565  }
8566  else return TRUE;
8567  if (errorreported) return TRUE;
8568  }
8569  int bt=b->Typ();
8570  int ct=c->Typ();
8571 
8572  iiOp=op;
8573  int i=0;
8574  while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8575  return iiExprArith3TabIntern(res,op,a,b,c,dArith3+i,at,bt,ct,dConvertTypes);
8576  }
8577  a->CleanUp();
8578  b->CleanUp();
8579  c->CleanUp();
8580  //Print("op: %d,result typ:%d\n",op,res->rtyp);
8581  return TRUE;
8582 }
static BOOLEAN iiExprArith3TabIntern(leftv res, int op, leftv a, leftv b, leftv c, const struct sValCmd3 *dA3, int at, int bt, int ct, const struct sConvertTypes *dConvertTypes)
Definition: iparith.cc:8377
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
ip_command * command
Definition: ipid.h:24
const poly a
Definition: syzextra.cc:212
const struct sConvertTypes dConvertTypes[]
Definition: table.h:1186
#define FALSE
Definition: auxiliary.h:94
Definition: tok.h:213
BOOLEAN siq
Definition: subexpr.cc:57
#define TRUE
Definition: auxiliary.h:98
void Init()
Definition: subexpr.h:107
int Typ()
Definition: subexpr.cc:995
poly res
Definition: myNF.cc:322
const struct sValCmd3 dArith3[]
Definition: table.h:716
int i
Definition: cfEzgcd.cc:123
short errorreported
Definition: feFopen.cc:23
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
#define NULL
Definition: omList.c:10
omBin sip_command_bin
Definition: ipid.cc:49
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
int iiOp
Definition: iparith.cc:224
const poly b
Definition: syzextra.cc:213
#define COMMAND
Definition: tok.h:29
blackbox * getBlackboxStuff(const int t)
return the structure to the type given by t
Definition: blackbox.cc:16

◆ iiExprArith3Tab()

BOOLEAN iiExprArith3Tab ( leftv  res,
leftv  a,
int  op,
const struct sValCmd3 dA3,
int  at,
const struct sConvertTypes dConvertTypes 
)

apply an operation 'op' to arguments a, a->next and a->next->next return TRUE on failure

Parameters
[out]respre-allocated result
[in]a3 arguments
[in]opoperation
[in]dA3table of possible proc assumes dA3[0].cmd==op
[in]ata->Typ()
[in]dConvertTypestable of type conversions

Definition at line 8583 of file iparith.cc.

8587 {
8588  leftv b=a->next;
8589  a->next=NULL;
8590  int bt=b->Typ();
8591  leftv c=b->next;
8592  b->next=NULL;
8593  int ct=c->Typ();
8594  BOOLEAN bo=iiExprArith3TabIntern(res,op,a,b,c,dA3,at,bt,ct,dConvertTypes);
8595  b->next=c;
8596  a->next=b;
8597  a->CleanUp(); // to cleanup the chain, content already done
8598  return bo;
8599 }
static BOOLEAN iiExprArith3TabIntern(leftv res, int op, leftv a, leftv b, leftv c, const struct sValCmd3 *dA3, int at, int bt, int ct, const struct sConvertTypes *dConvertTypes)
Definition: iparith.cc:8377
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
const poly a
Definition: syzextra.cc:212
const struct sConvertTypes dConvertTypes[]
Definition: table.h:1186
int Typ()
Definition: subexpr.cc:995
poly res
Definition: myNF.cc:322
#define NULL
Definition: omList.c:10
int BOOLEAN
Definition: auxiliary.h:85
const poly b
Definition: syzextra.cc:213

◆ iiExprArithM()

BOOLEAN iiExprArithM ( leftv  res,
sleftv a,
int  op 
)

◆ iiGetLibName()

char* iiGetLibName ( procinfov  v)

Definition at line 101 of file iplib.cc.

102 {
103  return pi->libname;
104 }
#define pi
Definition: libparse.cc:1143

◆ iiGetLibProcBuffer()

char* iiGetLibProcBuffer ( procinfov  pi,
int  part = 1 
)

◆ 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 }
BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition: ring.h:752
#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:177
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 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()

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

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
Definition: idrec.h:34
#define IDTYP(a)
Definition: ipid.h:116
int RingDependend(int t)
Definition: gentable.cc:23
idrec * idhdl
Definition: ring.h:18
idhdl next
Definition: idrec.h:38
char name() const
Definition: variable.cc:122
#define IDLEV(a)
Definition: ipid.h:118
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
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

◆ iiLibCmd()

BOOLEAN iiLibCmd ( char *  newlib,
BOOLEAN  autoexport,
BOOLEAN  tellerror,
BOOLEAN  force 
)

Definition at line 844 of file iplib.cc.

845 {
846  char libnamebuf[1024];
847  // procinfov pi;
848  // idhdl h;
849  idhdl pl;
850  // idhdl hl;
851  // long pos = 0L;
852  char *plib = iiConvName(newlib);
853  FILE * fp = feFopen( newlib, "r", libnamebuf, tellerror );
854  // int lines = 1;
855  BOOLEAN LoadResult = TRUE;
856 
857  if (fp==NULL)
858  {
859  return TRUE;
860  }
861  pl = basePack->idroot->get(plib,0);
862  if (pl==NULL)
863  {
864  pl = enterid( plib,0, PACKAGE_CMD,
865  &(basePack->idroot), TRUE );
866  IDPACKAGE(pl)->language = LANG_SINGULAR;
867  IDPACKAGE(pl)->libname=omStrDup(newlib);
868  }
869  else
870  {
871  if(IDTYP(pl)!=PACKAGE_CMD)
872  {
873  WarnS("not of type package.");
874  fclose(fp);
875  return TRUE;
876  }
877  if (!force) return FALSE;
878  }
879  LoadResult = iiLoadLIB(fp, libnamebuf, newlib, pl, autoexport, tellerror);
880  omFree((ADDRESS)newlib);
881 
882  if(!LoadResult) IDPACKAGE(pl)->loaded = TRUE;
883  omFree((ADDRESS)plib);
884 
885  return LoadResult;
886 }
CanonicalForm fp
Definition: cfModGcd.cc:4043
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
void * ADDRESS
Definition: auxiliary.h:115
#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 enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:258
#define omFree(addr)
Definition: omAllocDecl.h:261
FILE * feFopen(const char *path, const char *mode, char *where, short useWerror, short path_only)
Definition: feFopen.cc:47
char libnamebuf[1024]
Definition: libparse.cc:1096
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
BOOLEAN iiLoadLIB(FILE *fp, const char *libnamebuf, const char *newlib, idhdl pl, BOOLEAN autoexport, BOOLEAN tellerror)
Definition: iplib.cc:933
char * iiConvName(const char *libname)
Definition: iplib.cc:1340
int BOOLEAN
Definition: auxiliary.h:85
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiLoadLIB()

BOOLEAN iiLoadLIB ( FILE *  fp,
const char *  libnamebuf,
const char *  newlib,
idhdl  pl,
BOOLEAN  autoexport,
BOOLEAN  tellerror 
)

Definition at line 933 of file iplib.cc.

935 {
936  extern FILE *yylpin;
937  libstackv ls_start = library_stack;
938  lib_style_types lib_style;
939 
940  yylpin = fp;
941  #if YYLPDEBUG > 1
942  print_init();
943  #endif
944  extern int lpverbose;
946  else lpverbose=0;
947  // yylplex sets also text_buffer
948  if (text_buffer!=NULL) *text_buffer='\0';
949  yylplex(newlib, libnamebuf, &lib_style, pl, autoexport);
950  if(yylp_errno)
951  {
952  Werror("Library %s: ERROR occurred: in line %d, %d.", newlib, yylplineno,
953  current_pos(0));
955  {
959  }
960  else
962  WerrorS("Cannot load library,... aborting.");
963  reinit_yylp();
964  fclose( yylpin );
966  return TRUE;
967  }
968  if (BVERBOSE(V_LOAD_LIB))
969  Print( "// ** loaded %s %s\n", libnamebuf, text_buffer);
970  if( (lib_style == OLD_LIBSTYLE) && (BVERBOSE(V_LOAD_LIB)))
971  {
972  Warn( "library %s has old format. This format is still accepted,", newlib);
973  Warn( "but for functionality you may wish to change to the new");
974  Warn( "format. Please refer to the manual for further information.");
975  }
976  reinit_yylp();
977  fclose( yylpin );
978  fp = NULL;
979  iiRunInit(IDPACKAGE(pl));
980 
981  {
982  libstackv ls;
983  for(ls = library_stack; (ls != NULL) && (ls != ls_start); )
984  {
985  if(ls->to_be_done)
986  {
987  ls->to_be_done=FALSE;
988  iiLibCmd(ls->get(),autoexport,tellerror,FALSE);
989  ls = ls->pop(newlib);
990  }
991  }
992 #if 0
993  PrintS("--------------------\n");
994  for(ls = library_stack; ls != NULL; ls = ls->next)
995  {
996  Print("%s: LIB-stack:(%d), %s %s\n", newlib, ls->cnt, ls->get(),
997  ls->to_be_done ? "not loaded" : "loaded");
998  }
999  PrintS("--------------------\n");
1000 #endif
1001  }
1002 
1003  if(fp != NULL) fclose(fp);
1004  return FALSE;
1005 }
int cnt
Definition: subexpr.h:166
#define Print
Definition: emacs.cc:83
CanonicalForm fp
Definition: cfModGcd.cc:4043
int yylplex(const char *libname, const char *libfile, lib_style_types *lib_style, idhdl pl, BOOLEAN autoexport=FALSE, lp_modes=LOAD_LIB)
libstackv next
Definition: subexpr.h:163
#define FALSE
Definition: auxiliary.h:94
static void iiRunInit(package p)
Definition: iplib.cc:917
#define V_LOAD_LIB
Definition: options.h:45
#define IDROOT
Definition: ipid.h:20
BOOLEAN to_be_done
Definition: subexpr.h:165
#define TRUE
Definition: auxiliary.h:98
void print_init()
Definition: libparse.cc:3480
void * ADDRESS
Definition: auxiliary.h:115
void WerrorS(const char *s)
Definition: feFopen.cc:24
char * get()
Definition: subexpr.h:169
#define V_DEBUG_LIB
Definition: options.h:46
libstackv pop(const char *p)
Definition: iplib.cc:1429
BOOLEAN iiLibCmd(char *newlib, BOOLEAN autoexport, BOOLEAN tellerror, BOOLEAN force)
Definition: iplib.cc:844
#define IDPACKAGE(a)
Definition: ipid.h:136
#define YYLP_BAD_CHAR
Definition: libparse.h:93
int lpverbose
Definition: libparse.cc:1104
int yylp_errno
Definition: libparse.cc:1128
#define omFree(addr)
Definition: omAllocDecl.h:261
char * yylp_errlist[]
Definition: libparse.cc:1112
void PrintS(const char *s)
Definition: reporter.cc:284
char libnamebuf[1024]
Definition: libparse.cc:1096
#define BVERBOSE(a)
Definition: options.h:33
#define NULL
Definition: omList.c:10
char * text_buffer
Definition: libparse.cc:1097
int current_pos(int i=0)
Definition: libparse.cc:3344
lib_style_types
Definition: libparse.h:9
static void iiCleanProcs(idhdl &root)
Definition: iplib.cc:888
void Werror(const char *fmt,...)
Definition: reporter.cc:189
libstackv library_stack
Definition: iplib.cc:74
int yylplineno
Definition: libparse.cc:1102
#define Warn
Definition: emacs.cc:80
void reinit_yylp()
Definition: libparse.cc:3374

◆ iiLocateLib()

BOOLEAN iiLocateLib ( const char *  lib,
char *  where 
)

Definition at line 830 of file iplib.cc.

831 {
832  char *plib = iiConvName(lib);
833  idhdl pl = basePack->idroot->get(plib,0);
834  if( (pl!=NULL) && (IDTYP(pl)==PACKAGE_CMD) &&
835  (IDPACKAGE(pl)->language == LANG_SINGULAR))
836  {
837  strncpy(where,IDPACKAGE(pl)->libname,127);
838  return TRUE;
839  }
840  else
841  return FALSE;;
842 }
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:136
#define IDTYP(a)
Definition: ipid.h:116
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
char * iiConvName(const char *libname)
Definition: iplib.cc:1340

◆ iiMake_proc()

BOOLEAN iiMake_proc ( idhdl  pn,
package  pack,
leftv  sl 
)

Definition at line 503 of file iplib.cc.

504 {
505  int err;
506  procinfov pi = IDPROC(pn);
507  if(pi->is_static && myynest==0)
508  {
509  Werror("'%s::%s()' is a local procedure and cannot be accessed by an user.",
510  pi->libname, pi->procname);
511  return TRUE;
512  }
513  iiCheckNest();
515  //Print("currRing(%d):%s(%x) in %s\n",myynest,IDID(currRingHdl),currRing,IDID(pn));
516  iiRETURNEXPR.Init();
517  procstack->push(pi->procname);
519  || (pi->trace_flag&TRACE_SHOW_PROC))
520  {
522  Print("entering%-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
523  }
524 #ifdef RDEBUG
526 #endif
527  switch (pi->language)
528  {
529  default:
530  case LANG_NONE:
531  WerrorS("undefined proc");
532  err=TRUE;
533  break;
534 
535  case LANG_SINGULAR:
536  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
537  {
538  currPack=pi->pack;
541  //Print("set pack=%s\n",IDID(currPackHdl));
542  }
543  else if ((pack!=NULL)&&(currPack!=pack))
544  {
545  currPack=pack;
548  //Print("set pack=%s\n",IDID(currPackHdl));
549  }
550  err=iiPStart(pn,sl);
551  break;
552  case LANG_C:
554  err = (pi->data.o.function)(res, sl);
555  memcpy(&iiRETURNEXPR,res,sizeof(iiRETURNEXPR));
557  break;
558  }
560  || (pi->trace_flag&TRACE_SHOW_PROC))
561  {
563  Print("leaving %-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
564  }
565  //const char *n="NULL";
566  //if (currRingHdl!=NULL) n=IDID(currRingHdl);
567  //Print("currRing(%d):%s(%x) after %s\n",myynest,n,currRing,IDID(pn));
568 #ifdef RDEBUG
570 #endif
571  if (err)
572  {
574  //iiRETURNEXPR.Init(); //done by CleanUp
575  }
576  if (iiCurrArgs!=NULL)
577  {
578  if (!err) Warn("too many arguments for %s",IDID(pn));
579  iiCurrArgs->CleanUp();
582  }
583  procstack->pop();
584  if (err)
585  return TRUE;
586  return FALSE;
587 }
#define TRACE_SHOW_LINENO
Definition: reporter.h:30
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define TRACE_SHOW_RINGS
Definition: reporter.h:35
void PrintLn()
Definition: reporter.cc:310
#define Print
Definition: emacs.cc:83
idhdl currPackHdl
Definition: ipid.cc:61
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:473
proclevel * procstack
Definition: ipid.cc:58
static void iiShowLevRings()
Definition: iplib.cc:477
#define TRUE
Definition: auxiliary.h:98
void Init()
Definition: subexpr.h:107
void * ADDRESS
Definition: auxiliary.h:115
sleftv * leftv
Definition: structs.h:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
int traceit
Definition: febase.cc:47
static void iiCheckNest()
Definition: iplib.cc:492
BOOLEAN iiPStart(idhdl pn, leftv v)
Definition: iplib.cc:371
poly res
Definition: myNF.cc:322
Definition: subexpr.h:22
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
omBin sleftv_bin
Definition: subexpr.cc:50
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
#define IDPROC(a)
Definition: ipid.h:137
#define pi
Definition: libparse.cc:1143
ring * iiLocalRing
Definition: iplib.cc:472
#define NULL
Definition: omList.c:10
package currPack
Definition: ipid.cc:63
leftv iiCurrArgs
Definition: ipshell.cc:78
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
#define TRACE_SHOW_PROC
Definition: reporter.h:28
idhdl packFindHdl(package r)
Definition: ipid.cc:739
void iiCheckPack(package &p)
Definition: ipshell.cc:1535
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
void push(char *)
Definition: ipid.cc:711
void pop()
Definition: ipid.cc:721
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 = NULL 
)

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:82
#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:88
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
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:89
omBin slists_bin
Definition: lists.cc:23
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
static Poly * h
Definition: janet.cc:978
#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:82
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
void * data
Definition: subexpr.h:88
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:91
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:82
#define FALSE
Definition: auxiliary.h:94
return P p
Definition: myNF.cc:203
#define TRUE
Definition: auxiliary.h:98
void * ADDRESS
Definition: auxiliary.h:115
poly res
Definition: myNF.cc:322
omBin sleftv_bin
Definition: subexpr.cc:50
const char * VoiceName()
Definition: fevoices.cc:66
#define NULL
Definition: omList.c:10
BOOLEAN iiDefaultParameter(leftv p)
Definition: ipshell.cc:1166
leftv iiCurrArgs
Definition: ipshell.cc:78
#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

◆ iiProcArgs()

char* iiProcArgs ( char *  e,
BOOLEAN  withParenth 
)

Definition at line 127 of file iplib.cc.

128 {
129  while ((*e==' ') || (*e=='\t') || (*e=='(')) e++;
130  if (*e<' ')
131  {
132  if (withParenth)
133  {
134  // no argument list, allow list #
135  return omStrDup("parameter list #;");
136  }
137  else
138  {
139  // empty list
140  return omStrDup("");
141  }
142  }
143  BOOLEAN in_args;
144  BOOLEAN args_found;
145  char *s;
146  char *argstr=(char *)omAlloc(127); // see ../omalloc/omTables.inc
147  int argstrlen=127;
148  *argstr='\0';
149  int par=0;
150  do
151  {
152  args_found=FALSE;
153  s=e; // set s to the starting point of the arg
154  // and search for the end
155  // skip leading spaces:
156  loop
157  {
158  if ((*s==' ')||(*s=='\t'))
159  s++;
160  else if ((*s=='\n')&&(*(s+1)==' '))
161  s+=2;
162  else // start of new arg or \0 or )
163  break;
164  }
165  e=s;
166  while ((*e!=',')
167  &&((par!=0) || (*e!=')'))
168  &&(*e!='\0'))
169  {
170  if (*e=='(') par++;
171  else if (*e==')') par--;
172  args_found=args_found || (*e>' ');
173  e++;
174  }
175  in_args=(*e==',');
176  if (args_found)
177  {
178  *e='\0';
179  // check for space:
180  if ((int)strlen(argstr)+12 /* parameter + ;*/ +(int)strlen(s)>= argstrlen)
181  {
182  argstrlen*=2;
183  char *a=(char *)omAlloc( argstrlen);
184  strcpy(a,argstr);
185  omFree((ADDRESS)argstr);
186  argstr=a;
187  }
188  // copy the result to argstr
189  if(strncmp(s,"alias ",6)!=0)
190  {
191  strcat(argstr,"parameter ");
192  }
193  strcat(argstr,s);
194  strcat(argstr,"; ");
195  e++; // e was pointing to ','
196  }
197  } while (in_args);
198  return argstr;
199 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
const poly a
Definition: syzextra.cc:212
loop
Definition: myNF.cc:98
#define FALSE
Definition: auxiliary.h:94
void * ADDRESS
Definition: auxiliary.h:115
#define omAlloc(size)
Definition: omAllocDecl.h:210
#define omFree(addr)
Definition: omAllocDecl.h:261
int BOOLEAN
Definition: auxiliary.h:85
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiProcName()

char* iiProcName ( char *  buf,
char &  ct,
char *&  e 
)

Definition at line 113 of file iplib.cc.

114 {
115  char *s=buf+5;
116  while (*s==' ') s++;
117  e=s+1;
118  while ((*e>' ') && (*e!='(')) e++;
119  ct=*e;
120  *e='\0';
121  return s;
122 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
int status int void * buf
Definition: si_signals.h:59

◆ iiPStart()

BOOLEAN iiPStart ( idhdl  pn,
leftv  sl 
)

Definition at line 371 of file iplib.cc.

372 {
373  procinfov pi=NULL;
374  int old_echo=si_echo;
375  BOOLEAN err=FALSE;
376  char save_flags=0;
377 
378  /* init febase ======================================== */
379  /* we do not enter this case if filename != NULL !! */
380  if (pn!=NULL)
381  {
382  pi = IDPROC(pn);
383  if(pi!=NULL)
384  {
385  save_flags=pi->trace_flag;
386  if( pi->data.s.body==NULL )
387  {
389  if (pi->data.s.body==NULL) return TRUE;
390  }
391 // omUpdateInfo();
392 // int m=om_Info.UsedBytes;
393 // Print("proc %s, mem=%d\n",IDID(pn),m);
394  }
395  }
396  else return TRUE;
397  /* generate argument list ======================================*/
398  //iiCurrArgs should be NULL here, as the assignment for the parameters
399  // of the prevouis call are already done befor calling another routine
400  if (v!=NULL)
401  {
403  memcpy(iiCurrArgs,v,sizeof(sleftv)); // keeps track of v->next etc.
404  memset(v,0,sizeof(sleftv));
405  }
406  else
407  {
409  }
410  iiCurrProc=pn;
411  /* start interpreter ======================================*/
412  myynest++;
413  if (myynest > SI_MAX_NEST)
414  {
415  WerrorS("nesting too deep");
416  err=TRUE;
417  }
418  else
419  {
420  err=iiAllStart(pi,pi->data.s.body,BT_proc,pi->data.s.body_lineno-(v!=NULL));
421 
422  if (iiLocalRing[myynest-1] != currRing)
423  {
425  {
426  //idhdl hn;
427  const char *n;
428  const char *o;
429  idhdl nh=NULL, oh=NULL;
430  if (iiLocalRing[myynest-1]!=NULL)
432  if (oh!=NULL) o=oh->id;
433  else o="none";
434  if (currRing!=NULL)
435  nh=rFindHdl(currRing,NULL);
436  if (nh!=NULL) n=nh->id;
437  else n="none";
438  Werror("ring change during procedure call %s: %s -> %s (level %d)",pi->procname,o,n,myynest);
440  err=TRUE;
441  }
443  }
444  if ((currRing==NULL)
445  && (currRingHdl!=NULL))
447  else
448  if ((currRing!=NULL) &&
450  ||(IDLEV(currRingHdl)>=myynest-1)))
451  {
454  }
455  //Print("kill locals for %s (level %d)\n",IDID(pn),myynest);
457 #ifndef SING_NDEBUG
458  checkall();
459 #endif
460  //Print("end kill locals for %s (%d)\n",IDID(pn),myynest);
461  }
462  myynest--;
463  si_echo=old_echo;
464  if (pi!=NULL)
465  pi->trace_flag=save_flags;
466 // omUpdateInfo();
467 // int m=om_Info.UsedBytes;
468 // Print("exit %s, mem=%d\n",IDID(pn),m);
469  return err;
470 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:473
#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
idhdl iiCurrProc
Definition: ipshell.cc:79
#define SI_MAX_NEST
Definition: iplib.cc:33
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 RingDependend()
Definition: subexpr.cc:402
void killlocals(int v)
Definition: ipshell.cc:378
idhdl currRingHdl
Definition: ipid.cc:65
omBin sleftv_bin
Definition: subexpr.cc:50
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1594
#define IDLEV(a)
Definition: ipid.h:118
BOOLEAN iiAllStart(procinfov pi, char *p, feBufferTypes t, int l)
Definition: iplib.cc:311
#define IDPROC(a)
Definition: ipid.h:137
#define pi
Definition: libparse.cc:1143
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
ring * iiLocalRing
Definition: iplib.cc:472
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:124
leftv iiCurrArgs
Definition: ipshell.cc:78
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
const char * id
Definition: idrec.h:39
void rSetHdl(idhdl h)
Definition: ipshell.cc:5038
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:210
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189
int si_echo
Definition: febase.cc:41

◆ 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:137
#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

◆ iiTestAssume()

BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6349 of file ipshell.cc.

6350 {
6351  // assume a: level
6352  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6353  {
6354  if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6355  char assume_yylinebuf[80];
6356  strncpy(assume_yylinebuf,my_yylinebuf,79);
6357  int lev=(long)a->Data();
6358  int startlev=0;
6359  idhdl h=ggetid("assumeLevel");
6360  if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6361  if(lev <=startlev)
6362  {
6363  BOOLEAN bo=b->Eval();
6364  if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6365  if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6366  if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6367  }
6368  }
6369  b->CleanUp();
6370  a->CleanUp();
6371  return FALSE;
6372 }
idhdl ggetid(const char *n)
Definition: ipid.cc:510
const poly a
Definition: syzextra.cc:212
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
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
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
#define TEST_V_ALLWARN
Definition: options.h:135

◆ iiTokType()

int iiTokType ( int  op)

Definition at line 239 of file iparith.cc.

240 {
241  for (unsigned i=0;i<sArithBase.nCmdUsed;i++)
242  {
243  if (sArithBase.sCmds[i].tokval==op)
244  return sArithBase.sCmds[i].toktype;
245  }
246  return 0;
247 }
int i
Definition: cfEzgcd.cc:123
unsigned nCmdUsed
number of commands used
Definition: iparith.cc:193
static SArithBase sArithBase
Base entry for arithmetic.
Definition: iparith.cc:203
cmdnames * sCmds
array of existing commands
Definition: iparith.cc:188

◆ iiTryLoadLib()

BOOLEAN iiTryLoadLib ( leftv  v,
const char *  id 
)

Definition at line 782 of file iplib.cc.

783 {
784  BOOLEAN LoadResult = TRUE;
785  char libnamebuf[1024];
786  char *libname = (char *)omAlloc(strlen(id)+5);
787  const char *suffix[] = { "", ".lib", ".so", ".sl", NULL };
788  int i = 0;
789  // FILE *fp;
790  // package pack;
791  // idhdl packhdl;
792  lib_types LT;
793  for(i=0; suffix[i] != NULL; i++)
794  {
795  sprintf(libname, "%s%s", id, suffix[i]);
796  *libname = mytolower(*libname);
797  if((LT = type_of_LIB(libname, libnamebuf)) > LT_NOTFOUND)
798  {
799  char *s=omStrDup(libname);
800  #ifdef HAVE_DYNAMIC_LOADING
801  char libnamebuf[1024];
802  #endif
803 
804  if (LT==LT_SINGULAR)
805  LoadResult = iiLibCmd(s, FALSE, FALSE,TRUE);
806  #ifdef HAVE_DYNAMIC_LOADING
807  else if ((LT==LT_ELF) || (LT==LT_HPUX))
808  LoadResult = load_modules(s,libnamebuf,FALSE);
809  #endif
810  else if (LT==LT_BUILTIN)
811  {
812  LoadResult=load_builtin(s,FALSE, iiGetBuiltinModInit(s));
813  }
814  if(!LoadResult )
815  {
816  v->name = iiConvName(libname);
817  break;
818  }
819  }
820  }
821  omFree(libname);
822  return LoadResult;
823 }
BOOLEAN load_builtin(const char *newlib, BOOLEAN autoexport, SModulFunc_t init)
Definition: iplib.cc:1206
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define FALSE
Definition: auxiliary.h:94
Definition: mod_raw.h:16
#define TRUE
Definition: auxiliary.h:98
lib_types type_of_LIB(const char *newlib, char *libnamebuf)
Definition: mod_lib.cc:24
#define omAlloc(size)
Definition: omAllocDecl.h:210
BOOLEAN iiLibCmd(char *newlib, BOOLEAN autoexport, BOOLEAN tellerror, BOOLEAN force)
Definition: iplib.cc:844
#define omFree(addr)
Definition: omAllocDecl.h:261
int i
Definition: cfEzgcd.cc:123
lib_types
Definition: mod_raw.h:16
char libnamebuf[1024]
Definition: libparse.cc:1096
char mytolower(char c)
Definition: iplib.cc:1327
char name() const
Definition: variable.cc:122
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
SModulFunc_t iiGetBuiltinModInit(const char *libname)
Definition: iplib.cc:769
char * iiConvName(const char *libname)
Definition: iplib.cc:1340
int BOOLEAN
Definition: auxiliary.h:85
BOOLEAN load_modules(const char *newlib, char *fullname, BOOLEAN autoexport)
Definition: iplib.cc:1108
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiTwoOps()

const char* iiTwoOps ( int  t)

Definition at line 253 of file gentable.cc.

254 {
255  if (t<127)
256  {
257  static char ch[2];
258  switch (t)
259  {
260  case '&':
261  return "and";
262  case '|':
263  return "or";
264  default:
265  ch[0]=t;
266  ch[1]='\0';
267  return ch;
268  }
269  }
270  switch (t)
271  {
272  case COLONCOLON: return "::";
273  case DOTDOT: return "..";
274  //case PLUSEQUAL: return "+=";
275  //case MINUSEQUAL: return "-=";
276  case MINUSMINUS: return "--";
277  case PLUSPLUS: return "++";
278  case EQUAL_EQUAL: return "==";
279  case LE: return "<=";
280  case GE: return ">=";
281  case NOTEQUAL: return "<>";
282  default: return Tok2Cmdname(t);
283  }
284 }
Definition: grammar.cc:270
Definition: grammar.cc:269
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:132

◆ iiWRITE()

BOOLEAN iiWRITE ( leftv  res,
leftv  exprlist 
)

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:82
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
leftv next
Definition: subexpr.h:86
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
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

◆ IsCmd()

int IsCmd ( const char *  n,
int &  tok 
)

Definition at line 8729 of file iparith.cc.

8730 {
8731  int i;
8732  int an=1;
8733  int en=sArithBase.nLastIdentifier;
8734 
8735  loop
8736  //for(an=0; an<sArithBase.nCmdUsed; )
8737  {
8738  if(an>=en-1)
8739  {
8740  if (strcmp(n, sArithBase.sCmds[an].name) == 0)
8741  {
8742  i=an;
8743  break;
8744  }
8745  else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
8746  {
8747  i=en;
8748  break;
8749  }
8750  else
8751  {
8752  // -- blackbox extensions:
8753  // return 0;
8754  return blackboxIsCmd(n,tok);
8755  }
8756  }
8757  i=(an+en)/2;
8758  if (*n < *(sArithBase.sCmds[i].name))
8759  {
8760  en=i-1;
8761  }
8762  else if (*n > *(sArithBase.sCmds[i].name))
8763  {
8764  an=i+1;
8765  }
8766  else
8767  {
8768  int v=strcmp(n,sArithBase.sCmds[i].name);
8769  if(v<0)
8770  {
8771  en=i-1;
8772  }
8773  else if(v>0)
8774  {
8775  an=i+1;
8776  }
8777  else /*v==0*/
8778  {
8779  break;
8780  }
8781  }
8782  }
8784  tok=sArithBase.sCmds[i].tokval;
8785  if(sArithBase.sCmds[i].alias==2)
8786  {
8787  Warn("outdated identifier `%s` used - please change your code",
8788  sArithBase.sCmds[i].name);
8789  sArithBase.sCmds[i].alias=1;
8790  }
8791  #if 0
8792  if (currRingHdl==NULL)
8793  {
8794  #ifdef SIQ
8795  if (siq<=0)
8796  {
8797  #endif
8798  if ((tok>=BEGIN_RING) && (tok<=END_RING))
8799  {
8800  WerrorS("no ring active");
8801  return 0;
8802  }
8803  #ifdef SIQ
8804  }
8805  #endif
8806  }
8807  #endif
8808  if (!expected_parms)
8809  {
8810  switch (tok)
8811  {
8812  case IDEAL_CMD:
8813  case INT_CMD:
8814  case INTVEC_CMD:
8815  case MAP_CMD:
8816  case MATRIX_CMD:
8817  case MODUL_CMD:
8818  case POLY_CMD:
8819  case PROC_CMD:
8820  case RING_CMD:
8821  case STRING_CMD:
8822  cmdtok = tok;
8823  break;
8824  }
8825  }
8826  return sArithBase.sCmds[i].toktype;
8827 }
Definition: tok.h:95
loop
Definition: myNF.cc:98
BOOLEAN siq
Definition: subexpr.cc:57
int cmdtok
Definition: grammar.cc:174
void WerrorS(const char *s)
Definition: feFopen.cc:24
BOOLEAN expected_parms
Definition: grammar.cc:173
idhdl currRingHdl
Definition: ipid.cc:65
int i
Definition: cfEzgcd.cc:123
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
unsigned nLastIdentifier
valid indentifieres are slot 1..nLastIdentifier
Definition: iparith.cc:195
#define NULL
Definition: omList.c:10
int blackboxIsCmd(const char *n, int &tok)
used by scanner: returns ROOT_DECL for known types (and the type number in tok)
Definition: blackbox.cc:191
static SArithBase sArithBase
Base entry for arithmetic.
Definition: iparith.cc:203
cmdnames * sCmds
array of existing commands
Definition: iparith.cc:188
const char * lastreserved
Definition: ipshell.cc:80
#define Warn
Definition: emacs.cc:80

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv  res,
leftv  v 
)

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:82
Definition: tok.h:95
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:920
void * data
Definition: subexpr.h:88
poly res
Definition: myNF.cc:322
int rtyp
Definition: subexpr.h:91
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 }
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
poly res
Definition: myNF.cc:322
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
void atSet(idhdl root, char *name, void *data, int typ)
Definition: attrib.cc:158
int i
Definition: cfEzgcd.cc:123
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:137
#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;
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
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
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
poly res
Definition: myNF.cc:322
const ring r
Definition: syzextra.cc:208
Definition: tok.h:58
CFList tmp2
Definition: facFqBivar.cc:70
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
void * Data()
Definition: subexpr.cc:1137
Definition: tok.h:117
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 3273 of file ipshell.cc.

3274 {
3275  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3276  return (res->data==NULL);
3277 }
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
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition: clapsing.cc:1385
#define NULL
Definition: omList.c:10
void * Data()
Definition: subexpr.cc:1137

◆ jjIMPORTFROM()

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

Definition at line 2184 of file ipassign.cc.

2185 {
2186  //Print("importfrom %s::%s ->.\n",v->Name(),u->Name() );
2187  assume(u->Typ()==PACKAGE_CMD);
2188  char *vn=(char *)v->Name();
2189  idhdl h=((package)(u->Data()))->idroot->get(vn /*v->Name()*/, myynest);
2190  if (h!=NULL)
2191  {
2192  //check for existence
2193  if (((package)(u->Data()))==basePack)
2194  {
2195  WarnS("source and destination packages are identical");
2196  return FALSE;
2197  }
2198  idhdl t=basePack->idroot->get(vn /*v->Name()*/, myynest);
2199  if (t!=NULL)
2200  {
2201  if (BVERBOSE(V_REDEFINE)) Warn("redefining %s (%s)",vn,my_yylinebuf);
2202  killhdl(t);
2203  }
2204  sleftv tmp_expr;
2205  if (iiDeclCommand(&tmp_expr,v,myynest,DEF_CMD,&IDROOT)) return TRUE;
2206  sleftv h_expr;
2207  memset(&h_expr,0,sizeof(h_expr));
2208  h_expr.rtyp=IDHDL;
2209  h_expr.data=h;
2210  h_expr.name=vn;
2211  return iiAssign(&tmp_expr,&h_expr);
2212  }
2213  else
2214  {
2215  Werror("`%s` not found in `%s`",v->Name(), u->Name());
2216  return TRUE;
2217  }
2218  return FALSE;
2219 }
ip_package * package
Definition: structs.h:46
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define FALSE
Definition: auxiliary.h:94
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:98
#define WarnS
Definition: emacs.cc:81
int Typ()
Definition: subexpr.cc:995
const char * Name()
Definition: subexpr.h:120
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:31
void * data
Definition: subexpr.h:88
int myynest
Definition: febase.cc:46
char my_yylinebuf[80]
Definition: febase.cc:48
Definition: tok.h:58
const char * name
Definition: subexpr.h:87
#define assume(x)
Definition: mod2.h:394
#define BVERBOSE(a)
Definition: options.h:33
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition: ipshell.cc:1122
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
void killhdl(idhdl h, package proot)
Definition: ipid.cc:377
package basePack
Definition: ipid.cc:64
int rtyp
Definition: subexpr.h:91
void * Data()
Definition: subexpr.cc:1137
static Poly * h
Definition: janet.cc:978
#define V_REDEFINE
Definition: options.h:43
void Werror(const char *fmt,...)
Definition: reporter.cc:189
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1793
#define Warn
Definition: emacs.cc:80

◆ jjLIST_PL()

BOOLEAN jjLIST_PL ( leftv  res,
leftv  v 
)

Definition at line 7374 of file iparith.cc.

7375 {
7376  int sl=0;
7377  if (v!=NULL) sl = v->listLength();
7378  lists L;
7379  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7380  {
7381  int add_row_shift = 0;
7382  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7383  if (weights!=NULL) add_row_shift=weights->min_in();
7384  L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7385  }
7386  else
7387  {
7389  leftv h=NULL;
7390  int i;
7391  int rt;
7392 
7393  L->Init(sl);
7394  for (i=0;i<sl;i++)
7395  {
7396  if (h!=NULL)
7397  { /* e.g. not in the first step:
7398  * h is the pointer to the old sleftv,
7399  * v is the pointer to the next sleftv
7400  * (in this moment) */
7401  h->next=v;
7402  }
7403  h=v;
7404  v=v->next;
7405  h->next=NULL;
7406  rt=h->Typ();
7407  if (rt==0)
7408  {
7409  L->Clean();
7410  Werror("`%s` is undefined",h->Fullname());
7411  return TRUE;
7412  }
7413  if (rt==RING_CMD)
7414  {
7415  L->m[i].rtyp=rt; L->m[i].data=h->Data();
7416  ((ring)L->m[i].data)->ref++;
7417  }
7418  else
7419  L->m[i].Copy(h);
7420  }
7421  }
7422  res->data=(char *)L;
7423  return FALSE;
7424 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
lists syConvRes(syStrategy syzstr, BOOLEAN toDel, int add_row_shift)
Definition: ipshell.cc:3109
#define TRUE
Definition: auxiliary.h:98
int min_in()
Definition: intvec.h:113
void * data
Definition: subexpr.h:88
poly res
Definition: myNF.cc:322
Definition: intvec.h:14
void Copy(leftv e)
Definition: subexpr.cc:688
int i
Definition: cfEzgcd.cc:123
Variable next() const
Definition: factory.h:135
INLINE_THIS void Init(int l=0)
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:137
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
void Clean(ring r=currRing)
Definition: lists.h:25
omBin slists_bin
Definition: lists.cc:23
static Poly * h
Definition: janet.cc:978
void Werror(const char *fmt,...)
Definition: reporter.cc:189

◆ jjLOAD()

BOOLEAN jjLOAD ( const char *  s,
BOOLEAN  autoexport = FALSE 
)

load lib/module given in v

Definition at line 5157 of file iparith.cc.

5158 {
5159  char libnamebuf[1024];
5161 
5162 #ifdef HAVE_DYNAMIC_LOADING
5163  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5164 #endif /* HAVE_DYNAMIC_LOADING */
5165  switch(LT)
5166  {
5167  default:
5168  case LT_NONE:
5169  Werror("%s: unknown type", s);
5170  break;
5171  case LT_NOTFOUND:
5172  Werror("cannot open %s", s);
5173  break;
5174 
5175  case LT_SINGULAR:
5176  {
5177  char *plib = iiConvName(s);
5178  idhdl pl = IDROOT->get(plib,0);
5179  if (pl==NULL)
5180  {
5181  pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5182  IDPACKAGE(pl)->language = LANG_SINGULAR;
5183  IDPACKAGE(pl)->libname=plib;
5184  }
5185  else if (IDTYP(pl)!=PACKAGE_CMD)
5186  {
5187  Werror("can not create package `%s`",plib);
5188  omFree(plib);
5189  return TRUE;
5190  }
5191  else
5192  omFree(plib);
5193  package savepack=currPack;
5194  currPack=IDPACKAGE(pl);
5195  IDPACKAGE(pl)->loaded=TRUE;
5196  char libnamebuf[1024];
5197  FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5198  BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5199  currPack=savepack;
5200  IDPACKAGE(pl)->loaded=(!bo);
5201  return bo;
5202  }
5203  case LT_BUILTIN:
5204  SModulFunc_t iiGetBuiltinModInit(const char*);
5205  return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5206  case LT_MACH_O:
5207  case LT_ELF:
5208  case LT_HPUX:
5209 #ifdef HAVE_DYNAMIC_LOADING
5210  return load_modules(s, libnamebuf, autoexport);
5211 #else /* HAVE_DYNAMIC_LOADING */
5212  WerrorS("Dynamic modules are not supported by this version of Singular");
5213  break;
5214 #endif /* HAVE_DYNAMIC_LOADING */
5215  }
5216  return TRUE;
5217 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
CanonicalForm fp
Definition: cfModGcd.cc:4043
Definition: mod_raw.h:16
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:98
lib_types type_of_LIB(const char *newlib, char *libnamebuf)
Definition: mod_lib.cc:24
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:136
#define IDTYP(a)
Definition: ipid.h:116
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:258
#define omFree(addr)
Definition: omAllocDecl.h:261
FILE * feFopen(const char *path, const char *mode, char *where, short useWerror, short path_only)
Definition: feFopen.cc:47
lib_types
Definition: mod_raw.h:16
char libnamebuf[1024]
Definition: libparse.cc:1096
BOOLEAN load_builtin(const char *newlib, BOOLEAN autoexport, SModulFunc_t init)
Definition: iplib.cc:1206
#define NULL
Definition: omList.c:10
SModulFunc_t iiGetBuiltinModInit(const char *libname)
Definition: iplib.cc:769
package basePack
Definition: ipid.cc:64
package currPack
Definition: ipid.cc:63
int(* SModulFunc_t)(SModulFunctions *)
Definition: ipid.h:82
BOOLEAN iiLoadLIB(FILE *fp, const char *libnamebuf, const char *newlib, idhdl pl, BOOLEAN autoexport, BOOLEAN tellerror)
Definition: iplib.cc:933
char * iiConvName(const char *libname)
Definition: iplib.cc:1340
int BOOLEAN
Definition: auxiliary.h:85
BOOLEAN load_modules(const char *newlib, char *fullname, BOOLEAN autoexport)
Definition: iplib.cc:1108
void Werror(const char *fmt,...)
Definition: reporter.cc:189

◆ jjLOAD_TRY()

BOOLEAN jjLOAD_TRY ( const char *  s)

Definition at line 5223 of file iparith.cc.

5224 {
5225  void (*WerrorS_save)(const char *s) = WerrorS_callback;
5228  BOOLEAN bo=jjLOAD(s,TRUE);
5229  if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
5230  Print("loading of >%s< failed\n",s);
5231  WerrorS_callback=WerrorS_save;
5232  errorreported=0;
5233  return FALSE;
5234 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define Print
Definition: emacs.cc:83
#define TEST_OPT_PROT
Definition: options.h:98
static int WerrorS_dummy_cnt
Definition: iparith.cc:5218
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
BOOLEAN jjLOAD(const char *s, BOOLEAN autoexport)
load lib/module given in v
Definition: iparith.cc:5157
static void WerrorS_dummy(const char *)
Definition: iparith.cc:5219
void(* WerrorS_callback)(const char *s)
Definition: feFopen.cc:21
short errorreported
Definition: feFopen.cc:23
int BOOLEAN
Definition: auxiliary.h:85

◆ 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
poly res
Definition: myNF.cc:322
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
static resolvente iiCopyRes(resolvente r, int l)
Definition: ipshell.cc:855
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:137
#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
ideal * resolvente
Definition: ideals.h:18

◆ jjRESULTANT()

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

Definition at line 3266 of file ipshell.cc.

3267 {
3268  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3269  (poly)w->CopyD(), currRing);
3270  return errorreported;
3271 }
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition: clapsing.cc:304
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
short errorreported
Definition: feFopen.cc:23
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
const CanonicalForm & w
Definition: facAbsFact.cc:55
polyrec * poly
Definition: hilb.h:10
void * CopyD(int t)
Definition: subexpr.cc:707

◆ jjSYSTEM()

BOOLEAN jjSYSTEM ( leftv  res,
leftv  v 
)

Definition at line 244 of file extra.cc.

245 {
246  if(args->Typ() == STRING_CMD)
247  {
248  const char *sys_cmd=(char *)(args->Data());
249  leftv h=args->next;
250 // ONLY documented system calls go here
251 // Undocumented system calls go down into jjEXTENDED_SYSTEM (#ifdef HAVE_EXTENDED_SYSTEM)
252 /*==================== nblocks ==================================*/
253  if (strcmp(sys_cmd, "nblocks") == 0)
254  {
255  ring r;
256  if (h == NULL)
257  {
258  if (currRingHdl != NULL)
259  {
260  r = IDRING(currRingHdl);
261  }
262  else
263  {
264  WerrorS("no ring active");
265  return TRUE;
266  }
267  }
268  else
269  {
270  if (h->Typ() != RING_CMD)
271  {
272  WerrorS("ring expected");
273  return TRUE;
274  }
275  r = (ring) h->Data();
276  }
277  res->rtyp = INT_CMD;
278  res->data = (void*) (long)(rBlocks(r) - 1);
279  return FALSE;
280  }
281 /*==================== version ==================================*/
282  if(strcmp(sys_cmd,"version")==0)
283  {
284  res->rtyp=INT_CMD;
285  res->data=(void *)SINGULAR_VERSION;
286  return FALSE;
287  }
288  else
289 /*==================== alarm ==================================*/
290  #ifdef unix
291  if(strcmp(sys_cmd,"alarm")==0)
292  {
293  if ((h!=NULL) &&(h->Typ()==INT_CMD))
294  {
295  // standard variant -> SIGALARM (standard: abort)
296  //alarm((unsigned)h->next->Data());
297  // process time (user +system): SIGVTALARM
298  struct itimerval t,o;
299  memset(&t,0,sizeof(t));
300  t.it_value.tv_sec =(unsigned)((unsigned long)h->Data());
301  setitimer(ITIMER_VIRTUAL,&t,&o);
302  return FALSE;
303  }
304  else
305  WerrorS("int expected");
306  }
307  else
308  #endif
309 /*==================== cpu ==================================*/
310  if(strcmp(sys_cmd,"cpu")==0)
311  {
312  long cpu=1; //feOptValue(FE_OPT_CPUS);
313  #ifdef _SC_NPROCESSORS_ONLN
314  cpu=sysconf(_SC_NPROCESSORS_ONLN);
315  #elif defined(_SC_NPROCESSORS_CONF)
316  cpu=sysconf(_SC_NPROCESSORS_CONF);
317  #endif
318  res->data=(void *)cpu;
319  res->rtyp=INT_CMD;
320  return FALSE;
321  }
322  else
323 /*==================== executable ==================================*/
324  if(strcmp(sys_cmd,"executable")==0)
325  {
326  if ((h!=NULL) && (h->Typ()==STRING_CMD))
327  {
328  char tbuf[MAXPATHLEN];
329  char *s=omFindExec((char*)h->Data(),tbuf);
330  if(s==NULL) s=(char*)"";
331  res->data=(void *)omStrDup(s);
332  res->rtyp=STRING_CMD;
333  return FALSE;
334  }
335  return TRUE;
336  }
337  else
338  /*==================== neworder =============================*/
339  if(strcmp(sys_cmd,"neworder")==0)
340  {
341  if ((h!=NULL) &&(h->Typ()==IDEAL_CMD))
342  {
343  res->rtyp=STRING_CMD;
344  res->data=(void *)singclap_neworder((ideal)h->Data(), currRing);
345  return FALSE;
346  }
347  else
348  WerrorS("ideal expected");
349  }
350  else
351 /*===== nc_hilb ===============================================*/
352  // Hilbert series of non-commutative monomial algebras
353  if(strcmp(sys_cmd,"nc_hilb") == 0)
354  {
355  ideal i; int lV;
356  bool ig = FALSE;
357  bool mgrad = FALSE;
358  bool autop = FALSE;
359  if((h != NULL)&&(h->Typ() == IDEAL_CMD))
360  i = (ideal)h->Data();
361  else
362  {
363  WerrorS("nc_Hilb:ideal expected");
364  return TRUE;
365  }
366  h = h->next;
367  if((h != NULL)&&(h->Typ() == INT_CMD))
368  lV = (int)(long)h->Data();
369  else
370  {
371  WerrorS("nc_Hilb:int expected");
372  return TRUE;
373  }
374  h = h->next;
375  while((h != NULL)&&(h->Typ() == INT_CMD))
376  {
377  if((int)(long)h->Data() == 1)
378  ig = TRUE;
379  else if((int)(long)h->Data() == 2)
380  mgrad = TRUE;
381  else if((int)(long)h->Data() == 3)
382  autop = TRUE;
383  h = h->next;
384  }
385  if(h != NULL)
386  {
387  WerrorS("nc_Hilb:int 1,2 or 3 are expected");
388  return TRUE;
389  }
390  HilbertSeries_OrbitData(i, lV, ig, mgrad, autop);
391  return(FALSE);
392  }
393  else
394 /*==================== sh ==================================*/
395  if(strcmp(sys_cmd,"sh")==0)
396  {
397  if (feOptValue(FE_OPT_NO_SHELL))
398  {
399  WerrorS("shell execution is disallowed in restricted mode");
400  return TRUE;
401  }
402  res->rtyp=INT_CMD;
403  if (h==NULL) res->data = (void *)(long) system("sh");
404  else if (h->Typ()==STRING_CMD)
405  res->data = (void*)(long) system((char*)(h->Data()));
406  else
407  WerrorS("string expected");
408  return FALSE;
409  }
410  else
411 /*========reduce procedure like the global one but with jet bounds=======*/
412  if(strcmp(sys_cmd,"reduce_bound")==0)
413  {
414  poly p;
415  ideal pid=NULL;
416  const short t1[]={3,POLY_CMD,IDEAL_CMD,INT_CMD};
417  const short t2[]={3,IDEAL_CMD,IDEAL_CMD,INT_CMD};
418  const short t3[]={3,VECTOR_CMD,MODUL_CMD,INT_CMD};
419  const short t4[]={3,MODUL_CMD,MODUL_CMD,INT_CMD};
420  if ((iiCheckTypes(h,t1,0))||((iiCheckTypes(h,t3,0))))
421  {
422  p = (poly)h->CopyD();
423  }
424  else if ((iiCheckTypes(h,t2,0))||(iiCheckTypes(h,t4,1)))
425  {
426  pid = (ideal)h->CopyD();
427  }
428  else return TRUE;
429  //int htype;
430  res->rtyp= h->Typ(); /*htype*/
431  ideal q = (ideal)h->next->CopyD();
432  int bound = (int)(long)h->next->next->Data();
433  if (pid==NULL) /*(htype == POLY_CMD || htype == VECTOR_CMD)*/
434  res->data = (char *)kNFBound(q,currRing->qideal,p,bound);
435  else /*(htype == IDEAL_CMD || htype == MODUL_CMD)*/
436  res->data = (char *)kNFBound(q,currRing->qideal,pid,bound);
437  return FALSE;
438  }
439  else
440 /*==================== uname ==================================*/
441  if(strcmp(sys_cmd,"uname")==0)
442  {
443  res->rtyp=STRING_CMD;
444  res->data = omStrDup(S_UNAME);
445  return FALSE;
446  }
447  else
448 /*==================== with ==================================*/
449  if(strcmp(sys_cmd,"with")==0)
450  {
451  if (h==NULL)
452  {
453  res->rtyp=STRING_CMD;
454  res->data=(void *)versionString();
455  return FALSE;
456  }
457  else if (h->Typ()==STRING_CMD)
458  {
459  #define TEST_FOR(A) if(strcmp(s,A)==0) res->data=(void *)1; else
460  char *s=(char *)h->Data();
461  res->rtyp=INT_CMD;
462  #ifdef HAVE_DBM
463  TEST_FOR("DBM")
464  #endif
465  #ifdef HAVE_DLD
466  TEST_FOR("DLD")
467  #endif
468  //TEST_FOR("factory")
469  //TEST_FOR("libfac")
470  #ifdef HAVE_READLINE
471  TEST_FOR("readline")
472  #endif
473  #ifdef TEST_MAC_ORDER
474  TEST_FOR("MAC_ORDER")
475  #endif
476  // unconditional since 3-1-0-6
477  TEST_FOR("Namespaces")
478  #ifdef HAVE_DYNAMIC_LOADING
479  TEST_FOR("DynamicLoading")
480  #endif
481  #ifdef HAVE_EIGENVAL
482  TEST_FOR("eigenval")
483  #endif
484  #ifdef HAVE_GMS
485  TEST_FOR("gms")
486  #endif
487  #ifdef OM_NDEBUG
488  TEST_FOR("om_ndebug")
489  #endif
490  #ifdef SING_NDEBUG
491  TEST_FOR("ndebug")
492  #endif
493  {};
494  return FALSE;
495  #undef TEST_FOR
496  }
497  return TRUE;
498  }
499  else
500  /*==================== browsers ==================================*/
501  if (strcmp(sys_cmd,"browsers")==0)
502  {
503  res->rtyp = STRING_CMD;
504  StringSetS("");
506  res->data = StringEndS();
507  return FALSE;
508  }
509  else
510  /*==================== pid ==================================*/
511  if (strcmp(sys_cmd,"pid")==0)
512  {
513  res->rtyp=INT_CMD;
514  res->data=(void *)(long) getpid();
515  return FALSE;
516  }
517  else
518  /*==================== getenv ==================================*/
519  if (strcmp(sys_cmd,"getenv")==0)
520  {
521  if ((h!=NULL) && (h->Typ()==STRING_CMD))
522  {
523  res->rtyp=STRING_CMD;
524  const char *r=getenv((char *)h->Data());
525  if (r==NULL) r="";
526  res->data=(void *)omStrDup(r);
527  return FALSE;
528  }
529  else
530  {
531  WerrorS("string expected");
532  return TRUE;
533  }
534  }
535  else
536  /*==================== setenv ==================================*/
537  if (strcmp(sys_cmd,"setenv")==0)
538  {
539  #ifdef HAVE_SETENV
540  const short t[]={2,STRING_CMD,STRING_CMD};
541  if (iiCheckTypes(h,t,1))
542  {
543  res->rtyp=STRING_CMD;
544  setenv((char *)h->Data(), (char *)h->next->Data(), 1);
545  res->data=(void *)omStrDup((char *)h->next->Data());
547  return FALSE;
548  }
549  else
550  {
551  return TRUE;
552  }
553  #else
554  WerrorS("setenv not supported on this platform");
555  return TRUE;
556  #endif
557  }
558  else
559  /*==================== Singular ==================================*/
560  if (strcmp(sys_cmd, "Singular") == 0)
561  {
562  res->rtyp=STRING_CMD;
563  const char *r=feResource("Singular");
564  if (r == NULL) r="";
565  res->data = (void*) omStrDup( r );
566  return FALSE;
567  }
568  else
569  if (strcmp(sys_cmd, "SingularLib") == 0)
570  {
571  res->rtyp=STRING_CMD;
572  const char *r=feResource("SearchPath");
573  if (r == NULL) r="";
574  res->data = (void*) omStrDup( r );
575  return FALSE;
576  }
577  else
578  /*==================== options ==================================*/
579  if (strstr(sys_cmd, "--") == sys_cmd)
580  {
581  if (strcmp(sys_cmd, "--") == 0)
582  {
584  return FALSE;
585  }
586  feOptIndex opt = feGetOptIndex(&sys_cmd[2]);
587  if (opt == FE_OPT_UNDEF)
588  {
589  Werror("Unknown option %s", sys_cmd);
590  WerrorS("Use 'system(\"--\");' for listing of available options");
591  return TRUE;
592  }
593  // for Untyped Options (help version),
594  // setting it just triggers action
595  if (feOptSpec[opt].type == feOptUntyped)
596  {
597  feSetOptValue(opt,0);
598  return FALSE;
599  }
600  if (h == NULL)
601  {
602  if (feOptSpec[opt].type == feOptString)
603  {
604  res->rtyp = STRING_CMD;
605  const char *r=(const char*)feOptSpec[opt].value;
606  if (r == NULL) r="";
607  res->data = omStrDup(r);
608  }
609  else
610  {
611  res->rtyp = INT_CMD;
612  res->data = feOptSpec[opt].value;
613  }
614  return FALSE;
615  }
616  if (h->Typ() != STRING_CMD &&
617  h->Typ() != INT_CMD)
618  {
619  WerrorS("Need string or int argument to set option value");
620  return TRUE;
621  }
622  const char* errormsg;
623  if (h->Typ() == INT_CMD)
624  {
625  if (feOptSpec[opt].type == feOptString)
626  {
627  Werror("Need string argument to set value of option %s", sys_cmd);
628  return TRUE;
629  }
630  errormsg = feSetOptValue(opt, (int)((long) h->Data()));
631  if (errormsg != NULL)
632  Werror("Option '--%s=%d' %s", sys_cmd, (int) ((long)h->Data()), errormsg);
633  }
634  else
635  {
636  errormsg = feSetOptValue(opt, (char*) h->Data());
637  if (errormsg != NULL)
638  Werror("Option '--%s=%s' %s", sys_cmd, (char*) h->Data(), errormsg);
639  }
640  if (errormsg != NULL) return TRUE;
641  return FALSE;
642  }
643  else
644  /*==================== HC ==================================*/
645  if (strcmp(sys_cmd,"HC")==0)
646  {
647  res->rtyp=INT_CMD;
648  res->data=(void *)(long) HCord;
649  return FALSE;
650  }
651  else
652  /*==================== random ==================================*/
653  if(strcmp(sys_cmd,"random")==0)
654  {
655  const short t[]={1,INT_CMD};
656  if (h!=NULL)
657  {
658  if (iiCheckTypes(h,t,1))
659  {
660  siRandomStart=(int)((long)h->Data());
663  return FALSE;
664  }
665  else
666  {
667  return TRUE;
668  }
669  }
670  res->rtyp=INT_CMD;
671  res->data=(void*)(long) siSeed;
672  return FALSE;
673  }
674  else
675  /*==================== std_syz =================*/
676  if (strcmp(sys_cmd, "std_syz") == 0)
677  {
678  ideal i1;
679  int i2;
680  if ((h!=NULL) && (h->Typ()==MODUL_CMD))
681  {
682  i1=(ideal)h->CopyD();
683  h=h->next;
684  }
685  else return TRUE;
686  if ((h!=NULL) && (h->Typ()==INT_CMD))
687  {
688  i2=(int)((long)h->Data());
689  }
690  else return TRUE;
691  res->rtyp=MODUL_CMD;
692  res->data=idXXX(i1,i2);
693  return FALSE;
694  }
695  else
696  /*======================= demon_list =====================*/
697  if (strcmp(sys_cmd,"denom_list")==0)
698  {
699  res->rtyp=LIST_CMD;
700  extern lists get_denom_list();
701  res->data=(lists)get_denom_list();
702  return FALSE;
703  }
704  else
705  /*==================== complexNearZero ======================*/
706  if(strcmp(sys_cmd,"complexNearZero")==0)
707  {
708  const short t[]={2,NUMBER_CMD,INT_CMD};
709  if (iiCheckTypes(h,t,1))
710  {
711  if ( !rField_is_long_C(currRing) )
712  {
713  WerrorS( "unsupported ground field!");
714  return TRUE;
715  }
716  else
717  {
718  res->rtyp=INT_CMD;
719  res->data=(void*)complexNearZero((gmp_complex*)h->Data(),
720  (int)((long)(h->next->Data())));
721  return FALSE;
722  }
723  }
724  else
725  {
726  return TRUE;
727  }
728  }
729  else
730  /*==================== getPrecDigits ======================*/
731  if(strcmp(sys_cmd,"getPrecDigits")==0)
732  {
733  if ( (currRing==NULL)
735  {
736  WerrorS( "unsupported ground field!");
737  return TRUE;
738  }
739  res->rtyp=INT_CMD;
740  res->data=(void*)(long)gmp_output_digits;
741  //if (gmp_output_digits!=getGMPFloatDigits())
742  //{ Print("%d, %d\n",getGMPFloatDigits(),gmp_output_digits);}
743  return FALSE;
744  }
745  else
746  /*==================== lduDecomp ======================*/
747  if(strcmp(sys_cmd, "lduDecomp")==0)
748  {
749  const short t[]={1,MATRIX_CMD};
750  if (iiCheckTypes(h,t,1))
751  {
752  matrix aMat = (matrix)h->Data();
753  matrix pMat; matrix lMat; matrix dMat; matrix uMat;
754  poly l; poly u; poly prodLU;
755  lduDecomp(aMat, pMat, lMat, dMat, uMat, l, u, prodLU);
757  L->Init(7);
758  L->m[0].rtyp = MATRIX_CMD; L->m[0].data=(void*)pMat;
759  L->m[1].rtyp = MATRIX_CMD; L->m[1].data=(void*)lMat;
760  L->m[2].rtyp = MATRIX_CMD; L->m[2].data=(void*)dMat;
761  L->m[3].rtyp = MATRIX_CMD; L->m[3].data=(void*)uMat;
762  L->m[4].rtyp = POLY_CMD; L->m[4].data=(void*)l;
763  L->m[5].rtyp = POLY_CMD; L->m[5].data=(void*)u;
764  L->m[6].rtyp = POLY_CMD; L->m[6].data=(void*)prodLU;
765  res->rtyp = LIST_CMD;
766  res->data = (char *)L;
767  return FALSE;
768  }
769  else
770  {
771  return TRUE;
772  }
773  }
774  else
775  /*==================== lduSolve ======================*/
776  if(strcmp(sys_cmd, "lduSolve")==0)
777  {
778  /* for solving a linear equation system A * x = b, via the
779  given LDU-decomposition of the matrix A;
780  There is one valid parametrisation:
781  1) exactly eight arguments P, L, D, U, l, u, lTimesU, b;
782  P, L, D, and U realise the LDU-decomposition of A, that is,
783  P * A = L * D^(-1) * U, and P, L, D, and U satisfy the
784  properties decribed in method 'luSolveViaLDUDecomp' in
785  linearAlgebra.h; see there;
786  l, u, and lTimesU are as described in the same location;
787  b is the right-hand side vector of the linear equation system;
788  The method will return a list of either 1 entry or three entries:
789  1) [0] if there is no solution to the system;
790  2) [1, x, H] if there is at least one solution;
791  x is any solution of the given linear system,
792  H is the matrix with column vectors spanning the homogeneous
793  solution space.
794  The method produces an error if matrix and vector sizes do not
795  fit. */
797  if (!iiCheckTypes(h,t,1))
798  {
799  return TRUE;
800  }
802  {
803  WerrorS("field required");
804  return TRUE;
805  }
806  matrix pMat = (matrix)h->Data();
807  matrix lMat = (matrix)h->next->Data();
808  matrix dMat = (matrix)h->next->next->Data();
809  matrix uMat = (matrix)h->next->next->next->Data();
810  poly l = (poly) h->next->next->next->next->Data();
811  poly u = (poly) h->next->next->next->next->next->Data();
812  poly lTimesU = (poly) h->next->next->next->next->next->next->Data();
813  matrix bVec = (matrix)h->next->next->next->next->next->next->next->Data();
814  matrix xVec; int solvable; matrix homogSolSpace;
815  if (pMat->rows() != pMat->cols())
816  {
817  Werror("first matrix (%d x %d) is not quadratic",
818  pMat->rows(), pMat->cols());
819  return TRUE;
820  }
821  if (lMat->rows() != lMat->cols())
822  {
823  Werror("second matrix (%d x %d) is not quadratic",
824  lMat->rows(), lMat->cols());
825  return TRUE;
826  }
827  if (dMat->rows() != dMat->cols())
828  {
829  Werror("third matrix (%d x %d) is not quadratic",
830  dMat->rows(), dMat->cols());
831  return TRUE;
832  }
833  if (dMat->cols() != uMat->rows())
834  {
835  Werror("third matrix (%d x %d) and fourth matrix (%d x %d) %s",
836  dMat->rows(), dMat->cols(), uMat->rows(), uMat->cols(),
837  "do not t");
838  return TRUE;
839  }
840  if (uMat->rows() != bVec->rows())
841  {
842  Werror("fourth matrix (%d x %d) and vector (%d x 1) do not fit",
843  uMat->rows(), uMat->cols(), bVec->rows());
844  return TRUE;
845  }
846  solvable = luSolveViaLDUDecomp(pMat, lMat, dMat, uMat, l, u, lTimesU,
847  bVec, xVec, homogSolSpace);
848 
849  /* build the return structure; a list with either one or
850  three entries */
852  if (solvable)
853  {
854  ll->Init(3);
855  ll->m[0].rtyp=INT_CMD; ll->m[0].data=(void *)(long)solvable;
856  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
857  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
858  }
859  else
860  {
861  ll->Init(1);
862  ll->m[0].rtyp=INT_CMD; ll->m[0].data=(void *)(long)solvable;
863  }
864  res->rtyp = LIST_CMD;
865  res->data=(char*)ll;
866  return FALSE;
867  }
868  else
869  /*==== countedref: reference and shared ====*/
870  if (strcmp(sys_cmd, "shared") == 0)
871  {
872  #ifndef SI_COUNTEDREF_AUTOLOAD
873  void countedref_shared_load();
875  #endif
876  res->rtyp = NONE;
877  return FALSE;
878  }
879  else if (strcmp(sys_cmd, "reference") == 0)
880  {
881  #ifndef SI_COUNTEDREF_AUTOLOAD
884  #endif
885  res->rtyp = NONE;
886  return FALSE;
887  }
888  else
889 /*==================== semaphore =================*/
890 #ifdef HAVE_SIMPLEIPC
891  if (strcmp(sys_cmd,"semaphore")==0)
892  {
893  if((h!=NULL) && (h->Typ()==STRING_CMD) && (h->next!=NULL) && (h->next->Typ()==INT_CMD))
894  {
895  int v=1;
896  if ((h->next->next!=NULL)&& (h->next->next->Typ()==INT_CMD))
897  v=(int)(long)h->next->next->Data();
898  res->data=(char *)(long)simpleipc_cmd((char *)h->Data(),(int)(long)h->next->Data(),v);
899  res->rtyp=INT_CMD;
900  return FALSE;
901  }
902  else
903  {
904  WerrorS("Usage: system(\"semaphore\",<cmd>,int)");
905  return TRUE;
906  }
907  }
908  else
909 #endif
910 /*==================== reserved port =================*/
911  if (strcmp(sys_cmd,"reserve")==0)
912  {
913  int ssiReservePort(int clients);
914  const short t[]={1,INT_CMD};
915  if (iiCheckTypes(h,t,1))
916  {
917  res->rtyp=INT_CMD;
918  int p=ssiReservePort((int)(long)h->Data());
919  res->data=(void*)(long)p;
920  return (p==0);
921  }
922  return TRUE;
923  }
924  else
925 /*==================== reserved link =================*/
926  if (strcmp(sys_cmd,"reservedLink")==0)
927  {
928  res->rtyp=LINK_CMD;
930  res->data=(void*)p;
931  return (p==NULL);
932  }
933  else
934 /*==================== install newstruct =================*/
935  if (strcmp(sys_cmd,"install")==0)
936  {
937  const short t[]={4,STRING_CMD,STRING_CMD,PROC_CMD,INT_CMD};
938  if (iiCheckTypes(h,t,1))
939  {
940  return newstruct_set_proc((char*)h->Data(),(char*)h->next->Data(),
941  (int)(long)h->next->next->next->Data(),
942  (procinfov)h->next->next->Data());
943  }
944  return TRUE;
945  }
946  else
947 /*==================== newstruct =================*/
948  if (strcmp(sys_cmd,"newstruct")==0)
949  {
950  const short t[]={1,STRING_CMD};
951  if (iiCheckTypes(h,t,1))
952  {
953  int id=0;
954  char *n=(char*)h->Data();
955  blackboxIsCmd(n,id);
956  if (id>0)
957  {
958  blackbox *bb=getBlackboxStuff(id);
959  if (BB_LIKE_LIST(bb))
960  {
961  newstruct_desc desc=(newstruct_desc)bb->data;
962  newstructShow(desc);
963  return FALSE;
964  }
965  else Werror("'%s' is not a newstruct",n);
966  }
967  else Werror("'%s' is not a blackbox object",n);
968  }
969  return TRUE;
970  }
971  else
972 /*==================== blackbox =================*/
973  if (strcmp(sys_cmd,"blackbox")==0)
974  {
976  return FALSE;
977  }
978  else
979  /*================= absBiFact ======================*/
980  #ifdef HAVE_NTL
981  if (strcmp(sys_cmd, "absFact") == 0)
982  {
983  const short t[]={1,POLY_CMD};
984  if (iiCheckTypes(h,t,1)
985  && (currRing!=NULL)
986  && (getCoeffType(currRing->cf)==n_transExt))
987  {
988  res->rtyp=LIST_CMD;
989  intvec *v=NULL;
990  ideal mipos= NULL;
991  int n= 0;
992  ideal f=singclap_absFactorize((poly)(h->Data()), mipos, &v, n, currRing);
993  if (f==NULL) return TRUE;
994  ivTest(v);
996  l->Init(4);
997  l->m[0].rtyp=IDEAL_CMD;
998  l->m[0].data=(void *)f;
999  l->m[1].rtyp=INTVEC_CMD;
1000  l->m[1].data=(void *)v;
1001  l->m[2].rtyp=IDEAL_CMD;
1002  l->m[2].data=(void*) mipos;
1003  l->m[3].rtyp=INT_CMD;
1004  l->m[3].data=(void*) (long) n;
1005  res->data=(void *)l;
1006  return FALSE;
1007  }
1008  else return TRUE;
1009  }
1010  else
1011  #endif
1012  /* =================== LLL via NTL ==============================*/
1013  #ifdef HAVE_NTL
1014  if (strcmp(sys_cmd, "LLL") == 0)
1015  {
1016  if (h!=NULL)
1017  {
1018  res->rtyp=h->Typ();
1019  if (h->Typ()==MATRIX_CMD)
1020  {
1021  res->data=(char *)singntl_LLL((matrix)h->Data(), currRing);
1022  return FALSE;
1023  }
1024  else if (h->Typ()==INTMAT_CMD)
1025  {
1026  res->data=(char *)singntl_LLL((intvec*)h->Data());
1027  return FALSE;
1028  }
1029  else return TRUE;
1030  }
1031  else return TRUE;
1032  }
1033  else
1034  #endif
1035  /* =================== LLL via Flint ==============================*/
1036  #ifdef HAVE_FLINT
1037  #if __FLINT_RELEASE >= 20500
1038  if (strcmp(sys_cmd, "LLL_Flint") == 0)
1039  {
1040  if (h!=NULL)
1041  {
1042  if(h->next == NULL)
1043  {
1044  res->rtyp=h->Typ();
1045  if (h->Typ()==BIGINTMAT_CMD)
1046  {
1047  res->data=(char *)singflint_LLL((bigintmat*)h->Data(), NULL);
1048  return FALSE;
1049  }
1050  else if (h->Typ()==INTMAT_CMD)
1051  {
1052  res->data=(char *)singflint_LLL((intvec*)h->Data(), NULL);
1053  return FALSE;
1054  }
1055  else return TRUE;
1056  }
1057  if(h->next->Typ()!= INT_CMD)
1058  {
1059  WerrorS("matrix,int or bigint,int expected");
1060  return TRUE;
1061  }
1062  if(h->next->Typ()== INT_CMD)
1063  {
1064  if(((int)((long)(h->next->Data())) != 0) && (int)((long)(h->next->Data()) != 1))
1065  {
1066  WerrorS("int is different from 0, 1");
1067  return TRUE;
1068  }
1069  res->rtyp=h->Typ();
1070  if((long)(h->next->Data()) == 0)
1071  {
1072  if (h->Typ()==BIGINTMAT_CMD)
1073  {
1074  res->data=(char *)singflint_LLL((bigintmat*)h->Data(), NULL);
1075  return FALSE;
1076  }
1077  else if (h->Typ()==INTMAT_CMD)
1078  {
1079  res->data=(char *)singflint_LLL((intvec*)h->Data(), NULL);
1080  return FALSE;
1081  }
1082  else return TRUE;
1083  }
1084  // This will give also the transformation matrix U s.t. res = U * m
1085  if((long)(h->next->Data()) == 1)
1086  {
1087  if (h->Typ()==BIGINTMAT_CMD)
1088  {
1089  bigintmat* m = (bigintmat*)h->Data();
1090  bigintmat* T = new bigintmat(m->rows(),m->rows(),m->basecoeffs());
1091  for(int i = 1; i<=m->rows(); i++)
1092  {
1093  n_Delete(&(BIMATELEM(*T,i,i)),T->basecoeffs());
1094  BIMATELEM(*T,i,i)=n_Init(1, T->basecoeffs());
1095  }
1096  m = singflint_LLL(m,T);
1098  L->Init(2);
1099  L->m[0].rtyp = BIGINTMAT_CMD; L->m[0].data = (void*)m;
1100  L->m[1].rtyp = BIGINTMAT_CMD; L->m[1].data = (void*)T;
1101  res->data=L;
1102  res->rtyp=LIST_CMD;
1103  return FALSE;
1104  }
1105  else if (h->Typ()==INTMAT_CMD)
1106  {
1107  intvec* m = (intvec*)h->Data();
1108  intvec* T = new intvec(m->rows(),m->rows(),(int)0);
1109  for(int i = 1; i<=m->rows(); i++)
1110  IMATELEM(*T,i,i)=1;
1111  m = singflint_LLL(m,T);
1113  L->Init(2);
1114  L->m[0].rtyp = INTMAT_CMD; L->m[0].data = (void*)m;
1115  L->m[1].rtyp = INTMAT_CMD; L->m[1].data = (void*)T;
1116  res->data=L;
1117  res->rtyp=LIST_CMD;
1118  return FALSE;
1119  }
1120  else return TRUE;
1121  }
1122  }
1123 
1124  }
1125  else return TRUE;
1126  }
1127  else
1128  #endif
1129  #endif
1130  /*==================== shift-test for freeGB =================*/
1131  #ifdef HAVE_SHIFTBBA
1132  if (strcmp(sys_cmd, "stest") == 0)
1133  {
1134  const short t[]={4,POLY_CMD,INT_CMD,INT_CMD,INT_CMD};
1135  if (iiCheckTypes(h,t,1))
1136  {
1137  poly p=(poly)h->CopyD();
1138  h=h->next;
1139  int sh=(int)((long)(h->Data()));
1140  h=h->next;
1141  int uptodeg=(int)((long)(h->Data()));
1142  h=h->next;
1143  int lVblock=(int)((long)(h->Data()));
1144  if (sh<0)
1145  {
1146  WerrorS("negative shift for pLPshift");
1147  return TRUE;
1148  }
1149  int L = pmLastVblock(p,lVblock);
1150  if (L+sh-1 > uptodeg)
1151  {
1152  WerrorS("pLPshift: too big shift requested\n");
1153  return TRUE;
1154  }
1155  res->data = pLPshift(p,sh,uptodeg,lVblock);
1156  res->rtyp = POLY_CMD;
1157  return FALSE;
1158  }
1159  else return TRUE;
1160  }
1161  else
1162  #endif
1163  /*==================== block-test for freeGB =================*/
1164  #ifdef HAVE_SHIFTBBA
1165  if (strcmp(sys_cmd, "btest") == 0)
1166  {
1167  const short t[]={2,POLY_CMD,INT_CMD};
1168  if (iiCheckTypes(h,t,1))
1169  {
1170  poly p=(poly)h->CopyD();
1171  h=h->next;
1172  int lV=(int)((long)(h->Data()));
1173  res->rtyp = INT_CMD;
1174  res->data = (void*)(long)pLastVblock(p, lV);
1175  return FALSE;
1176  }
1177  else return TRUE;
1178  }
1179  else
1180  #endif
1181  /*==================== shrink-test for freeGB =================*/
1182  #ifdef HAVE_SHIFTBBA
1183  if (strcmp(sys_cmd, "shrinktest") == 0)
1184  {
1185  const short t[]={2,POLY_CMD,INT_CMD};
1186  if (iiCheckTypes(h,t,1))
1187  {
1188  poly p=(poly)h->Data();
1189  h=h->next;
1190  int lV=(int)((long)(h->Data()));
1191  res->rtyp = POLY_CMD;
1192  // res->data = p_mShrink(p, lV, currRing);
1193  // kStrategy strat=new skStrategy;
1194  // strat->tailRing = currRing;
1195  res->data = p_Shrink(p, lV, currRing);
1196  return FALSE;
1197  }
1198  else return TRUE;
1199  }
1200  else
1201  #endif
1202  /*==================== pcv ==================================*/
1203  #ifdef HAVE_PCV
1204  if(strcmp(sys_cmd,"pcvLAddL")==0)
1205  {
1206  return pcvLAddL(res,h);
1207  }
1208  else
1209  if(strcmp(sys_cmd,"pcvPMulL")==0)
1210  {
1211  return pcvPMulL(res,h);
1212  }
1213  else
1214  if(strcmp(sys_cmd,"pcvMinDeg")==0)
1215  {
1216  return pcvMinDeg(res,h);
1217  }
1218  else
1219  if(strcmp(sys_cmd,"pcvP2CV")==0)
1220  {
1221  return pcvP2CV(res,h);
1222  }
1223  else
1224  if(strcmp(sys_cmd,"pcvCV2P")==0)
1225  {
1226  return pcvCV2P(res,h);
1227  }
1228  else
1229  if(strcmp(sys_cmd,"pcvDim")==0)
1230  {
1231  return pcvDim(res,h);
1232  }
1233  else
1234  if(strcmp(sys_cmd,"pcvBasis")==0)
1235  {
1236  return pcvBasis(res,h);
1237  }
1238  else
1239  #endif
1240  /*==================== hessenberg/eigenvalues ==================================*/
1241  #ifdef HAVE_EIGENVAL
1242  if(strcmp(sys_cmd,"hessenberg")==0)
1243  {
1244  return evHessenberg(res,h);
1245  }
1246  else
1247  #endif
1248  /*==================== eigenvalues ==================================*/
1249  #ifdef HAVE_EIGENVAL
1250  if(strcmp(sys_cmd,"eigenvals")==0)
1251  {
1252  return evEigenvals(res,h);
1253  }
1254  else
1255  #endif
1256  /*==================== rowelim ==================================*/
1257  #ifdef HAVE_EIGENVAL
1258  if(strcmp(sys_cmd,"rowelim")==0)
1259  {
1260  return evRowElim(res,h);
1261  }
1262  else
1263  #endif
1264  /*==================== rowcolswap ==================================*/
1265  #ifdef HAVE_EIGENVAL
1266  if(strcmp(sys_cmd,"rowcolswap")==0)
1267  {
1268  return evSwap(res,h);
1269  }
1270  else
1271  #endif
1272  /*==================== Gauss-Manin system ==================================*/
1273  #ifdef HAVE_GMS
1274  if(strcmp(sys_cmd,"gmsnf")==0)
1275  {
1276  return gmsNF(res,h);
1277  }
1278  else
1279  #endif
1280  /*==================== contributors =============================*/
1281  if(strcmp(sys_cmd,"contributors") == 0)
1282  {
1283  res->rtyp=STRING_CMD;
1284  res->data=(void *)omStrDup(
1285  "Olaf Bachmann, Michael Brickenstein, Hubert Grassmann, Kai Krueger, Victor Levandovskyy, Wolfgang Neumann, Thomas Nuessler, Wilfred Pohl, Jens Schmidt, Mathias Schulze, Thomas Siebert, Ruediger Stobbe, Moritz Wenk, Tim Wichmann");
1286  return FALSE;
1287  }
1288  else
1289  /*==================== spectrum =============================*/
1290  #ifdef HAVE_SPECTRUM
1291  if(strcmp(sys_cmd,"spectrum") == 0)
1292  {
1293  if ((h==NULL) || (h->Typ()!=POLY_CMD))
1294  {
1295  WerrorS("poly expected");
1296  return TRUE;
1297  }
1298  if (h->next==NULL)
1299  return spectrumProc(res,h);
1300  if (h->next->Typ()!=INT_CMD)
1301  {
1302  WerrorS("poly,int expected");
1303  return TRUE;
1304  }
1305  if(((long)h->next->Data())==1L)
1306  return spectrumfProc(res,h);
1307  return spectrumProc(res,h);
1308  }
1309  else
1310  /*==================== semic =============================*/
1311  if(strcmp(sys_cmd,"semic") == 0)
1312  {
1313  if ((h->next!=NULL)
1314  && (h->Typ()==LIST_CMD)
1315  && (h->next->Typ()==LIST_CMD))
1316  {
1317  if (h->next->next==NULL)
1318  return semicProc(res,h,h->next);
1319  else if (h->next->next->Typ()==INT_CMD)
1320  return semicProc3(res,h,h->next,h->next->next);
1321  }
1322  return TRUE;
1323  }
1324  else
1325  /*==================== spadd =============================*/
1326  if(strcmp(sys_cmd,"spadd") == 0)
1327  {
1328  const short t[]={2,LIST_CMD,LIST_CMD};
1329  if (iiCheckTypes(h,t,1))
1330  {
1331  return spaddProc(res,h,h->next);
1332  }
1333  return TRUE;
1334  }
1335  else
1336  /*==================== spmul =============================*/
1337  if(strcmp(sys_cmd,"spmul") == 0)
1338  {
1339  const short t[]={2,LIST_CMD,INT_CMD};
1340  if (iiCheckTypes(h,t,1))
1341  {
1342  return spmulProc(res,h,h->next);
1343  }
1344  return TRUE;
1345  }
1346  else
1347  #endif
1348 /*==================== tensorModuleMult ========================= */
1349  #define HAVE_SHEAFCOH_TRICKS 1
1350 
1351  #ifdef HAVE_SHEAFCOH_TRICKS
1352  if(strcmp(sys_cmd,"tensorModuleMult")==0)
1353  {
1354  const short t[]={2,INT_CMD,MODUL_CMD};
1355  // WarnS("tensorModuleMult!");
1356  if (iiCheckTypes(h,t,1))
1357  {
1358  int m = (int)( (long)h->Data() );
1359  ideal M = (ideal)h->next->Data();
1360  res->rtyp=MODUL_CMD;
1361  res->data=(void *)id_TensorModuleMult(m, M, currRing);
1362  return FALSE;
1363  }
1364  return TRUE;
1365  }
1366  else
1367  #endif
1368  /*==================== twostd =================*/
1369  #ifdef HAVE_PLURAL
1370  if (strcmp(sys_cmd, "twostd") == 0)
1371  {
1372  ideal I;
1373  if ((h!=NULL) && (h->Typ()==IDEAL_CMD))
1374  {
1375  I=(ideal)h->CopyD();
1376  res->rtyp=IDEAL_CMD;
1377  if (rIsPluralRing(currRing)) res->data=twostd(I);
1378  else res->data=I;
1380  setFlag(res,FLAG_STD);
1381  }
1382  else return TRUE;
1383  return FALSE;
1384  }
1385  else
1386  #endif
1387  /*==================== lie bracket =================*/
1388  #ifdef HAVE_PLURAL
1389  if (strcmp(sys_cmd, "bracket") == 0)
1390  {
1391  const short t[]={2,POLY_CMD,POLY_CMD};
1392  if (iiCheckTypes(h,t,1))
1393  {
1394  poly p=(poly)h->CopyD();
1395  h=h->next;
1396  poly q=(poly)h->Data();
1397  res->rtyp=POLY_CMD;
1399  return FALSE;
1400  }
1401  return TRUE;
1402  }
1403  else
1404  #endif
1405  /*==================== env ==================================*/
1406  #ifdef HAVE_PLURAL
1407  if (strcmp(sys_cmd, "env")==0)
1408  {
1409  if ((h!=NULL) && (h->Typ()==RING_CMD))
1410  {
1411  ring r = (ring)h->Data();
1412  res->data = rEnvelope(r);
1413  res->rtyp = RING_CMD;
1414  return FALSE;
1415  }
1416  else
1417  {
1418  WerrorS("`system(\"env\",<ring>)` expected");
1419  return TRUE;
1420  }
1421  }
1422  else
1423  #endif
1424 /* ============ opp ======================== */
1425  #ifdef HAVE_PLURAL
1426  if (strcmp(sys_cmd, "opp")==0)
1427  {
1428  if ((h!=NULL) && (h->Typ()==RING_CMD))
1429  {
1430  ring r=(ring)h->Data();
1431  res->data=rOpposite(r);
1432  res->rtyp=RING_CMD;
1433  return FALSE;
1434  }
1435  else
1436  {
1437  WerrorS("`system(\"opp\",<ring>)` expected");
1438  return TRUE;
1439  }
1440  }
1441  else
1442  #endif
1443  /*==================== oppose ==================================*/
1444  #ifdef HAVE_PLURAL
1445  if (strcmp(sys_cmd, "oppose")==0)
1446  {
1447  if ((h!=NULL) && (h->Typ()==RING_CMD)
1448  && (h->next!= NULL))
1449  {
1450  ring Rop = (ring)h->Data();
1451  h = h->next;
1452  idhdl w;
1453  if ((w=Rop->idroot->get(h->Name(),myynest))!=NULL)
1454  {
1455  poly p = (poly)IDDATA(w);
1456  res->data = pOppose(Rop, p, currRing); // into CurrRing?
1457  res->rtyp = POLY_CMD;
1458  return FALSE;
1459  }
1460  }
1461  else
1462  {
1463  WerrorS("`system(\"oppose\",<ring>,<poly>)` expected");
1464  return TRUE;
1465  }
1466  }
1467  else
1468  #endif
1469  /*==================== freeGB, twosided GB in free algebra =================*/
1470  #ifdef HAVE_PLURAL
1471  #ifdef HAVE_SHIFTBBA
1472  if (strcmp(sys_cmd, "freegb") == 0)
1473  {
1474  const short t[]={3,IDEAL_CMD,INT_CMD,INT_CMD};
1475  if (iiCheckTypes(h,t,1))
1476  {
1477  ideal I=(ideal)h->CopyD();
1478  h=h->next;
1479  int uptodeg=(int)((long)(h->Data()));
1480  h=h->next;
1481  int lVblock=(int)((long)(h->Data()));
1482  res->data = freegb(I,uptodeg,lVblock);
1483  if (res->data == NULL)
1484  {
1485  /* that is there were input errors */
1486  res->data = I;
1487  }
1488  res->rtyp = IDEAL_CMD;
1489  return FALSE;
1490  }
1491  else return TRUE;
1492  }
1493  else
1494  #endif /*SHIFTBBA*/
1495  #endif /*PLURAL*/
1496  /*==================== walk stuff =================*/
1497  /*==================== walkNextWeight =================*/
1498  #ifdef HAVE_WALK
1499  #ifdef OWNW
1500  if (strcmp(sys_cmd, "walkNextWeight") == 0)
1501  {
1502  const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1503  if (!iiCheckTypes(h,t,1)) return TRUE;
1504  if (((intvec*) h->Data())->length() != currRing->N ||
1505  ((intvec*) h->next->Data())->length() != currRing->N)
1506  {
1507  Werror("system(\"walkNextWeight\" ...) intvecs not of length %d\n",
1508  currRing->N);
1509  return TRUE;
1510  }
1511  res->data = (void*) walkNextWeight(((intvec*) h->Data()),
1512  ((intvec*) h->next->Data()),
1513  (ideal) h->next->next->Data());
1514  if (res->data == NULL || res->data == (void*) 1L)
1515  {
1516  res->rtyp = INT_CMD;
1517  }
1518  else
1519  {
1520  res->rtyp = INTVEC_CMD;
1521  }
1522  return FALSE;
1523  }
1524  else
1525  #endif
1526  #endif
1527  /*==================== walkNextWeight =================*/
1528  #ifdef HAVE_WALK
1529  #ifdef OWNW
1530  if (strcmp(sys_cmd, "walkInitials") == 0)
1531  {
1532  if (h == NULL || h->Typ() != IDEAL_CMD)
1533  {
1534  WerrorS("system(\"walkInitials\", ideal) expected");
1535  return TRUE;
1536  }
1537  res->data = (void*) walkInitials((ideal) h->Data());
1538  res->rtyp = IDEAL_CMD;
1539  return FALSE;
1540  }
1541  else
1542  #endif
1543  #endif
1544  /*==================== walkAddIntVec =================*/
1545  #ifdef HAVE_WALK
1546  #ifdef WAIV
1547  if (strcmp(sys_cmd, "walkAddIntVec") == 0)
1548  {
1549  const short t[]={2,INTVEC_CMD,INTVEC_CMD};
1550  if (!iiCheckTypes(h,t,1)) return TRUE;
1551  intvec* arg1 = (intvec*) h->Data();
1552  intvec* arg2 = (intvec*) h->next->Data();
1553  res->data = (intvec*) walkAddIntVec(arg1, arg2);
1554  res->rtyp = INTVEC_CMD;
1555  return FALSE;
1556  }
1557  else
1558  #endif
1559  #endif
1560  /*==================== MwalkNextWeight =================*/
1561  #ifdef HAVE_WALK
1562  #ifdef MwaklNextWeight
1563  if (strcmp(sys_cmd, "MwalkNextWeight") == 0)
1564  {
1565  const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1566  if (!iiCheckTypes(h,t,1)) return TRUE;
1567  if (((intvec*) h->Data())->length() != currRing->N ||
1568  ((intvec*) h->next->Data())->length() != currRing->N)
1569  {
1570  Werror("system(\"MwalkNextWeight\" ...) intvecs not of length %d\n",
1571  currRing->N);
1572  return TRUE;
1573  }
1574  intvec* arg1 = (intvec*) h->Data();
1575  intvec* arg2 = (intvec*) h->next->Data();
1576  ideal arg3 = (ideal) h->next->next->Data();
1577  intvec* result = (intvec*) MwalkNextWeight(arg1, arg2, arg3);
1578  res->rtyp = INTVEC_CMD;
1579  res->data = result;
1580  return FALSE;
1581  }
1582  else
1583  #endif //MWalkNextWeight
1584  #endif
1585  /*==================== Mivdp =================*/
1586  #ifdef HAVE_WALK
1587  if(strcmp(sys_cmd, "Mivdp") == 0)
1588  {
1589  if (h == NULL || h->Typ() != INT_CMD)
1590  {
1591  WerrorS("system(\"Mivdp\", int) expected");
1592  return TRUE;
1593  }
1594  if ((int) ((long)(h->Data())) != currRing->N)
1595  {
1596  Werror("system(\"Mivdp\" ...) intvecs not of length %d\n",
1597  currRing->N);
1598  return TRUE;
1599  }
1600  int arg1 = (int) ((long)(h->Data()));
1601  intvec* result = (intvec*) Mivdp(arg1);
1602  res->rtyp = INTVEC_CMD;
1603  res->data = result;
1604  return FALSE;
1605  }
1606  else
1607  #endif
1608  /*==================== Mivlp =================*/
1609  #ifdef HAVE_WALK
1610  if(strcmp(sys_cmd, "Mivlp") == 0)
1611  {
1612  if (h == NULL || h->Typ() != INT_CMD)
1613  {
1614  WerrorS("system(\"Mivlp\", int) expected");
1615  return TRUE;
1616  }
1617  if ((int) ((long)(h->Data())) != currRing->N)
1618  {
1619  Werror("system(\"Mivlp\" ...) intvecs not of length %d\n",
1620  currRing->N);
1621  return TRUE;
1622  }
1623  int arg1 = (int) ((long)(h->Data()));
1624  intvec* result = (intvec*) Mivlp(arg1);
1625  res->rtyp = INTVEC_CMD;
1626  res->data = result;
1627  return FALSE;
1628  }
1629  else
1630  #endif
1631  /*==================== MpDiv =================*/
1632  #ifdef HAVE_WALK
1633  #ifdef MpDiv
1634  if(strcmp(sys_cmd, "MpDiv") == 0)
1635  {
1636  const short t[]={2,POLY_CMD,POLY_CMD};
1637  if (!iiCheckTypes(h,t,1)) return TRUE;
1638  poly arg1 = (poly) h->Data();
1639  poly arg2 = (poly) h->next->Data();
1640  poly result = MpDiv(arg1, arg2);
1641  res->rtyp = POLY_CMD;
1642  res->data = result;
1643  return FALSE;
1644  }
1645  else
1646  #endif
1647  #endif
1648  /*==================== MpMult =================*/
1649  #ifdef HAVE_WALK
1650  #ifdef MpMult
1651  if(strcmp(sys_cmd, "MpMult") == 0)
1652  {
1653  const short t[]={2,POLY_CMD,POLY_CMD};
1654  if (!iiCheckTypes(h,t,1)) return TRUE;
1655  poly arg1 = (poly) h->Data();
1656  poly arg2 = (poly) h->next->Data();
1657  poly result = MpMult(arg1, arg2);
1658  res->rtyp = POLY_CMD;
1659  res->data = result;
1660  return FALSE;
1661  }
1662  else
1663  #endif
1664  #endif
1665  /*==================== MivSame =================*/
1666  #ifdef HAVE_WALK
1667  if (strcmp(sys_cmd, "MivSame") == 0)
1668  {
1669  const short t[]={2,INTVEC_CMD,INTVEC_CMD};
1670  if (!iiCheckTypes(h,t,1)) return TRUE;
1671  /*
1672  if (((intvec*) h->Data())->length() != currRing->N ||
1673  ((intvec*) h->next->Data())->length() != currRing->N)
1674  {
1675  Werror("system(\"MivSame\" ...) intvecs not of length %d\n",
1676  currRing->N);
1677  return TRUE;
1678  }
1679  */
1680  intvec* arg1 = (intvec*) h->Data();
1681  intvec* arg2 = (intvec*) h->next->Data();
1682  /*
1683  poly result = (poly) MivSame(arg1, arg2);
1684  res->rtyp = POLY_CMD;
1685  res->data = (poly) result;
1686  */
1687  res->rtyp = INT_CMD;
1688  res->data = (void*)(long) MivSame(arg1, arg2);
1689  return FALSE;
1690  }
1691  else
1692  #endif
1693  /*==================== M3ivSame =================*/
1694  #ifdef HAVE_WALK
1695  if (strcmp(sys_cmd, "M3ivSame") == 0)
1696  {
1697  const short t[]={3,INTVEC_CMD,INTVEC_CMD,INTVEC_CMD};
1698  if (!iiCheckTypes(h,t,1)) return TRUE;
1699  /*
1700  if (((intvec*) h->Data())->length() != currRing->N ||
1701  ((intvec*) h->next->Data())->length() != currRing->N ||
1702  ((intvec*) h->next->next->Data())->length() != currRing->N )
1703  {
1704  Werror("system(\"M3ivSame\" ...) intvecs not of length %d\n",
1705  currRing->N);
1706  return TRUE;
1707  }
1708  */
1709  intvec* arg1 = (intvec*) h->Data();
1710  intvec* arg2 = (intvec*) h->next->Data();
1711  intvec* arg3 = (intvec*) h->next->next->Data();
1712  /*
1713  poly result = (poly) M3ivSame(arg1, arg2, arg3);
1714  res->rtyp = POLY_CMD;
1715  res->data = (poly) result;
1716  */
1717  res->rtyp = INT_CMD;
1718  res->data = (void*)(long) M3ivSame(arg1, arg2, arg3);
1719  return FALSE;
1720  }
1721  else
1722  #endif
1723  /*==================== MwalkInitialForm =================*/
1724  #ifdef HAVE_WALK
1725  if(strcmp(sys_cmd, "MwalkInitialForm") == 0)
1726  {
1727  const short t[]={2,IDEAL_CMD,INTVEC_CMD};
1728  if (!iiCheckTypes(h,t,1)) return TRUE;
1729  if(((intvec*) h->next->Data())->length() != currRing->N)
1730  {
1731  Werror("system \"MwalkInitialForm\"...) intvec not of length %d\n",
1732  currRing->N);
1733  return TRUE;
1734  }
1735  ideal id = (ideal) h->Data();
1736  intvec* int_w = (intvec*) h->next->Data();
1737  ideal result = (ideal) MwalkInitialForm(id, int_w);
1738  res->rtyp = IDEAL_CMD;
1739  res->data = result;
1740  return FALSE;
1741  }
1742  else
1743  #endif
1744  /*==================== MivMatrixOrder =================*/
1745  #ifdef HAVE_WALK
1746  /************** Perturbation walk **********/
1747  if(strcmp(sys_cmd, "MivMatrixOrder") == 0)
1748  {
1749  if(h==NULL || h->Typ() != INTVEC_CMD)
1750  {
1751  WerrorS("system(\"MivMatrixOrder\",intvec) expected");
1752  return TRUE;
1753  }
1754  intvec* arg1 = (intvec*) h->Data();
1755  intvec* result = MivMatrixOrder(arg1);
1756  res->rtyp = INTVEC_CMD;
1757  res->data = result;
1758  return FALSE;
1759  }
1760  else
1761  #endif
1762  /*==================== MivMatrixOrderdp =================*/
1763  #ifdef HAVE_WALK
1764  if(strcmp(sys_cmd, "MivMatrixOrderdp") == 0)
1765  {
1766  if(h==NULL || h->Typ() != INT_CMD)
1767  {
1768  WerrorS("system(\"MivMatrixOrderdp\",intvec) expected");
1769  return TRUE;
1770  }
1771  int arg1 = (int) ((long)(h->Data()));
1772  intvec* result = (intvec*) MivMatrixOrderdp(arg1);
1773  res->rtyp = INTVEC_CMD;
1774  res->data = result;
1775  return FALSE;
1776  }
1777  else
1778  #endif
1779  /*==================== MPertVectors =================*/
1780  #ifdef HAVE_WALK
1781  if(strcmp(sys_cmd, "MPertVectors") == 0)
1782  {
1783  const short t[]={3,IDEAL_CMD,INTVEC_CMD,INT_CMD};
1784  if (!iiCheckTypes(h,t,1)) return TRUE;
1785  ideal arg1 = (ideal) h->Data();
1786  intvec* arg2 = (intvec*) h->next->Data();
1787  int arg3 = (int) ((long)(h->next->next->Data()));
1788  intvec* result = (intvec*) MPertVectors(arg1, arg2, arg3);
1789  res->rtyp = INTVEC_CMD;
1790  res->data = result;
1791  return FALSE;
1792  }
1793  else
1794  #endif
1795  /*==================== MPertVectorslp =================*/
1796  #ifdef HAVE_WALK
1797  if(strcmp(sys_cmd, "MPertVectorslp") == 0)
1798  {
1799  const short t[]={3,IDEAL_CMD,INTVEC_CMD,INT_CMD};
1800  if (!iiCheckTypes(h,t,1)) return TRUE;
1801  ideal arg1 = (ideal) h->Data();
1802  intvec* arg2 = (intvec*) h->next->Data();
1803  int arg3 = (int) ((long)(h->next->next->Data()));
1804  intvec* result = (intvec*) MPertVectorslp(arg1, arg2, arg3);
1805  res->rtyp = INTVEC_CMD;
1806  res->data = result;
1807  return FALSE;
1808  }
1809  else
1810  #endif
1811  /************** fractal walk **********/
1812  #ifdef HAVE_WALK
1813  if(strcmp(sys_cmd, "Mfpertvector") == 0)
1814  {
1815  const short t[]={2,IDEAL_CMD,INTVEC_CMD};
1816  if (!iiCheckTypes(h,t,1)) return TRUE;
1817  ideal arg1 = (ideal) h->Data();
1818  intvec* arg2 = (intvec*) h->next->Data();
1819  intvec* result = Mfpertvector(arg1, arg2);
1820  res->rtyp = INTVEC_CMD;
1821  res->data = result;
1822  return FALSE;
1823  }
1824  else
1825  #endif
1826  /*==================== MivUnit =================*/
1827  #ifdef HAVE_WALK
1828  if(strcmp(sys_cmd, "MivUnit") == 0)
1829  {
1830  const short t[]={1,INT_CMD};
1831  if (!iiCheckTypes(h,t,1)) return TRUE;
1832  int arg1 = (int) ((long)(h->Data()));
1833  intvec* result = (intvec*) MivUnit(arg1);
1834  res->rtyp = INTVEC_CMD;
1835  res->data = result;
1836  return FALSE;
1837  }
1838  else
1839  #endif
1840  /*==================== MivWeightOrderlp =================*/
1841  #ifdef HAVE_WALK
1842  if(strcmp(sys_cmd, "MivWeightOrderlp") == 0)
1843  {
1844  const short t[]={1,INTVEC_CMD};
1845  if (!iiCheckTypes(h,t,1)) return TRUE;
1846  intvec* arg1 = (intvec*) h->Data();
1847  intvec* result = MivWeightOrderlp(arg1);
1848  res->rtyp = INTVEC_CMD;
1849  res->data = result;
1850  return FALSE;
1851  }
1852  else
1853  #endif
1854  /*==================== MivWeightOrderdp =================*/
1855  #ifdef HAVE_WALK
1856  if(strcmp(sys_cmd, "MivWeightOrderdp") == 0)
1857  {
1858  if(h==NULL || h->Typ() != INTVEC_CMD)
1859  {
1860  WerrorS("system(\"MivWeightOrderdp\",intvec) expected");
1861  return TRUE;
1862  }
1863  intvec* arg1 = (intvec*) h->Data();
1864  //int arg2 = (int) h->next->Data();
1865  intvec* result = MivWeightOrderdp(arg1);
1866  res->rtyp = INTVEC_CMD;
1867  res->data = result;
1868  return FALSE;
1869  }
1870  else
1871  #endif
1872  /*==================== MivMatrixOrderlp =================*/
1873  #ifdef HAVE_WALK
1874  if(strcmp(sys_cmd, "MivMatrixOrderlp") == 0)
1875  {
1876  if(h==NULL || h->Typ() != INT_CMD)
1877  {
1878  WerrorS("system(\"MivMatrixOrderlp\",int) expected");
1879  return TRUE;
1880  }
1881  int arg1 = (int) ((long)(h->Data()));
1882  intvec* result = (intvec*) MivMatrixOrderlp(arg1);
1883  res->rtyp = INTVEC_CMD;
1884  res->data = result;
1885  return FALSE;
1886  }
1887  else
1888  #endif
1889  /*==================== MkInterRedNextWeight =================*/
1890  #ifdef HAVE_WALK
1891  if (strcmp(sys_cmd, "MkInterRedNextWeight") == 0)
1892  {
1893  const short t[]={3,INTVEC_CMD,INTVEC_CMD,IDEAL_CMD};
1894  if (!iiCheckTypes(h,t,1)) return TRUE;
1895  if (((intvec*) h->Data())->length() != currRing->N ||
1896  ((intvec*) h->next->Data())->length() != currRing->N)
1897  {
1898  Werror("system(\"MkInterRedNextWeight\" ...) intvecs not of length %d\n",
1899  currRing->N);
1900  return TRUE;
1901  }
1902  intvec* arg1 = (intvec*) h->Data();
1903  intvec* arg2 = (intvec*) h->next->Data();
1904  ideal arg3 = (ideal) h->next->next->Data();
1905  intvec* result = (intvec*) MkInterRedNextWeight(arg1, arg2, arg3);
1906  res->rtyp = INTVEC_CMD;
1907  res->data = result;
1908  return FALSE;
1909  }
1910  else
1911  #endif
1912  /*==================== MPertNextWeight =================*/
1913  #ifdef HAVE_WALK
1914  #ifdef MPertNextWeight
1915  if (strcmp(sys_cmd, "MPertNextWeight") == 0)
1916  {
1917  const short t[]={3,INTVEC_CMD,IDEAL_CMD,INT_CMD};
1918  if (!iiCheckTypes(h,t,1)) return TRUE;
1919  if (((intvec*) h->Data())->length() != currRing->N)
1920  {
1921  Werror("system(\"MPertNextWeight\" ...) intvecs not of length %d\n",
1922  currRing->N);
1923  return TRUE;
1924  }
1925  intvec* arg1 = (intvec*) h->Data();
1926  ideal arg2 = (ideal) h->next->Data();
1927  int arg3 = (int) h->next->next->Data();
1928  intvec* result = (intvec*) MPertNextWeight(arg1, arg2, arg3);
1929  res->rtyp = INTVEC_CMD;
1930  res->data = result;
1931  return FALSE;
1932  }
1933  else
1934  #endif //MPertNextWeight
1935  #endif
1936  /*==================== Mivperttarget =================*/
1937  #ifdef HAVE_WALK
1938  #ifdef Mivperttarget
1939  if (strcmp(sys_cmd, "Mivperttarget") == 0)
1940  {
1941  const short t[]={2,IDEAL_CMD,INT_CMD};
1942  if (!iiCheckTypes(h,t,1)) return TRUE;
1943  ideal arg1 = (ideal) h->Data();
1944  int arg2 = (int) h->next->Data();
1945  intvec* result = (intvec*) Mivperttarget(arg1, arg2);
1946  res->rtyp = INTVEC_CMD;
1947  res->data = result;
1948  return FALSE;
1949  }
1950  else
1951  #endif //Mivperttarget
1952  #endif
1953  /*==================== Mwalk =================*/
1954  #ifdef HAVE_WALK
1955  if (strcmp(sys_cmd, "Mwalk") == 0)
1956  {
1957  const short t[]={6,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,RING_CMD,INT_CMD,INT_CMD};
1958  if (!iiCheckTypes(h,t,1)) return TRUE;
1959  if (((intvec*) h->next->Data())->length() != currRing->N &&
1960  ((intvec*) h->next->next->Data())->length() != currRing->N )
1961  {
1962  Werror("system(\"Mwalk\" ...) intvecs not of length %d\n",
1963  currRing->N);
1964  return TRUE;
1965  }
1966  ideal arg1 = (ideal) h->CopyD();
1967  intvec* arg2 = (intvec*) h->next->Data();
1968  intvec* arg3 = (intvec*) h->next->next->Data();
1969  ring arg4 = (ring) h->next->next->next->Data();
1970  int arg5 = (int) (long) h->next->next->next->next->Data();
1971  int arg6 = (int) (long) h->next->next->next->next->next->Data();
1972  ideal result = (ideal) Mwalk(arg1, arg2, arg3, arg4, arg5, arg6);
1973  res->rtyp = IDEAL_CMD;
1974  res->data = result;
1975  return FALSE;
1976  }
1977  else
1978  #endif
1979  /*==================== Mpwalk =================*/
1980  #ifdef HAVE_WALK
1981  #ifdef MPWALK_ORIG
1982  if (strcmp(sys_cmd, "Mwalk") == 0)
1983  {
1984  const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,RING_CMD};
1985  if (!iiCheckTypes(h,t,1)) return TRUE;
1986  if ((((intvec*) h->next->Data())->length() != currRing->N &&
1987  ((intvec*) h->next->next->Data())->length() != currRing->N ) &&
1988  (((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
1989  ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N)))
1990  {
1991  Werror("system(\"Mwalk\" ...) intvecs not of length %d or %d\n",
1992  currRing->N,(currRing->N)*(currRing->N));
1993  return TRUE;
1994  }
1995  ideal arg1 = (ideal) h->Data();
1996  intvec* arg2 = (intvec*) h->next->Data();
1997  intvec* arg3 = (intvec*) h->next->next->Data();
1998  ring arg4 = (ring) h->next->next->next->Data();
1999  ideal result = (ideal) Mwalk(arg1, arg2, arg3,arg4);
2000  res->rtyp = IDEAL_CMD;
2001  res->data = result;
2002  return FALSE;
2003  }
2004  else
2005  #else
2006  if (strcmp(sys_cmd, "Mpwalk") == 0)
2007  {
2009  if (!iiCheckTypes(h,t,1)) return TRUE;
2010  if(((intvec*) h->next->next->next->Data())->length() != currRing->N &&
2011  ((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
2012  {
2013  Werror("system(\"Mpwalk\" ...) intvecs not of length %d\n",currRing->N);
2014  return TRUE;
2015  }
2016  ideal arg1 = (ideal) h->Data();
2017  int arg2 = (int) (long) h->next->Data();
2018  int arg3 = (int) (long) h->next->next->Data();
2019  intvec* arg4 = (intvec*) h->next->next->next->Data();
2020  intvec* arg5 = (intvec*) h->next->next->next->next->Data();
2021  int arg6 = (int) (long) h->next->next->next->next->next->Data();
2022  int arg7 = (int) (long) h->next->next->next->next->next->next->Data();
2023  int arg8 = (int) (long) h->next->next->next->next->next->next->next->Data();
2024  ideal result = (ideal) Mpwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8);
2025  res->rtyp = IDEAL_CMD;
2026  res->data = result;
2027  return FALSE;
2028  }
2029  else
2030  #endif
2031  #endif
2032  /*==================== Mrwalk =================*/
2033  #ifdef HAVE_WALK
2034  if (strcmp(sys_cmd, "Mrwalk") == 0)
2035  {
2037  if (!iiCheckTypes(h,t,1)) return TRUE;
2038  if(((intvec*) h->next->Data())->length() != currRing->N &&
2039  ((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
2040  ((intvec*) h->next->next->Data())->length() != currRing->N &&
2041  ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N) )
2042  {
2043  Werror("system(\"Mrwalk\" ...) intvecs not of length %d or %d\n",
2044  currRing->N,(currRing->N)*(currRing->N));
2045  return TRUE;
2046  }
2047  ideal arg1 = (ideal) h->Data();
2048  intvec* arg2 = (intvec*) h->next->Data();
2049  intvec* arg3 = (intvec*) h->next->next->Data();
2050  int arg4 = (int)(long) h->next->next->next->Data();
2051  int arg5 = (int)(long) h->next->next->next->next->Data();
2052  int arg6 = (int)(long) h->next->next->next->next->next->Data();
2053  int arg7 = (int)(long) h->next->next->next->next->next->next->Data();
2054  ideal result = (ideal) Mrwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7);
2055  res->rtyp = IDEAL_CMD;
2056  res->data = result;
2057  return FALSE;
2058  }
2059  else
2060  #endif
2061  /*==================== MAltwalk1 =================*/
2062  #ifdef HAVE_WALK
2063  if (strcmp(sys_cmd, "MAltwalk1") == 0)
2064  {
2065  const short t[]={5,IDEAL_CMD,INT_CMD,INT_CMD,INTVEC_CMD,INTVEC_CMD};
2066  if (!iiCheckTypes(h,t,1)) return TRUE;
2067  if (((intvec*) h->next->next->next->Data())->length() != currRing->N &&
2068  ((intvec*) h->next->next->next->next->Data())->length()!=currRing->N)
2069  {
2070  Werror("system(\"MAltwalk1\" ...) intvecs not of length %d\n",
2071  currRing->N);
2072  return TRUE;
2073  }
2074  ideal arg1 = (ideal) h->Data();
2075  int arg2 = (int) ((long)(h->next->Data()));
2076  int arg3 = (int) ((long)(h->next->next->Data()));
2077  intvec* arg4 = (intvec*) h->next->next->next->Data();
2078  intvec* arg5 = (intvec*) h->next->next->next->next->Data();
2079  ideal result = (ideal) MAltwalk1(arg1, arg2, arg3, arg4, arg5);
2080  res->rtyp = IDEAL_CMD;
2081  res->data = result;
2082  return FALSE;
2083  }
2084  else
2085  #endif
2086  /*==================== MAltwalk1 =================*/
2087  #ifdef HAVE_WALK
2088  #ifdef MFWALK_ALT
2089  if (strcmp(sys_cmd, "Mfwalk_alt") == 0)
2090  {
2091  const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD};
2092  if (!iiCheckTypes(h,t,1)) return TRUE;
2093  if (((intvec*) h->next->Data())->length() != currRing->N &&
2094  ((intvec*) h->next->next->Data())->length() != currRing->N )
2095  {
2096  Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
2097  currRing->N);
2098  return TRUE;
2099  }
2100  ideal arg1 = (ideal) h->Data();
2101  intvec* arg2 = (intvec*) h->next->Data();
2102  intvec* arg3 = (intvec*) h->next->next->Data();
2103  int arg4 = (int) h->next->next->next->Data();
2104  ideal result = (ideal) Mfwalk_alt(arg1, arg2, arg3, arg4);
2105  res->rtyp = IDEAL_CMD;
2106  res->data = result;
2107  return FALSE;
2108  }
2109  else
2110  #endif
2111  #endif
2112  /*==================== Mfwalk =================*/
2113  #ifdef HAVE_WALK
2114  if (strcmp(sys_cmd, "Mfwalk") == 0)
2115  {
2116  const short t[]={5,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD};
2117  if (!iiCheckTypes(h,t,1)) return TRUE;
2118  if (((intvec*) h->next->Data())->length() != currRing->N &&
2119  ((intvec*) h->next->next->Data())->length() != currRing->N )
2120  {
2121  Werror("system(\"Mfwalk\" ...) intvecs not of length %d\n",
2122  currRing->N);
2123  return TRUE;
2124  }
2125  ideal arg1 = (ideal) h->Data();
2126  intvec* arg2 = (intvec*) h->next->Data();
2127  intvec* arg3 = (intvec*) h->next->next->Data();
2128  int arg4 = (int)(long) h->next->next->next->Data();
2129  int arg5 = (int)(long) h->next->next->next->next->Data();
2130  ideal result = (ideal) Mfwalk(arg1, arg2, arg3, arg4, arg5);
2131  res->rtyp = IDEAL_CMD;
2132  res->data = result;
2133  return FALSE;
2134  }
2135  else
2136  #endif
2137  /*==================== Mfrwalk =================*/
2138  #ifdef HAVE_WALK
2139  if (strcmp(sys_cmd, "Mfrwalk") == 0)
2140  {
2141  const short t[]={6,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD};
2142  if (!iiCheckTypes(h,t,1)) return TRUE;
2143 /*
2144  if (((intvec*) h->next->Data())->length() != currRing->N &&
2145  ((intvec*) h->next->next->Data())->length() != currRing->N)
2146  {
2147  Werror("system(\"Mfrwalk\" ...) intvecs not of length %d\n",currRing->N);
2148  return TRUE;
2149  }
2150 */
2151  if((((intvec*) h->next->Data())->length() != currRing->N &&
2152  ((intvec*) h->next->next->Data())->length() != currRing->N ) &&
2153  (((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
2154  ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N) ))
2155  {
2156  Werror("system(\"Mfrwalk\" ...) intvecs not of length %d or %d\n",
2157  currRing->N,(currRing->N)*(currRing->N));
2158  return TRUE;
2159  }
2160 
2161  ideal arg1 = (ideal) h->Data();
2162  intvec* arg2 = (intvec*) h->next->Data();
2163  intvec* arg3 = (intvec*) h->next->next->Data();
2164  int arg4 = (int)(long) h->next->next->next->Data();
2165  int arg5 = (int)(long) h->next->next->next->next->Data();
2166  int arg6 = (int)(long) h->next->next->next->next->next->Data();
2167  ideal result = (ideal) Mfrwalk(arg1, arg2, arg3, arg4, arg5, arg6);
2168  res->rtyp = IDEAL_CMD;
2169  res->data = result;
2170  return FALSE;
2171  }
2172  else
2173  /*==================== Mprwalk =================*/
2174  if (strcmp(sys_cmd, "Mprwalk") == 0)
2175  {
2177  if (!iiCheckTypes(h,t,1)) return TRUE;
2178  if((((intvec*) h->next->Data())->length() != currRing->N &&
2179  ((intvec*) h->next->next->Data())->length() != currRing->N ) &&
2180  (((intvec*) h->next->Data())->length() != (currRing->N)*(currRing->N) &&
2181  ((intvec*) h->next->next->Data())->length() != (currRing->N)*(currRing->N) ))
2182  {
2183  Werror("system(\"Mrwalk\" ...) intvecs not of length %d or %d\n",
2184  currRing->N,(currRing->N)*(currRing->N));
2185  return TRUE;
2186  }
2187  ideal arg1 = (ideal) h->Data();
2188  intvec* arg2 = (intvec*) h->next->Data();
2189  intvec* arg3 = (intvec*) h->next->next->Data();
2190  int arg4 = (int)(long) h->next->next->next->Data();
2191  int arg5 = (int)(long) h->next->next->next->next->Data();
2192  int arg6 = (int)(long) h->next->next->next->next->next->Data();
2193  int arg7 = (int)(long) h->next->next->next->next->next->next->Data();
2194  int arg8 = (int)(long) h->next->next->next->next->next->next->next->Data();
2195  int arg9 = (int)(long) h->next->next->next->next->next->next->next->next->Data();
2196  ideal result = (ideal) Mprwalk(arg1, arg2, arg3, arg4, arg5, arg6, arg7, arg8, arg9);
2197  res->rtyp = IDEAL_CMD;
2198  res->data = result;
2199  return FALSE;
2200  }
2201  else
2202  #endif
2203  /*==================== TranMImprovwalk =================*/
2204  #ifdef HAVE_WALK
2205  #ifdef TRAN_Orig
2206  if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
2207  {
2208  const short t[]={3,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD};
2209  if (!iiCheckTypes(h,t,1)) return TRUE;
2210  if (((intvec*) h->next->Data())->length() != currRing->N &&
2211  ((intvec*) h->next->next->Data())->length() != currRing->N )
2212  {
2213  Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
2214  currRing->N);
2215  return TRUE;
2216  }
2217  ideal arg1 = (ideal) h->Data();
2218  intvec* arg2 = (intvec*) h->next->Data();
2219  intvec* arg3 = (intvec*) h->next->next->Data();
2220  ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3);
2221  res->rtyp = IDEAL_CMD;
2222  res->data = result;
2223  return FALSE;
2224  }
2225  else
2226  #endif
2227  #endif
2228  /*==================== MAltwalk2 =================*/
2229  #ifdef HAVE_WALK
2230  if (strcmp(sys_cmd, "MAltwalk2") == 0)
2231  {
2232  const short t[]={3,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD};
2233  if (!iiCheckTypes(h,t,1)) return TRUE;
2234  if (((intvec*) h->next->Data())->length() != currRing->N &&
2235  ((intvec*) h->next->next->Data())->length() != currRing->N )
2236  {
2237  Werror("system(\"MAltwalk2\" ...) intvecs not of length %d\n",
2238  currRing->N);
2239  return TRUE;
2240  }
2241  ideal arg1 = (ideal) h->Data();
2242  intvec* arg2 = (intvec*) h->next->Data();
2243  intvec* arg3 = (intvec*) h->next->next->Data();
2244  ideal result = (ideal) MAltwalk2(arg1, arg2, arg3);
2245  res->rtyp = IDEAL_CMD;
2246  res->data = result;
2247  return FALSE;
2248  }
2249  else
2250  #endif
2251  /*==================== MAltwalk2 =================*/
2252  #ifdef HAVE_WALK
2253  if (strcmp(sys_cmd, "TranMImprovwalk") == 0)
2254  {
2255  const short t[]={4,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD};
2256  if (!iiCheckTypes(h,t,1)) return TRUE;
2257  if (((intvec*) h->next->Data())->length() != currRing->N &&
2258  ((intvec*) h->next->next->Data())->length() != currRing->N )
2259  {
2260  Werror("system(\"TranMImprovwalk\" ...) intvecs not of length %d\n",
2261  currRing->N);
2262  return TRUE;
2263  }
2264  ideal arg1 = (ideal) h->Data();
2265  intvec* arg2 = (intvec*) h->next->Data();
2266  intvec* arg3 = (intvec*) h->next->next->Data();
2267  int arg4 = (int) ((long)(h->next->next->next->Data()));
2268  ideal result = (ideal) TranMImprovwalk(arg1, arg2, arg3, arg4);
2269  res->rtyp = IDEAL_CMD;
2270  res->data = result;
2271  return FALSE;
2272  }
2273  else
2274  #endif
2275  /*==================== TranMrImprovwalk =================*/
2276  #if 0
2277  #ifdef HAVE_WALK
2278  if (strcmp(sys_cmd, "TranMrImprovwalk") == 0)
2279  {
2280  if (h == NULL || h->Typ() != IDEAL_CMD ||
2281  h->next == NULL || h->next->Typ() != INTVEC_CMD ||
2282  h->next->next == NULL || h->next->next->Typ() != INTVEC_CMD ||
2283  h->next->next->next == NULL || h->next->next->next->Typ() != INT_CMD ||
2284  h->next->next->next == NULL || h->next->next->next->next->Typ() != INT_CMD ||
2285  h->next->next->next == NULL || h->next->next->next->next->next->Typ() != INT_CMD)
2286  {
2287  WerrorS("system(\"TranMrImprovwalk\", ideal, intvec, intvec) expected");
2288  return TRUE;
2289  }
2290  if (((intvec*) h->next->Data())->length() != currRing->N &&
2291  ((intvec*) h->next->next->Data())->length() != currRing->N )
2292  {
2293  Werror("system(\"TranMrImprovwalk\" ...) intvecs not of length %d\n", currRing->N);
2294  return TRUE;
2295  }
2296  ideal arg1 = (ideal) h->Data();
2297  intvec* arg2 = (intvec*) h->next->Data();
2298  intvec* arg3 = (intvec*) h->next->next->Data();
2299  int arg4 = (int)(long) h->next->next->next->Data();
2300  int arg5 = (int)(long) h->next->next->next->next->Data();
2301  int arg6 = (int)(long) h->next->next->next->next->next->Data();
2302  ideal result = (ideal) TranMrImprovwalk(arg1, arg2, arg3, arg4, arg5, arg6);
2303  res->rtyp = IDEAL_CMD;
2304  res->data = result;
2305  return FALSE;
2306  }
2307  else
2308  #endif
2309  #endif
2310  /*================= Extended system call ========================*/
2311  {
2312  #ifndef MAKE_DISTRIBUTION
2313  return(jjEXTENDED_SYSTEM(res, args));
2314  #else
2315  Werror( "system(\"%s\",...) %s", sys_cmd, feNotImplemented );
2316  #endif
2317  }
2318  } /* typ==string */
2319  return TRUE;
2320 }
feOptIndex
Definition: feOptGen.h:15
int & rows()
Definition: matpol.h:24
lists get_denom_list()
Definition: denom_list.cc:8
poly pOppose(ring Rop_src, poly p, const ring Rop_dst)
opposes a vector p from Rop to currRing (dst!)
Definition: old.gring.cc:3373
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
const CanonicalForm int s
Definition: facAbsFact.cc:55
ring rEnvelope(ring R)
Definition: ring.cc:5519
sleftv * m
Definition: lists.h:45
intvec * MivMatrixOrder(intvec *iv)
Definition: walk.cc:972
poly nc_p_Bracket_qq(poly p, const poly q, const ring r)
returns [p,q], destroys p
Definition: old.gring.cc:2254
void factoryseed(int s)
random seed initializer
Definition: cf_random.cc:176
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define MAXPATHLEN
Definition: omRet2Info.c:22
int HCord
Definition: kutil.cc:235
static CanonicalForm bound(const CFMatrix &M)
Definition: cf_linsys.cc:460
matrix singntl_LLL(matrix m, const ring s)
Definition: clapsing.cc:1726
intvec * Mfpertvector(ideal G, intvec *ivtarget)
Definition: walk.cc:1521
Definition: tok.h:95
static void * feOptValue(feOptIndex opt)
Definition: feOpt.h:40
matrix evRowElim(matrix M, int i, int j, int k)
Definition: eigenval.cc:47
Definition: lists.h:22
ideal Mpwalk(ideal Go, int op_deg, int tp_deg, intvec *curr_weight, intvec *target_weight, int nP, int reduction, int printout)
Definition: walk.cc:5956
used for all transcendental extensions, i.e., the top-most extension in an extension tower is transce...
Definition: coeffs.h:39
char * versionString()
Definition: misc_ip.cc:778
#define FALSE
Definition: auxiliary.h:94
return P p
Definition: myNF.cc:203
intvec * MivWeightOrderlp(intvec *ivstart)
Definition: walk.cc:1445
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4437
Matrices of numbers.
Definition: bigintmat.h:51
#define SINGULAR_VERSION
Definition: mod2.h:86
static char * feResource(feResourceConfig config, int warn)
Definition: feResource.cc:258
lists pcvPMulL(poly p, lists l1)
Definition: pcv.cc:56
static FORCE_INLINE number n_Init(long i, const coeffs r)
a number representing i in the given coeff field/ring r
Definition: coeffs.h:542
ring rOpposite(ring src)
Definition: ring.cc:5189
#define BB_LIKE_LIST(B)
Definition: blackbox.h:54
int siRandomStart
Definition: cntrlc.cc:102
ideal id_TensorModuleMult(const int m, const ideal M, const ring rRing)
void HilbertSeries_OrbitData(ideal S, int lV, bool IG_CASE, bool mgrad, bool odp)
Definition: hilb.cc:1861
char * getenv()
BOOLEAN spectrumProc(leftv result, leftv first)
Definition: ipshell.cc:4059
#define TRUE
Definition: auxiliary.h:98
int MivSame(intvec *u, intvec *v)
Definition: walk.cc:902
intvec * MivWeightOrderdp(intvec *ivstart)
Definition: walk.cc:1465
BOOLEAN spmulProc(leftv result, leftv first, leftv second)
Definition: ipshell.cc:4396
void * value
Definition: fegetopt.h:93
const char * feSetOptValue(feOptIndex opt, char *optarg)
Definition: feOpt.cc:153
void WerrorS(const char *s)
Definition: feFopen.cc:24
gmp_complex numbers based on
Definition: mpr_complex.h:178
char * StringEndS()
Definition: reporter.cc:151
bool complexNearZero(gmp_complex *c, int digits)
Definition: mpr_complex.cc:767
void lduDecomp(const matrix aMat, matrix &pMat, matrix &lMat, matrix &dMat, matrix &uMat, poly &l, poly &u, poly &lTimesU)
LU-decomposition of a given (m x n)-matrix with performing only those divisions that yield zero remai...
matrix evSwap(matrix M, int i, int j)
Definition: eigenval.cc:25
Definition: idrec.h:34
#define ivTest(v)
Definition: intvec.h:149
intvec * MPertVectorslp(ideal G, intvec *ivtarget, int pdeg)
Definition: walk.cc:1308
void * data
Definition: subexpr.h:88
void printBlackboxTypes()
list all defined type (for debugging)
Definition: blackbox.cc:208
void feStringAppendBrowsers(int warn)
Definition: fehelp.cc:354
ideal Mfwalk(ideal G, intvec *ivstart, intvec *ivtarget, int reduction, int printout)
Definition: walk.cc:8040
poly res
Definition: myNF.cc:322
poly p_Shrink(poly p, int lV, const ring r)
Definition: shiftgb.cc:373
int myynest
Definition: febase.cc:46
#define M
Definition: sirandom.c:24
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
ideal MAltwalk1(ideal Go, int op_deg, int tp_deg, intvec *curr_weight, intvec *target_weight)
Definition: walk.cc:9680
#define FLAG_TWOSTD
Definition: ipid.h:107
Definition: intvec.h:14
int pcvDim(int d0, int d1)
Definition: pcv.cc:361
void newstructShow(newstruct_desc d)
Definition: newstruct.cc:830
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:404
void StringSetS(const char *st)
Definition: reporter.cc:128
#define pLPshift(p, sh, uptodeg, lV)
Definition: shiftgb.h:30
static BOOLEAN jjEXTENDED_SYSTEM(leftv res, leftv h)
Definition: extra.cc:2334
#define pmLastVblock(p, lV)
Definition: shiftgb.h:35
int M3ivSame(intvec *temp, intvec *u, intvec *v)
Definition: walk.cc:923
const char feNotImplemented[]
Definition: reporter.cc:54
struct fe_option feOptSpec[]
intvec * MwalkNextWeight(intvec *curr_weight, intvec *target_weight, ideal G)
ideal Mwalk(ideal Go, intvec *orig_M, intvec *target_M, ring baseRing, int reduction, int printout)
Definition: walk.cc:5311
ip_smatrix * matrix
intvec * MPertNextWeight(intvec *iva, ideal G, int deg)
void system(sys)
idhdl currRingHdl
Definition: ipid.cc:65
#define setFlag(A, F)
Definition: ipid.h:110
int simpleipc_cmd(char *cmd, int id, int v)
Definition: semaphore.c:167
int m
Definition: cfEzgcd.cc:119
void fePrintOptValues()
Definition: feOpt.cc:319
poly pcvCV2P(poly cv, int d0, int d1)
Definition: pcv.cc:263
FILE * f
Definition: checklibs.c:9
int i
Definition: cfEzgcd.cc:123
intvec * Mivperttarget(ideal G, int ndeg)
BOOLEAN spectrumfProc(leftv result, leftv first)
Definition: ipshell.cc:4110
lists pcvLAddL(lists l1, lists l2)
Definition: pcv.cc:31
int pcvBasis(lists b, int i, poly m, int d, int n)
Definition: pcv.cc:391
intvec * MPertVectors(ideal G, intvec *ivtarget, int pdeg)
Definition: walk.cc:1097
poly kNFBound(ideal F, ideal Q, poly p, int bound, int syzComp, int lazyReduce)
Definition: kstd1.cc:3017
ideal freegb(ideal I, int uptodeg, int lVblock)
Definition: kstd2.cc:4371
static FORCE_INLINE n_coeffType getCoeffType(const coeffs r)
Returns the type of coeffs domain.
Definition: coeffs.h:425
#define FLAG_STD
Definition: ipid.h:106
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:537
intvec * Mivdp(int nR)
Definition: walk.cc:1016
#define BIMATELEM(M, I, J)
Definition: bigintmat.h:134
INLINE_THIS void Init(int l=0)
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
matrix evHessenberg(matrix M)
Definition: eigenval.cc:100
int & cols()
Definition: matpol.h:25
#define pLastVblock(p, lV)
Definition: shiftgb.h:33
Definition: tok.h:116
lists evEigenvals(matrix M)
Definition: eigenval_ip.cc:118
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
BOOLEAN semicProc(leftv res, leftv u, leftv v)
Definition: ipshell.cc:4477
int siSeed
Definition: sirandom.c:29
bool luSolveViaLDUDecomp(const matrix pMat, const matrix lMat, const matrix dMat, const matrix uMat, const poly l, const poly u, const poly lTimesU, const matrix bVec, matrix &xVec, matrix &H)
Solves the linear system A * x = b, where A is an (m x n)-matrix which is given by its LDU-decomposit...
ideal TranMImprovwalk(ideal G, intvec *curr_weight, intvec *target_tmp, int nP)
Definition: walk.cc:8405
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:6466
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:534
#define IDRING(a)
Definition: ipid.h:124
int blackboxIsCmd(const char *n, int &tok)
used by scanner: returns ROOT_DECL for known types (and the type number in tok)
Definition: blackbox.cc:191
const CanonicalForm & w
Definition: facAbsFact.cc:55
intvec * MivMatrixOrderdp(int nV)
Definition: walk.cc:1426
int rtyp
Definition: subexpr.h:91
#define TEST_FOR(A)
ideal MAltwalk2(ideal Go, intvec *curr_weight, intvec *target_weight)
Definition: walk.cc:4289
ideal Mrwalk(ideal Go, intvec *orig_M, intvec *target_M, int weight_rad, int pert_deg, int reduction, int printout)
Definition: walk.cc:5612
poly pcvP2CV(poly p, int d0, int d1)
Definition: pcv.cc:246
Definition: tok.h:117
char * omFindExec(const char *name, char *exec)
Definition: omFindExec.c:252
omBin slists_bin
Definition: lists.cc:23
BOOLEAN spaddProc(leftv result, leftv first, leftv second)
Definition: ipshell.cc:4354
intvec * MivUnit(int nV)
Definition: walk.cc:1505
ideal idXXX(ideal h1, int k)
Definition: ideals.cc:703
ideal singclap_absFactorize(poly f, ideal &mipos, intvec **exps, int &numFactors, const ring r)
Definition: clapsing.cc:1782
BOOLEAN newstruct_set_proc(const char *bbname, const char *func, int args, procinfov pr)
Definition: newstruct.cc:850
size_t gmp_output_digits
Definition: mpr_complex.cc:44
ideal Mprwalk(ideal Go, intvec *orig_M, intvec *target_M, int weight_rad, int op_deg, int tp_deg, int nP, int reduction, int printout)
Definition: walk.cc:6397
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete &#39;p&#39;
Definition: coeffs.h:459
lists gmsNF(ideal p, ideal g, matrix B, int D, int K)
Definition: gms.cc:22
feOptIndex feGetOptIndex(const char *name)
Definition: feOpt.cc:104
void countedref_reference_load()
Initialize blackbox types &#39;reference&#39; and &#39;shared&#39;, or both.
Definition: countedref.cc:700
static jList * T
Definition: janet.cc:37
polyrec * poly
Definition: hilb.h:10
#define IDDATA(a)
Definition: ipid.h:123
char * singclap_neworder(ideal I, const ring r)
Definition: clapsing.cc:1476
ideal MwalkInitialForm(ideal G, intvec *ivw)
Definition: walk.cc:770
ideal Mfrwalk(ideal G, intvec *ivstart, intvec *ivtarget, int weight_rad, int reduction, int printout)
Definition: walk.cc:8221
static Poly * h
Definition: janet.cc:978
#define IMATELEM(M, I, J)
Definition: intvec.h:77
#define NONE
Definition: tok.h:216
void feReInitResources()
Definition: feResource.cc:207
void Werror(const char *fmt,...)
Definition: reporter.cc:189
intvec * MivMatrixOrderlp(int nV)
Definition: walk.cc:1410
int pcvMinDeg(poly p)
Definition: pcv.cc:108
void countedref_shared_load()
Definition: countedref.cc:724
return result
Definition: facAbsBiFact.cc:76
int l
Definition: cfEzgcd.cc:94
intvec * Mivlp(int nR)
Definition: walk.cc:1031
procinfo * procinfov
Definition: structs.h:63
blackbox * getBlackboxStuff(const int t)
return the structure to the type given by t
Definition: blackbox.cc:16
intvec * MkInterRedNextWeight(intvec *iva, intvec *ivb, ideal G)
Definition: walk.cc:2579
ideal twostd(ideal I)
Compute two-sided GB:
Definition: nc.cc:21
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ jjVARIABLES_ID()

BOOLEAN jjVARIABLES_ID ( leftv  res,
leftv  u 
)

Definition at line 6222 of file ipshell.cc.

6223 {
6224  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6225  ideal I=(ideal)u->Data();
6226  int i;
6227  int n=0;
6228  for(i=I->nrows*I->ncols-1;i>=0;i--)
6229  {
6230  int n0=pGetVariables(I->m[i],e);
6231  if (n0>n) n=n0;
6232  }
6233  jjINT_S_TO_ID(n,e,res);
6234  return FALSE;
6235 }
#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:6192
#define pGetVariables(p, e)
Definition: polys.h:234
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
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 6214 of file ipshell.cc.

6215 {
6216  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6217  int n=pGetVariables((poly)u->Data(),e);
6218  jjINT_S_TO_ID(n,e,res);
6219  return FALSE;
6220 }
#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:6192
#define pGetVariables(p, e)
Definition: polys.h:234
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 * Data()
Definition: subexpr.cc:1137
polyrec * poly
Definition: hilb.h:10
#define omAlloc0(size)
Definition: omAllocDecl.h:211

◆ 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  {
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:474
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:473
#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
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

◆ kQHWeight()

BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3249 of file ipshell.cc.

3250 {
3251  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3252  if (res->data==NULL)
3253  res->data=(char *)new intvec(rVar(currRing));
3254  return FALSE;
3255 }
#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)
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
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3227 of file ipshell.cc.

3228 {
3229  ideal F=(ideal)id->Data();
3230  intvec * iv = new intvec(rVar(currRing));
3231  polyset s;
3232  int sl, n, i;
3233  int *x;
3234 
3235  res->data=(char *)iv;
3236  s = F->m;
3237  sl = IDELEMS(F) - 1;
3238  n = rVar(currRing);
3239  double wNsqr = (double)2.0 / (double)n;
3241  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3242  wCall(s, sl, x, wNsqr, currRing);
3243  for (i = n; i!=0; i--)
3244  (*iv)[i-1] = x[i + n + 1];
3245  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3246  return FALSE;
3247 }
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
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
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

◆ list_cmd()

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

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  {
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;
497  list_cmd(0,IDID(h),"// ",FALSE);
498  currPack=save_p;
499  }
500  }
501  h = IDNEXT(h);
502  }
503  currPack=savePack;
504 }
idhdl ggetid(const char *n)
Definition: ipid.cc:510
#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

◆ loNewtonP()

BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4489 of file ipshell.cc.

4490 {
4491  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4492  return FALSE;
4493 }
#define FALSE
Definition: auxiliary.h:94
ideal loNewtonPolytope(const ideal id)
Definition: mpr_base.cc:3190
poly res
Definition: myNF.cc:322
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 4495 of file ipshell.cc.

4496 {
4497  if ( !(rField_is_long_R(currRing)) )
4498  {
4499  WerrorS("Ground field not implemented!");
4500  return TRUE;
4501  }
4502 
4503  simplex * LP;
4504  matrix m;
4505 
4506  leftv v= args;
4507  if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4508  return TRUE;
4509  else
4510  m= (matrix)(v->CopyD());
4511 
4512  LP = new simplex(MATROWS(m),MATCOLS(m));
4513  LP->mapFromMatrix(m);
4514 
4515  v= v->next;
4516  if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4517  return TRUE;
4518  else
4519  LP->m= (int)(long)(v->Data());
4520 
4521  v= v->next;
4522  if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4523  return TRUE;
4524  else
4525  LP->n= (int)(long)(v->Data());
4526 
4527  v= v->next;
4528  if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4529  return TRUE;
4530  else
4531  LP->m1= (int)(long)(v->Data());
4532 
4533  v= v->next;
4534  if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4535  return TRUE;
4536  else
4537  LP->m2= (int)(long)(v->Data());
4538 
4539  v= v->next;
4540  if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4541  return TRUE;
4542  else
4543  LP->m3= (int)(long)(v->Data());
4544 
4545 #ifdef mprDEBUG_PROT
4546  Print("m (constraints) %d\n",LP->m);
4547  Print("n (columns) %d\n",LP->n);
4548  Print("m1 (<=) %d\n",LP->m1);
4549  Print("m2 (>=) %d\n",LP->m2);
4550  Print("m3 (==) %d\n",LP->m3);
4551 #endif
4552 
4553  LP->compute();
4554 
4555  lists lres= (lists)omAlloc( sizeof(slists) );
4556  lres->Init( 6 );
4557 
4558  lres->m[0].rtyp= MATRIX_CMD; // output matrix
4559  lres->m[0].data=(void*)LP->mapToMatrix(m);
4560 
4561  lres->m[1].rtyp= INT_CMD; // found a solution?
4562  lres->m[1].data=(void*)(long)LP->icase;
4563 
4564  lres->m[2].rtyp= INTVEC_CMD;
4565  lres->m[2].data=(void*)LP->posvToIV();
4566 
4567  lres->m[3].rtyp= INTVEC_CMD;
4568  lres->m[3].data=(void*)LP->zrovToIV();
4569 
4570  lres->m[4].rtyp= INT_CMD;
4571  lres->m[4].data=(void*)(long)LP->m;
4572 
4573  lres->m[5].rtyp= INT_CMD;
4574  lres->m[5].data=(void*)(long)LP->n;
4575 
4576  res->data= (void*)lres;
4577 
4578  return FALSE;
4579 }
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
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
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:88
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
intvec * posvToIV()
BOOLEAN mapFromMatrix(matrix m)
ip_smatrix * matrix
int m
Definition: cfEzgcd.cc:119
Variable next() const
Definition: factory.h:135
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:91
#define MATROWS(i)
Definition: matpol.h:27
int icase
Definition: mpr_numeric.h:201

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 2996 of file ipshell.cc.

2997 {
2998  int i,j;
2999  matrix result;
3000  ideal id=(ideal)a->Data();
3001 
3002  result =mpNew(IDELEMS(id),rVar(currRing));
3003  for (i=1; i<=IDELEMS(id); i++)
3004  {
3005  for (j=1; j<=rVar(currRing); j++)
3006  {
3007  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
3008  }
3009  }
3010  res->data=(char *)result;
3011  return FALSE;
3012 }
const poly a
Definition: syzextra.cc:212
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
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
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:44
#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 3018 of file ipshell.cc.

3019 {
3020  int n=(int)(long)b->Data();
3021  int d=(int)(long)c->Data();
3022  int k,l,sign,row,col;
3023  matrix result;
3024  ideal temp;
3025  BOOLEAN bo;
3026  poly p;
3027 
3028  if ((d>n) || (d<1) || (n<1))
3029  {
3030  res->data=(char *)mpNew(1,1);
3031  return FALSE;
3032  }
3033  int *choise = (int*)omAlloc(d*sizeof(int));
3034  if (id==NULL)
3035  temp=idMaxIdeal(1);
3036  else
3037  temp=(ideal)id->Data();
3038 
3039  k = binom(n,d);
3040  l = k*d;
3041  l /= n-d+1;
3042  result =mpNew(l,k);
3043  col = 1;
3044  idInitChoise(d,1,n,&bo,choise);
3045  while (!bo)
3046  {
3047  sign = 1;
3048  for (l=1;l<=d;l++)
3049  {
3050  if (choise[l-1]<=IDELEMS(temp))
3051  {
3052  p = pCopy(temp->m[choise[l-1]-1]);
3053  if (sign == -1) p = pNeg(p);
3054  sign *= -1;
3055  row = idGetNumberOfChoise(l-1,d,1,n,choise);
3056  MATELEM(result,row,col) = p;
3057  }
3058  }
3059  col++;
3060  idGetNextChoise(d,n,&bo,choise);
3061  }
3062  omFreeSize(choise,d*sizeof(int));
3063  if (id==NULL) idDelete(&temp);
3064 
3065  res->data=(char *)result;
3066  return FALSE;
3067 }
#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 omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define pNeg(p)
Definition: polys.h:181
int k
Definition: cfEzgcd.cc:93
#define omAlloc(size)
Definition: omAllocDecl.h:210
poly res
Definition: myNF.cc:322
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:44
#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
const poly b
Definition: syzextra.cc:213
static int sign(int x)
Definition: ring.cc:3342
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 4604 of file ipshell.cc.

4605 {
4606 
4607  poly gls;
4608  gls= (poly)(arg1->Data());
4609  int howclean= (int)(long)arg3->Data();
4610 
4611  if ( !(rField_is_R(currRing) ||
4612  rField_is_Q(currRing) ||
4615  {
4616  WerrorS("Ground field not implemented!");
4617  return TRUE;
4618  }
4619 
4622  {
4623  unsigned long int ii = (unsigned long int)arg2->Data();
4624  setGMPFloatDigits( ii, ii );
4625  }
4626 
4627  if ( gls == NULL || pIsConstant( gls ) )
4628  {
4629  WerrorS("Input polynomial is constant!");
4630  return TRUE;
4631  }
4632 
4633  int ldummy;
4634  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4635  int i,vpos=0;
4636  poly piter;
4637  lists elist;
4638  lists rlist;
4639 
4640  elist= (lists)omAlloc( sizeof(slists) );
4641  elist->Init( 0 );
4642 
4643  if ( rVar(currRing) > 1 )
4644  {
4645  piter= gls;
4646  for ( i= 1; i <= rVar(currRing); i++ )
4647  if ( pGetExp( piter, i ) )
4648  {
4649  vpos= i;
4650  break;
4651  }
4652  while ( piter )
4653  {
4654  for ( i= 1; i <= rVar(currRing); i++ )
4655  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4656  {
4657  WerrorS("The input polynomial must be univariate!");
4658  return TRUE;
4659  }
4660  pIter( piter );
4661  }
4662  }
4663 
4664  rootContainer * roots= new rootContainer();
4665  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4666  piter= gls;
4667  for ( i= deg; i >= 0; i-- )
4668  {
4669  if ( piter && pTotaldegree(piter) == i )
4670  {
4671  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4672  //nPrint( pcoeffs[i] );PrintS(" ");
4673  pIter( piter );
4674  }
4675  else
4676  {
4677  pcoeffs[i]= nInit(0);
4678  }
4679  }
4680 
4681 #ifdef mprDEBUG_PROT
4682  for (i=deg; i >= 0; i--)
4683  {
4684  nPrint( pcoeffs[i] );PrintS(" ");
4685  }
4686  PrintLn();
4687 #endif
4688 
4689  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4690  roots->solver( howclean );
4691 
4692  int elem= roots->getAnzRoots();
4693  char *dummy;
4694  int j;
4695 
4696  rlist= (lists)omAlloc( sizeof(slists) );
4697  rlist->Init( elem );
4698 
4700  {
4701  for ( j= 0; j < elem; j++ )
4702  {
4703  rlist->m[j].rtyp=NUMBER_CMD;
4704  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4705  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4706  }
4707  }
4708  else
4709  {
4710  for ( j= 0; j < elem; j++ )
4711  {
4712  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4713  rlist->m[j].rtyp=STRING_CMD;
4714  rlist->m[j].data=(void *)dummy;
4715  }
4716  }
4717 
4718  elist->Clean();
4719  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4720 
4721  // this is (via fillContainer) the same data as in root
4722  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4723  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4724 
4725  delete roots;
4726 
4727  res->rtyp= LIST_CMD;
4728  res->data= (void*)rlist;
4729 
4730  return FALSE;
4731 }
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:88
#define pIter(p)
Definition: monomials.h:44
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
#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:91
#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 4581 of file ipshell.cc.

4582 {
4583  ideal gls = (ideal)(arg1->Data());
4584  int imtype= (int)(long)arg2->Data();
4585 
4586  uResultant::resMatType mtype= determineMType( imtype );
4587 
4588  // check input ideal ( = polynomial system )
4589  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4590  {
4591  return TRUE;
4592  }
4593 
4594  uResultant *resMat= new uResultant( gls, mtype, false );
4595  if (resMat!=NULL)
4596  {
4597  res->rtyp = MODUL_CMD;
4598  res->data= (void*)resMat->accessResMat()->getMatrix();
4599  if (!errorreported) delete resMat;
4600  }
4601  return errorreported;
4602 }
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:120
Definition: mpr_base.h:98
poly res
Definition: myNF.cc:322
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
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 4834 of file ipshell.cc.

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

4734 {
4735  int i;
4736  ideal p,w;
4737  p= (ideal)arg1->Data();
4738  w= (ideal)arg2->Data();
4739 
4740  // w[0] = f(p^0)
4741  // w[1] = f(p^1)
4742  // ...
4743  // p can be a vector of numbers (multivariate polynom)
4744  // or one number (univariate polynom)
4745  // tdg = deg(f)
4746 
4747  int n= IDELEMS( p );
4748  int m= IDELEMS( w );
4749  int tdg= (int)(long)arg3->Data();
4750 
4751  res->data= (void*)NULL;
4752 
4753  // check the input
4754  if ( tdg < 1 )
4755  {
4756  WerrorS("Last input parameter must be > 0!");
4757  return TRUE;
4758  }
4759  if ( n != rVar(currRing) )
4760  {
4761  Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
4762  return TRUE;
4763  }
4764  if ( m != (int)pow((double)tdg+1,(double)n) )
4765  {
4766  Werror("Size of second input ideal must be equal to %d!",
4767  (int)pow((double)tdg+1,(double)n));
4768  return TRUE;
4769  }
4770  if ( !(rField_is_Q(currRing) /* ||
4771  rField_is_R() || rField_is_long_R() ||
4772  rField_is_long_C()*/ ) )
4773  {
4774  WerrorS("Ground field not implemented!");
4775  return TRUE;
4776  }
4777 
4778  number tmp;
4779  number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
4780  for ( i= 0; i < n; i++ )
4781  {
4782  pevpoint[i]=nInit(0);
4783  if ( (p->m)[i] )
4784  {
4785  tmp = pGetCoeff( (p->m)[i] );
4786  if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
4787  {
4788  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4789  WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
4790  return TRUE;
4791  }
4792  } else tmp= NULL;
4793  if ( !nIsZero(tmp) )
4794  {
4795  if ( !pIsConstant((p->m)[i]))
4796  {
4797  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4798  WerrorS("Elements of first input ideal must be numbers!");
4799  return TRUE;
4800  }
4801  pevpoint[i]= nCopy( tmp );
4802  }
4803  }
4804 
4805  number *wresults= (number *)omAlloc( m * sizeof( number ) );
4806  for ( i= 0; i < m; i++ )
4807  {
4808  wresults[i]= nInit(0);
4809  if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
4810  {
4811  if ( !pIsConstant((w->m)[i]))
4812  {
4813  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4814  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4815  WerrorS("Elements of second input ideal must be numbers!");
4816  return TRUE;
4817  }
4818  wresults[i]= nCopy(pGetCoeff((w->m)[i]));
4819  }
4820  }
4821 
4822  vandermonde vm( m, n, tdg, pevpoint, FALSE );
4823  number *ncpoly= vm.interpolateDense( wresults );
4824  // do not free ncpoly[]!!
4825  poly rpoly= vm.numvec2poly( ncpoly );
4826 
4827  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4828  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4829 
4830  res->data= (void*)rpoly;
4831  return FALSE;
4832 }
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
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
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 6237 of file ipshell.cc.

6238 {
6239  Print(" %s (",n);
6240  switch (p->language)
6241  {
6242  case LANG_SINGULAR: PrintS("S"); break;
6243  case LANG_C: PrintS("C"); break;
6244  case LANG_TOP: PrintS("T"); break;
6245  case LANG_NONE: PrintS("N"); break;
6246  default: PrintS("U");
6247  }
6248  if(p->libname!=NULL)
6249  Print(",%s", p->libname);
6250  PrintS(")");
6251 }
#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

◆ 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)
2158  || (r->order[i] == ringorder_s)) //|| r->order[i] == ringorder_S)
2159  {
2160  assume( r->block0[i] == r->block1[i] );
2161  const int s = r->block0[i];
2162  assume( (-2 < s && s < 2)||(r->order[i] != ringorder_IS));
2163 
2164  iv=new intvec(1);
2165  (*iv)[0] = s;
2166  }
2167  else if (r->block1[i]-r->block0[i] >=0 )
2168  {
2169  int bl=j=r->block1[i]-r->block0[i];
2170  if (r->order[i]==ringorder_M)
2171  {
2172  j=(j+1)*(j+1)-1;
2173  bl=j+1;
2174  }
2175  else if (r->order[i]==ringorder_am)
2176  {
2177  j+=r->wvhdl[i][bl+1];
2178  }
2179  iv=new intvec(j+1);
2180  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2181  {
2182  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2183  }
2184  else switch (r->order[i])
2185  {
2186  case ringorder_dp:
2187  case ringorder_Dp:
2188  case ringorder_ds:
2189  case ringorder_Ds:
2190  case ringorder_lp:
2191  for(;j>=0; j--) (*iv)[j]=1;
2192  break;
2193  default: /* do nothing */;
2194  }
2195  }
2196  else
2197  {
2198  iv=new intvec(1);
2199  }
2200  LLL->m[1].rtyp=INTVEC_CMD;
2201  LLL->m[1].data=(void *)iv;
2202  LL->m[i].data=(void *)LLL;
2203  }
2204  L->m[2].rtyp=LIST_CMD;
2205  L->m[2].data=(void *)LL;
2206  // ----------------------------------------
2207  // 3: qideal
2208  L->m[3].rtyp=IDEAL_CMD;
2209  if (r->qideal==NULL)
2210  L->m[3].data=(void *)idInit(1,1);
2211  else
2212  L->m[3].data=(void *)idCopy(r->qideal);
2213  // ----------------------------------------
2214 #ifdef HAVE_PLURAL // NC! in rDecompose
2215  if (rIsPluralRing(r))
2216  {
2217  L->m[4].rtyp=MATRIX_CMD;
2218  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2219  L->m[5].rtyp=MATRIX_CMD;
2220  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2221  }
2222 #endif
2223  return L;
2224 }
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:88
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:91
Definition: tok.h:117
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:71
omBin slists_bin
Definition: lists.cc:23
s?
Definition: ring.h:84
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  {
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:88
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1620
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
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:91
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:88
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:91
Definition: tok.h:117
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:71
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:82
{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:3365
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:5038
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:6129
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
#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

◆ rInit()

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

Definition at line 5524 of file ipshell.cc.

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

Definition at line 6103 of file ipshell.cc.

6104 {
6105  ring r = IDRING(h);
6106  int ref=0;
6107  if (r!=NULL)
6108  {
6109  // avoid, that sLastPrinted is the last reference to the base ring:
6110  // clean up before killing the last "named" refrence:
6111  if ((sLastPrinted.rtyp==RING_CMD)
6112  && (sLastPrinted.data==(void*)r))
6113  {
6115  }
6116  ref=r->ref;
6117  rKill(r);
6118  }
6119  if (h==currRingHdl)
6120  {
6121  if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6122  else
6123  {
6125  }
6126  }
6127 }
void * data
Definition: subexpr.h:88
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:6057
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:91
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
static Poly * h
Definition: janet.cc:978

◆ rKill() [2/2]

void rKill ( ring  r)

Definition at line 6057 of file ipshell.cc.

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

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5038 of file ipshell.cc.

5039 {
5040  ring rg = NULL;
5041  if (h!=NULL)
5042  {
5043 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5044  rg = IDRING(h);
5045  if (rg==NULL) return; //id <>NULL, ring==NULL
5046  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5047  if (IDID(h)) // OB: ????
5049  rTest(rg);
5050  }
5051 
5052  // clean up history
5054  {
5056  memset(&sLastPrinted,0,sizeof(sleftv));
5057  }
5058 
5059  if ((rg!=currRing)&&(currRing!=NULL))
5060  {
5062  if (DENOMINATOR_LIST!=NULL)
5063  {
5064  if (TEST_V_ALLWARN)
5065  Warn("deleting denom_list for ring change to %s",IDID(h));
5066  do
5067  {
5068  n_Delete(&(dd->n),currRing->cf);
5069  dd=dd->next;
5071  DENOMINATOR_LIST=dd;
5072  } while(DENOMINATOR_LIST!=NULL);
5073  }
5074  }
5075 
5076  // test for valid "currRing":
5077  if ((rg!=NULL) && (rg->idroot==NULL))
5078  {
5079  ring old=rg;
5080  rg=rAssure_HasComp(rg);
5081  if (old!=rg)
5082  {
5083  rKill(old);
5084  IDRING(h)=rg;
5085  }
5086  }
5087  /*------------ change the global ring -----------------------*/
5088  rChangeCurrRing(rg);
5089  currRingHdl = h;
5090 }
#define omCheckAddrSize(addr, size)
Definition: omAllocDecl.h:327
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#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:4557
Definition: idrec.h:34
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
BOOLEAN RingDependend()
Definition: subexpr.cc:402
void rKill(ring r)
Definition: ipshell.cc:6057
#define omFree(addr)
Definition: omAllocDecl.h:261
#define rTest(r)
Definition: ring.h:777
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:59
#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 = NULL 
)

Definition at line 6129 of file ipshell.cc.

6130 {
6131  idhdl h=root;
6132  while (h!=NULL)
6133  {
6134  if ((IDTYP(h)==RING_CMD)
6135  && (h!=n)
6136  && (IDRING(h)==r)
6137  )
6138  {
6139  return h;
6140  }
6141  h=IDNEXT(h);
6142  }
6143  return NULL;
6144 }
#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

◆ 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
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 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
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
slists * lists
Definition: mpr_numeric.h:146
monf radmem
Definition: hutil.cc:24
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  ,
leftv  ,
leftv   
)

Definition at line 4477 of file ipshell.cc.

4478 {
4479  sleftv tmp;
4480  memset(&tmp,0,sizeof(tmp));
4481  tmp.rtyp=INT_CMD;
4482  /* tmp.data = (void *)0; -- done by memset */
4483 
4484  return semicProc3(res,u,v,&tmp);
4485 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: tok.h:95
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4437
poly res
Definition: myNF.cc:322
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
int rtyp
Definition: subexpr.h:91

◆ semicProc3()

BOOLEAN semicProc3 ( leftv  ,
leftv  ,
leftv  ,
leftv   
)

Definition at line 4437 of file ipshell.cc.

4438 {
4439  semicState state;
4440  BOOLEAN qh=(((int)(long)w->Data())==1);
4441 
4442  // -----------------
4443  // check arguments
4444  // -----------------
4445 
4446  lists l1 = (lists)u->Data( );
4447  lists l2 = (lists)v->Data( );
4448 
4449  if( (state=list_is_spectrum( l1 ))!=semicOK )
4450  {
4451  WerrorS( "first argument is not a spectrum" );
4452  list_error( state );
4453  }
4454  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4455  {
4456  WerrorS( "second argument is not a spectrum" );
4457  list_error( state );
4458  }
4459  else
4460  {
4461  spectrum s1= spectrumFromList( l1 );
4462  spectrum s2= spectrumFromList( l2 );
4463 
4464  res->rtyp = INT_CMD;
4465  if (qh)
4466  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4467  else
4468  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4469  }
4470 
4471  // -----------------
4472  // check status
4473  // -----------------
4474 
4475  return (state!=semicOK);
4476 }
Definition: tok.h:95
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3310
void list_error(semicState state)
Definition: ipshell.cc:3394
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
poly res
Definition: myNF.cc:322
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4179
int mult_spectrumh(spectrum &)
Definition: semic.cc:425
semicState
Definition: ipshell.cc:3360
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
slists * lists
Definition: mpr_numeric.h:146
const CanonicalForm & w
Definition: facAbsFact.cc:55
int BOOLEAN
Definition: auxiliary.h:85
int mult_spectrum(spectrum &)
Definition: semic.cc:396

◆ setOption()

BOOLEAN setOption ( leftv  res,
leftv  v 
)

Definition at line 575 of file misc_ip.cc.

576 {
577  const char *n;
578  do
579  {
580  if (v->Typ()==STRING_CMD)
581  {
582  n=(const char *)v->CopyD(STRING_CMD);
583  }
584  else
585  {
586  if (v->name==NULL)
587  return TRUE;
588  if (v->rtyp==0)
589  {
590  n=v->name;
591  v->name=NULL;
592  }
593  else
594  {
595  n=omStrDup(v->name);
596  }
597  }
598 
599  int i;
600 
601  if(strcmp(n,"get")==0)
602  {
603  intvec *w=new intvec(2);
604  (*w)[0]=si_opt_1;
605  (*w)[1]=si_opt_2;
606  res->rtyp=INTVEC_CMD;
607  res->data=(void *)w;
608  goto okay;
609  }
610  if(strcmp(n,"set")==0)
611  {
612  if((v->next!=NULL)
613  &&(v->next->Typ()==INTVEC_CMD))
614  {
615  v=v->next;
616  intvec *w=(intvec*)v->Data();
617  si_opt_1=(*w)[0];
618  si_opt_2=(*w)[1];
619 #if 0
623  ) {
625  }
626 #endif
627  goto okay;
628  }
629  }
630  if(strcmp(n,"none")==0)
631  {
632  si_opt_1=0;
633  si_opt_2=0;
634  goto okay;
635  }
636  for (i=0; (i==0) || (optionStruct[i-1].setval!=0); i++)
637  {
638  if (strcmp(n,optionStruct[i].name)==0)
639  {
640  if (optionStruct[i].setval & validOpts)
641  {
643  // optOldStd disables redthrough
644  if (optionStruct[i].setval == Sy_bit(OPT_OLDSTD))
646  }
647  else
648  Warn("cannot set option");
649 #if 0
653  ) {
655  }
656 #endif
657  goto okay;
658  }
659  else if ((strncmp(n,"no",2)==0)
660  && (strcmp(n+2,optionStruct[i].name)==0))
661  {
662  if (optionStruct[i].setval & validOpts)
663  {
665  }
666  else
667  Warn("cannot clear option");
668  goto okay;
669  }
670  }
671  for (i=0; (i==0) || (verboseStruct[i-1].setval!=0); i++)
672  {
673  if (strcmp(n,verboseStruct[i].name)==0)
674  {
676  #ifdef YYDEBUG
677  #if YYDEBUG
678  /*debugging the bison grammar --> grammar.cc*/
679  extern int yydebug;
680  if (BVERBOSE(V_YACC)) yydebug=1;
681  else yydebug=0;
682  #endif
683  #endif
684  goto okay;
685  }
686  else if ((strncmp(n,"no",2)==0)
687  && (strcmp(n+2,verboseStruct[i].name)==0))
688  {
690  #ifdef YYDEBUG
691  #if YYDEBUG
692  /*debugging the bison grammar --> grammar.cc*/
693  extern int yydebug;
694  if (BVERBOSE(V_YACC)) yydebug=1;
695  else yydebug=0;
696  #endif
697  #endif
698  goto okay;
699  }
700  }
701  Werror("unknown option `%s`",n);
702  okay:
703  if (currRing != NULL)
704  currRing->options = si_opt_1 & TEST_RINGDEP_OPTS;
705  omFree((ADDRESS)n);
706  v=v->next;
707  } while (v!=NULL);
708 
709  // set global variable to show memory usage
710  extern int om_sing_opt_show_mem;
711  if (BVERBOSE(V_SHOW_MEM)) om_sing_opt_show_mem = 1;
712  else om_sing_opt_show_mem = 0;
713 
714  return FALSE;
715 }
unsigned si_opt_1
Definition: options.c:5
#define FALSE
Definition: auxiliary.h:94
const struct soptionStruct optionStruct[]
Definition: misc_ip.cc:516
#define OPT_OLDSTD
Definition: options.h:81
#define TRUE
Definition: auxiliary.h:98
void * ADDRESS
Definition: auxiliary.h:115
unsigned setval
Definition: ipid.h:152
unsigned resetval
Definition: ipid.h:153
#define Sy_bit(x)
Definition: options.h:30
BITSET validOpts
Definition: kstd1.cc:63
static BOOLEAN rField_has_simple_inverse(const ring r)
Definition: ring.h:540
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
#define V_SHOW_MEM
Definition: options.h:41
#define TEST_OPT_INTSTRATEGY
Definition: options.h:105
Definition: intvec.h:14
#define omFree(addr)
Definition: omAllocDecl.h:261
int i
Definition: cfEzgcd.cc:123
const struct soptionStruct verboseStruct[]
Definition: misc_ip.cc:546
char name(const Variable &v)
Definition: factory.h:178
Variable next() const
Definition: factory.h:135
char name() const
Definition: variable.cc:122
#define OPT_INTSTRATEGY
Definition: options.h:87
#define BVERBOSE(a)
Definition: options.h:33
CanonicalForm test
Definition: cfModGcd.cc:4037
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define V_YACC
Definition: options.h:42
static BOOLEAN rField_is_Ring(const ring r)
Definition: ring.h:477
#define NULL
Definition: omList.c:10
int yydebug
Definition: grammar.cc:1795
const CanonicalForm & w
Definition: facAbsFact.cc:55
#define OPT_REDTHROUGH
Definition: options.h:77
#define TEST_RINGDEP_OPTS
Definition: options.h:95
unsigned si_opt_2
Definition: options.c:6
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ showOption()

char* showOption ( )

Definition at line 717 of file misc_ip.cc.

718 {
719  int i;
720  BITSET tmp;
721 
722  StringSetS("//options:");
723  if ((si_opt_1!=0)||(si_opt_2!=0))
724  {
725  tmp=si_opt_1;
726  if(tmp)
727  {
728  for (i=0; optionStruct[i].setval!=0; i++)
729  {
730  if (optionStruct[i].setval & tmp)
731  {
733  tmp &=optionStruct[i].resetval;
734  }
735  }
736  for (i=0; i<32; i++)
737  {
738  if (tmp & Sy_bit(i)) StringAppend(" %d",i);
739  }
740  }
741  tmp=si_opt_2;
742  if (tmp)
743  {
744  for (i=0; verboseStruct[i].setval!=0; i++)
745  {
746  if (verboseStruct[i].setval & tmp)
747  {
749  tmp &=verboseStruct[i].resetval;
750  }
751  }
752  for (i=1; i<32; i++)
753  {
754  if (tmp & Sy_bit(i)) StringAppend(" %d",i+32);
755  }
756  }
757  return StringEndS();
758  }
759  StringAppendS(" none");
760  return StringEndS();
761 }
unsigned si_opt_1
Definition: options.c:5
const struct soptionStruct optionStruct[]
Definition: misc_ip.cc:516
unsigned setval
Definition: ipid.h:152
unsigned resetval
Definition: ipid.h:153
char * StringEndS()
Definition: reporter.cc:151
#define BITSET
Definition: structs.h:18
#define Sy_bit(x)
Definition: options.h:30
void StringSetS(const char *st)
Definition: reporter.cc:128
void StringAppendS(const char *st)
Definition: reporter.cc:107
#define StringAppend
Definition: emacs.cc:82
int i
Definition: cfEzgcd.cc:123
const struct soptionStruct verboseStruct[]
Definition: misc_ip.cc:546
char name(const Variable &v)
Definition: factory.h:178
unsigned si_opt_2
Definition: options.c:6

◆ singular_example()

void singular_example ( char *  str)

Definition at line 439 of file misc_ip.cc.

440 {
441  assume(str!=NULL);
442  char *s=str;
443  while (*s==' ') s++;
444  char *ss=s;
445  while (*ss!='\0') ss++;
446  while (*ss<=' ')
447  {
448  *ss='\0';
449  ss--;
450  }
451  idhdl h=IDROOT->get(s,myynest);
452  if ((h!=NULL) && (IDTYP(h)==PROC_CMD))
453  {
454  char *lib=iiGetLibName(IDPROC(h));
455  if((lib!=NULL)&&(*lib!='\0'))
456  {
457  Print("// proc %s from lib %s\n",s,lib);
459  if (s!=NULL)
460  {
461  if (strlen(s)>5)
462  {
463  iiEStart(s,IDPROC(h));
464  omFree((ADDRESS)s);
465  return;
466  }
467  else omFree((ADDRESS)s);
468  }
469  }
470  }
471  else
472  {
473  char sing_file[MAXPATHLEN];
474  FILE *fd=NULL;
475  char *res_m=feResource('m', 0);
476  if (res_m!=NULL)
477  {
478  sprintf(sing_file, "%s/%s.sing", res_m, s);
479  fd = feFopen(sing_file, "r");
480  }
481  if (fd != NULL)
482  {
483 
484  int old_echo = si_echo;
485  int length, got;
486  char* s;
487 
488  fseek(fd, 0, SEEK_END);
489  length = ftell(fd);
490  fseek(fd, 0, SEEK_SET);
491  s = (char*) omAlloc((length+20)*sizeof(char));
492  got = fread(s, sizeof(char), length, fd);
493  fclose(fd);
494  if (got != length)
495  {
496  Werror("Error while reading file %s", sing_file);
497  }
498  else
499  {
500  s[length] = '\0';
501  strcat(s, "\n;return();\n\n");
502  si_echo = 2;
503  iiEStart(s, NULL);
504  si_echo = old_echo;
505  }
506  omFree(s);
507  }
508  else
509  {
510  Werror("no example for %s", str);
511  }
512  }
513 }
int status int fd
Definition: si_signals.h:59
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define MAXPATHLEN
Definition: omRet2Info.c:22
#define Print
Definition: emacs.cc:83
static char * feResource(feResourceConfig config, int warn)
Definition: feResource.cc:258
#define IDROOT
Definition: ipid.h:20
void * ADDRESS
Definition: auxiliary.h:115
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: idrec.h:34
int myynest
Definition: febase.cc:46
#define IDTYP(a)
Definition: ipid.h:116
#define omFree(addr)
Definition: omAllocDecl.h:261
#define assume(x)
Definition: mod2.h:394
FILE * feFopen(const char *path, const char *mode, char *where, short useWerror, short path_only)
Definition: feFopen.cc:47
BOOLEAN iiEStart(char *example, procinfo *pi)
Definition: iplib.cc:717
#define IDPROC(a)
Definition: ipid.h:137
#define SEEK_END
Definition: mod2.h:110
#define NULL
Definition: omList.c:10
char * iiGetLibName(procinfov pi)
Definition: iplib.cc:101
#define SEEK_SET
Definition: mod2.h:114
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:210
static Poly * h
Definition: janet.cc:978
void Werror(const char *fmt,...)
Definition: reporter.cc:189
int si_echo
Definition: febase.cc:41

◆ singular_system()

leftv singular_system ( sleftv  h)

◆ spaddProc()

BOOLEAN spaddProc ( leftv  ,
leftv  ,
leftv   
)

Definition at line 4354 of file ipshell.cc.

4355 {
4356  semicState state;
4357 
4358  // -----------------
4359  // check arguments
4360  // -----------------
4361 
4362  lists l1 = (lists)first->Data( );
4363  lists l2 = (lists)second->Data( );
4364 
4365  if( (state=list_is_spectrum( l1 )) != semicOK )
4366  {
4367  WerrorS( "first argument is not a spectrum:" );
4368  list_error( state );
4369  }
4370  else if( (state=list_is_spectrum( l2 )) != semicOK )
4371  {
4372  WerrorS( "second argument is not a spectrum:" );
4373  list_error( state );
4374  }
4375  else
4376  {
4377  spectrum s1= spectrumFromList ( l1 );
4378  spectrum s2= spectrumFromList ( l2 );
4379  spectrum sum( s1+s2 );
4380 
4381  result->rtyp = LIST_CMD;
4382  result->data = (char*)(getList(sum));
4383  }
4384 
4385  return (state!=semicOK);
4386 }
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3310
void list_error(semicState state)
Definition: ipshell.cc:3394
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
lists getList(spectrum &spec)
Definition: ipshell.cc:3322
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4179
semicState
Definition: ipshell.cc:3360
slists * lists
Definition: mpr_numeric.h:146
Definition: tok.h:117
return result
Definition: facAbsBiFact.cc:76

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv  ,
leftv   
)

Definition at line 4110 of file ipshell.cc.

4111 {
4112  spectrumState state = spectrumOK;
4113 
4114  // -------------------
4115  // check consistency
4116  // -------------------
4117 
4118  // check for a local polynomial ring
4119 
4120  if( currRing->OrdSgn != -1 )
4121  // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4122  // or should we use:
4123  //if( !ringIsLocal( ) )
4124  {
4125  WerrorS( "only works for local orderings" );
4126  state = spectrumWrongRing;
4127  }
4128  else if( currRing->qideal != NULL )
4129  {
4130  WerrorS( "does not work in quotient rings" );
4131  state = spectrumWrongRing;
4132  }
4133  else
4134  {
4135  lists L = (lists)NULL;
4136  int flag = 2; // symmetric optimization
4137 
4138  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4139 
4140  if( state==spectrumOK )
4141  {
4142  result->rtyp = LIST_CMD;
4143  result->data = (char*)L;
4144  }
4145  else
4146  {
4147  spectrumPrintError(state);
4148  }
4149  }
4150 
4151  return (state!=spectrumOK);
4152 }
spectrumState
Definition: ipshell.cc:3476
Definition: lists.h:22
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
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:4028
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3736
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
Definition: tok.h:117
polyrec * poly
Definition: hilb.h:10
return result
Definition: facAbsBiFact.cc:76

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  ,
leftv   
)

Definition at line 4059 of file ipshell.cc.

4060 {
4061  spectrumState state = spectrumOK;
4062 
4063  // -------------------
4064  // check consistency
4065  // -------------------
4066 
4067  // check for a local ring
4068 
4069  if( !ringIsLocal(currRing ) )
4070  {
4071  WerrorS( "only works for local orderings" );
4072  state = spectrumWrongRing;
4073  }
4074 
4075  // no quotient rings are allowed
4076 
4077  else if( currRing->qideal != NULL )
4078  {
4079  WerrorS( "does not work in quotient rings" );
4080  state = spectrumWrongRing;
4081  }
4082  else
4083  {
4084  lists L = (lists)NULL;
4085  int flag = 1; // weight corner optimization is safe
4086 
4087  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4088 
4089  if( state==spectrumOK )
4090  {
4091  result->rtyp = LIST_CMD;
4092  result->data = (char*)L;
4093  }
4094  else
4095  {
4096  spectrumPrintError(state);
4097  }
4098  }
4099 
4100  return (state!=spectrumOK);
4101 }
spectrumState
Definition: ipshell.cc:3476
Definition: lists.h:22
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
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:4028
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3736
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
Definition: tok.h:117
BOOLEAN ringIsLocal(const ring r)
Definition: spectrum.cc:461
polyrec * poly
Definition: hilb.h:10
return result
Definition: facAbsBiFact.cc:76

◆ spmulProc()

BOOLEAN spmulProc ( leftv  ,
leftv  ,
leftv   
)

Definition at line 4396 of file ipshell.cc.

4397 {
4398  semicState state;
4399 
4400  // -----------------
4401  // check arguments
4402  // -----------------
4403 
4404  lists l = (lists)first->Data( );
4405  int k = (int)(long)second->Data( );
4406 
4407  if( (state=list_is_spectrum( l ))!=semicOK )
4408  {
4409  WerrorS( "first argument is not a spectrum" );
4410  list_error( state );
4411  }
4412  else if( k < 0 )
4413  {
4414  WerrorS( "second argument should be positive" );
4415  state = semicMulNegative;
4416  }
4417  else
4418  {
4420  spectrum product( k*s );
4421 
4422  result->rtyp = LIST_CMD;
4423  result->data = (char*)getList(product);
4424  }
4425 
4426  return (state!=semicOK);
4427 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3310
void list_error(semicState state)
Definition: ipshell.cc:3394
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:3322
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4179
semicState
Definition: ipshell.cc:3360
slists * lists
Definition: mpr_numeric.h:146
Definition: tok.h:117
return result
Definition: facAbsBiFact.cc:76
int l
Definition: cfEzgcd.cc:94

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3097 of file ipshell.cc.

3098 {
3099  sleftv tmp;
3100  memset(&tmp,0,sizeof(tmp));
3101  tmp.rtyp=INT_CMD;
3102  tmp.data=(void *)1;
3103  return syBetti2(res,u,&tmp);
3104 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: tok.h:95
void * data
Definition: subexpr.h:88
poly res
Definition: myNF.cc:322
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3074
int rtyp
Definition: subexpr.h:91

◆ syBetti2()

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

Definition at line 3074 of file ipshell.cc.

3075 {
3076  syStrategy syzstr=(syStrategy)u->Data();
3077 
3078  BOOLEAN minim=(int)(long)w->Data();
3079  int row_shift=0;
3080  int add_row_shift=0;
3081  intvec *weights=NULL;
3082  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3083  if (ww!=NULL)
3084  {
3085  weights=ivCopy(ww);
3086  add_row_shift = ww->min_in();
3087  (*weights) -= add_row_shift;
3088  }
3089 
3090  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3091  //row_shift += add_row_shift;
3092  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3093  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3094 
3095  return FALSE;
3096 }
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
poly res
Definition: myNF.cc:322
Definition: intvec.h:14
void atSet(idhdl root, char *name, void *data, int typ)
Definition: attrib.cc:158
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:137
#define NULL
Definition: omList.c:10
intvec * syBettiOfComputation(syStrategy syzstr, BOOLEAN minim=TRUE, int *row_shift=NULL, intvec *weights=NULL)
Definition: syz1.cc:1763
const CanonicalForm & w
Definition: facAbsFact.cc:55
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 3182 of file ipshell.cc.

3183 {
3184  int typ0;
3186 
3187  resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3188  if (fr != NULL)
3189  {
3190 
3191  result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3192  for (int i=result->length-1;i>=0;i--)
3193  {
3194  if (fr[i]!=NULL)
3195  result->fullres[i] = idCopy(fr[i]);
3196  }
3197  result->list_length=result->length;
3198  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3199  }
3200  else
3201  {
3202  omFreeSize(result, sizeof(ssyStrategy));
3203  result = NULL;
3204  }
3205  return result;
3206 }
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
#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

◆ syConvRes()

lists syConvRes ( syStrategy  syzstr,
BOOLEAN  toDel = FALSE,
int  add_row_shift = 0 
)

Definition at line 3109 of file ipshell.cc.

3110 {
3111  resolvente fullres = syzstr->fullres;
3112  resolvente minres = syzstr->minres;
3113 
3114  const int length = syzstr->length;
3115 
3116  if ((fullres==NULL) && (minres==NULL))
3117  {
3118  if (syzstr->hilb_coeffs==NULL)
3119  { // La Scala
3120  fullres = syReorder(syzstr->res, length, syzstr);
3121  }
3122  else
3123  { // HRES
3124  minres = syReorder(syzstr->orderedRes, length, syzstr);
3125  syKillEmptyEntres(minres, length);
3126  }
3127  }
3128 
3129  resolvente tr;
3130  int typ0=IDEAL_CMD;
3131 
3132  if (minres!=NULL)
3133  tr = minres;
3134  else
3135  tr = fullres;
3136 
3137  resolvente trueres=NULL; intvec ** w=NULL;
3138 
3139  if (length>0)
3140  {
3141  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3142  for (int i=(length)-1;i>=0;i--)
3143  {
3144  if (tr[i]!=NULL)
3145  {
3146  trueres[i] = idCopy(tr[i]);
3147  }
3148  }
3149  if ( id_RankFreeModule(trueres[0], currRing) > 0)
3150  typ0 = MODUL_CMD;
3151  if (syzstr->weights!=NULL)
3152  {
3153  w = (intvec**)omAlloc0(length*sizeof(intvec*));
3154  for (int i=length-1;i>=0;i--)
3155  {
3156  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3157  }
3158  }
3159  }
3160 
3161  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3162  w, add_row_shift);
3163 
3164  if (w != NULL) omFreeSize(w, length*sizeof(intvec*));
3165 
3166  if (toDel)
3167  syKillComputation(syzstr);
3168  else
3169  {
3170  if( fullres != NULL && syzstr->fullres == NULL )
3171  syzstr->fullres = fullres;
3172 
3173  if( minres != NULL && syzstr->minres == NULL )
3174  syzstr->minres = minres;
3175  }
3176  return li;
3177 }
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 3211 of file ipshell.cc.

3212 {
3213  int typ0;
3215 
3216  resolvente fr = liFindRes(li,&(result->length),&typ0);
3217  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3218  for (int i=result->length-1;i>=0;i--)
3219  {
3220  if (fr[i]!=NULL)
3221  result->minres[i] = idCopy(fr[i]);
3222  }
3223  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3224  return result;
3225 }
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
#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

◆ Tok2Cmdname()

const char* Tok2Cmdname ( int  i)

Definition at line 132 of file gentable.cc.

133 {
134  if (tok < 0)
135  {
136  return cmds[0].name;
137  }
138  if (tok==COMMAND) return "command";
139  if (tok==ANY_TYPE) return "any_type";
140  if (tok==NONE) return "nothing";
141  //if (tok==IFBREAK) return "if_break";
142  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
143  //if (tok==ORDER_VECTOR) return "ordering";
144  //if (tok==REF_VAR) return "ref";
145  //if (tok==OBJECT) return "object";
146  //if (tok==PRINT_EXPR) return "print_expr";
147  if (tok==IDHDL) return "identifier";
148  // we do not blackbox objects during table generation:
149  //if (tok>MAX_TOK) return getBlackboxName(tok);
150  int i = 0;
151  while (cmds[i].tokval!=0)
152  {
153  if ((cmds[i].tokval == tok)&&(cmds[i].alias==0))
154  {
155  return cmds[i].name;
156  }
157  i++;
158  }
159  i=0;// try again for old/alias names:
160  while (cmds[i].tokval!=0)
161  {
162  if (cmds[i].tokval == tok)
163  {
164  return cmds[i].name;
165  }
166  i++;
167  }
168  #if 0
169  char *s=(char*)malloc(10);
170  sprintf(s,"(%d)",tok);
171  return s;
172  #else
173  return cmds[0].name;
174  #endif
175 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define ANY_TYPE
Definition: tok.h:30
#define IDHDL
Definition: tok.h:31
void * malloc(size_t size)
Definition: omalloc.c:92
int i
Definition: cfEzgcd.cc:123
cmdnames cmds[]
Definition: table.h:904
#define NONE
Definition: tok.h:216
#define COMMAND
Definition: tok.h:29

◆ 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
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
Definition: intvec.h:14
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define MATCOLS(i)
Definition: matpol.h:28
#define NULL
Definition: omList.c:10
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:132
Definition: tok.h:117
#define MATROWS(i)
Definition: matpol.h:27
int BOOLEAN
Definition: auxiliary.h:85

◆ versionString()

char* versionString ( )

Definition at line 778 of file misc_ip.cc.

779 {
780  StringSetS("");
781  StringAppend("Singular for %s version %s (%d, %d bit) %s #%s",
782  S_UNAME, VERSION, // SINGULAR_VERSION,
783  SINGULAR_VERSION, sizeof(void*)*8,
784 #ifdef MAKE_DISTRIBUTION
785  VERSION_DATE, GIT_VERSION);
786 #else
787  singular_date, GIT_VERSION);
788 #endif
789  StringAppendS("\nwith\n\t");
790 
791 #if defined(mpir_version)
792  StringAppend("MPIR(%s)~GMP(%s),", mpir_version, gmp_version);
793 #elif defined(gmp_version)
794  // #if defined (__GNU_MP_VERSION) && defined (__GNU_MP_VERSION_MINOR)
795  // StringAppend("GMP(%d.%d),",__GNU_MP_VERSION,__GNU_MP_VERSION_MINOR);
796  StringAppend("GMP(%s),", gmp_version);
797 #endif
798 #ifdef HAVE_NTL
799 #include <NTL/version.h>
800  StringAppend("NTL(%s),",NTL_VERSION);
801 #endif
802 
803 #ifdef HAVE_FLINT
804  StringAppend("FLINT(%s),",version);
805 #endif
806  StringAppend("factory(%s),\n\t", factoryVersion);
807 #if defined(HAVE_DYN_RL)
809  StringAppendS("no input,");
810  else if (fe_fgets_stdin==fe_fgets)
811  StringAppendS("fgets,");
813  StringAppendS("dynamic readline,");
814  #ifdef HAVE_FEREAD
816  StringAppendS("emulated readline,");
817  #endif
818  else
819  StringAppendS("unknown fgets method,");
820 #else
821  #if defined(HAVE_READLINE) && !defined(FEREAD)
822  StringAppendS("static readline,");
823  #else
824  #ifdef HAVE_FEREAD
825  StringAppendS("emulated readline,");
826  #else
827  StringAppendS("fgets,");
828  #endif
829  #endif
830 #endif
831 #ifdef HAVE_PLURAL
832  StringAppendS("Plural,");
833 #endif
834 #ifdef HAVE_DBM
835  StringAppendS("DBM,\n\t");
836 #else
837  StringAppendS("\n\t");
838 #endif
839 #ifdef HAVE_DYNAMIC_LOADING
840  StringAppendS("dynamic modules,");
841 #endif
842  if (p_procs_dynamic) StringAppendS("dynamic p_Procs,");
843 #if YYDEBUG
844  StringAppendS("YYDEBUG=1,");
845 #endif
846 #ifdef HAVE_ASSUME
847  StringAppendS("ASSUME,");
848 #endif
849 #ifdef MDEBUG
850  StringAppend("MDEBUG=%d,",MDEBUG);
851 #endif
852 #ifdef OM_CHECK
853  StringAppend("OM_CHECK=%d,",OM_CHECK);
854 #endif
855 #ifdef OM_TRACK
856  StringAppend("OM_TRACK=%d,",OM_TRACK);
857 #endif
858 #ifdef OM_NDEBUG
859  StringAppendS("OM_NDEBUG,");
860 #endif
861 #ifdef SING_NDEBUG
862  StringAppendS("SING_NDEBUG,");
863 #endif
864 #ifdef PDEBUG
865  StringAppendS("PDEBUG,");
866 #endif
867 #ifdef KDEBUG
868  StringAppendS("KDEBUG,");
869 #endif
870 #ifdef __OPTIMIZE__
871  StringAppendS("CC:OPTIMIZE,");
872 #endif
873 #ifdef __OPTIMIZE_SIZE__
874  StringAppendS("CC:OPTIMIZE_SIZE,");
875 #endif
876 #ifdef __NO_INLINE__
877  StringAppendS("CC:NO_INLINE,");
878 #endif
879 #ifdef HAVE_EIGENVAL
880  StringAppendS("eigenvalues,");
881 #endif
882 #ifdef HAVE_GMS
883  StringAppendS("Gauss-Manin system,");
884 #endif
885 #ifdef HAVE_RATGRING
886  StringAppendS("ratGB,");
887 #endif
888  StringAppend("random=%d\n",siRandomStart);
889 
890 #define SI_SHOW_BUILTIN_MODULE(name) StringAppend(" %s", #name);
891  StringAppendS("built-in modules: {");
893  StringAppendS("}\n");
894 #undef SI_SHOW_BUILTIN_MODULE
895 
896  StringAppend("AC_CONFIGURE_ARGS = %s,\n"
897  "CC = %s,FLAGS : %s,\n"
898  "CXX = %s,FLAGS : %s,\n"
899  "DEFS : %s,CPPFLAGS : %s,\n"
900  "LDFLAGS : %s,LIBS : %s "
901 #ifdef __GNUC__
902  "(ver: " __VERSION__ ")"
903 #endif
904  "\n",AC_CONFIGURE_ARGS, CC,CFLAGS, CXX,CXXFLAGS, DEFS,CPPFLAGS, LDFLAGS,LIBS);
907  StringAppendS("\n");
908  return StringEndS();
909 }
#define OM_CHECK
Definition: omalloc_debug.c:15
char *(* fe_fgets_stdin)(const char *pr, char *s, int size)
Definition: feread.cc:34
void feStringAppendResources(int warn)
Definition: reporter.cc:398
const BOOLEAN p_procs_dynamic
#define SINGULAR_VERSION
Definition: mod2.h:86
char * fe_fgets(const char *pr, char *s, int size)
Definition: feread.cc:310
char * fe_fgets_dummy(const char *, char *, int)
Definition: feread.cc:451
int siRandomStart
Definition: cntrlc.cc:102
char * StringEndS()
Definition: reporter.cc:151
void feStringAppendBrowsers(int warn)
Definition: fehelp.cc:354
#define MDEBUG
Definition: mod2.h:185
char * fe_fgets_stdin_emu(const char *pr, char *s, int size)
Definition: feread.cc:254
void StringSetS(const char *st)
Definition: reporter.cc:128
void StringAppendS(const char *st)
Definition: reporter.cc:107
SI_FOREACH_BUILTIN(SI_GET_BUILTIN_MOD_INIT0) }
#define StringAppend
Definition: emacs.cc:82
#define version
Definition: libparse.cc:1260
#define OM_TRACK
Definition: omalloc_debug.c:10
#define VERSION
Definition: mod2.h:16
const char * singular_date
Definition: misc_ip.cc:775
#define SI_SHOW_BUILTIN_MODULE(name)
const char factoryVersion[]
extern const char factoryVersion[];
char * fe_fgets_stdin_drl(const char *pr, char *s, int size)
Definition: feread.cc:270

Variable Documentation

◆ currid

const char* currid

Definition at line 171 of file grammar.cc.

◆ dArith1

const struct sValCmd1 dArith1[]

Definition at line 19 of file table.h.

◆ dArith2

const struct sValCmd2 dArith2[]

Definition at line 291 of file table.h.

◆ dArith3

const struct sValCmd3 dArith3[]

Definition at line 716 of file table.h.

◆ dArithM

const struct sValCmdM dArithM[]

Definition at line 826 of file table.h.

◆ iiCurrArgs

leftv iiCurrArgs

Definition at line 78 of file ipshell.cc.

◆ iiCurrProc

idhdl iiCurrProc

Definition at line 79 of file ipshell.cc.

◆ iiLocalRing

ring* iiLocalRing

Definition at line 472 of file iplib.cc.

◆ iiOp

int iiOp

Definition at line 224 of file iparith.cc.

◆ iiRETURNEXPR

sleftv iiRETURNEXPR

Definition at line 473 of file iplib.cc.

◆ iiRETURNEXPR_len

int iiRETURNEXPR_len

Definition at line 474 of file iplib.cc.

◆ lastreserved

const char* lastreserved

Definition at line 80 of file ipshell.cc.

◆ myynest

int myynest

Definition at line 46 of file febase.cc.

◆ printlevel

int printlevel

Definition at line 42 of file febase.cc.

◆ si_echo

int si_echo

Definition at line 41 of file febase.cc.

◆ yyInRingConstruction

BOOLEAN yyInRingConstruction

Definition at line 172 of file grammar.cc.