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, sleftv *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, sleftv *sl)
 
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
int Typ()
Definition: subexpr.cc:995
Definition: intvec.h:14
ip_smatrix * matrix
leftv next
Definition: subexpr.h:87
int & cols()
Definition: matpol.h:25
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
void * Data()
Definition: subexpr.cc:1137
Definition: tok.h:117

◆ iiAddCproc()

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

Definition at line 897 of file iplib.cc.

899 {
900  procinfov pi;
901  idhdl h;
902 
903  #ifndef SING_NDEBUG
904  int dummy;
905  if (IsCmd(procname,dummy))
906  {
907  Werror(">>%s< is a reserved name",procname);
908  return 0;
909  }
910  #endif
911 
912  h=IDROOT->get(procname,0);
913  if ((h!=NULL)
914  && (IDTYP(h)==PROC_CMD))
915  {
916  pi = IDPROC(h);
917  if ((pi->language == LANG_SINGULAR)
918  &&(BVERBOSE(V_REDEFINE)))
919  Warn("extend `%s`",procname);
920  }
921  else
922  {
923  h = enterid(procname,0, PROC_CMD, &IDROOT, TRUE);
924  }
925  if ( h!= NULL )
926  {
927  pi = IDPROC(h);
928  if((pi->language == LANG_SINGULAR)
929  ||(pi->language == LANG_NONE))
930  {
931  omfree(pi->libname);
932  pi->libname = omStrDup(libname);
933  omfree(pi->procname);
934  pi->procname = omStrDup(procname);
935  pi->language = LANG_C;
936  pi->ref = 1;
937  pi->is_static = pstatic;
938  pi->data.o.function = func;
939  }
940  else if(pi->language == LANG_C)
941  {
942  if(pi->data.o.function == func)
943  {
944  pi->ref++;
945  }
946  else
947  {
948  omfree(pi->libname);
949  pi->libname = omStrDup(libname);
950  omfree(pi->procname);
951  pi->procname = omStrDup(procname);
952  pi->language = LANG_C;
953  pi->ref = 1;
954  pi->is_static = pstatic;
955  pi->data.o.function = func;
956  }
957  }
958  else
959  Warn("internal error: unknown procedure type %d",pi->language);
960  return(1);
961  }
962  else
963  {
964  WarnS("iiAddCproc: failed.");
965  }
966  return(0);
967 }
language_defs language
Definition: subexpr.h:59
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:98
short ref
Definition: subexpr.h:60
#define WarnS
Definition: emacs.cc:81
Definition: idrec.h:34
char * procname
Definition: subexpr.h:57
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
char * libname
Definition: subexpr.h:56
#define omfree(addr)
Definition: omAllocDecl.h:237
procinfodata data
Definition: subexpr.h:63
#define BVERBOSE(a)
Definition: options.h:33
char is_static
Definition: subexpr.h:61
#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:8628
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiAlias()

BOOLEAN iiAlias ( leftv  p)

Definition at line 751 of file ipid.cc.

752 {
753  if (iiCurrArgs==NULL)
754  {
755  Werror("not enough arguments for proc %s",VoiceName());
756  p->CleanUp();
757  return TRUE;
758  }
760  iiCurrArgs=h->next;
761  h->next=NULL;
762  if (h->rtyp!=IDHDL)
763  {
764  BOOLEAN res=iiAssign(p,h);
765  h->CleanUp();
767  return res;
768  }
769  if ((h->Typ()!=p->Typ()) &&(p->Typ()!=DEF_CMD))
770  {
771  WerrorS("type mismatch");
772  return TRUE;
773  }
774  idhdl pp=(idhdl)p->data;
775  switch(pp->typ)
776  {
777  case CRING_CMD:
778  nKillChar((coeffs)pp);
779  break;
780  case DEF_CMD:
781  case INT_CMD:
782  break;
783  case INTVEC_CMD:
784  case INTMAT_CMD:
785  delete IDINTVEC(pp);
786  break;
787  case NUMBER_CMD:
788  nDelete(&IDNUMBER(pp));
789  break;
790  case BIGINT_CMD:
792  break;
793  case MAP_CMD:
794  {
795  map im = IDMAP(pp);
796  omFree((ADDRESS)im->preimage);
797  }
798  // continue as ideal:
799  case IDEAL_CMD:
800  case MODUL_CMD:
801  case MATRIX_CMD:
802  idDelete(&IDIDEAL(pp));
803  break;
804  case PROC_CMD:
805  case RESOLUTION_CMD:
806  case STRING_CMD:
807  omFree((ADDRESS)IDSTRING(pp));
808  break;
809  case LIST_CMD:
810  IDLIST(pp)->Clean();
811  break;
812  case LINK_CMD:
814  break;
815  // case ring: cannot happen
816  default:
817  Werror("unknown type %d",p->Typ());
818  return TRUE;
819  }
820  pp->typ=ALIAS_CMD;
821  IDDATA(pp)=(char*)h->data;
822  int eff_typ=h->Typ();
823  if ((RingDependend(eff_typ))
824  || ((eff_typ==LIST_CMD) && (lRingDependend((lists)h->Data()))))
825  {
826  ipSwapId(pp,IDROOT,currRing->idroot);
827  }
828  h->CleanUp();
830  return FALSE;
831 }
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:83
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
#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
int Typ()
Definition: subexpr.cc:995
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:31
poly pp
Definition: myNF.cc:296
void * data
Definition: subexpr.h:89
poly res
Definition: myNF.cc:322
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
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
leftv next
Definition: subexpr.h:87
#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
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
void * Data()
Definition: subexpr.cc:1137
int typ
Definition: idrec.h:43
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:584
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
char * procname
Definition: subexpr.h:57
char * libname
Definition: subexpr.h:56
int i
Definition: cfEzgcd.cc:123
char name(const Variable &v)
Definition: factory.h:178
int yyparse(void)
Definition: grammar.cc:2101
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
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 6331 of file ipshell.cc.

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

◆ iiARROW()

BOOLEAN iiARROW ( leftv  ,
char *  ,
char *   
)

Definition at line 6380 of file ipshell.cc.

