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

Go to the source code of this file.

Data Structures

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

Typedefs

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

Functions

BOOLEAN spectrumProc (leftv, leftv)
 
BOOLEAN spectrumfProc (leftv, leftv)
 
BOOLEAN spaddProc (leftv, leftv, leftv)
 
BOOLEAN spmulProc (leftv, leftv, leftv)
 
BOOLEAN semicProc (leftv, leftv, leftv)
 
BOOLEAN semicProc3 (leftv, leftv, leftv, leftv)
 
BOOLEAN iiAssignCR (leftv, leftv)
 
BOOLEAN iiARROW (leftv, char *, char *)
 
int IsCmd (const char *n, int &tok)
 
BOOLEAN iiPStart (idhdl pn, leftv sl)
 
BOOLEAN iiEStart (char *example, procinfo *pi)
 
BOOLEAN iiAllStart (procinfov pi, char *p, feBufferTypes t, int l)
 
void type_cmd (leftv v)
 
void test_cmd (int i)
 
void list_cmd (int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname=FALSE)
 
void killlocals (int v)
 
int exprlist_length (leftv v)
 
const char * Tok2Cmdname (int i)
 
const char * iiTwoOps (int t)
 
int iiOpsTwoChar (const char *s)
 
BOOLEAN iiWRITE (leftv res, leftv exprlist)
 
BOOLEAN iiExport (leftv v, int toLev)
 
BOOLEAN iiExport (leftv v, int toLev, package pack)
 
BOOLEAN iiInternalExport (leftv v, int toLev, package pack)
 
static char * iiGetLibName (const procinfov pi)
 find the library of an proc More...
 
char * iiGetLibProcBuffer (procinfov pi, int part=1)
 
char * iiProcName (char *buf, char &ct, char *&e)
 
char * iiProcArgs (char *e, BOOLEAN withParenth)
 
BOOLEAN iiLibCmd (char *newlib, BOOLEAN autoexport, BOOLEAN tellerror, BOOLEAN force)
 
BOOLEAN jjLOAD (const char *s, BOOLEAN autoexport=FALSE)
 load lib/module given in v More...
 
BOOLEAN jjLOAD_TRY (const char *s)
 
BOOLEAN iiLocateLib (const char *lib, char *where)
 
leftv iiMap (map theMap, const char *what)
 
void iiMakeResolv (resolvente r, int length, int rlen, char *name, int typ0, intvec **weights=NULL)
 
BOOLEAN jjMINRES (leftv res, leftv v)
 
BOOLEAN jjBETTI (leftv res, leftv v)
 
BOOLEAN jjBETTI2 (leftv res, leftv u, leftv v)
 
BOOLEAN jjBETTI2_ID (leftv res, leftv u, leftv v)
 
BOOLEAN jjIMPORTFROM (leftv res, leftv u, leftv v)
 
BOOLEAN jjLIST_PL (leftv res, leftv v)
 
BOOLEAN jjVARIABLES_P (leftv res, leftv u)
 
BOOLEAN jjVARIABLES_ID (leftv res, leftv u)
 
int iiRegularity (lists L)
 
leftv singular_system (sleftv h)
 
BOOLEAN jjSYSTEM (leftv res, leftv v)
 
void iiDebug ()
 
BOOLEAN iiCheckRing (int i)
 
poly iiHighCorner (ideal i, int ak)
 
char * iiConvName (const char *libname)
 
BOOLEAN iiLoadLIB (FILE *fp, const char *libnamebuf, const char *newlib, idhdl pl, BOOLEAN autoexport, BOOLEAN tellerror)
 
lists syConvRes (syStrategy syzstr, BOOLEAN toDel=FALSE, int add_row_shift=0)
 
syStrategy syForceMin (lists li)
 
syStrategy syConvList (lists li)
 
BOOLEAN syBetti1 (leftv res, leftv u)
 
BOOLEAN syBetti2 (leftv res, leftv u, leftv w)
 
BOOLEAN iiExprArith1 (leftv res, sleftv *a, int op)
 
BOOLEAN iiExprArith2 (leftv res, sleftv *a, int op, sleftv *b, BOOLEAN proccall=FALSE)
 
BOOLEAN iiExprArith3 (leftv res, int op, leftv a, leftv b, leftv c)
 
BOOLEAN iiExprArithM (leftv res, sleftv *a, int op)
 
BOOLEAN iiApply (leftv res, leftv a, int op, leftv proc)
 
BOOLEAN iiAssign (leftv left, leftv right, BOOLEAN toplevel=TRUE)
 
BOOLEAN iiParameter (leftv p)
 
BOOLEAN iiAlias (leftv p)
 
int iiTokType (int op)
 
int iiDeclCommand (leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring=FALSE, BOOLEAN init_b=TRUE)
 
BOOLEAN iiMake_proc (idhdl pn, package pack, leftv sl)
 
void * iiCallLibProc1 (const char *n, void *arg, int arg_type, BOOLEAN &err)
 
void * iiCallLibProcM (const char *n, void **args, int *arg_types, BOOLEAN &err)
 args: NULL terminated arry of arguments arg_types: 0 terminated array of corresponding types More...
 
char * showOption ()
 
BOOLEAN setOption (leftv res, leftv v)
 
char * versionString ()
 
void singular_example (char *str)
 
BOOLEAN iiTryLoadLib (leftv v, const char *id)
 
int iiAddCproc (const char *libname, const char *procname, BOOLEAN pstatic, BOOLEAN(*func)(leftv res, leftv v))
 
void iiCheckPack (package &p)
 
void rSetHdl (idhdl h)
 
ring rInit (leftv pn, leftv rv, leftv ord)
 
idhdl rDefault (const char *s)
 
idhdl rSimpleFindHdl (ring r, idhdl root, idhdl n=NULL)
 
idhdl rFindHdl (ring r, idhdl n)
 
void rKill (idhdl h)
 
void rKill (ring r)
 
lists scIndIndset (ideal S, BOOLEAN all, ideal Q)
 
BOOLEAN mpKoszul (leftv res, leftv c, leftv b, leftv id)
 
BOOLEAN mpJacobi (leftv res, leftv a)
 
BOOLEAN jjRESULTANT (leftv res, leftv u, leftv v, leftv w)
 
BOOLEAN kQHWeight (leftv res, leftv v)
 
BOOLEAN kWeight (leftv res, leftv id)
 
BOOLEAN loSimplex (leftv res, leftv args)
 Implementation of the Simplex Algorithm. More...
 
BOOLEAN loNewtonP (leftv res, leftv arg1)
 compute Newton Polytopes of input polynomials More...
 
BOOLEAN nuMPResMat (leftv res, leftv arg1, leftv arg2)
 returns module representing the multipolynomial resultant matrix Arguments 2: ideal i, int k k=0: use sparse resultant matrix of Gelfand, Kapranov and Zelevinsky k=1: use resultant matrix of Macaulay (k=0 is default) More...
 
BOOLEAN nuLagSolve (leftv res, leftv arg1, leftv arg2, leftv arg3)
 find the (complex) roots an univariate polynomial Determines the roots of an univariate polynomial using Laguerres' root-solver. More...
 
BOOLEAN nuVanderSys (leftv res, leftv arg1, leftv arg2, leftv arg3)
 COMPUTE: polynomial p with values given by v at points p1,..,pN derived from p; more precisely: consider p as point in K^n and v as N elements in K, let p1,..,pN be the points in K^n obtained by evaluating all monomials of degree 0,1,...,N at p in lexicographical order, then the procedure computes the polynomial f satisfying f(pi) = v[i] RETURN: polynomial f of degree d. More...
 
BOOLEAN nuUResSolve (leftv res, leftv args)
 solve a multipolynomial system using the u-resultant Input ideal must be 0-dimensional and (currRing->N) == IDELEMS(ideal). More...
 
BOOLEAN jjCHARSERIES (leftv res, leftv u)
 
void paPrint (const char *n, package p)
 
BOOLEAN iiTestAssume (leftv a, leftv b)
 
BOOLEAN iiExprArith1Tab (leftv res, leftv a, int op, const struct sValCmd1 *dA1, int at, const struct sConvertTypes *dConvertTypes)
 apply an operation 'op' to an argument a return TRUE on failure More...
 
BOOLEAN iiExprArith2Tab (leftv res, leftv a, int op, const struct sValCmd2 *dA2, int at, const struct sConvertTypes *dConvertTypes)
 apply an operation 'op' to arguments a and a->next return TRUE on failure More...
 
BOOLEAN iiExprArith3Tab (leftv res, leftv a, int op, const struct sValCmd3 *dA3, int at, const struct sConvertTypes *dConvertTypes)
 apply an operation 'op' to arguments a, a->next and a->next->next return TRUE on failure More...
 
BOOLEAN iiCheckTypes (leftv args, const short *type_list, int report=0)
 check a list of arguemys against a given field of types return TRUE if the types match return FALSE (and, if report) report an error via Werror otherwise More...
 
BOOLEAN iiBranchTo (leftv r, leftv args)
 
lists rDecompose (const ring r)
 
lists rDecompose_list_cf (const ring r)
 
BOOLEAN rDecompose_CF (leftv res, const coeffs C)
 
ring rCompose (const lists L, const BOOLEAN check_comp=TRUE, const long bitmask=0x7fff, const int isLetterplace=FALSE)
 

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 78 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 69 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 86 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 96 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 104 of file gentable.cc.

Data Fields
short arg
int p
proc1 p
short res

◆ sValAssign

struct sValAssign

Definition at line 111 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 121 of file ipshell.h.

◆ proc2

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

Definition at line 133 of file ipshell.h.

◆ proc3

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

Definition at line 144 of file ipshell.h.

◆ proci

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

Definition at line 173 of file ipshell.h.

Function Documentation

◆ exprlist_length()

int exprlist_length ( leftv  v)

Definition at line 547 of file ipshell.cc.

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

◆ iiAddCproc()

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

Definition at line 1004 of file iplib.cc.

1006 {
1007  procinfov pi;
1008  idhdl h;
1009 
1010  #ifndef SING_NDEBUG
1011  int dummy;
1012  if (IsCmd(procname,dummy))
1013  {
1014  Werror(">>%s< is a reserved name",procname);
1015  return 0;
1016  }
1017  #endif
1018 
1019  h=IDROOT->get(procname,0);
1020  if ((h!=NULL)
1021  && (IDTYP(h)==PROC_CMD))
1022  {
1023  pi = IDPROC(h);
1024  if ((pi->language == LANG_SINGULAR)
1025  &&(BVERBOSE(V_REDEFINE)))
1026  Warn("extend `%s`",procname);
1027  }
1028  else
1029  {
1030  h = enterid(procname,0, PROC_CMD, &IDROOT, TRUE);
1031  }
1032  if ( h!= NULL )
1033  {
1034  pi = IDPROC(h);
1035  if((pi->language == LANG_SINGULAR)
1036  ||(pi->language == LANG_NONE))
1037  {
1038  omfree(pi->libname);
1039  pi->libname = omStrDup(libname);
1040  omfree(pi->procname);
1041  pi->procname = omStrDup(procname);
1042  pi->language = LANG_C;
1043  pi->ref = 1;
1044  pi->is_static = pstatic;
1045  pi->data.o.function = func;
1046  }
1047  else if(pi->language == LANG_C)
1048  {
1049  if(pi->data.o.function == func)
1050  {
1051  pi->ref++;
1052  }
1053  else
1054  {
1055  omfree(pi->libname);
1056  pi->libname = omStrDup(libname);
1057  omfree(pi->procname);
1058  pi->procname = omStrDup(procname);
1059  pi->language = LANG_C;
1060  pi->ref = 1;
1061  pi->is_static = pstatic;
1062  pi->data.o.function = func;
1063  }
1064  }
1065  else
1066  Warn("internal error: unknown procedure type %d",pi->language);
1067  if (currPack->language==LANG_SINGULAR) currPack->language=LANG_MIX;
1068  return(1);
1069  }
1070  else
1071  {
1072  WarnS("iiAddCproc: failed.");
1073  }
1074  return(0);
1075 }
language_defs language
Definition: subexpr.h:59
#define IDROOT
Definition: ipid.h:18
#define TRUE
Definition: auxiliary.h:98
short ref
Definition: subexpr.h:60
#define WarnS
Definition: emacs.cc:78
Definition: idrec.h:34
char * procname
Definition: subexpr.h:57
Definition: subexpr.h:22
#define IDTYP(a)
Definition: ipid.h:114
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:265
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:35
char is_static
Definition: subexpr.h:61
#define IDPROC(a)
Definition: ipid.h:135
#define pi
Definition: libparse.cc:1143
#define NULL
Definition: omList.c:12
package currPack
Definition: ipid.cc:57
static Poly * h
Definition: janet.cc:971
#define V_REDEFINE
Definition: options.h:45
void Werror(const char *fmt,...)
Definition: reporter.cc:189
int IsCmd(const char *n, int &tok)
Definition: iparith.cc:8897
#define Warn
Definition: emacs.cc:77
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiAlias()

BOOLEAN iiAlias ( leftv  p)

Definition at line 763 of file ipid.cc.

764 {
765  if (iiCurrArgs==NULL)
766  {
767  Werror("not enough arguments for proc %s",VoiceName());
768  p->CleanUp();
769  return TRUE;
770  }
772  iiCurrArgs=h->next;
773  h->next=NULL;
774  if (h->rtyp!=IDHDL)
775  {
776  BOOLEAN res=iiAssign(p,h);
777  h->CleanUp();
779  return res;
780  }
781  if ((h->Typ()!=p->Typ()) &&(p->Typ()!=DEF_CMD))
782  {
783  WerrorS("type mismatch");
784  return TRUE;
785  }
786  idhdl pp=(idhdl)p->data;
787  switch(pp->typ)
788  {
789  case CRING_CMD:
790  nKillChar((coeffs)pp);
791  break;
792  case DEF_CMD:
793  case INT_CMD:
794  break;
795  case INTVEC_CMD:
796  case INTMAT_CMD:
797  delete IDINTVEC(pp);
798  break;
799  case NUMBER_CMD:
800  nDelete(&IDNUMBER(pp));
801  break;
802  case BIGINT_CMD:
804  break;
805  case MAP_CMD:
806  {
807  map im = IDMAP(pp);
808  omFree((ADDRESS)im->preimage);
809  }
810  // continue as ideal:
811  case IDEAL_CMD:
812  case MODUL_CMD:
813  case MATRIX_CMD:
814  idDelete(&IDIDEAL(pp));
815  break;
816  case PROC_CMD:
817  case RESOLUTION_CMD:
818  case STRING_CMD:
819  omFree((ADDRESS)IDSTRING(pp));
820  break;
821  case LIST_CMD:
822  IDLIST(pp)->Clean();
823  break;
824  case LINK_CMD:
826  break;
827  // case ring: cannot happen
828  default:
829  Werror("unknown type %d",p->Typ());
830  return TRUE;
831  }
832  pp->typ=ALIAS_CMD;
833  IDDATA(pp)=(char*)h->data;
834  int eff_typ=h->Typ();
835  if ((RingDependend(eff_typ))
836  || ((eff_typ==LIST_CMD) && (lRingDependend((lists)h->Data()))))
837  {
838  ipSwapId(pp,IDROOT,currRing->idroot);
839  }
840  h->CleanUp();
842  return FALSE;
843 }
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:132
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: tok.h:96
#define IDLINK(a)
Definition: ipid.h:133
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
Definition: lists.h:23
#define IDINTVEC(a)
Definition: ipid.h:123
#define FALSE
Definition: auxiliary.h:94
Definition: tok.h:38
#define IDROOT
Definition: ipid.h:18
#define TRUE
Definition: auxiliary.h:98
#define IDIDEAL(a)
Definition: ipid.h:128
void * ADDRESS
Definition: auxiliary.h:133
void WerrorS(const char *s)
Definition: feFopen.cc:24
coeffs coeffs_BIGINT
Definition: ipid.cc:50
int Typ()
Definition: subexpr.cc:1033
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:31
void * data
Definition: subexpr.h:88
int RingDependend(int t)
Definition: gentable.cc:28
Definition: tok.h:56
CanonicalForm res
Definition: facAbsFact.cc:64
Definition: tok.h:58
#define omFree(addr)
Definition: omAllocDecl.h:261
The main handler for Singular numbers which are suitable for Singular polynomials.
CanonicalForm pp(const CanonicalForm &)
CanonicalForm pp ( const CanonicalForm & f )
Definition: cf_gcd.cc:248
#define IDSTRING(a)
Definition: ipid.h:131
idrec * idhdl
Definition: ring.h:21
omBin sleftv_bin
Definition: subexpr.cc:41
const char * VoiceName()
Definition: fevoices.cc:56
#define nDelete(n)
Definition: numbers.h:16
#define IDMAP(a)
Definition: ipid.h:130
leftv next
Definition: subexpr.h:86
#define IDNUMBER(a)
Definition: ipid.h:127
Definition: tok.h:34
Definition: tok.h:117
#define NULL
Definition: omList.c:12
leftv iiCurrArgs
Definition: ipshell.cc:76
int rtyp
Definition: subexpr.h:91
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void * Data()
Definition: subexpr.cc:1176
int typ
Definition: idrec.h:43
Definition: tok.h:118
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete &#39;p&#39;
Definition: coeffs.h:455
#define IDDATA(a)
Definition: ipid.h:121
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
static Poly * h
Definition: janet.cc:971
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:596
void nKillChar(coeffs r)
undo all initialisations
Definition: numbers.cc:510
void Werror(const char *fmt,...)
Definition: reporter.cc:189
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1830

◆ iiAllStart()

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

Definition at line 292 of file iplib.cc.

293 {
294  // see below:
295  BITSET save1=si_opt_1;
296  BITSET save2=si_opt_2;
297  newBuffer( omStrDup(p /*pi->data.s.body*/), t /*BT_proc*/,
298  pi, l );
299  BOOLEAN err=yyparse();
300  if (sLastPrinted.rtyp!=0)
301  {
303  }
304  // the access to optionStruct and verboseStruct do not work
305  // on x86_64-Linux for pic-code
306  if ((TEST_V_ALLWARN) &&
307  (t==BT_proc) &&
308  ((save1!=si_opt_1)||(save2!=si_opt_2)) &&
309  (pi->libname!=NULL) && (pi->libname[0]!='\0'))
310  {
311  if ((pi->libname!=NULL) && (pi->libname[0]!='\0'))
312  Warn("option changed in proc %s from %s",pi->procname,pi->libname);
313  else
314  Warn("option changed in proc %s",pi->procname);
315  int i;
316  for (i=0; optionStruct[i].setval!=0; i++)
317  {
318  if ((optionStruct[i].setval & si_opt_1)
319  && (!(optionStruct[i].setval & save1)))
320  {
321  Print(" +%s",optionStruct[i].name);
322  }
323  if (!(optionStruct[i].setval & si_opt_1)
324  && ((optionStruct[i].setval & save1)))
325  {
326  Print(" -%s",optionStruct[i].name);
327  }
328  }
329  for (i=0; verboseStruct[i].setval!=0; i++)
330  {
331  if ((verboseStruct[i].setval & si_opt_2)
332  && (!(verboseStruct[i].setval & save2)))
333  {
334  Print(" +%s",verboseStruct[i].name);
335  }
336  if (!(verboseStruct[i].setval & si_opt_2)
337  && ((verboseStruct[i].setval & save2)))
338  {
339  Print(" -%s",verboseStruct[i].name);
340  }
341  }
342  PrintLn();
343  }
344  return err;
345 }
const struct soptionStruct optionStruct[]
Definition: misc_ip.cc:521
unsigned si_opt_1
Definition: options.c:5
void PrintLn()
Definition: reporter.cc:310
#define Print
Definition: emacs.cc:80
unsigned setval
Definition: ipid.h:148
#define BITSET
Definition: structs.h:20
char * procname
Definition: subexpr.h:57
char * libname
Definition: subexpr.h:56
int i
Definition: cfEzgcd.cc:125
char name(const Variable &v)
Definition: factory.h:180
int yyparse(void)
Definition: grammar.cc:2111
#define NULL
Definition: omList.c:12
int rtyp
Definition: subexpr.h:91
sleftv sLastPrinted
Definition: subexpr.cc:46
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:156
int p
Definition: cfModGcd.cc:4019
const struct soptionStruct verboseStruct[]
Definition: misc_ip.cc:551
unsigned si_opt_2
Definition: options.c:6
int BOOLEAN
Definition: auxiliary.h:85
#define TEST_V_ALLWARN
Definition: options.h:140
int l
Definition: cfEzgcd.cc:93
#define Warn
Definition: emacs.cc:77
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiApply()

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

Definition at line 6412 of file ipshell.cc.

