My Project  debian-1:4.1.1-p2+ds-4build4
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)
 

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 76 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 67 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 84 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 94 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 102 of file gentable.cc.

Data Fields
short arg
int p
proc1 p
short res

◆ sValAssign

struct sValAssign

Definition at line 109 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 544 of file ipshell.cc.

545 {
546  int rc = 0;
547  while (v!=NULL)
548  {
549  switch (v->Typ())
550  {
551  case INT_CMD:
552  case POLY_CMD:
553  case VECTOR_CMD:
554  case NUMBER_CMD:
555  rc++;
556  break;
557  case INTVEC_CMD:
558  case INTMAT_CMD:
559  rc += ((intvec *)(v->Data()))->length();
560  break;
561  case MATRIX_CMD:
562  case IDEAL_CMD:
563  case MODUL_CMD:
564  {
565  matrix mm = (matrix)(v->Data());
566  rc += mm->rows() * mm->cols();
567  }
568  break;
569  case LIST_CMD:
570  rc+=((lists)v->Data())->nr+1;
571  break;
572  default:
573  rc++;
574  }
575  v = v->next;
576  }
577  return rc;
578 }
Variable next() const
Definition: factory.h:137
Definition: intvec.h:21
int & rows()
Definition: matpol.h:23
int & cols()
Definition: matpol.h:24
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
@ IDEAL_CMD
Definition: grammar.cc:283
@ MATRIX_CMD
Definition: grammar.cc:285
@ INTMAT_CMD
Definition: grammar.cc:279
@ MODUL_CMD
Definition: grammar.cc:286
@ VECTOR_CMD
Definition: grammar.cc:290
@ NUMBER_CMD
Definition: grammar.cc:287
@ POLY_CMD
Definition: grammar.cc:288
ip_smatrix * matrix
Definition: matpol.h:31
slists * lists
Definition: mpr_numeric.h:146
#define NULL
Definition: omList.c:10
@ LIST_CMD
Definition: tok.h:118
@ INTVEC_CMD
Definition: tok.h:101
@ INT_CMD
Definition: tok.h:96

◆ iiAddCproc()

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

Definition at line 1005 of file iplib.cc.

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

◆ iiAlias()

BOOLEAN iiAlias ( leftv  p)

Definition at line 755 of file ipid.cc.

756 {
757  if (iiCurrArgs==NULL)
758  {
759  Werror("not enough arguments for proc %s",VoiceName());
760  p->CleanUp();
761  return TRUE;
762  }
764  iiCurrArgs=h->next;
765  h->next=NULL;
766  if (h->rtyp!=IDHDL)
767  {
769  h->CleanUp();
771  return res;
772  }
773  if ((h->Typ()!=p->Typ()) &&(p->Typ()!=DEF_CMD))
774  {
775  WerrorS("type mismatch");
776  return TRUE;
777  }
778  idhdl pp=(idhdl)p->data;
779  switch(pp->typ)
780  {
781  case CRING_CMD:
782  nKillChar((coeffs)pp);
783  break;
784  case DEF_CMD:
785  case INT_CMD:
786  break;
787  case INTVEC_CMD:
788  case INTMAT_CMD:
789  delete IDINTVEC(pp);
790  break;
791  case NUMBER_CMD:
792  nDelete(&IDNUMBER(pp));
793  break;
794  case BIGINT_CMD:
796  break;
797  case MAP_CMD:
798  {
799  map im = IDMAP(pp);
800  omFree((ADDRESS)im->preimage);
801  }
802  // continue as ideal:
803  case IDEAL_CMD:
804  case MODUL_CMD:
805  case MATRIX_CMD:
806  idDelete(&IDIDEAL(pp));
807  break;
808  case PROC_CMD:
809  case RESOLUTION_CMD:
810  case STRING_CMD:
812  break;
813  case LIST_CMD:
814  IDLIST(pp)->Clean();
815  break;
816  case LINK_CMD:
818  break;
819  // case ring: cannot happen
820  default:
821  Werror("unknown type %d",p->Typ());
822  return TRUE;
823  }
824  pp->typ=ALIAS_CMD;
825  IDDATA(pp)=(char*)h->data;
826  int eff_typ=h->Typ();
827  if ((RingDependend(eff_typ))
828  || ((eff_typ==LIST_CMD) && (lRingDependend((lists)h->Data()))))
829  {
830  ipSwapId(pp,IDROOT,currRing->idroot);
831  }
832  h->CleanUp();
834  return FALSE;
835 }
int BOOLEAN
Definition: auxiliary.h:85
#define FALSE
Definition: auxiliary.h:94
void * ADDRESS
Definition: auxiliary.h:133
CanonicalForm pp(const CanonicalForm &)
CanonicalForm pp ( const CanonicalForm & f )
Definition: cf_gcd.cc:253
int p
Definition: cfModGcd.cc:4019
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
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: lists.h:23
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete 'p'
Definition: coeffs.h:456
void nKillChar(coeffs r)
undo all initialisations
Definition: numbers.cc:510
CanonicalForm res
Definition: facAbsFact.cc:64
void WerrorS(const char *s)
Definition: feFopen.cc:24
const char * VoiceName()
Definition: fevoices.cc:57
int RingDependend(int t)
Definition: gentable.cc:29
@ MAP_CMD
Definition: grammar.cc:284
@ RESOLUTION_CMD
Definition: grammar.cc:289
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1792
static int ipSwapId(idhdl tomove, idhdl &root1, idhdl &root2)
Definition: ipid.cc:588
coeffs coeffs_BIGINT
Definition: ipid.cc:52
#define IDMAP(a)
Definition: ipid.h:130
#define IDSTRING(a)
Definition: ipid.h:131
#define IDDATA(a)
Definition: ipid.h:121
#define IDINTVEC(a)
Definition: ipid.h:123
#define IDLINK(a)
Definition: ipid.h:133
#define IDIDEAL(a)
Definition: ipid.h:128
omBin sleftv_bin
Definition: subexpr.cc:46
#define IDNUMBER(a)
Definition: ipid.h:127
#define IDLIST(a)
Definition: ipid.h:132
leftv iiCurrArgs
Definition: ipshell.cc:78
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:199
The main handler for Singular numbers which are suitable for Singular polynomials.
#define nDelete(n)
Definition: numbers.h:17
#define omFree(addr)
Definition: omAllocDecl.h:261
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
idrec * idhdl
Definition: ring.h:21
#define IDHDL
Definition: tok.h:31
@ ALIAS_CMD
Definition: tok.h:34
@ BIGINT_CMD
Definition: tok.h:38
@ CRING_CMD
Definition: tok.h:56
@ DEF_CMD
Definition: tok.h:58
@ LINK_CMD
Definition: tok.h:117
@ STRING_CMD
Definition: tok.h:183

◆ iiAllStart()

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

Definition at line 293 of file iplib.cc.

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

◆ iiApply()

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

Definition at line 6364 of file ipshell.cc.

6365 {
6366  memset(res,0,sizeof(sleftv));
6367  res->rtyp=a->Typ();
6368  switch (res->rtyp /*a->Typ()*/)
6369  {
6370  case INTVEC_CMD:
6371  case INTMAT_CMD:
6372  return iiApplyINTVEC(res,a,op,proc);
6373  case BIGINTMAT_CMD:
6374  return iiApplyBIGINTMAT(res,a,op,proc);
6375  case IDEAL_CMD:
6376  case MODUL_CMD:
6377  case MATRIX_CMD:
6378  return iiApplyIDEAL(res,a,op,proc);
6379  case LIST_CMD:
6380  return iiApplyLIST(res,a,op,proc);
6381  }
6382  WerrorS("first argument to `apply` must allow an index");
6383  return TRUE;
6384 }
unsigned char * proc[NUM_PROC]
Definition: checklibs.c:16
int Typ()
Definition: subexpr.cc:992
@ BIGINTMAT_CMD
Definition: grammar.cc:278
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6290
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6332
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6327
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6322

◆ iiARROW()

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

Definition at line 6413 of file ipshell.cc.

6414 {
6415  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6416  // find end of s:
6417  int end_s=strlen(s);
6418  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6419  s[end_s+1]='\0';
6420  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6421  sprintf(name,"%s->%s",a,s);
6422  // find start of last expression
6423  int start_s=end_s-1;
6424  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6425  if (start_s<0) // ';' not found
6426  {
6427  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6428  }
6429  else // s[start_s] is ';'
6430  {
6431  s[start_s]='\0';
6432  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6433  }
6434  memset(r,0,sizeof(*r));
6435  // now produce procinfo for PROC_CMD:
6436  r->data = (void *)omAlloc0Bin(procinfo_bin);
6437  ((procinfo *)(r->data))->language=LANG_NONE;
6438  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6439  ((procinfo *)r->data)->data.s.body=ss;
6440  omFree(name);
6441  r->rtyp=PROC_CMD;
6442  //r->rtyp=STRING_CMD;
6443  //r->data=ss;
6444  return FALSE;
6445 }
void * data
Definition: subexpr.h:88
const CanonicalForm int s
Definition: facAbsFact.cc:55
procinfo * iiInitSingularProcinfo(procinfov pi, const char *libname, const char *procname, int, long pos, BOOLEAN pstatic)
Definition: iplib.cc:991
#define omAlloc(size)
Definition: omAllocDecl.h:210
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
omBin procinfo_bin
Definition: subexpr.cc:47

◆ iiAssign()

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

Definition at line 1792 of file ipassign.cc.

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

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6447 of file ipshell.cc.

6448 {
6449  char* ring_name=omStrDup((char*)r->Name());
6450  int t=arg->Typ();
6451  if (t==RING_CMD)
6452  {
6453  sleftv tmp;
6454  memset(&tmp,0,sizeof(tmp));
6455  tmp.rtyp=IDHDL;
6456  tmp.data=(char*)rDefault(ring_name);
6457  if (tmp.data!=NULL)
6458  {
6459  BOOLEAN b=iiAssign(&tmp,arg);
6460  if (b) return TRUE;
6461  rSetHdl(ggetid(ring_name));
6462  omFree(ring_name);
6463  return FALSE;
6464  }
6465  else
6466  return TRUE;
6467  }
6468  else if (t==CRING_CMD)
6469  {
6470  sleftv tmp;
6471  sleftv n;
6472  memset(&n,0,sizeof(n));
6473  n.name=ring_name;
6474  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6475  if (iiAssign(&tmp,arg)) return TRUE;
6476  //Print("create %s\n",r->Name());
6477  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6478  return FALSE;
6479  }
6480  //Print("create %s\n",r->Name());
6481  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6482  return TRUE;// not handled -> error for now
6483 }
const char * name
Definition: subexpr.h:87
const char * Name()
Definition: subexpr.h:120
int myynest
Definition: febase.cc:41
idhdl ggetid(const char *n)
Definition: ipid.cc:513
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition: ipshell.cc:1122
idhdl rDefault(const char *s)
Definition: ipshell.cc:1550
void rSetHdl(idhdl h)
Definition: ipshell.cc:5050

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  r,
leftv  args 
)

Definition at line 1179 of file ipshell.cc.

1180 {
1181  // must be inside a proc, as we simultae an proc_end at the end
1182  if (myynest==0)
1183  {
1184  WerrorS("branchTo can only occur in a proc");
1185  return TRUE;
1186  }
1187  // <string1...stringN>,<proc>
1188  // known: args!=NULL, l>=1
1189  int l=args->listLength();
1190  int ll=0;
1191  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1192  if (ll!=(l-1)) return FALSE;
1193  leftv h=args;
1194  // set up the table for type test:
1195  short *t=(short*)omAlloc(l*sizeof(short));
1196  t[0]=l-1;
1197  int b;
1198  int i;
1199  for(i=1;i<l;i++,h=h->next)
1200  {
1201  if (h->Typ()!=STRING_CMD)
1202  {
1203  omFree(t);
1204  Werror("arg %d is not a string",i);
1205  return TRUE;
1206  }
1207  int tt;
1208  b=IsCmd((char *)h->Data(),tt);
1209  if(b) t[i]=tt;
1210  else
1211  {
1212  omFree(t);
1213  Werror("arg %d is not a type name",i);
1214  return TRUE;
1215  }
1216  }
1217  if (h->Typ()!=PROC_CMD)
1218  {
1219  omFree(t);
1220  Werror("last(%d.) arg.(%s) is not a proc(but %s(%d)), nesting=%d",
1221  i,h->name,Tok2Cmdname(h->Typ()),h->Typ(),myynest);
1222  return TRUE;
1223  }
1224  b=iiCheckTypes(iiCurrArgs,t,0);
1225  omFree(t);
1226  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1227  {
1228  // get the proc:
1229  iiCurrProc=(idhdl)h->data;
1231  // already loaded ?
1232  if( pi->data.s.body==NULL )
1233  {
1235  if (pi->data.s.body==NULL) return TRUE;
1236  }
1237  // set currPackHdl/currPack
1238  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1239  {
1240  currPack=pi->pack;
1243  //Print("set pack=%s\n",IDID(currPackHdl));
1244  }
1245  // see iiAllStart:
1246  BITSET save1=si_opt_1;
1247  BITSET save2=si_opt_2;
1248  newBuffer( omStrDup(pi->data.s.body), BT_proc,
1249  pi, pi->data.s.body_lineno-(iiCurrArgs==NULL) );
1250  BOOLEAN err=yyparse();
1251  si_opt_1=save1;
1252  si_opt_2=save2;
1253  // now save the return-expr.
1255  memcpy(&sLastPrinted,&iiRETURNEXPR,sizeof(sleftv));
1256  iiRETURNEXPR.Init();
1257  // warning about args.:
1258  if (iiCurrArgs!=NULL)
1259  {
1260  if (err==0) Warn("too many arguments for %s",IDID(iiCurrProc));
1261  iiCurrArgs->CleanUp();
1263  iiCurrArgs=NULL;
1264  }
1265  // similate proc_end:
1266  // - leave input
1267  void myychangebuffer();
1268  myychangebuffer();
1269  // - set the current buffer to its end (this is a pointer in a buffer,
1270  // not a file ptr) "branchTo" is only valid in proc)
1272  // - kill local vars
1274  // - return
1275  newBuffer(omStrDup("\n;return(_);\n"),BT_execute);
1276  return (err!=0);
1277  }
1278  return FALSE;
1279 }
char * buffer
Definition: fevoices.h:69
long fptr
Definition: fevoices.h:70
void Init()
Definition: subexpr.h:107
int listLength()
Definition: subexpr.cc:56
Voice * currentVoice
Definition: fevoices.cc:48
@ BT_execute
Definition: fevoices.h:23
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:138
idhdl currPackHdl
Definition: ipid.cc:57
idhdl packFindHdl(package r)
Definition: ipid.cc:742
#define IDID(a)
Definition: ipid.h:117
sleftv iiRETURNEXPR
Definition: iplib.cc:455
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:192
idhdl iiCurrProc
Definition: ipshell.cc:79
void iiCheckPack(package &p)
Definition: ipshell.cc:1536
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:6503
void killlocals(int v)
Definition: ipshell.cc:378
void myychangebuffer()
Definition: scanner.cc:2330

◆ iiCallLibProc1()

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

Definition at line 613 of file iplib.cc.

614 {
615  idhdl h=ggetid(n);
616  if ((h==NULL)
617  || (IDTYP(h)!=PROC_CMD))
618  {
619  err=2;
620  return NULL;
621  }
622  // ring handling
623  idhdl save_ringhdl=currRingHdl;
624  ring save_ring=currRing;
626  // argument:
627  sleftv tmp;
628  tmp.Init();
629  tmp.data=arg;
630  tmp.rtyp=arg_type;
631  // call proc
632  err=iiMake_proc(h,currPack,&tmp);
633  // clean up ring
634  iiCallLibProcEnd(save_ringhdl,save_ring);
635  // return
636  if (err==FALSE)
637  {
638  void*r=iiRETURNEXPR.data;
641  return r;
642  }
643  return NULL;
644 }
idhdl currRingHdl
Definition: ipid.cc:61
static void iiCallLibProcEnd(idhdl save_ringhdl, ring save_ring)
Definition: iplib.cc:588
BOOLEAN iiMake_proc(idhdl pn, package pack, leftv sl)
Definition: iplib.cc:485
static void iiCallLibProcBegin()
Definition: iplib.cc:570

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