6381 {
6382  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6383  // find end of s:
6384  int end_s=strlen(s);
6385  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6386  s[end_s+1]='\0';
6387  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6388  sprintf(name,"%s->%s",a,s);
6389  // find start of last expression
6390  int start_s=end_s-1;
6391  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6392  if (start_s<0) // ';' not found
6393  {
6394  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6395  }
6396  else // s[start_s] is ';'
6397  {
6398  s[start_s]='\0';
6399  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6400  }
6401  memset(r,0,sizeof(*r));
6402  // now produce procinfo for PROC_CMD:
6403  r->data = (void *)omAlloc0Bin(procinfo_bin);
6404  ((procinfo *)(r->data))->language=LANG_NONE;
6405  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6406  ((procinfo *)r->data)->data.s.body=ss;
6407  omFree(name);
6408  r->rtyp=PROC_CMD;
6409  //r->rtyp=STRING_CMD;
6410  //r->data=ss;
6411  return FALSE;
6412 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
const poly a
Definition: syzextra.cc:212
#define FALSE
Definition: auxiliary.h:94
procinfo * iiInitSingularProcinfo(procinfov pi, const char *libname, const char *procname, int, long pos, BOOLEAN pstatic)
Definition: iplib.cc:883
#define omAlloc(size)
Definition: omAllocDecl.h:210
omBin procinfo_bin
Definition: subexpr.cc:51
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  //r=hh;
1992  }
1993  else
1994  {
1995  WerrorS("expected ring-name");
1996  nok=TRUE;
1997  break;
1998  }
1999  if (hh==NULL) /* map-assign: map f=r; */
2000  {
2001  WerrorS("expected image ideal");
2002  nok=TRUE;
2003  break;
2004  }
2005  if ((hh->next==NULL)&&(hh->Typ()==IDEAL_CMD))
2006  return jiAssign_1(l,hh,toplevel); /* map-assign: map f=r,i; */
2007  //no break, handle the rest like an ideal:
2008  map_assign=TRUE;
2009  }
2010  case MATRIX_CMD:
2011  case IDEAL_CMD:
2012  case MODUL_CMD:
2013  {
2014  sleftv t;
2015  matrix olm = (matrix)l->Data();
2016  int rk;
2017  char *pr=((map)olm)->preimage;
2018  BOOLEAN module_assign=(/*l->Typ()*/ lt==MODUL_CMD);
2019  matrix lm ;
2020  int num;
2021  int j,k;
2022  int i=0;
2023  int mtyp=MATRIX_CMD; /*Type of left side object*/
2024  int etyp=POLY_CMD; /*Type of elements of left side object*/
2025 
2026  if (lt /*l->Typ()*/==MATRIX_CMD)
2027  {
2028  rk=olm->rows();
2029  num=olm->cols()*rk /*olm->rows()*/;
2030  lm=mpNew(olm->rows(),olm->cols());
2031  int el;
2032  if ((traceit&TRACE_ASSIGN) && (num!=(el=exprlist_length(hh))))
2033  {
2034  Warn("expression list length(%d) does not match matrix size(%d)",el,num);
2035  }
2036  }
2037  else /* IDEAL_CMD or MODUL_CMD */
2038  {
2039  num=exprlist_length(hh);
2040  lm=(matrix)idInit(num,1);
2041  if (module_assign)
2042  {
2043  rk=0;
2044  mtyp=MODUL_CMD;
2045  etyp=VECTOR_CMD;
2046  }
2047  else
2048  rk=1;
2049  }
2050 
2051  int ht;
2052  loop
2053  {
2054  if (hh==NULL)
2055  break;
2056  else
2057  {
2058  matrix rm;
2059  ht=hh->Typ();
2060  if ((j=iiTestConvert(ht,etyp))!=0)
2061  {
2062  nok=iiConvert(ht,etyp,j,hh,&t);
2063  hh->next=t.next;
2064  if (nok) break;
2065  lm->m[i]=(poly)t.CopyD(etyp);
2066  pNormalize(lm->m[i]);
2067  if (module_assign) rk=si_max(rk,(int)pMaxComp(lm->m[i]));
2068  i++;
2069  }
2070  else
2071  if ((j=iiTestConvert(ht,mtyp))!=0)
2072  {
2073  nok=iiConvert(ht,mtyp,j,hh,&t);
2074  hh->next=t.next;
2075  if (nok) break;
2076  rm = (matrix)t.CopyD(mtyp);
2077  if (module_assign)
2078  {
2079  j = si_min(num,rm->cols());
2080  rk=si_max(rk,(int)rm->rank);
2081  }
2082  else
2083  j = si_min(num-i,rm->rows() * rm->cols());
2084  for(k=0;k<j;k++,i++)
2085  {
2086  lm->m[i]=rm->m[k];
2087  pNormalize(lm->m[i]);
2088  rm->m[k]=NULL;
2089  }
2090  idDelete((ideal *)&rm);
2091  }
2092  else
2093  {
2094  nok=TRUE;
2095  break;
2096  }
2097  t.next=NULL;t.CleanUp();
2098  if (i==num) break;
2099  hh=hh->next;
2100  }
2101  }
2102  if (nok)
2103  idDelete((ideal *)&lm);
2104  else
2105  {
2106  idDelete((ideal *)&olm);
2107  if (module_assign) lm->rank=rk;
2108  else if (map_assign) ((map)lm)->preimage=pr;
2109  l=l->LData();
2110  if (l->rtyp==IDHDL)
2111  IDMATRIX((idhdl)l->data)=lm;
2112  else
2113  l->data=(char *)lm;
2114  }
2115  break;
2116  }
2117  case STRING_CMD:
2118  nok=jjA_L_STRING(l,r);
2119  break;
2120  //case DEF_CMD:
2121  case LIST_CMD:
2122  nok=jjA_L_LIST(l,r);
2123  break;
2124  case NONE:
2125  case 0:
2126  Werror("cannot assign to %s",l->Fullname());
2127  nok=TRUE;
2128  break;
2129  default:
2130  WerrorS("assign not impl.");
2131  nok=TRUE;
2132  break;
2133  } /* end switch: typ */
2134  if (nok && (!errorreported)) WerrorS("incompatible type in list assignment");
2135  r->CleanUp();
2136  return nok;
2137 }
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:609
int iiTestConvert(int inputType, int outputType)
Definition: gentable.cc:293
Definition: tok.h:203
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#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:87
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:47
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 6414 of file ipshell.cc.

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

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  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:83
idhdl currPackHdl
Definition: ipid.cc:61
char * buffer
Definition: fevoices.h:69
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:471
int listLength()
Definition: subexpr.cc:60
#define TRUE
Definition: auxiliary.h:98
void Init()
Definition: subexpr.h:108
void * ADDRESS
Definition: auxiliary.h:115
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define BITSET
Definition: structs.h:18
#define omAlloc(size)
Definition: omAllocDecl.h:210
#define IDHDL
Definition: tok.h:31
idhdl iiCurrProc
Definition: ipshell.cc:79
int myynest
Definition: febase.cc:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
#define omFree(addr)
Definition: omAllocDecl.h:261
void killlocals(int v)
Definition: ipshell.cc:378
idrec * idhdl
Definition: ring.h:18
omBin sleftv_bin
Definition: subexpr.cc:50
int i
Definition: cfEzgcd.cc:123
int yyparse(void)
Definition: grammar.cc:2101
leftv next
Definition: subexpr.h:87
#define IDPROC(a)
Definition: ipid.h:137
#define pi
Definition: libparse.cc:1143
#define NULL
Definition: omList.c:10
Voice * currentVoice
Definition: fevoices.cc:57
BOOLEAN iiCheckTypes(leftv args, const short *type_list, int report)
check a list of arguemys against a given field of types return TRUE if the types match return FALSE (...
Definition: ipshell.cc:6470
package currPack
Definition: ipid.cc:63
leftv iiCurrArgs
Definition: ipshell.cc:78
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:171
idhdl packFindHdl(package r)
Definition: ipid.cc:738
void iiCheckPack(package &p)
Definition: ipshell.cc:1535
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
unsigned si_opt_2
Definition: options.c:6
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:210
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:85
const poly b
Definition: syzextra.cc:213
void Werror(const char *fmt,...)
Definition: reporter.cc:189
int l
Definition: cfEzgcd.cc:94
utypes data
Definition: idrec.h:40
int IsCmd(const char *n, int &tok)
Definition: iparith.cc:8628
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1535 of file ipshell.cc.

1536 {
1537  if (p!=basePack)
1538  {
1539  idhdl t=basePack->idroot;
1540  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1541  if (t==NULL)
1542  {
1543  WarnS("package not found\n");
1544  p=basePack;
1545  }
1546  }
1547 }
return P p
Definition: myNF.cc:203
#define WarnS
Definition: emacs.cc:81
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:136
#define IDTYP(a)
Definition: ipid.h:116
idhdl next
Definition: idrec.h:38
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64

◆ iiCheckRing()

BOOLEAN iiCheckRing ( int  i)

Definition at line 1491 of file ipshell.cc.

1492 {
1493  if (currRing==NULL)
1494  {
1495  #ifdef SIQ
1496  if (siq<=0)
1497  {
1498  #endif
1499  if (RingDependend(i))
1500  {
1501  WerrorS("no ring active");
1502  return TRUE;
1503  }
1504  #ifdef SIQ
1505  }
1506  #endif
1507  }
1508  return FALSE;
1509 }
#define FALSE
Definition: auxiliary.h:94
BOOLEAN siq
Definition: subexpr.cc:57
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
int RingDependend(int t)
Definition: gentable.cc:23
int i
Definition: cfEzgcd.cc:123
#define NULL
Definition: omList.c:10

◆ iiCheckTypes()

BOOLEAN iiCheckTypes ( leftv  args,
const short *  type_list,
int  report = 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 6470 of file ipshell.cc.

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

◆ iiConvName()

char* iiConvName ( const char *  libname)

Definition at line 1214 of file iplib.cc.

1215 {
1216  char *tmpname = omStrDup(libname);
1217  char *p = strrchr(tmpname, DIR_SEP);
1218  char *r;
1219  if(p==NULL) p = tmpname;
1220  else p++;
1221  r = (char *)strchr(p, '.');
1222  if( r!= NULL) *r = '\0';
1223  r = omStrDup(p);
1224  *r = mytoupper(*r);
1225  // printf("iiConvName: '%s' '%s' => '%s'\n", libname, tmpname, r);
1226  omFree((ADDRESS)tmpname);
1227 
1228  return(r);
1229 }
char mytoupper(char c)
Definition: iplib.cc:1195
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");
1018  newBuffer(s,BT_execute);
1019  }
1020 }
void VoiceBackTrack()
Definition: fevoices.cc:77
const CanonicalForm int s
Definition: facAbsFact.cc:55
char *(* fe_fgets_stdin)(const char *pr, char *s, int size)
Definition: feread.cc:34
int sdb_flags
Definition: sdb.cc:32
#define Print
Definition: emacs.cc:83
loop
Definition: myNF.cc:98
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
#define omAlloc(size)
Definition: omAllocDecl.h:210
BOOLEAN iiDebugMarker
Definition: ipshell.cc:982
const char * VoiceName()
Definition: fevoices.cc:66
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:983
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:171

◆ iiDeclCommand()