6413 {
6414  memset(res,0,sizeof(sleftv));
6415  res->rtyp=a->Typ();
6416  switch (res->rtyp /*a->Typ()*/)
6417  {
6418  case INTVEC_CMD:
6419  case INTMAT_CMD:
6420  return iiApplyINTVEC(res,a,op,proc);
6421  case BIGINTMAT_CMD:
6422  return iiApplyBIGINTMAT(res,a,op,proc);
6423  case IDEAL_CMD:
6424  case MODUL_CMD:
6425  case MATRIX_CMD:
6426  return iiApplyIDEAL(res,a,op,proc);
6427  case LIST_CMD:
6428  return iiApplyLIST(res,a,op,proc);
6429  }
6430  WerrorS("first argument to `apply` must allow an index");
6431  return TRUE;
6432 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:1033
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6370
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6380
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6375
int rtyp
Definition: subexpr.h:91
Definition: tok.h:118
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6338

◆ iiARROW()

BOOLEAN iiARROW ( leftv  ,
char *  ,
char *   
)

Definition at line 6461 of file ipshell.cc.

6462 {
6463  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6464  // find end of s:
6465  int end_s=strlen(s);
6466  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6467  s[end_s+1]='\0';
6468  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6469  sprintf(name,"%s->%s",a,s);
6470  // find start of last expression
6471  int start_s=end_s-1;
6472  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6473  if (start_s<0) // ';' not found
6474  {
6475  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6476  }
6477  else // s[start_s] is ';'
6478  {
6479  s[start_s]='\0';
6480  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6481  }
6482  memset(r,0,sizeof(*r));
6483  // now produce procinfo for PROC_CMD:
6484  r->data = (void *)omAlloc0Bin(procinfo_bin);
6485  ((procinfo *)(r->data))->language=LANG_NONE;
6486  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6487  ((procinfo *)r->data)->data.s.body=ss;
6488  omFree(name);
6489  r->rtyp=PROC_CMD;
6490  //r->rtyp=STRING_CMD;
6491  //r->data=ss;
6492  return FALSE;
6493 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define FALSE
Definition: auxiliary.h:94
procinfo * iiInitSingularProcinfo(procinfov pi, const char *libname, const char *procname, int, long pos, BOOLEAN pstatic)
Definition: iplib.cc:990
#define omAlloc(size)
Definition: omAllocDecl.h:210
omBin procinfo_bin
Definition: subexpr.cc:42
#define omFree(addr)
Definition: omAllocDecl.h:261
char name(const Variable &v)
Definition: factory.h:180
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206

◆ iiAssign()

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

Definition at line 1830 of file ipassign.cc.

1831 {
1832  if (errorreported) return TRUE;
1833  int ll=l->listLength();
1834  int rl;
1835  int lt=l->Typ();
1836  int rt=NONE;
1837  BOOLEAN b;
1838  if (l->rtyp==ALIAS_CMD)
1839  {
1840  Werror("`%s` is read-only",l->Name());
1841  }
1842 
1843  if (l->rtyp==IDHDL)
1844  {
1845  atKillAll((idhdl)l->data);
1846  IDFLAG((idhdl)l->data)=0;
1847  l->attribute=NULL;
1848  toplevel=FALSE;
1849  }
1850  else if (l->attribute!=NULL)
1851  atKillAll((idhdl)l);
1852  l->flag=0;
1853  if (ll==1)
1854  {
1855  /* l[..] = ... */
1856  if(l->e!=NULL)
1857  {
1858  BOOLEAN like_lists=0;
1859  blackbox *bb=NULL;
1860  int bt;
1861  if (((bt=l->rtyp)>MAX_TOK)
1862  || ((l->rtyp==IDHDL) && ((bt=IDTYP((idhdl)l->data))>MAX_TOK)))
1863  {
1864  bb=getBlackboxStuff(bt);
1865  like_lists=BB_LIKE_LIST(bb); // bb like a list
1866  }
1867  else if (((l->rtyp==IDHDL) && (IDTYP((idhdl)l->data)==LIST_CMD))
1868  || (l->rtyp==LIST_CMD))
1869  {
1870  like_lists=2; // bb in a list
1871  }
1872  if(like_lists)
1873  {
1874  if (traceit&TRACE_ASSIGN) PrintS("assign list[..]=...or similar\n");
1875  if (like_lists==1)
1876  {
1877  // check blackbox/newtype type:
1878  if(bb->blackbox_CheckAssign(bb,l,r)) return TRUE;
1879  }
1880  b=jiAssign_list(l,r);
1881  if((!b) && (like_lists==2))
1882  {
1883  //Print("jjA_L_LIST: - 2 \n");
1884  if((l->rtyp==IDHDL) && (l->data!=NULL))
1885  {
1886  ipMoveId((idhdl)l->data);
1887  l->attribute=IDATTR((idhdl)l->data);
1888  l->flag=IDFLAG((idhdl)l->data);
1889  }
1890  }
1891  r->CleanUp();
1892  Subexpr h;
1893  while (l->e!=NULL)
1894  {
1895  h=l->e->next;
1897  l->e=h;
1898  }
1899  return b;
1900  }
1901  }
1902  if (lt>MAX_TOK)
1903  {
1904  blackbox *bb=getBlackboxStuff(lt);
1905 #ifdef BLACKBOX_DEVEL
1906  Print("bb-assign: bb=%lx\n",bb);
1907 #endif
1908  return (bb==NULL) || bb->blackbox_Assign(l,r);
1909  }
1910  // end of handling elems of list and similar
1911  rl=r->listLength();
1912  if (rl==1)
1913  {
1914  /* system variables = ... */
1915  if(((l->rtyp>=VECHO)&&(l->rtyp<=VPRINTLEVEL))
1916  ||((l->rtyp>=VALTVARS)&&(l->rtyp<=VMINPOLY)))
1917  {
1918  b=iiAssign_sys(l,r);
1919  r->CleanUp();
1920  //l->CleanUp();
1921  return b;
1922  }
1923  rt=r->Typ();
1924  /* a = ... */
1925  if ((lt!=MATRIX_CMD)
1926  &&(lt!=BIGINTMAT_CMD)
1927  &&(lt!=CMATRIX_CMD)
1928  &&(lt!=INTMAT_CMD)
1929  &&((lt==rt)||(lt!=LIST_CMD)))
1930  {
1931  b=jiAssign_1(l,r,toplevel);
1932  if (l->rtyp==IDHDL)
1933  {
1934  if ((lt==DEF_CMD)||(lt==LIST_CMD))
1935  {
1936  ipMoveId((idhdl)l->data);
1937  }
1938  l->attribute=IDATTR((idhdl)l->data);
1939  l->flag=IDFLAG((idhdl)l->data);
1940  l->CleanUp();
1941  }
1942  r->CleanUp();
1943  return b;
1944  }
1945  if (((lt!=LIST_CMD)
1946  &&((rt==MATRIX_CMD)
1947  ||(rt==BIGINTMAT_CMD)
1948  ||(rt==CMATRIX_CMD)
1949  ||(rt==INTMAT_CMD)
1950  ||(rt==INTVEC_CMD)
1951  ||(rt==MODUL_CMD)))
1952  ||((lt==LIST_CMD)
1953  &&(rt==RESOLUTION_CMD))
1954  )
1955  {
1956  b=jiAssign_1(l,r,toplevel);
1957  if((l->rtyp==IDHDL)&&(l->data!=NULL))
1958  {
1959  if ((lt==DEF_CMD) || (lt==LIST_CMD))
1960  {
1961  //Print("ipAssign - 3.0\n");
1962  ipMoveId((idhdl)l->data);
1963  }
1964  l->attribute=IDATTR((idhdl)l->data);
1965  l->flag=IDFLAG((idhdl)l->data);
1966  }
1967  r->CleanUp();
1968  Subexpr h;
1969  while (l->e!=NULL)
1970  {
1971  h=l->e->next;
1973  l->e=h;
1974  }
1975  return b;
1976  }
1977  }
1978  if (rt==NONE) rt=r->Typ();
1979  }
1980  else if (ll==(rl=r->listLength()))
1981  {
1982  b=jiAssign_rec(l,r);
1983  return b;
1984  }
1985  else
1986  {
1987  if (rt==NONE) rt=r->Typ();
1988  if (rt==INTVEC_CMD)
1989  return jiA_INTVEC_L(l,r);
1990  else if (rt==VECTOR_CMD)
1991  return jiA_VECTOR_L(l,r);
1992  else if ((rt==IDEAL_CMD)||(rt==MATRIX_CMD))
1993  return jiA_MATRIX_L(l,r);
1994  else if ((rt==STRING_CMD)&&(rl==1))
1995  return jiA_STRING_L(l,r);
1996  Werror("length of lists in assignment does not match (l:%d,r:%d)",
1997  ll,rl);
1998  return TRUE;
1999  }
2000 
2001  leftv hh=r;
2002  BOOLEAN nok=FALSE;
2003  BOOLEAN map_assign=FALSE;
2004  switch (lt)
2005  {
2006  case INTVEC_CMD:
2007  nok=jjA_L_INTVEC(l,r,new intvec(exprlist_length(r)));
2008  break;
2009  case INTMAT_CMD:
2010  {
2011  nok=jjA_L_INTVEC(l,r,new intvec(IDINTVEC((idhdl)l->data)));
2012  break;
2013  }
2014  case BIGINTMAT_CMD:
2015  {
2016  nok=jjA_L_BIGINTMAT(l, r, new bigintmat(IDBIMAT((idhdl)l->data)));
2017  break;
2018  }
2019  case MAP_CMD:
2020  {
2021  // first element in the list sl (r) must be a ring
2022  if ((rt == RING_CMD)&&(r->e==NULL))
2023  {
2024  omFree((ADDRESS)IDMAP((idhdl)l->data)->preimage);
2025  IDMAP((idhdl)l->data)->preimage = omStrDup (r->Fullname());
2026  /* advance the expressionlist to get the next element after the ring */
2027  hh = r->next;
2028  }
2029  else
2030  {
2031  WerrorS("expected ring-name");
2032  nok=TRUE;
2033  break;
2034  }
2035  if (hh==NULL) /* map-assign: map f=r; */
2036  {
2037  WerrorS("expected image ideal");
2038  nok=TRUE;
2039  break;
2040  }
2041  if ((hh->next==NULL)&&(hh->Typ()==IDEAL_CMD))
2042  {
2043  BOOLEAN bo=jiAssign_1(l,hh,toplevel); /* map-assign: map f=r,i; */
2044  omFreeBin(hh,sleftv_bin);
2045  return bo;
2046  }
2047  //no break, handle the rest like an ideal:
2048  map_assign=TRUE;
2049  }
2050  case MATRIX_CMD:
2051  case IDEAL_CMD:
2052  case MODUL_CMD:
2053  {
2054  sleftv t;
2055  matrix olm = (matrix)l->Data();
2056  int rk;
2057  char *pr=((map)olm)->preimage;
2058  BOOLEAN module_assign=(/*l->Typ()*/ lt==MODUL_CMD);
2059  matrix lm ;
2060  int num;
2061  int j,k;
2062  int i=0;
2063  int mtyp=MATRIX_CMD; /*Type of left side object*/
2064  int etyp=POLY_CMD; /*Type of elements of left side object*/
2065 
2066  if (lt /*l->Typ()*/==MATRIX_CMD)
2067  {
2068  rk=olm->rows();
2069  num=olm->cols()*rk /*olm->rows()*/;
2070  lm=mpNew(olm->rows(),olm->cols());
2071  int el;
2072  if ((traceit&TRACE_ASSIGN) && (num!=(el=exprlist_length(hh))))
2073  {
2074  Warn("expression list length(%d) does not match matrix size(%d)",el,num);
2075  }
2076  }
2077  else /* IDEAL_CMD or MODUL_CMD */
2078  {
2079  num=exprlist_length(hh);
2080  lm=(matrix)idInit(num,1);
2081  if (module_assign)
2082  {
2083  rk=0;
2084  mtyp=MODUL_CMD;
2085  etyp=VECTOR_CMD;
2086  }
2087  else
2088  rk=1;
2089  }
2090 
2091  int ht;
2092  loop
2093  {
2094  if (hh==NULL)
2095  break;
2096  else
2097  {
2098  matrix rm;
2099  ht=hh->Typ();
2100  if ((j=iiTestConvert(ht,etyp))!=0)
2101  {
2102  nok=iiConvert(ht,etyp,j,hh,&t);
2103  hh->next=t.next;
2104  if (nok)
2105  { Werror("can not convert %s(%s) -> %s",Tok2Cmdname(ht),hh->Name(),Tok2Cmdname(etyp));
2106  break;
2107  }
2108  lm->m[i]=(poly)t.CopyD(etyp);
2109  pNormalize(lm->m[i]);
2110  if (module_assign) rk=si_max(rk,(int)pMaxComp(lm->m[i]));
2111  i++;
2112  }
2113  else
2114  if ((j=iiTestConvert(ht,mtyp))!=0)
2115  {
2116  nok=iiConvert(ht,mtyp,j,hh,&t);
2117  hh->next=t.next;
2118  if (nok)
2119  { Werror("can not convert %s(%s) -> %s",Tok2Cmdname(ht),hh->Name(),Tok2Cmdname(mtyp));
2120  break;
2121  }
2122  rm = (matrix)t.CopyD(mtyp);
2123  if (module_assign)
2124  {
2125  j = si_min(num,rm->cols());
2126  rk=si_max(rk,(int)rm->rank);
2127  }
2128  else
2129  j = si_min(num-i,rm->rows() * rm->cols());
2130  for(k=0;k<j;k++,i++)
2131  {
2132  lm->m[i]=rm->m[k];
2133  pNormalize(lm->m[i]);
2134  rm->m[k]=NULL;
2135  }
2136  idDelete((ideal *)&rm);
2137  }
2138  else
2139  {
2140  nok=TRUE;
2141  if (nok)
2142  { Werror("can not convert %s(%s) -> %s",Tok2Cmdname(ht),hh->Name(),Tok2Cmdname(mtyp));
2143  }
2144  break;
2145  }
2146  t.next=NULL;t.CleanUp();
2147  if (i==num) break;
2148  hh=hh->next;
2149  }
2150  }
2151  if (nok)
2152  idDelete((ideal *)&lm);
2153  else
2154  {
2155  idDelete((ideal *)&olm);
2156  if (module_assign) lm->rank=rk;
2157  else if (map_assign) ((map)lm)->preimage=pr;
2158  l=l->LData();
2159  if (l->rtyp==IDHDL)
2160  IDMATRIX((idhdl)l->data)=lm;
2161  else
2162  l->data=(char *)lm;
2163  }
2164  break;
2165  }
2166  case STRING_CMD:
2167  nok=jjA_L_STRING(l,r);
2168  break;
2169  //case DEF_CMD:
2170  case LIST_CMD:
2171  nok=jjA_L_LIST(l,r);
2172  break;
2173  case NONE:
2174  case 0:
2175  Werror("cannot assign to %s",l->Fullname());
2176  nok=TRUE;
2177  break;
2178  default:
2179  WerrorS("assign not impl.");
2180  nok=TRUE;
2181  break;
2182  } /* end switch: typ */
2183  if (nok && (!errorreported)) WerrorS("incompatible type in list assignment");
2184  r->CleanUp();
2185  return nok;
2186 }
int & rows()
Definition: matpol.h:23
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:1363
void ipMoveId(idhdl tomove)
Definition: ipid.cc:621
int iiTestConvert(int inputType, int outputType)
Definition: gentable.cc:301
Definition: tok.h:206
int j
Definition: facHensel.cc:105
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define TRACE_ASSIGN
Definition: reporter.h:45
static BOOLEAN jjA_L_INTVEC(leftv l, leftv r, intvec *iv)
Definition: ipassign.cc:1495
#define Print
Definition: emacs.cc:80
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
CanonicalForm num(const CanonicalForm &f)
#define IDINTVEC(a)
Definition: ipid.h:123
#define pMaxComp(p)
Definition: polys.h:294
static int si_min(const int a, const int b)
Definition: auxiliary.h:139
#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:435
int exprlist_length(leftv v)
Definition: ipshell.cc:547
Matrices of numbers.
Definition: bigintmat.h:50
static BOOLEAN jiAssign_list(leftv l, leftv r)
Definition: ipassign.cc:1739
Definition: tok.h:216
static BOOLEAN jiAssign_1(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1116
#define BB_LIKE_LIST(B)
Definition: blackbox.h:53
#define TRUE
Definition: auxiliary.h:98
void * ADDRESS
Definition: auxiliary.h:133
#define IDBIMAT(a)
Definition: ipid.h:124
void WerrorS(const char *s)
Definition: feFopen.cc:24
int k
Definition: cfEzgcd.cc:92
#define loop
Definition: structs.h:80
int traceit
Definition: febase.cc:42
int Typ()
Definition: subexpr.cc:1033
const char * Name()
Definition: subexpr.h:120
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:31
static BOOLEAN jjA_L_BIGINTMAT(leftv l, leftv r, bigintmat *bim)
Definition: ipassign.cc:1544
static BOOLEAN iiAssign_sys(leftv l, leftv r)
Definition: ipassign.cc:1289
#define IDTYP(a)
Definition: ipid.h:114
poly * m
Definition: matpol.h:18
CanonicalForm b
Definition: cfModGcd.cc:4044
Definition: intvec.h:19
Definition: tok.h:58
#define omFree(addr)
Definition: omAllocDecl.h:261
static BOOLEAN jiA_VECTOR_L(leftv l, leftv r)
Definition: ipassign.cc:1389
omBin sSubexpr_bin
Definition: subexpr.cc:40
static BOOLEAN jjA_L_STRING(leftv l, leftv r)
Definition: ipassign.cc:1593
static int si_max(const int a, const int b)
Definition: auxiliary.h:138
omBin sleftv_bin
Definition: subexpr.cc:41
int i
Definition: cfEzgcd.cc:125
void PrintS(const char *s)
Definition: reporter.cc:284
#define IDMAP(a)
Definition: ipid.h:130
short errorreported
Definition: feFopen.cc:23
leftv next
Definition: subexpr.h:86
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:37
Definition: tok.h:34
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:35
#define atKillAll(H)
Definition: attrib.h:47
static BOOLEAN jiA_STRING_L(leftv l, leftv r)
Definition: ipassign.cc:1703
int & cols()
Definition: matpol.h:24
#define NULL
Definition: omList.c:12
static BOOLEAN jiAssign_rec(leftv l, leftv r)
Definition: ipassign.cc:1807
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140
static BOOLEAN jiA_MATRIX_L(leftv l, leftv r)
Definition: ipassign.cc:1627
static BOOLEAN jjA_L_LIST(leftv l, leftv r)
Definition: ipassign.cc:1430
#define IDFLAG(a)
Definition: ipid.h:115
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
#define IDATTR(a)
Definition: ipid.h:118
Definition: tok.h:118
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
static Poly * h
Definition: janet.cc:971
int BOOLEAN
Definition: auxiliary.h:85
#define NONE
Definition: tok.h:219
void Werror(const char *fmt,...)
Definition: reporter.cc:189
ip_smatrix * matrix
Definition: matpol.h:43
void * CopyD(int t)
Definition: subexpr.cc:739
int l
Definition: cfEzgcd.cc:93
long rank
Definition: matpol.h:19
#define IDMATRIX(a)
Definition: ipid.h:129
blackbox * getBlackboxStuff(const int t)
return the structure to the type given by t
Definition: blackbox.cc:16
#define pNormalize(p)
Definition: polys.h:312
#define Warn
Definition: emacs.cc:77
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  ,
leftv   
)

Definition at line 6495 of file ipshell.cc.

6496 {
6497  char* ring_name=omStrDup((char*)r->Name());
6498  int t=arg->Typ();
6499  if (t==RING_CMD)
6500  {
6501  sleftv tmp;
6502  memset(&tmp,0,sizeof(tmp));
6503  tmp.rtyp=IDHDL;
6504  tmp.data=(char*)rDefault(ring_name);
6505  if (tmp.data!=NULL)
6506  {
6507  BOOLEAN b=iiAssign(&tmp,arg);
6508  if (b) return TRUE;
6509  rSetHdl(ggetid(ring_name));
6510  omFree(ring_name);
6511  return FALSE;
6512  }
6513  else
6514  return TRUE;
6515  }
6516  else if (t==CRING_CMD)
6517  {
6518  sleftv tmp;
6519  sleftv n;
6520  memset(&n,0,sizeof(n));
6521  n.name=ring_name;
6522  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6523  if (iiAssign(&tmp,arg)) return TRUE;
6524  //Print("create %s\n",r->Name());
6525  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6526  return FALSE;
6527  }
6528  //Print("create %s\n",r->Name());
6529  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6530  return TRUE;// not handled -> error for now
6531 }
idhdl ggetid(const char *n)
Definition: ipid.cc:521
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define FALSE
Definition: auxiliary.h:94
#define IDROOT
Definition: ipid.h:18
#define TRUE
Definition: auxiliary.h:98
#define IDHDL
Definition: tok.h:31
idhdl rDefault(const char *s)
Definition: ipshell.cc:1553
void * data
Definition: subexpr.h:88
int myynest
Definition: febase.cc:41
CanonicalForm b
Definition: cfModGcd.cc:4044
Definition: tok.h:56
const char * name
Definition: subexpr.h:87
#define omFree(addr)
Definition: omAllocDecl.h:261
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition: ipshell.cc:1125
#define NULL
Definition: omList.c:12
int rtyp
Definition: subexpr.h:91
void rSetHdl(idhdl h)
Definition: ipshell.cc:5086
int BOOLEAN
Definition: auxiliary.h:85
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1830
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  r,
leftv  args 
)

Definition at line 1182 of file ipshell.cc.

1183 {
1184  // must be inside a proc, as we simultae an proc_end at the end
1185  if (myynest==0)
1186  {
1187  WerrorS("branchTo can only occur in a proc");
1188  return TRUE;
1189  }
1190  // <string1...stringN>,<proc>
1191  // known: args!=NULL, l>=1
1192  int l=args->listLength();
1193  int ll=0;
1194  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1195  if (ll!=(l-1)) return FALSE;
1196  leftv h=args;
1197  // set up the table for type test:
1198  short *t=(short*)omAlloc(l*sizeof(short));
1199  t[0]=l-1;
1200  int b;
1201  int i;
1202  for(i=1;i<l;i++,h=h->next)
1203  {
1204  if (h->Typ()!=STRING_CMD)
1205  {
1206  omFree(t);
1207  Werror("arg %d is not a string",i);
1208  return TRUE;
1209  }
1210  int tt;
1211  b=IsCmd((char *)h->Data(),tt);
1212  if(b) t[i]=tt;
1213  else
1214  {
1215  omFree(t);
1216  Werror("arg %d is not a type name",i);
1217  return TRUE;
1218  }
1219  }
1220  if (h->Typ()!=PROC_CMD)
1221  {
1222  omFree(t);
1223  Werror("last(%d.) arg.(%s) is not a proc(but %s(%d)), nesting=%d",
1224  i,h->name,Tok2Cmdname(h->Typ()),h->Typ(),myynest);
1225  return TRUE;
1226  }
1227  b=iiCheckTypes(iiCurrArgs,t,0);
1228  omFree(t);
1229  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1230  {
1231  // get the proc:
1232  iiCurrProc=(idhdl)h->data;
1234  // already loaded ?
1235  if( pi->data.s.body==NULL )
1236  {
1238  if (pi->data.s.body==NULL) return TRUE;
1239  }
1240  // set currPackHdl/currPack
1241  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1242  {
1243  currPack=pi->pack;
1246  //Print("set pack=%s\n",IDID(currPackHdl));
1247  }
1248  // see iiAllStart:
1249  BITSET save1=si_opt_1;
1250  BITSET save2=si_opt_2;
1251  newBuffer( omStrDup(pi->data.s.body), BT_proc,
1252  pi, pi->data.s.body_lineno-(iiCurrArgs==NULL) );
1253  BOOLEAN err=yyparse();
1254  si_opt_1=save1;
1255  si_opt_2=save2;
1256  // now save the return-expr.
1258  memcpy(&sLastPrinted,&iiRETURNEXPR,sizeof(sleftv));
1259  iiRETURNEXPR.Init();
1260  // warning about args.:
1261  if (iiCurrArgs!=NULL)
1262  {
1263  if (err==0) Warn("too many arguments for %s",IDID(iiCurrProc));
1264  iiCurrArgs->CleanUp();
1266  iiCurrArgs=NULL;
1267  }
1268  // similate proc_end:
1269  // - leave input
1270  void myychangebuffer();
1271  myychangebuffer();
1272  // - set the current buffer to its end (this is a pointer in a buffer,
1273  // not a file ptr) "branchTo" is only valid in proc)
1275  // - kill local vars
1277  // - return
1278  newBuffer(omStrDup("\n;return(_);\n"),BT_execute);
1279  return (err!=0);
1280  }
1281  return FALSE;
1282 }
long fptr
Definition: fevoices.h:70
void myychangebuffer()
Definition: scanner.cc:2330
unsigned si_opt_1
Definition: options.c:5
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
idhdl currPackHdl
Definition: ipid.cc:55
char * buffer
Definition: fevoices.h:69
#define IDID(a)
Definition: ipid.h:117
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:454
int listLength()
Definition: subexpr.cc:51
#define TRUE
Definition: auxiliary.h:98
void Init()
Definition: subexpr.h:107
void * ADDRESS
Definition: auxiliary.h:133
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define BITSET
Definition: structs.h:20
#define omAlloc(size)
Definition: omAllocDecl.h:210
#define IDHDL
Definition: tok.h:31
idhdl iiCurrProc
Definition: ipshell.cc:77
int myynest
Definition: febase.cc:41
CanonicalForm b
Definition: cfModGcd.cc:4044
#define omFree(addr)
Definition: omAllocDecl.h:261
void killlocals(int v)
Definition: ipshell.cc:381
idrec * idhdl
Definition: ring.h:21
omBin sleftv_bin
Definition: subexpr.cc:41
int i
Definition: cfEzgcd.cc:125
int yyparse(void)
Definition: grammar.cc:2111
leftv next
Definition: subexpr.h:86
#define IDPROC(a)
Definition: ipid.h:135
#define pi
Definition: libparse.cc:1143
#define NULL
Definition: omList.c:12
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140
Voice * currentVoice
Definition: fevoices.cc:47
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:6551
package currPack
Definition: ipid.cc:57
leftv iiCurrArgs
Definition: ipshell.cc:76
sleftv sLastPrinted
Definition: subexpr.cc:46
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:156
idhdl packFindHdl(package r)
Definition: ipid.cc:750
void iiCheckPack(package &p)
Definition: ipshell.cc:1539
#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:191
static Poly * h
Definition: janet.cc:971
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189
int l
Definition: cfEzgcd.cc:93
utypes data
Definition: idrec.h:40
int IsCmd(const char *n, int &tok)
Definition: iparith.cc:8897
#define Warn
Definition: emacs.cc:77
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiCallLibProc1()

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

Definition at line 612 of file iplib.cc.

613 {
614  idhdl h=ggetid(n);
615  if ((h==NULL)
616  || (IDTYP(h)!=PROC_CMD))
617  {
618  err=2;
619  return NULL;
620  }
621  // ring handling
622  idhdl save_ringhdl=currRingHdl;
623  ring save_ring=currRing;
625  // argument:
626  sleftv tmp;
627  tmp.Init();
628  tmp.data=arg;
629  tmp.rtyp=arg_type;
630  // call proc
631  err=iiMake_proc(h,currPack,&tmp);
632  // clean up ring
633  iiCallLibProcEnd(save_ringhdl,save_ring);
634  // return
635  if (err==FALSE)
636  {
637  void*r=iiRETURNEXPR.data;
640  return r;
641  }
642  return NULL;
643 }
idhdl ggetid(const char *n)
Definition: ipid.cc:521
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:454
static void iiCallLibProcEnd(idhdl save_ringhdl, ring save_ring)
Definition: iplib.cc:587
void Init()
Definition: subexpr.h:107
Definition: idrec.h:34
void * data
Definition: subexpr.h:88
#define IDTYP(a)
Definition: ipid.h:114
idhdl currRingHdl
Definition: ipid.cc:59
static void iiCallLibProcBegin()
Definition: iplib.cc:569
BOOLEAN iiMake_proc(idhdl pn, package pack, leftv sl)
Definition: iplib.cc:484
#define NULL
Definition: omList.c:12
package currPack
Definition: ipid.cc:57
int rtyp
Definition: subexpr.h:91
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
static Poly * h
Definition: janet.cc:971

◆ iiCallLibProcM()

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

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

Definition at line 646 of file iplib.cc.

647 {
648  idhdl h=ggetid(n);
649  if ((h==NULL)
650  || (IDTYP(h)!=PROC_CMD))
651  {
652  err=2;
653  return NULL;
654  }
655  // ring handling
656  idhdl save_ringhdl=currRingHdl;
657  ring save_ring=currRing;
659  // argument:
660  if (arg_types[0]!=0)
661  {
662  sleftv tmp;
663  leftv tt=&tmp;
664  int i=1;
665  tmp.Init();
666  tmp.data=args[0];
667  tmp.rtyp=arg_types[0];
668  while(arg_types[i]!=0)
669  {
670  tt->next=(leftv)omAlloc0(sizeof(sleftv));
671  tt=tt->next;
672  tt->rtyp=arg_types[i];
673  tt->data=args[i];
674  i++;
675  }
676  // call proc
677  err=iiMake_proc(h,currPack,&tmp);
678  }
679  else
680  // call proc
681  err=iiMake_proc(h,currPack,NULL);
682  // clean up ring
683  iiCallLibProcEnd(save_ringhdl,save_ring);
684  // return
685  if (err==FALSE)
686  {
687  void*r=iiRETURNEXPR.data;
690  return r;
691  }
692  return NULL;
693 }
idhdl ggetid(const char *n)
Definition: ipid.cc:521
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:454
static void iiCallLibProcEnd(idhdl save_ringhdl, ring save_ring)
Definition: iplib.cc:587
void Init()
Definition: subexpr.h:107
sleftv * leftv
Definition: structs.h:62
Definition: idrec.h:34
void * data
Definition: subexpr.h:88
#define IDTYP(a)
Definition: ipid.h:114
idhdl currRingHdl
Definition: ipid.cc:59
int i
Definition: cfEzgcd.cc:125
static void iiCallLibProcBegin()
Definition: iplib.cc:569
leftv next
Definition: subexpr.h:86
BOOLEAN iiMake_proc(idhdl pn, package pack, leftv sl)
Definition: iplib.cc:484
#define NULL
Definition: omList.c:12
package currPack
Definition: ipid.cc:57
int rtyp
Definition: subexpr.h:91
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
static Poly * h
Definition: janet.cc:971
#define omAlloc0(size)
Definition: omAllocDecl.h:211

◆ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1539 of file ipshell.cc.

1540 {
1541  if (p!=basePack)
1542  {
1543  idhdl t=basePack->idroot;
1544  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1545  if (t==NULL)
1546  {
1547  WarnS("package not found\n");
1548  p=basePack;
1549  }
1550  }
1551 }
#define WarnS
Definition: emacs.cc:78
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:134
#define IDTYP(a)
Definition: ipid.h:114
idhdl next
Definition: idrec.h:38
#define NULL
Definition: omList.c:12
package basePack
Definition: ipid.cc:58
int p
Definition: cfModGcd.cc:4019

◆ iiCheckRing()

BOOLEAN iiCheckRing ( int  i)

Definition at line 1495 of file ipshell.cc.

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

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

6552 {
6553  int l=0;
6554  if (args==NULL)
6555  {
6556  if (type_list[0]==0) return TRUE;
6557  }
6558  else l=args->listLength();
6559  if (l!=(int)type_list[0])
6560  {
6561  if (report) iiReportTypes(0,l,type_list);
6562  return FALSE;
6563  }
6564  for(int i=1;i<=l;i++,args=args->next)
6565  {
6566  short t=type_list[i];
6567  if (t!=ANY_TYPE)
6568  {
6569  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6570  || (t!=args->Typ()))
6571  {
6572  if (report) iiReportTypes(i,args->Typ(),type_list);
6573  return FALSE;
6574  }
6575  }
6576  }
6577  return TRUE;
6578 }
#define ANY_TYPE
Definition: tok.h:30
#define FALSE
Definition: auxiliary.h:94
int listLength()
Definition: subexpr.cc:51
#define TRUE
Definition: auxiliary.h:98
#define IDHDL
Definition: tok.h:31
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6533
int i
Definition: cfEzgcd.cc:125
leftv next
Definition: subexpr.h:86
#define NULL
Definition: omList.c:12
int l
Definition: cfEzgcd.cc:93

◆ iiConvName()

char* iiConvName ( const char *  libname)

Definition at line 1331 of file iplib.cc.

1332 {
1333  char *tmpname = omStrDup(libname);
1334  char *p = strrchr(tmpname, DIR_SEP);
1335  char *r;
1336  if(p==NULL) p = tmpname; else p++;
1337  // p is now the start of the file name (without path)
1338  r=p;
1339  while(isalnum(*r)||(*r=='_')) r++;
1340  // r point the the end of the main part of the filename
1341  *r = '\0';
1342  r = omStrDup(p);
1343  *r = mytoupper(*r);
1344  // printf("iiConvName: '%s' '%s' => '%s'\n", libname, tmpname, r);
1345  omFree((ADDRESS)tmpname);
1346 
1347  return(r);
1348 }
char mytoupper(char c)
Definition: iplib.cc:1312
void * ADDRESS
Definition: auxiliary.h:133
#define DIR_SEP
Definition: feResource.h:6
#define omFree(addr)
Definition: omAllocDecl.h:261
#define NULL
Definition: omList.c:12
int p
Definition: cfModGcd.cc:4019
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiDebug()

void iiDebug ( )

Definition at line 987 of file ipshell.cc.

988 {
989 #ifdef HAVE_SDB
990  sdb_flags=1;
991 #endif
992  Print("\n-- break point in %s --\n",VoiceName());
994  char * s;
996  s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
997  loop
998  {
999  memset(s,0,80);
1001  if (s[BREAK_LINE_LENGTH-1]!='\0')
1002  {
1003  Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
1004  }
1005  else
1006  break;
1007  }
1008  if (*s=='\n')
1009  {
1011  }
1012 #if MDEBUG
1013  else if(strncmp(s,"cont;",5)==0)
1014  {
1016  }
1017 #endif /* MDEBUG */
1018  else
1019  {
1020  strcat( s, "\n;~\n");
1021  newBuffer(s,BT_execute);
1022  }
1023 }
void VoiceBackTrack()
Definition: fevoices.cc:67
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:31
#define Print
Definition: emacs.cc:80
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
#define loop
Definition: structs.h:80
#define omAlloc(size)
Definition: omAllocDecl.h:210
BOOLEAN iiDebugMarker
Definition: ipshell.cc:985
const char * VoiceName()
Definition: fevoices.cc:56
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:986
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:156

◆ iiDeclCommand()

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

Definition at line 1125 of file ipshell.cc.