648 {
649  idhdl h=ggetid(n);
650  if ((h==NULL)
651  || (IDTYP(h)!=PROC_CMD))
652  {
653  err=2;
654  return NULL;
655  }
656  // ring handling
657  idhdl save_ringhdl=currRingHdl;
658  ring save_ring=currRing;
660  // argument:
661  if (arg_types[0]!=0)
662  {
663  sleftv tmp;
664  leftv tt=&tmp;
665  int i=1;
666  tmp.Init();
667  tmp.data=args[0];
668  tmp.rtyp=arg_types[0];
669  while(arg_types[i]!=0)
670  {
671  tt->next=(leftv)omAlloc0(sizeof(sleftv));
672  tt=tt->next;
673  tt->rtyp=arg_types[i];
674  tt->data=args[i];
675  i++;
676  }
677  // call proc
678  err=iiMake_proc(h,currPack,&tmp);
679  }
680  else
681  // call proc
682  err=iiMake_proc(h,currPack,NULL);
683  // clean up ring
684  iiCallLibProcEnd(save_ringhdl,save_ring);
685  // return
686  if (err==FALSE)
687  {
688  void*r=iiRETURNEXPR.data;
691  return r;
692  }
693  return NULL;
694 }
#define omAlloc0(size)
Definition: omAllocDecl.h:211
sleftv * leftv
Definition: structs.h:60

◆ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1536 of file ipshell.cc.

1537 {
1538  if (p!=basePack)
1539  {
1540  idhdl t=basePack->idroot;
1541  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1542  if (t==NULL)
1543  {
1544  WarnS("package not found\n");
1545  p=basePack;
1546  }
1547  }
1548 }
idhdl next
Definition: idrec.h:38
package basePack
Definition: ipid.cc:60
#define IDPACKAGE(a)
Definition: ipid.h:134
@ PACKAGE_CMD
Definition: tok.h:149

◆ iiCheckRing()

BOOLEAN iiCheckRing ( int  i)

Definition at line 1492 of file ipshell.cc.

1493 {
1494  if (currRing==NULL)
1495  {
1496  #ifdef SIQ
1497  if (siq<=0)
1498  {
1499  #endif
1500  if (RingDependend(i))
1501  {
1502  WerrorS("no ring active");
1503  return TRUE;
1504  }
1505  #ifdef SIQ
1506  }
1507  #endif
1508  }
1509  return FALSE;
1510 }
BOOLEAN siq
Definition: subexpr.cc:53

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

6504 {
6505  int l=0;
6506  if (args==NULL)
6507  {
6508  if (type_list[0]==0) return TRUE;
6509  }
6510  else l=args->listLength();
6511  if (l!=(int)type_list[0])
6512  {
6513  if (report) iiReportTypes(0,l,type_list);
6514  return FALSE;
6515  }
6516  for(int i=1;i<=l;i++,args=args->next)
6517  {
6518  short t=type_list[i];
6519  if (t!=ANY_TYPE)
6520  {
6521  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6522  || (t!=args->Typ()))
6523  {
6524  if (report) iiReportTypes(i,args->Typ(),type_list);
6525  return FALSE;
6526  }
6527  }
6528  }
6529  return TRUE;
6530 }
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6485
#define ANY_TYPE
Definition: tok.h:30

◆ 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 }
#define DIR_SEP
Definition: feResource.h:6
char mytoupper(char c)
Definition: iplib.cc:1312

◆ iiDebug()

void iiDebug ( )

Definition at line 984 of file ipshell.cc.

985 {
986 #ifdef HAVE_SDB
987  sdb_flags=1;
988 #endif
989  Print("\n-- break point in %s --\n",VoiceName());
991  char * s;
993  s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
994  loop
995  {
996  memset(s,0,80);
998  if (s[BREAK_LINE_LENGTH-1]!='\0')
999  {
1000  Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
1001  }
1002  else
1003  break;
1004  }
1005  if (*s=='\n')
1006  {
1008  }
1009 #if MDEBUG
1010  else if(strncmp(s,"cont;",5)==0)
1011  {
1013  }
1014 #endif /* MDEBUG */
1015  else
1016  {
1017  strcat( s, "\n;~\n");
1019  }
1020 }
char *(* fe_fgets_stdin)(const char *pr, char *s, int size)
Definition: feread.cc:34
void VoiceBackTrack()
Definition: fevoices.cc:68
BOOLEAN iiDebugMarker
Definition: ipshell.cc:982
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:983
int sdb_flags
Definition: sdb.cc:32

◆ iiDeclCommand()

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

Definition at line 1122 of file ipshell.cc.

1123 {
1124  BOOLEAN res=FALSE;
1125  const char *id = name->name;
1126 
1127  memset(sy,0,sizeof(sleftv));
1128  if ((name->name==NULL)||(isdigit(name->name[0])))
1129  {
1130  WerrorS("object to declare is not a name");
1131  res=TRUE;
1132  }
1133  else
1134  {
1135  if (t==QRING_CMD) t=RING_CMD; // qring is always RING_CMD
1136 
1137  if (TEST_V_ALLWARN
1138  && (name->rtyp!=0)
1139  && (name->rtyp!=IDHDL)
1140  && (currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1141  {
1142  Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1144  }
1145  {
1146  sy->data = (char *)enterid(id,lev,t,root,init_b);
1147  }
1148  if (sy->data!=NULL)
1149  {
1150  sy->rtyp=IDHDL;
1151  currid=sy->name=IDID((idhdl)sy->data);
1152  // name->name=NULL; /* used in enterid */
1153  //sy->e = NULL;
1154  if (name->next!=NULL)
1155  {
1157  res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1158  }
1159  }
1160  else res=TRUE;
1161  }
1162  name->CleanUp();
1163  return res;
1164 }
char * filename
Definition: fevoices.h:63
int yylineno
Definition: febase.cc:40
char my_yylinebuf[80]
Definition: febase.cc:43
const char * currid
Definition: grammar.cc:171
#define IDLEV(a)
Definition: ipid.h:116
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
@ QRING_CMD
Definition: tok.h:158

◆ iiEStart()

BOOLEAN iiEStart ( char *  example,
procinfo pi 
)

Definition at line 699 of file iplib.cc.

700 {
701  BOOLEAN err;
702  int old_echo=si_echo;
703 
704  iiCheckNest();
705  procstack->push(example);
708  {
709  if (traceit&TRACE_SHOW_LINENO) printf("\n");
710  printf("entering example (level %d)\n",myynest);
711  }
712  myynest++;
713 
714  err=iiAllStart(pi,example,BT_example,(pi != NULL ? pi->data.s.example_lineno: 0));
715 
717  myynest--;
718  si_echo=old_echo;
720  {
721  if (traceit&TRACE_SHOW_LINENO) printf("\n");
722  printf("leaving -example- (level %d)\n",myynest);
723  }
724  if (iiLocalRing[myynest] != currRing)
725  {
726  if (iiLocalRing[myynest]!=NULL)
727  {
730  }
731  else
732  {
734  currRing=NULL;
735  }
736  }
737  procstack->pop();
738  return err;
739 }
void pop()
Definition: ipid.cc:724
void push(char *)
Definition: ipid.cc:714
int si_echo
Definition: febase.cc:35
@ BT_example
Definition: fevoices.h:21
proclevel * procstack
Definition: ipid.cc:54
ring * iiLocalRing
Definition: iplib.cc:454
BOOLEAN iiAllStart(procinfov pi, char *p, feBufferTypes t, int l)
Definition: iplib.cc:293
static void iiCheckNest()
Definition: iplib.cc:474
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1595
#define TRACE_SHOW_LINENO
Definition: reporter.h:30
#define TRACE_SHOW_PROC
Definition: reporter.h:28

◆ iiExport() [1/2]

BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1414 of file ipshell.cc.

1415 {
1416  BOOLEAN nok=FALSE;
1417  leftv r=v;
1418  while (v!=NULL)
1419  {
1420  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1421  {
1422  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1423  nok=TRUE;
1424  }
1425  else
1426  {
1427  if(iiInternalExport(v, toLev))
1428  {
1429  r->CleanUp();
1430  return TRUE;
1431  }
1432  }
1433  v=v->next;
1434  }
1435  r->CleanUp();
1436  return nok;
1437 }
char name() const
Definition: variable.cc:122
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1316

◆ iiExport() [2/2]

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

Definition at line 1440 of file ipshell.cc.

1441 {
1442 // if ((pack==basePack)&&(pack!=currPack))
1443 // { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
1444  BOOLEAN nok=FALSE;
1445  leftv rv=v;
1446  while (v!=NULL)
1447  {
1448  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
1449  )
1450  {
1451  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1452  nok=TRUE;
1453  }
1454  else
1455  {
1456  idhdl old=pack->idroot->get( v->name,toLev);
1457  if (old!=NULL)
1458  {
1459  if ((pack==currPack) && (old==(idhdl)v->data))
1460  {
1461  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
1462  break;
1463  }
1464  else if (IDTYP(old)==v->Typ())
1465  {
1466  if (BVERBOSE(V_REDEFINE))
1467  {
1468  Warn("redefining %s (%s)",IDID(old),my_yylinebuf);
1469  }
1470  v->name=omStrDup(v->name);
1471  killhdl2(old,&(pack->idroot),currRing);
1472  }
1473  else
1474  {
1475  rv->CleanUp();
1476  return TRUE;
1477  }
1478  }
1479  //Print("iiExport: pack=%s\n",IDID(root));
1480  if(iiInternalExport(v, toLev, pack))
1481  {
1482  rv->CleanUp();
1483  return TRUE;
1484  }
1485  }
1486  v=v->next;
1487  }
1488  rv->CleanUp();
1489  return nok;
1490 }
idhdl get(const char *s, int lev)
Definition: ipid.cc:86
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:407

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

8138 {
8139  memset(res,0,sizeof(sleftv));
8140  BOOLEAN call_failed=FALSE;
8141 
8142  if (!errorreported)
8143  {
8144  BOOLEAN failed=FALSE;
8145  iiOp=op;
8146  int i = 0;
8147  while (dA1[i].cmd==op)
8148  {
8149  if (at==dA1[i].arg)
8150  {
8151  if (currRing!=NULL)
8152  {
8153  if (check_valid(dA1[i].valid_for,op)) break;
8154  }
8155  else
8156  {
8157  if (RingDependend(dA1[i].res))
8158  {
8159  WerrorS("no ring active");
8160  break;
8161  }
8162  }
8163  if (traceit&TRACE_CALL)
8164  Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
8165  res->rtyp=dA1[i].res;
8166  if ((call_failed=dA1[i].p(res,a)))
8167  {
8168  break;// leave loop, goto error handling
8169  }
8170  if (a->Next()!=NULL)
8171  {
8172  res->next=(leftv)omAllocBin(sleftv_bin);
8173  failed=iiExprArith1(res->next,a->next,op);
8174  }
8175  a->CleanUp();
8176  return failed;
8177  }
8178  i++;
8179  }
8180  // implicite type conversion --------------------------------------------
8181  if (dA1[i].cmd!=op)
8182  {
8184  i=0;
8185  //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
8186  while (dA1[i].cmd==op)
8187  {
8188  int ai;
8189  //Print("test %s\n",Tok2Cmdname(dA1[i].arg));
8190  if ((dA1[i].valid_for & NO_CONVERSION)==0)
8191  {
8192  if ((ai=iiTestConvert(at,dA1[i].arg,dConvertTypes))!=0)
8193  {
8194  if (currRing!=NULL)
8195  {
8196  if (check_valid(dA1[i].valid_for,op)) break;
8197  }
8198  else
8199  {
8200  if (RingDependend(dA1[i].res))
8201  {
8202  WerrorS("no ring active");
8203  break;
8204  }
8205  }
8206  if (traceit&TRACE_CALL)
8207  Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(dA1[i].arg));
8208  res->rtyp=dA1[i].res;
8209  failed= ((iiConvert(at,dA1[i].arg,ai,a,an,dConvertTypes))
8210  || (call_failed=dA1[i].p(res,an)));
8211  // everything done, clean up temp. variables
8212  if (failed)
8213  {
8214  // leave loop, goto error handling
8215  break;
8216  }
8217  else
8218  {
8219  if (an->Next() != NULL)
8220  {
8221  res->next = (leftv)omAllocBin(sleftv_bin);
8222  failed=iiExprArith1(res->next,an->next,op);
8223  }
8224  // everything ok, clean up and return
8225  an->CleanUp();
8227  return failed;
8228  }
8229  }
8230  }
8231  i++;
8232  }
8233  an->CleanUp();
8235  }
8236  // error handling
8237  if (!errorreported)
8238  {
8239  if ((at==0) && (a->Fullname()!=sNoName_fe))
8240  {
8241  Werror("`%s` is not defined",a->Fullname());
8242  }
8243  else
8244  {
8245  i=0;
8246  const char *s = iiTwoOps(op);
8247  Werror("%s(`%s`) failed"
8248  ,s,Tok2Cmdname(at));
8249  if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8250  {
8251  while (dA1[i].cmd==op)
8252  {
8253  if ((dA1[i].res!=0)
8254  && (dA1[i].p!=jjWRONG))
8255  Werror("expected %s(`%s`)"
8256  ,s,Tok2Cmdname(dA1[i].arg));
8257  i++;
8258  }
8259  }
8260  }
8261  }
8262  res->rtyp = UNKNOWN;
8263  }
8264  a->CleanUp();
8265  return TRUE;
8266 }
const char * Fullname()
Definition: subexpr.h:125
leftv Next()
Definition: subexpr.h:136
const char sNoName_fe[]
Definition: fevoices.cc:56
const char * iiTwoOps(int t)
Definition: gentable.cc:259
static BOOLEAN jjWRONG(leftv, leftv)
Definition: iparith.cc:3400
const char * Tok2Cmdname(int tok)
Definition: iparith.cc:8803
#define NO_CONVERSION
Definition: iparith.cc:118
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:8267
static BOOLEAN check_valid(const int p, const int op)
Definition: iparith.cc:9083
int iiOp
Definition: iparith.cc:218
short res
Definition: gentable.cc:80
#define V_SHOW_USE
Definition: options.h:52
#define TRACE_CALL
Definition: reporter.h:43
const struct sConvertTypes dConvertTypes[]
Definition: table.h:1207
#define UNKNOWN
Definition: tok.h:219

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

8069 {
8070  leftv b=a->next;
8071  a->next=NULL;
8072  int bt=b->Typ();
8073  BOOLEAN bo=iiExprArith2TabIntern(res,a,op,b,TRUE,dA2,at,bt,dConvertTypes);
8074  a->next=b;
8075  a->CleanUp(); // to clean up the chain, content already done in iiExprArith2TabIntern
8076  return bo;
8077 }
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:7905

◆ iiExprArith3()

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

Definition at line 8480 of file iparith.cc.

8481 {
8482  memset(res,0,sizeof(sleftv));
8483 
8484  if (!errorreported)
8485  {
8486 #ifdef SIQ
8487  if (siq>0)
8488  {
8489  //Print("siq:%d\n",siq);
8491  memcpy(&d->arg1,a,sizeof(sleftv));
8492  a->Init();
8493  memcpy(&d->arg2,b,sizeof(sleftv));
8494  b->Init();
8495  memcpy(&d->arg3,c,sizeof(sleftv));
8496  c->Init();
8497  d->op=op;
8498  d->argc=3;
8499  res->data=(char *)d;
8500  res->rtyp=COMMAND;
8501  return FALSE;
8502  }
8503 #endif
8504  int at=a->Typ();
8505  // handling bb-objects ----------------------------------------------
8506  if (at>MAX_TOK)
8507  {
8508  blackbox *bb=getBlackboxStuff(at);
8509  if (bb!=NULL)
8510  {
8511  if(!bb->blackbox_Op3(op,res,a,b,c)) return FALSE;
8512  // else: no op defined
8513  }
8514  else
8515  return TRUE;
8516  if (errorreported) return TRUE;
8517  }
8518  int bt=b->Typ();
8519  int ct=c->Typ();
8520 
8521  iiOp=op;
8522  int i=0;
8523  while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8524  return iiExprArith3TabIntern(res,op,a,b,c,dArith3+i,at,bt,ct,dConvertTypes);
8525  }
8526  a->CleanUp();
8527  b->CleanUp();
8528  c->CleanUp();
8529  //Print("op: %d,result typ:%d\n",op,res->rtyp);
8530  return TRUE;
8531 }
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:8326
omBin sip_command_bin
Definition: ipid.cc:47
ip_command * command
Definition: ipid.h:22
const struct sValCmd3 dArith3[]
Definition: table.h:726
#define COMMAND
Definition: tok.h:29

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

8536 {
8537  leftv b=a->next;
8538  a->next=NULL;
8539  int bt=b->Typ();
8540  leftv c=b->next;
8541  b->next=NULL;
8542  int ct=c->Typ();
8543  BOOLEAN bo=iiExprArith3TabIntern(res,op,a,b,c,dA3,at,bt,ct,dConvertTypes);
8544  b->next=c;
8545  a->next=b;
8546  a->CleanUp(); // to cleanup the chain, content already done
8547  return bo;
8548 }

◆ 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; }

◆ iiGetLibProcBuffer()

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

◆ iiHighCorner()

poly iiHighCorner ( ideal  i,
int  ak 
)

Definition at line 1512 of file ipshell.cc.