int iiDeclCommand ( leftv  sy,
leftv  name,
int  lev,
int  t,
idhdl root,
BOOLEAN  isring = 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:83
int yylineno
Definition: febase.cc:45
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:94
char * filename
Definition: fevoices.h:63
#define TRUE
Definition: auxiliary.h:98
sleftv * leftv
Definition: structs.h:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:31
const char * currid
Definition: grammar.cc:171
void * data
Definition: subexpr.h:89
poly res
Definition: myNF.cc:322
int myynest
Definition: febase.cc:46
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:258
char my_yylinebuf[80]
Definition: febase.cc:48
const char * name
Definition: subexpr.h:88
idhdl currRingHdl
Definition: ipid.cc:65
omBin sleftv_bin
Definition: subexpr.cc:50
#define IDLEV(a)
Definition: ipid.h:118
leftv next
Definition: subexpr.h:87
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition: ipshell.cc:1122
#define NULL
Definition: omList.c:10
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:132
Voice * currentVoice
Definition: fevoices.cc:57
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
Definition: tok.h:157
int BOOLEAN
Definition: auxiliary.h:85
#define TEST_V_ALLWARN
Definition: options.h:135
#define Warn
Definition: emacs.cc:80

◆ iiEStart()

BOOLEAN iiEStart ( char *  example,
procinfo pi 
)

Definition at line 591 of file iplib.cc.

592 {
593  BOOLEAN err;
594  int old_echo=si_echo;
595 
596  iiCheckNest();
597  procstack->push(example);
600  {
601  if (traceit&TRACE_SHOW_LINENO) printf("\n");
602  printf("entering example (level %d)\n",myynest);
603  }
604  myynest++;
605 
606  err=iiAllStart(pi,example,BT_example,(pi != NULL ? pi->data.s.example_lineno: 0));
607 
609  myynest--;
610  si_echo=old_echo;
611  if (traceit&TRACE_SHOW_PROC)
612  {
613  if (traceit&TRACE_SHOW_LINENO) printf("\n");
614  printf("leaving -example- (level %d)\n",myynest);
615  }
616  if (iiLocalRing[myynest] != currRing)
617  {
618  if (iiLocalRing[myynest]!=NULL)
619  {
622  }
623  else
624  {
626  currRing=NULL;
627  }
628  }
629  procstack->pop();
630  return err;
631 }
#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:490
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
procinfodata data
Definition: subexpr.h:63
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
ring * iiLocalRing
Definition: iplib.cc:470
#define NULL
Definition: omList.c:10
#define TRACE_SHOW_PROC
Definition: reporter.h:28
void rSetHdl(idhdl h)
Definition: ipshell.cc:5032
void push(char *)
Definition: ipid.cc:710
void pop()
Definition: ipid.cc:720
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:83
Subexpr e
Definition: subexpr.h:106
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
const ring r
Definition: syzextra.cc:208
const char * name
Definition: subexpr.h:88
leftv next
Definition: subexpr.h:87
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1315
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189

◆ iiExport() [2/2]

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

Definition at line 1439 of file ipshell.cc.

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

◆ 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 8084 of file iparith.cc.

8085 {
8086  memset(res,0,sizeof(sleftv));
8087  BOOLEAN call_failed=FALSE;
8088 
8089  if (!errorreported)
8090  {
8091  BOOLEAN failed=FALSE;
8092  iiOp=op;
8093  int i = 0;
8094  while (dA1[i].cmd==op)
8095  {
8096  if (at==dA1[i].arg)
8097  {
8098  if (currRing!=NULL)
8099  {
8100  if (check_valid(dA1[i].valid_for,op)) break;
8101  }
8102  else
8103  {
8104  if (RingDependend(dA1[i].res))
8105  {
8106  WerrorS("no ring active");
8107  break;
8108  }
8109  }
8110  if (traceit&TRACE_CALL)
8111  Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
8112  res->rtyp=dA1[i].res;
8113  if ((call_failed=dA1[i].p(res,a)))
8114  {
8115  break;// leave loop, goto error handling
8116  }
8117  if (a->Next()!=NULL)
8118  {
8120  failed=iiExprArith1(res->next,a->next,op);
8121  }
8122  a->CleanUp();
8123  return failed;
8124  }
8125  i++;
8126  }
8127  // implicite type conversion --------------------------------------------
8128  if (dA1[i].cmd!=op)
8129  {
8131  i=0;
8132  //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
8133  while (dA1[i].cmd==op)
8134  {
8135  int ai;
8136  //Print("test %s\n",Tok2Cmdname(dA1[i].arg));
8137  if ((dA1[i].valid_for & NO_CONVERSION)==0)
8138  {
8139  if ((ai=iiTestConvert(at,dA1[i].arg,dConvertTypes))!=0)
8140  {
8141  if (currRing!=NULL)
8142  {
8143  if (check_valid(dA1[i].valid_for,op)) break;
8144  }
8145  else
8146  {
8147  if (RingDependend(dA1[i].res))
8148  {
8149  WerrorS("no ring active");
8150  break;
8151  }
8152  }
8153  if (traceit&TRACE_CALL)
8154  Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(dA1[i].arg));
8155  res->rtyp=dA1[i].res;
8156  failed= ((iiConvert(at,dA1[i].arg,ai,a,an,dConvertTypes))
8157  || (call_failed=dA1[i].p(res,an)));
8158  // everything done, clean up temp. variables
8159  if (failed)
8160  {
8161  // leave loop, goto error handling
8162  break;
8163  }
8164  else
8165  {
8166  if (an->Next() != NULL)
8167  {
8168  res->next = (leftv)omAllocBin(sleftv_bin);
8169  failed=iiExprArith1(res->next,an->next,op);
8170  }
8171  // everything ok, clean up and return
8172  an->CleanUp();
8174  a->CleanUp();
8175  return failed;
8176  }
8177  }
8178  }
8179  i++;
8180  }
8181  an->CleanUp();
8183  }
8184  // error handling
8185  if (!errorreported)
8186  {
8187  if ((at==0) && (a->Fullname()!=sNoName_fe))
8188  {
8189  Werror("`%s` is not defined",a->Fullname());
8190  }
8191  else
8192  {
8193  i=0;
8194  const char *s = iiTwoOps(op);
8195  Werror("%s(`%s`) failed"
8196  ,s,Tok2Cmdname(at));
8197  if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8198  {
8199  while (dA1[i].cmd==op)
8200  {
8201  if ((dA1[i].res!=0)
8202  && (dA1[i].p!=jjWRONG))
8203  Werror("expected %s(`%s`)"
8204  ,s,Tok2Cmdname(dA1[i].arg));
8205  i++;
8206  }
8207  }
8208  }
8209  }
8210  res->rtyp = UNKNOWN;
8211  }
8212  a->CleanUp();
8213  return TRUE;
8214 }
#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:83
#define Print
Definition: emacs.cc:83
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:8215
#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
const char * Fullname()
Definition: subexpr.h:126
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:9025
const char * Tok2Cmdname(int tok)
Definition: iparith.cc:8750
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:3473
leftv Next()
Definition: subexpr.h:137
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:87
#define BVERBOSE(a)
Definition: options.h:33
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
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 8012 of file iparith.cc.

8016 {
8017  leftv b=a->next;
8018  a->next=NULL;
8019  int bt=b->Typ();
8020  BOOLEAN bo=iiExprArith2TabIntern(res,a,op,b,TRUE,dA2,at,bt,dConvertTypes);
8021  a->next=b;
8022  a->CleanUp(); // to clean up the chain, content already done in iiExprArith2TabIntern
8023  return bo;
8024 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define TRUE
Definition: auxiliary.h:98
int Typ()
Definition: subexpr.cc:995
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:7852
leftv next
Definition: subexpr.h:87
#define NULL
Definition: omList.c:10
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
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 8430 of file iparith.cc.

8431 {
8432  memset(res,0,sizeof(sleftv));
8433 
8434  if (!errorreported)
8435  {
8436 #ifdef SIQ
8437  if (siq>0)
8438  {
8439  //Print("siq:%d\n",siq);
8441  memcpy(&d->arg1,a,sizeof(sleftv));
8442  a->Init();
8443  memcpy(&d->arg2,b,sizeof(sleftv));
8444  b->Init();
8445  memcpy(&d->arg3,c,sizeof(sleftv));
8446  c->Init();
8447  d->op=op;
8448  d->argc=3;
8449  res->data=(char *)d;
8450  res->rtyp=COMMAND;
8451  return FALSE;
8452  }
8453 #endif
8454  int at=a->Typ();
8455  // handling bb-objects ----------------------------------------------
8456  if (at>MAX_TOK)
8457  {
8458  blackbox *bb=getBlackboxStuff(at);
8459  if (bb!=NULL)
8460  {
8461  if(!bb->blackbox_Op3(op,res,a,b,c)) return FALSE;
8462  if (errorreported) return TRUE;
8463  // else: no op defined
8464  }
8465  else return TRUE;
8466  if (errorreported) return TRUE;
8467  }
8468  int bt=b->Typ();
8469  int ct=c->Typ();
8470 
8471  iiOp=op;
8472  int i=0;
8473  while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8474  return iiExprArith3TabIntern(res,op,a,b,c,dArith3+i,at,bt,ct,dConvertTypes);
8475  }
8476  a->CleanUp();
8477  b->CleanUp();
8478  c->CleanUp();
8479  //Print("op: %d,result typ:%d\n",op,res->rtyp);
8480  return TRUE;
8481 }
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:8273
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
ip_command * command
Definition: ipid.h:24
const struct sConvertTypes dConvertTypes[]
Definition: table.h:1177
#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:108
int Typ()
Definition: subexpr.cc:995
void * data
Definition: subexpr.h:89
const struct sValCmd3 dArith3[]
Definition: table.h:713
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
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
int iiOp
Definition: iparith.cc:224
#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 8482 of file iparith.cc.

8486 {
8487  leftv b=a->next;
8488  a->next=NULL;
8489  int bt=b->Typ();
8490  leftv c=b->next;
8491  b->next=NULL;
8492  int ct=c->Typ();
8493  BOOLEAN bo=iiExprArith3TabIntern(res,op,a,b,c,dA3,at,bt,ct,dConvertTypes);
8494  b->next=c;
8495  a->next=b;
8496  a->CleanUp(); // to cleanup the chain, content already done
8497  return bo;
8498 }
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:8273
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
int Typ()
Definition: subexpr.cc:995
leftv next
Definition: subexpr.h:87
#define NULL
Definition: omList.c:10
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332
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 }
#define pSetm(p)
Definition: polys.h:253
#define pDecrExp(p, i)
Definition: polys.h:44
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge, ring tailRing)
Definition: hdegree.cc:1005
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy ...
Definition: monomials.h:51
static BOOLEAN idIsZeroDim(ideal i)
Definition: ideals.h:161
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
#define pSetComp(p, v)
Definition: polys.h:38
int i
Definition: cfEzgcd.cc:123
#define pOne()
Definition: polys.h:297
#define rHasLocalOrMixedOrdering_currRing()
Definition: ring.h:758
#define NULL
Definition: omList.c:10
strat ak
Definition: myNF.cc:321
polyrec * poly
Definition: hilb.h:10
#define nInit(i)
Definition: numbers.h:24