1126 {
1127  BOOLEAN res=FALSE;
1128  const char *id = name->name;
1129 
1130  memset(sy,0,sizeof(sleftv));
1131  if ((name->name==NULL)||(isdigit(name->name[0])))
1132  {
1133  WerrorS("object to declare is not a name");
1134  res=TRUE;
1135  }
1136  else
1137  {
1138  if (t==QRING_CMD) t=RING_CMD; // qring is always RING_CMD
1139 
1140  if (TEST_V_ALLWARN
1141  && (name->rtyp!=0)
1142  && (name->rtyp!=IDHDL)
1143  && (currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1144  {
1145  Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1147  }
1148  {
1149  sy->data = (char *)enterid(id,lev,t,root,init_b);
1150  }
1151  if (sy->data!=NULL)
1152  {
1153  sy->rtyp=IDHDL;
1154  currid=sy->name=IDID((idhdl)sy->data);
1155  // name->name=NULL; /* used in enterid */
1156  //sy->e = NULL;
1157  if (name->next!=NULL)
1158  {
1160  res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1161  }
1162  }
1163  else res=TRUE;
1164  }
1165  name->CleanUp();
1166  return res;
1167 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
int yylineno
Definition: febase.cc:40
#define IDID(a)
Definition: ipid.h:117
#define FALSE
Definition: auxiliary.h:94
char * filename
Definition: fevoices.h:63
#define TRUE
Definition: auxiliary.h:98
sleftv * leftv
Definition: structs.h:62
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:31
const char * currid
Definition: grammar.cc:171
void * data
Definition: subexpr.h:88
int myynest
Definition: febase.cc:41
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:265
char my_yylinebuf[80]
Definition: febase.cc:43
CanonicalForm res
Definition: facAbsFact.cc:64
const char * name
Definition: subexpr.h:87
idhdl currRingHdl
Definition: ipid.cc:59
omBin sleftv_bin
Definition: subexpr.cc:41
#define IDLEV(a)
Definition: ipid.h:116
leftv next
Definition: subexpr.h:86
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition: ipshell.cc:1125
#define NULL
Definition: omList.c:12
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140
Voice * currentVoice
Definition: fevoices.cc:47
int rtyp
Definition: subexpr.h:91
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
Definition: tok.h:158
int BOOLEAN
Definition: auxiliary.h:85
#define TEST_V_ALLWARN
Definition: options.h:140
#define Warn
Definition: emacs.cc:77

◆ iiEStart()

BOOLEAN iiEStart ( char *  example,
procinfo pi 
)

Definition at line 698 of file iplib.cc.

699 {
700  BOOLEAN err;
701  int old_echo=si_echo;
702 
703  iiCheckNest();
704  procstack->push(example);
707  {
708  if (traceit&TRACE_SHOW_LINENO) printf("\n");
709  printf("entering example (level %d)\n",myynest);
710  }
711  myynest++;
712 
713  err=iiAllStart(pi,example,BT_example,(pi != NULL ? pi->data.s.example_lineno: 0));
714 
716  myynest--;
717  si_echo=old_echo;
718  if (traceit&TRACE_SHOW_PROC)
719  {
720  if (traceit&TRACE_SHOW_LINENO) printf("\n");
721  printf("leaving -example- (level %d)\n",myynest);
722  }
723  if (iiLocalRing[myynest] != currRing)
724  {
725  if (iiLocalRing[myynest]!=NULL)
726  {
729  }
730  else
731  {
733  currRing=NULL;
734  }
735  }
736  procstack->pop();
737  return err;
738 }
#define TRACE_SHOW_LINENO
Definition: reporter.h:30
proclevel * procstack
Definition: ipid.cc:52
int traceit
Definition: febase.cc:42
static void iiCheckNest()
Definition: iplib.cc:473
int myynest
Definition: febase.cc:41
void killlocals(int v)
Definition: ipshell.cc:381
procinfodata data
Definition: subexpr.h:63
idhdl currRingHdl
Definition: ipid.cc:59
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1610
BOOLEAN iiAllStart(procinfov pi, char *p, feBufferTypes t, int l)
Definition: iplib.cc:292
ring * iiLocalRing
Definition: iplib.cc:453
#define NULL
Definition: omList.c:12
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define TRACE_SHOW_PROC
Definition: reporter.h:28
void rSetHdl(idhdl h)
Definition: ipshell.cc:5086
void push(char *)
Definition: ipid.cc:722
void pop()
Definition: ipid.cc:732
int BOOLEAN
Definition: auxiliary.h:85
int si_echo
Definition: febase.cc:35

◆ iiExport() [1/2]

BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1417 of file ipshell.cc.

1418 {
1419  BOOLEAN nok=FALSE;
1420  leftv r=v;
1421  while (v!=NULL)
1422  {
1423  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1424  {
1425  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1426  nok=TRUE;
1427  }
1428  else
1429  {
1430  if(iiInternalExport(v, toLev))
1431  {
1432  r->CleanUp();
1433  return TRUE;
1434  }
1435  }
1436  v=v->next;
1437  }
1438  r->CleanUp();
1439  return nok;
1440 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Subexpr e
Definition: subexpr.h:105
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
const char * name
Definition: subexpr.h:87
leftv next
Definition: subexpr.h:86
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1319
#define NULL
Definition: omList.c:12
int rtyp
Definition: subexpr.h:91
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
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 1443 of file ipshell.cc.

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

8356 {
8357  memset(res,0,sizeof(sleftv));
8358  BOOLEAN call_failed=FALSE;
8359 
8360  if (!errorreported)
8361  {
8362  BOOLEAN failed=FALSE;
8363  iiOp=op;
8364  int i = 0;
8365  while (dA1[i].cmd==op)
8366  {
8367  if (at==dA1[i].arg)
8368  {
8369  if (currRing!=NULL)
8370  {
8371  if (check_valid(dA1[i].valid_for,op)) break;
8372  }
8373  else
8374  {
8375  if (RingDependend(dA1[i].res))
8376  {
8377  WerrorS("no ring active");
8378  break;
8379  }
8380  }
8381  if (traceit&TRACE_CALL)
8382  Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
8383  res->rtyp=dA1[i].res;
8384  if ((call_failed=dA1[i].p(res,a)))
8385  {
8386  break;// leave loop, goto error handling
8387  }
8388  if (a->Next()!=NULL)
8389  {
8391  failed=iiExprArith1(res->next,a->next,op);
8392  }
8393  a->CleanUp();
8394  return failed;
8395  }
8396  i++;
8397  }
8398  // implicite type conversion --------------------------------------------
8399  if (dA1[i].cmd!=op)
8400  {
8402  i=0;
8403  //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
8404  while (dA1[i].cmd==op)
8405  {
8406  int ai;
8407  //Print("test %s\n",Tok2Cmdname(dA1[i].arg));
8408  if ((dA1[i].valid_for & NO_CONVERSION)==0)
8409  {
8410  if ((ai=iiTestConvert(at,dA1[i].arg,dConvertTypes))!=0)
8411  {
8412  if (currRing!=NULL)
8413  {
8414  if (check_valid(dA1[i].valid_for,op)) break;
8415  }
8416  else
8417  {
8418  if (RingDependend(dA1[i].res))
8419  {
8420  WerrorS("no ring active");
8421  break;
8422  }
8423  }
8424  if (traceit&TRACE_CALL)
8425  Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(dA1[i].arg));
8426  res->rtyp=dA1[i].res;
8427  failed= ((iiConvert(at,dA1[i].arg,ai,a,an,dConvertTypes))
8428  || (call_failed=dA1[i].p(res,an)));
8429  // everything done, clean up temp. variables
8430  if (failed)
8431  {
8432  // leave loop, goto error handling
8433  break;
8434  }
8435  else
8436  {
8437  if (an->Next() != NULL)
8438  {
8439  res->next = (leftv)omAllocBin(sleftv_bin);
8440  failed=iiExprArith1(res->next,an->next,op);
8441  }
8442  // everything ok, clean up and return
8443  an->CleanUp();
8445  return failed;
8446  }
8447  }
8448  }
8449  i++;
8450  }
8451  an->CleanUp();
8453  }
8454  // error handling
8455  if (!errorreported)
8456  {
8457  if ((at==0) && (a->Fullname()!=sNoName_fe))
8458  {
8459  Werror("`%s` is not defined",a->Fullname());
8460  }
8461  else
8462  {
8463  i=0;
8464  const char *s = iiTwoOps(op);
8465  Werror("%s(`%s`) failed"
8466  ,s,Tok2Cmdname(at));
8467  if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8468  {
8469  while (dA1[i].cmd==op)
8470  {
8471  if ((dA1[i].res!=0)
8472  && (dA1[i].p!=jjWRONG))
8473  Werror("expected %s(`%s`)"
8474  ,s,Tok2Cmdname(dA1[i].arg));
8475  i++;
8476  }
8477  }
8478  }
8479  }
8480  res->rtyp = UNKNOWN;
8481  }
8482  a->CleanUp();
8483  return TRUE;
8484 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
const CanonicalForm int s
Definition: facAbsFact.cc:55
int iiTestConvert(int inputType, int outputType)
Definition: gentable.cc:301
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define Print
Definition: emacs.cc:80
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:8485
#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:435
const char sNoName_fe[]
Definition: fevoices.cc:55
#define TRUE
Definition: auxiliary.h:98
#define UNKNOWN
Definition: tok.h:220
void * ADDRESS
Definition: auxiliary.h:133
sleftv * leftv
Definition: structs.h:62
void WerrorS(const char *s)
Definition: feFopen.cc:24
int traceit
Definition: febase.cc:42
short res
Definition: gentable.cc:82
const char * Fullname()
Definition: subexpr.h:125
#define V_SHOW_USE
Definition: options.h:52
static BOOLEAN check_valid(const int p, const int op)
Definition: iparith.cc:9301
const char * Tok2Cmdname(int tok)
Definition: iparith.cc:9021
int RingDependend(int t)
Definition: gentable.cc:28
const char * iiTwoOps(int t)
Definition: gentable.cc:261
static BOOLEAN jjWRONG(leftv, leftv)
Definition: iparith.cc:3558
leftv Next()
Definition: subexpr.h:136
omBin sleftv_bin
Definition: subexpr.cc:41
int i
Definition: cfEzgcd.cc:125
#define TRACE_CALL
Definition: reporter.h:43
short errorreported
Definition: feFopen.cc:23
leftv next
Definition: subexpr.h:86
#define BVERBOSE(a)
Definition: options.h:35
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
#define NULL
Definition: omList.c:12
int rtyp
Definition: subexpr.h:91
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define NO_CONVERSION
Definition: iparith.cc:116
int p
Definition: cfModGcd.cc:4019
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
int iiOp
Definition: iparith.cc:216
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 8283 of file iparith.cc.

8287 {
8288  leftv b=a->next;
8289  a->next=NULL;
8290  int bt=b->Typ();
8291  BOOLEAN bo=iiExprArith2TabIntern(res,a,op,b,TRUE,dA2,at,bt,dConvertTypes);
8292  a->next=b;
8293  a->CleanUp(); // to clean up the chain, content already done in iiExprArith2TabIntern
8294  return bo;
8295 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define TRUE
Definition: auxiliary.h:98
int Typ()
Definition: subexpr.cc:1033
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:8123
CanonicalForm b
Definition: cfModGcd.cc:4044
leftv next
Definition: subexpr.h:86
#define NULL
Definition: omList.c:12
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
int BOOLEAN
Definition: auxiliary.h:85

◆ iiExprArith3()

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

Definition at line 8698 of file iparith.cc.

8699 {
8700  memset(res,0,sizeof(sleftv));
8701 
8702  if (!errorreported)
8703  {
8704 #ifdef SIQ
8705  if (siq>0)
8706  {
8707  //Print("siq:%d\n",siq);
8709  memcpy(&d->arg1,a,sizeof(sleftv));
8710  a->Init();
8711  memcpy(&d->arg2,b,sizeof(sleftv));
8712  b->Init();
8713  memcpy(&d->arg3,c,sizeof(sleftv));
8714  c->Init();
8715  d->op=op;
8716  d->argc=3;
8717  res->data=(char *)d;
8718  res->rtyp=COMMAND;
8719  return FALSE;
8720  }
8721 #endif
8722  int at=a->Typ();
8723  // handling bb-objects ----------------------------------------------
8724  if (at>MAX_TOK)
8725  {
8726  blackbox *bb=getBlackboxStuff(at);
8727  if (bb!=NULL)
8728  {
8729  if(!bb->blackbox_Op3(op,res,a,b,c)) return FALSE;
8730  // else: no op defined
8731  }
8732  else
8733  return TRUE;
8734  if (errorreported) return TRUE;
8735  }
8736  int bt=b->Typ();
8737  int ct=c->Typ();
8738 
8739  iiOp=op;
8740  int i=0;
8741  while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8742  return iiExprArith3TabIntern(res,op,a,b,c,dArith3+i,at,bt,ct,dConvertTypes);
8743  }
8744  a->CleanUp();
8745  b->CleanUp();
8746  c->CleanUp();
8747  //Print("op: %d,result typ:%d\n",op,res->rtyp);
8748  return TRUE;
8749 }
const struct sConvertTypes dConvertTypes[]
Definition: table.h:1256
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:8544
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
ip_command * command
Definition: ipid.h:22
#define FALSE
Definition: auxiliary.h:94
Definition: tok.h:216
BOOLEAN siq
Definition: subexpr.cc:48
#define TRUE
Definition: auxiliary.h:98
void Init()
Definition: subexpr.h:107
int Typ()
Definition: subexpr.cc:1033
void * data
Definition: subexpr.h:88
const struct sValCmd3 dArith3[]
Definition: table.h:768
int i
Definition: cfEzgcd.cc:125
short errorreported
Definition: feFopen.cc:23
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
#define NULL
Definition: omList.c:12
omBin sip_command_bin
Definition: ipid.cc:45
int rtyp
Definition: subexpr.h:91
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
int iiOp
Definition: iparith.cc:216
#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 8750 of file iparith.cc.

8754 {
8755  leftv b=a->next;
8756  a->next=NULL;
8757  int bt=b->Typ();
8758  leftv c=b->next;
8759  b->next=NULL;
8760  int ct=c->Typ();
8761  BOOLEAN bo=iiExprArith3TabIntern(res,op,a,b,c,dA3,at,bt,ct,dConvertTypes);
8762  b->next=c;
8763  a->next=b;
8764  a->CleanUp(); // to cleanup the chain, content already done
8765  return bo;
8766 }
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:8544
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
int Typ()
Definition: subexpr.cc:1033
CanonicalForm b
Definition: cfModGcd.cc:4044
leftv next
Definition: subexpr.h:86
#define NULL
Definition: omList.c:12
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
int BOOLEAN
Definition: auxiliary.h:85

◆ iiExprArithM()

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

◆ iiGetLibName()

static char* iiGetLibName ( const procinfov  pi)
inlinestatic

find the library of an proc

Definition at line 66 of file ipshell.h.

66 { return pi->libname; }
char * libname
Definition: subexpr.h:56

◆ iiGetLibProcBuffer()

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

◆ iiHighCorner()

poly iiHighCorner ( ideal  i,
int  ak 
)

Definition at line 1515 of file ipshell.cc.

1516 {
1517  int i;
1518  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1519  poly po=NULL;
1521  {
1522  scComputeHC(I,currRing->qideal,ak,po);
1523  if (po!=NULL)
1524  {
1525  pGetCoeff(po)=nInit(1);
1526  for (i=rVar(currRing); i>0; i--)
1527  {
1528  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1529  }
1530  pSetComp(po,ak);
1531  pSetm(po);
1532  }
1533  }
1534  else
1535  po=pOne();
1536  return po;
1537 }
BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition: ring.h:755
#define pSetm(p)
Definition: polys.h:266
#define pDecrExp(p, i)
Definition: polys.h:44
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:586
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge, ring tailRing)
Definition: hdegree.cc:1004
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy ...
Definition: monomials.h:44
static BOOLEAN idIsZeroDim(ideal i)
Definition: ideals.h:178
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
#define pSetComp(p, v)
Definition: polys.h:38
int i
Definition: cfEzgcd.cc:125
#define pOne()
Definition: polys.h:310
#define NULL
Definition: omList.c:12
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define nInit(i)
Definition: numbers.h:24

◆ iiInternalExport()

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

Definition at line 1371 of file ipshell.cc.

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

◆ iiLibCmd()

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

Definition at line 825 of file iplib.cc.

826 {
827  char libnamebuf[1024];
828  // procinfov pi;
829  // idhdl h;
830  idhdl pl;
831  // idhdl hl;
832  // long pos = 0L;
833  char *plib = iiConvName(newlib);
834  FILE * fp = feFopen( newlib, "r", libnamebuf, tellerror );
835  // int lines = 1;
836  BOOLEAN LoadResult = TRUE;
837 
838  if (fp==NULL)
839  {
840  return TRUE;
841  }
842  pl = basePack->idroot->get(plib,0);
843  if (pl==NULL)
844  {
845  pl = enterid( plib,0, PACKAGE_CMD,
846  &(basePack->idroot), TRUE );
847  IDPACKAGE(pl)->language = LANG_SINGULAR;
848  IDPACKAGE(pl)->libname=omStrDup(newlib);
849  }
850  else
851  {
852  if(IDTYP(pl)!=PACKAGE_CMD)
853  {
854  WarnS("not of type package.");
855  fclose(fp);
856  return TRUE;
857  }
858  if (!force) return FALSE;
859  }
860  LoadResult = iiLoadLIB(fp, libnamebuf, newlib, pl, autoexport, tellerror);
861  omFree((ADDRESS)newlib);
862 
863  if(!LoadResult) IDPACKAGE(pl)->loaded = TRUE;
864  omFree((ADDRESS)plib);
865 
866  return LoadResult;
867 }
CanonicalForm fp
Definition: cfModGcd.cc:4043
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
void * ADDRESS
Definition: auxiliary.h:133
#define WarnS
Definition: emacs.cc:78
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:134
#define IDTYP(a)
Definition: ipid.h:114
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:265
#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:12
package basePack
Definition: ipid.cc:58
BOOLEAN iiLoadLIB(FILE *fp, const char *libnamebuf, const char *newlib, idhdl pl, BOOLEAN autoexport, BOOLEAN tellerror)
Definition: iplib.cc:914
char * iiConvName(const char *libname)
Definition: iplib.cc:1331
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 914 of file iplib.cc.

916 {
917  extern FILE *yylpin;
918  libstackv ls_start = library_stack;
919  lib_style_types lib_style;
920 
921  yylpin = fp;
922  #if YYLPDEBUG > 1
923  print_init();
924  #endif
925  extern int lpverbose;
926  if (BVERBOSE(V_DEBUG_LIB)) lpverbose=1;
927  else lpverbose=0;
928  // yylplex sets also text_buffer
929  if (text_buffer!=NULL) *text_buffer='\0';
930  yylplex(newlib, libnamebuf, &lib_style, pl, autoexport);
931  if(yylp_errno)
932  {
933  Werror("Library %s: ERROR occurred: in line %d, %d.", newlib, yylplineno,
934  current_pos(0));
936  {
940  }
941  else
943  WerrorS("Cannot load library,... aborting.");
944  reinit_yylp();
945  fclose( yylpin );
947  return TRUE;
948  }
949  if (BVERBOSE(V_LOAD_LIB))
950  Print( "// ** loaded %s %s\n", libnamebuf, text_buffer);
951  if( (lib_style == OLD_LIBSTYLE) && (BVERBOSE(V_LOAD_LIB)))
952  {
953  Warn( "library %s has old format. This format is still accepted,", newlib);
954  WarnS( "but for functionality you may wish to change to the new");
955  WarnS( "format. Please refer to the manual for further information.");
956  }
957  reinit_yylp();
958  fclose( yylpin );
959  fp = NULL;
960  iiRunInit(IDPACKAGE(pl));
961 
962  {
963  libstackv ls;
964  for(ls = library_stack; (ls != NULL) && (ls != ls_start); )
965  {
966  if(ls->to_be_done)
967  {
968  ls->to_be_done=FALSE;
969  iiLibCmd(ls->get(),autoexport,tellerror,FALSE);
970  ls = ls->pop(newlib);
971  }
972  }
973 #if 0
974  PrintS("--------------------\n");
975  for(ls = library_stack; ls != NULL; ls = ls->next)
976  {
977  Print("%s: LIB-stack:(%d), %s %s\n", newlib, ls->cnt, ls->get(),
978  ls->to_be_done ? "not loaded" : "loaded");
979  }
980  PrintS("--------------------\n");
981 #endif
982  }
983 
984  if(fp != NULL) fclose(fp);
985  return FALSE;
986 }
int cnt
Definition: subexpr.h:166
#define Print
Definition: emacs.cc:80
CanonicalForm fp
Definition: cfModGcd.cc:4043
int yylplex(const char *libname, const char *libfile, lib_style_types *lib_style, idhdl pl, BOOLEAN autoexport=FALSE, lp_modes=LOAD_LIB)
libstackv next
Definition: subexpr.h:163
#define FALSE
Definition: auxiliary.h:94
static void iiRunInit(package p)
Definition: iplib.cc:898
#define V_LOAD_LIB
Definition: options.h:47
#define IDROOT
Definition: ipid.h:18
BOOLEAN to_be_done
Definition: subexpr.h:165
#define TRUE
Definition: auxiliary.h:98
void print_init()
Definition: libparse.cc:3480
void * ADDRESS
Definition: auxiliary.h:133
void WerrorS(const char *s)
Definition: feFopen.cc:24
char * get()
Definition: subexpr.h:169
#define V_DEBUG_LIB
Definition: options.h:48
#define WarnS
Definition: emacs.cc:78
libstackv pop(const char *p)
Definition: iplib.cc:1422
BOOLEAN iiLibCmd(char *newlib, BOOLEAN autoexport, BOOLEAN tellerror, BOOLEAN force)
Definition: iplib.cc:825
#define IDPACKAGE(a)
Definition: ipid.h:134
#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:35
#define NULL
Definition: omList.c:12
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:869
void Werror(const char *fmt,...)
Definition: reporter.cc:189
libstackv library_stack
Definition: iplib.cc:64
int yylplineno
Definition: libparse.cc:1102
#define Warn
Definition: emacs.cc:77
void reinit_yylp()
Definition: libparse.cc:3374

◆ iiLocateLib()

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

Definition at line 811 of file iplib.cc.

812 {
813  char *plib = iiConvName(lib);
814  idhdl pl = basePack->idroot->get(plib,0);
815  if( (pl!=NULL) && (IDTYP(pl)==PACKAGE_CMD) &&
816  (IDPACKAGE(pl)->language == LANG_SINGULAR))
817  {
818  strncpy(where,IDPACKAGE(pl)->libname,127);
819  return TRUE;
820  }
821  else
822  return FALSE;;
823 }
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:134
#define IDTYP(a)
Definition: ipid.h:114
#define NULL
Definition: omList.c:12
package basePack
Definition: ipid.cc:58
char * iiConvName(const char *libname)
Definition: iplib.cc:1331

◆ iiMake_proc()

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

Definition at line 484 of file iplib.cc.

485 {
486  int err;
487  procinfov pi = IDPROC(pn);
488  if(pi->is_static && myynest==0)
489  {
490  Werror("'%s::%s()' is a local procedure and cannot be accessed by an user.",
491  pi->libname, pi->procname);
492  return TRUE;
493  }
494  iiCheckNest();
496  //Print("currRing(%d):%s(%x) in %s\n",myynest,IDID(currRingHdl),currRing,IDID(pn));
497  iiRETURNEXPR.Init();
498  procstack->push(pi->procname);
500  || (pi->trace_flag&TRACE_SHOW_PROC))
501  {
503  Print("entering%-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
504  }
505 #ifdef RDEBUG
507 #endif
508  switch (pi->language)
509  {
510  default:
511  case LANG_NONE:
512  WerrorS("undefined proc");
513  err=TRUE;
514  break;
515 
516  case LANG_SINGULAR:
517  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
518  {
519  currPack=pi->pack;
522  //Print("set pack=%s\n",IDID(currPackHdl));
523  }
524  else if ((pack!=NULL)&&(currPack!=pack))
525  {
526  currPack=pack;
529  //Print("set pack=%s\n",IDID(currPackHdl));
530  }
531  err=iiPStart(pn,sl);
532  break;
533  case LANG_C:
535  err = (pi->data.o.function)(res, sl);
536  memcpy(&iiRETURNEXPR,res,sizeof(iiRETURNEXPR));
538  break;
539  }
540  if ((traceit&TRACE_SHOW_PROC)
541  || (pi->trace_flag&TRACE_SHOW_PROC))
542  {
543  if (traceit&TRACE_SHOW_LINENO) PrintLn();
544  Print("leaving %-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
545  }
546  //const char *n="NULL";
547  //if (currRingHdl!=NULL) n=IDID(currRingHdl);
548  //Print("currRing(%d):%s(%x) after %s\n",myynest,n,currRing,IDID(pn));
549 #ifdef RDEBUG
550  if (traceit&TRACE_SHOW_RINGS) iiShowLevRings();
551 #endif
552  if (err)
553  {
555  //iiRETURNEXPR.Init(); //done by CleanUp
556  }
557  if (iiCurrArgs!=NULL)
558  {
559  if (!err) Warn("too many arguments for %s",IDID(pn));
560  iiCurrArgs->CleanUp();
563  }
564  procstack->pop();
565  if (err)
566  return TRUE;
567  return FALSE;
568 }
#define TRACE_SHOW_LINENO
Definition: reporter.h:30
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define TRACE_SHOW_RINGS
Definition: reporter.h:35
void PrintLn()
Definition: reporter.cc:310
#define Print
Definition: emacs.cc:80
package pack
Definition: subexpr.h:58
idhdl currPackHdl
Definition: ipid.cc:55
#define IDID(a)
Definition: ipid.h:117
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:454
language_defs language
Definition: subexpr.h:59
proclevel * procstack
Definition: ipid.cc:52
static void iiShowLevRings()
Definition: iplib.cc:458
#define TRUE
Definition: auxiliary.h:98
void Init()
Definition: subexpr.h:107
void * ADDRESS
Definition: auxiliary.h:133
sleftv * leftv
Definition: structs.h:62
void WerrorS(const char *s)
Definition: feFopen.cc:24
int traceit
Definition: febase.cc:42
static void iiCheckNest()
Definition: iplib.cc:473
BOOLEAN iiPStart(idhdl pn, leftv v)
Definition: iplib.cc:352
char * procname
Definition: subexpr.h:57
Definition: subexpr.h:22
int myynest
Definition: febase.cc:41
char * libname
Definition: subexpr.h:56
CanonicalForm res
Definition: facAbsFact.cc:64
procinfodata data
Definition: subexpr.h:63
omBin sleftv_bin
Definition: subexpr.cc:41
char is_static
Definition: subexpr.h:61
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
#define IDPROC(a)
Definition: ipid.h:135
#define pi
Definition: libparse.cc:1143
ring * iiLocalRing
Definition: iplib.cc:453
#define NULL
Definition: omList.c:12
package currPack
Definition: ipid.cc:57
leftv iiCurrArgs
Definition: ipshell.cc:76
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define TRACE_SHOW_PROC
Definition: reporter.h:28
idhdl packFindHdl(package r)
Definition: ipid.cc:750
void iiCheckPack(package &p)
Definition: ipshell.cc:1539
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
void push(char *)
Definition: ipid.cc:722
void pop()
Definition: ipid.cc:732
char trace_flag
Definition: subexpr.h:62
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define Warn
Definition: emacs.cc:77

◆ iiMakeResolv()

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

Definition at line 769 of file ipshell.cc.

771 {
772  lists L=liMakeResolv(r,length,rlen,typ0,weights);
773  int i=0;
774  idhdl h;
775  char * s=(char *)omAlloc(strlen(name)+5);
776 
777  while (i<=L->nr)
778  {
779  sprintf(s,"%s(%d)",name,i+1);
780  if (i==0)
781  h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
782  else
783  h=enterid(s,myynest,MODUL_CMD,&(currRing->idroot), FALSE);
784  if (h!=NULL)
785  {
786  h->data.uideal=(ideal)L->m[i].data;
787  h->attribute=L->m[i].attribute;
789  Print("//defining: %s as %d-th syzygy module\n",s,i+1);
790  }
791  else
792  {
793  idDelete((ideal *)&(L->m[i].data));
794  Warn("cannot define %s",s);
795  }
796  //L->m[i].data=NULL;
797  //L->m[i].rtyp=0;
798  //L->m[i].attribute=NULL;
799  i++;
800  }
801  omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
803  omFreeSize((ADDRESS)s,strlen(name)+5);
804 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:46
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define Print
Definition: emacs.cc:80
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
Definition: lists.h:23
#define FALSE
Definition: auxiliary.h:94
#define V_DEF_RES
Definition: options.h:50
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:133
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: idrec.h:34
void * data
Definition: subexpr.h:88
int myynest
Definition: febase.cc:41
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:265
if(yy_init)
Definition: libparse.cc:1418
int i
Definition: cfEzgcd.cc:125
char name(const Variable &v)
Definition: factory.h:180
#define BVERBOSE(a)
Definition: options.h:35
int nr
Definition: lists.h:44
#define NULL
Definition: omList.c:12
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:216
static BOOLEAN length(leftv result, leftv arg)
Definition: interval.cc:263
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
attr attribute
Definition: subexpr.h:89
omBin slists_bin
Definition: lists.cc:23
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
static Poly * h
Definition: janet.cc:971
utypes data
Definition: idrec.h:40
#define Warn
Definition: emacs.cc:77

◆ iiMap()

leftv iiMap ( map  theMap,
const char *  what 
)

Definition at line 610 of file ipshell.cc.

611 {
612  idhdl w,r;
613  leftv v;
614  int i;
615  nMapFunc nMap;
616 
617  r=IDROOT->get(theMap->preimage,myynest);
618  if ((currPack!=basePack)
619  &&((r==NULL) || ((r->typ != RING_CMD) )))
620  r=basePack->idroot->get(theMap->preimage,myynest);
621  if ((r==NULL) && (currRingHdl!=NULL)
622  && (strcmp(theMap->preimage,IDID(currRingHdl))==0))
623  {
624  r=currRingHdl;
625  }
626  if ((r!=NULL) && (r->typ == RING_CMD))
627  {
628  ring src_ring=IDRING(r);
629  if ((nMap=n_SetMap(src_ring->cf, currRing->cf))==NULL)
630  {
631  Werror("can not map from ground field of %s to current ground field",
632  theMap->preimage);
633  return NULL;
634  }
635  if (IDELEMS(theMap)<src_ring->N)
636  {
637  theMap->m=(polyset)omReallocSize((ADDRESS)theMap->m,
638  IDELEMS(theMap)*sizeof(poly),
639  (src_ring->N)*sizeof(poly));
640  for(i=IDELEMS(theMap);i<src_ring->N;i++)
641  theMap->m[i]=NULL;
642  IDELEMS(theMap)=src_ring->N;
643  }
644  if (what==NULL)
645  {
646  WerrorS("argument of a map must have a name");
647  }
648  else if ((w=src_ring->idroot->get(what,myynest))!=NULL)
649  {
650  char *save_r=NULL;
652  sleftv tmpW;
653  memset(&tmpW,0,sizeof(sleftv));
654  tmpW.rtyp=IDTYP(w);
655  if (tmpW.rtyp==MAP_CMD)
656  {
657  tmpW.rtyp=IDEAL_CMD;
658  save_r=IDMAP(w)->preimage;
659  IDMAP(w)->preimage=0;
660  }
661  tmpW.data=IDDATA(w);
662  // check overflow
663  BOOLEAN overflow=FALSE;
664  if ((tmpW.rtyp==IDEAL_CMD)
665  || (tmpW.rtyp==MODUL_CMD)
666  || (tmpW.rtyp==MAP_CMD))
667  {
668  ideal id=(ideal)tmpW.data;
669  long *degs=(long*)omAlloc(IDELEMS(id)*sizeof(long));
670  for(int i=IDELEMS(id)-1;i>=0;i--)
671  {
672  poly p=id->m[i];
673  if (p!=NULL) degs[i]=p_Totaldegree(p,src_ring);
674  else degs[i]=0;
675  }
676  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
677  {
678  if (theMap->m[j]!=NULL)
679  {
680  long deg_monexp=pTotaldegree(theMap->m[j]);
681 
682  for(int i=IDELEMS(id)-1;i>=0;i--)
683  {
684  poly p=id->m[i];
685  if ((p!=NULL) && (degs[i]!=0) &&
686  ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)degs[i])/2)))
687  {
688  overflow=TRUE;
689  break;
690  }
691  }
692  }
693  }
694  omFreeSize(degs,IDELEMS(id)*sizeof(long));
695  }
696  else if (tmpW.rtyp==POLY_CMD)
697  {
698  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
699  {
700  if (theMap->m[j]!=NULL)
701  {
702  long deg_monexp=pTotaldegree(theMap->m[j]);
703  poly p=(poly)tmpW.data;
704  long deg=0;
705  if ((p!=NULL) && ((deg=p_Totaldegree(p,src_ring))!=0) &&
706  ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)deg)/2)))
707  {
708  overflow=TRUE;
709  break;
710  }
711  }
712  }
713  }
714  if (overflow)
715  Warn("possible OVERFLOW in map, max exponent is %ld",currRing->bitmask/2);
716 #if 0
717  if (((tmpW.rtyp==IDEAL_CMD)||(tmpW.rtyp==MODUL_CMD)) && idIs0(IDIDEAL(w)))
718  {
719  v->rtyp=tmpW.rtyp;
720  v->data=idInit(IDELEMS(IDIDEAL(w)),IDIDEAL(w)->rank);
721  }
722  else
723 #endif
724  {
725  if ((tmpW.rtyp==IDEAL_CMD)
726  ||(tmpW.rtyp==MODUL_CMD)
727  ||(tmpW.rtyp==MATRIX_CMD)
728  ||(tmpW.rtyp==MAP_CMD))
729  {
730  v->rtyp=tmpW.rtyp;
731  char *tmp = theMap->preimage;
732  theMap->preimage=(char*)1L;
733  // map gets 1 as its rank (as an ideal)
734  v->data=maMapIdeal(IDIDEAL(w), src_ring, (ideal)theMap, currRing,nMap);
735  theMap->preimage=tmp; // map gets its preimage back
736  }
737  if (v->data==NULL) /*i.e. not IDEAL_CMD/MODUL_CMD/MATRIX_CMD/MAP */
738  {
739  if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,src_ring,NULL,NULL,0,nMap))
740  {
741  Werror("cannot map %s(%d)",Tok2Cmdname(w->typ),w->typ);
743  if (save_r!=NULL) IDMAP(w)->preimage=save_r;
744  return NULL;
745  }
746  }
747  }
748  if (save_r!=NULL)
749  {
750  IDMAP(w)->preimage=save_r;
751  IDMAP((idhdl)v)->preimage=omStrDup(save_r);
752  v->rtyp=MAP_CMD;
753  }
754  return v;
755  }
756  else
757  {
758  Werror("%s undefined in %s",what,theMap->preimage);
759  }
760  }
761  else
762  {
763  Werror("cannot find preimage %s",theMap->preimage);
764  }
765  return NULL;
766 }
int j
Definition: facHensel.cc:105
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define IDID(a)
Definition: ipid.h:117
#define FALSE
Definition: auxiliary.h:94
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define IDROOT
Definition: ipid.h:18
#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:45
#define IDIDEAL(a)
Definition: ipid.h:128
static long p_Totaldegree(poly p, const ring r)
Definition: p_polys.h:1442
void * ADDRESS
Definition: auxiliary.h:133
sleftv * leftv
Definition: structs.h:62
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:84
void * data
Definition: subexpr.h:88
int myynest
Definition: febase.cc:41
#define omReallocSize(addr, o_size, size)
Definition: omAllocDecl.h:220
#define IDTYP(a)
Definition: ipid.h:114
if(yy_init)
Definition: libparse.cc:1418
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:87
static long pTotaldegree(poly p)
Definition: polys.h:277
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:59
poly * polyset
Definition: polys.h:254
omBin sleftv_bin
Definition: subexpr.cc:41
int i
Definition: cfEzgcd.cc:125
#define IDELEMS(i)
Definition: simpleideals.h:23
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:721
#define IDMAP(a)
Definition: ipid.h:130
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:35
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:12
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140
package basePack
Definition: ipid.cc:58
#define IDRING(a)
Definition: ipid.h:122
const CanonicalForm & w
Definition: facAbsFact.cc:55
package currPack
Definition: ipid.cc:57
int rtyp
Definition: subexpr.h:91
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
int typ
Definition: idrec.h:43
int p
Definition: cfModGcd.cc:4019
#define IDDATA(a)
Definition: ipid.h:121
#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:77
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiOpsTwoChar()

int iiOpsTwoChar ( const char *  s)

Definition at line 117 of file ipshell.cc.

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

◆ iiParameter()

BOOLEAN iiParameter ( leftv  p)

Definition at line 1283 of file ipshell.cc.