1513 {
1514  int i;
1515  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1516  poly po=NULL;
1518  {
1519  scComputeHC(I,currRing->qideal,ak,po);
1520  if (po!=NULL)
1521  {
1522  pGetCoeff(po)=nInit(1);
1523  for (i=rVar(currRing); i>0; i--)
1524  {
1525  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1526  }
1527  pSetComp(po,ak);
1528  pSetm(po);
1529  }
1530  }
1531  else
1532  po=pOne();
1533  return po;
1534 }
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge, ring tailRing)
Definition: hdegree.cc:1005
static BOOLEAN idIsZeroDim(ideal i)
Definition: ideals.h:178
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy
Definition: monomials.h:51
#define nInit(i)
Definition: numbers.h:25
#define pSetm(p)
Definition: polys.h:257
#define pSetComp(p, v)
Definition: polys.h:38
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
#define pOne()
Definition: polys.h:301
#define pDecrExp(p, i)
Definition: polys.h:44
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:583
BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition: ring.h:752

◆ iiInternalExport()

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

Definition at line 1368 of file ipshell.cc.

1369 {
1370  idhdl h=(idhdl)v->data;
1371  if(h==NULL)
1372  {
1373  Warn("'%s': no such identifier\n", v->name);
1374  return FALSE;
1375  }
1376  package frompack=v->req_packhdl;
1377  if (frompack==NULL) frompack=currPack;
1378  if ((RingDependend(IDTYP(h)))
1379  || ((IDTYP(h)==LIST_CMD)
1380  && (lRingDependend(IDLIST(h)))
1381  )
1382  )
1383  {
1384  //Print("// ==> Ringdependent set nesting to 0\n");
1385  return (iiInternalExport(v, toLev));
1386  }
1387  else
1388  {
1389  IDLEV(h)=toLev;
1390  v->req_packhdl=rootpack;
1391  if (h==frompack->idroot)
1392  {
1393  frompack->idroot=h->next;
1394  }
1395  else
1396  {
1397  idhdl hh=frompack->idroot;
1398  while ((hh!=NULL) && (hh->next!=h))
1399  hh=hh->next;
1400  if ((hh!=NULL) && (hh->next==h))
1401  hh->next=h->next;
1402  else
1403  {
1404  Werror("`%s` not found",v->Name());
1405  return TRUE;
1406  }
1407  }
1408  h->next=rootpack->idroot;
1409  rootpack->idroot=h;
1410  }
1411  return FALSE;
1412 }

◆ iiLibCmd()

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

Definition at line 826 of file iplib.cc.

827 {
828  char libnamebuf[1024];
829  // procinfov pi;
830  // idhdl h;
831  idhdl pl;
832  // idhdl hl;
833  // long pos = 0L;
834  char *plib = iiConvName(newlib);
835  FILE * fp = feFopen( newlib, "r", libnamebuf, tellerror );
836  // int lines = 1;
837  BOOLEAN LoadResult = TRUE;
838 
839  if (fp==NULL)
840  {
841  return TRUE;
842  }
843  pl = basePack->idroot->get(plib,0);
844  if (pl==NULL)
845  {
846  pl = enterid( plib,0, PACKAGE_CMD,
847  &(basePack->idroot), TRUE );
848  IDPACKAGE(pl)->language = LANG_SINGULAR;
849  IDPACKAGE(pl)->libname=omStrDup(newlib);
850  }
851  else
852  {
853  if(IDTYP(pl)!=PACKAGE_CMD)
854  {
855  WarnS("not of type package.");
856  fclose(fp);
857  return TRUE;
858  }
859  if (!force) return FALSE;
860  }
861  LoadResult = iiLoadLIB(fp, libnamebuf, newlib, pl, autoexport, tellerror);
862  omFree((ADDRESS)newlib);
863 
864  if(!LoadResult) IDPACKAGE(pl)->loaded = TRUE;
865  omFree((ADDRESS)plib);
866 
867  return LoadResult;
868 }
CanonicalForm fp
Definition: cfModGcd.cc:4043
FILE * feFopen(const char *path, const char *mode, char *where, short useWerror, short path_only)
Definition: feFopen.cc:47
BOOLEAN iiLoadLIB(FILE *fp, const char *libnamebuf, const char *newlib, idhdl pl, BOOLEAN autoexport, BOOLEAN tellerror)
Definition: iplib.cc:915
char * iiConvName(const char *libname)
Definition: iplib.cc:1331
char libnamebuf[1024]
Definition: libparse.cc:1096

◆ iiLoadLIB()

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

Definition at line 915 of file iplib.cc.

917 {
918  extern FILE *yylpin;
919  libstackv ls_start = library_stack;
920  lib_style_types lib_style;
921 
922  yylpin = fp;
923  #if YYLPDEBUG > 1
924  print_init();
925  #endif
926  extern int lpverbose;
928  else lpverbose=0;
929  // yylplex sets also text_buffer
930  if (text_buffer!=NULL) *text_buffer='\0';
931  yylplex(newlib, libnamebuf, &lib_style, pl, autoexport);
932  if(yylp_errno)
933  {
934  Werror("Library %s: ERROR occurred: in line %d, %d.", newlib, yylplineno,
935  current_pos(0));
937  {
941  }
942  else
944  WerrorS("Cannot load library,... aborting.");
945  reinit_yylp();
946  fclose( yylpin );
948  return TRUE;
949  }
950  if (BVERBOSE(V_LOAD_LIB))
951  Print( "// ** loaded %s %s\n", libnamebuf, text_buffer);
952  if( (lib_style == OLD_LIBSTYLE) && (BVERBOSE(V_LOAD_LIB)))
953  {
954  Warn( "library %s has old format. This format is still accepted,", newlib);
955  WarnS( "but for functionality you may wish to change to the new");
956  WarnS( "format. Please refer to the manual for further information.");
957  }
958  reinit_yylp();
959  fclose( yylpin );
960  fp = NULL;
961  iiRunInit(IDPACKAGE(pl));
962 
963  {
964  libstackv ls;
965  for(ls = library_stack; (ls != NULL) && (ls != ls_start); )
966  {
967  if(ls->to_be_done)
968  {
969  ls->to_be_done=FALSE;
970  iiLibCmd(ls->get(),autoexport,tellerror,FALSE);
971  ls = ls->pop(newlib);
972  }
973  }
974 #if 0
975  PrintS("--------------------\n");
976  for(ls = library_stack; ls != NULL; ls = ls->next)
977  {
978  Print("%s: LIB-stack:(%d), %s %s\n", newlib, ls->cnt, ls->get(),
979  ls->to_be_done ? "not loaded" : "loaded");
980  }
981  PrintS("--------------------\n");
982 #endif
983  }
984 
985  if(fp != NULL) fclose(fp);
986  return FALSE;
987 }
libstackv next
Definition: subexpr.h:163
libstackv pop(const char *p)
Definition: iplib.cc:1422
int cnt
Definition: subexpr.h:166
char * get()
Definition: subexpr.h:169
BOOLEAN to_be_done
Definition: subexpr.h:165
BOOLEAN iiLibCmd(char *newlib, BOOLEAN autoexport, BOOLEAN tellerror, BOOLEAN force)
Definition: iplib.cc:826
libstackv library_stack
Definition: iplib.cc:65
int yylplineno
Definition: libparse.cc:1102
int current_pos(int i=0)
Definition: libparse.cc:3344
void print_init()
Definition: libparse.cc:3480
int yylp_errno
Definition: libparse.cc:1128
static void iiCleanProcs(idhdl &root)
Definition: iplib.cc:870
static void iiRunInit(package p)
Definition: iplib.cc:899
char * yylp_errlist[]
Definition: libparse.cc:1112
char * text_buffer
Definition: libparse.cc:1097
int lpverbose
Definition: libparse.cc:1104
void reinit_yylp()
Definition: libparse.cc:3374
lib_style_types
Definition: libparse.h:9
@ OLD_LIBSTYLE
Definition: libparse.h:9
#define YYLP_BAD_CHAR
Definition: libparse.h:93
int yylplex(const char *libname, const char *libfile, lib_style_types *lib_style, idhdl pl, BOOLEAN autoexport=FALSE, lp_modes=LOAD_LIB)
#define V_DEBUG_LIB
Definition: options.h:48
#define V_LOAD_LIB
Definition: options.h:47

◆ iiLocateLib()

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

Definition at line 812 of file iplib.cc.

813 {
814  char *plib = iiConvName(lib);
815  idhdl pl = basePack->idroot->get(plib,0);
816  if( (pl!=NULL) && (IDTYP(pl)==PACKAGE_CMD) &&
817  (IDPACKAGE(pl)->language == LANG_SINGULAR))
818  {
819  strncpy(where,IDPACKAGE(pl)->libname,127);
820  return TRUE;
821  }
822  else
823  return FALSE;;
824 }

◆ iiMake_proc()

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

Definition at line 485 of file iplib.cc.

486 {
487  int err;
488  procinfov pi = IDPROC(pn);
489  if(pi->is_static && myynest==0)
490  {
491  Werror("'%s::%s()' is a local procedure and cannot be accessed by an user.",
492  pi->libname, pi->procname);
493  return TRUE;
494  }
495  iiCheckNest();
497  //Print("currRing(%d):%s(%x) in %s\n",myynest,IDID(currRingHdl),currRing,IDID(pn));
498  iiRETURNEXPR.Init();
499  procstack->push(pi->procname);
501  || (pi->trace_flag&TRACE_SHOW_PROC))
502  {
504  Print("entering%-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
505  }
506 #ifdef RDEBUG
508 #endif
509  switch (pi->language)
510  {
511  default:
512  case LANG_NONE:
513  WerrorS("undefined proc");
514  err=TRUE;
515  break;
516 
517  case LANG_SINGULAR:
518  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
519  {
520  currPack=pi->pack;
523  //Print("set pack=%s\n",IDID(currPackHdl));
524  }
525  else if ((pack!=NULL)&&(currPack!=pack))
526  {
527  currPack=pack;
530  //Print("set pack=%s\n",IDID(currPackHdl));
531  }
532  err=iiPStart(pn,sl);
533  break;
534  case LANG_C:
536  err = (pi->data.o.function)(res, sl);
537  memcpy(&iiRETURNEXPR,res,sizeof(iiRETURNEXPR));
539  break;
540  }
542  || (pi->trace_flag&TRACE_SHOW_PROC))
543  {
545  Print("leaving %-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
546  }
547  //const char *n="NULL";
548  //if (currRingHdl!=NULL) n=IDID(currRingHdl);
549  //Print("currRing(%d):%s(%x) after %s\n",myynest,n,currRing,IDID(pn));
550 #ifdef RDEBUG
552 #endif
553  if (err)
554  {
556  //iiRETURNEXPR.Init(); //done by CleanUp
557  }
558  if (iiCurrArgs!=NULL)
559  {
560  if (!err) Warn("too many arguments for %s",IDID(pn));
561  iiCurrArgs->CleanUp();
564  }
565  procstack->pop();
566  if (err)
567  return TRUE;
568  return FALSE;
569 }
static void iiShowLevRings()
Definition: iplib.cc:459
BOOLEAN iiPStart(idhdl pn, leftv v)
Definition: iplib.cc:353
#define TRACE_SHOW_RINGS
Definition: reporter.h:35

◆ iiMakeResolv()

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

Definition at line 766 of file ipshell.cc.

768 {
769  lists L=liMakeResolv(r,length,rlen,typ0,weights);
770  int i=0;
771  idhdl h;
772  char * s=(char *)omAlloc(strlen(name)+5);
773 
774  while (i<=L->nr)
775  {
776  sprintf(s,"%s(%d)",name,i+1);
777  if (i==0)
778  h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
779  else
780  h=enterid(s,myynest,MODUL_CMD,&(currRing->idroot), FALSE);
781  if (h!=NULL)
782  {
783  h->data.uideal=(ideal)L->m[i].data;
784  h->attribute=L->m[i].attribute;
786  Print("//defining: %s as %d-th syzygy module\n",s,i+1);
787  }
788  else
789  {
790  idDelete((ideal *)&(L->m[i].data));
791  Warn("cannot define %s",s);
792  }
793  //L->m[i].data=NULL;
794  //L->m[i].rtyp=0;
795  //L->m[i].attribute=NULL;
796  i++;
797  }
798  omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
800  omFreeSize((ADDRESS)s,strlen(name)+5);
801 }
attr attribute
Definition: subexpr.h:89
sleftv * m
Definition: lists.h:45
int nr
Definition: lists.h:43
static BOOLEAN length(leftv result, leftv arg)
Definition: interval.cc:267
if(yy_init)
Definition: libparse.cc:1418
omBin slists_bin
Definition: lists.cc:23
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:216
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define V_DEF_RES
Definition: options.h:50

◆ iiMap()

leftv iiMap ( map  theMap,
const char *  what 
)

Definition at line 607 of file ipshell.cc.

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

◆ iiOpsTwoChar()

int iiOpsTwoChar ( const char *  s)

Definition at line 119 of file ipshell.cc.

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

◆ iiParameter()

BOOLEAN iiParameter ( leftv  p)

Definition at line 1280 of file ipshell.cc.

1281 {
1282  if (iiCurrArgs==NULL)
1283  {
1284  if (strcmp(p->name,"#")==0)
1285  return iiDefaultParameter(p);
1286  Werror("not enough arguments for proc %s",VoiceName());
1287  p->CleanUp();
1288  return TRUE;
1289  }
1290  leftv h=iiCurrArgs;
1291  leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1292  BOOLEAN is_default_list=FALSE;
1293  if (strcmp(p->name,"#")==0)
1294  {
1295  is_default_list=TRUE;
1296  rest=NULL;
1297  }
1298  else
1299  {
1300  h->next=NULL;
1301  }
1302  BOOLEAN res=iiAssign(p,h);
1303  if (is_default_list)
1304  {
1305  iiCurrArgs=NULL;
1306  }
1307  else
1308  {
1309  iiCurrArgs=rest;
1310  }
1311  h->CleanUp();
1313  return res;
1314 }
BOOLEAN iiDefaultParameter(leftv p)
Definition: ipshell.cc:1166

◆ iiProcArgs()

char* iiProcArgs ( char *  e,
BOOLEAN  withParenth 
)

Definition at line 109 of file iplib.cc.

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

◆ iiProcName()

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

Definition at line 95 of file iplib.cc.

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

◆ iiPStart()

BOOLEAN iiPStart ( idhdl  pn,
leftv  sl 
)

Definition at line 353 of file iplib.cc.

354 {
355  procinfov pi=NULL;
356  int old_echo=si_echo;
357  BOOLEAN err=FALSE;
358  char save_flags=0;
359 
360  /* init febase ======================================== */
361  /* we do not enter this case if filename != NULL !! */
362  if (pn!=NULL)
363  {
364  pi = IDPROC(pn);
365  if(pi!=NULL)
366  {
367  save_flags=pi->trace_flag;
368  if( pi->data.s.body==NULL )
369  {
371  if (pi->data.s.body==NULL) return TRUE;
372  }
373 // omUpdateInfo();
374 // int m=om_Info.UsedBytes;
375 // Print("proc %s, mem=%d\n",IDID(pn),m);
376  }
377  }
378  else return TRUE;
379  /* generate argument list ======================================*/
380  //iiCurrArgs should be NULL here, as the assignment for the parameters
381  // of the prevouis call are already done befor calling another routine
382  if (v!=NULL)
383  {
385  memcpy(iiCurrArgs,v,sizeof(sleftv)); // keeps track of v->next etc.
386  memset(v,0,sizeof(sleftv));
387  }
388  else
389  {
391  }
392  iiCurrProc=pn;
393  /* start interpreter ======================================*/
394  myynest++;
395  if (myynest > SI_MAX_NEST)
396  {
397  WerrorS("nesting too deep");
398  err=TRUE;
399  }
400  else
401  {
402  err=iiAllStart(pi,pi->data.s.body,BT_proc,pi->data.s.body_lineno-(v!=NULL));
403 
404  if (iiLocalRing[myynest-1] != currRing)
405  {
407  {
408  //idhdl hn;
409  const char *n;
410  const char *o;
411  idhdl nh=NULL, oh=NULL;
412  if (iiLocalRing[myynest-1]!=NULL)
414  if (oh!=NULL) o=oh->id;
415  else o="none";
416  if (currRing!=NULL)
417  nh=rFindHdl(currRing,NULL);
418  if (nh!=NULL) n=nh->id;
419  else n="none";
420  Werror("ring change during procedure call %s: %s -> %s (level %d)",pi->procname,o,n,myynest);
422  err=TRUE;
423  }
425  }
426  if ((currRing==NULL)
427  && (currRingHdl!=NULL))
429  else
430  if ((currRing!=NULL) &&
432  ||(IDLEV(currRingHdl)>=myynest-1)))
433  {
436  }
437  //Print("kill locals for %s (level %d)\n",IDID(pn),myynest);
439 #ifndef SING_NDEBUG
440  checkall();
441 #endif
442  //Print("end kill locals for %s (%d)\n",IDID(pn),myynest);
443  }
444  myynest--;
445  si_echo=old_echo;
446  if (pi!=NULL)
447  pi->trace_flag=save_flags;
448 // omUpdateInfo();
449 // int m=om_Info.UsedBytes;
450 // Print("exit %s, mem=%d\n",IDID(pn),m);
451  return err;
452 }
const char * id
Definition: idrec.h:39
BOOLEAN RingDependend()
Definition: subexpr.cc:398
#define SI_MAX_NEST
Definition: iplib.cc:24