◆ iiInternalExport()

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
const char * Name()
Definition: subexpr.h:121
Definition: idrec.h:34
void * data
Definition: subexpr.h:89
#define IDTYP(a)
Definition: ipid.h:116
int RingDependend(int t)
Definition: gentable.cc:23
const char * name
Definition: subexpr.h:88
idrec * idhdl
Definition: ring.h:18
idhdl next
Definition: idrec.h:38
#define IDLEV(a)
Definition: ipid.h:118
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1315
#define NULL
Definition: omList.c:10
package req_packhdl
Definition: subexpr.h:107
package currPack
Definition: ipid.cc:63
Definition: tok.h:117
static Poly * h
Definition: janet.cc:978
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:199
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define Warn
Definition: emacs.cc:80

◆ iiLibCmd()

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

Definition at line 718 of file iplib.cc.

719 {
720  char libnamebuf[1024];
721  // procinfov pi;
722  // idhdl h;
723  idhdl pl;
724  // idhdl hl;
725  // long pos = 0L;
726  char *plib = iiConvName(newlib);
727  FILE * fp = feFopen( newlib, "r", libnamebuf, tellerror );
728  // int lines = 1;
729  BOOLEAN LoadResult = TRUE;
730 
731  if (fp==NULL)
732  {
733  return TRUE;
734  }
735  pl = basePack->idroot->get(plib,0);
736  if (pl==NULL)
737  {
738  pl = enterid( plib,0, PACKAGE_CMD,
739  &(basePack->idroot), TRUE );
740  IDPACKAGE(pl)->language = LANG_SINGULAR;
741  IDPACKAGE(pl)->libname=omStrDup(newlib);
742  }
743  else
744  {
745  if(IDTYP(pl)!=PACKAGE_CMD)
746  {
747  WarnS("not of type package.");
748  fclose(fp);
749  return TRUE;
750  }
751  if (!force) return FALSE;
752  }
753  LoadResult = iiLoadLIB(fp, libnamebuf, newlib, pl, autoexport, tellerror);
754  omFree((ADDRESS)newlib);
755 
756  if(!LoadResult) IDPACKAGE(pl)->loaded = TRUE;
757  omFree((ADDRESS)plib);
758 
759  return LoadResult;
760 }
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:807
char * iiConvName(const char *libname)
Definition: iplib.cc:1214
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 807 of file iplib.cc.

809 {
810  extern FILE *yylpin;
811  libstackv ls_start = library_stack;
812  lib_style_types lib_style;
813 
814  yylpin = fp;
815  #if YYLPDEBUG > 1
816  print_init();
817  #endif
818  extern int lpverbose;
819  if (BVERBOSE(V_DEBUG_LIB)) lpverbose=1;
820  else lpverbose=0;
821  // yylplex sets also text_buffer
822  if (text_buffer!=NULL) *text_buffer='\0';
823  yylplex(newlib, libnamebuf, &lib_style, pl, autoexport);
824  if(yylp_errno)
825  {
826  Werror("Library %s: ERROR occurred: in line %d, %d.", newlib, yylplineno,
827  current_pos(0));
829  {
833  }
834  else
836  WerrorS("Cannot load library,... aborting.");
837  reinit_yylp();
838  fclose( yylpin );
840  return TRUE;
841  }
842  if (BVERBOSE(V_LOAD_LIB))
843  Print( "// ** loaded %s %s\n", libnamebuf, text_buffer);
844  if( (lib_style == OLD_LIBSTYLE) && (BVERBOSE(V_LOAD_LIB)))
845  {
846  Warn( "library %s has old format. This format is still accepted,", newlib);
847  Warn( "but for functionality you may wish to change to the new");
848  Warn( "format. Please refer to the manual for further information.");
849  }
850  reinit_yylp();
851  fclose( yylpin );
852  fp = NULL;
853  iiRunInit(IDPACKAGE(pl));
854 
855  {
856  libstackv ls;
857  for(ls = library_stack; (ls != NULL) && (ls != ls_start); )
858  {
859  if(ls->to_be_done)
860  {
861  ls->to_be_done=FALSE;
862  iiLibCmd(ls->get(),autoexport,tellerror,FALSE);
863  ls = ls->pop(newlib);
864  }
865  }
866 #if 0
867  PrintS("--------------------\n");
868  for(ls = library_stack; ls != NULL; ls = ls->next)
869  {
870  Print("%s: LIB-stack:(%d), %s %s\n", newlib, ls->cnt, ls->get(),
871  ls->to_be_done ? "not loaded" : "loaded");
872  }
873  PrintS("--------------------\n");
874 #endif
875  }
876 
877  if(fp != NULL) fclose(fp);
878  return FALSE;
879 }
int cnt
Definition: subexpr.h:167
#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:164
#define FALSE
Definition: auxiliary.h:94
static void iiRunInit(package p)
Definition: iplib.cc:791
#define V_LOAD_LIB
Definition: options.h:45
#define IDROOT
Definition: ipid.h:20
BOOLEAN to_be_done
Definition: subexpr.h:166
#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:170
#define V_DEBUG_LIB
Definition: options.h:46
libstackv pop(const char *p)
Definition: iplib.cc:1303
BOOLEAN iiLibCmd(char *newlib, BOOLEAN autoexport, BOOLEAN tellerror, BOOLEAN force)
Definition: iplib.cc:718
#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:762
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 704 of file iplib.cc.

705 {
706  char *plib = iiConvName(lib);
707  idhdl pl = basePack->idroot->get(plib,0);
708  if( (pl!=NULL) && (IDTYP(pl)==PACKAGE_CMD) &&
709  (IDPACKAGE(pl)->language == LANG_SINGULAR))
710  {
711  strncpy(where,IDPACKAGE(pl)->libname,127);
712  return TRUE;
713  }
714  else
715  return FALSE;;
716 }
#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:1214

◆ iiMake_proc()

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

Definition at line 501 of file iplib.cc.