1284 {
1285  if (iiCurrArgs==NULL)
1286  {
1287  if (strcmp(p->name,"#")==0)
1288  return iiDefaultParameter(p);
1289  Werror("not enough arguments for proc %s",VoiceName());
1290  p->CleanUp();
1291  return TRUE;
1292  }
1293  leftv h=iiCurrArgs;
1294  leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1295  BOOLEAN is_default_list=FALSE;
1296  if (strcmp(p->name,"#")==0)
1297  {
1298  is_default_list=TRUE;
1299  rest=NULL;
1300  }
1301  else
1302  {
1303  h->next=NULL;
1304  }
1305  BOOLEAN res=iiAssign(p,h);
1306  if (is_default_list)
1307  {
1308  iiCurrArgs=NULL;
1309  }
1310  else
1311  {
1312  iiCurrArgs=rest;
1313  }
1314  h->CleanUp();
1316  return res;
1317 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define FALSE
Definition: auxiliary.h:94
#define TRUE
Definition: auxiliary.h:98
void * ADDRESS
Definition: auxiliary.h:133
CanonicalForm res
Definition: facAbsFact.cc:64
const char * name
Definition: subexpr.h:87
omBin sleftv_bin
Definition: subexpr.cc:41
const char * VoiceName()
Definition: fevoices.cc:56
leftv next
Definition: subexpr.h:86
#define NULL
Definition: omList.c:12
BOOLEAN iiDefaultParameter(leftv p)
Definition: ipshell.cc:1169
leftv iiCurrArgs
Definition: ipshell.cc:76
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
static Poly * h
Definition: janet.cc:971
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:1830

◆ iiProcArgs()

char* iiProcArgs ( char *  e,
BOOLEAN  withParenth 
)

Definition at line 108 of file iplib.cc.

109 {
110  while ((*e==' ') || (*e=='\t') || (*e=='(')) e++;
111  if (*e<' ')
112  {
113  if (withParenth)
114  {
115  // no argument list, allow list #
116  return omStrDup("parameter list #;");
117  }
118  else
119  {
120  // empty list
121  return omStrDup("");
122  }
123  }
124  BOOLEAN in_args;
125  BOOLEAN args_found;
126  char *s;
127  char *argstr=(char *)omAlloc(127); // see ../omalloc/omTables.inc
128  int argstrlen=127;
129  *argstr='\0';
130  int par=0;
131  do
132  {
133  args_found=FALSE;
134  s=e; // set s to the starting point of the arg
135  // and search for the end
136  // skip leading spaces:
137  loop
138  {
139  if ((*s==' ')||(*s=='\t'))
140  s++;
141  else if ((*s=='\n')&&(*(s+1)==' '))
142  s+=2;
143  else // start of new arg or \0 or )
144  break;
145  }
146  e=s;
147  while ((*e!=',')
148  &&((par!=0) || (*e!=')'))
149  &&(*e!='\0'))
150  {
151  if (*e=='(') par++;
152  else if (*e==')') par--;
153  args_found=args_found || (*e>' ');
154  e++;
155  }
156  in_args=(*e==',');
157  if (args_found)
158  {
159  *e='\0';
160  // check for space:
161  if ((int)strlen(argstr)+12 /* parameter + ;*/ +(int)strlen(s)>= argstrlen)
162  {
163  argstrlen*=2;
164  char *a=(char *)omAlloc( argstrlen);
165  strcpy(a,argstr);
166  omFree((ADDRESS)argstr);
167  argstr=a;
168  }
169  // copy the result to argstr
170  if(strncmp(s,"alias ",6)!=0)
171  {
172  strcat(argstr,"parameter ");
173  }
174  strcat(argstr,s);
175  strcat(argstr,"; ");
176  e++; // e was pointing to ','
177  }
178  } while (in_args);
179  return argstr;
180 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define FALSE
Definition: auxiliary.h:94
void * ADDRESS
Definition: auxiliary.h:133
#define loop
Definition: structs.h:80
#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 94 of file iplib.cc.

95 {
96  char *s=buf+5;
97  while (*s==' ') s++;
98  e=s+1;
99  while ((*e>' ') && (*e!='(')) e++;
100  ct=*e;
101  *e='\0';
102  return s;
103 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
int status int void * buf
Definition: si_signals.h:59

◆ iiPStart()

BOOLEAN iiPStart ( idhdl  pn,
leftv  sl 
)

Definition at line 352 of file iplib.cc.

353 {
354  procinfov pi=NULL;
355  int old_echo=si_echo;
356  BOOLEAN err=FALSE;
357  char save_flags=0;
358 
359  /* init febase ======================================== */
360  /* we do not enter this case if filename != NULL !! */
361  if (pn!=NULL)
362  {
363  pi = IDPROC(pn);
364  if(pi!=NULL)
365  {
366  save_flags=pi->trace_flag;
367  if( pi->data.s.body==NULL )
368  {
369  iiGetLibProcBuffer(pi);
370  if (pi->data.s.body==NULL) return TRUE;
371  }
372 // omUpdateInfo();
373 // int m=om_Info.UsedBytes;
374 // Print("proc %s, mem=%d\n",IDID(pn),m);
375  }
376  }
377  else return TRUE;
378  /* generate argument list ======================================*/
379  //iiCurrArgs should be NULL here, as the assignment for the parameters
380  // of the prevouis call are already done befor calling another routine
381  if (v!=NULL)
382  {
384  memcpy(iiCurrArgs,v,sizeof(sleftv)); // keeps track of v->next etc.
385  memset(v,0,sizeof(sleftv));
386  }
387  else
388  {
390  }
391  iiCurrProc=pn;
392  /* start interpreter ======================================*/
393  myynest++;
394  if (myynest > SI_MAX_NEST)
395  {
396  WerrorS("nesting too deep");
397  err=TRUE;
398  }
399  else
400  {
401  err=iiAllStart(pi,pi->data.s.body,BT_proc,pi->data.s.body_lineno-(v!=NULL));
402 
403  if (iiLocalRing[myynest-1] != currRing)
404  {
406  {
407  //idhdl hn;
408  const char *n;
409  const char *o;
410  idhdl nh=NULL, oh=NULL;
411  if (iiLocalRing[myynest-1]!=NULL)
413  if (oh!=NULL) o=oh->id;
414  else o="none";
415  if (currRing!=NULL)
416  nh=rFindHdl(currRing,NULL);
417  if (nh!=NULL) n=nh->id;
418  else n="none";
419  Werror("ring change during procedure call %s: %s -> %s (level %d)",pi->procname,o,n,myynest);
421  err=TRUE;
422  }
424  }
425  if ((currRing==NULL)
426  && (currRingHdl!=NULL))
428  else
429  if ((currRing!=NULL) &&
431  ||(IDLEV(currRingHdl)>=myynest-1)))
432  {
435  }
436  //Print("kill locals for %s (level %d)\n",IDID(pn),myynest);
438 #ifndef SING_NDEBUG
439  checkall();
440 #endif
441  //Print("end kill locals for %s (%d)\n",IDID(pn),myynest);
442  }
443  myynest--;
444  si_echo=old_echo;
445  if (pi!=NULL)
446  pi->trace_flag=save_flags;
447 // omUpdateInfo();
448 // int m=om_Info.UsedBytes;
449 // Print("exit %s, mem=%d\n",IDID(pn),m);
450  return err;
451 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:454
#define TRUE
Definition: auxiliary.h:98
sleftv * leftv
Definition: structs.h:62
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: idrec.h:34
idhdl iiCurrProc
Definition: ipshell.cc:77
#define SI_MAX_NEST
Definition: iplib.cc:23
char * procname
Definition: subexpr.h:57
int myynest
Definition: febase.cc:41
BOOLEAN RingDependend()
Definition: subexpr.cc:418
void killlocals(int v)
Definition: ipshell.cc:381
procinfodata data
Definition: subexpr.h:63
idhdl currRingHdl
Definition: ipid.cc:59
omBin sleftv_bin
Definition: subexpr.cc:41
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1610
#define IDLEV(a)
Definition: ipid.h:116
BOOLEAN iiAllStart(procinfov pi, char *p, feBufferTypes t, int l)
Definition: iplib.cc:292
#define IDPROC(a)
Definition: ipid.h:135
#define pi
Definition: libparse.cc:1143
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
ring * iiLocalRing
Definition: iplib.cc:453
#define NULL
Definition: omList.c:12
#define IDRING(a)
Definition: ipid.h:122
leftv iiCurrArgs
Definition: ipshell.cc:76
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
const char * id
Definition: idrec.h:39
void rSetHdl(idhdl h)
Definition: ipshell.cc:5086
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:191
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:35

◆ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 959 of file ipshell.cc.

960 {
961  int len,reg,typ0;
962 
963  resolvente r=liFindRes(L,&len,&typ0);
964 
965  if (r==NULL)
966  return -2;
967  intvec *weights=NULL;
968  int add_row_shift=0;
969  intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
970  if (ww!=NULL)
971  {
972  weights=ivCopy(ww);
973  add_row_shift = ww->min_in();
974  (*weights) -= add_row_shift;
975  }
976  //Print("attr:%x\n",weights);
977 
978  intvec *dummy=syBetti(r,len,&reg,weights);
979  if (weights!=NULL) delete weights;
980  delete dummy;
981  omFreeSize((ADDRESS)r,len*sizeof(ideal));
982  return reg+1+add_row_shift;
983 }
sleftv * m
Definition: lists.h:46
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:315
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * ivCopy(const intvec *o)
Definition: intvec.h:135
void * ADDRESS
Definition: auxiliary.h:133
int min_in()
Definition: intvec.h:121
Definition: intvec.h:19
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:129
#define NULL
Definition: omList.c:12
ideal * resolvente
Definition: ideals.h:18
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:770

◆ iiTestAssume()

BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6434 of file ipshell.cc.

6435 {
6436  // assume a: level
6437  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6438  {
6439  if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6440  char assume_yylinebuf[80];
6441  strncpy(assume_yylinebuf,my_yylinebuf,79);
6442  int lev=(long)a->Data();
6443  int startlev=0;
6444  idhdl h=ggetid("assumeLevel");
6445  if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6446  if(lev <=startlev)
6447  {
6448  BOOLEAN bo=b->Eval();
6449  if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6450  if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6451  if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6452  }
6453  }
6454  b->CleanUp();
6455  a->CleanUp();
6456  return FALSE;
6457 }
idhdl ggetid(const char *n)
Definition: ipid.cc:521
int Eval()
Definition: subexpr.cc:1837
Definition: tok.h:96
#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:78
int Typ()
Definition: subexpr.cc:1033
Definition: idrec.h:34
int myynest
Definition: febase.cc:41
#define IDTYP(a)
Definition: ipid.h:114
char my_yylinebuf[80]
Definition: febase.cc:43
#define NULL
Definition: omList.c:12
#define IDINT(a)
Definition: ipid.h:120
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
void * Data()
Definition: subexpr.cc:1176
static Poly * h
Definition: janet.cc:971
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189
#define TEST_V_ALLWARN
Definition: options.h:140

◆ iiTokType()

int iiTokType ( int  op)

Definition at line 231 of file iparith.cc.

232 {
233  for (unsigned i=0;i<sArithBase.nCmdUsed;i++)
234  {
235  if (sArithBase.sCmds[i].tokval==op)
236  return sArithBase.sCmds[i].toktype;
237  }
238  return 0;
239 }
int i
Definition: cfEzgcd.cc:125
unsigned nCmdUsed
number of commands used
Definition: iparith.cc:185
static SArithBase sArithBase
Base entry for arithmetic.
Definition: iparith.cc:195
cmdnames * sCmds
array of existing commands
Definition: iparith.cc:180

◆ iiTryLoadLib()

BOOLEAN iiTryLoadLib ( leftv  v,
const char *  id 
)

Definition at line 763 of file iplib.cc.

764 {
765  BOOLEAN LoadResult = TRUE;
766  char libnamebuf[1024];
767  char *libname = (char *)omAlloc(strlen(id)+5);
768  const char *suffix[] = { "", ".lib", ".so", ".sl", NULL };
769  int i = 0;
770  // FILE *fp;
771  // package pack;
772  // idhdl packhdl;
773  lib_types LT;
774  for(i=0; suffix[i] != NULL; i++)
775  {
776  sprintf(libname, "%s%s", id, suffix[i]);
777  *libname = mytolower(*libname);
778  if((LT = type_of_LIB(libname, libnamebuf)) > LT_NOTFOUND)
779  {
780  char *s=omStrDup(libname);
781  #ifdef HAVE_DYNAMIC_LOADING
782  char libnamebuf[1024];
783  #endif
784 
785  if (LT==LT_SINGULAR)
786  LoadResult = iiLibCmd(s, FALSE, FALSE,TRUE);
787  #ifdef HAVE_DYNAMIC_LOADING
788  else if ((LT==LT_ELF) || (LT==LT_HPUX))
789  LoadResult = load_modules(s,libnamebuf,FALSE);
790  #endif
791  else if (LT==LT_BUILTIN)
792  {
793  LoadResult=load_builtin(s,FALSE, iiGetBuiltinModInit(s));
794  }
795  if(!LoadResult )
796  {
797  v->name = iiConvName(libname);
798  break;
799  }
800  }
801  }
802  omFree(libname);
803  return LoadResult;
804 }
BOOLEAN load_builtin(const char *newlib, BOOLEAN autoexport, SModulFunc_t init)
Definition: iplib.cc:1197
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:22
#define omAlloc(size)
Definition: omAllocDecl.h:210
BOOLEAN iiLibCmd(char *newlib, BOOLEAN autoexport, BOOLEAN tellerror, BOOLEAN force)
Definition: iplib.cc:825
const char * name
Definition: subexpr.h:87
#define omFree(addr)
Definition: omAllocDecl.h:261
int i
Definition: cfEzgcd.cc:125
lib_types
Definition: mod_raw.h:16
char libnamebuf[1024]
Definition: libparse.cc:1096
char mytolower(char c)
Definition: iplib.cc:1318
#define NULL
Definition: omList.c:12
SModulFunc_t iiGetBuiltinModInit(const char *libname)
Definition: iplib.cc:750
char * iiConvName(const char *libname)
Definition: iplib.cc:1331
int BOOLEAN
Definition: auxiliary.h:85
BOOLEAN load_modules(const char *newlib, char *fullname, BOOLEAN autoexport)
Definition: iplib.cc:1090
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ iiTwoOps()

const char* iiTwoOps ( int  t)

Definition at line 261 of file gentable.cc.

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

◆ iiWRITE()

BOOLEAN iiWRITE ( leftv  res,
leftv  exprlist 
)

Definition at line 583 of file ipshell.cc.

584 {
585  sleftv vf;
586  if (iiConvert(v->Typ(),LINK_CMD,iiTestConvert(v->Typ(),LINK_CMD),v,&vf))
587  {
588  WerrorS("link expected");
589  return TRUE;
590  }
591  si_link l=(si_link)vf.Data();
592  if (vf.next == NULL)
593  {
594  WerrorS("write: need at least two arguments");
595  return TRUE;
596  }
597 
598  BOOLEAN b=slWrite(l,vf.next); /* iiConvert preserves next */
599  if (b)
600  {
601  const char *s;
602  if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
603  else s=sNoName_fe;
604  Werror("cannot write to %s",s);
605  }
606  vf.CleanUp();
607  return b;
608 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
int iiTestConvert(int inputType, int outputType)
Definition: gentable.cc:301
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, const struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:435
const char sNoName_fe[]
Definition: fevoices.cc:55
#define TRUE
Definition: auxiliary.h:98
void WerrorS(const char *s)
Definition: feFopen.cc:24
CanonicalForm b
Definition: cfModGcd.cc:4044
leftv next
Definition: subexpr.h:86
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
Definition: tok.h:117
#define NULL
Definition: omList.c:12
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
void * Data()
Definition: subexpr.cc:1176
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189
int l
Definition: cfEzgcd.cc:93

◆ IsCmd()

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

Definition at line 8897 of file iparith.cc.

8898 {
8899  int i;
8900  int an=1;
8901  int en=sArithBase.nLastIdentifier;
8902 
8903  loop
8904  //for(an=0; an<sArithBase.nCmdUsed; )
8905  {
8906  if(an>=en-1)
8907  {
8908  if (strcmp(n, sArithBase.sCmds[an].name) == 0)
8909  {
8910  i=an;
8911  break;
8912  }
8913  else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
8914  {
8915  i=en;
8916  break;
8917  }
8918  else
8919  {
8920  // -- blackbox extensions:
8921  // return 0;
8922  return blackboxIsCmd(n,tok);
8923  }
8924  }
8925  i=(an+en)/2;
8926  if (*n < *(sArithBase.sCmds[i].name))
8927  {
8928  en=i-1;
8929  }
8930  else if (*n > *(sArithBase.sCmds[i].name))
8931  {
8932  an=i+1;
8933  }
8934  else
8935  {
8936  int v=strcmp(n,sArithBase.sCmds[i].name);
8937  if(v<0)
8938  {
8939  en=i-1;
8940  }
8941  else if(v>0)
8942  {
8943  an=i+1;
8944  }
8945  else /*v==0*/
8946  {
8947  break;
8948  }
8949  }
8950  }
8952  tok=sArithBase.sCmds[i].tokval;
8953  if(sArithBase.sCmds[i].alias==2)
8954  {
8955  Warn("outdated identifier `%s` used - please change your code",
8956  sArithBase.sCmds[i].name);
8957  sArithBase.sCmds[i].alias=1;
8958  }
8959  #if 0
8960  if (currRingHdl==NULL)
8961  {
8962  #ifdef SIQ
8963  if (siq<=0)
8964  {
8965  #endif
8966  if ((tok>=BEGIN_RING) && (tok<=END_RING))
8967  {
8968  WerrorS("no ring active");
8969  return 0;
8970  }
8971  #ifdef SIQ
8972  }
8973  #endif
8974  }
8975  #endif
8976  if (!expected_parms)
8977  {
8978  switch (tok)
8979  {
8980  case IDEAL_CMD:
8981  case INT_CMD:
8982  case INTVEC_CMD:
8983  case MAP_CMD:
8984  case MATRIX_CMD:
8985  case MODUL_CMD:
8986  case POLY_CMD:
8987  case PROC_CMD:
8988  case RING_CMD:
8989  case STRING_CMD:
8990  cmdtok = tok;
8991  break;
8992  }
8993  }
8994  return sArithBase.sCmds[i].toktype;
8995 }
Definition: tok.h:96
BOOLEAN siq
Definition: subexpr.cc:48
int cmdtok
Definition: grammar.cc:174
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define loop
Definition: structs.h:80
BOOLEAN expected_parms
Definition: grammar.cc:173
idhdl currRingHdl
Definition: ipid.cc:59
int i
Definition: cfEzgcd.cc:125
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
unsigned nLastIdentifier
valid indentifieres are slot 1..nLastIdentifier
Definition: iparith.cc:187
#define NULL
Definition: omList.c:12
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:192
static SArithBase sArithBase
Base entry for arithmetic.
Definition: iparith.cc:195
cmdnames * sCmds
array of existing commands
Definition: iparith.cc:180
const char * lastreserved
Definition: ipshell.cc:78
#define Warn
Definition: emacs.cc:77

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv  res,
leftv  v 
)

Definition at line 889 of file ipshell.cc.

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

◆ jjBETTI2()

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

Definition at line 923 of file ipshell.cc.

924 {
925  resolvente r;
926  int len;
927  int reg,typ0;
928  lists l=(lists)u->Data();
929 
930  intvec *weights=NULL;
931  int add_row_shift=0;
932  intvec *ww=NULL;
933  if (l->nr>=0) ww=(intvec *)atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
934  if (ww!=NULL)
935  {
936  weights=ivCopy(ww);
937  add_row_shift = ww->min_in();
938  (*weights) -= add_row_shift;
939  }
940  //Print("attr:%x\n",weights);
941 
942  r=liFindRes(l,&len,&typ0);
943  if (r==NULL) return TRUE;
944  intvec* res_im=syBetti(r,len,&reg,weights,(int)(long)v->Data());
945  res->data=(void*)res_im;
946  omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
947  //Print("rowShift: %d ",add_row_shift);
948  for(int i=1;i<=res_im->rows();i++)
949  {
950  if (IMATELEM(*res_im,1,i)==0) { add_row_shift--; }
951  else break;
952  }
953  //Print(" %d\n",add_row_shift);
954  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
955  if (weights!=NULL) delete weights;
956  return FALSE;
957 }
sleftv * m
Definition: lists.h:46
Definition: tok.h:96
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:315
Definition: lists.h:23
#define FALSE
Definition: auxiliary.h:94
int rows() const
Definition: intvec.h:96
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * ivCopy(const intvec *o)
Definition: intvec.h:135
#define TRUE
Definition: auxiliary.h:98
void * ADDRESS
Definition: auxiliary.h:133
int min_in()
Definition: intvec.h:121
void * data
Definition: subexpr.h:88
Definition: intvec.h:19
void atSet(idhdl root, char *name, void *data, int typ)
Definition: attrib.cc:150
int i
Definition: cfEzgcd.cc:125
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:129
int nr
Definition: lists.h:44
#define NULL
Definition: omList.c:12
slists * lists
Definition: mpr_numeric.h:146
void * Data()
Definition: subexpr.cc:1176
ideal * resolvente
Definition: ideals.h:18
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:770
#define IMATELEM(M, I, J)
Definition: intvec.h:85
int l
Definition: cfEzgcd.cc:93
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ jjBETTI2_ID()

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

Definition at line 902 of file ipshell.cc.

903 {
905  l->Init(1);
906  l->m[0].rtyp=u->Typ();
907  l->m[0].data=u->Data();
908  attr *a=u->Attribute();
909  if (a!=NULL)
910  l->m[0].attribute=*a;
911  sleftv tmp2;
912  memset(&tmp2,0,sizeof(tmp2));
913  tmp2.rtyp=LIST_CMD;
914  tmp2.data=(void *)l;
915  BOOLEAN r=jjBETTI2(res,&tmp2,v);
916  l->m[0].data=NULL;
917  l->m[0].attribute=NULL;
918  l->m[0].rtyp=DEF_CMD;
919  l->Clean();
920  return r;
921 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
sleftv * m
Definition: lists.h:46
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: attrib.h:17
Definition: lists.h:23
attr * Attribute()
Definition: subexpr.cc:1470
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:923
int Typ()
Definition: subexpr.cc:1033
void * data
Definition: subexpr.h:88
Definition: tok.h:58
CFList tmp2
Definition: facFqBivar.cc:70
INLINE_THIS void Init(int l=0)
#define NULL
Definition: omList.c:12
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
void Clean(ring r=currRing)
Definition: lists.h:26
void * Data()
Definition: subexpr.cc:1176
Definition: tok.h:118
attr attribute
Definition: subexpr.h:89
omBin slists_bin
Definition: lists.cc:23
int BOOLEAN
Definition: auxiliary.h:85
int l
Definition: cfEzgcd.cc:93

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3321 of file ipshell.cc.

3322 {
3323  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3324  return (res->data==NULL);
3325 }
void * data
Definition: subexpr.h:88
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition: clapsing.cc:1451
#define NULL
Definition: omList.c:12
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void * Data()
Definition: subexpr.cc:1176

◆ jjIMPORTFROM()

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

Definition at line 2234 of file ipassign.cc.

2235 {
2236  //Print("importfrom %s::%s ->.\n",v->Name(),u->Name() );
2237  assume(u->Typ()==PACKAGE_CMD);
2238  char *vn=(char *)v->Name();
2239  idhdl h=((package)(u->Data()))->idroot->get(vn /*v->Name()*/, myynest);
2240  if (h!=NULL)
2241  {
2242  //check for existence
2243  if (((package)(u->Data()))==basePack)
2244  {
2245  WarnS("source and destination packages are identical");
2246  return FALSE;
2247  }
2248  idhdl t=basePack->idroot->get(vn /*v->Name()*/, myynest);
2249  if (t!=NULL)
2250  {
2251  if (BVERBOSE(V_REDEFINE)) Warn("redefining %s (%s)",vn,my_yylinebuf);
2252  killhdl(t);
2253  }
2254  sleftv tmp_expr;
2255  if (iiDeclCommand(&tmp_expr,v,myynest,DEF_CMD,&IDROOT)) return TRUE;
2256  sleftv h_expr;
2257  memset(&h_expr,0,sizeof(h_expr));
2258  h_expr.rtyp=IDHDL;
2259  h_expr.data=h;
2260  h_expr.name=vn;
2261  return iiAssign(&tmp_expr,&h_expr);
2262  }
2263  else
2264  {
2265  Werror("`%s` not found in `%s`",v->Name(), u->Name());
2266  return TRUE;
2267  }
2268  return FALSE;
2269 }
ip_package * package
Definition: structs.h:48
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
#define FALSE
Definition: auxiliary.h:94
#define IDROOT
Definition: ipid.h:18
#define TRUE
Definition: auxiliary.h:98
#define WarnS
Definition: emacs.cc:78
int Typ()
Definition: subexpr.cc:1033
const char * Name()
Definition: subexpr.h:120
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:31
void * data
Definition: subexpr.h:88
int myynest
Definition: febase.cc:41
char my_yylinebuf[80]
Definition: febase.cc:43
Definition: tok.h:58
const char * name
Definition: subexpr.h:87
#define assume(x)
Definition: mod2.h:390
#define BVERBOSE(a)
Definition: options.h:35
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition: ipshell.cc:1125
#define NULL
Definition: omList.c:12
void killhdl(idhdl h, package proot)
Definition: ipid.cc:384
package basePack
Definition: ipid.cc:58
int rtyp
Definition: subexpr.h:91
void * Data()
Definition: subexpr.cc:1176
static Poly * h
Definition: janet.cc:971
#define V_REDEFINE
Definition: options.h:45
void Werror(const char *fmt,...)
Definition: reporter.cc:189
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1830
#define Warn
Definition: emacs.cc:77

◆ jjLIST_PL()

BOOLEAN jjLIST_PL ( leftv  res,
leftv  v 
)

Definition at line 7517 of file iparith.cc.

7518 {
7519  int sl=0;
7520  if (v!=NULL) sl = v->listLength();
7521  lists L;
7522  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7523  {
7524  int add_row_shift = 0;
7525  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7526  if (weights!=NULL) add_row_shift=weights->min_in();
7527  L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7528  }
7529  else
7530  {
7532  leftv h=NULL;
7533  int i;
7534  int rt;
7535 
7536  L->Init(sl);
7537  for (i=0;i<sl;i++)
7538  {
7539  if (h!=NULL)
7540  { /* e.g. not in the first step:
7541  * h is the pointer to the old sleftv,
7542  * v is the pointer to the next sleftv
7543  * (in this moment) */
7544  h->next=v;
7545  }
7546  h=v;
7547  v=v->next;
7548  h->next=NULL;
7549  rt=h->Typ();
7550  if (rt==0)
7551  {
7552  L->Clean();
7553  Werror("`%s` is undefined",h->Fullname());
7554  return TRUE;
7555  }
7556  if (rt==RING_CMD)
7557  {
7558  L->m[i].rtyp=rt; L->m[i].data=h->Data();
7559  ((ring)L->m[i].data)->ref++;
7560  }
7561  else
7562  L->m[i].Copy(h);
7563  }
7564  }
7565  res->data=(char *)L;
7566  return FALSE;
7567 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
sleftv * m
Definition: lists.h:46
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: lists.h:23
#define FALSE
Definition: auxiliary.h:94
lists syConvRes(syStrategy syzstr, BOOLEAN toDel, int add_row_shift)
Definition: ipshell.cc:3158
int listLength()
Definition: subexpr.cc:51
#define TRUE
Definition: auxiliary.h:98
int min_in()
Definition: intvec.h:121
int Typ()
Definition: subexpr.cc:1033
const char * Fullname()
Definition: subexpr.h:125
void * data
Definition: subexpr.h:88
Definition: intvec.h:19
void Copy(leftv e)
Definition: subexpr.cc:714
int i
Definition: cfEzgcd.cc:125
leftv next
Definition: subexpr.h:86
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:129
#define NULL
Definition: omList.c:12
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
void Clean(ring r=currRing)
Definition: lists.h:26
void * Data()
Definition: subexpr.cc:1176
omBin slists_bin
Definition: lists.cc:23
static Poly * h
Definition: janet.cc:971
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 5255 of file iparith.cc.

5256 {
5257  char libnamebuf[1024];
5258  lib_types LT = type_of_LIB(s, libnamebuf);
5259 
5260 #ifdef HAVE_DYNAMIC_LOADING
5261  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5262 #endif /* HAVE_DYNAMIC_LOADING */
5263  switch(LT)
5264  {
5265  default:
5266  case LT_NONE:
5267  Werror("%s: unknown type", s);
5268  break;
5269  case LT_NOTFOUND:
5270  Werror("cannot open %s", s);
5271  break;
5272 
5273  case LT_SINGULAR:
5274  {
5275  char *plib = iiConvName(s);
5276  idhdl pl = IDROOT->get(plib,0);
5277  if (pl==NULL)
5278  {
5279  pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5280  IDPACKAGE(pl)->language = LANG_SINGULAR;
5281  IDPACKAGE(pl)->libname=omStrDup(s);
5282  }
5283  else if (IDTYP(pl)!=PACKAGE_CMD)
5284  {
5285  Werror("can not create package `%s`",plib);
5286  omFree(plib);
5287  return TRUE;
5288  }
5289  else /* package */
5290  {
5291  package pa=IDPACKAGE(pl);
5292  if ((pa->language==LANG_C)
5293  || (pa->language==LANG_MIX))
5294  {
5295  Werror("can not create package `%s` - binaries exists",plib);
5296  omfree(plib);
5297  return TRUE;
5298  }
5299  }
5300  omFree(plib);
5301  package savepack=currPack;
5302  currPack=IDPACKAGE(pl);
5303  IDPACKAGE(pl)->loaded=TRUE;
5304  char libnamebuf[1024];
5305  FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5306  BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5307  currPack=savepack;
5308  IDPACKAGE(pl)->loaded=(!bo);
5309  return bo;
5310  }
5311  case LT_BUILTIN:
5312  SModulFunc_t iiGetBuiltinModInit(const char*);
5313  return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5314  case LT_MACH_O:
5315  case LT_ELF:
5316  case LT_HPUX:
5317 #ifdef HAVE_DYNAMIC_LOADING
5318  return load_modules(s, libnamebuf, autoexport);
5319 #else /* HAVE_DYNAMIC_LOADING */
5320  WerrorS("Dynamic modules are not supported by this version of Singular");
5321  break;
5322 #endif /* HAVE_DYNAMIC_LOADING */
5323  }
5324  return TRUE;
5325 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
CanonicalForm fp
Definition: cfModGcd.cc:4043
Definition: mod_raw.h:16
#define IDROOT
Definition: ipid.h:18
#define TRUE
Definition: auxiliary.h:98
lib_types type_of_LIB(const char *newlib, char *libnamebuf)
Definition: mod_lib.cc:22
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: idrec.h:34
Definition: subexpr.h:22
#define IDPACKAGE(a)
Definition: ipid.h:134
#define IDTYP(a)
Definition: ipid.h:114
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:265
#define omFree(addr)
Definition: omAllocDecl.h:261
#define omfree(addr)
Definition: omAllocDecl.h:237
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:1197
#define NULL
Definition: omList.c:12
SModulFunc_t iiGetBuiltinModInit(const char *libname)
Definition: iplib.cc:750
package basePack
Definition: ipid.cc:58
package currPack
Definition: ipid.cc:57
int(* SModulFunc_t)(SModulFunctions *)
Definition: ipid.h:80
BOOLEAN iiLoadLIB(FILE *fp, const char *libnamebuf, const char *newlib, idhdl pl, BOOLEAN autoexport, BOOLEAN tellerror)
Definition: iplib.cc:914
BOOLEAN pa(leftv res, leftv args)
Definition: cohomo.cc:4346
char * iiConvName(const char *libname)
Definition: iplib.cc:1331
int BOOLEAN
Definition: auxiliary.h:85
BOOLEAN load_modules(const char *newlib, char *fullname, BOOLEAN autoexport)
Definition: iplib.cc:1090
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 5331 of file iparith.cc.

5332 {
5333  void (*WerrorS_save)(const char *s) = WerrorS_callback;
5336  BOOLEAN bo=jjLOAD(s,TRUE);
5337  if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
5338  Print("loading of >%s< failed\n",s);
5339  WerrorS_callback=WerrorS_save;
5340  errorreported=0;
5341  return FALSE;
5342 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define Print
Definition: emacs.cc:80
#define TEST_OPT_PROT
Definition: options.h:102
static int WerrorS_dummy_cnt
Definition: iparith.cc:5326
#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:5255
static void WerrorS_dummy(const char *)
Definition: iparith.cc:5327
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 868 of file ipshell.cc.

869 {
870  int len=0;
871  int typ0;
872  lists L=(lists)v->Data();
873  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
874  int add_row_shift = 0;
875  if (weights==NULL)
876  weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
877  if (weights!=NULL) add_row_shift=weights->min_in();
878  resolvente rr=liFindRes(L,&len,&typ0);
879  if (rr==NULL) return TRUE;
880  resolvente r=iiCopyRes(rr,len);
881 
882  syMinimizeResolvente(r,len,0);
883  omFreeSize((ADDRESS)rr,len*sizeof(ideal));
884  len++;
885  res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
886  return FALSE;
887 }
sleftv * m
Definition: lists.h:46
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:315
Definition: lists.h:23
#define FALSE
Definition: auxiliary.h:94
void syMinimizeResolvente(resolvente res, int length, int first)
Definition: syz.cc:355
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define TRUE
Definition: auxiliary.h:98
void * ADDRESS
Definition: auxiliary.h:133
int min_in()
Definition: intvec.h:121
void * data
Definition: subexpr.h:88
Definition: intvec.h:19
static resolvente iiCopyRes(resolvente r, int l)
Definition: ipshell.cc:858
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:129
#define NULL
Definition: omList.c:12
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:216
void * Data()
Definition: subexpr.cc:1176
ideal * resolvente
Definition: ideals.h:18

◆ jjRESULTANT()

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

Definition at line 3314 of file ipshell.cc.

3315 {
3316  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3317  (poly)w->CopyD(), currRing);
3318  return errorreported;
3319 }
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition: clapsing.cc:277
void * data
Definition: subexpr.h:88
short errorreported
Definition: feFopen.cc:23
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void * CopyD(int t)
Definition: subexpr.cc:739

◆ jjSYSTEM()

BOOLEAN jjSYSTEM ( leftv  res,
leftv  v 
)

Definition at line 231 of file extra.cc.

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

◆ jjVARIABLES_ID()

BOOLEAN jjVARIABLES_ID ( leftv  res,
leftv  u 
)

Definition at line 6306 of file ipshell.cc.

6307 {
6308  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6309  ideal I=(ideal)u->Data();
6310  int i;
6311  int n=0;
6312  for(i=I->nrows*I->ncols-1;i>=0;i--)
6313  {
6314  int n0=pGetVariables(I->m[i],e);
6315  if (n0>n) n=n0;
6316  }
6317  jjINT_S_TO_ID(n,e,res);
6318  return FALSE;
6319 }
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:586
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6276
#define pGetVariables(p, e)
Definition: polys.h:246
int i
Definition: cfEzgcd.cc:125
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void * Data()
Definition: subexpr.cc:1176
#define omAlloc0(size)
Definition: omAllocDecl.h:211

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6298 of file ipshell.cc.

6299 {
6300  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6301  int n=pGetVariables((poly)u->Data(),e);
6302  jjINT_S_TO_ID(n,e,res);
6303  return FALSE;
6304 }
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:586
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6276
#define pGetVariables(p, e)
Definition: polys.h:246
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void * Data()
Definition: subexpr.cc:1176
#define omAlloc0(size)
Definition: omAllocDecl.h:211

◆ killlocals()

void killlocals ( int  v)

Definition at line 381 of file ipshell.cc.

382 {
383  BOOLEAN changed=FALSE;
384  idhdl sh=currRingHdl;
385  ring cr=currRing;
386  if (sh!=NULL) changed=((IDLEV(sh)<v) || (IDRING(sh)->ref>0));
387  //if (changed) Print("currRing=%s(%x), lev=%d,ref=%d\n",IDID(sh),IDRING(sh),IDLEV(sh),IDRING(sh)->ref);
388 
389  killlocals_rec(&(basePack->idroot),v,currRing);
390 
392  {
393  int t=iiRETURNEXPR.Typ();
394  if (/*iiRETURNEXPR.Typ()*/ t==RING_CMD)
395  {
397  if (((ring)h->data)->idroot!=NULL)
398  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
399  }
400  else if (/*iiRETURNEXPR.Typ()*/ t==LIST_CMD)
401  {
402  leftv h=&iiRETURNEXPR;
403  changed |=killlocals_list(v,(lists)h->data);
404  }
405  }
406  if (changed)
407  {
409  if (currRingHdl==NULL)
410  currRing=NULL;
411  else if(cr!=currRing)
412  rChangeCurrRing(cr);
413  }
414 
415  if (myynest<=1) iiNoKeepRing=TRUE;
416  //Print("end killlocals >= %d\n",v);
417  //listall();
418 }
int iiRETURNEXPR_len
Definition: iplib.cc:455
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: lists.h:23
#define FALSE
Definition: auxiliary.h:94
sleftv iiRETURNEXPR
Definition: iplib.cc:454
#define TRUE
Definition: auxiliary.h:98
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:325
int Typ()
Definition: subexpr.cc:1033
Definition: idrec.h:34
void * data
Definition: subexpr.h:88
int myynest
Definition: febase.cc:41
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:361
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:80
idhdl currRingHdl
Definition: ipid.cc:59
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1610
#define IDLEV(a)
Definition: ipid.h:116
void rChangeCurrRing(ring r)
Definition: polys.cc:14
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:12
package basePack
Definition: ipid.cc:58
#define IDRING(a)
Definition: ipid.h:122
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
Definition: tok.h:118
static Poly * h
Definition: janet.cc:971
int BOOLEAN
Definition: auxiliary.h:85
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:290

◆ kQHWeight()

BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3297 of file ipshell.cc.

3298 {
3299  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3300  if (res->data==NULL)
3301  res->data=(char *)new intvec(rVar(currRing));
3302  return FALSE;
3303 }
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:586
intvec * id_QHomWeight(ideal id, const ring r)
void * data
Definition: subexpr.h:88
Definition: intvec.h:19
#define NULL
Definition: omList.c:12
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void * Data()
Definition: subexpr.cc:1176

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3275 of file ipshell.cc.

3276 {
3277  ideal F=(ideal)id->Data();
3278  intvec * iv = new intvec(rVar(currRing));
3279  polyset s;
3280  int sl, n, i;
3281  int *x;
3282 
3283  res->data=(char *)iv;
3284  s = F->m;
3285  sl = IDELEMS(F) - 1;
3286  n = rVar(currRing);
3287  double wNsqr = (double)2.0 / (double)n;
3289  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3290  wCall(s, sl, x, wNsqr, currRing);
3291  for (i = n; i!=0; i--)
3292  (*iv)[i-1] = x[i + n + 1];
3293  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3294  return FALSE;
3295 }
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:586
void * ADDRESS
Definition: auxiliary.h:133
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:88
Definition: intvec.h:19
double(* wFunctional)(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight.cc:20
poly * polyset
Definition: polys.h:254
int i
Definition: cfEzgcd.cc:125
#define IDELEMS(i)
Definition: simpleideals.h:23
void wCall(poly *s, int sl, int *x, double wNsqr, const ring R)
Definition: weight.cc:108
Variable x
Definition: cfModGcd.cc:4023
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void * Data()
Definition: subexpr.cc:1176
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 420 of file ipshell.cc.

421 {
422  package savePack=currPack;
423  idhdl h,start;
424  BOOLEAN all = typ<0;
425  BOOLEAN really_all=FALSE;
426 
427  if ( typ==0 )
428  {
429  if (strcmp(what,"all")==0)
430  {
431  if (currPack!=basePack)
432  list_cmd(-1,NULL,prefix,iterate,fullname); // list current package
433  really_all=TRUE;
434  h=basePack->idroot;
435  }
436  else
437  {
438  h = ggetid(what);
439  if (h!=NULL)
440  {
441  if (iterate) list1(prefix,h,TRUE,fullname);
442  if (IDTYP(h)==ALIAS_CMD) PrintS("A");
443  if ((IDTYP(h)==RING_CMD)
444  //|| (IDTYP(h)==PACKAGE_CMD)
445  )
446  {
447  h=IDRING(h)->idroot;
448  }
449  else if(IDTYP(h)==PACKAGE_CMD)
450  {
451  currPack=IDPACKAGE(h);
452  //Print("list_cmd:package\n");
453  all=TRUE;typ=PROC_CMD;fullname=TRUE;really_all=TRUE;
454  h=IDPACKAGE(h)->idroot;
455  }
456  else
457  {
458  currPack=savePack;
459  return;
460  }
461  }
462  else
463  {
464  Werror("%s is undefined",what);
465  currPack=savePack;
466  return;
467  }
468  }
469  all=TRUE;
470  }
471  else if (RingDependend(typ))
472  {
473  h = currRing->idroot;
474  }
475  else
476  h = IDROOT;
477  start=h;
478  while (h!=NULL)
479  {
480  if ((all
481  && (IDTYP(h)!=PROC_CMD)
482  &&(IDTYP(h)!=PACKAGE_CMD)
483  &&(IDTYP(h)!=CRING_CMD)
484  )
485  || (typ == IDTYP(h))
486  || ((IDTYP(h)==CRING_CMD) && (typ==RING_CMD))
487  )
488  {
489  list1(prefix,h,start==currRingHdl, fullname);
490  if ((IDTYP(h)==RING_CMD)
491  && (really_all || (all && (h==currRingHdl)))
492  && ((IDLEV(h)==0)||(IDLEV(h)==myynest)))
493  {
494  list_cmd(0,IDID(h),"// ",FALSE);
495  }
496  if (IDTYP(h)==PACKAGE_CMD && really_all)
497  {
498  package save_p=currPack;
499  currPack=IDPACKAGE(h);
500  list_cmd(0,IDID(h),"// ",FALSE);
501  currPack=save_p;
502  }
503  }
504  h = IDNEXT(h);
505  }
506  currPack=savePack;
507 }
idhdl ggetid(const char *n)
Definition: ipid.cc:521
#define IDID(a)
Definition: ipid.h:117
#define FALSE
Definition: auxiliary.h:94
#define IDNEXT(a)
Definition: ipid.h:113
#define IDROOT
Definition: ipid.h:18
#define TRUE
Definition: auxiliary.h:98
static void list1(const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
Definition: ipshell.cc:145
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:134
int myynest
Definition: febase.cc:41
#define IDTYP(a)
Definition: ipid.h:114
Definition: tok.h:56
int RingDependend(int t)
Definition: gentable.cc:28
void list_cmd(int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname)
Definition: ipshell.cc:420
idhdl currRingHdl
Definition: ipid.cc:59
void PrintS(const char *s)
Definition: reporter.cc:284
#define IDLEV(a)
Definition: ipid.h:116
Definition: tok.h:34
#define NULL
Definition: omList.c:12
package basePack
Definition: ipid.cc:58
#define IDRING(a)
Definition: ipid.h:122
package currPack
Definition: ipid.cc:57
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
static Poly * h
Definition: janet.cc:971
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189

◆ loNewtonP()

BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4537 of file ipshell.cc.

4538 {
4539  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4540  return FALSE;
4541 }
#define FALSE
Definition: auxiliary.h:94
ideal loNewtonPolytope(const ideal id)
Definition: mpr_base.cc:3190
void * data
Definition: subexpr.h:88
void * Data()
Definition: subexpr.cc:1176

◆ loSimplex()

BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4543 of file ipshell.cc.

4544 {
4545  if ( !(rField_is_long_R(currRing)) )
4546  {
4547  WerrorS("Ground field not implemented!");
4548  return TRUE;
4549  }
4550 
4551  simplex * LP;
4552  matrix m;
4553 
4554  leftv v= args;
4555  if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4556  return TRUE;
4557  else
4558  m= (matrix)(v->CopyD());
4559 
4560  LP = new simplex(MATROWS(m),MATCOLS(m));
4561  LP->mapFromMatrix(m);
4562 
4563  v= v->next;
4564  if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4565  return TRUE;
4566  else
4567  LP->m= (int)(long)(v->Data());
4568 
4569  v= v->next;
4570  if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4571  return TRUE;
4572  else
4573  LP->n= (int)(long)(v->Data());
4574 
4575  v= v->next;
4576  if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4577  return TRUE;
4578  else
4579  LP->m1= (int)(long)(v->Data());
4580 
4581  v= v->next;
4582  if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4583  return TRUE;
4584  else
4585  LP->m2= (int)(long)(v->Data());
4586 
4587  v= v->next;
4588  if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4589  return TRUE;
4590  else
4591  LP->m3= (int)(long)(v->Data());
4592 
4593 #ifdef mprDEBUG_PROT
4594  Print("m (constraints) %d\n",LP->m);
4595  Print("n (columns) %d\n",LP->n);
4596  Print("m1 (<=) %d\n",LP->m1);
4597  Print("m2 (>=) %d\n",LP->m2);
4598  Print("m3 (==) %d\n",LP->m3);
4599 #endif
4600 
4601  LP->compute();
4602 
4603  lists lres= (lists)omAlloc( sizeof(slists) );
4604  lres->Init( 6 );
4605 
4606  lres->m[0].rtyp= MATRIX_CMD; // output matrix
4607  lres->m[0].data=(void*)LP->mapToMatrix(m);
4608 
4609  lres->m[1].rtyp= INT_CMD; // found a solution?
4610  lres->m[1].data=(void*)(long)LP->icase;
4611 
4612  lres->m[2].rtyp= INTVEC_CMD;
4613  lres->m[2].data=(void*)LP->posvToIV();
4614 
4615  lres->m[3].rtyp= INTVEC_CMD;
4616  lres->m[3].data=(void*)LP->zrovToIV();
4617 
4618  lres->m[4].rtyp= INT_CMD;
4619  lres->m[4].data=(void*)(long)LP->m;
4620 
4621  lres->m[5].rtyp= INT_CMD;
4622  lres->m[5].data=(void*)(long)LP->n;
4623 
4624  res->data= (void*)lres;
4625 
4626  return FALSE;
4627 }
sleftv * m
Definition: lists.h:46
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
matrix mapToMatrix(matrix m)
void compute()
#define Print
Definition: emacs.cc:80
Definition: tok.h:96
Definition: lists.h:23
#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:1033
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:88
intvec * posvToIV()
BOOLEAN mapFromMatrix(matrix m)
int m
Definition: cfEzgcd.cc:121
leftv next
Definition: subexpr.h:86
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:27
slists * lists
Definition: mpr_numeric.h:146
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:537
int rtyp
Definition: subexpr.h:91
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void * Data()
Definition: subexpr.cc:1176
#define MATROWS(i)
Definition: matpol.h:26
int icase
Definition: mpr_numeric.h:201
ip_smatrix * matrix
Definition: matpol.h:43
void * CopyD(int t)
Definition: subexpr.cc:739

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 3045 of file ipshell.cc.

3046 {
3047  int i,j;
3048  matrix result;
3049  ideal id=(ideal)a->Data();
3050 
3051  result =mpNew(IDELEMS(id),rVar(currRing));
3052  for (i=1; i<=IDELEMS(id); i++)
3053  {
3054  for (j=1; j<=rVar(currRing); j++)
3055  {
3056  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
3057  }
3058  }
3059  res->data=(char *)result;
3060  return FALSE;
3061 }
int j
Definition: facHensel.cc:105
#define FALSE
Definition: auxiliary.h:94
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:586
void * data
Definition: subexpr.h:88
int i
Definition: cfEzgcd.cc:125
#define IDELEMS(i)
Definition: simpleideals.h:23
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:37
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void * Data()
Definition: subexpr.cc:1176
#define pDiff(a, b)
Definition: polys.h:291
return result
Definition: facAbsBiFact.cc:76
#define MATELEM(mat, i, j)
1-based access to matrix
Definition: matpol.h:29

◆ mpKoszul()

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

Definition at line 3067 of file ipshell.cc.

3068 {
3069  int n=(int)(long)b->Data();
3070  int d=(int)(long)c->Data();
3071  int k,l,sign,row,col;
3072  matrix result;
3073  ideal temp;
3074  BOOLEAN bo;
3075  poly p;
3076 
3077  if ((d>n) || (d<1) || (n<1))
3078  {
3079  res->data=(char *)mpNew(1,1);
3080  return FALSE;
3081  }
3082  int *choise = (int*)omAlloc(d*sizeof(int));
3083  if (id==NULL)
3084  temp=idMaxIdeal(1);
3085  else
3086  temp=(ideal)id->Data();
3087 
3088  k = binom(n,d);
3089  l = k*d;
3090  l /= n-d+1;
3091  result =mpNew(l,k);
3092  col = 1;
3093  idInitChoise(d,1,n,&bo,choise);
3094  while (!bo)
3095  {
3096  sign = 1;
3097  for (l=1;l<=d;l++)
3098  {
3099  if (choise[l-1]<=IDELEMS(temp))
3100  {
3101  p = pCopy(temp->m[choise[l-1]-1]);
3102  if (sign == -1) p = pNeg(p);
3103  sign *= -1;
3104  row = idGetNumberOfChoise(l-1,d,1,n,choise);
3105  MATELEM(result,row,col) = p;
3106  }
3107  }
3108  col++;
3109  idGetNextChoise(d,n,&bo,choise);
3110  }
3111  omFreeSize(choise,d*sizeof(int));
3112  if (id==NULL) idDelete(&temp);
3113 
3114  res->data=(char *)result;
3115  return FALSE;
3116 }
#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
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define pNeg(p)
Definition: polys.h:193
int k
Definition: cfEzgcd.cc:92
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:88
void idGetNextChoise(int r, int end, BOOLEAN *endch, int *choise)
#define IDELEMS(i)
Definition: simpleideals.h:23
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:37
#define NULL
Definition: omList.c:12
void idInitChoise(int r, int beg, int end, BOOLEAN *endch, int *choise)
void * Data()
Definition: subexpr.cc:1176
int idGetNumberOfChoise(int t, int d, int begin, int end, int *choise)
int p
Definition: cfModGcd.cc:4019
int BOOLEAN
Definition: auxiliary.h:85
static int sign(int x)
Definition: ring.cc:3371
int binom(int n, int r)
return result
Definition: facAbsBiFact.cc:76
int l
Definition: cfEzgcd.cc:93
#define pCopy(p)
return a copy of the poly
Definition: polys.h:180
#define MATELEM(mat, i, j)
1-based access to matrix
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 4652 of file ipshell.cc.

4653 {
4654 
4655  poly gls;
4656  gls= (poly)(arg1->Data());
4657  int howclean= (int)(long)arg3->Data();
4658 
4659  if ( !(rField_is_R(currRing) ||
4660  rField_is_Q(currRing) ||
4663  {
4664  WerrorS("Ground field not implemented!");
4665  return TRUE;
4666  }
4667 
4670  {
4671  unsigned long int ii = (unsigned long int)arg2->Data();
4672  setGMPFloatDigits( ii, ii );
4673  }
4674 
4675  if ( gls == NULL || pIsConstant( gls ) )
4676  {
4677  WerrorS("Input polynomial is constant!");
4678  return TRUE;
4679  }
4680 
4681  int ldummy;
4682  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4683  int i,vpos=0;
4684  poly piter;
4685  lists elist;
4686  lists rlist;
4687 
4688  elist= (lists)omAlloc( sizeof(slists) );
4689  elist->Init( 0 );
4690 
4691  if ( rVar(currRing) > 1 )
4692  {
4693  piter= gls;
4694  for ( i= 1; i <= rVar(currRing); i++ )
4695  if ( pGetExp( piter, i ) )
4696  {
4697  vpos= i;
4698  break;
4699  }
4700  while ( piter )
4701  {
4702  for ( i= 1; i <= rVar(currRing); i++ )
4703  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4704  {
4705  WerrorS("The input polynomial must be univariate!");
4706  return TRUE;
4707  }
4708  pIter( piter );
4709  }
4710  }
4711 
4712  rootContainer * roots= new rootContainer();
4713  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4714  piter= gls;
4715  for ( i= deg; i >= 0; i-- )
4716  {
4717  if ( piter && pTotaldegree(piter) == i )
4718  {
4719  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4720  //nPrint( pcoeffs[i] );PrintS(" ");
4721  pIter( piter );
4722  }
4723  else
4724  {
4725  pcoeffs[i]= nInit(0);
4726  }
4727  }
4728 
4729 #ifdef mprDEBUG_PROT
4730  for (i=deg; i >= 0; i--)
4731  {
4732  nPrint( pcoeffs[i] );PrintS(" ");
4733  }
4734  PrintLn();
4735 #endif
4736 
4737  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4738  roots->solver( howclean );
4739 
4740  int elem= roots->getAnzRoots();
4741  char *dummy;
4742  int j;
4743 
4744  rlist= (lists)omAlloc( sizeof(slists) );
4745  rlist->Init( elem );
4746 
4748  {
4749  for ( j= 0; j < elem; j++ )
4750  {
4751  rlist->m[j].rtyp=NUMBER_CMD;
4752  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4753  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4754  }
4755  }
4756  else
4757  {
4758  for ( j= 0; j < elem; j++ )
4759  {
4760  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4761  rlist->m[j].rtyp=STRING_CMD;
4762  rlist->m[j].data=(void *)dummy;
4763  }
4764  }
4765 
4766  elist->Clean();
4767  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4768 
4769  // this is (via fillContainer) the same data as in root
4770  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4771  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4772 
4773  delete roots;
4774 
4775  res->rtyp= LIST_CMD;
4776  res->data= (void*)rlist;
4777 
4778  return FALSE;
4779 }
complex root finder for univariate polynomials based on laguers algorithm
Definition: mpr_numeric.h:65
sleftv * m
Definition: lists.h:46
int j
Definition: facHensel.cc:105
void PrintLn()
Definition: reporter.cc:310
Definition: lists.h:23
#define FALSE
Definition: auxiliary.h:94
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:513
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:586
#define TRUE
Definition: auxiliary.h:98
bool solver(const int polishmode=PM_NONE)
Definition: mpr_numeric.cc:436
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:44
#define omAlloc(size)
Definition: omAllocDecl.h:210
#define nPrint(a)
only for debug, over any initalized currRing
Definition: numbers.h:46
void * data
Definition: subexpr.h:88
#define pIter(p)
Definition: monomials.h:37
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
static long pTotaldegree(poly p)
Definition: polys.h:277
#define pIsConstant(p)
like above, except that Comp must be 0
Definition: polys.h:233
void fillContainer(number *_coeffs, number *_ievpoint, const int _var, const int _tdg, const rootType _rt, const int _anz)
Definition: mpr_numeric.cc:299
int i
Definition: cfEzgcd.cc:125
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:540
INLINE_THIS void Init(int l=0)
#define NULL
Definition: omList.c:12
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:537
int rtyp
Definition: subexpr.h:91
#define nCopy(n)
Definition: numbers.h:15
void Clean(ring r=currRing)
Definition: lists.h:26
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void * Data()
Definition: subexpr.cc:1176
Definition: tok.h:118
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition: mpr_complex.cc:704
size_t gmp_output_digits
Definition: mpr_complex.cc:42
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:60
#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 4629 of file ipshell.cc.

4630 {
4631  ideal gls = (ideal)(arg1->Data());
4632  int imtype= (int)(long)arg2->Data();
4633 
4634  uResultant::resMatType mtype= determineMType( imtype );
4635 
4636  // check input ideal ( = polynomial system )
4637  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4638  {
4639  return TRUE;
4640  }
4641 
4642  uResultant *resMat= new uResultant( gls, mtype, false );
4643  if (resMat!=NULL)
4644  {
4645  res->rtyp = MODUL_CMD;
4646  res->data= (void*)resMat->accessResMat()->getMatrix();
4647  if (!errorreported) delete resMat;
4648  }
4649  return errorreported;
4650 }
Base class for solving 0-dim poly systems using u-resultant.
Definition: mpr_base.h:62
resMatrixBase * accessResMat()
Definition: mpr_base.h:78
#define TRUE
Definition: auxiliary.h:98
uResultant::resMatType determineMType(int imtype)
const char * Name()
Definition: subexpr.h:120
Definition: mpr_base.h:98
void * data
Definition: subexpr.h:88
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:12
int rtyp
Definition: subexpr.h:91
void * Data()
Definition: subexpr.cc:1176

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

4883 {
4884  leftv v= args;
4885 
4886  ideal gls;
4887  int imtype;
4888  int howclean;
4889 
4890  // get ideal
4891  if ( v->Typ() != IDEAL_CMD )
4892  return TRUE;
4893  else gls= (ideal)(v->Data());
4894  v= v->next;
4895 
4896  // get resultant matrix type to use (0,1)
4897  if ( v->Typ() != INT_CMD )
4898  return TRUE;
4899  else imtype= (int)(long)v->Data();
4900  v= v->next;
4901 
4902  if (imtype==0)
4903  {
4904  ideal test_id=idInit(1,1);
4905  int j;
4906  for(j=IDELEMS(gls)-1;j>=0;j--)
4907  {
4908  if (gls->m[j]!=NULL)
4909  {
4910  test_id->m[0]=gls->m[j];
4911  intvec *dummy_w=id_QHomWeight(test_id, currRing);
4912  if (dummy_w!=NULL)
4913  {
4914  WerrorS("Newton polytope not of expected dimension");
4915  delete dummy_w;
4916  return TRUE;
4917  }
4918  }
4919  }
4920  }
4921 
4922  // get and set precision in digits ( > 0 )
4923  if ( v->Typ() != INT_CMD )
4924  return TRUE;
4925  else if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
4927  {
4928  unsigned long int ii=(unsigned long int)v->Data();
4929  setGMPFloatDigits( ii, ii );
4930  }
4931  v= v->next;
4932 
4933  // get interpolation steps (0,1,2)
4934  if ( v->Typ() != INT_CMD )
4935  return TRUE;
4936  else howclean= (int)(long)v->Data();
4937 
4938  uResultant::resMatType mtype= determineMType( imtype );
4939  int i,count;
4940  lists listofroots= NULL;
4941  number smv= NULL;
4942  BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;
4943 
4944  //emptylist= (lists)omAlloc( sizeof(slists) );
4945  //emptylist->Init( 0 );
4946 
4947  //res->rtyp = LIST_CMD;
4948  //res->data= (void *)emptylist;
4949 
4950  // check input ideal ( = polynomial system )
4951  if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
4952  {
4953  return TRUE;
4954  }
4955 
4956  uResultant * ures;
4957  rootContainer ** iproots;
4958  rootContainer ** muiproots;
4959  rootArranger * arranger;
4960 
4961  // main task 1: setup of resultant matrix
4962  ures= new uResultant( gls, mtype );
4963  if ( ures->accessResMat()->initState() != resMatrixBase::ready )
4964  {
4965  WerrorS("Error occurred during matrix setup!");
4966  return TRUE;
4967  }
4968 
4969  // if dense resultant, check if minor nonsingular
4970  if ( mtype == uResultant::denseResMat )
4971  {
4972  smv= ures->accessResMat()->getSubDet();
4973 #ifdef mprDEBUG_PROT
4974  PrintS("// Determinant of submatrix: ");nPrint(smv);PrintLn();
4975 #endif
4976  if ( nIsZero(smv) )
4977  {
4978  WerrorS("Unsuitable input ideal: Minor of resultant matrix is singular!");
4979  return TRUE;
4980  }
4981  }
4982 
4983  // main task 2: Interpolate specialized resultant polynomials
4984  if ( interpolate_det )
4985  iproots= ures->interpolateDenseSP( false, smv );
4986  else
4987  iproots= ures->specializeInU( false, smv );
4988 
4989  // main task 3: Interpolate specialized resultant polynomials
4990  if ( interpolate_det )
4991  muiproots= ures->interpolateDenseSP( true, smv );
4992  else
4993  muiproots= ures->specializeInU( true, smv );
4994 
4995 #ifdef mprDEBUG_PROT
4996  int c= iproots[0]->getAnzElems();
4997  for (i=0; i < c; i++) pWrite(iproots[i]->getPoly());
4998  c= muiproots[0]->getAnzElems();
4999  for (i=0; i < c; i++) pWrite(muiproots[i]->getPoly());
5000 #endif
5001 
5002  // main task 4: Compute roots of specialized polys and match them up
5003  arranger= new rootArranger( iproots, muiproots, howclean );
5004  arranger->solve_all();
5005 
5006  // get list of roots
5007  if ( arranger->success() )
5008  {
5009  arranger->arrange();
5010  listofroots= listOfRoots(arranger, gmp_output_digits );
5011  }
5012  else
5013  {
5014  WerrorS("Solver was unable to find any roots!");
5015  return TRUE;
5016  }
5017 
5018  // free everything
5019  count= iproots[0]->getAnzElems();
5020  for (i=0; i < count; i++) delete iproots[i];
5021  omFreeSize( (ADDRESS) iproots, count * sizeof(rootContainer*) );
5022  count= muiproots[0]->getAnzElems();
5023  for (i=0; i < count; i++) delete muiproots[i];
5024  omFreeSize( (ADDRESS) muiproots, count * sizeof(rootContainer*) );
5025 
5026  delete ures;
5027  delete arranger;
5028  nDelete( &smv );
5029 
5030  res->data= (void *)listofroots;
5031 
5032  //emptylist->Clean();
5033  // omFreeSize( (ADDRESS) emptylist, sizeof(slists) );
5034 
5035  return FALSE;
5036 }
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
int j
Definition: facHensel.cc:105
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
void PrintLn()
Definition: reporter.cc:310
Base class for solving 0-dim poly systems using u-resultant.
Definition: mpr_base.h:62
Definition: tok.h:96
Definition: lists.h:23
#define FALSE
Definition: auxiliary.h:94
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:513
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:133
void pWrite(poly p)
Definition: polys.h:303
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:1033
const char * Name()
Definition: subexpr.h:120
Definition: mpr_base.h:98
#define nPrint(a)
only for debug, over any initalized currRing
Definition: numbers.h:46
void * data
Definition: subexpr.h:88
Definition: intvec.h:19
bool success()
Definition: mpr_numeric.h:162
void arrange()
Definition: mpr_numeric.cc:882
int i
Definition: cfEzgcd.cc:125
void PrintS(const char *s)
Definition: reporter.cc:284
void solve_all()
Definition: mpr_numeric.cc:857
#define IDELEMS(i)
Definition: simpleideals.h:23
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:86
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:540
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:35
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define nIsZero(n)
Definition: numbers.h:19
#define NULL
Definition: omList.c:12
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:537
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void * Data()
Definition: subexpr.cc:1176
size_t gmp_output_digits
Definition: mpr_complex.cc:42
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:60
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:5039
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 4781 of file ipshell.cc.

4782 {
4783  int i;
4784  ideal p,w;
4785  p= (ideal)arg1->Data();
4786  w= (ideal)arg2->Data();
4787 
4788  // w[0] = f(p^0)
4789  // w[1] = f(p^1)
4790  // ...
4791  // p can be a vector of numbers (multivariate polynom)
4792  // or one number (univariate polynom)
4793  // tdg = deg(f)
4794 
4795  int n= IDELEMS( p );
4796  int m= IDELEMS( w );
4797  int tdg= (int)(long)arg3->Data();
4798 
4799  res->data= (void*)NULL;
4800 
4801  // check the input
4802  if ( tdg < 1 )
4803  {
4804  WerrorS("Last input parameter must be > 0!");
4805  return TRUE;
4806  }
4807  if ( n != rVar(currRing) )
4808  {
4809  Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
4810  return TRUE;
4811  }
4812  if ( m != (int)pow((double)tdg+1,(double)n) )
4813  {
4814  Werror("Size of second input ideal must be equal to %d!",
4815  (int)pow((double)tdg+1,(double)n));
4816  return TRUE;
4817  }
4818  if ( !(rField_is_Q(currRing) /* ||
4819  rField_is_R() || rField_is_long_R() ||
4820  rField_is_long_C()*/ ) )
4821  {
4822  WerrorS("Ground field not implemented!");
4823  return TRUE;
4824  }
4825 
4826  number tmp;
4827  number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
4828  for ( i= 0; i < n; i++ )
4829  {
4830  pevpoint[i]=nInit(0);
4831  if ( (p->m)[i] )
4832  {
4833  tmp = pGetCoeff( (p->m)[i] );
4834  if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
4835  {
4836  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4837  WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
4838  return TRUE;
4839  }
4840  } else tmp= NULL;
4841  if ( !nIsZero(tmp) )
4842  {
4843  if ( !pIsConstant((p->m)[i]))
4844  {
4845  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4846  WerrorS("Elements of first input ideal must be numbers!");
4847  return TRUE;
4848  }
4849  pevpoint[i]= nCopy( tmp );
4850  }
4851  }
4852 
4853  number *wresults= (number *)omAlloc( m * sizeof( number ) );
4854  for ( i= 0; i < m; i++ )
4855  {
4856  wresults[i]= nInit(0);
4857  if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
4858  {
4859  if ( !pIsConstant((w->m)[i]))
4860  {
4861  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4862  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4863  WerrorS("Elements of second input ideal must be numbers!");
4864  return TRUE;
4865  }
4866  wresults[i]= nCopy(pGetCoeff((w->m)[i]));
4867  }
4868  }
4869 
4870  vandermonde vm( m, n, tdg, pevpoint, FALSE );
4871  number *ncpoly= vm.interpolateDense( wresults );
4872  // do not free ncpoly[]!!
4873  poly rpoly= vm.numvec2poly( ncpoly );
4874 
4875  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4876  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4877 
4878  res->data= (void*)rpoly;
4879  return FALSE;
4880 }
vandermonde system solver for interpolating polynomials from their values
Definition: mpr_numeric.h:28
#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:586
#define TRUE
Definition: auxiliary.h:98
#define nIsOne(n)
Definition: numbers.h:25
void * ADDRESS
Definition: auxiliary.h:133
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:44
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:88
int m
Definition: cfEzgcd.cc:121
#define pIsConstant(p)
like above, except that Comp must be 0
Definition: polys.h:233
int i
Definition: cfEzgcd.cc:125
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:501
#define IDELEMS(i)
Definition: simpleideals.h:23
#define nIsZero(n)
Definition: numbers.h:19
#define NULL
Definition: omList.c:12
const CanonicalForm & w
Definition: facAbsFact.cc:55
#define nCopy(n)
Definition: numbers.h:15
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void * Data()
Definition: subexpr.cc:1176
int p
Definition: cfModGcd.cc:4019
#define nInit(i)
Definition: numbers.h:24
Rational pow(const Rational &a, int e)
Definition: GMPrat.cc:411
void Werror(const char *fmt,...)
Definition: reporter.cc:189

◆ paPrint()

void paPrint ( const char *  n,
package  p 
)

Definition at line 6321 of file ipshell.cc.

6322 {
6323  Print(" %s (",n);
6324  switch (p->language)
6325  {
6326  case LANG_SINGULAR: PrintS("S"); break;
6327  case LANG_C: PrintS("C"); break;
6328  case LANG_TOP: PrintS("T"); break;
6329  case LANG_MAX: PrintS("M"); break;
6330  case LANG_NONE: PrintS("N"); break;
6331  default: PrintS("U");
6332  }
6333  if(p->libname!=NULL)
6334  Print(",%s", p->libname);
6335  PrintS(")");
6336 }
#define Print
Definition: emacs.cc:80
Definition: subexpr.h:22
void PrintS(const char *s)
Definition: reporter.cc:284
#define NULL
Definition: omList.c:12
int p
Definition: cfModGcd.cc:4019

◆ rCompose()

ring rCompose ( const lists  L,
const BOOLEAN  check_comp = TRUE,
const long  bitmask = 0x7fff,
const int  isLetterplace = FALSE 
)

Definition at line 2758 of file ipshell.cc.

2759 {
2760  if ((L->nr!=3)
2761 #ifdef HAVE_PLURAL
2762  &&(L->nr!=5)
2763 #endif
2764  )
2765  return NULL;
2766  int is_gf_char=0;
2767  // 0: char/ cf - ring
2768  // 1: list (var)
2769  // 2: list (ord)
2770  // 3: qideal
2771  // possibly:
2772  // 4: C
2773  // 5: D
2774 
2775  ring R = (ring) omAlloc0Bin(sip_sring_bin);
2776 
2777  // ------------------------------------------------------------------
2778  // 0: char:
2779  if (L->m[0].Typ()==CRING_CMD)
2780  {
2781  R->cf=(coeffs)L->m[0].Data();
2782  R->cf->ref++;
2783  }
2784  else if (L->m[0].Typ()==INT_CMD)
2785  {
2786  int ch = (int)(long)L->m[0].Data();
2787  assume( ch >= 0 );
2788 
2789  if (ch == 0) // Q?
2790  R->cf = nInitChar(n_Q, NULL);
2791  else
2792  {
2793  int l = IsPrime(ch); // Zp?
2794  if( l != ch )
2795  {
2796  Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
2797  ch = l;
2798  }
2799  #ifndef TEST_ZN_AS_ZP
2800  R->cf = nInitChar(n_Zp, (void*)(long)ch);
2801  #else
2802  mpz_t modBase;
2803  mpz_init_set_ui(modBase,(long) ch);
2804  ZnmInfo info;
2805  info.base= modBase;
2806  info.exp= 1;
2807  R->cf=nInitChar(n_Zn,(void*) &info); //exponent is missing
2808  R->cf->is_field=1;
2809  R->cf->is_domain=1;
2810  R->cf->has_simple_Inverse=1;
2811  #endif
2812  }
2813  }
2814  else if (L->m[0].Typ()==LIST_CMD) // something complicated...
2815  {
2816  lists LL=(lists)L->m[0].Data();
2817 
2818 #ifdef HAVE_RINGS
2819  if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
2820  {
2821  rComposeRing(LL, R); // Ring!?
2822  }
2823  else
2824 #endif
2825  if (LL->nr < 3)
2826  rComposeC(LL,R); // R, long_R, long_C
2827  else
2828  {
2829  if (LL->m[0].Typ()==INT_CMD)
2830  {
2831  int ch = (int)(long)LL->m[0].Data();
2832  while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
2833  if (fftable[is_gf_char]==0) is_gf_char=-1;
2834 
2835  if(is_gf_char!= -1)
2836  {
2837  GFInfo param;
2838 
2839  param.GFChar = ch;
2840  param.GFDegree = 1;
2841  param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
2842 
2843  // nfInitChar should be able to handle the case when ch is in fftables!
2844  R->cf = nInitChar(n_GF, (void*)&param);
2845  }
2846  }
2847 
2848  if( R->cf == NULL )
2849  {
2850  ring extRing = rCompose((lists)L->m[0].Data(),FALSE,0x7fff);
2851 
2852  if (extRing==NULL)
2853  {
2854  WerrorS("could not create the specified coefficient field");
2855  goto rCompose_err;
2856  }
2857 
2858  if( extRing->qideal != NULL ) // Algebraic extension
2859  {
2860  AlgExtInfo extParam;
2861 
2862  extParam.r = extRing;
2863 
2864  R->cf = nInitChar(n_algExt, (void*)&extParam);
2865  }
2866  else // Transcendental extension
2867  {
2868  TransExtInfo extParam;
2869  extParam.r = extRing;
2870  assume( extRing->qideal == NULL );
2871 
2872  R->cf = nInitChar(n_transExt, &extParam);
2873  }
2874  }
2875  }
2876  }
2877  else
2878  {
2879  WerrorS("coefficient field must be described by `int` or `list`");
2880  goto rCompose_err;
2881  }
2882 
2883  if( R->cf == NULL )
2884  {
2885  WerrorS("could not create coefficient field described by the input!");
2886  goto rCompose_err;
2887  }
2888 
2889  // ------------------------- VARS ---------------------------
2890  if (rComposeVar(L,R)) goto rCompose_err;
2891  // ------------------------ ORDER ------------------------------
2892  if (rComposeOrder(L,check_comp,R)) goto rCompose_err;
2893 
2894  // ------------------------ ??????? --------------------
2895 
2896  if (!isLetterplace) rRenameVars(R);
2897  #ifdef HAVE_SHIFTBBA
2898  else
2899  {
2900  R->isLPring=isLetterplace;
2901  R->ShortOut=FALSE;
2902  R->CanShortOut=FALSE;
2903  }
2904  #endif
2905  if (bitmask!=0x7fff) R->bitmask=bitmask*2;
2906  rComplete(R);
2907 
2908  // ------------------------ Q-IDEAL ------------------------
2909 
2910  if (L->m[3].Typ()==IDEAL_CMD)
2911  {
2912  ideal q=(ideal)L->m[3].Data();
2913  if (q->m[0]!=NULL)
2914  {
2915  if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
2916  {
2917  #if 0
2918  WerrorS("coefficient fields must be equal if q-ideal !=0");
2919  goto rCompose_err;
2920  #else
2921  ring orig_ring=currRing;
2922  rChangeCurrRing(R);
2923  int *perm=NULL;
2924  int *par_perm=NULL;
2925  int par_perm_size=0;
2926  nMapFunc nMap;
2927 
2928  if ((nMap=nSetMap(orig_ring->cf))==NULL)
2929  {
2930  if (rEqual(orig_ring,currRing))
2931  {
2932  nMap=n_SetMap(currRing->cf, currRing->cf);
2933  }
2934  else
2935  // Allow imap/fetch to be make an exception only for:
2936  if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2940  ||
2941  (rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
2942  (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
2943  rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
2944  {
2945  par_perm_size=rPar(orig_ring);
2946 
2947 // if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
2948 // naSetChar(rInternalChar(orig_ring),orig_ring);
2949 // else ntSetChar(rInternalChar(orig_ring),orig_ring);
2950 
2951  nSetChar(currRing->cf);
2952  }
2953  else
2954  {
2955  WerrorS("coefficient fields must be equal if q-ideal !=0");
2956  goto rCompose_err;
2957  }
2958  }
2959  perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
2960  if (par_perm_size!=0)
2961  par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2962  int i;
2963  #if 0
2964  // use imap:
2965  maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
2966  currRing->names,currRing->N,currRing->parameter, currRing->P,
2967  perm,par_perm, currRing->ch);
2968  #else
2969  // use fetch
2970  if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
2971  {
2972  for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
2973  }
2974  else if (par_perm_size!=0)
2975  for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2976  for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
2977  #endif
2978  ideal dest_id=idInit(IDELEMS(q),1);
2979  for(i=IDELEMS(q)-1; i>=0; i--)
2980  {
2981  dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
2982  par_perm,par_perm_size);
2983  // PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
2984  pTest(dest_id->m[i]);
2985  }
2986  R->qideal=dest_id;
2987  if (perm!=NULL)
2988  omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
2989  if (par_perm!=NULL)
2990  omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2991  rChangeCurrRing(orig_ring);
2992  #endif
2993  }
2994  else
2995  R->qideal=idrCopyR(q,currRing,R);
2996  }
2997  }
2998  else
2999  {
3000  WerrorS("q-ideal must be given as `ideal`");
3001  goto rCompose_err;
3002  }
3003 
3004 
3005  // ---------------------------------------------------------------
3006  #ifdef HAVE_PLURAL
3007  if (L->nr==5)
3008  {
3009  if (nc_CallPlural((matrix)L->m[4].Data(),
3010  (matrix)L->m[5].Data(),
3011  NULL,NULL,
3012  R,
3013  true, // !!!
3014  true, false,
3015  currRing, FALSE)) goto rCompose_err;
3016  // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
3017  }
3018  #endif
3019  return R;
3020 
3021 rCompose_err:
3022  if (R->N>0)
3023  {
3024  int i;
3025  if (R->names!=NULL)
3026  {
3027  i=R->N-1;
3028  while (i>=0) { omfree(R->names[i]); i--; }
3029  omFree(R->names);
3030  }
3031  }
3032  omfree(R->order);
3033  omfree(R->block0);
3034  omfree(R->block1);
3035  omfree(R->wvhdl);
3036  omFree(R);
3037  return NULL;
3038 }
mpz_ptr base
Definition: rmodulon.h:18
sleftv * m
Definition: lists.h:46
only used if HAVE_RINGS is defined
Definition: coeffs.h:45
Definition: tok.h:96
ring r
Definition: algext.h:37
static BOOLEAN rField_is_Zp_a(const ring r)
Definition: ring.h:524
static BOOLEAN rComposeVar(const lists L, ring R)
Definition: ipshell.cc:2447
Definition: lists.h:23
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:139
#define FALSE
Definition: auxiliary.h:94
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:593
#define pTest(p)
Definition: polys.h:410
static FORCE_INLINE void nSetChar(const coeffs r)
initialisations after each ring change
Definition: coeffs.h:436
rational (GMP) numbers
Definition: coeffs.h:31
const char * GFPar_name
Definition: coeffs.h:96
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
{p < 2^31}
Definition: coeffs.h:30
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:586
static BOOLEAN rField_is_Q_a(const ring r)
Definition: ring.h:534
void * ADDRESS
Definition: auxiliary.h:133
static BOOLEAN rField_is_Zn(const ring r)
Definition: ring.h:507
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:1033
void rComposeC(lists L, ring R)
Definition: ipshell.cc:2242
Creation data needed for finite fields.
Definition: coeffs.h:92
Definition: tok.h:56
poly p_PermPoly(poly p, const int *perm, const ring oldRing, const ring dst, nMapFunc nMap, const int *par_perm, int OldPar, BOOLEAN use_mult)
Definition: p_polys.cc:4036
static BOOLEAN rComposeOrder(const lists L, const BOOLEAN check_comp, ring R)
Definition: ipshell.cc:2492
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:3394
#define omFree(addr)
Definition: omAllocDecl.h:261
#define assume(x)
Definition: mod2.h:390
The main handler for Singular numbers which are suitable for Singular polynomials.
int GFDegree
Definition: coeffs.h:95
const ExtensionInfo & info
< [in] sqrfree poly
number(* nMapFunc)(number a, const coeffs src, const coeffs dst)
maps "a", which lives in src, into dst
Definition: coeffs.h:73
#define omfree(addr)
Definition: omAllocDecl.h:237
omBin sip_sring_bin
Definition: ring.cc:43
const unsigned short fftable[]
Definition: ffields.cc:30
struct for passing initialization parameters to naInitChar
Definition: transext.h:88
int i
Definition: cfEzgcd.cc:125
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:501
int IsPrime(int p)
Definition: prime.cc:61
#define IDELEMS(i)
Definition: simpleideals.h:23
BOOLEAN rEqual(ring r1, ring r2, BOOLEAN qr)
returns TRUE, if r1 equals r2 FALSE, otherwise Equality is determined componentwise, if qr == 1, then qrideal equality is tested, as well
Definition: ring.cc:1660
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:721
static void rRenameVars(ring R)
Definition: ipshell.cc:2406
void rChangeCurrRing(ring r)
Definition: polys.cc:14
static BOOLEAN rField_is_Zp(const ring r)
Definition: ring.h:495
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
int GFChar
Definition: coeffs.h:94
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:35
BOOLEAN nc_CallPlural(matrix cc, matrix dd, poly cn, poly dn, ring r, bool bSetupQuotient, bool bCopyInput, bool bBeQuiet, ring curr, bool dummy_ring=false)
returns TRUE if there were errors analyze inputs, check them for consistency detects nc_type...
Definition: old.gring.cc:2682
int nr
Definition: lists.h:44
void maFindPerm(char const *const *const preim_names, int preim_n, char const *const *const preim_par, int preim_p, char const *const *const names, int n, char const *const *const par, int nop, int *perm, int *par_perm, n_coeffType ch)
Definition: maps.cc:163
void rComposeRing(lists L, ring R)
Definition: ipshell.cc:2313
#define NULL
Definition: omList.c:12
slists * lists
Definition: mpr_numeric.h:146
{p^n < 2^16}
Definition: coeffs.h:33
struct for passing initialization parameters to naInitChar
Definition: algext.h:37
used for all algebraic extensions, i.e., the top-most extension in an extension tower is algebraic ...
Definition: coeffs.h:36
#define R
Definition: sirandom.c:26
int exp
Definition: rmodulon.h:18
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void * Data()
Definition: subexpr.cc:1176
#define nSetMap(R)
Definition: numbers.h:43
ideal idrCopyR(ideal id, ring src_r, ring dest_r)
Definition: prCopy.cc:191
static int rInternalChar(const ring r)
Definition: ring.h:683
Definition: tok.h:118
ring rCompose(const lists L, const BOOLEAN check_comp, const long bitmask, const int isLetterplace)
Definition: ipshell.cc:2758
ip_smatrix * matrix
Definition: matpol.h:43
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:93
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:349
#define Warn
Definition: emacs.cc:77

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2056 of file ipshell.cc.

2057 {
2058  assume( r != NULL );
2059  const coeffs C = r->cf;
2060  assume( C != NULL );
2061 
2062  // sanity check: require currRing==r for rings with polynomial data
2063  if ( (r!=currRing) && (
2064  (nCoeff_is_algExt(C) && (C != currRing->cf))
2065  || (r->qideal != NULL)
2066 #ifdef HAVE_PLURAL
2067  || (rIsPluralRing(r))
2068 #endif
2069  )
2070  )
2071  {
2072  WerrorS("ring with polynomial data must be the base ring or compatible");
2073  return NULL;
2074  }
2075  // 0: char/ cf - ring
2076  // 1: list (var)
2077  // 2: list (ord)
2078  // 3: qideal
2079  // possibly:
2080  // 4: C
2081  // 5: D
2083  if (rIsPluralRing(r))
2084  L->Init(6);
2085  else
2086  L->Init(4);
2087  // ----------------------------------------
2088  // 0: char/ cf - ring
2089  if (rField_is_numeric(r))
2090  {
2091  rDecomposeC(&(L->m[0]),r);
2092  }
2093  else if (rField_is_Ring(r))
2094  {
2095  rDecomposeRing(&(L->m[0]),r);
2096  }
2097  else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2098  {
2099  rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2100  }
2101  else if(rField_is_GF(r))
2102  {
2104  Lc->Init(4);
2105  // char:
2106  Lc->m[0].rtyp=INT_CMD;
2107  Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2108  // var:
2110  Lv->Init(1);
2111  Lv->m[0].rtyp=STRING_CMD;
2112  Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2113  Lc->m[1].rtyp=LIST_CMD;
2114  Lc->m[1].data=(void*)Lv;
2115  // ord:
2117  Lo->Init(1);
2119  Loo->Init(2);
2120  Loo->m[0].rtyp=STRING_CMD;
2121  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2122 
2123  intvec *iv=new intvec(1); (*iv)[0]=1;
2124  Loo->m[1].rtyp=INTVEC_CMD;
2125  Loo->m[1].data=(void *)iv;
2126 
2127  Lo->m[0].rtyp=LIST_CMD;
2128  Lo->m[0].data=(void*)Loo;
2129 
2130  Lc->m[2].rtyp=LIST_CMD;
2131  Lc->m[2].data=(void*)Lo;
2132  // q-ideal:
2133  Lc->m[3].rtyp=IDEAL_CMD;
2134  Lc->m[3].data=(void *)idInit(1,1);
2135  // ----------------------
2136  L->m[0].rtyp=LIST_CMD;
2137  L->m[0].data=(void*)Lc;
2138  }
2139  else
2140  {
2141  L->m[0].rtyp=INT_CMD;
2142  L->m[0].data=(void *)(long)r->cf->ch;
2143  }
2144  // ----------------------------------------
2145  // 1: list (var)
2147  LL->Init(r->N);
2148  int i;
2149  for(i=0; i<r->N; i++)
2150  {
2151  LL->m[i].rtyp=STRING_CMD;
2152  LL->m[i].data=(void *)omStrDup(r->names[i]);
2153  }
2154  L->m[1].rtyp=LIST_CMD;
2155  L->m[1].data=(void *)LL;
2156  // ----------------------------------------
2157  // 2: list (ord)
2159  i=rBlocks(r)-1;
2160  LL->Init(i);
2161  i--;
2162  lists LLL;
2163  for(; i>=0; i--)
2164  {
2165  intvec *iv;
2166  int j;
2167  LL->m[i].rtyp=LIST_CMD;
2169  LLL->Init(2);
2170  LLL->m[0].rtyp=STRING_CMD;
2171  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2172 
2173  if((r->order[i] == ringorder_IS)
2174  || (r->order[i] == ringorder_s)) //|| r->order[i] == ringorder_S)
2175  {
2176  assume( r->block0[i] == r->block1[i] );
2177  const int s = r->block0[i];
2178  assume( (-2 < s && s < 2)||(r->order[i] != ringorder_IS));
2179 
2180  iv=new intvec(1);
2181  (*iv)[0] = s;
2182  }
2183  else if (r->block1[i]-r->block0[i] >=0 )
2184  {
2185  int bl=j=r->block1[i]-r->block0[i];
2186  if (r->order[i]==ringorder_M)
2187  {
2188  j=(j+1)*(j+1)-1;
2189  bl=j+1;
2190  }
2191  else if (r->order[i]==ringorder_am)
2192  {
2193  j+=r->wvhdl[i][bl+1];
2194  }
2195  iv=new intvec(j+1);
2196  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2197  {
2198  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2199  }
2200  else switch (r->order[i])
2201  {
2202  case ringorder_dp:
2203  case ringorder_Dp:
2204  case ringorder_ds:
2205  case ringorder_Ds:
2206  case ringorder_lp:
2207  for(;j>=0; j--) (*iv)[j]=1;
2208  break;
2209  default: /* do nothing */;
2210  }
2211  }
2212  else
2213  {
2214  iv=new intvec(1);
2215  }
2216  LLL->m[1].rtyp=INTVEC_CMD;
2217  LLL->m[1].data=(void *)iv;
2218  LL->m[i].data=(void *)LLL;
2219  }
2220  L->m[2].rtyp=LIST_CMD;
2221  L->m[2].data=(void *)LL;
2222  // ----------------------------------------
2223  // 3: qideal
2224  L->m[3].rtyp=IDEAL_CMD;
2225  if (r->qideal==NULL)
2226  L->m[3].data=(void *)idInit(1,1);
2227  else
2228  L->m[3].data=(void *)idCopy(r->qideal);
2229  // ----------------------------------------
2230 #ifdef HAVE_PLURAL // NC! in rDecompose
2231  if (rIsPluralRing(r))
2232  {
2233  L->m[4].rtyp=MATRIX_CMD;
2234  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2235  L->m[5].rtyp=MATRIX_CMD;
2236  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2237  }
2238 #endif
2239  return L;
2240 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:46
int j
Definition: facHensel.cc:105
Definition: tok.h:96
Definition: lists.h:23
void WerrorS(const char *s)
Definition: feFopen.cc:24
static BOOLEAN rField_is_GF(const ring r)
Definition: ring.h:516
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:619
CanonicalForm Lc(const CanonicalForm &f)
void * data
Definition: subexpr.h:88
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1636
static int rBlocks(ring r)
Definition: ring.h:562
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:932
Definition: intvec.h:19
#define assume(x)
Definition: mod2.h:390
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:397
The main handler for Singular numbers which are suitable for Singular polynomials.
static void rDecomposeC(leftv h, const ring R)
Definition: ipshell.cc:1758
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:77
int i
Definition: cfEzgcd.cc:125
Induced (Schreyer) ordering.
Definition: ring.h:93
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:35
void rDecomposeRing(leftv h, const ring R)
Definition: ipshell.cc:1822
static BOOLEAN rField_is_Ring(const ring r)
Definition: ring.h:479
#define NULL
Definition: omList.c:12
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
Definition: tok.h:118
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:64
omBin slists_bin
Definition: lists.cc:23
s?
Definition: ring.h:76
static BOOLEAN rField_is_numeric(const ring r)
Definition: ring.h:510
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1854 of file ipshell.cc.

1855 {
1856  assume( C != NULL );
1857 
1858  // sanity check: require currRing==r for rings with polynomial data
1859  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1860  {
1861  WerrorS("ring with polynomial data must be the base ring or compatible");
1862  return TRUE;
1863  }
1864  if (nCoeff_is_numeric(C))
1865  {
1866  rDecomposeC_41(res,C);
1867  }
1868 #ifdef HAVE_RINGS
1869  else if (nCoeff_is_Ring(C))
1870  {
1871  rDecomposeRing_41(res,C);
1872  }
1873 #endif
1874  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1875  {
1876  rDecomposeCF(res, C->extRing, currRing);
1877  }
1878  else if(nCoeff_is_GF(C))
1879  {
1881  Lc->Init(4);
1882  // char:
1883  Lc->m[0].rtyp=INT_CMD;
1884  Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1885  // var:
1887  Lv->Init(1);
1888  Lv->m[0].rtyp=STRING_CMD;
1889  Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1890  Lc->m[1].rtyp=LIST_CMD;
1891  Lc->m[1].data=(void*)Lv;
1892  // ord:
1894  Lo->Init(1);
1896  Loo->Init(2);
1897  Loo->m[0].rtyp=STRING_CMD;
1898  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1899 
1900  intvec *iv=new intvec(1); (*iv)[0]=1;
1901  Loo->m[1].rtyp=INTVEC_CMD;
1902  Loo->m[1].data=(void *)iv;
1903 
1904  Lo->m[0].rtyp=LIST_CMD;
1905  Lo->m[0].data=(void*)Loo;
1906 
1907  Lc->m[2].rtyp=LIST_CMD;
1908  Lc->m[2].data=(void*)Lo;
1909  // q-ideal:
1910  Lc->m[3].rtyp=IDEAL_CMD;
1911  Lc->m[3].data=(void *)idInit(1,1);
1912  // ----------------------
1913  res->rtyp=LIST_CMD;
1914  res->data=(void*)Lc;
1915  }
1916  else
1917  {
1918  res->rtyp=INT_CMD;
1919  res->data=(void *)(long)C->ch;
1920  }
1921  // ----------------------------------------
1922  return FALSE;
1923 }
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:800
sleftv * m
Definition: lists.h:46
static FORCE_INLINE BOOLEAN nCoeff_is_numeric(const coeffs r)
Definition: coeffs.h:854
Definition: tok.h:96
Definition: lists.h:23
#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:752
void rDecomposeRing_41(leftv h, const coeffs C)
Definition: ipshell.cc:1794
void * data
Definition: subexpr.h:88
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1636
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:932
Definition: intvec.h:19
#define assume(x)
Definition: mod2.h:390
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:77
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition: coeffs.h:861
static void rDecomposeC_41(leftv h, const coeffs C)
Definition: ipshell.cc:1724
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:35
#define NULL
Definition: omList.c:12
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
Definition: tok.h:118
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 1925 of file ipshell.cc.

1926 {
1927  assume( r != NULL );
1928  const coeffs C = r->cf;
1929  assume( C != NULL );
1930 
1931  // sanity check: require currRing==r for rings with polynomial data
1932  if ( (r!=currRing) && (
1933  (r->qideal != NULL)
1934 #ifdef HAVE_PLURAL
1935  || (rIsPluralRing(r))
1936 #endif
1937  )
1938  )
1939  {
1940  WerrorS("ring with polynomial data must be the base ring or compatible");
1941  return NULL;
1942  }
1943  // 0: char/ cf - ring
1944  // 1: list (var)
1945  // 2: list (ord)
1946  // 3: qideal
1947  // possibly:
1948  // 4: C
1949  // 5: D
1951  if (rIsPluralRing(r))
1952  L->Init(6);
1953  else
1954  L->Init(4);
1955  // ----------------------------------------
1956  // 0: char/ cf - ring
1957  L->m[0].rtyp=CRING_CMD;
1958  L->m[0].data=(char*)r->cf; r->cf->ref++;
1959  // ----------------------------------------
1960  // 1: list (var)
1962  LL->Init(r->N);
1963  int i;
1964  for(i=0; i<r->N; i++)
1965  {
1966  LL->m[i].rtyp=STRING_CMD;
1967  LL->m[i].data=(void *)omStrDup(r->names[i]);
1968  }
1969  L->m[1].rtyp=LIST_CMD;
1970  L->m[1].data=(void *)LL;
1971  // ----------------------------------------
1972  // 2: list (ord)
1974  i=rBlocks(r)-1;
1975  LL->Init(i);
1976  i--;
1977  lists LLL;
1978  for(; i>=0; i--)
1979  {
1980  intvec *iv;
1981  int j;
1982  LL->m[i].rtyp=LIST_CMD;
1984  LLL->Init(2);
1985  LLL->m[0].rtyp=STRING_CMD;
1986  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1987 
1988  if(r->order[i] == ringorder_IS) // || r->order[i] == ringorder_s || r->order[i] == ringorder_S)
1989  {
1990  assume( r->block0[i] == r->block1[i] );
1991  const int s = r->block0[i];
1992  assume( -2 < s && s < 2);
1993 
1994  iv=new intvec(1);
1995  (*iv)[0] = s;
1996  }
1997  else if (r->block1[i]-r->block0[i] >=0 )
1998  {
1999  int bl=j=r->block1[i]-r->block0[i];
2000  if (r->order[i]==ringorder_M)
2001  {
2002  j=(j+1)*(j+1)-1;
2003  bl=j+1;
2004  }
2005  else if (r->order[i]==ringorder_am)
2006  {
2007  j+=r->wvhdl[i][bl+1];
2008  }
2009  iv=new intvec(j+1);
2010  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2011  {
2012  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2013  }
2014  else switch (r->order[i])
2015  {
2016  case ringorder_dp:
2017  case ringorder_Dp:
2018  case ringorder_ds:
2019  case ringorder_Ds:
2020  case ringorder_lp:
2021  for(;j>=0; j--) (*iv)[j]=1;
2022  break;
2023  default: /* do nothing */;
2024  }
2025  }
2026  else
2027  {
2028  iv=new intvec(1);
2029  }
2030  LLL->m[1].rtyp=INTVEC_CMD;
2031  LLL->m[1].data=(void *)iv;
2032  LL->m[i].data=(void *)LLL;
2033  }
2034  L->m[2].rtyp=LIST_CMD;
2035  L->m[2].data=(void *)LL;
2036  // ----------------------------------------
2037  // 3: qideal
2038  L->m[3].rtyp=IDEAL_CMD;
2039  if (r->qideal==NULL)
2040  L->m[3].data=(void *)idInit(1,1);
2041  else
2042  L->m[3].data=(void *)idCopy(r->qideal);
2043  // ----------------------------------------
2044 #ifdef HAVE_PLURAL // NC! in rDecompose
2045  if (rIsPluralRing(r))
2046  {
2047  L->m[4].rtyp=MATRIX_CMD;
2048  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2049  L->m[5].rtyp=MATRIX_CMD;
2050  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2051  }
2052 #endif
2053  return L;
2054 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:46
int j
Definition: facHensel.cc:105
Definition: lists.h:23
void WerrorS(const char *s)
Definition: feFopen.cc:24
void * data
Definition: subexpr.h:88
static int rBlocks(ring r)
Definition: ring.h:562
Definition: tok.h:56
Definition: intvec.h:19
#define assume(x)
Definition: mod2.h:390
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:397
The main handler for Singular numbers which are suitable for Singular polynomials.
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:77
int i
Definition: cfEzgcd.cc:125
Induced (Schreyer) ordering.
Definition: ring.h:93
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:35
#define NULL
Definition: omList.c:12
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:91
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
Definition: tok.h:118
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:64
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1553 of file ipshell.cc.

1554 {
1555  idhdl tmp=NULL;
1556 
1557  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
1558  if (tmp==NULL) return NULL;
1559 
1560 // if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
1562  {
1564  memset(&sLastPrinted,0,sizeof(sleftv));
1565  }
1566 
1567  ring r = IDRING(tmp) = (ring) omAlloc0Bin(sip_sring_bin);
1568 
1569  #ifndef TEST_ZN_AS_ZP
1570  r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1571  #else
1572  mpz_t modBase;
1573  mpz_init_set_ui(modBase, (long)32003);
1574  ZnmInfo info;
1575  info.base= modBase;
1576  info.exp= 1;
1577  r->cf=nInitChar(n_Zn,(void*) &info);
1578  r->cf->is_field=1;
1579  r->cf->is_domain=1;
1580  r->cf->has_simple_Inverse=1;
1581  #endif
1582  r->N = 3;
1583  /*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
1584  /*names*/
1585  r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
1586  r->names[0] = omStrDup("x");
1587  r->names[1] = omStrDup("y");
1588  r->names[2] = omStrDup("z");
1589  /*weights: entries for 3 blocks: NULL*/
1590  r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1591  /*order: dp,C,0*/
1592  r->order = (rRingOrder_t *) omAlloc(3 * sizeof(rRingOrder_t *));
1593  r->block0 = (int *)omAlloc0(3 * sizeof(int *));
1594  r->block1 = (int *)omAlloc0(3 * sizeof(int *));
1595  /* ringorder dp for the first block: var 1..3 */
1596  r->order[0] = ringorder_dp;
1597  r->block0[0] = 1;
1598  r->block1[0] = 3;
1599  /* ringorder C for the second block: no vars */
1600  r->order[1] = ringorder_C;
1601  /* the last block: everything is 0 */
1602  r->order[2] = (rRingOrder_t)0;
1603 
1604  /* complete ring intializations */
1605  rComplete(r);
1606  rSetHdl(tmp);
1607  return currRingHdl;
1608 }
mpz_ptr base
Definition: rmodulon.h:18
const CanonicalForm int s
Definition: facAbsFact.cc:55
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
only used if HAVE_RINGS is defined
Definition: coeffs.h:45
{p < 2^31}
Definition: coeffs.h:30
#define IDROOT
Definition: ipid.h:18
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: idrec.h:34
int myynest
Definition: febase.cc:41
char * char_ptr
Definition: structs.h:58
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:265
BOOLEAN RingDependend()
Definition: subexpr.cc:418
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:3394
const ExtensionInfo & info
< [in] sqrfree poly
rRingOrder_t
order stuff
Definition: ring.h:67
idhdl currRingHdl
Definition: ipid.cc:59
omBin sip_sring_bin
Definition: ring.cc:43
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
#define NULL
Definition: omList.c:12
#define IDRING(a)
Definition: ipid.h:122
int exp
Definition: rmodulon.h:18
sleftv sLastPrinted
Definition: subexpr.cc:46
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
void rSetHdl(idhdl h)
Definition: ipshell.cc:5086
int * int_ptr
Definition: structs.h:59
#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:349
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1610 of file ipshell.cc.

1611 {
1613  if (h!=NULL) return h;
1614  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1615  if (h!=NULL) return h;
1617  while(p!=NULL)
1618  {
1619  if ((p->cPack!=basePack)
1620  && (p->cPack!=currPack))
1621  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1622  if (h!=NULL) return h;
1623  p=p->next;
1624  }
1625  idhdl tmp=basePack->idroot;
1626  while (tmp!=NULL)
1627  {
1628  if (IDTYP(tmp)==PACKAGE_CMD)
1629  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1630  if (h!=NULL) return h;
1631  tmp=IDNEXT(tmp);
1632  }
1633  return NULL;
1634 }
idhdl rSimpleFindHdl(ring r, idhdl root, idhdl n)
Definition: ipshell.cc:6213
#define IDNEXT(a)
Definition: ipid.h:113
proclevel * procstack
Definition: ipid.cc:52
#define IDROOT
Definition: ipid.h:18
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:134
#define IDTYP(a)
Definition: ipid.h:114
Definition: ipid.h:54
proclevel * next
Definition: ipid.h:57
#define NULL
Definition: omList.c:12
package basePack
Definition: ipid.cc:58
package currPack
Definition: ipid.cc:57
int p
Definition: cfModGcd.cc:4019
static Poly * h
Definition: janet.cc:971
package cPack
Definition: ipid.h:59

◆ rInit()

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

Definition at line 5579 of file ipshell.cc.

5580 {
5581  int float_len=0;
5582  int float_len2=0;
5583  ring R = NULL;
5584  //BOOLEAN ffChar=FALSE;
5585 
5586  /* ch -------------------------------------------------------*/
5587  // get ch of ground field
5588 
5589  // allocated ring
5590  R = (ring) omAlloc0Bin(sip_sring_bin);
5591 
5592  coeffs cf = NULL;
5593 
5594  assume( pn != NULL );
5595  const int P = pn->listLength();
5596 
5597  if (pn->Typ()==CRING_CMD)
5598  {
5599  cf=(coeffs)pn->CopyD();
5600  leftv pnn=pn;
5601  if(P>1) /*parameter*/
5602  {
5603  pnn = pnn->next;
5604  const int pars = pnn->listLength();
5605  assume( pars > 0 );
5606  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5607 
5608  if (rSleftvList2StringArray(pnn, names))
5609  {
5610  WerrorS("parameter expected");
5611  goto rInitError;
5612  }
5613 
5614  TransExtInfo extParam;
5615 
5616  extParam.r = rDefault( cf, pars, names); // Q/Zp [ p_1, ... p_pars ]
5617  for(int i=pars-1; i>=0;i--)
5618  {
5619  omFree(names[i]);
5620  }
5621  omFree(names);
5622 
5623  cf = nInitChar(n_transExt, &extParam);
5624  }
5625  assume( cf != NULL );
5626  }
5627  else if (pn->Typ()==INT_CMD)
5628  {
5629  int ch = (int)(long)pn->Data();
5630  leftv pnn=pn;
5631 
5632  /* parameter? -------------------------------------------------------*/
5633  pnn = pnn->next;
5634 
5635  if (pnn == NULL) // no params!?
5636  {
5637  if (ch!=0)
5638  {
5639  int ch2=IsPrime(ch);
5640  if ((ch<2)||(ch!=ch2))
5641  {
5642  Warn("%d is invalid as characteristic of the ground field. 32003 is used.", ch);
5643  ch=32003;
5644  }
5645  #ifndef TEST_ZN_AS_ZP
5646  cf = nInitChar(n_Zp, (void*)(long)ch);
5647  #else
5648  mpz_t modBase;
5649  mpz_init_set_ui(modBase, (long)ch);
5650  ZnmInfo info;
5651  info.base= modBase;
5652  info.exp= 1;
5653  cf=nInitChar(n_Zn,(void*) &info);
5654  cf->is_field=1;
5655  cf->is_domain=1;
5656  cf->has_simple_Inverse=1;
5657  #endif
5658  }
5659  else
5660  cf = nInitChar(n_Q, (void*)(long)ch);
5661  }
5662  else
5663  {
5664  const int pars = pnn->listLength();
5665 
5666  assume( pars > 0 );
5667 
5668  // predefined finite field: (p^k, a)
5669  if ((ch!=0) && (ch!=IsPrime(ch)) && (pars == 1))
5670  {
5671  GFInfo param;
5672 
5673  param.GFChar = ch;
5674  param.GFDegree = 1;
5675  param.GFPar_name = pnn->name;
5676 
5677  cf = nInitChar(n_GF, &param);
5678  }
5679  else // (0/p, a, b, ..., z)
5680  {
5681  if ((ch!=0) && (ch!=IsPrime(ch)))
5682  {
5683  WerrorS("too many parameters");
5684  goto rInitError;
5685  }
5686 
5687  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5688 
5689  if (rSleftvList2StringArray(pnn, names))
5690  {
5691  WerrorS("parameter expected");
5692  goto rInitError;
5693  }
5694 
5695  TransExtInfo extParam;
5696 
5697  extParam.r = rDefault( ch, pars, names); // Q/Zp [ p_1, ... p_pars ]
5698  for(int i=pars-1; i>=0;i--)
5699  {
5700  omFree(names[i]);
5701  }
5702  omFree(names);
5703 
5704  cf = nInitChar(n_transExt, &extParam);
5705  }
5706  }
5707 
5708  //if (cf==NULL) ->Error: Invalid ground field specification
5709  }
5710  else if ((pn->name != NULL)
5711  && ((strcmp(pn->name,"real")==0) || (strcmp(pn->name,"complex")==0)))
5712  {
5713  leftv pnn=pn->next;
5714  BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
5715  if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5716  {
5717  float_len=(int)(long)pnn->Data();
5718  float_len2=float_len;
5719  pnn=pnn->next;
5720  if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5721  {
5722  float_len2=(int)(long)pnn->Data();
5723  pnn=pnn->next;
5724  }
5725  }
5726 
5727  if (!complex_flag)
5728  complex_flag= (pnn!=NULL) && (pnn->name!=NULL);
5729  if( !complex_flag && (float_len2 <= (short)SHORT_REAL_LENGTH))
5730  cf=nInitChar(n_R, NULL);
5731  else // longR or longC?
5732  {
5733  LongComplexInfo param;
5734 
5735  param.float_len = si_min (float_len, 32767);
5736  param.float_len2 = si_min (float_len2, 32767);
5737 
5738  // set the parameter name
5739  if (complex_flag)
5740  {
5741  if (param.float_len < SHORT_REAL_LENGTH)
5742  {
5745  }
5746  if ((pnn == NULL) || (pnn->name == NULL))
5747  param.par_name=(const char*)"i"; //default to i
5748  else
5749  param.par_name = (const char*)pnn->name;
5750  }
5751 
5752  cf = nInitChar(complex_flag ? n_long_C: n_long_R, (void*)&param);
5753  }
5754  assume( cf != NULL );
5755  }
5756 #ifdef HAVE_RINGS
5757  else if ((pn->name != NULL) && (strcmp(pn->name, "integer") == 0))
5758  {
5759  // TODO: change to use coeffs_BIGINT!?
5760  mpz_t modBase;
5761  unsigned int modExponent = 1;
5762  mpz_init_set_si(modBase, 0);
5763  if (pn->next!=NULL)
5764  {
5765  leftv pnn=pn;
5766  if (pnn->next->Typ()==INT_CMD)
5767  {
5768  pnn=pnn->next;
5769  mpz_set_ui(modBase, (long) pnn->Data());
5770  if ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5771  {
5772  pnn=pnn->next;
5773  modExponent = (long) pnn->Data();
5774  }
5775  while ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5776  {
5777  pnn=pnn->next;
5778  mpz_mul_ui(modBase, modBase, (int)(long) pnn->Data());
5779  }
5780  }
5781  else if (pnn->next->Typ()==BIGINT_CMD)
5782  {
5783  number p=(number)pnn->next->CopyD();
5784  nlGMP(p,modBase,coeffs_BIGINT); // TODO? // extern void nlGMP(number &i, mpz_t n, const coeffs r); // FIXME: n_MPZ( modBase, p, coeffs_BIGINT); ?
5785  n_Delete(&p,coeffs_BIGINT);
5786  }
5787  }
5788  else
5789  cf=nInitChar(n_Z,NULL);
5790 
5791  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_sgn1(modBase) < 0))
5792  {
5793  WerrorS("Wrong ground ring specification (module is 1)");
5794  goto rInitError;
5795  }
5796  if (modExponent < 1)
5797  {
5798  WerrorS("Wrong ground ring specification (exponent smaller than 1");
5799  goto rInitError;
5800  }
5801  // module is 0 ---> integers ringtype = 4;
5802  // we have an exponent
5803  if (modExponent > 1 && cf == NULL)
5804  {
5805  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
5806  {
5807  /* this branch should be active for modExponent = 2..32 resp. 2..64,
5808  depending on the size of a long on the respective platform */
5809  //ringtype = 1; // Use Z/2^ch
5810  cf=nInitChar(n_Z2m,(void*)(long)modExponent);
5811  }
5812  else
5813  {
5814  if (mpz_sgn1(modBase)==0)
5815  {
5816  WerrorS("modulus must not be 0 or parameter not allowed");
5817  goto rInitError;
5818  }
5819  //ringtype = 3;
5820  ZnmInfo info;
5821  info.base= modBase;
5822  info.exp= modExponent;
5823  cf=nInitChar(n_Znm,(void*) &info); //exponent is missing
5824  }
5825  }
5826  // just a module m > 1
5827  else if (cf == NULL)
5828  {
5829  if (mpz_sgn1(modBase)==0)
5830  {
5831  WerrorS("modulus must not be 0 or parameter not allowed");
5832  goto rInitError;
5833  }
5834  //ringtype = 2;
5835  ZnmInfo info;
5836  info.base= modBase;
5837  info.exp= modExponent;
5838  cf=nInitChar(n_Zn,(void*) &info);
5839  }
5840  assume( cf != NULL );
5841  mpz_clear(modBase);
5842  }
5843 #endif
5844  // ring NEW = OLD, (), (); where OLD is a polynomial ring...
5845  else if ((pn->Typ()==RING_CMD) && (P == 1))
5846  {
5847  TransExtInfo extParam;
5848  extParam.r = (ring)pn->Data();
5849  cf = nInitChar(n_transExt, &extParam);
5850  }
5851  //else if ((pn->Typ()==QRING_CMD) && (P == 1)) // same for qrings - which should be fields!?
5852  //{
5853  // AlgExtInfo extParam;
5854  // extParam.r = (ring)pn->Data();
5855 
5856  // cf = nInitChar(n_algExt, &extParam); // Q[a]/<minideal>
5857  //}
5858  else
5859  {
5860  WerrorS("Wrong or unknown ground field specification");
5861 #if 0
5862 // debug stuff for unknown cf descriptions:
5863  sleftv* p = pn;
5864  while (p != NULL)
5865  {
5866  Print( "pn[%p]: type: %d [%s]: %p, name: %s", (void*)p, p->Typ(), Tok2Cmdname(p->Typ()), p->Data(), (p->name == NULL? "NULL" : p->name) );
5867  PrintLn();
5868  p = p->next;
5869  }
5870 #endif
5871  goto rInitError;
5872  }
5873 
5874  /*every entry in the new ring is initialized to 0*/
5875 
5876  /* characteristic -----------------------------------------------*/
5877  /* input: 0 ch=0 : Q parameter=NULL ffChar=FALSE float_len
5878  * 0 1 : Q(a,...) *names FALSE
5879  * 0 -1 : R NULL FALSE 0
5880  * 0 -1 : R NULL FALSE prec. >6
5881  * 0 -1 : C *names FALSE prec. 0..?
5882  * p p : Fp NULL FALSE
5883  * p -p : Fp(a) *names FALSE
5884  * q q : GF(q=p^n) *names TRUE
5885  */
5886  if (cf==NULL)
5887  {
5888  WerrorS("Invalid ground field specification");
5889  goto rInitError;
5890 // const int ch=32003;
5891 // cf=nInitChar(n_Zp, (void*)(long)ch);
5892  }
5893 
5894  assume( R != NULL );
5895 
5896  R->cf = cf;
5897 
5898  /* names and number of variables-------------------------------------*/
5899  {
5900  int l=rv->listLength();
5901 
5902  if (l>MAX_SHORT)
5903  {
5904  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5905  goto rInitError;
5906  }
5907  R->N = l; /*rv->listLength();*/
5908  }
5909  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
5910  if (rSleftvList2StringArray(rv, R->names))
5911  {
5912  WerrorS("name of ring variable expected");
5913  goto rInitError;
5914  }
5915 
5916  /* check names and parameters for conflicts ------------------------- */
5917  rRenameVars(R); // conflicting variables will be renamed
5918  /* ordering -------------------------------------------------------------*/
5919  if (rSleftvOrdering2Ordering(ord, R))
5920  goto rInitError;
5921 
5922  // Complete the initialization
5923  if (rComplete(R,1))
5924  goto rInitError;
5925 
5926 /*#ifdef HAVE_RINGS
5927 // currently, coefficients which are ring elements require a global ordering:
5928  if (rField_is_Ring(R) && (R->OrdSgn==-1))
5929  {
5930  WerrorS("global ordering required for these coefficients");
5931  goto rInitError;
5932  }
5933 #endif*/
5934 
5935  rTest(R);
5936 
5937  // try to enter the ring into the name list
5938  // need to clean up sleftv here, before this ring can be set to
5939  // new currRing or currRing can be killed beacuse new ring has
5940  // same name
5941  pn->CleanUp();
5942  rv->CleanUp();
5943  ord->CleanUp();
5944  //if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
5945  // goto rInitError;
5946 
5947  //memcpy(IDRING(tmp),R,sizeof(*R));
5948  // set current ring
5949  //omFreeBin(R, ip_sring_bin);
5950  //return tmp;
5951  return R;
5952 
5953  // error case:
5954  rInitError:
5955  if ((R != NULL)&&(R->cf!=NULL)) rDelete(R);
5956  pn->CleanUp();
5957  rv->CleanUp();
5958  ord->CleanUp();
5959  return NULL;
5960 }
mpz_ptr base
Definition: rmodulon.h:18
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
void PrintLn()
Definition: reporter.cc:310
#define Print
Definition: emacs.cc:80
only used if HAVE_RINGS is defined
Definition: coeffs.h:45
Definition: tok.h:96
#define SHORT_REAL_LENGTH
Definition: numbers.h:57
const short MAX_SHORT
Definition: ipshell.cc:5567
#define mpz_sgn1(A)
Definition: si_gmp.h:13
static BOOLEAN rSleftvList2StringArray(leftv sl, char **p)
Definition: ipshell.cc:5531
only used if HAVE_RINGS is defined
Definition: coeffs.h:47
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:139
BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R)
Definition: ipshell.cc:5259
Definition: tok.h:38
rational (GMP) numbers
Definition: coeffs.h:31
const char * GFPar_name
Definition: coeffs.h:96
{p < 2^31}
Definition: coeffs.h:30
int listLength()
Definition: subexpr.cc:51
void WerrorS(const char *s)
Definition: feFopen.cc:24
coeffs coeffs_BIGINT
Definition: ipid.cc:50
int Typ()
Definition: subexpr.cc:1033
Creation data needed for finite fields.
Definition: coeffs.h:92
idhdl rDefault(const char *s)
Definition: ipshell.cc:1553
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:58
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:3394
only used if HAVE_RINGS is defined
Definition: coeffs.h:46
const char * name
Definition: subexpr.h:87
#define omFree(addr)
Definition: omAllocDecl.h:261
#define assume(x)
Definition: mod2.h:390
The main handler for Singular numbers which are suitable for Singular polynomials.
int GFDegree
Definition: coeffs.h:95
const ExtensionInfo & info
< [in] sqrfree poly
complex floating point (GMP) numbers
Definition: coeffs.h:42
#define rTest(r)
Definition: ring.h:780
omBin sip_sring_bin
Definition: ring.cc:43
only used if HAVE_RINGS is defined
Definition: coeffs.h:44
struct for passing initialization parameters to naInitChar
Definition: transext.h:88
int i
Definition: cfEzgcd.cc:125
int IsPrime(int p)
Definition: prime.cc:61
void nlGMP(number &i, mpz_t n, const coeffs r)
Definition: longrat.cc:1477
static void rRenameVars(ring R)
Definition: ipshell.cc:2406
leftv next
Definition: subexpr.h:86
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
int GFChar
Definition: coeffs.h:94
CanonicalForm cf
Definition: cfModGcd.cc:4024
#define NULL
Definition: omList.c:12
{p^n < 2^16}
Definition: coeffs.h:33
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:448
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140
#define R
Definition: sirandom.c:26
int exp
Definition: rmodulon.h:18
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
void * Data()
Definition: subexpr.cc:1176
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:455
int p
Definition: cfModGcd.cc:4019
int BOOLEAN
Definition: auxiliary.h:85
void Werror(const char *fmt,...)
Definition: reporter.cc:189
void * CopyD(int t)
Definition: subexpr.cc:739
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:93
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:349
#define Warn
Definition: emacs.cc:77

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6170 of file ipshell.cc.

6171 {
6172  ring r = IDRING(h);
6173  int ref=0;
6174  if (r!=NULL)
6175  {
6176  // avoid, that sLastPrinted is the last reference to the base ring:
6177  // clean up before killing the last "named" refrence:
6178  if ((sLastPrinted.rtyp==RING_CMD)
6179  && (sLastPrinted.data==(void*)r))
6180  {
6181  sLastPrinted.CleanUp(r);
6182  }
6183  ref=r->ref;
6184  if ((ref<=0)&&(r==currRing))
6185  {
6186  // cleanup DENOMINATOR_LIST
6187  if (DENOMINATOR_LIST!=NULL)
6188  {
6190  if (TEST_V_ALLWARN)
6191  Warn("deleting denom_list for ring change from %s",IDID(h));
6192  do
6193  {
6194  n_Delete(&(dd->n),currRing->cf);
6195  dd=dd->next;
6197  DENOMINATOR_LIST=dd;
6198  } while(DENOMINATOR_LIST!=NULL);
6199  }
6200  }
6201  rKill(r);
6202  }
6203  if (h==currRingHdl)
6204  {
6205  if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6206  else
6207  {
6209  }
6210  }
6211 }
#define IDID(a)
Definition: ipid.h:117
denominator_list DENOMINATOR_LIST
Definition: kutil.cc:88
void * data
Definition: subexpr.h:88
void rKill(ring r)
Definition: ipshell.cc:6124
#define omFree(addr)
Definition: omAllocDecl.h:261
idhdl currRingHdl
Definition: ipid.cc:59
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1610
#define NULL
Definition: omList.c:12
denominator_list next
Definition: kutil.h:61
#define IDRING(a)
Definition: ipid.h:122
int rtyp
Definition: subexpr.h:91
sleftv sLastPrinted
Definition: subexpr.cc:46
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete &#39;p&#39;
Definition: coeffs.h:455
#define TEST_V_ALLWARN
Definition: options.h:140
#define Warn
Definition: emacs.cc:77

◆ rKill() [2/2]

void rKill ( ring  r)

Definition at line 6124 of file ipshell.cc.

6125 {
6126  if ((r->ref<=0)&&(r->order!=NULL))
6127  {
6128 #ifdef RDEBUG
6129  if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6130 #endif
6131  int j;
6132  for (j=0;j<myynest;j++)
6133  {
6134  if (iiLocalRing[j]==r)
6135  {
6136  if (j==0) WarnS("killing the basering for level 0");
6137  iiLocalRing[j]=NULL;
6138  }
6139  }
6140 // any variables depending on r ?
6141  while (r->idroot!=NULL)
6142  {
6143  r->idroot->lev=myynest; // avoid warning about kill global objects
6144  killhdl2(r->idroot,&(r->idroot),r);
6145  }
6146  if (r==currRing)
6147  {
6148  // all dependend stuff is done, clean global vars:
6149  if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6151  {
6153  }
6154  //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6155  //{
6156  // WerrorS("return value depends on local ring variable (export missing ?)");
6157  // iiRETURNEXPR.CleanUp();
6158  //}
6159  currRing=NULL;
6160  currRingHdl=NULL;
6161  }
6162 
6163  /* nKillChar(r); will be called from inside of rDelete */
6164  rDelete(r);
6165  return;
6166  }
6167  r->ref--;
6168 }
int j
Definition: facHensel.cc:105
#define TRACE_SHOW_RINGS
Definition: reporter.h:35
#define Print
Definition: emacs.cc:80
int traceit
Definition: febase.cc:42
#define WarnS
Definition: emacs.cc:78
int myynest
Definition: febase.cc:41
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:415
BOOLEAN RingDependend()
Definition: subexpr.cc:418
idhdl currRingHdl
Definition: ipid.cc:59
ring * iiLocalRing
Definition: iplib.cc:453
#define NULL
Definition: omList.c:12
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:448
#define pDelete(p_ptr)
Definition: polys.h:181
sleftv sLastPrinted
Definition: subexpr.cc:46
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5086 of file ipshell.cc.

5087 {
5088  ring rg = NULL;
5089  if (h!=NULL)
5090  {
5091 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5092  rg = IDRING(h);
5093  if (rg==NULL) return; //id <>NULL, ring==NULL
5094  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5095  if (IDID(h)) // OB: ????
5096  omCheckAddr((ADDRESS)IDID(h));
5097  rTest(rg);
5098  }
5099  else return;
5100 
5101  // clean up history
5102  if (currRing!=NULL)
5103  {
5105  {
5107  //memset(&sLastPrinted,0,sizeof(sleftv)); // done by Cleanup,Init
5108  }
5109 
5110  if (rg!=currRing)/*&&(currRing!=NULL)*/
5111  {
5112  if (rg->cf!=currRing->cf)
5113  {
5115  if (DENOMINATOR_LIST!=NULL)
5116  {
5117  if (TEST_V_ALLWARN)
5118  Warn("deleting denom_list for ring change to %s",IDID(h));
5119  do
5120  {
5121  n_Delete(&(dd->n),currRing->cf);
5122  dd=dd->next;
5124  DENOMINATOR_LIST=dd;
5125  } while(DENOMINATOR_LIST!=NULL);
5126  }
5127  }
5128  }
5129  }
5130 
5131  // test for valid "currRing":
5132  if ((rg!=NULL) && (rg->idroot==NULL))
5133  {
5134  ring old=rg;
5135  rg=rAssure_HasComp(rg);
5136  if (old!=rg)
5137  {
5138  rKill(old);
5139  IDRING(h)=rg;
5140  }
5141  }
5142  /*------------ change the global ring -----------------------*/
5143  rChangeCurrRing(rg);
5144  currRingHdl = h;
5145 }
#define omCheckAddrSize(addr, size)
Definition: omAllocDecl.h:327
#define IDID(a)
Definition: ipid.h:117
denominator_list DENOMINATOR_LIST
Definition: kutil.cc:88
void * ADDRESS
Definition: auxiliary.h:133
ring rAssure_HasComp(const ring r)
Definition: ring.cc:4583
Definition: idrec.h:34
BOOLEAN RingDependend()
Definition: subexpr.cc:418
void rKill(ring r)
Definition: ipshell.cc:6124
#define omFree(addr)
Definition: omAllocDecl.h:261
#define rTest(r)
Definition: ring.h:780
idhdl currRingHdl
Definition: ipid.cc:59
void rChangeCurrRing(ring r)
Definition: polys.cc:14
#define NULL
Definition: omList.c:12
denominator_list next
Definition: kutil.h:61
#define IDRING(a)
Definition: ipid.h:122
sleftv sLastPrinted
Definition: subexpr.cc:46
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#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:455
static Poly * h
Definition: janet.cc:971
#define TEST_V_ALLWARN
Definition: options.h:140
#define Warn
Definition: emacs.cc:77

◆ rSimpleFindHdl()

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

Definition at line 6213 of file ipshell.cc.

6214 {
6215  idhdl h=root;
6216  while (h!=NULL)
6217  {
6218  if ((IDTYP(h)==RING_CMD)
6219  && (h!=n)
6220  && (IDRING(h)==r)
6221  )
6222  {
6223  return h;
6224  }
6225  h=IDNEXT(h);
6226  }
6227  return NULL;
6228 }
#define IDNEXT(a)
Definition: ipid.h:113
Definition: idrec.h:34
#define IDTYP(a)
Definition: ipid.h:114
#define NULL
Definition: omList.c:12
#define IDRING(a)
Definition: ipid.h:122
static Poly * h
Definition: janet.cc:971

◆ scIndIndset()

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

Definition at line 1025 of file ipshell.cc.

1026 {
1027  int i;
1028  indset save;
1030 
1031  hexist = hInit(S, Q, &hNexist, currRing);
1032  if (hNexist == 0)
1033  {
1034  intvec *iv=new intvec(rVar(currRing));
1035  for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1036  res->Init(1);
1037  res->m[0].rtyp=INTVEC_CMD;
1038  res->m[0].data=(intvec*)iv;
1039  return res;
1040  }
1041  else if (hisModule!=0)
1042  {
1043  res->Init(0);
1044  return res;
1045  }
1046  save = ISet = (indset)omAlloc0Bin(indlist_bin);
1047  hMu = 0;
1048  hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1049  hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1050  hpure = (scmon)omAlloc((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1051  hrad = hexist;
1052  hNrad = hNexist;
1053  radmem = hCreate(rVar(currRing) - 1);
1054  hCo = rVar(currRing) + 1;
1055  hNvar = rVar(currRing);
1056  hRadical(hrad, &hNrad, hNvar);
1057  hSupp(hrad, hNrad, hvar, &hNvar);
1058  if (hNvar)
1059  {
1060  hCo = hNvar;
1061  memset(hpure, 0, (rVar(currRing) + 1) * sizeof(long));
1062  hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1063  hLexR(hrad, hNrad, hvar, hNvar);
1065  }
1066  if (hCo && (hCo < rVar(currRing)))
1067  {
1069  }
1070  if (hMu!=0)
1071  {
1072  ISet = save;
1073  hMu2 = 0;
1074  if (all && (hCo+1 < rVar(currRing)))
1075  {
1078  i=hMu+hMu2;
1079  res->Init(i);
1080  if (hMu2 == 0)
1081  {
1083  }
1084  }
1085  else
1086  {
1087  res->Init(hMu);
1088  }
1089  for (i=0;i<hMu;i++)
1090  {
1091  res->m[i].data = (void *)save->set;
1092  res->m[i].rtyp = INTVEC_CMD;
1093  ISet = save;
1094  save = save->nx;
1096  }
1097  omFreeBin((ADDRESS)save, indlist_bin);
1098  if (hMu2 != 0)
1099  {
1100  save = JSet;
1101  for (i=hMu;i<hMu+hMu2;i++)
1102  {
1103  res->m[i].data = (void *)save->set;
1104  res->m[i].rtyp = INTVEC_CMD;
1105  JSet = save;
1106  save = save->nx;
1108  }
1109  omFreeBin((ADDRESS)save, indlist_bin);
1110  }
1111  }
1112  else
1113  {
1114  res->Init(0);
1116  }
1117  hKill(radmem, rVar(currRing) - 1);
1118  omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1119  omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1120  omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1122  return res;
1123 }
int hMu2
Definition: hdegree.cc:21
sleftv * m
Definition: lists.h:46
void hDimSolve(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:28
scfmon hwork
Definition: hutil.cc:16
void hIndAllMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:495
int hNexist
Definition: hutil.cc:19
int * varset
Definition: hutil.h:16
int hCo
Definition: hdegree.cc:21
Definition: lists.h:23
scmon * scfmon
Definition: hutil.h:15
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
scfmon hexist
Definition: hutil.cc:16
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:586
monf hCreate(int Nvar)
Definition: hutil.cc:999
int hNvar
Definition: hutil.cc:19
void * ADDRESS
Definition: auxiliary.h:133
int hNrad
Definition: hutil.cc:19
int hNpure
Definition: hutil.cc:19
scmon hpure
Definition: hutil.cc:17
#define Q
Definition: sirandom.c:25
void hRadical(scfmon rad, int *Nrad, int Nvar)
Definition: hutil.cc:414
#define omAlloc(size)
Definition: omAllocDecl.h:210
scfmon hrad
Definition: hutil.cc:16
void * data
Definition: subexpr.h:88
void hDelete(scfmon ev, int ev_length)
Definition: hutil.cc:143
indset ISet
Definition: hdegree.cc:278
Definition: intvec.h:19
CanonicalForm res
Definition: facAbsFact.cc:64
void hKill(monf xmem, int Nvar)
Definition: hutil.cc:1013
varset hvar
Definition: hutil.cc:18
void hIndMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:312
indlist * indset
Definition: hutil.h:28
void hPure(scfmon stc, int a, int *Nstc, varset var, int Nvar, scmon pure, int *Npure)
Definition: hutil.cc:624
omBin indlist_bin
Definition: hdegree.cc:22
indset JSet
Definition: hdegree.cc:278
int * scmon
Definition: hutil.h:14
int i
Definition: cfEzgcd.cc:125
void hLexR(scfmon rad, int Nrad, varset var, int Nvar)
Definition: hutil.cc:568
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:21
int rtyp
Definition: subexpr.h:91
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
omBin slists_bin
Definition: lists.cc:23
int hisModule
Definition: hutil.cc:20
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
scfmon hInit(ideal S, ideal Q, int *Nexist, ring tailRing)
Definition: hutil.cc:31
int hMu
Definition: hdegree.cc:21
void hSupp(scfmon stc, int Nstc, varset var, int *Nvar)
Definition: hutil.cc:177

◆ semicProc()

BOOLEAN semicProc ( leftv  ,
leftv  ,
leftv   
)

Definition at line 4525 of file ipshell.cc.

4526 {
4527  sleftv tmp;
4528  memset(&tmp,0,sizeof(tmp));
4529  tmp.rtyp=INT_CMD;
4530  /* tmp.data = (void *)0; -- done by memset */
4531 
4532  return semicProc3(res,u,v,&tmp);
4533 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: tok.h:96
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4485
CanonicalForm res
Definition: facAbsFact.cc:64
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
int rtyp
Definition: subexpr.h:91

◆ semicProc3()

BOOLEAN semicProc3 ( leftv  ,
leftv  ,
leftv  ,
leftv   
)

Definition at line 4485 of file ipshell.cc.

4486 {
4487  semicState state;
4488  BOOLEAN qh=(((int)(long)w->Data())==1);
4489 
4490  // -----------------
4491  // check arguments
4492  // -----------------
4493 
4494  lists l1 = (lists)u->Data( );
4495  lists l2 = (lists)v->Data( );
4496 
4497  if( (state=list_is_spectrum( l1 ))!=semicOK )
4498  {
4499  WerrorS( "first argument is not a spectrum" );
4500  list_error( state );
4501  }
4502  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4503  {
4504  WerrorS( "second argument is not a spectrum" );
4505  list_error( state );
4506  }
4507  else
4508  {
4509  spectrum s1= spectrumFromList( l1 );
4510  spectrum s2= spectrumFromList( l2 );
4511 
4512  res->rtyp = INT_CMD;
4513  if (qh)
4514  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4515  else
4516  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4517  }
4518 
4519  // -----------------
4520  // check status
4521  // -----------------
4522 
4523  return (state!=semicOK);
4524 }
Definition: tok.h:96
Definition: lists.h:23
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3358
void list_error(semicState state)
Definition: ipshell.cc:3442
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4227
CanonicalForm res
Definition: facAbsFact.cc:64
int mult_spectrumh(spectrum &)
Definition: semic.cc:425
semicState
Definition: ipshell.cc:3408
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 581 of file misc_ip.cc.

582 {
583  const char *n;
584  do
585  {
586  if (v->Typ()==STRING_CMD)
587  {
588  n=(const char *)v->CopyD(STRING_CMD);
589  }
590  else
591  {
592  if (v->name==NULL)
593  return TRUE;
594  if (v->rtyp==0)
595  {
596  n=v->name;
597  v->name=NULL;
598  }
599  else
600  {
601  n=omStrDup(v->name);
602  }
603  }
604 
605  int i;
606 
607  if(strcmp(n,"get")==0)
608  {
609  intvec *w=new intvec(2);
610  (*w)[0]=si_opt_1;
611  (*w)[1]=si_opt_2;
612  res->rtyp=INTVEC_CMD;
613  res->data=(void *)w;
614  goto okay;
615  }
616  if(strcmp(n,"set")==0)
617  {
618  if((v->next!=NULL)
619  &&(v->next->Typ()==INTVEC_CMD))
620  {
621  v=v->next;
622  intvec *w=(intvec*)v->Data();
623  si_opt_1=(*w)[0];
624  si_opt_2=(*w)[1];
625 #if 0
629  ) {
631  }
632 #endif
633  goto okay;
634  }
635  }
636  if(strcmp(n,"none")==0)
637  {
638  si_opt_1=0;
639  si_opt_2=0;
640  goto okay;
641  }
642  for (i=0; (i==0) || (optionStruct[i-1].setval!=0); i++)
643  {
644  if (strcmp(n,optionStruct[i].name)==0)
645  {
646  if (optionStruct[i].setval & validOpts)
647  {
649  // optOldStd disables redthrough
650  if (optionStruct[i].setval == Sy_bit(OPT_OLDSTD))
652  }
653  else
654  WarnS("cannot set option");
655 #if 0
659  ) {
661  }
662 #endif
663  goto okay;
664  }
665  else if ((strncmp(n,"no",2)==0)
666  && (strcmp(n+2,optionStruct[i].name)==0))
667  {
668  if (optionStruct[i].setval & validOpts)
669  {
671  }
672  else
673  WarnS("cannot clear option");
674  goto okay;
675  }
676  }
677  for (i=0; (i==0) || (verboseStruct[i-1].setval!=0); i++)
678  {
679  if (strcmp(n,verboseStruct[i].name)==0)
680  {
682  #ifdef YYDEBUG
683  #if YYDEBUG
684  /*debugging the bison grammar --> grammar.cc*/
685  extern int yydebug;
686  if (BVERBOSE(V_YACC)) yydebug=1;
687  else yydebug=0;
688  #endif
689  #endif
690  goto okay;
691  }
692  else if ((strncmp(n,"no",2)==0)
693  && (strcmp(n+2,verboseStruct[i].name)==0))
694  {
696  #ifdef YYDEBUG
697  #if YYDEBUG
698  /*debugging the bison grammar --> grammar.cc*/
699  extern int yydebug;
700  if (BVERBOSE(V_YACC)) yydebug=1;
701  else yydebug=0;
702  #endif
703  #endif
704  goto okay;
705  }
706  }
707  Werror("unknown option `%s`",n);
708  okay:
709  if (currRing != NULL)
710  currRing->options = si_opt_1 & TEST_RINGDEP_OPTS;
711  omFree((ADDRESS)n);
712  v=v->next;
713  } while (v!=NULL);
714 
715  // set global variable to show memory usage
716  extern int om_sing_opt_show_mem;
717  if (BVERBOSE(V_SHOW_MEM)) om_sing_opt_show_mem = 1;
718  else om_sing_opt_show_mem = 0;
719 
720  return FALSE;
721 }
unsigned si_opt_1
Definition: options.c:5
#define FALSE
Definition: auxiliary.h:94
const struct soptionStruct optionStruct[]
Definition: misc_ip.cc:521
int om_sing_opt_show_mem
#define OPT_OLDSTD
Definition: options.h:85
#define TRUE
Definition: auxiliary.h:98
void * ADDRESS
Definition: auxiliary.h:133
unsigned setval
Definition: ipid.h:148
unsigned resetval
Definition: ipid.h:149
#define WarnS
Definition: emacs.cc:78
int Typ()
Definition: subexpr.cc:1033
#define Sy_bit(x)
Definition: options.h:32
BITSET validOpts
Definition: kstd1.cc:57
static BOOLEAN rField_has_simple_inverse(const ring r)
Definition: ring.h:543
void * data
Definition: subexpr.h:88
#define V_SHOW_MEM
Definition: options.h:43
#define TEST_OPT_INTSTRATEGY
Definition: options.h:109
Definition: intvec.h:19
const char * name
Definition: subexpr.h:87
#define omFree(addr)
Definition: omAllocDecl.h:261
int i
Definition: cfEzgcd.cc:125
const struct soptionStruct verboseStruct[]
Definition: misc_ip.cc:551
char name(const Variable &v)
Definition: factory.h:180
leftv next
Definition: subexpr.h:86
#define OPT_INTSTRATEGY
Definition: options.h:91
#define BVERBOSE(a)
Definition: options.h:35
CanonicalForm test
Definition: cfModGcd.cc:4037
#define V_YACC
Definition: options.h:44
static BOOLEAN rField_is_Ring(const ring r)
Definition: ring.h:479
#define NULL
Definition: omList.c:12
int yydebug
Definition: grammar.cc:1805
const CanonicalForm & w
Definition: facAbsFact.cc:55
int rtyp
Definition: subexpr.h:91
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void * Data()
Definition: subexpr.cc:1176
#define OPT_REDTHROUGH
Definition: options.h:81
#define TEST_RINGDEP_OPTS
Definition: options.h:99
unsigned si_opt_2
Definition: options.c:6
void Werror(const char *fmt,...)
Definition: reporter.cc:189
void * CopyD(int t)
Definition: subexpr.cc:739
#define omStrDup(s)
Definition: omAllocDecl.h:263

◆ showOption()

char* showOption ( )

Definition at line 723 of file misc_ip.cc.

724 {
725  int i;
726  BITSET tmp;
727 
728  StringSetS("//options:");
729  if ((si_opt_1!=0)||(si_opt_2!=0))
730  {
731  tmp=si_opt_1;
732  if(tmp)
733  {
734  for (i=0; optionStruct[i].setval!=0; i++)
735  {
736  if (optionStruct[i].setval & tmp)
737  {
738  StringAppend(" %s",optionStruct[i].name);
739  tmp &=optionStruct[i].resetval;
740  }
741  }
742  for (i=0; i<32; i++)
743  {
744  if (tmp & Sy_bit(i)) StringAppend(" %d",i);
745  }
746  }
747  tmp=si_opt_2;
748  if (tmp)
749  {
750  for (i=0; verboseStruct[i].setval!=0; i++)
751  {
752  if (verboseStruct[i].setval & tmp)
753  {
754  StringAppend(" %s",verboseStruct[i].name);
755  tmp &=verboseStruct[i].resetval;
756  }
757  }
758  for (i=1; i<32; i++)
759  {
760  if (tmp & Sy_bit(i)) StringAppend(" %d",i+32);
761  }
762  }
763  return StringEndS();
764  }
765  StringAppendS(" none");
766  return StringEndS();
767 }
unsigned si_opt_1
Definition: options.c:5
const struct soptionStruct optionStruct[]
Definition: misc_ip.cc:521
unsigned setval
Definition: ipid.h:148
unsigned resetval
Definition: ipid.h:149
char * StringEndS()
Definition: reporter.cc:151
#define BITSET
Definition: structs.h:20
#define Sy_bit(x)
Definition: options.h:32
void StringSetS(const char *st)
Definition: reporter.cc:128
void StringAppendS(const char *st)
Definition: reporter.cc:107
#define StringAppend
Definition: emacs.cc:79
int i
Definition: cfEzgcd.cc:125
const struct soptionStruct verboseStruct[]
Definition: misc_ip.cc:551
char name(const Variable &v)
Definition: factory.h:180
unsigned si_opt_2
Definition: options.c:6

◆ singular_example()

void singular_example ( char *  str)

Definition at line 444 of file misc_ip.cc.

445 {
446  assume(str!=NULL);
447  char *s=str;
448  while (*s==' ') s++;
449  char *ss=s;
450  while (*ss!='\0') ss++;
451  while (*ss<=' ')
452  {
453  *ss='\0';
454  ss--;
455  }
456  idhdl h=IDROOT->get(s,myynest);
457  if ((h!=NULL) && (IDTYP(h)==PROC_CMD))
458  {
459  char *lib=iiGetLibName(IDPROC(h));
460  if((lib!=NULL)&&(*lib!='\0'))
461  {
462  Print("// proc %s from lib %s\n",s,lib);
463  s=iiGetLibProcBuffer(IDPROC(h), 2);
464  if (s!=NULL)
465  {
466  if (strlen(s)>5)
467  {
468  iiEStart(s,IDPROC(h));
469  omFree((ADDRESS)s);
470  return;
471  }
472  else omFree((ADDRESS)s);
473  }
474  }
475  }
476  else
477  {
478  char sing_file[MAXPATHLEN];
479  FILE *fd=NULL;
480  char *res_m=feResource('m', 0);
481  if (res_m!=NULL)
482  {
483  sprintf(sing_file, "%s/%s.sing", res_m, s);
484  fd = feFopen(sing_file, "r");
485  }
486  if (fd != NULL)
487  {
488 
489  int old_echo = si_echo;
490  int length, got;
491  char* s;
492 
493  fseek(fd, 0, SEEK_END);
494  length = ftell(fd);
495  fseek(fd, 0, SEEK_SET);
496  s = (char*) omAlloc((length+20)*sizeof(char));
497  got = fread(s, sizeof(char), length, fd);
498  fclose(fd);
499  if (got != length)
500  {
501  Werror("Error while reading file %s", sing_file);
502  }
503  else
504  {
505  s[length] = '\0';
506  strcat(s, "\n;return();\n\n");
507  si_echo = 2;
508  iiEStart(s, NULL);
509  si_echo = old_echo;
510  }
511  omFree(s);
512  }
513  else
514  {
515  Werror("no example for %s", str);
516  }
517  }
518 }
int status int fd
Definition: si_signals.h:59
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define MAXPATHLEN
Definition: omRet2Info.c:22
static char * iiGetLibName(const procinfov pi)
find the library of an proc
Definition: ipshell.h:66
#define Print
Definition: emacs.cc:80
static char * feResource(feResourceConfig config, int warn)
Definition: feResource.cc:258
#define IDROOT
Definition: ipid.h:18
void * ADDRESS
Definition: auxiliary.h:133
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: idrec.h:34
int myynest
Definition: febase.cc:41
#define IDTYP(a)
Definition: ipid.h:114
#define omFree(addr)
Definition: omAllocDecl.h:261
#define assume(x)
Definition: mod2.h:390
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:698
#define IDPROC(a)
Definition: ipid.h:135
#define SEEK_END
Definition: mod2.h:112
#define NULL
Definition: omList.c:12
static BOOLEAN length(leftv result, leftv arg)
Definition: interval.cc:263
#define SEEK_SET
Definition: mod2.h:116
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:191
static Poly * h
Definition: janet.cc:971
void Werror(const char *fmt,...)
Definition: reporter.cc:189
int si_echo
Definition: febase.cc:35

◆ singular_system()

leftv singular_system ( sleftv  h)

◆ spaddProc()

BOOLEAN spaddProc ( leftv  ,
leftv  ,
leftv   
)

Definition at line 4402 of file ipshell.cc.

4403 {
4404  semicState state;
4405 
4406  // -----------------
4407  // check arguments
4408  // -----------------
4409 
4410  lists l1 = (lists)first->Data( );
4411  lists l2 = (lists)second->Data( );
4412 
4413  if( (state=list_is_spectrum( l1 )) != semicOK )
4414  {
4415  WerrorS( "first argument is not a spectrum:" );
4416  list_error( state );
4417  }
4418  else if( (state=list_is_spectrum( l2 )) != semicOK )
4419  {
4420  WerrorS( "second argument is not a spectrum:" );
4421  list_error( state );
4422  }
4423  else
4424  {
4425  spectrum s1= spectrumFromList ( l1 );
4426  spectrum s2= spectrumFromList ( l2 );
4427  spectrum sum( s1+s2 );
4428 
4429  result->rtyp = LIST_CMD;
4430  result->data = (char*)(getList(sum));
4431  }
4432 
4433  return (state!=semicOK);
4434 }
Definition: lists.h:23
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3358
void list_error(semicState state)
Definition: ipshell.cc:3442
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
lists getList(spectrum &spec)
Definition: ipshell.cc:3370
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4227
semicState
Definition: ipshell.cc:3408
slists * lists
Definition: mpr_numeric.h:146
Definition: tok.h:118
return result
Definition: facAbsBiFact.cc:76

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv  ,
leftv   
)

Definition at line 4158 of file ipshell.cc.

4159 {
4160  spectrumState state = spectrumOK;
4161 
4162  // -------------------
4163  // check consistency
4164  // -------------------
4165 
4166  // check for a local polynomial ring
4167 
4168  if( currRing->OrdSgn != -1 )
4169  // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4170  // or should we use:
4171  //if( !ringIsLocal( ) )
4172  {
4173  WerrorS( "only works for local orderings" );
4174  state = spectrumWrongRing;
4175  }
4176  else if( currRing->qideal != NULL )
4177  {
4178  WerrorS( "does not work in quotient rings" );
4179  state = spectrumWrongRing;
4180  }
4181  else
4182  {
4183  lists L = (lists)NULL;
4184  int flag = 2; // symmetric optimization
4185 
4186  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4187 
4188  if( state==spectrumOK )
4189  {
4190  result->rtyp = LIST_CMD;
4191  result->data = (char*)L;
4192  }
4193  else
4194  {
4195  spectrumPrintError(state);
4196  }
4197  }
4198 
4199  return (state!=spectrumOK);
4200 }
spectrumState
Definition: ipshell.cc:3524
Definition: lists.h:23
void WerrorS(const char *s)
Definition: feFopen.cc:24
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:4076
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3784
#define NULL
Definition: omList.c:12
slists * lists
Definition: mpr_numeric.h:146
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
Definition: tok.h:118
return result
Definition: facAbsBiFact.cc:76

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  ,
leftv   
)

Definition at line 4107 of file ipshell.cc.

4108 {
4109  spectrumState state = spectrumOK;
4110 
4111  // -------------------
4112  // check consistency
4113  // -------------------
4114 
4115  // check for a local ring
4116 
4117  if( !ringIsLocal(currRing ) )
4118  {
4119  WerrorS( "only works for local orderings" );
4120  state = spectrumWrongRing;
4121  }
4122 
4123  // no quotient rings are allowed
4124 
4125  else if( currRing->qideal != NULL )
4126  {
4127  WerrorS( "does not work in quotient rings" );
4128  state = spectrumWrongRing;
4129  }
4130  else
4131  {
4132  lists L = (lists)NULL;
4133  int flag = 1; // weight corner optimization is safe
4134 
4135  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4136 
4137  if( state==spectrumOK )
4138  {
4139  result->rtyp = LIST_CMD;
4140  result->data = (char*)L;
4141  }
4142  else
4143  {
4144  spectrumPrintError(state);
4145  }
4146  }
4147 
4148  return (state!=spectrumOK);
4149 }
spectrumState
Definition: ipshell.cc:3524
Definition: lists.h:23
void WerrorS(const char *s)
Definition: feFopen.cc:24
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:4076
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3784
#define NULL
Definition: omList.c:12
slists * lists
Definition: mpr_numeric.h:146
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
Definition: tok.h:118
BOOLEAN ringIsLocal(const ring r)
Definition: spectrum.cc:461
return result
Definition: facAbsBiFact.cc:76

◆ spmulProc()

BOOLEAN spmulProc ( leftv  ,
leftv  ,
leftv   
)

Definition at line 4444 of file ipshell.cc.

4445 {
4446  semicState state;
4447 
4448  // -----------------
4449  // check arguments
4450  // -----------------
4451 
4452  lists l = (lists)first->Data( );
4453  int k = (int)(long)second->Data( );
4454 
4455  if( (state=list_is_spectrum( l ))!=semicOK )
4456  {
4457  WerrorS( "first argument is not a spectrum" );
4458  list_error( state );
4459  }
4460  else if( k < 0 )
4461  {
4462  WerrorS( "second argument should be positive" );
4463  state = semicMulNegative;
4464  }
4465  else
4466  {
4467  spectrum s= spectrumFromList( l );
4468  spectrum product( k*s );
4469 
4470  result->rtyp = LIST_CMD;
4471  result->data = (char*)getList(product);
4472  }
4473 
4474  return (state!=semicOK);
4475 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Definition: lists.h:23
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3358
void list_error(semicState state)
Definition: ipshell.cc:3442
void WerrorS(const char *s)
Definition: feFopen.cc:24
int k
Definition: cfEzgcd.cc:92
Definition: semic.h:63
lists getList(spectrum &spec)
Definition: ipshell.cc:3370
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4227
semicState
Definition: ipshell.cc:3408
slists * lists
Definition: mpr_numeric.h:146
Definition: tok.h:118
return result
Definition: facAbsBiFact.cc:76
int l
Definition: cfEzgcd.cc:93

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3146 of file ipshell.cc.

3147 {
3148  sleftv tmp;
3149  memset(&tmp,0,sizeof(tmp));
3150  tmp.rtyp=INT_CMD;
3151  tmp.data=(void *)1;
3152  return syBetti2(res,u,&tmp);
3153 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:82
Definition: tok.h:96
void * data
Definition: subexpr.h:88
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3123
int rtyp
Definition: subexpr.h:91

◆ syBetti2()

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

Definition at line 3123 of file ipshell.cc.

3124 {
3125  syStrategy syzstr=(syStrategy)u->Data();
3126 
3127  BOOLEAN minim=(int)(long)w->Data();
3128  int row_shift=0;
3129  int add_row_shift=0;
3130  intvec *weights=NULL;
3131  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3132  if (ww!=NULL)
3133  {
3134  weights=ivCopy(ww);
3135  add_row_shift = ww->min_in();
3136  (*weights) -= add_row_shift;
3137  }
3138 
3139  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3140  //row_shift += add_row_shift;
3141  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3142  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3143 
3144  return FALSE;
3145 }
Definition: tok.h:96
#define FALSE
Definition: auxiliary.h:94
intvec * ivCopy(const intvec *o)
Definition: intvec.h:135
int min_in()
Definition: intvec.h:121
void * data
Definition: subexpr.h:88
Definition: intvec.h:19
void atSet(idhdl root, char *name, void *data, int typ)
Definition: attrib.cc:150
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:129
#define NULL
Definition: omList.c:12
intvec * syBettiOfComputation(syStrategy syzstr, BOOLEAN minim=TRUE, int *row_shift=NULL, intvec *weights=NULL)
Definition: syz1.cc:1755
void * Data()
Definition: subexpr.cc:1176
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 3230 of file ipshell.cc.

3231 {
3232  int typ0;
3234 
3235  resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3236  if (fr != NULL)
3237  {
3238 
3239  result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3240  for (int i=result->length-1;i>=0;i--)
3241  {
3242  if (fr[i]!=NULL)
3243  result->fullres[i] = idCopy(fr[i]);
3244  }
3245  result->list_length=result->length;
3246  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3247  }
3248  else
3249  {
3250  omFreeSize(result, sizeof(ssyStrategy));
3251  result = NULL;
3252  }
3253  return result;
3254 }
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:315
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:133
int i
Definition: cfEzgcd.cc:125
resolvente fullres
Definition: syz.h:57
ideal idCopy(ideal A)
Definition: ideals.h:60
#define NULL
Definition: omList.c:12
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 3158 of file ipshell.cc.

3159 {
3160  resolvente fullres = syzstr->fullres;
3161  resolvente minres = syzstr->minres;
3162 
3163  const int length = syzstr->length;
3164 
3165  if ((fullres==NULL) && (minres==NULL))
3166  {
3167  if (syzstr->hilb_coeffs==NULL)
3168  { // La Scala
3169  fullres = syReorder(syzstr->res, length, syzstr);
3170  }
3171  else
3172  { // HRES
3173  minres = syReorder(syzstr->orderedRes, length, syzstr);
3174  syKillEmptyEntres(minres, length);
3175  }
3176  }
3177 
3178  resolvente tr;
3179  int typ0=IDEAL_CMD;
3180 
3181  if (minres!=NULL)
3182  tr = minres;
3183  else
3184  tr = fullres;
3185 
3186  resolvente trueres=NULL;
3187  intvec ** w=NULL;
3188 
3189  if (length>0)
3190  {
3191  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3192  for (int i=length-1;i>=0;i--)
3193  {
3194  if (tr[i]!=NULL)
3195  {
3196  trueres[i] = idCopy(tr[i]);
3197  }
3198  }
3199  if ( id_RankFreeModule(trueres[0], currRing) > 0)
3200  typ0 = MODUL_CMD;
3201  if (syzstr->weights!=NULL)
3202  {
3203  w = (intvec**)omAlloc0(length*sizeof(intvec*));
3204  for (int i=length-1;i>=0;i--)
3205  {
3206  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3207  }
3208  }
3209  }
3210 
3211  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3212  w, add_row_shift);
3213 
3214  if (toDel)
3215  syKillComputation(syzstr);
3216  else
3217  {
3218  if( fullres != NULL && syzstr->fullres == NULL )
3219  syzstr->fullres = fullres;
3220 
3221  if( minres != NULL && syzstr->minres == NULL )
3222  syzstr->minres = minres;
3223  }
3224  return li;
3225 }
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:1641
Definition: lists.h:23
intvec * ivCopy(const intvec *o)
Definition: intvec.h:135
resolvente res
Definition: syz.h:47
intvec ** hilb_coeffs
Definition: syz.h:46
resolvente orderedRes
Definition: syz.h:48
Definition: intvec.h:19
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:125
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:12
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:216
static BOOLEAN length(leftv result, leftv arg)
Definition: interval.cc:263
const CanonicalForm & w
Definition: facAbsFact.cc:55
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
short list_length
Definition: syz.h:62
ideal * resolvente
Definition: ideals.h:18
void syKillEmptyEntres(resolvente res, int length)
Definition: syz1.cc:2200
void syKillComputation(syStrategy syzstr, ring r=currRing)
Definition: syz1.cc:1495
#define omAlloc0(size)
Definition: omAllocDecl.h:211

◆ syForceMin()

syStrategy syForceMin ( lists  li)

Definition at line 3259 of file ipshell.cc.

3260 {
3261  int typ0;
3263 
3264  resolvente fr = liFindRes(li,&(result->length),&typ0);
3265  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3266  for (int i=result->length-1;i>=0;i--)
3267  {
3268  if (fr[i]!=NULL)
3269  result->minres[i] = idCopy(fr[i]);
3270  }
3271  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3272  return result;
3273 }
int length
Definition: syz.h:60
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:315
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:133
int i
Definition: cfEzgcd.cc:125
ideal idCopy(ideal A)
Definition: ideals.h:60
resolvente minres
Definition: syz.h:58
#define NULL
Definition: omList.c:12
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 509 of file ipshell.cc.

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

◆ Tok2Cmdname()

const char* Tok2Cmdname ( int  i)

Definition at line 140 of file gentable.cc.

141 {
142  if (tok < 0)
143  {
144  return cmds[0].name;
145  }
146  if (tok==COMMAND) return "command";
147  if (tok==ANY_TYPE) return "any_type";
148  if (tok==NONE) return "nothing";
149  //if (tok==IFBREAK) return "if_break";
150  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
151  //if (tok==ORDER_VECTOR) return "ordering";
152  //if (tok==REF_VAR) return "ref";
153  //if (tok==OBJECT) return "object";
154  //if (tok==PRINT_EXPR) return "print_expr";
155  if (tok==IDHDL) return "identifier";
156  // we do not blackbox objects during table generation:
157  //if (tok>MAX_TOK) return getBlackboxName(tok);
158  int i = 0;
159  while (cmds[i].tokval!=0)
160  {
161  if ((cmds[i].tokval == tok)&&(cmds[i].alias==0))
162  {
163  return cmds[i].name;
164  }
165  i++;
166  }
167  i=0;// try again for old/alias names:
168  while (cmds[i].tokval!=0)
169  {
170  if (cmds[i].tokval == tok)
171  {
172  return cmds[i].name;
173  }
174  i++;
175  }
176  #if 0
177  char *s=(char*)malloc(10);
178  sprintf(s,"(%d)",tok);
179  return s;
180  #else
181  return cmds[0].name;
182  #endif
183 }
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:125
cmdnames cmds[]
Definition: table.h:969
#define NONE
Definition: tok.h:219
#define COMMAND
Definition: tok.h:29

◆ type_cmd()

void type_cmd ( leftv  v)

Definition at line 249 of file ipshell.cc.

250 {
251  BOOLEAN oldShortOut = FALSE;
252 
253  if (currRing != NULL)
254  {
255  oldShortOut = currRing->ShortOut;
256  currRing->ShortOut = 1;
257  }
258  int t=v->Typ();
259  Print("// %s %s ",v->Name(),Tok2Cmdname(t));
260  switch (t)
261  {
262  case MAP_CMD:Print(" from %s\n",((map)(v->Data()))->preimage); break;
263  case INTMAT_CMD: Print(" %d x %d\n",((intvec*)(v->Data()))->rows(),
264  ((intvec*)(v->Data()))->cols()); break;
265  case MATRIX_CMD:Print(" %u x %u\n" ,
266  MATROWS((matrix)(v->Data())),
267  MATCOLS((matrix)(v->Data())));break;
268  case MODUL_CMD: Print(", rk %d\n", (int)(((ideal)(v->Data()))->rank));break;
269  case LIST_CMD: Print(", size %d\n",((lists)(v->Data()))->nr+1); break;
270 
271  case PROC_CMD:
272  case RING_CMD:
273  case IDEAL_CMD: PrintLn(); break;
274 
275  //case INT_CMD:
276  //case STRING_CMD:
277  //case INTVEC_CMD:
278  //case POLY_CMD:
279  //case VECTOR_CMD:
280  //case PACKAGE_CMD:
281 
282  default:
283  break;
284  }
285  v->Print();
286  if (currRing != NULL)
287  currRing->ShortOut = oldShortOut;
288 }
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:80
Definition: lists.h:23
#define FALSE
Definition: auxiliary.h:94
int Typ()
Definition: subexpr.cc:1033
const char * Name()
Definition: subexpr.h:120
void Print(leftv store=NULL, int spaces=0)
Called by type_cmd (e.g. "r;") or as default in jPRINT.
Definition: subexpr.cc:63
Definition: intvec.h:19
#define MATCOLS(i)
Definition: matpol.h:27
#define NULL
Definition: omList.c:12
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void * Data()
Definition: subexpr.cc:1176
Definition: tok.h:118
#define MATROWS(i)
Definition: matpol.h:26
int BOOLEAN
Definition: auxiliary.h:85

◆ versionString()

char* versionString ( )

Definition at line 784 of file misc_ip.cc.

785 {
786  StringSetS("");
787  StringAppend("Singular for %s version %s (%d, %d bit) %s #%s",
788  S_UNAME, VERSION, // SINGULAR_VERSION,
789  SINGULAR_VERSION, sizeof(void*)*8,
790 #ifdef MAKE_DISTRIBUTION
791  VERSION_DATE, GIT_VERSION);
792 #else
793  singular_date, GIT_VERSION);
794 #endif
795  StringAppendS("\nwith\n\t");
796 
797 #if defined(mpir_version)
798  StringAppend("MPIR(%s)~GMP(%s),", mpir_version, gmp_version);
799 #elif defined(gmp_version)
800  // #if defined (__GNU_MP_VERSION) && defined (__GNU_MP_VERSION_MINOR)
801  // StringAppend("GMP(%d.%d),",__GNU_MP_VERSION,__GNU_MP_VERSION_MINOR);
802  StringAppend("GMP(%s),", gmp_version);
803 #endif
804 #ifdef HAVE_NTL
805  StringAppend("NTL(%s),",NTL_VERSION);
806 #endif
807 
808 #ifdef HAVE_FLINT
809  StringAppend("FLINT(%s),",version);
810 #endif
811  StringAppendS("factory(" FACTORYVERSION "),\n\t");
812 #ifndef HAVE_OMALLOC
813  StringAppendS("xalloc,");
814 #else
815  StringAppendS("omalloc,");
816 #endif
817 #if defined(HAVE_DYN_RL)
819  StringAppendS("no input,");
820  else if (fe_fgets_stdin==fe_fgets)
821  StringAppendS("fgets,");
823  StringAppend("dynamic readline%d),",RL_VERSION_MAJOR);
824  #ifdef HAVE_FEREAD
826  StringAppendS("emulated readline,");
827  #endif
828  else
829  StringAppendS("unknown fgets method,");
830 #else
831  #if defined(HAVE_READLINE) && !defined(FEREAD)
832  StringAppend("static readline(%d),",RL_VERSION_MAJOR);
833  #else
834  #ifdef HAVE_FEREAD
835  StringAppendS("emulated readline,");
836  #else
837  StringAppendS("fgets,");
838  #endif
839  #endif
840 #endif
841 #ifdef HAVE_PLURAL
842  StringAppendS("Plural,");
843 #endif
844 #ifdef HAVE_DBM
845  StringAppendS("DBM,\n\t");
846 #else
847  StringAppendS("\n\t");
848 #endif
849 #ifdef HAVE_DYNAMIC_LOADING
850  StringAppendS("dynamic modules,");
851 #endif
852  if (p_procs_dynamic) StringAppendS("dynamic p_Procs,");
853 #if YYDEBUG
854  StringAppendS("YYDEBUG=1,");
855 #endif
856 #ifdef MDEBUG
857  StringAppend("MDEBUG=%d,",MDEBUG);
858 #endif
859 #ifdef OM_CHECK
860  StringAppend("OM_CHECK=%d,",OM_CHECK);
861 #endif
862 #ifdef OM_TRACK
863  StringAppend("OM_TRACK=%d,",OM_TRACK);
864 #endif
865 #ifdef OM_NDEBUG
866  StringAppendS("OM_NDEBUG,");
867 #endif
868 #ifdef SING_NDEBUG
869  StringAppendS("SING_NDEBUG,");
870 #endif
871 #ifdef PDEBUG
872  StringAppendS("PDEBUG,");
873 #endif
874 #ifdef KDEBUG
875  StringAppendS("KDEBUG,");
876 #endif
877  StringAppendS("\n\t");
878 #ifdef __OPTIMIZE__
879  StringAppendS("CC:OPTIMIZE,");
880 #endif
881 #ifdef __OPTIMIZE_SIZE__
882  StringAppendS("CC:OPTIMIZE_SIZE,");
883 #endif
884 #ifdef __NO_INLINE__
885  StringAppendS("CC:NO_INLINE,");
886 #endif
887 #ifdef HAVE_GENERIC_ADD
888  StringAppendS("GenericAdd,");
889 #else
890  StringAppendS("AvoidBranching,");
891 #endif
892 #ifdef HAVE_GENERIC_MULT
893  StringAppendS("GenericMult,");
894 #else
895  StringAppendS("TableMult,");
896 #endif
897 #ifdef HAVE_INVTABLE
898  StringAppendS("invTable,");
899 #else
900  StringAppendS("no invTable,");
901 #endif
902  StringAppendS("\n\t");
903 #ifdef HAVE_EIGENVAL
904  StringAppendS("eigenvalues,");
905 #endif
906 #ifdef HAVE_GMS
907  StringAppendS("Gauss-Manin system,");
908 #endif
909 #ifdef HAVE_RATGRING
910  StringAppendS("ratGB,");
911 #endif
912  StringAppend("random=%d\n",siRandomStart);
913 
914 #define SI_SHOW_BUILTIN_MODULE(name) StringAppend(" %s", #name);
915  StringAppendS("built-in modules: {");
917  StringAppendS("}\n");
918 #undef SI_SHOW_BUILTIN_MODULE
919 
920  StringAppend("AC_CONFIGURE_ARGS = %s,\n"
921  "CC = %s,FLAGS : %s,\n"
922  "CXX = %s,FLAGS : %s,\n"
923  "DEFS : %s,CPPFLAGS : %s,\n"
924  "LDFLAGS : %s,LIBS : %s "
925 #ifdef __GNUC__
926  "(ver: " __VERSION__ ")"
927 #endif
928  "\n",AC_CONFIGURE_ARGS, CC,CFLAGS " " PTHREAD_CFLAGS,
929  CXX,CXXFLAGS " " PTHREAD_CFLAGS, DEFS,CPPFLAGS, LDFLAGS,
930  LIBS " " PTHREAD_LIBS);
933  StringAppendS("\n");
934  return StringEndS();
935 }
#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:88
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:96
char * StringEndS()
Definition: reporter.cc:151
void feStringAppendBrowsers(int warn)
Definition: fehelp.cc:340
#define FACTORYVERSION
Definition: factoryconf.h:52
#define MDEBUG
Definition: mod2.h:181
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:79
#define version
Definition: libparse.cc:1260
#define OM_TRACK
Definition: omalloc_debug.c:10
#define VERSION
Definition: mod2.h:18
const char * singular_date
Definition: misc_ip.cc:781
#define SI_SHOW_BUILTIN_MODULE(name)
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 37 of file table.h.

◆ dArith2

const struct sValCmd2 dArith2[]

Definition at line 316 of file table.h.

◆ dArith3

const struct sValCmd3 dArith3[]

Definition at line 768 of file table.h.

◆ dArithM

const struct sValCmdM dArithM[]

Definition at line 890 of file table.h.

◆ iiCurrArgs

leftv iiCurrArgs

Definition at line 76 of file ipshell.cc.

◆ iiCurrProc

idhdl iiCurrProc

Definition at line 77 of file ipshell.cc.

◆ iiLocalRing

ring* iiLocalRing

Definition at line 453 of file iplib.cc.

◆ iiOp

int iiOp

Definition at line 216 of file iparith.cc.

◆ iiRETURNEXPR

sleftv iiRETURNEXPR

Definition at line 454 of file iplib.cc.

◆ iiRETURNEXPR_len

int iiRETURNEXPR_len

Definition at line 455 of file iplib.cc.

◆ lastreserved

const char* lastreserved

Definition at line 78 of file ipshell.cc.

◆ myynest

int myynest

Definition at line 41 of file febase.cc.

◆ printlevel

int printlevel

Definition at line 36 of file febase.cc.

◆ si_echo

int si_echo

Definition at line 35 of file febase.cc.

◆ yyInRingConstruction

BOOLEAN yyInRingConstruction

Definition at line 172 of file grammar.cc.