◆ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 956 of file ipshell.cc.

957 {
958  int len,reg,typ0;
959 
960  resolvente r=liFindRes(L,&len,&typ0);
961 
962  if (r==NULL)
963  return -2;
964  intvec *weights=NULL;
965  int add_row_shift=0;
966  intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
967  if (ww!=NULL)
968  {
969  weights=ivCopy(ww);
970  add_row_shift = ww->min_in();
971  (*weights) -= add_row_shift;
972  }
973  //Print("attr:%x\n",weights);
974 
975  intvec *dummy=syBetti(r,len,&reg,weights);
976  if (weights!=NULL) delete weights;
977  delete dummy;
978  omFreeSize((ADDRESS)r,len*sizeof(ideal));
979  return reg+1+add_row_shift;
980 }
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:131
int min_in()
Definition: intvec.h:119
ideal * resolvente
Definition: ideals.h:18
intvec * ivCopy(const intvec *o)
Definition: intvec.h:133
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:315
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:771

◆ iiTestAssume()

BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6386 of file ipshell.cc.

6387 {
6388  // assume a: level
6389  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6390  {
6391  if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6392  char assume_yylinebuf[80];
6393  strncpy(assume_yylinebuf,my_yylinebuf,79);
6394  int lev=(long)a->Data();
6395  int startlev=0;
6396  idhdl h=ggetid("assumeLevel");
6397  if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6398  if(lev <=startlev)
6399  {
6400  BOOLEAN bo=b->Eval();
6401  if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6402  if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6403  if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6404  }
6405  }
6406  b->CleanUp();
6407  a->CleanUp();
6408  return FALSE;
6409 }
void * Data()
Definition: subexpr.cc:1134
#define IDINT(a)
Definition: ipid.h:120

◆ iiTokType()

int iiTokType ( int  op)

Definition at line 233 of file iparith.cc.

234 {
235  for (unsigned i=0;i<sArithBase.nCmdUsed;i++)
236  {
237  if (sArithBase.sCmds[i].tokval==op)
238  return sArithBase.sCmds[i].toktype;
239  }
240  return 0;
241 }
static SArithBase sArithBase
Base entry for arithmetic.
Definition: iparith.cc:197
cmdnames * sCmds
array of existing commands
Definition: iparith.cc:182
unsigned nCmdUsed
number of commands used
Definition: iparith.cc:187

◆ iiTryLoadLib()

BOOLEAN iiTryLoadLib ( leftv  v,
const char *  id 
)

Definition at line 764 of file iplib.cc.

765 {
766  BOOLEAN LoadResult = TRUE;
767  char libnamebuf[1024];
768  char *libname = (char *)omAlloc(strlen(id)+5);
769  const char *suffix[] = { "", ".lib", ".so", ".sl", NULL };
770  int i = 0;
771  // FILE *fp;
772  // package pack;
773  // idhdl packhdl;
774  lib_types LT;
775  for(i=0; suffix[i] != NULL; i++)
776  {
777  sprintf(libname, "%s%s", id, suffix[i]);
778  *libname = mytolower(*libname);
779  if((LT = type_of_LIB(libname, libnamebuf)) > LT_NOTFOUND)
780  {
781  char *s=omStrDup(libname);
782  #ifdef HAVE_DYNAMIC_LOADING
783  char libnamebuf[1024];
784  #endif
785 
786  if (LT==LT_SINGULAR)
787  LoadResult = iiLibCmd(s, FALSE, FALSE,TRUE);
788  #ifdef HAVE_DYNAMIC_LOADING
789  else if ((LT==LT_ELF) || (LT==LT_HPUX))
790  LoadResult = load_modules(s,libnamebuf,FALSE);
791  #endif
792  else if (LT==LT_BUILTIN)
793  {
794  LoadResult=load_builtin(s,FALSE, iiGetBuiltinModInit(s));
795  }
796  if(!LoadResult )
797  {
798  v->name = iiConvName(libname);
799  break;
800  }
801  }
802  }
803  omFree(libname);
804  return LoadResult;
805 }
BOOLEAN load_modules(const char *newlib, char *fullname, BOOLEAN autoexport)
Definition: iplib.cc:1091
char mytolower(char c)
Definition: iplib.cc:1318
BOOLEAN load_builtin(const char *newlib, BOOLEAN autoexport, SModulFunc_t init)
Definition: iplib.cc:1197
SModulFunc_t iiGetBuiltinModInit(const char *libname)
Definition: iplib.cc:751
lib_types type_of_LIB(const char *newlib, char *libnamebuf)
Definition: mod_lib.cc:22
lib_types
Definition: mod_raw.h:16
@ LT_HPUX
Definition: mod_raw.h:16
@ LT_SINGULAR
Definition: mod_raw.h:16
@ LT_BUILTIN
Definition: mod_raw.h:16
@ LT_ELF
Definition: mod_raw.h:16
@ LT_NOTFOUND
Definition: mod_raw.h:16

◆ iiTwoOps()

const char* iiTwoOps ( int  t)

Definition at line 259 of file gentable.cc.

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

◆ iiWRITE()

BOOLEAN iiWRITE ( leftv  res,
leftv  exprlist 
)

Definition at line 580 of file ipshell.cc.

581 {
582  sleftv vf;
583  if (iiConvert(v->Typ(),LINK_CMD,iiTestConvert(v->Typ(),LINK_CMD),v,&vf))
584  {
585  WerrorS("link expected");
586  return TRUE;
587  }
588  si_link l=(si_link)vf.Data();
589  if (vf.next == NULL)
590  {
591  WerrorS("write: need at least two arguments");
592  return TRUE;
593  }
594 
595  BOOLEAN b=slWrite(l,vf.next); /* iiConvert preserves next */
596  if (b)
597  {
598  const char *s;
599  if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
600  else s=sNoName_fe;
601  Werror("cannot write to %s",s);
602  }
603  vf.CleanUp();
604  return b;
605 }

◆ IsCmd()

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

Definition at line 8679 of file iparith.cc.

8680 {
8681  int i;
8682  int an=1;
8683  int en=sArithBase.nLastIdentifier;
8684 
8685  loop
8686  //for(an=0; an<sArithBase.nCmdUsed; )
8687  {
8688  if(an>=en-1)
8689  {
8690  if (strcmp(n, sArithBase.sCmds[an].name) == 0)
8691  {
8692  i=an;
8693  break;
8694  }
8695  else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
8696  {
8697  i=en;
8698  break;
8699  }
8700  else
8701  {
8702  // -- blackbox extensions:
8703  // return 0;
8704  return blackboxIsCmd(n,tok);
8705  }
8706  }
8707  i=(an+en)/2;
8708  if (*n < *(sArithBase.sCmds[i].name))
8709  {
8710  en=i-1;
8711  }
8712  else if (*n > *(sArithBase.sCmds[i].name))
8713  {
8714  an=i+1;
8715  }
8716  else
8717  {
8718  int v=strcmp(n,sArithBase.sCmds[i].name);
8719  if(v<0)
8720  {
8721  en=i-1;
8722  }
8723  else if(v>0)
8724  {
8725  an=i+1;
8726  }
8727  else /*v==0*/
8728  {
8729  break;
8730  }
8731  }
8732  }
8734  tok=sArithBase.sCmds[i].tokval;
8735  if(sArithBase.sCmds[i].alias==2)
8736  {
8737  Warn("outdated identifier `%s` used - please change your code",
8738  sArithBase.sCmds[i].name);
8739  sArithBase.sCmds[i].alias=1;
8740  }
8741  #if 0
8742  if (currRingHdl==NULL)
8743  {
8744  #ifdef SIQ
8745  if (siq<=0)
8746  {
8747  #endif
8748  if ((tok>=BEGIN_RING) && (tok<=END_RING))
8749  {
8750  WerrorS("no ring active");
8751  return 0;
8752  }
8753  #ifdef SIQ
8754  }
8755  #endif
8756  }
8757  #endif
8758  if (!expected_parms)
8759  {
8760  switch (tok)
8761  {
8762  case IDEAL_CMD:
8763  case INT_CMD:
8764  case INTVEC_CMD:
8765  case MAP_CMD:
8766  case MATRIX_CMD:
8767  case MODUL_CMD:
8768  case POLY_CMD:
8769  case PROC_CMD:
8770  case RING_CMD:
8771  case STRING_CMD:
8772  cmdtok = tok;
8773  break;
8774  }
8775  }
8776  return sArithBase.sCmds[i].toktype;
8777 }
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
@ END_RING
Definition: grammar.cc:308
@ BEGIN_RING
Definition: grammar.cc:282
int cmdtok
Definition: grammar.cc:174
BOOLEAN expected_parms
Definition: grammar.cc:173
unsigned nLastIdentifier
valid indentifieres are slot 1..nLastIdentifier
Definition: iparith.cc:189
const char * lastreserved
Definition: ipshell.cc:80

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv  res,
leftv  v 
)

Definition at line 886 of file ipshell.cc.

887 {
888  sleftv tmp;
889  memset(&tmp,0,sizeof(tmp));
890  tmp.rtyp=INT_CMD;
891  tmp.data=(void *)1;
892  if ((u->Typ()==IDEAL_CMD)
893  || (u->Typ()==MODUL_CMD))
894  return jjBETTI2_ID(res,u,&tmp);
895  else
896  return jjBETTI2(res,u,&tmp);
897 }
BOOLEAN jjBETTI2_ID(leftv res, leftv u, leftv v)
Definition: ipshell.cc:899
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:920

◆ jjBETTI2()

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

Definition at line 920 of file ipshell.cc.

921 {
922  resolvente r;
923  int len;
924  int reg,typ0;
925  lists l=(lists)u->Data();
926 
927  intvec *weights=NULL;
928  int add_row_shift=0;
929  intvec *ww=NULL;
930  if (l->nr>=0) ww=(intvec *)atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
931  if (ww!=NULL)
932  {
933  weights=ivCopy(ww);
934  add_row_shift = ww->min_in();
935  (*weights) -= add_row_shift;
936  }
937  //Print("attr:%x\n",weights);
938 
939  r=liFindRes(l,&len,&typ0);
940  if (r==NULL) return TRUE;
941  intvec* res_im=syBetti(r,len,&reg,weights,(int)(long)v->Data());
942  res->data=(void*)res_im;
943  omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
944  //Print("rowShift: %d ",add_row_shift);
945  for(int i=1;i<=res_im->rows();i++)
946  {
947  if (IMATELEM(*res_im,1,i)==0) { add_row_shift--; }
948  else break;
949  }
950  //Print(" %d\n",add_row_shift);
951  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
952  if (weights!=NULL) delete weights;
953  return FALSE;
954 }
void atSet(idhdl root, char *name, void *data, int typ)
Definition: attrib.cc:152
int rows() const
Definition: intvec.h:94
#define IMATELEM(M, I, J)
Definition: intvec.h:83

◆ jjBETTI2_ID()

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

Definition at line 899 of file ipshell.cc.

900 {
902  l->Init(1);
903  l->m[0].rtyp=u->Typ();
904  l->m[0].data=u->Data();
905  attr *a=u->Attribute();
906  if (a!=NULL)
907  l->m[0].attribute=*a;
908  sleftv tmp2;
909  memset(&tmp2,0,sizeof(tmp2));
910  tmp2.rtyp=LIST_CMD;
911  tmp2.data=(void *)l;
912  BOOLEAN r=jjBETTI2(res,&tmp2,v);
913  l->m[0].data=NULL;
914  l->m[0].attribute=NULL;
915  l->m[0].rtyp=DEF_CMD;
916  l->Clean();
917  return r;
918 }
Definition: attrib.h:21
attr * Attribute()
Definition: subexpr.cc:1389
CFList tmp2
Definition: facFqBivar.cc:70

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3285 of file ipshell.cc.

3286 {
3287  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3288  return (res->data==NULL);
3289 }
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition: clapsing.cc:1456

◆ jjIMPORTFROM()

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

Definition at line 2187 of file ipassign.cc.

2188 {
2189  //Print("importfrom %s::%s ->.\n",v->Name(),u->Name() );
2190  assume(u->Typ()==PACKAGE_CMD);
2191  char *vn=(char *)v->Name();
2192  idhdl h=((package)(u->Data()))->idroot->get(vn /*v->Name()*/, myynest);
2193  if (h!=NULL)
2194  {
2195  //check for existence
2196  if (((package)(u->Data()))==basePack)
2197  {
2198  WarnS("source and destination packages are identical");
2199  return FALSE;
2200  }
2201  idhdl t=basePack->idroot->get(vn /*v->Name()*/, myynest);
2202  if (t!=NULL)
2203  {
2204  if (BVERBOSE(V_REDEFINE)) Warn("redefining %s (%s)",vn,my_yylinebuf);
2205  killhdl(t);
2206  }
2207  sleftv tmp_expr;
2208  if (iiDeclCommand(&tmp_expr,v,myynest,DEF_CMD,&IDROOT)) return TRUE;
2209  sleftv h_expr;
2210  memset(&h_expr,0,sizeof(h_expr));
2211  h_expr.rtyp=IDHDL;
2212  h_expr.data=h;
2213  h_expr.name=vn;
2214  return iiAssign(&tmp_expr,&h_expr);
2215  }
2216  else
2217  {
2218  Werror("`%s` not found in `%s`",v->Name(), u->Name());
2219  return TRUE;
2220  }
2221  return FALSE;
2222 }
void killhdl(idhdl h, package proot)
Definition: ipid.cc:376
#define assume(x)
Definition: mod2.h:390
ip_package * package
Definition: structs.h:46

◆ jjLIST_PL()

BOOLEAN jjLIST_PL ( leftv  res,
leftv  v 
)

Definition at line 7307 of file iparith.cc.

7308 {
7309  int sl=0;
7310  if (v!=NULL) sl = v->listLength();
7311  lists L;
7312  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7313  {
7314  int add_row_shift = 0;
7315  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7316  if (weights!=NULL) add_row_shift=weights->min_in();
7317  L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7318  }
7319  else
7320  {
7322  leftv h=NULL;
7323  int i;
7324  int rt;
7325 
7326  L->Init(sl);
7327  for (i=0;i<sl;i++)
7328  {
7329  if (h!=NULL)
7330  { /* e.g. not in the first step:
7331  * h is the pointer to the old sleftv,
7332  * v is the pointer to the next sleftv
7333  * (in this moment) */
7334  h->next=v;
7335  }
7336  h=v;
7337  v=v->next;
7338  h->next=NULL;
7339  rt=h->Typ();
7340  if (rt==0)
7341  {
7342  L->Clean();
7343  Werror("`%s` is undefined",h->Fullname());
7344  return TRUE;
7345  }
7346  if (rt==RING_CMD)
7347  {
7348  L->m[i].rtyp=rt; L->m[i].data=h->Data();
7349  ((ring)L->m[i].data)->ref++;
7350  }
7351  else
7352  L->m[i].Copy(h);
7353  }
7354  }
7355  res->data=(char *)L;
7356  return FALSE;
7357 }
void Copy(leftv e)
Definition: subexpr.cc:684
void Clean(ring r=currRing)
Definition: lists.h:25
INLINE_THIS void Init(int l=0)
lists syConvRes(syStrategy syzstr, BOOLEAN toDel, int add_row_shift)
Definition: ipshell.cc:3122

◆ jjLOAD()

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

load lib/module given in v

Definition at line 5096 of file iparith.cc.