502 {
503  int err;
504  procinfov pi = IDPROC(pn);
505  if(pi->is_static && myynest==0)
506  {
507  Werror("'%s::%s()' is a local procedure and cannot be accessed by an user.",
508  pi->libname, pi->procname);
509  return TRUE;
510  }
511  iiCheckNest();
513  //Print("currRing(%d):%s(%x) in %s\n",myynest,IDID(currRingHdl),currRing,IDID(pn));
514  iiRETURNEXPR.Init();
515  procstack->push(pi->procname);
517  || (pi->trace_flag&TRACE_SHOW_PROC))
518  {
520  Print("entering%-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
521  }
522 #ifdef RDEBUG
524 #endif
525  switch (pi->language)
526  {
527  default:
528  case LANG_NONE:
529  WerrorS("undefined proc");
530  err=TRUE;
531  break;
532 
533  case LANG_SINGULAR:
534  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
535  {
536  currPack=pi->pack;
539  //Print("set pack=%s\n",IDID(currPackHdl));
540  }
541  else if ((pack!=NULL)&&(currPack!=pack))
542  {
543  currPack=pack;
546  //Print("set pack=%s\n",IDID(currPackHdl));
547  }
548  err=iiPStart(pn,sl);
549  break;
550  case LANG_C:
552  err = (pi->data.o.function)(res, sl);
553  memcpy(&iiRETURNEXPR,res,sizeof(iiRETURNEXPR));
555  break;
556  }
557  if ((traceit&TRACE_SHOW_PROC)
558  || (pi->trace_flag&TRACE_SHOW_PROC))
559  {
560  if (traceit&TRACE_SHOW_LINENO) PrintLn();
561  Print("leaving %-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
562  }
563  //const char *n="NULL";
564  //if (currRingHdl!=NULL) n=IDID(currRingHdl);
565  //Print("currRing(%d):%s(%x) after %s\n",myynest,n,currRing,IDID(pn));
566 #ifdef RDEBUG
567  if (traceit&TRACE_SHOW_RINGS) iiShowLevRings();
568 #endif
569  if (err)
570  {
572  //iiRETURNEXPR.Init(); //done by CleanUp
573  }
574  if (iiCurrArgs!=NULL)
575  {
576  if (!err) Warn("too many arguments for %s",IDID(pn));
577  iiCurrArgs->CleanUp();
580  }
581  procstack->pop();
582  if (err)
583  return TRUE;
584  return FALSE;
585 }
#define TRACE_SHOW_LINENO
Definition: reporter.h:30
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define TRACE_SHOW_RINGS
Definition: reporter.h:35
void PrintLn()
Definition: reporter.cc:310
#define Print
Definition: emacs.cc:83
package pack
Definition: subexpr.h:58
idhdl currPackHdl
Definition: ipid.cc:61
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:471
language_defs language
Definition: subexpr.h:59
proclevel * procstack
Definition: ipid.cc:58
static void iiShowLevRings()
Definition: iplib.cc:475
#define TRUE
Definition: auxiliary.h:98
void Init()
Definition: subexpr.h:108
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:490
char * procname
Definition: subexpr.h:57
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
char * libname
Definition: subexpr.h:56
procinfodata data
Definition: subexpr.h:63
omBin sleftv_bin
Definition: subexpr.cc:50
char is_static
Definition: subexpr.h:61
#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:470
#define NULL
Definition: omList.c:10
BOOLEAN iiPStart(idhdl pn, sleftv *v)
Definition: iplib.cc:371
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:738
void iiCheckPack(package &p)
Definition: ipshell.cc:1535
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
void push(char *)
Definition: ipid.cc:710
void pop()
Definition: ipid.cc:720
char trace_flag
Definition: subexpr.h:62
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:83
#define Print
Definition: emacs.cc:83
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
Definition: lists.h:22
if(0 > strat->sl)
Definition: myNF.cc:73
#define FALSE
Definition: auxiliary.h:94
#define V_DEF_RES
Definition: options.h:48
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:115
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: idrec.h:34
void * data
Definition: subexpr.h:89
int myynest
Definition: febase.cc:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:258
const ring r
Definition: syzextra.cc:208
int i
Definition: cfEzgcd.cc:123
char name(const Variable &v)
Definition: factory.h:178
#define BVERBOSE(a)
Definition: options.h:33
int nr
Definition: lists.h:43
#define NULL
Definition: omList.c:10
attr attribute
Definition: idrec.h:41
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:215
attr attribute
Definition: subexpr.h:90
omBin slists_bin
Definition: lists.cc:23
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
static Poly * h
Definition: janet.cc:978
utypes data
Definition: idrec.h:40
#define Warn
Definition: emacs.cc:80

◆ iiMap()

leftv iiMap ( map  theMap,
const char *  what 
)

Definition at line 607 of file ipshell.cc.

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

◆ iiOpsTwoChar()

int iiOpsTwoChar ( const char *  s)

Definition at line 119 of file ipshell.cc.

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

◆ iiParameter()

BOOLEAN iiParameter ( leftv  p)

Definition at line 1279 of file ipshell.cc.

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

◆ 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,
sleftv 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  {
388  iiGetLibProcBuffer(pi);
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  if (v!=NULL)
399  {
401  memcpy(iiCurrArgs,v,sizeof(sleftv));
402  memset(v,0,sizeof(sleftv));
403  }
404  else
405  {
407  }
408  iiCurrProc=pn;
409  /* start interpreter ======================================*/
410  myynest++;
411  if (myynest > SI_MAX_NEST)
412  {
413  WerrorS("nesting too deep");
414  err=TRUE;
415  }
416  else
417  {
418  err=iiAllStart(pi,pi->data.s.body,BT_proc,pi->data.s.body_lineno-(v!=NULL));
419 
420  if (iiLocalRing[myynest-1] != currRing)
421  {
423  {
424  //idhdl hn;
425  const char *n;
426  const char *o;
427  idhdl nh=NULL, oh=NULL;
428  if (iiLocalRing[myynest-1]!=NULL)
430  if (oh!=NULL) o=oh->id;
431  else o="none";
432  if (currRing!=NULL)
433  nh=rFindHdl(currRing,NULL);
434  if (nh!=NULL) n=nh->id;
435  else n="none";
436  Werror("ring change during procedure call: %s -> %s (level %d)",o,n,myynest);
438  err=TRUE;
439  }
441  }
442  if ((currRing==NULL)
443  && (currRingHdl!=NULL))
445  else
446  if ((currRing!=NULL) &&
448  ||(IDLEV(currRingHdl)>=myynest-1)))
449  {
452  }
453  //Print("kill locals for %s (level %d)\n",IDID(pn),myynest);
455 #ifndef SING_NDEBUG
456  checkall();
457 #endif
458  //Print("end kill locals for %s (%d)\n",IDID(pn),myynest);
459  }
460  myynest--;
461  si_echo=old_echo;
462  if (pi!=NULL)
463  pi->trace_flag=save_flags;
464 // omUpdateInfo();
465 // int m=om_Info.UsedBytes;
466 // Print("exit %s, mem=%d\n",IDID(pn),m);
467  return err;
468 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:471
#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
procinfodata data
Definition: subexpr.h:63
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:470
#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:5032
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:210
int BOOLEAN
Definition: auxiliary.h:85
char trace_flag
Definition: subexpr.h:62
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:135
#define NULL
Definition: omList.c:10
ideal * resolvente
Definition: ideals.h:18
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:791

◆ iiTestAssume()

BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6353 of file ipshell.cc.

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

◆ 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 656 of file iplib.cc.

657 {
658  BOOLEAN LoadResult = TRUE;
659  char libnamebuf[1024];
660  char *libname = (char *)omAlloc(strlen(id)+5);
661  const char *suffix[] = { "", ".lib", ".so", ".sl", NULL };
662  int i = 0;
663  // FILE *fp;
664  // package pack;
665  // idhdl packhdl;
666  lib_types LT;
667  for(i=0; suffix[i] != NULL; i++)
668  {
669  sprintf(libname, "%s%s", id, suffix[i]);
670  *libname = mytolower(*libname);
671  if((LT = type_of_LIB(libname, libnamebuf)) > LT_NOTFOUND)
672  {
673  char *s=omStrDup(libname);
674  #ifdef HAVE_DYNAMIC_LOADING
675  char libnamebuf[1024];
676  #endif
677 
678  if (LT==LT_SINGULAR)
679  LoadResult = iiLibCmd(s, FALSE, FALSE,TRUE);
680  #ifdef HAVE_DYNAMIC_LOADING
681  else if ((LT==LT_ELF) || (LT==LT_HPUX))
682  LoadResult = load_modules(s,libnamebuf,FALSE);
683  #endif
684  else if (LT==LT_BUILTIN)
685  {
686  LoadResult=load_builtin(s,FALSE, iiGetBuiltinModInit(s));
687  }
688  if(!LoadResult )
689  {
690  v->name = iiConvName(libname);
691  break;
692  }
693  }
694  }
695  omFree(libname);
696  return LoadResult;
697 }
BOOLEAN load_builtin(const char *newlib, BOOLEAN autoexport, SModulFunc_t init)
Definition: iplib.cc:1080
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:718
const char * name
Definition: subexpr.h:88
#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:1201
#define NULL
Definition: omList.c:10
SModulFunc_t iiGetBuiltinModInit(const char *libname)
Definition: iplib.cc:643
char * iiConvName(const char *libname)
Definition: iplib.cc:1214
int BOOLEAN
Definition: auxiliary.h:85
BOOLEAN load_modules(const char *newlib, char *fullname, BOOLEAN autoexport)
Definition: iplib.cc:982
#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:83
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, const struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:401
const char sNoName_fe[]
Definition: fevoices.cc:65
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
leftv next
Definition: subexpr.h:87
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 8628 of file iparith.cc.

8629 {
8630  int i;
8631  int an=1;
8632  int en=sArithBase.nLastIdentifier;
8633 
8634  loop
8635  //for(an=0; an<sArithBase.nCmdUsed; )
8636  {
8637  if(an>=en-1)
8638  {
8639  if (strcmp(n, sArithBase.sCmds[an].name) == 0)
8640  {
8641  i=an;
8642  break;
8643  }
8644  else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
8645  {
8646  i=en;
8647  break;
8648  }
8649  else
8650  {
8651  // -- blackbox extensions:
8652  // return 0;
8653  return blackboxIsCmd(n,tok);
8654  }
8655  }
8656  i=(an+en)/2;
8657  if (*n < *(sArithBase.sCmds[i].name))
8658  {
8659  en=i-1;
8660  }
8661  else if (*n > *(sArithBase.sCmds[i].name))
8662  {
8663  an=i+1;
8664  }
8665  else
8666  {
8667  int v=strcmp(n,sArithBase.sCmds[i].name);
8668  if(v<0)
8669  {
8670  en=i-1;
8671  }
8672  else if(v>0)
8673  {
8674  an=i+1;
8675  }
8676  else /*v==0*/
8677  {
8678  break;
8679  }
8680  }
8681  }
8683  tok=sArithBase.sCmds[i].tokval;
8684  if(sArithBase.sCmds[i].alias==2)
8685  {
8686  Warn("outdated identifier `%s` used - please change your code",
8687  sArithBase.sCmds[i].name);
8688  sArithBase.sCmds[i].alias=1;
8689  }
8690  #if 0
8691  if (currRingHdl==NULL)
8692  {
8693  #ifdef SIQ
8694  if (siq<=0)
8695  {
8696  #endif
8697  if ((tok>=BEGIN_RING) && (tok<=END_RING))
8698  {
8699  WerrorS("no ring active");
8700  return 0;
8701  }
8702  #ifdef SIQ
8703  }
8704  #endif
8705  }
8706  #endif
8707  if (!expected_parms)
8708  {
8709  switch (tok)
8710  {
8711  case IDEAL_CMD:
8712  case INT_CMD:
8713  case INTVEC_CMD:
8714  case MAP_CMD:
8715  case MATRIX_CMD:
8716  case MODUL_CMD:
8717  case POLY_CMD:
8718  case PROC_CMD:
8719  case RING_CMD:
8720  case STRING_CMD:
8721  cmdtok = tok;
8722  break;
8723  }
8724  }
8725  return sArithBase.sCmds[i].toktype;
8726 }
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:83
Definition: tok.h:95
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:920
void * data
Definition: subexpr.h:89
int rtyp
Definition: subexpr.h:92
BOOLEAN jjBETTI2_ID(leftv res, leftv u, leftv v)
Definition: ipshell.cc:899

◆ jjBETTI2()

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

Definition at line 920 of file ipshell.cc.

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

◆ jjBETTI2_ID()

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

Definition at line 899 of file ipshell.cc.

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

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3267 of file ipshell.cc.

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

◆ jjIMPORTFROM()

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

Definition at line 2185 of file ipassign.cc.

2186 {
2187  //Print("importfrom %s::%s ->.\n",v->Name(),u->Name() );
2188  assume(u->Typ()==PACKAGE_CMD);
2189  char *vn=(char *)v->Name();
2190  idhdl h=((package)(u->Data()))->idroot->get(vn /*v->Name()*/, myynest);
2191  if (h!=NULL)
2192  {
2193  //check for existence
2194  if (((package)(u->Data()))==basePack)
2195  {
2196  WarnS("source and destination packages are identical");
2197  return FALSE;
2198  }
2199  idhdl t=basePack->idroot->get(vn /*v->Name()*/, myynest);
2200  if (t!=NULL)
2201  {
2202  if (BVERBOSE(V_REDEFINE)) Warn("redefining %s (%s)",vn,my_yylinebuf);
2203  killhdl(t);
2204  }
2205  sleftv tmp_expr;
2206  if (iiDeclCommand(&tmp_expr,v,myynest,DEF_CMD,&IDROOT)) return TRUE;
2207  sleftv h_expr;
2208  memset(&h_expr,0,sizeof(h_expr));
2209  h_expr.rtyp=IDHDL;
2210  h_expr.data=h;
2211  h_expr.name=vn;
2212  return iiAssign(&tmp_expr,&h_expr);
2213  }
2214  else
2215  {
2216  Werror("`%s` not found in `%s`",v->Name(), u->Name());
2217  return TRUE;
2218  }
2219  return FALSE;
2220 }
ip_package * package
Definition: structs.h:46
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define FALSE
Definition: auxiliary.h:94
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:98
#define WarnS
Definition: emacs.cc:81
int Typ()
Definition: subexpr.cc:995
const char * Name()
Definition: subexpr.h:121
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:31
void * data
Definition: subexpr.h:89
int myynest
Definition: febase.cc:46
char my_yylinebuf[80]
Definition: febase.cc:48
Definition: tok.h:58
const char * name
Definition: subexpr.h:88
#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
#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:92
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 7269 of file iparith.cc.

7270 {
7271  int sl=0;
7272  if (v!=NULL) sl = v->listLength();
7273  lists L;
7274  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7275  {
7276  int add_row_shift = 0;
7277  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7278  if (weights!=NULL) add_row_shift=weights->min_in();
7279  L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7280  }
7281  else
7282  {
7284  leftv h=NULL;
7285  int i;
7286  int rt;
7287 
7288  L->Init(sl);
7289  for (i=0;i<sl;i++)
7290  {
7291  if (h!=NULL)
7292  { /* e.g. not in the first step:
7293  * h is the pointer to the old sleftv,
7294  * v is the pointer to the next sleftv
7295  * (in this moment) */
7296  h->next=v;
7297  }
7298  h=v;
7299  v=v->next;
7300  h->next=NULL;
7301  rt=h->Typ();
7302  if (rt==0)
7303  {
7304  L->Clean();
7305  Werror("`%s` is undefined",h->Fullname());
7306  return TRUE;
7307  }
7308  if (rt==RING_CMD)
7309  {
7310  L->m[i].rtyp=rt; L->m[i].data=h->Data();
7311  ((ring)L->m[i].data)->ref++;
7312  }
7313  else
7314  L->m[i].Copy(h);
7315  }
7316  }
7317  res->data=(char *)L;
7318  return FALSE;
7319 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:94
lists syConvRes(syStrategy syzstr, BOOLEAN toDel, int add_row_shift)
Definition: ipshell.cc:3103
int listLength()
Definition: subexpr.cc:60
#define TRUE
Definition: auxiliary.h:98
int min_in()
Definition: intvec.h:113
int Typ()
Definition: subexpr.cc:995
const char * Fullname()
Definition: subexpr.h:126
void * data
Definition: subexpr.h:89
Definition: intvec.h:14
void Copy(leftv e)
Definition: subexpr.cc:688
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:87
INLINE_THIS void Init(int l=0)
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:135
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void Clean(ring r=currRing)
Definition: lists.h:25
void * Data()
Definition: subexpr.cc:1137
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 5117 of file iparith.cc.

5118 {
5119  char libnamebuf[1024];
5120  lib_types LT = type_of_LIB(s, libnamebuf);
5121 
5122 #ifdef HAVE_DYNAMIC_LOADING
5123  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5124 #endif /* HAVE_DYNAMIC_LOADING */
5125  switch(LT)
5126  {
5127  default:
5128  case LT_NONE:
5129  Werror("%s: unknown type", s);
5130  break;
5131  case LT_NOTFOUND:
5132  Werror("cannot open %s", s);
5133  break;
5134 
5135  case LT_SINGULAR:
5136  {
5137  char *plib = iiConvName(s);
5138  idhdl pl = IDROOT->get(plib,0);
5139  if (pl==NULL)
5140  {
5141  pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5142  IDPACKAGE(pl)->language = LANG_SINGULAR;
5143  IDPACKAGE(pl)->libname=omStrDup(plib);
5144  }
5145  else if (IDTYP(pl)!=PACKAGE_CMD)
5146  {
5147  Werror("can not create package `%s`",plib);
5148  omFree(plib);
5149  return TRUE;
5150  }
5151  package savepack=currPack;
5152  currPack=IDPACKAGE(pl);
5153  IDPACKAGE(pl)->loaded=TRUE;
5154  char libnamebuf[1024];
5155  FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5156  BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5157  currPack=savepack;
5158  IDPACKAGE(pl)->loaded=(!bo);
5159  return bo;
5160  }
5161  case LT_BUILTIN:
5162  SModulFunc_t iiGetBuiltinModInit(const char*);
5163  return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5164  case LT_MACH_O:
5165  case LT_ELF:
5166  case LT_HPUX:
5167 #ifdef HAVE_DYNAMIC_LOADING
5168  return load_modules(s, libnamebuf, autoexport);
5169 #else /* HAVE_DYNAMIC_LOADING */
5170  WerrorS("Dynamic modules are not supported by this version of Singular");
5171  break;
5172 #endif /* HAVE_DYNAMIC_LOADING */
5173  }
5174  return TRUE;
5175 }
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:1080
#define NULL
Definition: omList.c:10
SModulFunc_t iiGetBuiltinModInit(const char *libname)
Definition: iplib.cc:643
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:807
char * iiConvName(const char *libname)
Definition: iplib.cc:1214
int BOOLEAN
Definition: auxiliary.h:85
BOOLEAN load_modules(const char *newlib, char *fullname, BOOLEAN autoexport)
Definition: iplib.cc:982
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ jjLOAD_TRY()

BOOLEAN jjLOAD_TRY ( const char *  s)

Definition at line 5181 of file iparith.cc.

5182 {
5183  void (*WerrorS_save)(const char *s) = WerrorS_callback;
5186  BOOLEAN bo=jjLOAD(s,TRUE);
5187  if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
5188  Print("loading of >%s< failed\n",s);
5189  WerrorS_callback=WerrorS_save;
5190  errorreported=0;
5191  return FALSE;
5192 }
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:5176
#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:5117
static void WerrorS_dummy(const char *)
Definition: iparith.cc:5177
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
void * data
Definition: subexpr.h:89
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
static resolvente iiCopyRes(resolvente r, int l)
Definition: ipshell.cc:855
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:135
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:215
void * Data()
Definition: subexpr.cc:1137
ideal * resolvente
Definition: ideals.h:18

◆ jjRESULTANT()

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

Definition at line 3260 of file ipshell.cc.

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

◆ 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. */
796  const short t[]={7,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,POLY_CMD,POLY_CMD,MATRIX_CMD};
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;
1379  setFlag(res,FLAG_TWOSTD);
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  {
2008  const short t[]={8,IDEAL_CMD,INT_CMD,INT_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD};
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  {
2036  const short t[]={7,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD};
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  {
2176  const short t[]={9,IDEAL_CMD,INTVEC_CMD,INTVEC_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD,INT_CMD};
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:3426
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
const CanonicalForm int s
Definition: facAbsFact.cc:55
ring rEnvelope(ring R)
Definition: ring.cc:5483
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:2307
void factoryseed(int s)
random seed initializer
Definition: cf_random.cc:176
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#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:4431
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
int rows() const
Definition: bigintmat.h:146
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
int rows() const
Definition: intvec.h:88
ring rOpposite(ring src)
Definition: ring.cc:5155
#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:1845
char * getenv()
BOOLEAN spectrumProc(leftv result, leftv first)
Definition: ipshell.cc:4053
#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:4390
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...
int Typ()
Definition: subexpr.cc:995
const char * Name()
Definition: subexpr.h:121
matrix evSwap(matrix M, int i, int j)
Definition: eigenval.cc:25
Definition: idrec.h:34
#define ivTest(v)
Definition: intvec.h:149
idhdl get(const char *s, int lev)
Definition: ipid.cc:90
intvec * MPertVectorslp(ideal G, intvec *ivtarget, int pdeg)
Definition: walk.cc:1308
void * data
Definition: subexpr.h:89
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 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:4104
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
leftv next
Definition: subexpr.h:87
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:4471
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:6470
coeffs basecoeffs() const
Definition: bigintmat.h:147
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:92
#define TEST_FOR(A)
void * Data()
Definition: subexpr.cc:1137
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:4348
intvec * MivUnit(int nV)
Definition: walk.cc:1505
ideal idXXX(ideal h1, int k)
Definition: ideals.cc:657
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
void * CopyD(int t)
Definition: subexpr.cc:707
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 6226 of file ipshell.cc.

6227 {
6228  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6229  ideal I=(ideal)u->Data();
6230  int i;
6231  int n=0;
6232  for(i=I->nrows*I->ncols-1;i>=0;i--)
6233  {
6234  int n0=pGetVariables(I->m[i],e);
6235  if (n0>n) n=n0;
6236  }
6237  jjINT_S_TO_ID(n,e,res);
6238  return FALSE;
6239 }
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6196
#define pGetVariables(p, e)
Definition: polys.h:234
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
int i
Definition: cfEzgcd.cc:123
void * Data()
Definition: subexpr.cc:1137
#define omAlloc0(size)
Definition: omAllocDecl.h:211

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6218 of file ipshell.cc.

6219 {
6220  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6221  int n=pGetVariables((poly)u->Data(),e);
6222  jjINT_S_TO_ID(n,e,res);
6223  return FALSE;
6224 }
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6196
#define pGetVariables(p, e)
Definition: polys.h:234
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
void * Data()
Definition: subexpr.cc:1137
polyrec * poly
Definition: hilb.h:10
#define omAlloc0(size)
Definition: omAllocDecl.h:211

◆ killlocals()

void killlocals ( int  v)

Definition at line 378 of file ipshell.cc.

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

◆ kQHWeight()

BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3243 of file ipshell.cc.

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

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3221 of file ipshell.cc.

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

◆ 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  {
448  currPack=IDPACKAGE(h);
449  //Print("list_cmd:package\n");
450  all=TRUE;typ=PROC_CMD;fullname=TRUE;really_all=TRUE;
451  h=IDPACKAGE(h)->idroot;
452  }
453  else
454  {
455  currPack=savePack;
456  return;
457  }
458  }
459  else
460  {
461  Werror("%s is undefined",what);
462  currPack=savePack;
463  return;
464  }
465  }
466  all=TRUE;
467  }
468  else if (RingDependend(typ))
469  {
470  h = currRing->idroot;
471  }
472  else
473  h = IDROOT;
474  start=h;
475  while (h!=NULL)
476  {
477  if ((all
478  && (IDTYP(h)!=PROC_CMD)
479  &&(IDTYP(h)!=PACKAGE_CMD)
480  &&(IDTYP(h)!=CRING_CMD)
481  )
482  || (typ == IDTYP(h))
483  || ((IDTYP(h)==CRING_CMD) && (typ==RING_CMD))
484  )
485  {
486  list1(prefix,h,start==currRingHdl, fullname);
487  if ((IDTYP(h)==RING_CMD)
488  && (really_all || (all && (h==currRingHdl)))
489  && ((IDLEV(h)==0)||(IDLEV(h)==myynest)))
490  {
491  list_cmd(0,IDID(h),"// ",FALSE);
492  }
493  if (IDTYP(h)==PACKAGE_CMD && really_all)
494  {
495  package save_p=currPack;
496  currPack=IDPACKAGE(h);
497  list_cmd(0,IDID(h),"// ",FALSE);
498  currPack=save_p;
499  }
500  }
501  h = IDNEXT(h);
502  }
503  currPack=savePack;
504 }
#define IDID(a)
Definition: ipid.h:119
#define FALSE
Definition: auxiliary.h:94
#define IDNEXT(a)
Definition: ipid.h:115
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:98
static void list1(const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
Definition: ipshell.cc:147
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:136
int myynest
Definition: febase.cc:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
#define IDTYP(a)
Definition: ipid.h:116
Definition: tok.h:56
int RingDependend(int t)
Definition: gentable.cc:23
void list_cmd(int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname)
Definition: ipshell.cc:417
idhdl currRingHdl
Definition: ipid.cc:65
void PrintS(const char *s)
Definition: reporter.cc:284
#define IDLEV(a)
Definition: ipid.h:118
Definition: tok.h:34
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
#define IDRING(a)
Definition: ipid.h:124
package currPack
Definition: ipid.cc:63
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:495

◆ loNewtonP()

BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4483 of file ipshell.cc.

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

◆ loSimplex()

BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4489 of file ipshell.cc.

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

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 2991 of file ipshell.cc.

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

◆ mpKoszul()

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

Definition at line 3013 of file ipshell.cc.

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

◆ nuLagSolve()

BOOLEAN nuLagSolve ( leftv  res,
leftv  arg1,
leftv  arg2,
leftv  arg3 
)

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

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

Definition at line 4598 of file ipshell.cc.

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

◆ nuMPResMat()

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

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

Definition at line 4575 of file ipshell.cc.

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

◆ nuUResSolve()

BOOLEAN nuUResSolve ( leftv  res,
leftv  args 
)

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

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

Definition at line 4828 of file ipshell.cc.

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

◆ nuVanderSys()

BOOLEAN nuVanderSys ( leftv  res,
leftv  arg1,
leftv  arg2,
leftv  arg3 
)

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

Definition at line 4727 of file ipshell.cc.

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

◆ paPrint()

void paPrint ( const char *  n,
package  p 
)

Definition at line 6241 of file ipshell.cc.

6242 {
6243  Print(" %s (",n);
6244  switch (p->language)
6245  {
6246  case LANG_SINGULAR: PrintS("S"); break;
6247  case LANG_C: PrintS("C"); break;
6248  case LANG_TOP: PrintS("T"); break;
6249  case LANG_NONE: PrintS("N"); break;
6250  default: PrintS("U");
6251  }
6252  if(p->libname!=NULL)
6253  Print(",%s", p->libname);
6254  PrintS(")");
6255 }
#define Print
Definition: emacs.cc:83
return P p
Definition: myNF.cc:203
Definition: subexpr.h:22
void PrintS(const char *s)
Definition: reporter.cc:284
#define NULL
Definition: omList.c:10

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2040 of file ipshell.cc.

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

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1838 of file ipshell.cc.

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

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 1909 of file ipshell.cc.

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

◆ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1549 of file ipshell.cc.

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

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1594 of file ipshell.cc.

1595 {
1597  if (h!=NULL) return h;
1598  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1599  if (h!=NULL) return h;
1601  while(p!=NULL)
1602  {
1603  if ((p->cPack!=basePack)
1604  && (p->cPack!=currPack))
1605  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1606  if (h!=NULL) return h;
1607  p=p->next;
1608  }
1609  idhdl tmp=basePack->idroot;
1610  while (tmp!=NULL)
1611  {
1612  if (IDTYP(tmp)==PACKAGE_CMD)
1613  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1614  if (h!=NULL) return h;
1615  tmp=IDNEXT(tmp);
1616  }
1617  return NULL;
1618 }
idhdl rSimpleFindHdl(ring r, idhdl root, idhdl n)
Definition: ipshell.cc:6133
return P p
Definition: myNF.cc:203
#define IDNEXT(a)
Definition: ipid.h:115
proclevel * procstack
Definition: ipid.cc:58
#define IDROOT
Definition: ipid.h:20
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:136
#define IDTYP(a)
Definition: ipid.h:116
const ring r
Definition: syzextra.cc:208
Definition: ipid.h:56
proclevel * next
Definition: ipid.h:59
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
package currPack
Definition: ipid.cc:63
static Poly * h
Definition: janet.cc:978
package cPack
Definition: ipid.h:61

◆ rInit()

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

Definition at line 5518 of file ipshell.cc.

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

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6107 of file ipshell.cc.

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

◆ rKill() [2/2]

void rKill ( ring  r)

Definition at line 6056 of file ipshell.cc.

6057 {
6058  if ((r->ref<=0)&&(r->order!=NULL))
6059  {
6060 #ifdef RDEBUG
6061  if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6062 #endif
6063  if (r->qideal!=NULL)
6064  {
6065  id_Delete(&r->qideal, r);
6066  r->qideal = NULL;
6067  }
6068  int j;
6069  for (j=0;j<myynest;j++)
6070  {
6071  if (iiLocalRing[j]==r)
6072  {
6073  if (j==0) WarnS("killing the basering for level 0");
6074  iiLocalRing[j]=NULL;
6075  }
6076  }
6077 // any variables depending on r ?
6078  while (r->idroot!=NULL)
6079  {
6080  r->idroot->lev=myynest; // avoid warning about kill global objects
6081  killhdl2(r->idroot,&(r->idroot),r);
6082  }
6083  if (r==currRing)
6084  {
6085  // all dependend stuff is done, clean global vars:
6086  if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6088  {
6090  }
6091  //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6092  //{
6093  // WerrorS("return value depends on local ring variable (export missing ?)");
6094  // iiRETURNEXPR.CleanUp();
6095  //}
6096  currRing=NULL;
6097  currRingHdl=NULL;
6098  }
6099 
6100  /* nKillChar(r); will be called from inside of rDelete */
6101  rDelete(r);
6102  return;
6103  }
6104  r->ref--;
6105 }
#define TRACE_SHOW_RINGS
Definition: reporter.h:35
#define Print
Definition: emacs.cc:83
void id_Delete(ideal *h, ring r)
deletes an ideal/module/matrix
int traceit
Definition: febase.cc:47
#define WarnS
Definition: emacs.cc:81
int myynest
Definition: febase.cc:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:408
const ring r
Definition: syzextra.cc:208
BOOLEAN RingDependend()
Definition: subexpr.cc:402
int j
Definition: myNF.cc:70
idhdl currRingHdl
Definition: ipid.cc:65
ring * iiLocalRing
Definition: iplib.cc:470
#define NULL
Definition: omList.c:10
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:450
#define pDelete(p_ptr)
Definition: polys.h:169
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:332

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5032 of file ipshell.cc.

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

◆ rSimpleFindHdl()

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

Definition at line 6133 of file ipshell.cc.

6134 {
6135  idhdl h=root;
6136  while (h!=NULL)
6137  {
6138  if ((IDTYP(h)==RING_CMD)
6139  && (h!=n)
6140  && (IDRING(h)==r)
6141  )
6142  {
6143  return h;
6144  }
6145  h=IDNEXT(h);
6146  }
6147  return NULL;
6148 }
#define IDNEXT(a)
Definition: ipid.h:115
Definition: idrec.h:34
#define IDTYP(a)
Definition: ipid.h:116
const ring r
Definition: syzextra.cc:208
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:124
static Poly * h
Definition: janet.cc:978

◆ scIndIndset()

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

Definition at line 1022 of file ipshell.cc.

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

◆ semicProc()

BOOLEAN semicProc ( leftv  ,
leftv  ,
leftv   
)

Definition at line 4471 of file ipshell.cc.

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

◆ semicProc3()

BOOLEAN semicProc3 ( leftv  ,
leftv  ,
leftv  ,
leftv   
)

Definition at line 4431 of file ipshell.cc.

4432 {
4433  semicState state;
4434  BOOLEAN qh=(((int)(long)w->Data())==1);
4435 
4436  // -----------------
4437  // check arguments
4438  // -----------------
4439 
4440  lists l1 = (lists)u->Data( );
4441  lists l2 = (lists)v->Data( );
4442 
4443  if( (state=list_is_spectrum( l1 ))!=semicOK )
4444  {
4445  WerrorS( "first argument is not a spectrum" );
4446  list_error( state );
4447  }
4448  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4449  {
4450  WerrorS( "second argument is not a spectrum" );
4451  list_error( state );
4452  }
4453  else
4454  {
4455  spectrum s1= spectrumFromList( l1 );
4456  spectrum s2= spectrumFromList( l2 );
4457 
4458  res->rtyp = INT_CMD;
4459  if (qh)
4460  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4461  else
4462  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4463  }
4464 
4465  // -----------------
4466  // check status
4467  // -----------------
4468 
4469  return (state!=semicOK);
4470 }
Definition: tok.h:95
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3304
void list_error(semicState state)
Definition: ipshell.cc:3388
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
poly res
Definition: myNF.cc:322
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4173
int mult_spectrumh(spectrum &)
Definition: semic.cc:425
semicState
Definition: ipshell.cc:3354
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
int Typ()
Definition: subexpr.cc:995
#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
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
#define V_SHOW_MEM
Definition: options.h:41
#define TEST_OPT_INTSTRATEGY
Definition: options.h:105
Definition: intvec.h:14
const char * name
Definition: subexpr.h:88
#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
leftv next
Definition: subexpr.h:87
#define OPT_INTSTRATEGY
Definition: options.h:87
#define BVERBOSE(a)
Definition: options.h:33
CanonicalForm test
Definition: cfModGcd.cc:4037
#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
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1137
#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
void * CopyD(int t)
Definition: subexpr.cc:707
#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  {
732  StringAppend(" %s",optionStruct[i].name);
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  {
748  StringAppend(" %s",verboseStruct[i].name);
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);
458  s=iiGetLibProcBuffer(IDPROC(h), 2);
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:591
#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 4348 of file ipshell.cc.

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

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

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  ,
leftv   
)

Definition at line 4053 of file ipshell.cc.

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

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

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

◆ syBetti2()

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

Definition at line 3068 of file ipshell.cc.

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

◆ syConvList()

syStrategy syConvList ( lists  li)

Definition at line 3176 of file ipshell.cc.

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

◆ syConvRes()

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

Definition at line 3103 of file ipshell.cc.

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

◆ syForceMin()

syStrategy syForceMin ( lists  li)

Definition at line 3205 of file ipshell.cc.

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

◆ test_cmd()

void test_cmd ( int  i)

Definition at line 506 of file ipshell.cc.

507 {
508  int ii;
509 
510  if (i<0)
511  {
512  ii= -i;
513  if (ii < 32)
514  {
515  si_opt_1 &= ~Sy_bit(ii);
516  }
517  else if (ii < 64)
518  {
519  si_opt_2 &= ~Sy_bit(ii-32);
520  }
521  else
522  WerrorS("out of bounds\n");
523  }
524  else if (i<32)
525  {
526  ii=i;
527  if (Sy_bit(ii) & kOptions)
528  {
529  Warn("Gerhard, use the option command");
530  si_opt_1 |= Sy_bit(ii);
531  }
532  else if (Sy_bit(ii) & validOpts)
533  si_opt_1 |= Sy_bit(ii);
534  }
535  else if (i<64)
536  {
537  ii=i-32;
538  si_opt_2 |= Sy_bit(ii);
539  }
540  else
541  WerrorS("out of bounds\n");
542 }
unsigned si_opt_1
Definition: options.c:5
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define Sy_bit(x)
Definition: options.h:30
BITSET validOpts
Definition: kstd1.cc:63
int i
Definition: cfEzgcd.cc:123
BITSET kOptions
Definition: kstd1.cc:48
unsigned si_opt_2
Definition: options.c:6
#define Warn
Definition: emacs.cc:80

◆ 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:895
#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
int Typ()
Definition: subexpr.cc:995
const char * Name()
Definition: subexpr.h:121
void Print(leftv store=NULL, int spaces=0)
Called by type_cmd (e.g. "r;") or as default in jPRINT.
Definition: subexpr.cc:72
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:10
Definition: intvec.h:14
#define MATCOLS(i)
Definition: matpol.h:28
#define NULL
Definition: omList.c:10
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:132
void * Data()
Definition: subexpr.cc:1137
Definition: tok.h:117
#define MATROWS(i)
Definition: matpol.h:27
int BOOLEAN
Definition: auxiliary.h:85

◆ 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 290 of file table.h.

◆ dArith3

const struct sValCmd3 dArith3[]

Definition at line 713 of file table.h.

◆ dArithM

const struct sValCmdM dArithM[]

Definition at line 823 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 470 of file iplib.cc.

◆ iiOp

int iiOp

Definition at line 224 of file iparith.cc.

◆ iiRETURNEXPR

sleftv iiRETURNEXPR

Definition at line 471 of file iplib.cc.

◆ iiRETURNEXPR_len

int iiRETURNEXPR_len

Definition at line 472 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.