5097 {
5098  char libnamebuf[1024];
5100 
5101 #ifdef HAVE_DYNAMIC_LOADING
5102  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5103 #endif /* HAVE_DYNAMIC_LOADING */
5104  switch(LT)
5105  {
5106  default:
5107  case LT_NONE:
5108  Werror("%s: unknown type", s);
5109  break;
5110  case LT_NOTFOUND:
5111  Werror("cannot open %s", s);
5112  break;
5113 
5114  case LT_SINGULAR:
5115  {
5116  char *plib = iiConvName(s);
5117  idhdl pl = IDROOT->get(plib,0);
5118  if (pl==NULL)
5119  {
5120  pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5121  IDPACKAGE(pl)->language = LANG_SINGULAR;
5122  IDPACKAGE(pl)->libname=omStrDup(s);
5123  }
5124  else if (IDTYP(pl)!=PACKAGE_CMD)
5125  {
5126  Werror("can not create package `%s`",plib);
5127  omFree(plib);
5128  return TRUE;
5129  }
5130  else /* package */
5131  {
5132  package pa=IDPACKAGE(pl);
5133  if ((pa->language==LANG_C)
5134  || (pa->language==LANG_MIX))
5135  {
5136  Werror("can not create package `%s` - binaries exists",plib);
5137  omfree(plib);
5138  return TRUE;
5139  }
5140  }
5141  omFree(plib);
5142  package savepack=currPack;
5143  currPack=IDPACKAGE(pl);
5144  IDPACKAGE(pl)->loaded=TRUE;
5145  char libnamebuf[1024];
5146  FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5147  BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5148  currPack=savepack;
5149  IDPACKAGE(pl)->loaded=(!bo);
5150  return bo;
5151  }
5152  case LT_BUILTIN:
5153  SModulFunc_t iiGetBuiltinModInit(const char*);
5154  return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5155  case LT_MACH_O:
5156  case LT_ELF:
5157  case LT_HPUX:
5158 #ifdef HAVE_DYNAMIC_LOADING
5159  return load_modules(s, libnamebuf, autoexport);
5160 #else /* HAVE_DYNAMIC_LOADING */
5161  WerrorS("Dynamic modules are not supported by this version of Singular");
5162  break;
5163 #endif /* HAVE_DYNAMIC_LOADING */
5164  }
5165  return TRUE;
5166 }
BOOLEAN load_builtin(const char *newlib, BOOLEAN autoexport, SModulFunc_t init)
Definition: iplib.cc:1197
int(* SModulFunc_t)(SModulFunctions *)
Definition: ipid.h:80
@ LT_MACH_O
Definition: mod_raw.h:16
@ LT_NONE
Definition: mod_raw.h:16

◆ jjLOAD_TRY()

BOOLEAN jjLOAD_TRY ( const char *  s)

Definition at line 5172 of file iparith.cc.

5173 {
5174  void (*WerrorS_save)(const char *s) = WerrorS_callback;
5177  BOOLEAN bo=jjLOAD(s,TRUE);
5178  if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
5179  Print("loading of >%s< failed\n",s);
5180  WerrorS_callback=WerrorS_save;
5181  errorreported=0;
5182  return FALSE;
5183 }
void(* WerrorS_callback)(const char *s)
Definition: feFopen.cc:21
BOOLEAN jjLOAD(const char *s, BOOLEAN autoexport)
load lib/module given in v
Definition: iparith.cc:5096
static void WerrorS_dummy(const char *)
Definition: iparith.cc:5168
static int WerrorS_dummy_cnt
Definition: iparith.cc:5167
#define TEST_OPT_PROT
Definition: options.h:102

◆ jjMINRES()

BOOLEAN jjMINRES ( leftv  res,
leftv  v 
)

Definition at line 865 of file ipshell.cc.

866 {
867  int len=0;
868  int typ0;
869  lists L=(lists)v->Data();
870  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
871  int add_row_shift = 0;
872  if (weights==NULL)
873  weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
874  if (weights!=NULL) add_row_shift=weights->min_in();
875  resolvente rr=liFindRes(L,&len,&typ0);
876  if (rr==NULL) return TRUE;
877  resolvente r=iiCopyRes(rr,len);
878 
879  syMinimizeResolvente(r,len,0);
880  omFreeSize((ADDRESS)rr,len*sizeof(ideal));
881  len++;
882  res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
883  return FALSE;
884 }
static resolvente iiCopyRes(resolvente r, int l)
Definition: ipshell.cc:855
void syMinimizeResolvente(resolvente res, int length, int first)
Definition: syz.cc:356

◆ jjRESULTANT()

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

Definition at line 3278 of file ipshell.cc.

3279 {
3280  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3281  (poly)w->CopyD(), currRing);
3282  return errorreported;
3283 }
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition: clapsing.cc:295

◆ jjSYSTEM()

BOOLEAN jjSYSTEM ( leftv  res,
leftv  v 
)

Definition at line 228 of file extra.cc.

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

◆ jjVARIABLES_ID()

BOOLEAN jjVARIABLES_ID ( leftv  res,
leftv  u 
)

Definition at line 6258 of file ipshell.cc.

6259 {
6260  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6261  ideal I=(ideal)u->Data();
6262  int i;
6263  int n=0;
6264  for(i=I->nrows*I->ncols-1;i>=0;i--)
6265  {
6266  int n0=pGetVariables(I->m[i],e);
6267  if (n0>n) n=n0;
6268  }
6269  jjINT_S_TO_ID(n,e,res);
6270  return FALSE;
6271 }
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6228
#define pGetVariables(p, e)
Definition: polys.h:238

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6250 of file ipshell.cc.

6251 {
6252  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6253  int n=pGetVariables((poly)u->Data(),e);
6254  jjINT_S_TO_ID(n,e,res);
6255  return FALSE;
6256 }

◆ killlocals()

void killlocals ( int  v)

Definition at line 378 of file ipshell.cc.

379 {
380  BOOLEAN changed=FALSE;
381  idhdl sh=currRingHdl;
382  ring cr=currRing;
383  if (sh!=NULL) changed=((IDLEV(sh)<v) || (IDRING(sh)->ref>0));
384  //if (changed) Print("currRing=%s(%x), lev=%d,ref=%d\n",IDID(sh),IDRING(sh),IDLEV(sh),IDRING(sh)->ref);
385 
386  killlocals_rec(&(basePack->idroot),v,currRing);
387 
389  {
390  int t=iiRETURNEXPR.Typ();
391  if (/*iiRETURNEXPR.Typ()*/ t==RING_CMD)
392  {
394  if (((ring)h->data)->idroot!=NULL)
395  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
396  }
397  else if (/*iiRETURNEXPR.Typ()*/ t==LIST_CMD)
398  {
400  changed |=killlocals_list(v,(lists)h->data);
401  }
402  }
403  if (changed)
404  {
406  if (currRingHdl==NULL)
407  currRing=NULL;
408  else if(cr!=currRing)
409  rChangeCurrRing(cr);
410  }
411 
412  if (myynest<=1) iiNoKeepRing=TRUE;
413  //Print("end killlocals >= %d\n",v);
414  //listall();
415 }
int iiRETURNEXPR_len
Definition: iplib.cc:456
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:358
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:82
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:322
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:287
void rChangeCurrRing(ring r)
Definition: polys.cc:15

◆ kQHWeight()

BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3261 of file ipshell.cc.

3262 {
3263  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3264  if (res->data==NULL)
3265  res->data=(char *)new intvec(rVar(currRing));
3266  return FALSE;
3267 }
intvec * id_QHomWeight(ideal id, const ring r)

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3239 of file ipshell.cc.

3240 {
3241  ideal F=(ideal)id->Data();
3242  intvec * iv = new intvec(rVar(currRing));
3243  polyset s;
3244  int sl, n, i;
3245  int *x;
3246 
3247  res->data=(char *)iv;
3248  s = F->m;
3249  sl = IDELEMS(F) - 1;
3250  n = rVar(currRing);
3251  double wNsqr = (double)2.0 / (double)n;
3253  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3254  wCall(s, sl, x, wNsqr, currRing);
3255  for (i = n; i!=0; i--)
3256  (*iv)[i-1] = x[i + n + 1];
3257  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3258  return FALSE;
3259 }
Variable x
Definition: cfModGcd.cc:4023
void wCall(poly *s, int sl, int *x, double wNsqr, const ring R)
Definition: weight.cc:114
double(* wFunctional)(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight.cc:26
double wFunctionalBuch(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight0.c:78

◆ list_cmd()

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

Definition at line 417 of file ipshell.cc.

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

◆ loNewtonP()

BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4501 of file ipshell.cc.

4502 {
4503  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4504  return FALSE;
4505 }
ideal loNewtonPolytope(const ideal id)
Definition: mpr_base.cc:3192

◆ loSimplex()

BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4507 of file ipshell.cc.

4508 {
4509  if ( !(rField_is_long_R(currRing)) )
4510  {
4511  WerrorS("Ground field not implemented!");
4512  return TRUE;
4513  }
4514 
4515  simplex * LP;
4516  matrix m;
4517 
4518  leftv v= args;
4519  if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4520  return TRUE;
4521  else
4522  m= (matrix)(v->CopyD());
4523 
4524  LP = new simplex(MATROWS(m),MATCOLS(m));
4525  LP->mapFromMatrix(m);
4526 
4527  v= v->next;
4528  if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4529  return TRUE;
4530  else
4531  LP->m= (int)(long)(v->Data());
4532 
4533  v= v->next;
4534  if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4535  return TRUE;
4536  else
4537  LP->n= (int)(long)(v->Data());
4538 
4539  v= v->next;
4540  if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4541  return TRUE;
4542  else
4543  LP->m1= (int)(long)(v->Data());
4544 
4545  v= v->next;
4546  if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4547  return TRUE;
4548  else
4549  LP->m2= (int)(long)(v->Data());
4550 
4551  v= v->next;
4552  if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4553  return TRUE;
4554  else
4555  LP->m3= (int)(long)(v->Data());
4556 
4557 #ifdef mprDEBUG_PROT
4558  Print("m (constraints) %d\n",LP->m);
4559  Print("n (columns) %d\n",LP->n);
4560  Print("m1 (<=) %d\n",LP->m1);
4561  Print("m2 (>=) %d\n",LP->m2);
4562  Print("m3 (==) %d\n",LP->m3);
4563 #endif
4564 
4565  LP->compute();
4566 
4567  lists lres= (lists)omAlloc( sizeof(slists) );
4568  lres->Init( 6 );
4569 
4570  lres->m[0].rtyp= MATRIX_CMD; // output matrix
4571  lres->m[0].data=(void*)LP->mapToMatrix(m);
4572 
4573  lres->m[1].rtyp= INT_CMD; // found a solution?
4574  lres->m[1].data=(void*)(long)LP->icase;
4575 
4576  lres->m[2].rtyp= INTVEC_CMD;
4577  lres->m[2].data=(void*)LP->posvToIV();
4578 
4579  lres->m[3].rtyp= INTVEC_CMD;
4580  lres->m[3].data=(void*)LP->zrovToIV();
4581 
4582  lres->m[4].rtyp= INT_CMD;
4583  lres->m[4].data=(void*)(long)LP->m;
4584 
4585  lres->m[5].rtyp= INT_CMD;
4586  lres->m[5].data=(void*)(long)LP->n;
4587 
4588  res->data= (void*)lres;
4589 
4590  return FALSE;
4591 }
Linear Programming / Linear Optimization using Simplex - Algorithm.
Definition: mpr_numeric.h:195
intvec * zrovToIV()
BOOLEAN mapFromMatrix(matrix m)
int icase
Definition: mpr_numeric.h:201
void compute()
matrix mapToMatrix(matrix m)
intvec * posvToIV()
#define MATROWS(i)
Definition: matpol.h:26
#define MATCOLS(i)
Definition: matpol.h:27

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 3009 of file ipshell.cc.

3010 {
3011  int i,j;
3012  matrix result;
3013  ideal id=(ideal)a->Data();
3014 
3015  result =mpNew(IDELEMS(id),rVar(currRing));
3016  for (i=1; i<=IDELEMS(id); i++)
3017  {
3018  for (j=1; j<=rVar(currRing); j++)
3019  {
3020  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
3021  }
3022  }
3023  res->data=(char *)result;
3024  return FALSE;
3025 }
#define MATELEM(mat, i, j)
Definition: matpol.h:28
#define pDiff(a, b)
Definition: polys.h:282

◆ mpKoszul()

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

Definition at line 3031 of file ipshell.cc.

3032 {
3033  int n=(int)(long)b->Data();
3034  int d=(int)(long)c->Data();
3035  int k,l,sign,row,col;
3036  matrix result;
3037  ideal temp;
3038  BOOLEAN bo;
3039  poly p;
3040 
3041  if ((d>n) || (d<1) || (n<1))
3042  {
3043  res->data=(char *)mpNew(1,1);
3044  return FALSE;
3045  }
3046  int *choise = (int*)omAlloc(d*sizeof(int));
3047  if (id==NULL)
3048  temp=idMaxIdeal(1);
3049  else
3050  temp=(ideal)id->Data();
3051 
3052  k = binom(n,d);
3053  l = k*d;
3054  l /= n-d+1;
3055  result =mpNew(l,k);
3056  col = 1;
3057  idInitChoise(d,1,n,&bo,choise);
3058  while (!bo)
3059  {
3060  sign = 1;
3061  for (l=1;l<=d;l++)
3062  {
3063  if (choise[l-1]<=IDELEMS(temp))
3064  {
3065  p = pCopy(temp->m[choise[l-1]-1]);
3066  if (sign == -1) p = pNeg(p);
3067  sign *= -1;
3068  row = idGetNumberOfChoise(l-1,d,1,n,choise);
3069  MATELEM(result,row,col) = p;
3070  }
3071  }
3072  col++;
3073  idGetNextChoise(d,n,&bo,choise);
3074  }
3075  omFreeSize(choise,d*sizeof(int));
3076  if (id==NULL) idDelete(&temp);
3077 
3078  res->data=(char *)result;
3079  return FALSE;
3080 }
int binom(int n, int r)
void idGetNextChoise(int r, int end, BOOLEAN *endch, int *choise)
#define idMaxIdeal(D)
initialise the maximal ideal (at 0)
Definition: ideals.h:33
int idGetNumberOfChoise(int t, int d, int begin, int end, int *choise)
void idInitChoise(int r, int beg, int end, BOOLEAN *endch, int *choise)
#define pNeg(p)
Definition: polys.h:185
#define pCopy(p)
return a copy of the poly
Definition: polys.h:172
static int sign(int x)
Definition: ring.cc:3328

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

4617 {
4618 
4619  poly gls;
4620  gls= (poly)(arg1->Data());
4621  int howclean= (int)(long)arg3->Data();
4622 
4623  if ( !(rField_is_R(currRing) ||
4624  rField_is_Q(currRing) ||
4627  {
4628  WerrorS("Ground field not implemented!");
4629  return TRUE;
4630  }
4631 
4634  {
4635  unsigned long int ii = (unsigned long int)arg2->Data();
4636  setGMPFloatDigits( ii, ii );
4637  }
4638 
4639  if ( gls == NULL || pIsConstant( gls ) )
4640  {
4641  WerrorS("Input polynomial is constant!");
4642  return TRUE;
4643  }
4644 
4645  int ldummy;
4646  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4647  int i,vpos=0;
4648  poly piter;
4649  lists elist;
4650  lists rlist;
4651 
4652  elist= (lists)omAlloc( sizeof(slists) );
4653  elist->Init( 0 );
4654 
4655  if ( rVar(currRing) > 1 )
4656  {
4657  piter= gls;
4658  for ( i= 1; i <= rVar(currRing); i++ )
4659  if ( pGetExp( piter, i ) )
4660  {
4661  vpos= i;
4662  break;
4663  }
4664  while ( piter )
4665  {
4666  for ( i= 1; i <= rVar(currRing); i++ )
4667  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4668  {
4669  WerrorS("The input polynomial must be univariate!");
4670  return TRUE;
4671  }
4672  pIter( piter );
4673  }
4674  }
4675 
4676  rootContainer * roots= new rootContainer();
4677  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4678  piter= gls;
4679  for ( i= deg; i >= 0; i-- )
4680  {
4681  if ( piter && pTotaldegree(piter) == i )
4682  {
4683  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4684  //nPrint( pcoeffs[i] );PrintS(" ");
4685  pIter( piter );
4686  }
4687  else
4688  {
4689  pcoeffs[i]= nInit(0);
4690  }
4691  }
4692 
4693 #ifdef mprDEBUG_PROT
4694  for (i=deg; i >= 0; i--)
4695  {
4696  nPrint( pcoeffs[i] );PrintS(" ");
4697  }
4698  PrintLn();
4699 #endif
4700 
4701  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4702  roots->solver( howclean );
4703 
4704  int elem= roots->getAnzRoots();
4705  char *dummy;
4706  int j;
4707 
4708  rlist= (lists)omAlloc( sizeof(slists) );
4709  rlist->Init( elem );
4710 
4712  {
4713  for ( j= 0; j < elem; j++ )
4714  {
4715  rlist->m[j].rtyp=NUMBER_CMD;
4716  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4717  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4718  }
4719  }
4720  else
4721  {
4722  for ( j= 0; j < elem; j++ )
4723  {
4724  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4725  rlist->m[j].rtyp=STRING_CMD;
4726  rlist->m[j].data=(void *)dummy;
4727  }
4728  }
4729 
4730  elist->Clean();
4731  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4732 
4733  // this is (via fillContainer) the same data as in root
4734  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4735  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4736 
4737  delete roots;
4738 
4739  res->rtyp= LIST_CMD;
4740  res->data= (void*)rlist;
4741 
4742  return FALSE;
4743 }
complex root finder for univariate polynomials based on laguers algorithm
Definition: mpr_numeric.h:66
void fillContainer(number *_coeffs, number *_ievpoint, const int _var, const int _tdg, const rootType _rt, const int _anz)
Definition: mpr_numeric.cc:304
gmp_complex * getRoot(const int i)
Definition: mpr_numeric.h:88
int getAnzRoots()
Definition: mpr_numeric.h:97
bool solver(const int polishmode=PM_NONE)
Definition: mpr_numeric.cc:441
#define pIter(p)
Definition: monomials.h:44
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition: mpr_complex.cc:705
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:61
#define nCopy(n)
Definition: numbers.h:16
#define nPrint(a)
only for debug, over any initalized currRing
Definition: numbers.h:47
#define pIsConstant(p)
like above, except that Comp might be != 0
Definition: polys.h:225
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:510
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:501

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

4594 {
4595  ideal gls = (ideal)(arg1->Data());
4596  int imtype= (int)(long)arg2->Data();
4597 
4598  uResultant::resMatType mtype= determineMType( imtype );
4599 
4600  // check input ideal ( = polynomial system )
4601  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4602  {
4603  return TRUE;
4604  }
4605 
4606  uResultant *resMat= new uResultant( gls, mtype, false );
4607  if (resMat!=NULL)
4608  {
4609  res->rtyp = MODUL_CMD;
4610  res->data= (void*)resMat->accessResMat()->getMatrix();
4611  if (!errorreported) delete resMat;
4612  }
4613  return errorreported;
4614 }
virtual ideal getMatrix()
Definition: mpr_base.h:31
Base class for solving 0-dim poly systems using u-resultant.
Definition: mpr_base.h:63
resMatrixBase * accessResMat()
Definition: mpr_base.h:78
@ mprOk
Definition: mpr_base.h:98
uResultant::resMatType determineMType(int imtype)
mprState mprIdealCheck(const ideal theIdeal, const char *name, uResultant::resMatType mtype, BOOLEAN rmatrix=false)

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

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

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

4746 {
4747  int i;
4748  ideal p,w;
4749  p= (ideal)arg1->Data();
4750  w= (ideal)arg2->Data();
4751 
4752  // w[0] = f(p^0)
4753  // w[1] = f(p^1)
4754  // ...
4755  // p can be a vector of numbers (multivariate polynom)
4756  // or one number (univariate polynom)
4757  // tdg = deg(f)
4758 
4759  int n= IDELEMS( p );
4760  int m= IDELEMS( w );
4761  int tdg= (int)(long)arg3->Data();
4762 
4763  res->data= (void*)NULL;
4764 
4765  // check the input
4766  if ( tdg < 1 )
4767  {
4768  WerrorS("Last input parameter must be > 0!");
4769  return TRUE;
4770  }
4771  if ( n != rVar(currRing) )
4772  {
4773  Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
4774  return TRUE;
4775  }
4776  if ( m != (int)pow((double)tdg+1,(double)n) )
4777  {
4778  Werror("Size of second input ideal must be equal to %d!",
4779  (int)pow((double)tdg+1,(double)n));
4780  return TRUE;
4781  }
4782  if ( !(rField_is_Q(currRing) /* ||
4783  rField_is_R() || rField_is_long_R() ||
4784  rField_is_long_C()*/ ) )
4785  {
4786  WerrorS("Ground field not implemented!");
4787  return TRUE;
4788  }
4789 
4790  number tmp;
4791  number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
4792  for ( i= 0; i < n; i++ )
4793  {
4794  pevpoint[i]=nInit(0);
4795  if ( (p->m)[i] )
4796  {
4797  tmp = pGetCoeff( (p->m)[i] );
4798  if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
4799  {
4800  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4801  WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
4802  return TRUE;
4803  }
4804  } else tmp= NULL;
4805  if ( !nIsZero(tmp) )
4806  {
4807  if ( !pIsConstant((p->m)[i]))
4808  {
4809  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4810  WerrorS("Elements of first input ideal must be numbers!");
4811  return TRUE;
4812  }
4813  pevpoint[i]= nCopy( tmp );
4814  }
4815  }
4816 
4817  number *wresults= (number *)omAlloc( m * sizeof( number ) );
4818  for ( i= 0; i < m; i++ )
4819  {
4820  wresults[i]= nInit(0);
4821  if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
4822  {
4823  if ( !pIsConstant((w->m)[i]))
4824  {
4825  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4826  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4827  WerrorS("Elements of second input ideal must be numbers!");
4828  return TRUE;
4829  }
4830  wresults[i]= nCopy(pGetCoeff((w->m)[i]));
4831  }
4832  }
4833 
4834  vandermonde vm( m, n, tdg, pevpoint, FALSE );
4835  number *ncpoly= vm.interpolateDense( wresults );
4836  // do not free ncpoly[]!!
4837  poly rpoly= vm.numvec2poly( ncpoly );
4838 
4839  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4840  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4841 
4842  res->data= (void*)rpoly;
4843  return FALSE;
4844 }
Rational pow(const Rational &a, int e)
Definition: GMPrat.cc:414
vandermonde system solver for interpolating polynomials from their values
Definition: mpr_numeric.h:29
#define nIsMOne(n)
Definition: numbers.h:27
#define nIsOne(n)
Definition: numbers.h:26

◆ paPrint()

void paPrint ( const char *  n,
package  p 
)

Definition at line 6273 of file ipshell.cc.

6274 {
6275  Print(" %s (",n);
6276  switch (p->language)
6277  {
6278  case LANG_SINGULAR: PrintS("S"); break;
6279  case LANG_C: PrintS("C"); break;
6280  case LANG_TOP: PrintS("T"); break;
6281  case LANG_MAX: PrintS("M"); break;
6282  case LANG_NONE: PrintS("N"); break;
6283  default: PrintS("U");
6284  }
6285  if(p->libname!=NULL)
6286  Print(",%s", p->libname);
6287  PrintS(")");
6288 }
@ LANG_MAX
Definition: subexpr.h:22
@ LANG_TOP
Definition: subexpr.h:22

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2041 of file ipshell.cc.

2042 {
2043  assume( r != NULL );
2044  const coeffs C = r->cf;
2045  assume( C != NULL );
2046 
2047  // sanity check: require currRing==r for rings with polynomial data
2048  if ( (r!=currRing) && (
2049  (nCoeff_is_algExt(C) && (C != currRing->cf))
2050  || (r->qideal != NULL)
2051 #ifdef HAVE_PLURAL
2052  || (rIsPluralRing(r))
2053 #endif
2054  )
2055  )
2056  {
2057  WerrorS("ring with polynomial data must be the base ring or compatible");
2058  return NULL;
2059  }
2060  // 0: char/ cf - ring
2061  // 1: list (var)
2062  // 2: list (ord)
2063  // 3: qideal
2064  // possibly:
2065  // 4: C
2066  // 5: D
2068  if (rIsPluralRing(r))
2069  L->Init(6);
2070  else
2071  L->Init(4);
2072  // ----------------------------------------
2073  // 0: char/ cf - ring
2074  if (rField_is_numeric(r))
2075  {
2076  rDecomposeC(&(L->m[0]),r);
2077  }
2078  else if (rField_is_Ring(r))
2079  {
2080  rDecomposeRing(&(L->m[0]),r);
2081  }
2082  else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2083  {
2084  rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2085  }
2086  else if(rField_is_GF(r))
2087  {
2089  Lc->Init(4);
2090  // char:
2091  Lc->m[0].rtyp=INT_CMD;
2092  Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2093  // var:
2095  Lv->Init(1);
2096  Lv->m[0].rtyp=STRING_CMD;
2097  Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2098  Lc->m[1].rtyp=LIST_CMD;
2099  Lc->m[1].data=(void*)Lv;
2100  // ord:
2102  Lo->Init(1);
2104  Loo->Init(2);
2105  Loo->m[0].rtyp=STRING_CMD;
2106  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2107 
2108  intvec *iv=new intvec(1); (*iv)[0]=1;
2109  Loo->m[1].rtyp=INTVEC_CMD;
2110  Loo->m[1].data=(void *)iv;
2111 
2112  Lo->m[0].rtyp=LIST_CMD;
2113  Lo->m[0].data=(void*)Loo;
2114 
2115  Lc->m[2].rtyp=LIST_CMD;
2116  Lc->m[2].data=(void*)Lo;
2117  // q-ideal:
2118  Lc->m[3].rtyp=IDEAL_CMD;
2119  Lc->m[3].data=(void *)idInit(1,1);
2120  // ----------------------
2121  L->m[0].rtyp=LIST_CMD;
2122  L->m[0].data=(void*)Lc;
2123  }
2124  else
2125  {
2126  L->m[0].rtyp=INT_CMD;
2127  L->m[0].data=(void *)(long)r->cf->ch;
2128  }
2129  // ----------------------------------------
2130  // 1: list (var)
2132  LL->Init(r->N);
2133  int i;
2134  for(i=0; i<r->N; i++)
2135  {
2136  LL->m[i].rtyp=STRING_CMD;
2137  LL->m[i].data=(void *)omStrDup(r->names[i]);
2138  }
2139  L->m[1].rtyp=LIST_CMD;
2140  L->m[1].data=(void *)LL;
2141  // ----------------------------------------
2142  // 2: list (ord)
2144  i=rBlocks(r)-1;
2145  LL->Init(i);
2146  i--;
2147  lists LLL;
2148  for(; i>=0; i--)
2149  {
2150  intvec *iv;
2151  int j;
2152  LL->m[i].rtyp=LIST_CMD;
2154  LLL->Init(2);
2155  LLL->m[0].rtyp=STRING_CMD;
2156  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2157 
2158  if((r->order[i] == ringorder_IS)
2159  || (r->order[i] == ringorder_s)) //|| r->order[i] == ringorder_S)
2160  {
2161  assume( r->block0[i] == r->block1[i] );
2162  const int s = r->block0[i];
2163  assume( (-2 < s && s < 2)||(r->order[i] != ringorder_IS));
2164 
2165  iv=new intvec(1);
2166  (*iv)[0] = s;
2167  }
2168  else if (r->block1[i]-r->block0[i] >=0 )
2169  {
2170  int bl=j=r->block1[i]-r->block0[i];
2171  if (r->order[i]==ringorder_M)
2172  {
2173  j=(j+1)*(j+1)-1;
2174  bl=j+1;
2175  }
2176  else if (r->order[i]==ringorder_am)
2177  {
2178  j+=r->wvhdl[i][bl+1];
2179  }
2180  iv=new intvec(j+1);
2181  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2182  {
2183  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2184  }
2185  else switch (r->order[i])
2186  {
2187  case ringorder_dp:
2188  case ringorder_Dp:
2189  case ringorder_ds:
2190  case ringorder_Ds:
2191  case ringorder_lp:
2192  for(;j>=0; j--) (*iv)[j]=1;
2193  break;
2194  default: /* do nothing */;
2195  }
2196  }
2197  else
2198  {
2199  iv=new intvec(1);
2200  }
2201  LLL->m[1].rtyp=INTVEC_CMD;
2202  LLL->m[1].data=(void *)iv;
2203  LL->m[i].data=(void *)LLL;
2204  }
2205  L->m[2].rtyp=LIST_CMD;
2206  L->m[2].data=(void *)LL;
2207  // ----------------------------------------
2208  // 3: qideal
2209  L->m[3].rtyp=IDEAL_CMD;
2210  if (r->qideal==NULL)
2211  L->m[3].data=(void *)idInit(1,1);
2212  else
2213  L->m[3].data=(void *)idCopy(r->qideal);
2214  // ----------------------------------------
2215 #ifdef HAVE_PLURAL // NC! in rDecompose
2216  if (rIsPluralRing(r))
2217  {
2218  L->m[4].rtyp=MATRIX_CMD;
2219  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2220  L->m[5].rtyp=MATRIX_CMD;
2221  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2222  }
2223 #endif
2224  return L;
2225 }
CanonicalForm Lc(const CanonicalForm &f)
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:924
ideal idCopy(ideal A)
Definition: ideals.h:60
static void rDecomposeC(leftv h, const ring R)
Definition: ipshell.cc:1743
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1621
void rDecomposeRing(leftv h, const ring R)
Definition: ipshell.cc:1807
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:63
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:78
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:616
@ ringorder_lp
Definition: ring.h:84
@ ringorder_am
Definition: ring.h:95
@ ringorder_ds
Definition: ring.h:91
@ ringorder_Dp
Definition: ring.h:87
@ ringorder_Ds
Definition: ring.h:92
@ ringorder_dp
Definition: ring.h:85
@ ringorder_IS
Induced (Schreyer) ordering.
Definition: ring.h:100
@ ringorder_s
s?
Definition: ring.h:83
@ ringorder_M
Definition: ring.h:81
static BOOLEAN rField_is_numeric(const ring r)
Definition: ring.h:507
static BOOLEAN rField_is_GF(const ring r)
Definition: ring.h:513

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1839 of file ipshell.cc.

1840 {
1841  assume( C != NULL );
1842 
1843  // sanity check: require currRing==r for rings with polynomial data
1844  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1845  {
1846  WerrorS("ring with polynomial data must be the base ring or compatible");
1847  return TRUE;
1848  }
1849  if (nCoeff_is_numeric(C))
1850  {
1851  rDecomposeC_41(res,C);
1852  }
1853 #ifdef HAVE_RINGS
1854  else if (nCoeff_is_Ring(C))
1855  {
1857  }
1858 #endif
1859  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1860  {
1861  rDecomposeCF(res, C->extRing, currRing);
1862  }
1863  else if(nCoeff_is_GF(C))
1864  {
1866  Lc->Init(4);
1867  // char:
1868  Lc->m[0].rtyp=INT_CMD;
1869  Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1870  // var:
1872  Lv->Init(1);
1873  Lv->m[0].rtyp=STRING_CMD;
1874  Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1875  Lc->m[1].rtyp=LIST_CMD;
1876  Lc->m[1].data=(void*)Lv;
1877  // ord:
1879  Lo->Init(1);
1881  Loo->Init(2);
1882  Loo->m[0].rtyp=STRING_CMD;
1883  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1884 
1885  intvec *iv=new intvec(1); (*iv)[0]=1;
1886  Loo->m[1].rtyp=INTVEC_CMD;
1887  Loo->m[1].data=(void *)iv;
1888 
1889  Lo->m[0].rtyp=LIST_CMD;
1890  Lo->m[0].data=(void*)Loo;
1891 
1892  Lc->m[2].rtyp=LIST_CMD;
1893  Lc->m[2].data=(void*)Lo;
1894  // q-ideal:
1895  Lc->m[3].rtyp=IDEAL_CMD;
1896  Lc->m[3].data=(void *)idInit(1,1);
1897  // ----------------------
1898  res->rtyp=LIST_CMD;
1899  res->data=(void*)Lc;
1900  }
1901  else
1902  {
1903  res->rtyp=INT_CMD;
1904  res->data=(void *)(long)C->ch;
1905  }
1906  // ----------------------------------------
1907  return FALSE;
1908 }
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition: coeffs.h:853
static FORCE_INLINE BOOLEAN nCoeff_is_numeric(const coeffs r)
Definition: coeffs.h:846
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:809
static FORCE_INLINE BOOLEAN nCoeff_is_Ring(const coeffs r)
Definition: coeffs.h:759
static void rDecomposeC_41(leftv h, const coeffs C)
Definition: ipshell.cc:1709
void rDecomposeRing_41(leftv h, const coeffs C)
Definition: ipshell.cc:1779

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 1910 of file ipshell.cc.

1911 {
1912  assume( r != NULL );
1913  const coeffs C = r->cf;
1914  assume( C != NULL );
1915 
1916  // sanity check: require currRing==r for rings with polynomial data
1917  if ( (r!=currRing) && (
1918  (r->qideal != NULL)
1919 #ifdef HAVE_PLURAL
1920  || (rIsPluralRing(r))
1921 #endif
1922  )
1923  )
1924  {
1925  WerrorS("ring with polynomial data must be the base ring or compatible");
1926  return NULL;
1927  }
1928  // 0: char/ cf - ring
1929  // 1: list (var)
1930  // 2: list (ord)
1931  // 3: qideal
1932  // possibly:
1933  // 4: C
1934  // 5: D
1936  if (rIsPluralRing(r))
1937  L->Init(6);
1938  else
1939  L->Init(4);
1940  // ----------------------------------------
1941  // 0: char/ cf - ring
1942  L->m[0].rtyp=CRING_CMD;
1943  L->m[0].data=(char*)r->cf; r->cf->ref++;
1944  // ----------------------------------------
1945  // 1: list (var)
1947  LL->Init(r->N);
1948  int i;
1949  for(i=0; i<r->N; i++)
1950  {
1951  LL->m[i].rtyp=STRING_CMD;
1952  LL->m[i].data=(void *)omStrDup(r->names[i]);
1953  }
1954  L->m[1].rtyp=LIST_CMD;
1955  L->m[1].data=(void *)LL;
1956  // ----------------------------------------
1957  // 2: list (ord)
1959  i=rBlocks(r)-1;
1960  LL->Init(i);
1961  i--;
1962  lists LLL;
1963  for(; i>=0; i--)
1964  {
1965  intvec *iv;
1966  int j;
1967  LL->m[i].rtyp=LIST_CMD;
1969  LLL->Init(2);
1970  LLL->m[0].rtyp=STRING_CMD;
1971  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1972 
1973  if(r->order[i] == ringorder_IS) // || r->order[i] == ringorder_s || r->order[i] == ringorder_S)
1974  {
1975  assume( r->block0[i] == r->block1[i] );
1976  const int s = r->block0[i];
1977  assume( -2 < s && s < 2);
1978 
1979  iv=new intvec(1);
1980  (*iv)[0] = s;
1981  }
1982  else if (r->block1[i]-r->block0[i] >=0 )
1983  {
1984  int bl=j=r->block1[i]-r->block0[i];
1985  if (r->order[i]==ringorder_M)
1986  {
1987  j=(j+1)*(j+1)-1;
1988  bl=j+1;
1989  }
1990  else if (r->order[i]==ringorder_am)
1991  {
1992  j+=r->wvhdl[i][bl+1];
1993  }
1994  iv=new intvec(j+1);
1995  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1996  {
1997  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
1998  }
1999  else switch (r->order[i])
2000  {
2001  case ringorder_dp:
2002  case ringorder_Dp:
2003  case ringorder_ds:
2004  case ringorder_Ds:
2005  case ringorder_lp:
2006  for(;j>=0; j--) (*iv)[j]=1;
2007  break;
2008  default: /* do nothing */;
2009  }
2010  }
2011  else
2012  {
2013  iv=new intvec(1);
2014  }
2015  LLL->m[1].rtyp=INTVEC_CMD;
2016  LLL->m[1].data=(void *)iv;
2017  LL->m[i].data=(void *)LLL;
2018  }
2019  L->m[2].rtyp=LIST_CMD;
2020  L->m[2].data=(void *)LL;
2021  // ----------------------------------------
2022  // 3: qideal
2023  L->m[3].rtyp=IDEAL_CMD;
2024  if (r->qideal==NULL)
2025  L->m[3].data=(void *)idInit(1,1);
2026  else
2027  L->m[3].data=(void *)idCopy(r->qideal);
2028  // ----------------------------------------
2029 #ifdef HAVE_PLURAL // NC! in rDecompose
2030  if (rIsPluralRing(r))
2031  {
2032  L->m[4].rtyp=MATRIX_CMD;
2033  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2034  L->m[5].rtyp=MATRIX_CMD;
2035  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2036  }
2037 #endif
2038  return L;
2039 }

◆ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1550 of file ipshell.cc.

1551 {
1552  idhdl tmp=NULL;
1553 
1554  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
1555  if (tmp==NULL) return NULL;
1556 
1557 // if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
1559  {
1561  memset(&sLastPrinted,0,sizeof(sleftv));
1562  }
1563 
1564  ring r = IDRING(tmp) = (ring) omAlloc0Bin(sip_sring_bin);
1565 
1566  r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1567  r->N = 3;
1568  /*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
1569  /*names*/
1570  r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
1571  r->names[0] = omStrDup("x");
1572  r->names[1] = omStrDup("y");
1573  r->names[2] = omStrDup("z");
1574  /*weights: entries for 3 blocks: NULL*/
1575  r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1576  /*order: dp,C,0*/
1577  r->order = (rRingOrder_t *) omAlloc(3 * sizeof(rRingOrder_t *));
1578  r->block0 = (int *)omAlloc0(3 * sizeof(int *));
1579  r->block1 = (int *)omAlloc0(3 * sizeof(int *));
1580  /* ringorder dp for the first block: var 1..3 */
1581  r->order[0] = ringorder_dp;
1582  r->block0[0] = 1;
1583  r->block1[0] = 3;
1584  /* ringorder C for the second block: no vars */
1585  r->order[1] = ringorder_C;
1586  /* the last block: everything is 0 */
1587  r->order[2] = (rRingOrder_t)0;
1588 
1589  /* complete ring intializations */
1590  rComplete(r);
1591  rSetHdl(tmp);
1592  return currRingHdl;
1593 }
@ n_Zp
\F{p < 2^31}
Definition: coeffs.h:30
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:349
omBin sip_sring_bin
Definition: ring.cc:44
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:3351
rRingOrder_t
order stuff
Definition: ring.h:75
@ ringorder_C
Definition: ring.h:80
char * char_ptr
Definition: structs.h:56
int * int_ptr
Definition: structs.h:57

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1595 of file ipshell.cc.

1596 {
1598  if (h!=NULL) return h;
1599  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1600  if (h!=NULL) return h;
1602  while(p!=NULL)
1603  {
1604  if ((p->cPack!=basePack)
1605  && (p->cPack!=currPack))
1606  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1607  if (h!=NULL) return h;
1608  p=p->next;
1609  }
1610  idhdl tmp=basePack->idroot;
1611  while (tmp!=NULL)
1612  {
1613  if (IDTYP(tmp)==PACKAGE_CMD)
1614  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1615  if (h!=NULL) return h;
1616  tmp=IDNEXT(tmp);
1617  }
1618  return NULL;
1619 }
Definition: ipid.h:55
idhdl rSimpleFindHdl(ring r, idhdl root, idhdl n)
Definition: ipshell.cc:6165

◆ rInit()

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

Definition at line 5543 of file ipshell.cc.

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

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6122 of file ipshell.cc.

6123 {
6124  ring r = IDRING(h);
6125  int ref=0;
6126  if (r!=NULL)
6127  {
6128  // avoid, that sLastPrinted is the last reference to the base ring:
6129  // clean up before killing the last "named" refrence:
6130  if ((sLastPrinted.rtyp==RING_CMD)
6131  && (sLastPrinted.data==(void*)r))
6132  {
6133  sLastPrinted.CleanUp(r);
6134  }
6135  ref=r->ref;
6136  if ((ref<=0)&&(r==currRing))
6137  {
6138  // cleanup DENOMINATOR_LIST
6139  if (DENOMINATOR_LIST!=NULL)
6140  {
6142  if (TEST_V_ALLWARN)
6143  Warn("deleting denom_list for ring change from %s",IDID(h));
6144  do
6145  {
6146  n_Delete(&(dd->n),currRing->cf);
6147  dd=dd->next;
6149  DENOMINATOR_LIST=dd;
6150  } while(DENOMINATOR_LIST!=NULL);
6151  }
6152  }
6153  rKill(r);
6154  }
6155  if (h==currRingHdl)
6156  {
6157  if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6158  else
6159  {
6161  }
6162  }
6163 }
void rKill(ring r)
Definition: ipshell.cc:6076
denominator_list DENOMINATOR_LIST
Definition: kutil.cc:87
denominator_list next
Definition: kutil.h:61

◆ rKill() [2/2]

void rKill ( ring  r)

Definition at line 6076 of file ipshell.cc.

6077 {
6078  if ((r->ref<=0)&&(r->order!=NULL))
6079  {
6080 #ifdef RDEBUG
6081  if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6082 #endif
6083  int j;
6084  for (j=0;j<myynest;j++)
6085  {
6086  if (iiLocalRing[j]==r)
6087  {
6088  if (j==0) WarnS("killing the basering for level 0");
6089  iiLocalRing[j]=NULL;
6090  }
6091  }
6092 // any variables depending on r ?
6093  while (r->idroot!=NULL)
6094  {
6095  r->idroot->lev=myynest; // avoid warning about kill global objects
6096  killhdl2(r->idroot,&(r->idroot),r);
6097  }
6098  if (r==currRing)
6099  {
6100  // all dependend stuff is done, clean global vars:
6101  if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6103  {
6105  }
6106  //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6107  //{
6108  // WerrorS("return value depends on local ring variable (export missing ?)");
6109  // iiRETURNEXPR.CleanUp();
6110  //}
6111  currRing=NULL;
6112  currRingHdl=NULL;
6113  }
6114 
6115  /* nKillChar(r); will be called from inside of rDelete */
6116  rDelete(r);
6117  return;
6118  }
6119  r->ref--;
6120 }
#define pDelete(p_ptr)
Definition: polys.h:173

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5050 of file ipshell.cc.

5051 {
5052  ring rg = NULL;
5053  if (h!=NULL)
5054  {
5055 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5056  rg = IDRING(h);
5057  if (rg==NULL) return; //id <>NULL, ring==NULL
5058  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5059  if (IDID(h)) // OB: ????
5061  rTest(rg);
5062  }
5063  else return;
5064 
5065  // clean up history
5066  if (currRing!=NULL)
5067  {
5069  {
5071  //memset(&sLastPrinted,0,sizeof(sleftv)); // done by Cleanup,Init
5072  }
5073 
5074  if (rg!=currRing)/*&&(currRing!=NULL)*/
5075  {
5076  if (rg->cf!=currRing->cf)
5077  {
5079  if (DENOMINATOR_LIST!=NULL)
5080  {
5081  if (TEST_V_ALLWARN)
5082  Warn("deleting denom_list for ring change to %s",IDID(h));
5083  do
5084  {
5085  n_Delete(&(dd->n),currRing->cf);
5086  dd=dd->next;
5088  DENOMINATOR_LIST=dd;
5089  } while(DENOMINATOR_LIST!=NULL);
5090  }
5091  }
5092  }
5093  }
5094 
5095  // test for valid "currRing":
5096  if ((rg!=NULL) && (rg->idroot==NULL))
5097  {
5098  ring old=rg;
5099  rg=rAssure_HasComp(rg);
5100  if (old!=rg)
5101  {
5102  rKill(old);
5103  IDRING(h)=rg;
5104  }
5105  }
5106  /*------------ change the global ring -----------------------*/
5107  rChangeCurrRing(rg);
5108  currRingHdl = h;
5109 }
#define omCheckAddr(addr)
Definition: omAllocDecl.h:328
#define omCheckAddrSize(addr, size)
Definition: omAllocDecl.h:327
ring rAssure_HasComp(const ring r)
Definition: ring.cc:4540

◆ rSimpleFindHdl()

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

Definition at line 6165 of file ipshell.cc.

6166 {
6167  idhdl h=root;
6168  while (h!=NULL)
6169  {
6170  if ((IDTYP(h)==RING_CMD)
6171  && (h!=n)
6172  && (IDRING(h)==r)
6173  )
6174  {
6175  return h;
6176  }
6177  h=IDNEXT(h);
6178  }
6179  return NULL;
6180 }

◆ scIndIndset()

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

Definition at line 1022 of file ipshell.cc.

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

◆ semicProc()

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

Definition at line 4489 of file ipshell.cc.

4490 {
4491  sleftv tmp;
4492  memset(&tmp,0,sizeof(tmp));
4493  tmp.rtyp=INT_CMD;
4494  /* tmp.data = (void *)0; -- done by memset */
4495 
4496  return semicProc3(res,u,v,&tmp);
4497 }

◆ semicProc3()

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

Definition at line 4449 of file ipshell.cc.

4450 {
4451  semicState state;
4452  BOOLEAN qh=(((int)(long)w->Data())==1);
4453 
4454  // -----------------
4455  // check arguments
4456  // -----------------
4457 
4458  lists l1 = (lists)u->Data( );
4459  lists l2 = (lists)v->Data( );
4460 
4461  if( (state=list_is_spectrum( l1 ))!=semicOK )
4462  {
4463  WerrorS( "first argument is not a spectrum" );
4464  list_error( state );
4465  }
4466  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4467  {
4468  WerrorS( "second argument is not a spectrum" );
4469  list_error( state );
4470  }
4471  else
4472  {
4473  spectrum s1= spectrumFromList( l1 );
4474  spectrum s2= spectrumFromList( l2 );
4475 
4476  res->rtyp = INT_CMD;
4477  if (qh)
4478  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4479  else
4480  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4481  }
4482 
4483  // -----------------
4484  // check status
4485  // -----------------
4486 
4487  return (state!=semicOK);
4488 }
Definition: semic.h:64
int mult_spectrum(spectrum &)
Definition: semic.cc:396
int mult_spectrumh(spectrum &)
Definition: semic.cc:425
semicState
Definition: ipshell.cc:3373
@ semicOK
Definition: ipshell.cc:3374
void list_error(semicState state)
Definition: ipshell.cc:3406
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3322
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4191

◆ setOption()

BOOLEAN setOption ( leftv  res,
leftv  v 
)

Definition at line 585 of file misc_ip.cc.

586 {
587  const char *n;
588  do
589  {
590  if (v->Typ()==STRING_CMD)
591  {
592  n=(const char *)v->CopyD(STRING_CMD);
593  }
594  else
595  {
596  if (v->name==NULL)
597  return TRUE;
598  if (v->rtyp==0)
599  {
600  n=v->name;
601  v->name=NULL;
602  }
603  else
604  {
605  n=omStrDup(v->name);
606  }
607  }
608 
609  int i;
610 
611  if(strcmp(n,"get")==0)
612  {
613  intvec *w=new intvec(2);
614  (*w)[0]=si_opt_1;
615  (*w)[1]=si_opt_2;
616  res->rtyp=INTVEC_CMD;
617  res->data=(void *)w;
618  goto okay;
619  }
620  if(strcmp(n,"set")==0)
621  {
622  if((v->next!=NULL)
623  &&(v->next->Typ()==INTVEC_CMD))
624  {
625  v=v->next;
626  intvec *w=(intvec*)v->Data();
627  si_opt_1=(*w)[0];
628  si_opt_2=(*w)[1];
629 #if 0
633  ) {
635  }
636 #endif
637  goto okay;
638  }
639  }
640  if(strcmp(n,"none")==0)
641  {
642  si_opt_1=0;
643  si_opt_2=0;
644  goto okay;
645  }
646  for (i=0; (i==0) || (optionStruct[i-1].setval!=0); i++)
647  {
648  if (strcmp(n,optionStruct[i].name)==0)
649  {
650  if (optionStruct[i].setval & validOpts)
651  {
653  // optOldStd disables redthrough
654  if (optionStruct[i].setval == Sy_bit(OPT_OLDSTD))
656  }
657  else
658  WarnS("cannot set option");
659 #if 0
663  ) {
665  }
666 #endif
667  goto okay;
668  }
669  else if ((strncmp(n,"no",2)==0)
670  && (strcmp(n+2,optionStruct[i].name)==0))
671  {
672  if (optionStruct[i].setval & validOpts)
673  {
675  }
676  else
677  WarnS("cannot clear option");
678  goto okay;
679  }
680  }
681  for (i=0; (i==0) || (verboseStruct[i-1].setval!=0); i++)
682  {
683  if (strcmp(n,verboseStruct[i].name)==0)
684  {
686  #ifdef YYDEBUG
687  #if YYDEBUG
688  /*debugging the bison grammar --> grammar.cc*/
689  extern int yydebug;
690  if (BVERBOSE(V_YACC)) yydebug=1;
691  else yydebug=0;
692  #endif
693  #endif
694  goto okay;
695  }
696  else if ((strncmp(n,"no",2)==0)
697  && (strcmp(n+2,verboseStruct[i].name)==0))
698  {
700  #ifdef YYDEBUG
701  #if YYDEBUG
702  /*debugging the bison grammar --> grammar.cc*/
703  extern int yydebug;
704  if (BVERBOSE(V_YACC)) yydebug=1;
705  else yydebug=0;
706  #endif
707  #endif
708  goto okay;
709  }
710  }
711  Werror("unknown option `%s`",n);
712  okay:
713  if (currRing != NULL)
714  currRing->options = si_opt_1 & TEST_RINGDEP_OPTS;
715  omFree((ADDRESS)n);
716  v=v->next;
717  } while (v!=NULL);
718 
719  // set global variable to show memory usage
720  extern int om_sing_opt_show_mem;
721  if (BVERBOSE(V_SHOW_MEM)) om_sing_opt_show_mem = 1;
722  else om_sing_opt_show_mem = 0;
723 
724  return FALSE;
725 }
CanonicalForm test
Definition: cfModGcd.cc:4037
int yydebug
Definition: grammar.cc:1803
unsigned resetval
Definition: ipid.h:149
BITSET validOpts
Definition: kstd1.cc:59
const struct soptionStruct verboseStruct[]
Definition: misc_ip.cc:555
const struct soptionStruct optionStruct[]
Definition: misc_ip.cc:525
#define OPT_INTSTRATEGY
Definition: options.h:91
#define TEST_OPT_INTSTRATEGY
Definition: options.h:109
#define V_SHOW_MEM
Definition: options.h:43
#define V_YACC
Definition: options.h:44
#define OPT_REDTHROUGH
Definition: options.h:81
#define Sy_bit(x)
Definition: options.h:32
#define TEST_RINGDEP_OPTS
Definition: options.h:99
#define OPT_OLDSTD
Definition: options.h:85
static BOOLEAN rField_has_simple_inverse(const ring r)
Definition: ring.h:540

◆ showOption()

char* showOption ( )

Definition at line 727 of file misc_ip.cc.

728 {
729  int i;
730  BITSET tmp;
731 
732  StringSetS("//options:");
733  if ((si_opt_1!=0)||(si_opt_2!=0))
734  {
735  tmp=si_opt_1;
736  if(tmp)
737  {
738  for (i=0; optionStruct[i].setval!=0; i++)
739  {
740  if (optionStruct[i].setval & tmp)
741  {
743  tmp &=optionStruct[i].resetval;
744  }
745  }
746  for (i=0; i<32; i++)
747  {
748  if (tmp & Sy_bit(i)) StringAppend(" %d",i);
749  }
750  }
751  tmp=si_opt_2;
752  if (tmp)
753  {
754  for (i=0; verboseStruct[i].setval!=0; i++)
755  {
756  if (verboseStruct[i].setval & tmp)
757  {
759  tmp &=verboseStruct[i].resetval;
760  }
761  }
762  for (i=1; i<32; i++)
763  {
764  if (tmp & Sy_bit(i)) StringAppend(" %d",i+32);
765  }
766  }
767  return StringEndS();
768  }
769  StringAppendS(" none");
770  return StringEndS();
771 }
#define StringAppend
Definition: emacs.cc:79
void StringAppendS(const char *st)
Definition: reporter.cc:107

◆ singular_example()

void singular_example ( char *  str)

Definition at line 448 of file misc_ip.cc.

449 {
450  assume(str!=NULL);
451  char *s=str;
452  while (*s==' ') s++;
453  char *ss=s;
454  while (*ss!='\0') ss++;
455  while (*ss<=' ')
456  {
457  *ss='\0';
458  ss--;
459  }
460  idhdl h=IDROOT->get(s,myynest);
461  if ((h!=NULL) && (IDTYP(h)==PROC_CMD))
462  {
463  char *lib=iiGetLibName(IDPROC(h));
464  if((lib!=NULL)&&(*lib!='\0'))
465  {
466  Print("// proc %s from lib %s\n",s,lib);
468  if (s!=NULL)
469  {
470  if (strlen(s)>5)
471  {
472  iiEStart(s,IDPROC(h));
473  omFree((ADDRESS)s);
474  return;
475  }
476  else omFree((ADDRESS)s);
477  }
478  }
479  }
480  else
481  {
482  char sing_file[MAXPATHLEN];
483  FILE *fd=NULL;
484  char *res_m=feResource('m', 0);
485  if (res_m!=NULL)
486  {
487  sprintf(sing_file, "%s/%s.sing", res_m, s);
488  fd = feFopen(sing_file, "r");
489  }
490  if (fd != NULL)
491  {
492 
493  int old_echo = si_echo;
494  int length, got;
495  char* s;
496 
497  fseek(fd, 0, SEEK_END);
498  length = ftell(fd);
499  fseek(fd, 0, SEEK_SET);
500  s = (char*) omAlloc((length+20)*sizeof(char));
501  got = fread(s, sizeof(char), length, fd);
502  fclose(fd);
503  if (got != length)
504  {
505  Werror("Error while reading file %s", sing_file);
506  }
507  else
508  {
509  s[length] = '\0';
510  strcat(s, "\n;return();\n\n");
511  si_echo = 2;
512  iiEStart(s, NULL);
513  si_echo = old_echo;
514  }
515  omFree(s);
516  }
517  else
518  {
519  Werror("no example for %s", str);
520  }
521  }
522 }
BOOLEAN iiEStart(char *example, procinfo *pi)
Definition: iplib.cc:699
static char * iiGetLibName(const procinfov pi)
find the library of an proc
Definition: ipshell.h:66
#define SEEK_SET
Definition: mod2.h:116
#define SEEK_END
Definition: mod2.h:112
int status int fd
Definition: si_signals.h:59

◆ singular_system()

leftv singular_system ( sleftv  h)

◆ spaddProc()

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

Definition at line 4366 of file ipshell.cc.

4367 {
4368  semicState state;
4369 
4370  // -----------------
4371  // check arguments
4372  // -----------------
4373 
4374  lists l1 = (lists)first->Data( );
4375  lists l2 = (lists)second->Data( );
4376 
4377  if( (state=list_is_spectrum( l1 )) != semicOK )
4378  {
4379  WerrorS( "first argument is not a spectrum:" );
4380  list_error( state );
4381  }
4382  else if( (state=list_is_spectrum( l2 )) != semicOK )
4383  {
4384  WerrorS( "second argument is not a spectrum:" );
4385  list_error( state );
4386  }
4387  else
4388  {
4389  spectrum s1= spectrumFromList ( l1 );
4390  spectrum s2= spectrumFromList ( l2 );
4391  spectrum sum( s1+s2 );
4392 
4393  result->rtyp = LIST_CMD;
4394  result->data = (char*)(getList(sum));
4395  }
4396 
4397  return (state!=semicOK);
4398 }
lists getList(spectrum &spec)
Definition: ipshell.cc:3334

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv  result,
leftv  first 
)

Definition at line 4122 of file ipshell.cc.

4123 {
4124  spectrumState state = spectrumOK;
4125 
4126  // -------------------
4127  // check consistency
4128  // -------------------
4129 
4130  // check for a local polynomial ring
4131 
4132  if( currRing->OrdSgn != -1 )
4133  // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4134  // or should we use:
4135  //if( !ringIsLocal( ) )
4136  {
4137  WerrorS( "only works for local orderings" );
4138  state = spectrumWrongRing;
4139  }
4140  else if( currRing->qideal != NULL )
4141  {
4142  WerrorS( "does not work in quotient rings" );
4143  state = spectrumWrongRing;
4144  }
4145  else
4146  {
4147  lists L = (lists)NULL;
4148  int flag = 2; // symmetric optimization
4149 
4150  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4151 
4152  if( state==spectrumOK )
4153  {
4154  result->rtyp = LIST_CMD;
4155  result->data = (char*)L;
4156  }
4157  else
4158  {
4159  spectrumPrintError(state);
4160  }
4161  }
4162 
4163  return (state!=spectrumOK);
4164 }
spectrumState
Definition: ipshell.cc:3489
@ spectrumWrongRing
Definition: ipshell.cc:3496
@ spectrumOK
Definition: ipshell.cc:3490
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3748
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:4040

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4071 of file ipshell.cc.

4072 {
4073  spectrumState state = spectrumOK;
4074 
4075  // -------------------
4076  // check consistency
4077  // -------------------
4078 
4079  // check for a local ring
4080 
4081  if( !ringIsLocal(currRing ) )
4082  {
4083  WerrorS( "only works for local orderings" );
4084  state = spectrumWrongRing;
4085  }
4086 
4087  // no quotient rings are allowed
4088 
4089  else if( currRing->qideal != NULL )
4090  {
4091  WerrorS( "does not work in quotient rings" );
4092  state = spectrumWrongRing;
4093  }
4094  else
4095  {
4096  lists L = (lists)NULL;
4097  int flag = 1; // weight corner optimization is safe
4098 
4099  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4100 
4101  if( state==spectrumOK )
4102  {
4103  result->rtyp = LIST_CMD;
4104  result->data = (char*)L;
4105  }
4106  else
4107  {
4108  spectrumPrintError(state);
4109  }
4110  }
4111 
4112  return (state!=spectrumOK);
4113 }
BOOLEAN ringIsLocal(const ring r)
Definition: spectrum.cc:461

◆ spmulProc()

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

Definition at line 4408 of file ipshell.cc.

4409 {
4410  semicState state;
4411 
4412  // -----------------
4413  // check arguments
4414  // -----------------
4415 
4416  lists l = (lists)first->Data( );
4417  int k = (int)(long)second->Data( );
4418 
4419  if( (state=list_is_spectrum( l ))!=semicOK )
4420  {
4421  WerrorS( "first argument is not a spectrum" );
4422  list_error( state );
4423  }
4424  else if( k < 0 )
4425  {
4426  WerrorS( "second argument should be positive" );
4427  state = semicMulNegative;
4428  }
4429  else
4430  {
4432  spectrum product( k*s );
4433 
4434  result->rtyp = LIST_CMD;
4435  result->data = (char*)getList(product);
4436  }
4437 
4438  return (state!=semicOK);
4439 }
@ semicMulNegative
Definition: ipshell.cc:3375

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3110 of file ipshell.cc.

3111 {
3112  sleftv tmp;
3113  memset(&tmp,0,sizeof(tmp));
3114  tmp.rtyp=INT_CMD;
3115  tmp.data=(void *)1;
3116  return syBetti2(res,u,&tmp);
3117 }
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3087

◆ syBetti2()

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

Definition at line 3087 of file ipshell.cc.

3088 {
3089  syStrategy syzstr=(syStrategy)u->Data();
3090 
3091  BOOLEAN minim=(int)(long)w->Data();
3092  int row_shift=0;
3093  int add_row_shift=0;
3094  intvec *weights=NULL;
3095  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3096  if (ww!=NULL)
3097  {
3098  weights=ivCopy(ww);
3099  add_row_shift = ww->min_in();
3100  (*weights) -= add_row_shift;
3101  }
3102 
3103  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3104  //row_shift += add_row_shift;
3105  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3106  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3107 
3108  return FALSE;
3109 }
intvec * syBettiOfComputation(syStrategy syzstr, BOOLEAN minim=TRUE, int *row_shift=NULL, intvec *weights=NULL)
Definition: syz1.cc:1756
ssyStrategy * syStrategy
Definition: syz.h:35

◆ syConvList()

syStrategy syConvList ( lists  li)

Definition at line 3194 of file ipshell.cc.

3195 {
3196  int typ0;
3198 
3199  resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3200  if (fr != NULL)
3201  {
3202 
3203  result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3204  for (int i=result->length-1;i>=0;i--)
3205  {
3206  if (fr[i]!=NULL)
3207  result->fullres[i] = idCopy(fr[i]);
3208  }
3209  result->list_length=result->length;
3210  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3211  }
3212  else
3213  {
3214  omFreeSize(result, sizeof(ssyStrategy));
3215  result = NULL;
3216  }
3217  return result;
3218 }

◆ syConvRes()

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

Definition at line 3122 of file ipshell.cc.

3123 {
3124  resolvente fullres = syzstr->fullres;
3125  resolvente minres = syzstr->minres;
3126 
3127  const int length = syzstr->length;
3128 
3129  if ((fullres==NULL) && (minres==NULL))
3130  {
3131  if (syzstr->hilb_coeffs==NULL)
3132  { // La Scala
3133  fullres = syReorder(syzstr->res, length, syzstr);
3134  }
3135  else
3136  { // HRES
3137  minres = syReorder(syzstr->orderedRes, length, syzstr);
3138  syKillEmptyEntres(minres, length);
3139  }
3140  }
3141 
3142  resolvente tr;
3143  int typ0=IDEAL_CMD;
3144 
3145  if (minres!=NULL)
3146  tr = minres;
3147  else
3148  tr = fullres;
3149 
3150  resolvente trueres=NULL;
3151  intvec ** w=NULL;
3152 
3153  if (length>0)
3154  {
3155  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3156  for (int i=length-1;i>=0;i--)
3157  {
3158  if (tr[i]!=NULL)
3159  {
3160  trueres[i] = idCopy(tr[i]);
3161  }
3162  }
3163  if ( id_RankFreeModule(trueres[0], currRing) > 0)
3164  typ0 = MODUL_CMD;
3165  if (syzstr->weights!=NULL)
3166  {
3167  w = (intvec**)omAlloc0(length*sizeof(intvec*));
3168  for (int i=length-1;i>=0;i--)
3169  {
3170  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3171  }
3172  }
3173  }
3174 
3175  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3176  w, add_row_shift);
3177 
3178  if (toDel)
3179  syKillComputation(syzstr);
3180  else
3181  {
3182  if( fullres != NULL && syzstr->fullres == NULL )
3183  syzstr->fullres = fullres;
3184 
3185  if( minres != NULL && syzstr->minres == NULL )
3186  syzstr->minres = minres;
3187  }
3188  return li;
3189 }
long id_RankFreeModule(ideal s, ring lmRing, ring tailRing)
return the maximal component number found in any polynomial in s
intvec ** hilb_coeffs
Definition: syz.h:46
resolvente minres
Definition: syz.h:58
void syKillComputation(syStrategy syzstr, ring r=currRing)
Definition: syz1.cc:1496
resolvente syReorder(resolvente res, int length, syStrategy syzstr, BOOLEAN toCopy=TRUE, resolvente totake=NULL)
Definition: syz1.cc:1642
void syKillEmptyEntres(resolvente res, int length)
Definition: syz1.cc:2201
short list_length
Definition: syz.h:62
resolvente res
Definition: syz.h:47
resolvente fullres
Definition: syz.h:57
intvec ** weights
Definition: syz.h:45
resolvente orderedRes
Definition: syz.h:48
int length
Definition: syz.h:60

◆ syForceMin()

syStrategy syForceMin ( lists  li)

Definition at line 3223 of file ipshell.cc.

3224 {
3225  int typ0;
3227 
3228  resolvente fr = liFindRes(li,&(result->length),&typ0);
3229  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3230  for (int i=result->length-1;i>=0;i--)
3231  {
3232  if (fr[i]!=NULL)
3233  result->minres[i] = idCopy(fr[i]);
3234  }
3235  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3236  return result;
3237 }

◆ test_cmd()

void test_cmd ( int  i)

Definition at line 506 of file ipshell.cc.

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

◆ Tok2Cmdname()

const char* Tok2Cmdname ( int  i)

Definition at line 138 of file gentable.cc.

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

◆ type_cmd()

void type_cmd ( leftv  v)

Definition at line 246 of file ipshell.cc.

247 {
248  BOOLEAN oldShortOut = FALSE;
249 
250  if (currRing != NULL)
251  {
252  oldShortOut = currRing->ShortOut;
253  currRing->ShortOut = 1;
254  }
255  int t=v->Typ();
256  Print("// %s %s ",v->Name(),Tok2Cmdname(t));
257  switch (t)
258  {
259  case MAP_CMD:Print(" from %s\n",((map)(v->Data()))->preimage); break;
260  case INTMAT_CMD: Print(" %d x %d\n",((intvec*)(v->Data()))->rows(),
261  ((intvec*)(v->Data()))->cols()); break;
262  case MATRIX_CMD:Print(" %u x %u\n" ,
263  MATROWS((matrix)(v->Data())),
264  MATCOLS((matrix)(v->Data())));break;
265  case MODUL_CMD: Print(", rk %d\n", (int)(((ideal)(v->Data()))->rank));break;
266  case LIST_CMD: Print(", size %d\n",((lists)(v->Data()))->nr+1); break;
267 
268  case PROC_CMD:
269  case RING_CMD:
270  case IDEAL_CMD: PrintLn(); break;
271 
272  //case INT_CMD:
273  //case STRING_CMD:
274  //case INTVEC_CMD:
275  //case POLY_CMD:
276  //case VECTOR_CMD:
277  //case PACKAGE_CMD:
278 
279  default:
280  break;
281  }
282  v->Print();
283  if (currRing != NULL)
284  currRing->ShortOut = oldShortOut;
285 }

◆ versionString()

char* versionString ( )

Definition at line 788 of file misc_ip.cc.

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

Variable Documentation

◆ currid

const char* currid
extern

Definition at line 171 of file grammar.cc.

◆ dArith1

const struct sValCmd1 dArith1[]
extern

Definition at line 1 of file table.h.

◆ dArith2

const struct sValCmd2 dArith2[]
extern

Definition at line 1 of file table.h.

◆ dArith3

const struct sValCmd3 dArith3[]
extern

Definition at line 1 of file table.h.

◆ dArithM

const struct sValCmdM dArithM[]
extern

Definition at line 1 of file table.h.

◆ iiCurrArgs

leftv iiCurrArgs
extern

Definition at line 78 of file ipshell.cc.

◆ iiCurrProc

idhdl iiCurrProc
extern

Definition at line 79 of file ipshell.cc.

◆ iiLocalRing

ring* iiLocalRing
extern

Definition at line 454 of file iplib.cc.

◆ iiOp

int iiOp
extern

Definition at line 218 of file iparith.cc.

◆ iiRETURNEXPR

sleftv iiRETURNEXPR
extern

Definition at line 455 of file iplib.cc.

◆ iiRETURNEXPR_len

int iiRETURNEXPR_len
extern

Definition at line 456 of file iplib.cc.

◆ lastreserved

const char* lastreserved
extern

Definition at line 80 of file ipshell.cc.

◆ myynest

int myynest
extern

Definition at line 41 of file febase.cc.

◆ printlevel

int printlevel
extern

Definition at line 36 of file febase.cc.

◆ si_echo

int si_echo
extern

Definition at line 35 of file febase.cc.

◆ yyInRingConstruction

BOOLEAN yyInRingConstruction
extern

Definition at line 172 of file grammar.cc.