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 char *(* Proc1) (char *)
 
typedef BOOLEAN(* proc2) (leftv, leftv, leftv)
 
typedef BOOLEAN(* proc3) (leftv, leftv, leftv, leftv)
 
typedef BOOLEAN(* proci) (leftv, leftv, Subexpr)
 

Functions

BOOLEAN spectrumProc (leftv, leftv)
 
BOOLEAN spectrumfProc (leftv, leftv)
 
BOOLEAN spaddProc (leftv, leftv, leftv)
 
BOOLEAN spmulProc (leftv, leftv, leftv)
 
BOOLEAN semicProc (leftv, leftv, leftv)
 
BOOLEAN semicProc3 (leftv, leftv, leftv, leftv)
 
BOOLEAN iiAssignCR (leftv, leftv)
 
BOOLEAN iiARROW (leftv, char *, char *)
 
int IsCmd (const char *n, int &tok)
 
BOOLEAN iiPStart (idhdl pn, sleftv *sl)
 
BOOLEAN iiEStart (char *example, procinfo *pi)
 
BOOLEAN iiAllStart (procinfov pi, char *p, feBufferTypes t, int l)
 
void type_cmd (leftv v)
 
void test_cmd (int i)
 
void list_cmd (int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname=FALSE)
 
void killlocals (int v)
 
int exprlist_length (leftv v)
 
const char * Tok2Cmdname (int i)
 
const char * iiTwoOps (int t)
 
int iiOpsTwoChar (const char *s)
 
BOOLEAN iiWRITE (leftv res, leftv exprlist)
 
BOOLEAN iiExport (leftv v, int toLev)
 
BOOLEAN iiExport (leftv v, int toLev, package pack)
 
BOOLEAN iiInternalExport (leftv v, int toLev, package pack)
 
char * iiGetLibName (procinfov v)
 
char * iiGetLibProcBuffer (procinfov pi, int part=1)
 
char * iiProcName (char *buf, char &ct, char *&e)
 
char * iiProcArgs (char *e, BOOLEAN withParenth)
 
BOOLEAN iiLibCmd (char *newlib, BOOLEAN autoexport, BOOLEAN tellerror, BOOLEAN force)
 
BOOLEAN jjLOAD (const char *s, BOOLEAN autoexport=FALSE)
 load lib/module given in v More...
 
BOOLEAN jjLOAD_TRY (const char *s)
 
BOOLEAN iiLocateLib (const char *lib, char *where)
 
leftv iiMap (map theMap, const char *what)
 
void iiMakeResolv (resolvente r, int length, int rlen, char *name, int typ0, intvec **weights=NULL)
 
BOOLEAN jjMINRES (leftv res, leftv v)
 
BOOLEAN jjBETTI (leftv res, leftv v)
 
BOOLEAN jjBETTI2 (leftv res, leftv u, leftv v)
 
BOOLEAN jjBETTI2_ID (leftv res, leftv u, leftv v)
 
BOOLEAN jjIMPORTFROM (leftv res, leftv u, leftv v)
 
BOOLEAN jjLIST_PL (leftv res, leftv v)
 
BOOLEAN jjVARIABLES_P (leftv res, leftv u)
 
BOOLEAN jjVARIABLES_ID (leftv res, leftv u)
 
int iiRegularity (lists L)
 
leftv singular_system (sleftv h)
 
BOOLEAN jjSYSTEM (leftv res, leftv v)
 
void iiDebug ()
 
BOOLEAN iiCheckRing (int i)
 
poly iiHighCorner (ideal i, int ak)
 
char * iiConvName (const char *libname)
 
BOOLEAN iiLoadLIB (FILE *fp, const char *libnamebuf, const char *newlib, idhdl pl, BOOLEAN autoexport, BOOLEAN tellerror)
 
lists syConvRes (syStrategy syzstr, BOOLEAN toDel=FALSE, int add_row_shift=0)
 
syStrategy syForceMin (lists li)
 
syStrategy syConvList (lists li, BOOLEAN toDel)
 
BOOLEAN syBetti1 (leftv res, leftv u)
 
BOOLEAN syBetti2 (leftv res, leftv u, leftv w)
 
BOOLEAN iiExprArith1 (leftv res, sleftv *a, int op)
 
BOOLEAN iiExprArith2 (leftv res, sleftv *a, int op, sleftv *b, BOOLEAN proccall=FALSE)
 
BOOLEAN iiExprArith3 (leftv res, int op, leftv a, leftv b, leftv c)
 
BOOLEAN iiExprArithM (leftv res, sleftv *a, int op)
 
BOOLEAN iiApply (leftv res, leftv a, int op, leftv proc)
 
BOOLEAN iiAssign (leftv left, leftv right, BOOLEAN toplevel=TRUE)
 
BOOLEAN iiParameter (leftv p)
 
BOOLEAN iiAlias (leftv p)
 
int iiTokType (int op)
 
int iiDeclCommand (leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring=FALSE, BOOLEAN init_b=TRUE)
 
BOOLEAN iiMake_proc (idhdl pn, package pack, sleftv *sl)
 
char * showOption ()
 
BOOLEAN setOption (leftv res, leftv v)
 
char * versionString ()
 
void singular_example (char *str)
 
BOOLEAN iiTryLoadLib (leftv v, const char *id)
 
int iiAddCproc (const char *libname, const char *procname, BOOLEAN pstatic, BOOLEAN(*func)(leftv res, leftv v))
 
void iiCheckPack (package &p)
 
void checkall ()
 
void rSetHdl (idhdl h)
 
ring rInit (sleftv *pn, sleftv *rv, sleftv *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, struct sValCmd1 *dA1, int at, struct sConvertTypes *dConvertTypes)
 apply an operation 'op' to an argument a return TRUE on failure More...
 
BOOLEAN iiExprArith2Tab (leftv res, leftv a, int op, struct sValCmd2 *dA2, int at, 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, struct sValCmd3 *dA3, int at, 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)
 
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
 
const char * singular_date
 
int myynest
 
int printlevel
 
int si_echo
 
BOOLEAN yyInRingConstruction
 
struct sValCmd2 dArith2 []
 
struct sValCmd1 dArith1 []
 
struct sValCmd3 dArith3 []
 
struct sValCmdM dArithM []
 

Data Structure Documentation

struct sValCmd1

Definition at line 66 of file gentable.cc.

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

Definition at line 57 of file gentable.cc.

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

Definition at line 74 of file gentable.cc.

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

Definition at line 84 of file gentable.cc.

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

Definition at line 92 of file gentable.cc.

Data Fields
short arg
int p
proc1 p
short res
struct sValAssign

Definition at line 99 of file gentable.cc.

Data Fields
short arg
int p
proci p
short res

Typedef Documentation

typedef BOOLEAN(* proc1) (leftv, leftv)

Definition at line 123 of file ipshell.h.

typedef char*(* Proc1) (char *)

Definition at line 126 of file ipshell.h.

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

Definition at line 136 of file ipshell.h.

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

Definition at line 147 of file ipshell.h.

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

Definition at line 176 of file ipshell.h.

Function Documentation

void checkall ( )

Definition at line 1017 of file misc_ip.cc.

1018 {
1019  idhdl hh=basePack->idroot;
1020  while (hh!=NULL)
1021  {
1022  omCheckAddr(hh);
1023  omCheckAddr((ADDRESS)IDID(hh));
1024  if (RingDependend(IDTYP(hh)))
1025  {
1026  Print("%s typ %d in Top (should be in ring)\n",IDID(hh),IDTYP(hh));
1027  }
1028  hh=IDNEXT(hh);
1029  }
1030  hh=basePack->idroot;
1031  while (hh!=NULL)
1032  {
1033  if (IDTYP(hh)==PACKAGE_CMD)
1034  {
1035  idhdl h2=IDPACKAGE(hh)->idroot;
1036  if (IDPACKAGE(hh)!=basePack)
1037  {
1038  while (h2!=NULL)
1039  {
1040  omCheckAddr(h2);
1041  omCheckAddr((ADDRESS)IDID(h2));
1042  if (RingDependend(IDTYP(h2)))
1043  {
1044  Print("%s typ %d in %s (should be in ring)\n",IDID(h2),IDTYP(h2),IDID(hh));
1045  }
1046  h2=IDNEXT(h2);
1047  }
1048  }
1049  }
1050  hh=IDNEXT(hh);
1051  }
1052 }
#define Print
Definition: emacs.cc:83
#define IDID(a)
Definition: ipid.h:121
#define IDNEXT(a)
Definition: ipid.h:117
void * ADDRESS
Definition: auxiliary.h:161
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:138
#define IDTYP(a)
Definition: ipid.h:118
int RingDependend(int t)
Definition: gentable.cc:23
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
#define omCheckAddr(addr)
Definition: omAllocDecl.h:328
int exprlist_length ( leftv  v)

Definition at line 559 of file ipshell.cc.

560 {
561  int rc = 0;
562  while (v!=NULL)
563  {
564  switch (v->Typ())
565  {
566  case INT_CMD:
567  case POLY_CMD:
568  case VECTOR_CMD:
569  case NUMBER_CMD:
570  rc++;
571  break;
572  case INTVEC_CMD:
573  case INTMAT_CMD:
574  rc += ((intvec *)(v->Data()))->length();
575  break;
576  case MATRIX_CMD:
577  case IDEAL_CMD:
578  case MODUL_CMD:
579  {
580  matrix mm = (matrix)(v->Data());
581  rc += mm->rows() * mm->cols();
582  }
583  break;
584  case LIST_CMD:
585  rc+=((lists)v->Data())->nr+1;
586  break;
587  default:
588  rc++;
589  }
590  v = v->next;
591  }
592  return rc;
593 }
int & rows()
Definition: matpol.h:24
Definition: tok.h:85
int Typ()
Definition: subexpr.cc:969
Definition: intvec.h:16
ip_smatrix * matrix
Definition: tok.h:88
leftv next
Definition: subexpr.h:87
int & cols()
Definition: matpol.h:25
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
void * Data()
Definition: subexpr.cc:1111
Definition: tok.h:96
int iiAddCproc ( const char *  libname,
const char *  procname,
BOOLEAN  pstatic,
BOOLEAN(*)(leftv res, leftv v func 
)

Definition at line 1003 of file iplib.cc.

1005 {
1006  procinfov pi;
1007  idhdl h;
1008 
1009  #ifndef SING_NDEBUG
1010  int dummy;
1011  if (IsCmd(procname,dummy))
1012  {
1013  Werror(">>%s< is a reserved name",procname);
1014  return 0;
1015  }
1016  #endif
1017 
1018  h = enterid(procname,0, PROC_CMD, &IDROOT, TRUE);
1019  if ( h!= NULL )
1020  {
1021  pi = IDPROC(h);
1022  pi->libname = omStrDup(libname);
1023  pi->procname = omStrDup(procname);
1024  pi->language = LANG_C;
1025  pi->ref = 1;
1026  pi->is_static = pstatic;
1027  pi->data.o.function = func;
1028  return(1);
1029  }
1030  else
1031  {
1032  PrintS("iiAddCproc: failed.\n");
1033  }
1034  return(0);
1035 }
language_defs language
Definition: subexpr.h:58
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:144
short ref
Definition: subexpr.h:59
Definition: idrec.h:34
char * procname
Definition: subexpr.h:56
Definition: subexpr.h:20
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:259
char * libname
Definition: subexpr.h:55
procinfodata data
Definition: subexpr.h:62
void PrintS(const char *s)
Definition: reporter.cc:294
char is_static
Definition: subexpr.h:60
#define IDPROC(a)
Definition: ipid.h:139
#define pi
Definition: libparse.cc:1143
#define NULL
Definition: omList.c:10
static Poly * h
Definition: janet.cc:978
void Werror(const char *fmt,...)
Definition: reporter.cc:199
int IsCmd(const char *n, int &tok)
Definition: iparith.cc:8739
#define omStrDup(s)
Definition: omAllocDecl.h:263
BOOLEAN iiAlias ( leftv  p)

Definition at line 745 of file ipid.cc.

746 {
747  if (iiCurrArgs==NULL)
748  {
749  Werror("not enough arguments for proc %s",VoiceName());
750  p->CleanUp();
751  return TRUE;
752  }
754  iiCurrArgs=h->next;
755  h->next=NULL;
756  if (h->rtyp!=IDHDL)
757  {
758  BOOLEAN res=iiAssign(p,h);
759  h->CleanUp();
761  return res;
762  }
763  if ((h->Typ()!=p->Typ()) &&(p->Typ()!=DEF_CMD))
764  {
765  WerrorS("type mismatch");
766  return TRUE;
767  }
768  idhdl pp=(idhdl)p->data;
769  switch(pp->typ)
770  {
771 #ifdef SINGULAR_4_1
772  case CRING_CMD:
773  nKillChar((coeffs)pp);
774  break;
775 #endif
776  case DEF_CMD:
777  case INT_CMD:
778  break;
779  case INTVEC_CMD:
780  case INTMAT_CMD:
781  delete IDINTVEC(pp);
782  break;
783  case NUMBER_CMD:
784  nDelete(&IDNUMBER(pp));
785  break;
786  case BIGINT_CMD:
788  break;
789  case MAP_CMD:
790  {
791  map im = IDMAP(pp);
792  omFree((ADDRESS)im->preimage);
793  }
794  // continue as ideal:
795  case IDEAL_CMD:
796  case MODUL_CMD:
797  case MATRIX_CMD:
798  idDelete(&IDIDEAL(pp));
799  break;
800  case PROC_CMD:
801  case RESOLUTION_CMD:
802  case STRING_CMD:
803  omFree((ADDRESS)IDSTRING(pp));
804  break;
805  case LIST_CMD:
806  IDLIST(pp)->Clean();
807  break;
808  case LINK_CMD:
810  break;
811  // case ring: cannot happen
812  default:
813  Werror("unknown type %d",p->Typ());
814  return TRUE;
815  }
816  pp->typ=ALIAS_CMD;
817  IDDATA(pp)=(char*)h->data;
818  int eff_typ=h->Typ();
819  if ((RingDependend(eff_typ))
820  || ((eff_typ==LIST_CMD) && (lRingDependend((lists)h->Data()))))
821  {
822  ipSwapId(pp,IDROOT,currRing->idroot);
823  }
824  h->CleanUp();
826  return FALSE;
827 }
CanonicalForm map(const CanonicalForm &primElem, const Variable &alpha, const CanonicalForm &F, const Variable &beta)
map from to such that is mapped onto
Definition: cf_map_ext.cc:400
#define IDLIST(a)
Definition: ipid.h:136
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:85
#define IDLINK(a)
Definition: ipid.h:137
#define idDelete(H)
delete an ideal
Definition: ideals.h:31
Definition: lists.h:22
#define IDINTVEC(a)
Definition: ipid.h:127
#define FALSE
Definition: auxiliary.h:140
Definition: tok.h:42
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:144
#define IDIDEAL(a)
Definition: ipid.h:132
void * ADDRESS
Definition: auxiliary.h:161
void WerrorS(const char *s)
Definition: feFopen.cc:24
coeffs coeffs_BIGINT
Definition: ipid.cc:54
int Typ()
Definition: subexpr.cc:969
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:35
poly pp
Definition: myNF.cc:296
void * data
Definition: subexpr.h:89
poly res
Definition: myNF.cc:322
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
int RingDependend(int t)
Definition: gentable.cc:23
Definition: tok.h:56
Definition: tok.h:58
#define omFree(addr)
Definition: omAllocDecl.h:261
The main handler for Singular numbers which are suitable for Singular polynomials.
#define IDSTRING(a)
Definition: ipid.h:135
idrec * idhdl
Definition: ring.h:18
omBin sleftv_bin
Definition: subexpr.cc:50
Definition: tok.h:88
const char * VoiceName()
Definition: fevoices.cc:66
#define nDelete(n)
Definition: numbers.h:16
#define IDMAP(a)
Definition: ipid.h:134
leftv next
Definition: subexpr.h:87
#define IDNUMBER(a)
Definition: ipid.h:131
Definition: tok.h:38
Definition: tok.h:95
#define NULL
Definition: omList.c:10
leftv iiCurrArgs
Definition: ipshell.cc:84
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
void * Data()
Definition: subexpr.cc:1111
int typ
Definition: idrec.h:43
Definition: tok.h:96
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete &#39;p&#39;
Definition: coeffs.h:456
#define IDDATA(a)
Definition: ipid.h:125
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:199
static int ipSwapId(idhdl tomove, idhdl &root1, idhdl &root2)
Definition: ipid.cc:579
void nKillChar(coeffs r)
undo all initialisations
Definition: numbers.cc:488
void Werror(const char *fmt,...)
Definition: reporter.cc:199
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1782
BOOLEAN iiAllStart ( procinfov  pi,
char *  p,
feBufferTypes  t,
int  l 
)

Definition at line 322 of file iplib.cc.

323 {
324  // see below:
325  BITSET save1=si_opt_1;
326  BITSET save2=si_opt_2;
327  newBuffer( omStrDup(p /*pi->data.s.body*/), t /*BT_proc*/,
328  pi, l );
329  BOOLEAN err=yyparse();
330  if (sLastPrinted.rtyp!=0)
331  {
333  }
334  // the access to optionStruct and verboseStruct do not work
335  // on x86_64-Linux for pic-code
336  if ((TEST_V_ALLWARN) &&
337  (t==BT_proc) &&
338  ((save1!=si_opt_1)||(save2!=si_opt_2)) &&
339  (pi->libname!=NULL) && (pi->libname[0]!='\0'))
340  {
341  if ((pi->libname!=NULL) && (pi->libname[0]!='\0'))
342  Warn("option changed in proc %s from %s",pi->procname,pi->libname);
343  else
344  Warn("option changed in proc %s",pi->procname);
345  int i;
346  for (i=0; optionStruct[i].setval!=0; i++)
347  {
348  if ((optionStruct[i].setval & si_opt_1)
349  && (!(optionStruct[i].setval & save1)))
350  {
351  Print(" +%s",optionStruct[i].name);
352  }
353  if (!(optionStruct[i].setval & si_opt_1)
354  && ((optionStruct[i].setval & save1)))
355  {
356  Print(" -%s",optionStruct[i].name);
357  }
358  }
359  for (i=0; verboseStruct[i].setval!=0; i++)
360  {
361  if ((verboseStruct[i].setval & si_opt_2)
362  && (!(verboseStruct[i].setval & save2)))
363  {
364  Print(" +%s",verboseStruct[i].name);
365  }
366  if (!(verboseStruct[i].setval & si_opt_2)
367  && ((verboseStruct[i].setval & save2)))
368  {
369  Print(" -%s",verboseStruct[i].name);
370  }
371  }
372  PrintLn();
373  }
374  return err;
375 }
unsigned si_opt_1
Definition: options.c:5
void PrintLn()
Definition: reporter.cc:327
#define Print
Definition: emacs.cc:83
return P p
Definition: myNF.cc:203
struct soptionStruct optionStruct[]
Definition: misc_ip.cc:522
#define BITSET
Definition: structs.h:17
char * procname
Definition: subexpr.h:56
unsigned setval
Definition: iplib.cc:315
struct soptionStruct verboseStruct[]
Definition: misc_ip.cc:552
char * libname
Definition: subexpr.h:55
int i
Definition: cfEzgcd.cc:123
int yyparse(void)
Definition: grammar.cc:2168
char name(const Variable &v)
Definition: variable.h:95
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:171
unsigned si_opt_2
Definition: options.c:6
int BOOLEAN
Definition: auxiliary.h:131
#define TEST_V_ALLWARN
Definition: options.h:135
int l
Definition: cfEzgcd.cc:94
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263
BOOLEAN iiApply ( leftv  res,
leftv  a,
int  op,
leftv  proc 
)

Definition at line 6293 of file ipshell.cc.

6294 {
6295  memset(res,0,sizeof(sleftv));
6296  res->rtyp=a->Typ();
6297  switch (res->rtyp /*a->Typ()*/)
6298  {
6299  case INTVEC_CMD:
6300  case INTMAT_CMD:
6301  return iiApplyINTVEC(res,a,op,proc);
6302  case BIGINTMAT_CMD:
6303  return iiApplyBIGINTMAT(res,a,op,proc);
6304  case IDEAL_CMD:
6305  case MODUL_CMD:
6306  case MATRIX_CMD:
6307  return iiApplyIDEAL(res,a,op,proc);
6308  case LIST_CMD:
6309  return iiApplyLIST(res,a,op,proc);
6310  }
6311  WerrorS("first argument to `apply` must allow an index");
6312  return TRUE;
6313 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
BOOLEAN iiApplyBIGINTMAT(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6251
BOOLEAN iiApplyIDEAL(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6256
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:969
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6261
Definition: tok.h:88
int rtyp
Definition: subexpr.h:92
Definition: tok.h:96
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6219
BOOLEAN iiARROW ( leftv  ,
char *  ,
char *   
)

Definition at line 6342 of file ipshell.cc.

6343 {
6344  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6345  // find end of s:
6346  int end_s=strlen(s);
6347  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6348  s[end_s+1]='\0';
6349  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6350  sprintf(name,"%s->%s",a,s);
6351  // find start of last expression
6352  int start_s=end_s-1;
6353  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6354  if (start_s<0) // ';' not found
6355  {
6356  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6357  }
6358  else // s[start_s] is ';'
6359  {
6360  s[start_s]='\0';
6361  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6362  }
6363  memset(r,0,sizeof(*r));
6364  // now produce procinfo for PROC_CMD:
6365  r->data = (void *)omAlloc0Bin(procinfo_bin);
6366  ((procinfo *)(r->data))->language=LANG_NONE;
6367  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6368  ((procinfo *)r->data)->data.s.body=ss;
6369  omFree(name);
6370  r->rtyp=PROC_CMD;
6371  //r->rtyp=STRING_CMD;
6372  //r->data=ss;
6373  return FALSE;
6374 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
const poly a
Definition: syzextra.cc:212
procinfo * iiInitSingularProcinfo(procinfov pi, const char *libname, const char *procname, int line, long pos, BOOLEAN pstatic)
Definition: iplib.cc:978
#define FALSE
Definition: auxiliary.h:140
#define omAlloc(size)
Definition: omAllocDecl.h:210
omBin procinfo_bin
Definition: subexpr.cc:51
const ring r
Definition: syzextra.cc:208
#define omFree(addr)
Definition: omAllocDecl.h:261
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
char name(const Variable &v)
Definition: variable.h:95
BOOLEAN iiAssign ( leftv  left,
leftv  right,
BOOLEAN  toplevel = TRUE 
)

Definition at line 1782 of file ipassign.cc.

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

Definition at line 6376 of file ipshell.cc.

6377 {
6378  int t=arg->Typ();
6379  char* ring_name=omStrDup((char*)r->Name());
6380  if ((t==RING_CMD) ||(t==QRING_CMD))
6381  {
6382  sleftv tmp;
6383  memset(&tmp,0,sizeof(tmp));
6384  tmp.rtyp=IDHDL;
6385  tmp.data=(char*)rDefault(ring_name);
6386  if (tmp.data!=NULL)
6387  {
6388  BOOLEAN b=iiAssign(&tmp,arg);
6389  if (b) return TRUE;
6390  rSetHdl(ggetid(ring_name));
6391  omFree(ring_name);
6392  return FALSE;
6393  }
6394  else
6395  return TRUE;
6396  }
6397  #ifdef SINGULAR_4_1
6398  else if (t==CRING_CMD)
6399  {
6400  sleftv tmp;
6401  sleftv n;
6402  memset(&n,0,sizeof(n));
6403  n.name=ring_name;
6404  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6405  if (iiAssign(&tmp,arg)) return TRUE;
6406  //Print("create %s\n",r->Name());
6407  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6408  return FALSE;
6409  }
6410  #endif
6411  //Print("create %s\n",r->Name());
6412  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6413  return TRUE;// not handled -> error for now
6414 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define FALSE
Definition: auxiliary.h:140
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:144
#define IDHDL
Definition: tok.h:35
idhdl rDefault(const char *s)
Definition: ipshell.cc:1528
void * data
Definition: subexpr.h:89
int myynest
Definition: febase.cc:46
Definition: tok.h:56
const ring r
Definition: syzextra.cc:208
const char * name
Definition: subexpr.h:88
#define omFree(addr)
Definition: omAllocDecl.h:261
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition: ipshell.cc:1119
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
Definition: tok.h:126
void rSetHdl(idhdl h)
Definition: ipshell.cc:4979
int BOOLEAN
Definition: auxiliary.h:131
const poly b
Definition: syzextra.cc:213
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:490
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1782
#define omStrDup(s)
Definition: omAllocDecl.h:263
BOOLEAN iiBranchTo ( leftv  r,
leftv  args 
)

Definition at line 1174 of file ipshell.cc.

1175 {
1176  // <string1...stringN>,<proc>
1177  // known: args!=NULL, l>=1
1178  int l=args->listLength();
1179  int ll=0;
1180  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1181  if (ll!=(l-1)) return FALSE;
1182  leftv h=args;
1183  short *t=(short*)omAlloc(l*sizeof(short));
1184  t[0]=l-1;
1185  int b;
1186  int i;
1187  for(i=1;i<l;i++,h=h->next)
1188  {
1189  if (h->Typ()!=STRING_CMD)
1190  {
1191  omFree(t);
1192  Werror("arg %d is not a string",i);
1193  return TRUE;
1194  }
1195  int tt;
1196  b=IsCmd((char *)h->Data(),tt);
1197  if(b) t[i]=tt;
1198  else
1199  {
1200  omFree(t);
1201  Werror("arg %d is not a type name",i);
1202  return TRUE;
1203  }
1204  }
1205  if (h->Typ()!=PROC_CMD)
1206  {
1207  omFree(t);
1208  Werror("last arg (%d) is not a proc",i);
1209  return TRUE;
1210  }
1211  b=iiCheckTypes(iiCurrArgs,t,0);
1212  omFree(t);
1213  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1214  {
1215  BOOLEAN err;
1216  //Print("branchTo: %s\n",h->Name());
1217  iiCurrProc=(idhdl)h->data;
1219  if( pi->data.s.body==NULL )
1220  {
1222  if (pi->data.s.body==NULL) return TRUE;
1223  }
1224  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1225  {
1226  currPack=pi->pack;
1229  //Print("set pack=%s\n",IDID(currPackHdl));
1230  }
1231  err=iiAllStart(pi,pi->data.s.body,BT_proc,pi->data.s.body_lineno-(iiCurrArgs==NULL));
1233  if (iiCurrArgs!=NULL)
1234  {
1235  if (!err) Warn("too many arguments for %s",IDID(iiCurrProc));
1236  iiCurrArgs->CleanUp();
1238  iiCurrArgs=NULL;
1239  }
1240  return 2-err;
1241  }
1242  return FALSE;
1243 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
idhdl currPackHdl
Definition: ipid.cc:61
#define IDID(a)
Definition: ipid.h:121
#define FALSE
Definition: auxiliary.h:140
int listLength()
Definition: subexpr.cc:61
#define TRUE
Definition: auxiliary.h:144
void * ADDRESS
Definition: auxiliary.h:161
#define omAlloc(size)
Definition: omAllocDecl.h:210
BOOLEAN exitBuffer(feBufferTypes typ)
Definition: fevoices.cc:241
#define IDHDL
Definition: tok.h:35
idhdl iiCurrProc
Definition: ipshell.cc:85
#define omFree(addr)
Definition: omAllocDecl.h:261
idrec * idhdl
Definition: ring.h:18
omBin sleftv_bin
Definition: subexpr.cc:50
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:87
BOOLEAN iiAllStart(procinfov pi, char *p, feBufferTypes t, int l)
Definition: iplib.cc:322
#define IDPROC(a)
Definition: ipid.h:139
#define pi
Definition: libparse.cc:1143
#define NULL
Definition: omList.c:10
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:6434
package currPack
Definition: ipid.cc:63
leftv iiCurrArgs
Definition: ipshell.cc:84
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
idhdl packFindHdl(package r)
Definition: ipid.cc:732
void iiCheckPack(package &p)
Definition: ipshell.cc:1512
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:210
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
const poly b
Definition: syzextra.cc:213
void Werror(const char *fmt,...)
Definition: reporter.cc:199
int l
Definition: cfEzgcd.cc:94
utypes data
Definition: idrec.h:40
int IsCmd(const char *n, int &tok)
Definition: iparith.cc:8739
#define Warn
Definition: emacs.cc:80
void iiCheckPack ( package p)

Definition at line 1512 of file ipshell.cc.

1513 {
1514  if (p==basePack) return;
1515 
1516  idhdl t=basePack->idroot;
1517 
1518  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1519 
1520  if (t==NULL)
1521  {
1522  WarnS("package not found\n");
1523  p=basePack;
1524  }
1525  return;
1526 }
return P p
Definition: myNF.cc:203
#define WarnS
Definition: emacs.cc:81
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:138
#define IDTYP(a)
Definition: ipid.h:118
idhdl next
Definition: idrec.h:38
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
BOOLEAN iiCheckRing ( int  i)

Definition at line 1468 of file ipshell.cc.

1469 {
1470  if (currRing==NULL)
1471  {
1472  #ifdef SIQ
1473  if (siq<=0)
1474  {
1475  #endif
1476  if (RingDependend(i))
1477  {
1478  WerrorS("no ring active");
1479  return TRUE;
1480  }
1481  #ifdef SIQ
1482  }
1483  #endif
1484  }
1485  return FALSE;
1486 }
#define FALSE
Definition: auxiliary.h:140
BOOLEAN siq
Definition: subexpr.cc:58
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
int RingDependend(int t)
Definition: gentable.cc:23
int i
Definition: cfEzgcd.cc:123
#define NULL
Definition: omList.c:10
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 6434 of file ipshell.cc.

6435 {
6436  if (args==NULL)
6437  {
6438  if (type_list[0]==0) return TRUE;
6439  else
6440  {
6441  if (report) WerrorS("no arguments expected");
6442  return FALSE;
6443  }
6444  }
6445  int l=args->listLength();
6446  if (l!=(int)type_list[0])
6447  {
6448  if (report) iiReportTypes(0,l,type_list);
6449  return FALSE;
6450  }
6451  for(int i=1;i<=l;i++,args=args->next)
6452  {
6453  short t=type_list[i];
6454  if (t!=ANY_TYPE)
6455  {
6456  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6457  || (t!=args->Typ()))
6458  {
6459  if (report) iiReportTypes(i,args->Typ(),type_list);
6460  return FALSE;
6461  }
6462  }
6463  }
6464  return TRUE;
6465 }
#define ANY_TYPE
Definition: tok.h:34
#define FALSE
Definition: auxiliary.h:140
int listLength()
Definition: subexpr.cc:61
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define IDHDL
Definition: tok.h:35
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6416
int i
Definition: cfEzgcd.cc:123
leftv next
Definition: subexpr.h:87
#define NULL
Definition: omList.c:10
int l
Definition: cfEzgcd.cc:94
char* iiConvName ( const char *  libname)

Definition at line 1279 of file iplib.cc.

1280 {
1281  char *tmpname = omStrDup(libname);
1282  char *p = strrchr(tmpname, DIR_SEP);
1283  char *r;
1284  if(p==NULL) p = tmpname;
1285  else p++;
1286  r = (char *)strchr(p, '.');
1287  if( r!= NULL) *r = '\0';
1288  r = omStrDup(p);
1289  *r = mytoupper(*r);
1290  // printf("iiConvName: '%s' '%s' => '%s'\n", libname, tmpname, r);
1291  omFree((ADDRESS)tmpname);
1292 
1293  return(r);
1294 }
char mytoupper(char c)
Definition: iplib.cc:1260
return P p
Definition: myNF.cc:203
void * ADDRESS
Definition: auxiliary.h:161
#define DIR_SEP
Definition: feResource.h:6
const ring r
Definition: syzextra.cc:208
#define omFree(addr)
Definition: omAllocDecl.h:261
#define NULL
Definition: omList.c:10
#define omStrDup(s)
Definition: omAllocDecl.h:263
void iiDebug ( )

Definition at line 981 of file ipshell.cc.

982 {
983 #ifdef HAVE_SDB
984  sdb_flags=1;
985 #endif
986  Print("\n-- break point in %s --\n",VoiceName());
988  char * s;
990  s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
991  loop
992  {
993  memset(s,0,80);
995  if (s[BREAK_LINE_LENGTH-1]!='\0')
996  {
997  Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
998  }
999  else
1000  break;
1001  }
1002  if (*s=='\n')
1003  {
1005  }
1006 #if MDEBUG
1007  else if(strncmp(s,"cont;",5)==0)
1008  {
1010  }
1011 #endif /* MDEBUG */
1012  else
1013  {
1014  strcat( s, "\n;~\n");
1015  newBuffer(s,BT_execute);
1016  }
1017 }
void VoiceBackTrack()
Definition: fevoices.cc:77
const CanonicalForm int s
Definition: facAbsFact.cc:55
char *(* fe_fgets_stdin)(const char *pr, char *s, int size)
Definition: feread.cc:33
int sdb_flags
Definition: sdb.cc:32
#define Print
Definition: emacs.cc:83
loop
Definition: myNF.cc:98
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
#define omAlloc(size)
Definition: omAllocDecl.h:210
BOOLEAN iiDebugMarker
Definition: ipshell.cc:979
const char * VoiceName()
Definition: fevoices.cc:66
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:980
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:171
int iiDeclCommand ( leftv  sy,
leftv  name,
int  lev,
int  t,
idhdl root,
BOOLEAN  isring = FALSE,
BOOLEAN  init_b = TRUE 
)

Definition at line 1119 of file ipshell.cc.

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

Definition at line 665 of file iplib.cc.

666 {
667  BOOLEAN err;
668  int old_echo=si_echo;
669 
670  iiCheckNest();
671  procstack->push(example);
672 #ifdef USE_IILOCALRING
674 #endif
676  {
677  if (traceit&TRACE_SHOW_LINENO) printf("\n");
678  printf("entering example (level %d)\n",myynest);
679  }
680  myynest++;
681 
682  err=iiAllStart(pi,example,BT_example,(pi != NULL ? pi->data.s.example_lineno: 0));
683 
685  myynest--;
686  si_echo=old_echo;
687  if (traceit&TRACE_SHOW_PROC)
688  {
689  if (traceit&TRACE_SHOW_LINENO) printf("\n");
690  printf("leaving -example- (level %d)\n",myynest);
691  }
692 #ifdef USE_IILOCALRING
693  if (iiLocalRing[myynest] != currRing)
694  {
695  if (iiLocalRing[myynest]!=NULL)
696  {
699  }
700  else
701  {
703  currRing=NULL;
704  }
705  }
706 #else /* USE_IILOCALRING */
707 #endif /* USE_IILOCALRING */
708  if (NS_LRING != currRing)
709  {
710  if (NS_LRING!=NULL)
711  {
713  if ((rh==NULL)||(IDRING(rh)!=NS_LRING))
714  rh=rFindHdl(NS_LRING,NULL);
715  rSetHdl(rh);
716  }
717  else
718  {
720  currRing=NULL;
721  }
722  }
723 //#endif /* USE_IILOCALRING */
724  procstack->pop();
725  return err;
726 }
#define TRACE_SHOW_LINENO
Definition: reporter.h:28
proclevel * procstack
Definition: ipid.cc:58
int traceit
Definition: febase.cc:47
idhdl cRingHdl
Definition: ipid.h:60
static void iiCheckNest()
Definition: iplib.cc:560
Definition: idrec.h:34
int myynest
Definition: febase.cc:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void killlocals(int v)
Definition: ipshell.cc:385
procinfodata data
Definition: subexpr.h:62
idhdl currRingHdl
Definition: ipid.cc:65
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1573
BOOLEAN iiAllStart(procinfov pi, char *p, feBufferTypes t, int l)
Definition: iplib.cc:322
ring * iiLocalRing
Definition: iplib.cc:525
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:126
#define TRACE_SHOW_PROC
Definition: reporter.h:26
void rSetHdl(idhdl h)
Definition: ipshell.cc:4979
void push(char *)
Definition: ipid.cc:702
void pop()
Definition: ipid.cc:714
int BOOLEAN
Definition: auxiliary.h:131
#define NS_LRING
Definition: iplib.cc:60
int si_echo
Definition: febase.cc:41
BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1388 of file ipshell.cc.

1389 {
1390  BOOLEAN nok=FALSE;
1391  leftv r=v;
1392  while (v!=NULL)
1393  {
1394  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1395  {
1396  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1397  nok=TRUE;
1398  }
1399  else
1400  {
1401  if(iiInternalExport(v, toLev))
1402  {
1403  r->CleanUp();
1404  return TRUE;
1405  }
1406  }
1407  v=v->next;
1408  }
1409  r->CleanUp();
1410  return nok;
1411 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Subexpr e
Definition: subexpr.h:106
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
const ring r
Definition: syzextra.cc:208
const char * name
Definition: subexpr.h:88
leftv next
Definition: subexpr.h:87
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1280
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
BOOLEAN iiExport ( leftv  v,
int  toLev,
package  pack 
)

Definition at line 1414 of file ipshell.cc.

1415 {
1416 #ifdef SINGULAR_4_1
1417  if ((pack==basePack)&&(pack!=currPack))
1418  { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
1419 #endif
1420  BOOLEAN nok=FALSE;
1421  leftv rv=v;
1422  while (v!=NULL)
1423  {
1424  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
1425  )
1426  {
1427  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1428  nok=TRUE;
1429  }
1430  else
1431  {
1432  idhdl old=pack->idroot->get( v->name,toLev);
1433  if (old!=NULL)
1434  {
1435  if ((pack==currPack) && (old==(idhdl)v->data))
1436  {
1437  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
1438  break;
1439  }
1440  else if (IDTYP(old)==v->Typ())
1441  {
1442  if (BVERBOSE(V_REDEFINE))
1443  {
1444  Warn("redefining %s",IDID(old));
1445  }
1446  v->name=omStrDup(v->name);
1447  killhdl2(old,&(pack->idroot),currRing);
1448  }
1449  else
1450  {
1451  rv->CleanUp();
1452  return TRUE;
1453  }
1454  }
1455  //Print("iiExport: pack=%s\n",IDID(root));
1456  if(iiInternalExport(v, toLev, pack))
1457  {
1458  rv->CleanUp();
1459  return TRUE;
1460  }
1461  }
1462  v=v->next;
1463  }
1464  rv->CleanUp();
1465  return nok;
1466 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Subexpr e
Definition: subexpr.h:106
#define IDID(a)
Definition: ipid.h:121
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
int Typ()
Definition: subexpr.cc:969
Definition: idrec.h:34
idhdl get(const char *s, int lev)
Definition: ipid.cc:91
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define IDTYP(a)
Definition: ipid.h:118
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:403
char my_yylinebuf[80]
Definition: febase.cc:48
const char * name
Definition: subexpr.h:88
leftv next
Definition: subexpr.h:87
#define BVERBOSE(a)
Definition: options.h:33
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1280
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
package currPack
Definition: ipid.cc:63
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
int BOOLEAN
Definition: auxiliary.h:131
#define V_REDEFINE
Definition: options.h:43
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263
BOOLEAN iiExprArith1 ( leftv  res,
sleftv a,
int  op 
)
BOOLEAN iiExprArith1Tab ( leftv  res,
leftv  a,
int  op,
struct sValCmd1 dA1,
int  at,
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 8202 of file iparith.cc.

8203 {
8204  memset(res,0,sizeof(sleftv));
8205  BOOLEAN call_failed=FALSE;
8206 
8207  if (!errorreported)
8208  {
8209  BOOLEAN failed=FALSE;
8210  iiOp=op;
8211  int i = 0;
8212  while (dA1[i].cmd==op)
8213  {
8214  if (at==dA1[i].arg)
8215  {
8216  if (currRing!=NULL)
8217  {
8218  if (check_valid(dA1[i].valid_for,op)) break;
8219  }
8220  else
8221  {
8222  if (RingDependend(dA1[i].res))
8223  {
8224  WerrorS("no ring active");
8225  break;
8226  }
8227  }
8228  if (traceit&TRACE_CALL)
8229  Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
8230  res->rtyp=dA1[i].res;
8231  if ((call_failed=dA1[i].p(res,a)))
8232  {
8233  break;// leave loop, goto error handling
8234  }
8235  if (a->Next()!=NULL)
8236  {
8238  failed=iiExprArith1(res->next,a->next,op);
8239  }
8240  a->CleanUp();
8241  return failed;
8242  }
8243  i++;
8244  }
8245  // implicite type conversion --------------------------------------------
8246  if (dA1[i].cmd!=op)
8247  {
8249  i=0;
8250  //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
8251  while (dA1[i].cmd==op)
8252  {
8253  int ai;
8254  //Print("test %s\n",Tok2Cmdname(dA1[i].arg));
8255  if ((ai=iiTestConvert(at,dA1[i].arg,dConvertTypes))!=0)
8256  {
8257  if (currRing!=NULL)
8258  {
8259  if (check_valid(dA1[i].valid_for,op)) break;
8260  }
8261  else
8262  {
8263  if (RingDependend(dA1[i].res))
8264  {
8265  WerrorS("no ring active");
8266  break;
8267  }
8268  }
8269  if (traceit&TRACE_CALL)
8270  Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(dA1[i].arg));
8271  res->rtyp=dA1[i].res;
8272  failed= ((iiConvert(at,dA1[i].arg,ai,a,an,dConvertTypes))
8273  || (call_failed=dA1[i].p(res,an)));
8274  // everything done, clean up temp. variables
8275  if (failed)
8276  {
8277  // leave loop, goto error handling
8278  break;
8279  }
8280  else
8281  {
8282  if (an->Next() != NULL)
8283  {
8284  res->next = (leftv)omAllocBin(sleftv_bin);
8285  failed=iiExprArith1(res->next,an->next,op);
8286  }
8287  // everything ok, clean up and return
8288  an->CleanUp();
8290  a->CleanUp();
8291  return failed;
8292  }
8293  }
8294  i++;
8295  }
8296  an->CleanUp();
8298  }
8299  // error handling
8300  if (!errorreported)
8301  {
8302  if ((at==0) && (a->Fullname()!=sNoName))
8303  {
8304  Werror("`%s` is not defined",a->Fullname());
8305  }
8306  else
8307  {
8308  i=0;
8309  const char *s = iiTwoOps(op);
8310  Werror("%s(`%s`) failed"
8311  ,s,Tok2Cmdname(at));
8312  if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8313  {
8314  while (dA1[i].cmd==op)
8315  {
8316  if ((dA1[i].res!=0)
8317  && (dA1[i].p!=jjWRONG))
8318  Werror("expected %s(`%s`)"
8319  ,s,Tok2Cmdname(dA1[i].arg));
8320  i++;
8321  }
8322  }
8323  }
8324  }
8325  res->rtyp = UNKNOWN;
8326  }
8327  a->CleanUp();
8328  return TRUE;
8329 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
const CanonicalForm int s
Definition: facAbsFact.cc:55
int iiTestConvert(int inputType, int outputType)
Definition: gentable.cc:292
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define Print
Definition: emacs.cc:83
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:8330
#define FALSE
Definition: auxiliary.h:140
return P p
Definition: myNF.cc:203
const char sNoName[]
Definition: subexpr.cc:56
#define TRUE
Definition: auxiliary.h:144
#define UNKNOWN
Definition: tok.h:174
void * ADDRESS
Definition: auxiliary.h:161
sleftv * leftv
Definition: structs.h:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
int traceit
Definition: febase.cc:47
short res
Definition: gentable.cc:70
const char * Fullname()
Definition: subexpr.h:126
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define V_SHOW_USE
Definition: options.h:50
static BOOLEAN check_valid(const int p, const int op)
Definition: iparith.cc:9140
const char * Tok2Cmdname(int tok)
Definition: iparith.cc:8861
int RingDependend(int t)
Definition: gentable.cc:23
const char * iiTwoOps(int t)
Definition: gentable.cc:252
static BOOLEAN jjWRONG(leftv, leftv)
Definition: iparith.cc:3665
leftv Next()
Definition: subexpr.h:137
omBin sleftv_bin
Definition: subexpr.cc:50
int i
Definition: cfEzgcd.cc:123
#define TRACE_CALL
Definition: reporter.h:41
short errorreported
Definition: feFopen.cc:23
leftv next
Definition: subexpr.h:87
#define BVERBOSE(a)
Definition: options.h:33
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
#define NULL
Definition: omList.c:10
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:358
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
int iiOp
Definition: iparith.cc:240
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
BOOLEAN iiExprArith2 ( leftv  res,
sleftv a,
int  op,
sleftv b,
BOOLEAN  proccall = FALSE 
)
BOOLEAN iiExprArith2Tab ( leftv  res,
leftv  a,
int  op,
struct sValCmd2 dA2,
int  at,
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 8130 of file iparith.cc.

8134 {
8135  leftv b=a->next;
8136  a->next=NULL;
8137  int bt=b->Typ();
8138  BOOLEAN bo=iiExprArith2TabIntern(res,a,op,b,TRUE,dA2,at,bt,dConvertTypes);
8139  a->next=b;
8140  a->CleanUp();
8141  return bo;
8142 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define TRUE
Definition: auxiliary.h:144
int Typ()
Definition: subexpr.cc:969
leftv next
Definition: subexpr.h:87
static BOOLEAN iiExprArith2TabIntern(leftv res, leftv a, int op, leftv b, BOOLEAN proccall, struct sValCmd2 *dA2, int at, int bt, struct sConvertTypes *dConvertTypes)
Definition: iparith.cc:7971
#define NULL
Definition: omList.c:10
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
int BOOLEAN
Definition: auxiliary.h:131
const poly b
Definition: syzextra.cc:213
BOOLEAN iiExprArith3 ( leftv  res,
int  op,
leftv  a,
leftv  b,
leftv  c 
)

Definition at line 8542 of file iparith.cc.

8543 {
8544  memset(res,0,sizeof(sleftv));
8545 
8546  if (!errorreported)
8547  {
8548 #ifdef SIQ
8549  if (siq>0)
8550  {
8551  //Print("siq:%d\n",siq);
8553  memcpy(&d->arg1,a,sizeof(sleftv));
8554  //a->Init();
8555  memcpy(&d->arg2,b,sizeof(sleftv));
8556  //b->Init();
8557  memcpy(&d->arg3,c,sizeof(sleftv));
8558  //c->Init();
8559  d->op=op;
8560  d->argc=3;
8561  res->data=(char *)d;
8562  res->rtyp=COMMAND;
8563  return FALSE;
8564  }
8565 #endif
8566  int at=a->Typ();
8567  // handling bb-objects ----------------------------------------------
8568  if (at>MAX_TOK)
8569  {
8570  blackbox *bb=getBlackboxStuff(at);
8571  if (bb!=NULL)
8572  {
8573  if(!bb->blackbox_Op3(op,res,a,b,c)) return FALSE;
8574  if (errorreported) return TRUE;
8575  // else: no op defined
8576  }
8577  else return TRUE;
8578  if (errorreported) return TRUE;
8579  }
8580  int bt=b->Typ();
8581  int ct=c->Typ();
8582 
8583  iiOp=op;
8584  int i=0;
8585  while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8586  return iiExprArith3TabIntern(res,op,a,b,c,dArith3+i,at,bt,ct,dConvertTypes);
8587  }
8588  a->CleanUp();
8589  b->CleanUp();
8590  c->CleanUp();
8591  //Print("op: %d,result typ:%d\n",op,res->rtyp);
8592  return TRUE;
8593 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
ip_command * command
Definition: ipid.h:24
#define FALSE
Definition: auxiliary.h:140
Definition: tok.h:170
BOOLEAN siq
Definition: subexpr.cc:58
#define TRUE
Definition: auxiliary.h:144
int Typ()
Definition: subexpr.cc:969
void * data
Definition: subexpr.h:89
struct sValCmd3 dArith3[]
Definition: table.h:706
int i
Definition: cfEzgcd.cc:123
short errorreported
Definition: feFopen.cc:23
struct sConvertTypes dConvertTypes[]
Definition: table.h:1170
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
static BOOLEAN iiExprArith3TabIntern(leftv res, int op, leftv a, leftv b, leftv c, struct sValCmd3 *dA3, int at, int bt, int ct, struct sConvertTypes *dConvertTypes)
Definition: iparith.cc:8388
#define NULL
Definition: omList.c:10
omBin sip_command_bin
Definition: ipid.cc:49
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
int iiOp
Definition: iparith.cc:240
#define COMMAND
Definition: tok.h:33
blackbox * getBlackboxStuff(const int t)
return the structure to the type given by t
Definition: blackbox.cc:20
BOOLEAN iiExprArith3Tab ( leftv  res,
leftv  a,
int  op,
struct sValCmd3 dA3,
int  at,
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 8594 of file iparith.cc.

8598 {
8599  leftv b=a->next;
8600  a->next=NULL;
8601  int bt=b->Typ();
8602  leftv c=b->next;
8603  b->next=NULL;
8604  int ct=c->Typ();
8605  BOOLEAN bo=iiExprArith3TabIntern(res,op,a,b,c,dA3,at,bt,ct,dConvertTypes);
8606  b->next=c;
8607  a->next=b;
8608  a->CleanUp();
8609  return bo;
8610 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
int Typ()
Definition: subexpr.cc:969
leftv next
Definition: subexpr.h:87
static BOOLEAN iiExprArith3TabIntern(leftv res, int op, leftv a, leftv b, leftv c, struct sValCmd3 *dA3, int at, int bt, int ct, struct sConvertTypes *dConvertTypes)
Definition: iparith.cc:8388
#define NULL
Definition: omList.c:10
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
int BOOLEAN
Definition: auxiliary.h:131
const poly b
Definition: syzextra.cc:213
BOOLEAN iiExprArithM ( leftv  res,
sleftv a,
int  op 
)
char* iiGetLibName ( procinfov  v)

Definition at line 101 of file iplib.cc.

102 {
103  return pi->libname;
104 }
#define pi
Definition: libparse.cc:1143
char* iiGetLibProcBuffer ( procinfov  pi,
int  part = 1 
)
poly iiHighCorner ( ideal  i,
int  ak 
)

Definition at line 1488 of file ipshell.cc.

1489 {
1490  int i;
1491  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1492  poly po=NULL;
1494  {
1495  scComputeHC(I,currRing->qideal,ak,po);
1496  if (po!=NULL)
1497  {
1498  pGetCoeff(po)=nInit(1);
1499  for (i=rVar(currRing); i>0; i--)
1500  {
1501  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1502  }
1503  pSetComp(po,ak);
1504  pSetm(po);
1505  }
1506  }
1507  else
1508  po=pOne();
1509  return po;
1510 }
#define pSetm(p)
Definition: polys.h:241
#define pDecrExp(p, i)
Definition: polys.h:44
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:540
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge, ring tailRing)
Definition: hdegree.cc:1005
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy ...
Definition: monomials.h:51
static BOOLEAN idIsZeroDim(ideal i)
Definition: ideals.h:173
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
#define pSetComp(p, v)
Definition: polys.h:38
int i
Definition: cfEzgcd.cc:123
#define pOne()
Definition: polys.h:286
#define rHasLocalOrMixedOrdering_currRing()
Definition: ring.h:760
#define NULL
Definition: omList.c:10
strat ak
Definition: myNF.cc:321
polyrec * poly
Definition: hilb.h:10
#define nInit(i)
Definition: numbers.h:24
BOOLEAN iiInternalExport ( leftv  v,
int  toLev,
package  pack 
)

Definition at line 1342 of file ipshell.cc.

1343 {
1344  idhdl h=(idhdl)v->data;
1345  if(h==NULL)
1346  {
1347  Warn("'%s': no such identifier\n", v->name);
1348  return FALSE;
1349  }
1350  package frompack=v->req_packhdl;
1351  if (frompack==NULL) frompack=currPack;
1352  if ((RingDependend(IDTYP(h)))
1353  || ((IDTYP(h)==LIST_CMD)
1354  && (lRingDependend(IDLIST(h)))
1355  )
1356  )
1357  {
1358  //Print("// ==> Ringdependent set nesting to 0\n");
1359  return (iiInternalExport(v, toLev));
1360  }
1361  else
1362  {
1363  IDLEV(h)=toLev;
1364  v->req_packhdl=rootpack;
1365  if (h==frompack->idroot)
1366  {
1367  frompack->idroot=h->next;
1368  }
1369  else
1370  {
1371  idhdl hh=frompack->idroot;
1372  while ((hh!=NULL) && (hh->next!=h))
1373  hh=hh->next;
1374  if ((hh!=NULL) && (hh->next==h))
1375  hh->next=h->next;
1376  else
1377  {
1378  Werror("`%s` not found",v->Name());
1379  return TRUE;
1380  }
1381  }
1382  h->next=rootpack->idroot;
1383  rootpack->idroot=h;
1384  }
1385  return FALSE;
1386 }
#define IDLIST(a)
Definition: ipid.h:136
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
const char * Name()
Definition: subexpr.h:121
Definition: idrec.h:34
void * data
Definition: subexpr.h:89
#define IDTYP(a)
Definition: ipid.h:118
int RingDependend(int t)
Definition: gentable.cc:23
const char * name
Definition: subexpr.h:88
idrec * idhdl
Definition: ring.h:18
idhdl next
Definition: idrec.h:38
#define IDLEV(a)
Definition: ipid.h:120
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1280
#define NULL
Definition: omList.c:10
package req_packhdl
Definition: subexpr.h:107
package currPack
Definition: ipid.cc:63
Definition: tok.h:96
static Poly * h
Definition: janet.cc:978
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:199
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define Warn
Definition: emacs.cc:80
BOOLEAN iiLibCmd ( char *  newlib,
BOOLEAN  autoexport,
BOOLEAN  tellerror,
BOOLEAN  force 
)

Definition at line 813 of file iplib.cc.

814 {
815  char libnamebuf[128];
816  // procinfov pi;
817  // idhdl h;
818  idhdl pl;
819  // idhdl hl;
820  // long pos = 0L;
821  char *plib = iiConvName(newlib);
822  FILE * fp = feFopen( newlib, "r", libnamebuf, tellerror );
823  // int lines = 1;
824  BOOLEAN LoadResult = TRUE;
825 
826  if (fp==NULL)
827  {
828  return TRUE;
829  }
830  pl = basePack->idroot->get(plib,0);
831  if (pl==NULL)
832  {
833  pl = enterid( plib,0, PACKAGE_CMD,
834  &(basePack->idroot), TRUE );
835  IDPACKAGE(pl)->language = LANG_SINGULAR;
836  IDPACKAGE(pl)->libname=omStrDup(newlib);
837  }
838  else
839  {
840  if(IDTYP(pl)!=PACKAGE_CMD)
841  {
842  WarnS("not of type package.");
843  fclose(fp);
844  return TRUE;
845  }
846  if (!force) return FALSE;
847  }
848  LoadResult = iiLoadLIB(fp, libnamebuf, newlib, pl, autoexport, tellerror);
849  omFree((ADDRESS)newlib);
850 
851  if(!LoadResult) IDPACKAGE(pl)->loaded = TRUE;
852  omFree((ADDRESS)plib);
853 
854  return LoadResult;
855 }
CanonicalForm fp
Definition: cfModGcd.cc:4043
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
void * ADDRESS
Definition: auxiliary.h:161
#define WarnS
Definition: emacs.cc:81
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:138
#define IDTYP(a)
Definition: ipid.h:118
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:259
#define omFree(addr)
Definition: omAllocDecl.h:261
FILE * feFopen(const char *path, const char *mode, char *where, short useWerror, short path_only)
Definition: feFopen.cc:47
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
char libnamebuf[128]
Definition: libparse.cc:1096
BOOLEAN iiLoadLIB(FILE *fp, const char *libnamebuf, const char *newlib, idhdl pl, BOOLEAN autoexport, BOOLEAN tellerror)
Definition: iplib.cc:902
char * iiConvName(const char *libname)
Definition: iplib.cc:1279
int BOOLEAN
Definition: auxiliary.h:131
#define omStrDup(s)
Definition: omAllocDecl.h:263
BOOLEAN iiLoadLIB ( FILE *  fp,
const char *  libnamebuf,
const char *  newlib,
idhdl  pl,
BOOLEAN  autoexport,
BOOLEAN  tellerror 
)

Definition at line 902 of file iplib.cc.

904 {
905  extern FILE *yylpin;
906  libstackv ls_start = library_stack;
907  lib_style_types lib_style;
908 
909  yylpin = fp;
910  #if YYLPDEBUG > 1
911  print_init();
912  #endif
913  extern int lpverbose;
914  if (BVERBOSE(V_DEBUG_LIB)) lpverbose=1;
915  else lpverbose=0;
916  // yylplex sets also text_buffer
917  if (text_buffer!=NULL) *text_buffer='\0';
918  yylplex(newlib, libnamebuf, &lib_style, pl, autoexport);
919  if(yylp_errno)
920  {
921  Werror("Library %s: ERROR occurred: in line %d, %d.", newlib, yylplineno,
922  current_pos(0));
924  {
928  }
929  else
931  Werror("Cannot load library,... aborting.");
932  reinit_yylp();
933  fclose( yylpin );
935  return TRUE;
936  }
937  if (BVERBOSE(V_LOAD_LIB))
938  Print( "// ** loaded %s %s\n", libnamebuf, text_buffer);
939  if( (lib_style == OLD_LIBSTYLE) && (BVERBOSE(V_LOAD_LIB)))
940  {
941  Warn( "library %s has old format. This format is still accepted,", newlib);
942  Warn( "but for functionality you may wish to change to the new");
943  Warn( "format. Please refer to the manual for further information.");
944  }
945  reinit_yylp();
946  fclose( yylpin );
947  fp = NULL;
948  iiRunInit(IDPACKAGE(pl));
949 
950  {
951  libstackv ls;
952  for(ls = library_stack; (ls != NULL) && (ls != ls_start); )
953  {
954  if(ls->to_be_done)
955  {
956  ls->to_be_done=FALSE;
957  iiLibCmd(ls->get(),autoexport,tellerror,FALSE);
958  ls = ls->pop(newlib);
959  }
960  }
961 #if 0
962  PrintS("--------------------\n");
963  for(ls = library_stack; ls != NULL; ls = ls->next)
964  {
965  Print("%s: LIB-stack:(%d), %s %s\n", newlib, ls->cnt, ls->get(),
966  ls->to_be_done ? "not loaded" : "loaded");
967  }
968  PrintS("--------------------\n");
969 #endif
970  }
971 
972  if(fp != NULL) fclose(fp);
973  return FALSE;
974 }
int cnt
Definition: subexpr.h:167
#define Print
Definition: emacs.cc:83
CanonicalForm fp
Definition: cfModGcd.cc:4043
int yylplex(const char *libname, const char *libfile, lib_style_types *lib_style, idhdl pl, BOOLEAN autoexport=FALSE, lp_modes=LOAD_LIB)
libstackv next
Definition: subexpr.h:164
#define FALSE
Definition: auxiliary.h:140
static void iiRunInit(package p)
Definition: iplib.cc:886
#define V_LOAD_LIB
Definition: options.h:45
#define IDROOT
Definition: ipid.h:20
BOOLEAN to_be_done
Definition: subexpr.h:166
#define TRUE
Definition: auxiliary.h:144
void print_init()
Definition: libparse.cc:3483
void * ADDRESS
Definition: auxiliary.h:161
char * get()
Definition: subexpr.h:170
#define V_DEBUG_LIB
Definition: options.h:46
libstackv pop(const char *p)
Definition: iplib.cc:1368
BOOLEAN iiLibCmd(char *newlib, BOOLEAN autoexport, BOOLEAN tellerror, BOOLEAN force)
Definition: iplib.cc:813
#define IDPACKAGE(a)
Definition: ipid.h:138
#define YYLP_BAD_CHAR
Definition: libparse.h:93
int lpverbose
Definition: libparse.cc:1104
int yylp_errno
Definition: libparse.cc:1128
#define omFree(addr)
Definition: omAllocDecl.h:261
char * yylp_errlist[]
Definition: libparse.cc:1112
void PrintS(const char *s)
Definition: reporter.cc:294
#define BVERBOSE(a)
Definition: options.h:33
#define NULL
Definition: omList.c:10
char * text_buffer
Definition: libparse.cc:1097
int current_pos(int i=0)
Definition: libparse.cc:3347
lib_style_types
Definition: libparse.h:9
char libnamebuf[128]
Definition: libparse.cc:1096
static void iiCleanProcs(idhdl &root)
Definition: iplib.cc:857
void Werror(const char *fmt,...)
Definition: reporter.cc:199
libstackv library_stack
Definition: iplib.cc:74
int yylplineno
Definition: libparse.cc:1102
#define Warn
Definition: emacs.cc:80
void reinit_yylp()
Definition: libparse.cc:3377
BOOLEAN iiLocateLib ( const char *  lib,
char *  where 
)

Definition at line 799 of file iplib.cc.

800 {
801  char *plib = iiConvName(lib);
802  idhdl pl = basePack->idroot->get(plib,0);
803  if( (pl!=NULL) && (IDTYP(pl)==PACKAGE_CMD) &&
804  (IDPACKAGE(pl)->language == LANG_SINGULAR))
805  {
806  strncpy(where,IDPACKAGE(pl)->libname,127);
807  return TRUE;
808  }
809  else
810  return FALSE;;
811 }
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:138
#define IDTYP(a)
Definition: ipid.h:118
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
char * iiConvName(const char *libname)
Definition: iplib.cc:1279
BOOLEAN iiMake_proc ( idhdl  pn,
package  pack,
sleftv sl 
)

Definition at line 573 of file iplib.cc.

574 {
575  int err;
576  procinfov pi = IDPROC(pn);
577  if(pi->is_static && myynest==0)
578  {
579  Werror("'%s::%s()' is a local procedure and cannot be accessed by an user.",
580  pi->libname, pi->procname);
581  return TRUE;
582  }
583  iiCheckNest();
584 #ifdef USE_IILOCALRING
586  //Print("currRing(%d):%s(%x) in %s\n",myynest,IDID(currRingHdl),currRing,IDID(pn));
587 #endif
588  iiRETURNEXPR.Init();
589  procstack->push(pi->procname);
591  || (pi->trace_flag&TRACE_SHOW_PROC))
592  {
594  Print("entering%-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
595  }
596 #ifdef RDEBUG
598 #endif
599  switch (pi->language)
600  {
601  default:
602  case LANG_NONE:
603  WerrorS("undefined proc");
604  err=TRUE;
605  break;
606 
607  case LANG_SINGULAR:
608  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
609  {
610  currPack=pi->pack;
613  //Print("set pack=%s\n",IDID(currPackHdl));
614  }
615  else if ((pack!=NULL)&&(currPack!=pack))
616  {
617  currPack=pack;
620  //Print("set pack=%s\n",IDID(currPackHdl));
621  }
622  err=iiPStart(pn,sl);
623  break;
624  case LANG_C:
626  err = (pi->data.o.function)(res, sl);
627  memcpy(&iiRETURNEXPR,res,sizeof(iiRETURNEXPR));
629  break;
630  }
631  if ((traceit&TRACE_SHOW_PROC)
632  || (pi->trace_flag&TRACE_SHOW_PROC))
633  {
634  if (traceit&TRACE_SHOW_LINENO) PrintLn();
635  Print("leaving %-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
636  }
637  //const char *n="NULL";
638  //if (currRingHdl!=NULL) n=IDID(currRingHdl);
639  //Print("currRing(%d):%s(%x) after %s\n",myynest,n,currRing,IDID(pn));
640 #ifdef RDEBUG
641  if (traceit&TRACE_SHOW_RINGS) iiShowLevRings();
642 #endif
643  if (err)
644  {
646  //iiRETURNEXPR.Init(); //done by CleanUp
647  }
648  if (iiCurrArgs!=NULL)
649  {
650  if (!err) Warn("too many arguments for %s",IDID(pn));
651  iiCurrArgs->CleanUp();
654  }
655  procstack->pop();
656  if (err)
657  return TRUE;
658  return FALSE;
659 }
#define TRACE_SHOW_LINENO
Definition: reporter.h:28
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define TRACE_SHOW_RINGS
Definition: reporter.h:33
void PrintLn()
Definition: reporter.cc:327
#define Print
Definition: emacs.cc:83
package pack
Definition: subexpr.h:57
idhdl currPackHdl
Definition: ipid.cc:61
#define IDID(a)
Definition: ipid.h:121
#define FALSE
Definition: auxiliary.h:140
sleftv iiRETURNEXPR
Definition: iplib.cc:527
language_defs language
Definition: subexpr.h:58
proclevel * procstack
Definition: ipid.cc:58
static void iiShowLevRings()
Definition: iplib.cc:531
#define TRUE
Definition: auxiliary.h:144
void Init()
Definition: subexpr.h:108
void * ADDRESS
Definition: auxiliary.h:161
sleftv * leftv
Definition: structs.h:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
int traceit
Definition: febase.cc:47
static void iiCheckNest()
Definition: iplib.cc:560
char * procname
Definition: subexpr.h:56
poly res
Definition: myNF.cc:322
Definition: subexpr.h:20
int myynest
Definition: febase.cc:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
char * libname
Definition: subexpr.h:55
procinfodata data
Definition: subexpr.h:62
omBin sleftv_bin
Definition: subexpr.cc:50
char is_static
Definition: subexpr.h:60
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
#define IDPROC(a)
Definition: ipid.h:139
#define pi
Definition: libparse.cc:1143
ring * iiLocalRing
Definition: iplib.cc:525
#define NULL
Definition: omList.c:10
BOOLEAN iiPStart(idhdl pn, sleftv *v)
Definition: iplib.cc:382
package currPack
Definition: ipid.cc:63
leftv iiCurrArgs
Definition: ipshell.cc:84
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
#define TRACE_SHOW_PROC
Definition: reporter.h:26
idhdl packFindHdl(package r)
Definition: ipid.cc:732
void iiCheckPack(package &p)
Definition: ipshell.cc:1512
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
void push(char *)
Definition: ipid.cc:702
void pop()
Definition: ipid.cc:714
char trace_flag
Definition: subexpr.h:61
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define Warn
Definition: emacs.cc:80
void iiMakeResolv ( resolvente  r,
int  length,
int  rlen,
char *  name,
int  typ0,
intvec **  weights = NULL 
)

Definition at line 772 of file ipshell.cc.

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

Definition at line 622 of file ipshell.cc.

623 {
624  idhdl w,r;
625  leftv v;
626  int i;
627  nMapFunc nMap;
628 
629  r=IDROOT->get(theMap->preimage,myynest);
630  if ((currPack!=basePack)
631  &&((r==NULL) || ((r->typ != RING_CMD) && (r->typ != QRING_CMD))))
632  r=basePack->idroot->get(theMap->preimage,myynest);
633  if ((r==NULL) && (currRingHdl!=NULL)
634  && (strcmp(theMap->preimage,IDID(currRingHdl))==0))
635  {
636  r=currRingHdl;
637  }
638  if ((r!=NULL) && ((r->typ == RING_CMD) || (r->typ== QRING_CMD)))
639  {
640  ring src_ring=IDRING(r);
641  if ((nMap=n_SetMap(src_ring->cf, currRing->cf))==NULL)
642  {
643  Werror("can not map from ground field of %s to current ground field",
644  theMap->preimage);
645  return NULL;
646  }
647  if (IDELEMS(theMap)<src_ring->N)
648  {
649  theMap->m=(polyset)omReallocSize((ADDRESS)theMap->m,
650  IDELEMS(theMap)*sizeof(poly),
651  (src_ring->N)*sizeof(poly));
652  for(i=IDELEMS(theMap);i<src_ring->N;i++)
653  theMap->m[i]=NULL;
654  IDELEMS(theMap)=src_ring->N;
655  }
656  if (what==NULL)
657  {
658  WerrorS("argument of a map must have a name");
659  }
660  else if ((w=src_ring->idroot->get(what,myynest))!=NULL)
661  {
662  char *save_r=NULL;
664  sleftv tmpW;
665  memset(&tmpW,0,sizeof(sleftv));
666  tmpW.rtyp=IDTYP(w);
667  if (tmpW.rtyp==MAP_CMD)
668  {
669  tmpW.rtyp=IDEAL_CMD;
670  save_r=IDMAP(w)->preimage;
671  IDMAP(w)->preimage=0;
672  }
673  tmpW.data=IDDATA(w);
674  // check overflow
675  BOOLEAN overflow=FALSE;
676  if ((tmpW.rtyp==IDEAL_CMD)
677  || (tmpW.rtyp==MODUL_CMD)
678  || (tmpW.rtyp==MAP_CMD))
679  {
680  ideal id=(ideal)tmpW.data;
681  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
682  {
683  if (theMap->m[j]!=NULL)
684  {
685  long deg_monexp=pTotaldegree(theMap->m[j]);
686  for(int i=IDELEMS(id)-1;i>=0;i--)
687  {
688  poly p=id->m[i];
689  if ((p!=NULL) && (p_Totaldegree(p,src_ring)!=0) &&
690  ((unsigned long)deg_monexp > (currRing->bitmask / (unsigned long)p_Totaldegree(p,src_ring)/2)))
691  {
692  overflow=TRUE;
693  break;
694  }
695  }
696  }
697  }
698  }
699  else if (tmpW.rtyp==POLY_CMD)
700  {
701  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
702  {
703  if (theMap->m[j]!=NULL)
704  {
705  long deg_monexp=pTotaldegree(theMap->m[j]);
706  poly p=(poly)tmpW.data;
707  if ((p!=NULL) && (p_Totaldegree(p,src_ring)!=0) &&
708  ((unsigned long)deg_monexp > (currRing->bitmask / (unsigned long)p_Totaldegree(p,src_ring)/2)))
709  {
710  overflow=TRUE;
711  break;
712  }
713  }
714  }
715  }
716  if (overflow)
717  Warn("possible OVERFLOW in map, max exponent is %ld",currRing->bitmask/2);
718 #if 0
719  if (((tmpW.rtyp==IDEAL_CMD)||(tmpW.rtyp==MODUL_CMD)) && idIs0(IDIDEAL(w)))
720  {
721  v->rtyp=tmpW.rtyp;
722  v->data=idInit(IDELEMS(IDIDEAL(w)),IDIDEAL(w)->rank);
723  }
724  else
725 #endif
726  {
727 #ifdef FAST_MAP
728  if ((tmpW.rtyp==IDEAL_CMD) && (nMap == ndCopyMap)
729 #ifdef HAVE_PLURAL
730  && (!rIsPluralRing(currRing))
731 #endif
732  )
733  {
734  v->rtyp=IDEAL_CMD;
735  char *tmp = theMap->preimage;
736  theMap->preimage=(char*)1L;
737  // map gets 1 as its rank (as an ideal)
738  v->data=fast_map(IDIDEAL(w), src_ring, (ideal)theMap, currRing);
739  theMap->preimage=tmp; // map gets its preimage back
740  }
741  else
742 #endif
743  if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,src_ring,NULL,NULL,0,nMap))
744  {
745  Werror("cannot map %s(%d)",Tok2Cmdname(w->typ),w->typ);
747  if (save_r!=NULL) IDMAP(w)->preimage=save_r;
748  return NULL;
749  }
750  }
751  if (save_r!=NULL)
752  {
753  IDMAP(w)->preimage=save_r;
754  IDMAP((idhdl)v)->preimage=omStrDup(save_r);
755  v->rtyp=MAP_CMD;
756  }
757  return v;
758  }
759  else
760  {
761  Werror("%s undefined in %s",what,theMap->preimage);
762  }
763  }
764  else
765  {
766  Werror("cannot find preimage %s",theMap->preimage);
767  }
768  return NULL;
769 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
if(0 > strat->sl)
Definition: myNF.cc:73
#define IDID(a)
Definition: ipid.h:121
#define FALSE
Definition: auxiliary.h:140
return P p
Definition: myNF.cc:203
number ndCopyMap(number a, const coeffs aRing, const coeffs r)
Definition: numbers.cc:239
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:144
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:54
#define IDIDEAL(a)
Definition: ipid.h:132
static long p_Totaldegree(poly p, const ring r)
Definition: p_polys.h:1435
void * ADDRESS
Definition: auxiliary.h:161
sleftv * leftv
Definition: structs.h:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
static bool rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:361
Definition: idrec.h:34
idhdl get(const char *s, int lev)
Definition: ipid.cc:91
void * data
Definition: subexpr.h:89
int myynest
Definition: febase.cc:46
#define omReallocSize(addr, o_size, size)
Definition: omAllocDecl.h:220
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define IDTYP(a)
Definition: ipid.h:118
const ring r
Definition: syzextra.cc:208
int j
Definition: myNF.cc:70
static long pTotaldegree(poly p)
Definition: polys.h:253
number(* nMapFunc)(number a, const coeffs src, const coeffs dst)
maps "a", which lives in src, into dst
Definition: coeffs.h:72
idhdl currRingHdl
Definition: ipid.cc:65
omBin sleftv_bin
Definition: subexpr.cc:50
int i
Definition: cfEzgcd.cc:123
#define IDELEMS(i)
Definition: simpleideals.h:24
static FORCE_INLINE nMapFunc n_SetMap(const coeffs src, const coeffs dst)
set the mapping function pointers for translating numbers from src to dst
Definition: coeffs.h:720
#define IDMAP(a)
Definition: ipid.h:134
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
poly * polyset
Definition: hutil.h:17
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:128
package basePack
Definition: ipid.cc:64
#define IDRING(a)
Definition: ipid.h:126
const CanonicalForm & w
Definition: facAbsFact.cc:55
package currPack
Definition: ipid.cc:63
int rtyp
Definition: subexpr.h:92
ideal fast_map(ideal map_id, ring map_r, ideal image_id, ring image_r)
Definition: fast_maps.cc:354
int typ
Definition: idrec.h:43
Definition: tok.h:126
polyrec * poly
Definition: hilb.h:10
#define IDDATA(a)
Definition: ipid.h:125
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
int BOOLEAN
Definition: auxiliary.h:131
BOOLEAN idIs0(ideal h)
returns true if h is the zero ideal
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263
int iiOpsTwoChar ( const char *  s)

Definition at line 125 of file ipshell.cc.

126 {
127 /* not handling: &&, ||, ** */
128  if (s[1]=='\0') return s[0];
129  else if (s[2]!='\0') return 0;
130  switch(s[0])
131  {
132  case '.': if (s[1]=='.') return DOTDOT;
133  else return 0;
134  case ':': if (s[1]==':') return COLONCOLON;
135  else return 0;
136  case '-': if (s[1]=='-') return MINUSMINUS;
137  else return 0;
138  case '+': if (s[1]=='+') return PLUSPLUS;
139  else return 0;
140  case '=': if (s[1]=='=') return EQUAL_EQUAL;
141  else return 0;
142  case '<': if (s[1]=='=') return LE;
143  else if (s[1]=='>') return NOTEQUAL;
144  else return 0;
145  case '>': if (s[1]=='=') return GE;
146  else return 0;
147  case '!': if (s[1]=='=') return NOTEQUAL;
148  else return 0;
149  }
150  return 0;
151 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Definition: grammar.cc:271
Definition: grammar.cc:270
BOOLEAN iiParameter ( leftv  p)

Definition at line 1244 of file ipshell.cc.

1245 {
1246  if (iiCurrArgs==NULL)
1247  {
1248  if (strcmp(p->name,"#")==0)
1249  return iiDefaultParameter(p);
1250  Werror("not enough arguments for proc %s",VoiceName());
1251  p->CleanUp();
1252  return TRUE;
1253  }
1254  leftv h=iiCurrArgs;
1255  leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1256  BOOLEAN is_default_list=FALSE;
1257  if (strcmp(p->name,"#")==0)
1258  {
1259  is_default_list=TRUE;
1260  rest=NULL;
1261  }
1262  else
1263  {
1264  h->next=NULL;
1265  }
1266  BOOLEAN res=iiAssign(p,h);
1267  if (is_default_list)
1268  {
1269  iiCurrArgs=NULL;
1270  }
1271  else
1272  {
1273  iiCurrArgs=rest;
1274  }
1275  h->CleanUp();
1277  return res;
1278 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
void * ADDRESS
Definition: auxiliary.h:161
poly res
Definition: myNF.cc:322
const char * name
Definition: subexpr.h:88
omBin sleftv_bin
Definition: subexpr.cc:50
const char * VoiceName()
Definition: fevoices.cc:66
leftv next
Definition: subexpr.h:87
#define NULL
Definition: omList.c:10
BOOLEAN iiDefaultParameter(leftv p)
Definition: ipshell.cc:1161
leftv iiCurrArgs
Definition: ipshell.cc:84
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1782
char* iiProcArgs ( char *  e,
BOOLEAN  withParenth 
)

Definition at line 127 of file iplib.cc.

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

Definition at line 113 of file iplib.cc.

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

Definition at line 382 of file iplib.cc.

383 {
384  procinfov pi=NULL;
385  int old_echo=si_echo;
386  BOOLEAN err=FALSE;
387  char save_flags=0;
388 
389  /* init febase ======================================== */
390  /* we do not enter this case if filename != NULL !! */
391  if (pn!=NULL)
392  {
393  pi = IDPROC(pn);
394  if(pi!=NULL)
395  {
396  save_flags=pi->trace_flag;
397  if( pi->data.s.body==NULL )
398  {
399  iiGetLibProcBuffer(pi);
400  if (pi->data.s.body==NULL) return TRUE;
401  }
402 // omUpdateInfo();
403 // int m=om_Info.UsedBytes;
404 // Print("proc %s, mem=%d\n",IDID(pn),m);
405  }
406  }
407  else return TRUE;
408  /* generate argument list ======================================*/
409  if (v!=NULL)
410  {
412  memcpy(iiCurrArgs,v,sizeof(sleftv));
413  memset(v,0,sizeof(sleftv));
414  }
415  else
416  {
418  }
419  iiCurrProc=pn;
420  /* start interpreter ======================================*/
421  myynest++;
422  if (myynest > SI_MAX_NEST)
423  {
424  WerrorS("nesting too deep");
425  err=TRUE;
426  }
427  else
428  {
429  err=iiAllStart(pi,pi->data.s.body,BT_proc,pi->data.s.body_lineno-(v!=NULL));
430 
431 #ifdef USE_IILOCALRING
432 #if 0
433  if(procstack->cRing != iiLocalRing[myynest]) Print("iiMake_proc: 1 ring not saved procs:%x, iiLocal:%x\n",procstack->cRing, iiLocalRing[myynest]);
434 #endif
435  if (iiLocalRing[myynest-1] != currRing)
436  {
438  {
439  //idhdl hn;
440  const char *n;
441  const char *o;
442  idhdl nh=NULL, oh=NULL;
443  if (iiLocalRing[myynest-1]!=NULL)
444  oh=rFindHdl(iiLocalRing[myynest-1],NULL);
445  if (oh!=NULL) o=oh->id;
446  else o="none";
447  if (currRing!=NULL)
448  nh=rFindHdl(currRing,NULL);
449  if (nh!=NULL) n=nh->id;
450  else n="none";
451  Werror("ring change during procedure call: %s -> %s (level %d)",o,n,myynest);
453  err=TRUE;
454  }
455  currRing=iiLocalRing[myynest-1];
456  }
457  if ((currRing==NULL)
458  && (currRingHdl!=NULL))
460  else
461  if ((currRing!=NULL) &&
463  ||(IDLEV(currRingHdl)>=myynest-1)))
464  {
466  iiLocalRing[myynest-1]=NULL;
467  }
468 #else /* USE_IILOCALRING */
469  if (procstack->cRing != currRing)
470  {
471  //if (procstack->cRingHdl!=NULL)
472  //Print("procstack:%s,",IDID(procstack->cRingHdl));
473  //if (currRingHdl!=NULL)
474  //Print(" curr:%s\n",IDID(currRingHdl));
475  //Print("pr:%x, curr: %x\n",procstack->cRing,currRing);
477  {
478  //idhdl hn;
479  const char *n;
480  const char *o;
481  if (procstack->cRing!=NULL)
482  {
483  //PrintS("reset ring\n");
485  o=IDID(procstack->cRingHdl);
488  }
489  else o="none";
490  if (currRing!=NULL) n=IDID(currRingHdl);
491  else n="none";
492  if (currRing==NULL)
493  {
494  Werror("ring change during procedure call: %s -> %s (level %d)",o,n,myynest);
496  err=TRUE;
497  }
498  }
499  if (procstack->cRingHdl!=NULL)
500  {
502  }
503  else
505  }
506 #endif /* USE_IILOCALRING */
507  //Print("kill locals for %s (level %d)\n",IDID(pn),myynest);
508  killlocals(myynest);
509 #ifndef SING_NDEBUG
510  checkall();
511 #endif
512  //Print("end kill locals for %s (%d)\n",IDID(pn),myynest);
513  }
514  myynest--;
515  si_echo=old_echo;
516  if (pi!=NULL)
517  pi->trace_flag=save_flags;
518 // omUpdateInfo();
519 // int m=om_Info.UsedBytes;
520 // Print("exit %s, mem=%d\n",IDID(pn),m);
521  return err;
522 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define Print
Definition: emacs.cc:83
#define IDID(a)
Definition: ipid.h:121
#define FALSE
Definition: auxiliary.h:140
sleftv iiRETURNEXPR
Definition: iplib.cc:527
proclevel * procstack
Definition: ipid.cc:58
#define TRUE
Definition: auxiliary.h:144
sleftv * leftv
Definition: structs.h:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
idhdl cRingHdl
Definition: ipid.h:60
Definition: idrec.h:34
idhdl iiCurrProc
Definition: ipshell.cc:85
#define SI_MAX_NEST
Definition: iplib.cc:32
int myynest
Definition: febase.cc:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
BOOLEAN RingDependend()
Definition: subexpr.cc:389
void checkall()
Definition: misc_ip.cc:1017
void killlocals(int v)
Definition: ipshell.cc:385
procinfodata data
Definition: subexpr.h:62
idhdl currRingHdl
Definition: ipid.cc:65
omBin sleftv_bin
Definition: subexpr.cc:50
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1573
#define IDLEV(a)
Definition: ipid.h:120
BOOLEAN iiAllStart(procinfov pi, char *p, feBufferTypes t, int l)
Definition: iplib.cc:322
#define IDPROC(a)
Definition: ipid.h:139
#define pi
Definition: libparse.cc:1143
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
ring * iiLocalRing
Definition: iplib.cc:525
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:126
ring cRing
Definition: ipid.h:61
leftv iiCurrArgs
Definition: ipshell.cc:84
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
const char * id
Definition: idrec.h:39
void rSetHdl(idhdl h)
Definition: ipshell.cc:4979
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:210
int BOOLEAN
Definition: auxiliary.h:131
char trace_flag
Definition: subexpr.h:61
void Werror(const char *fmt,...)
Definition: reporter.cc:199
int si_echo
Definition: febase.cc:41
int iiRegularity ( lists  L)

Definition at line 953 of file ipshell.cc.

954 {
955  int len,reg,typ0;
956 
957  resolvente r=liFindRes(L,&len,&typ0);
958 
959  if (r==NULL)
960  return -2;
961  intvec *weights=NULL;
962  int add_row_shift=0;
963  intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
964  if (ww!=NULL)
965  {
966  weights=ivCopy(ww);
967  add_row_shift = ww->min_in();
968  (*weights) -= add_row_shift;
969  }
970  //Print("attr:%x\n",weights);
971 
972  intvec *dummy=syBetti(r,len,&reg,weights);
973  if (weights!=NULL) delete weights;
974  delete dummy;
975  omFreeSize((ADDRESS)r,len*sizeof(ideal));
976  return reg+1+add_row_shift;
977 }
sleftv * m
Definition: lists.h:45
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:313
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * ivCopy(const intvec *o)
Definition: intvec.h:141
void * ADDRESS
Definition: auxiliary.h:161
int min_in()
Definition: intvec.h:114
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:16
Definition: tok.h:88
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:135
#define NULL
Definition: omList.c:10
ideal * resolvente
Definition: ideals.h:20
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:793
BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6315 of file ipshell.cc.

6316 {
6317  // assume a: level
6318  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6319  {
6320  if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6321  char assume_yylinebuf[80];
6322  strncpy(assume_yylinebuf,my_yylinebuf,79);
6323  int lev=(long)a->Data();
6324  int startlev=0;
6325  idhdl h=ggetid("assumeLevel");
6326  if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6327  if(lev <=startlev)
6328  {
6329  BOOLEAN bo=b->Eval();
6330  if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6331  if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6332  if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6333  }
6334  }
6335  b->CleanUp();
6336  a->CleanUp();
6337  return FALSE;
6338 }
int Eval()
Definition: subexpr.cc:1735
Definition: tok.h:85
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define WarnS
Definition: emacs.cc:81
int Typ()
Definition: subexpr.cc:969
Definition: idrec.h:34
int myynest
Definition: febase.cc:46
#define IDTYP(a)
Definition: ipid.h:118
char my_yylinebuf[80]
Definition: febase.cc:48
#define NULL
Definition: omList.c:10
#define IDINT(a)
Definition: ipid.h:124
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
void * Data()
Definition: subexpr.cc:1111
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define TEST_V_ALLWARN
Definition: options.h:135
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:490
int iiTokType ( int  op)

Definition at line 255 of file iparith.cc.

256 {
257  for (int i=0;i<sArithBase.nCmdUsed;i++)
258  {
259  if (sArithBase.sCmds[i].tokval==op)
260  return sArithBase.sCmds[i].toktype;
261  }
262  return 0;
263 }
int nCmdUsed
number of commands used
Definition: iparith.cc:209
int i
Definition: cfEzgcd.cc:123
static SArithBase sArithBase
Base entry for arithmetic.
Definition: iparith.cc:219
cmdnames * sCmds
array of existing commands
Definition: iparith.cc:204
BOOLEAN iiTryLoadLib ( leftv  v,
const char *  id 
)

Definition at line 751 of file iplib.cc.

752 {
753  BOOLEAN LoadResult = TRUE;
754  char libnamebuf[128];
755  char *libname = (char *)omAlloc(strlen(id)+5);
756  const char *suffix[] = { "", ".lib", ".so", ".sl", NULL };
757  int i = 0;
758  // FILE *fp;
759  // package pack;
760  // idhdl packhdl;
761  lib_types LT;
762  for(i=0; suffix[i] != NULL; i++)
763  {
764  sprintf(libname, "%s%s", id, suffix[i]);
765  *libname = mytolower(*libname);
766  if((LT = type_of_LIB(libname, libnamebuf)) > LT_NOTFOUND)
767  {
768  char *s=omStrDup(libname);
769  #ifdef HAVE_DYNAMIC_LOADING
770  char libnamebuf[256];
771  #endif
772 
773  if (LT==LT_SINGULAR)
774  LoadResult = iiLibCmd(s, FALSE, FALSE,TRUE);
775  #ifdef HAVE_DYNAMIC_LOADING
776  else if ((LT==LT_ELF) || (LT==LT_HPUX))
777  LoadResult = load_modules(s,libnamebuf,FALSE);
778  #endif
779  else if (LT==LT_BUILTIN)
780  {
781  LoadResult=load_builtin(s,FALSE, iiGetBuiltinModInit(s));
782  }
783  if(!LoadResult )
784  {
785  v->name = iiConvName(libname);
786  break;
787  }
788  }
789  }
790  omFree(libname);
791  return LoadResult;
792 }
BOOLEAN load_builtin(const char *newlib, BOOLEAN autoexport, SModulFunc_t init)
Definition: iplib.cc:1147
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define FALSE
Definition: auxiliary.h:140
Definition: mod_raw.h:16
#define TRUE
Definition: auxiliary.h:144
lib_types type_of_LIB(const char *newlib, char *libnamebuf)
Definition: mod_lib.cc:24
#define omAlloc(size)
Definition: omAllocDecl.h:210
BOOLEAN iiLibCmd(char *newlib, BOOLEAN autoexport, BOOLEAN tellerror, BOOLEAN force)
Definition: iplib.cc:813
const char * name
Definition: subexpr.h:88
#define omFree(addr)
Definition: omAllocDecl.h:261
int i
Definition: cfEzgcd.cc:123
lib_types
Definition: mod_raw.h:16
char mytolower(char c)
Definition: iplib.cc:1266
#define NULL
Definition: omList.c:10
SModulFunc_t iiGetBuiltinModInit(const char *libname)
Definition: iplib.cc:738
char libnamebuf[128]
Definition: libparse.cc:1096
char * iiConvName(const char *libname)
Definition: iplib.cc:1279
int BOOLEAN
Definition: auxiliary.h:131
BOOLEAN load_modules(const char *newlib, char *fullname, BOOLEAN autoexport)
Definition: iplib.cc:1050
#define omStrDup(s)
Definition: omAllocDecl.h:263
const char* iiTwoOps ( int  t)

Definition at line 252 of file gentable.cc.

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

Definition at line 595 of file ipshell.cc.

596 {
597  sleftv vf;
598  if (iiConvert(v->Typ(),LINK_CMD,iiTestConvert(v->Typ(),LINK_CMD),v,&vf))
599  {
600  WerrorS("link expected");
601  return TRUE;
602  }
603  si_link l=(si_link)vf.Data();
604  if (vf.next == NULL)
605  {
606  WerrorS("write: need at least two arguments");
607  return TRUE;
608  }
609 
610  BOOLEAN b=slWrite(l,vf.next); /* iiConvert preserves next */
611  if (b)
612  {
613  const char *s;
614  if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
615  else s=sNoName;
616  Werror("cannot write to %s",s);
617  }
618  vf.CleanUp();
619  return b;
620 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
int iiTestConvert(int inputType, int outputType)
Definition: gentable.cc:292
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
const char sNoName[]
Definition: subexpr.cc:56
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
leftv next
Definition: subexpr.h:87
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
Definition: tok.h:95
#define NULL
Definition: omList.c:10
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:358
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
void * Data()
Definition: subexpr.cc:1111
int BOOLEAN
Definition: auxiliary.h:131
const poly b
Definition: syzextra.cc:213
void Werror(const char *fmt,...)
Definition: reporter.cc:199
int l
Definition: cfEzgcd.cc:94
int IsCmd ( const char *  n,
int &  tok 
)

Definition at line 8739 of file iparith.cc.

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

Definition at line 892 of file ipshell.cc.

893 {
894  sleftv tmp;
895  memset(&tmp,0,sizeof(tmp));
896  tmp.rtyp=INT_CMD;
897  tmp.data=(void *)1;
898  if ((u->Typ()==IDEAL_CMD)
899  || (u->Typ()==MODUL_CMD))
900  return jjBETTI2_ID(res,u,&tmp);
901  else
902  return jjBETTI2(res,u,&tmp);
903 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:85
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:926
void * data
Definition: subexpr.h:89
int rtyp
Definition: subexpr.h:92
BOOLEAN jjBETTI2_ID(leftv res, leftv u, leftv v)
Definition: ipshell.cc:905
BOOLEAN jjBETTI2 ( leftv  res,
leftv  u,
leftv  v 
)

Definition at line 926 of file ipshell.cc.

927 {
928  resolvente r;
929  int len;
930  int reg,typ0;
931  lists l=(lists)u->Data();
932 
933  intvec *weights=NULL;
934  int add_row_shift=0;
935  intvec *ww=(intvec *)atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
936  if (ww!=NULL)
937  {
938  weights=ivCopy(ww);
939  add_row_shift = ww->min_in();
940  (*weights) -= add_row_shift;
941  }
942  //Print("attr:%x\n",weights);
943 
944  r=liFindRes(l,&len,&typ0);
945  if (r==NULL) return TRUE;
946  res->data=(char *)syBetti(r,len,&reg,weights,(int)(long)v->Data());
947  omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
948  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
949  if (weights!=NULL) delete weights;
950  return FALSE;
951 }
sleftv * m
Definition: lists.h:45
void atSet(idhdl root, const char *name, void *data, int typ)
Definition: attrib.cc:156
Definition: tok.h:85
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:313
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * ivCopy(const intvec *o)
Definition: intvec.h:141
#define TRUE
Definition: auxiliary.h:144
void * ADDRESS
Definition: auxiliary.h:161
int min_in()
Definition: intvec.h:114
void * data
Definition: subexpr.h:89
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:16
Definition: tok.h:88
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:135
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
void * Data()
Definition: subexpr.cc:1111
ideal * resolvente
Definition: ideals.h:20
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:793
int l
Definition: cfEzgcd.cc:94
#define omStrDup(s)
Definition: omAllocDecl.h:263
BOOLEAN jjBETTI2_ID ( leftv  res,
leftv  u,
leftv  v 
)

Definition at line 905 of file ipshell.cc.

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

Definition at line 3211 of file ipshell.cc.

3212 {
3213  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3214  return (res->data==NULL);
3215 }
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition: clapsing.cc:1398
#define NULL
Definition: omList.c:10
void * Data()
Definition: subexpr.cc:1111
BOOLEAN jjIMPORTFROM ( leftv  res,
leftv  u,
leftv  v 
)

Definition at line 2174 of file ipassign.cc.

2175 {
2176  //Print("importfrom %s::%s ->.\n",v->Name(),u->Name() );
2177  assume(u->Typ()==PACKAGE_CMD);
2178  char *vn=(char *)v->Name();
2179  idhdl h=((package)(u->Data()))->idroot->get(vn /*v->Name()*/, myynest);
2180  if (h!=NULL)
2181  {
2182  //check for existence
2183  if (((package)(u->Data()))==basePack)
2184  {
2185  WarnS("source and destination packages are identical");
2186  return FALSE;
2187  }
2188  idhdl t=basePack->idroot->get(vn /*v->Name()*/, myynest);
2189  if (t!=NULL)
2190  {
2191  Warn("redefining `%s`",vn);
2192  killhdl(t);
2193  }
2194  sleftv tmp_expr;
2195  if (iiDeclCommand(&tmp_expr,v,myynest,DEF_CMD,&IDROOT)) return TRUE;
2196  sleftv h_expr;
2197  memset(&h_expr,0,sizeof(h_expr));
2198  h_expr.rtyp=IDHDL;
2199  h_expr.data=h;
2200  h_expr.name=vn;
2201  return iiAssign(&tmp_expr,&h_expr);
2202  }
2203  else
2204  {
2205  Werror("`%s` not found in `%s`",v->Name(), u->Name());
2206  return TRUE;
2207  }
2208  return FALSE;
2209 }
ip_package * package
Definition: structs.h:46
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define FALSE
Definition: auxiliary.h:140
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:144
#define WarnS
Definition: emacs.cc:81
int Typ()
Definition: subexpr.cc:969
const char * Name()
Definition: subexpr.h:121
Definition: idrec.h:34
#define IDHDL
Definition: tok.h:35
void * data
Definition: subexpr.h:89
int myynest
Definition: febase.cc:46
Definition: tok.h:58
const char * name
Definition: subexpr.h:88
#define assume(x)
Definition: mod2.h:405
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition: ipshell.cc:1119
#define NULL
Definition: omList.c:10
void killhdl(idhdl h, package proot)
Definition: ipid.cc:372
package basePack
Definition: ipid.cc:64
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1111
static Poly * h
Definition: janet.cc:978
void Werror(const char *fmt,...)
Definition: reporter.cc:199
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1782
#define Warn
Definition: emacs.cc:80
BOOLEAN jjLIST_PL ( leftv  res,
leftv  v 
)

Definition at line 7411 of file iparith.cc.

7412 {
7413  int sl=0;
7414  if (v!=NULL) sl = v->listLength();
7415  lists L;
7416  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7417  {
7418  int add_row_shift = 0;
7419  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7420  if (weights!=NULL) add_row_shift=weights->min_in();
7421  L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7422  }
7423  else
7424  {
7426  leftv h=NULL;
7427  int i;
7428  int rt;
7429 
7430  L->Init(sl);
7431  for (i=0;i<sl;i++)
7432  {
7433  if (h!=NULL)
7434  { /* e.g. not in the first step:
7435  * h is the pointer to the old sleftv,
7436  * v is the pointer to the next sleftv
7437  * (in this moment) */
7438  h->next=v;
7439  }
7440  h=v;
7441  v=v->next;
7442  h->next=NULL;
7443  rt=h->Typ();
7444  if (rt==0)
7445  {
7446  L->Clean();
7447  Werror("`%s` is undefined",h->Fullname());
7448  return TRUE;
7449  }
7450  if ((rt==RING_CMD)||(rt==QRING_CMD))
7451  {
7452  L->m[i].rtyp=rt; L->m[i].data=h->Data();
7453  ((ring)L->m[i].data)->ref++;
7454  }
7455  else
7456  L->m[i].Copy(h);
7457  }
7458  }
7459  res->data=(char *)L;
7460  return FALSE;
7461 }
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
lists syConvRes(syStrategy syzstr, BOOLEAN toDel, int add_row_shift)
Definition: ipshell.cc:3046
int listLength()
Definition: subexpr.cc:61
#define TRUE
Definition: auxiliary.h:144
int min_in()
Definition: intvec.h:114
int Typ()
Definition: subexpr.cc:969
const char * Fullname()
Definition: subexpr.h:126
void * data
Definition: subexpr.h:89
Definition: intvec.h:16
void Copy(leftv e)
Definition: subexpr.cc:657
int i
Definition: cfEzgcd.cc:123
Definition: tok.h:88
leftv next
Definition: subexpr.h:87
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:135
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
void Clean(ring r=currRing)
Definition: lists.h:25
void * Data()
Definition: subexpr.cc:1111
omBin slists_bin
Definition: lists.cc:23
Definition: tok.h:126
static Poly * h
Definition: janet.cc:978
void Werror(const char *fmt,...)
Definition: reporter.cc:199
BOOLEAN jjLOAD ( const char *  s,
BOOLEAN  autoexport = FALSE 
)

load lib/module given in v

Definition at line 5286 of file iparith.cc.

5287 {
5288  char libnamebuf[256];
5289  lib_types LT = type_of_LIB(s, libnamebuf);
5290 
5291 #ifdef HAVE_DYNAMIC_LOADING
5292  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5293 #endif /* HAVE_DYNAMIC_LOADING */
5294  switch(LT)
5295  {
5296  default:
5297  case LT_NONE:
5298  Werror("%s: unknown type", s);
5299  break;
5300  case LT_NOTFOUND:
5301  Werror("cannot open %s", s);
5302  break;
5303 
5304  case LT_SINGULAR:
5305  {
5306  char *plib = iiConvName(s);
5307  idhdl pl = IDROOT->get(plib,0);
5308  if (pl==NULL)
5309  {
5310  pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5311  IDPACKAGE(pl)->language = LANG_SINGULAR;
5312  IDPACKAGE(pl)->libname=omStrDup(plib);
5313  }
5314  else if (IDTYP(pl)!=PACKAGE_CMD)
5315  {
5316  Werror("can not create package `%s`",plib);
5317  omFree(plib);
5318  return TRUE;
5319  }
5320  package savepack=currPack;
5321  currPack=IDPACKAGE(pl);
5322  IDPACKAGE(pl)->loaded=TRUE;
5323  char libnamebuf[256];
5324  FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5325  BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5326  currPack=savepack;
5327  IDPACKAGE(pl)->loaded=(!bo);
5328  return bo;
5329  }
5330  case LT_BUILTIN:
5331  SModulFunc_t iiGetBuiltinModInit(const char*);
5332  return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5333  case LT_MACH_O:
5334  case LT_ELF:
5335  case LT_HPUX:
5336 #ifdef HAVE_DYNAMIC_LOADING
5337  return load_modules(s, libnamebuf, autoexport);
5338 #else /* HAVE_DYNAMIC_LOADING */
5339  WerrorS("Dynamic modules are not supported by this version of Singular");
5340  break;
5341 #endif /* HAVE_DYNAMIC_LOADING */
5342  }
5343  return TRUE;
5344 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
CanonicalForm fp
Definition: cfModGcd.cc:4043
Definition: mod_raw.h:16
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:144
lib_types type_of_LIB(const char *newlib, char *libnamebuf)
Definition: mod_lib.cc:24
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:138
#define IDTYP(a)
Definition: ipid.h:118
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:259
#define omFree(addr)
Definition: omAllocDecl.h:261
FILE * feFopen(const char *path, const char *mode, char *where, short useWerror, short path_only)
Definition: feFopen.cc:47
lib_types
Definition: mod_raw.h:16
BOOLEAN load_builtin(const char *newlib, BOOLEAN autoexport, SModulFunc_t init)
Definition: iplib.cc:1147
#define NULL
Definition: omList.c:10
SModulFunc_t iiGetBuiltinModInit(const char *libname)
Definition: iplib.cc:738
package basePack
Definition: ipid.cc:64
package currPack
Definition: ipid.cc:63
int(* SModulFunc_t)(SModulFunctions *)
Definition: ipid.h:84
char libnamebuf[128]
Definition: libparse.cc:1096
BOOLEAN iiLoadLIB(FILE *fp, const char *libnamebuf, const char *newlib, idhdl pl, BOOLEAN autoexport, BOOLEAN tellerror)
Definition: iplib.cc:902
char * iiConvName(const char *libname)
Definition: iplib.cc:1279
int BOOLEAN
Definition: auxiliary.h:131
BOOLEAN load_modules(const char *newlib, char *fullname, BOOLEAN autoexport)
Definition: iplib.cc:1050
void Werror(const char *fmt,...)
Definition: reporter.cc:199
#define omStrDup(s)
Definition: omAllocDecl.h:263
BOOLEAN jjLOAD_TRY ( const char *  s)

Definition at line 5350 of file iparith.cc.

5351 {
5352  void (*WerrorS_save)(const char *s) = WerrorS_callback;
5355  BOOLEAN bo=jjLOAD(s,TRUE);
5356  if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
5357  Print("loading of >%s< failed\n",s);
5358  WerrorS_callback=WerrorS_save;
5359  errorreported=0;
5360  return FALSE;
5361 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define Print
Definition: emacs.cc:83
#define TEST_OPT_PROT
Definition: options.h:98
static int WerrorS_dummy_cnt
Definition: iparith.cc:5345
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
BOOLEAN jjLOAD(const char *s, BOOLEAN autoexport)
load lib/module given in v
Definition: iparith.cc:5286
static void WerrorS_dummy(const char *)
Definition: iparith.cc:5346
void(* WerrorS_callback)(const char *s)
Definition: feFopen.cc:21
short errorreported
Definition: feFopen.cc:23
int BOOLEAN
Definition: auxiliary.h:131
BOOLEAN jjMINRES ( leftv  res,
leftv  v 
)

Definition at line 871 of file ipshell.cc.

872 {
873  int len=0;
874  int typ0;
875  lists L=(lists)v->Data();
876  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
877  int add_row_shift = 0;
878  if (weights==NULL)
879  weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
880  if (weights!=NULL) add_row_shift=weights->min_in();
881  resolvente rr=liFindRes(L,&len,&typ0);
882  if (rr==NULL) return TRUE;
883  resolvente r=iiCopyRes(rr,len);
884 
885  syMinimizeResolvente(r,len,0);
886  omFreeSize((ADDRESS)rr,len*sizeof(ideal));
887  len++;
888  res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
889  return FALSE;
890 }
sleftv * m
Definition: lists.h:45
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:313
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
void syMinimizeResolvente(resolvente res, int length, int first)
Definition: syz.cc:360
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define TRUE
Definition: auxiliary.h:144
void * ADDRESS
Definition: auxiliary.h:161
int min_in()
Definition: intvec.h:114
void * data
Definition: subexpr.h:89
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:16
static resolvente iiCopyRes(resolvente r, int l)
Definition: ipshell.cc:861
Definition: tok.h:88
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:135
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:216
void * Data()
Definition: subexpr.cc:1111
ideal * resolvente
Definition: ideals.h:20
BOOLEAN jjRESULTANT ( leftv  res,
leftv  u,
leftv  v,
leftv  w 
)

Definition at line 3204 of file ipshell.cc.

3205 {
3206  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3207  (poly)w->CopyD(), currRing);
3208  return errorreported;
3209 }
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition: clapsing.cc:317
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
short errorreported
Definition: feFopen.cc:23
polyrec * poly
Definition: hilb.h:10
void * CopyD(int t)
Definition: subexpr.cc:676
BOOLEAN jjSYSTEM ( leftv  res,
leftv  v 
)

Definition at line 245 of file extra.cc.

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

Definition at line 6188 of file ipshell.cc.

6189 {
6190  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6191  ideal I=(ideal)u->Data();
6192  int i;
6193  int n=0;
6194  for(i=I->nrows*I->ncols-1;i>=0;i--)
6195  {
6196  int n0=pGetVariables(I->m[i],e);
6197  if (n0>n) n=n0;
6198  }
6199  jjINT_S_TO_ID(n,e,res);
6200  return FALSE;
6201 }
#define FALSE
Definition: auxiliary.h:140
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:540
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6158
#define pGetVariables(p, e)
Definition: polys.h:222
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
int i
Definition: cfEzgcd.cc:123
void * Data()
Definition: subexpr.cc:1111
#define omAlloc0(size)
Definition: omAllocDecl.h:211
BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6180 of file ipshell.cc.

6181 {
6182  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6183  int n=pGetVariables((poly)u->Data(),e);
6184  jjINT_S_TO_ID(n,e,res);
6185  return FALSE;
6186 }
#define FALSE
Definition: auxiliary.h:140
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:540
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6158
#define pGetVariables(p, e)
Definition: polys.h:222
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void * Data()
Definition: subexpr.cc:1111
polyrec * poly
Definition: hilb.h:10
#define omAlloc0(size)
Definition: omAllocDecl.h:211
void killlocals ( int  v)

Definition at line 385 of file ipshell.cc.

386 {
387  BOOLEAN changed=FALSE;
388  idhdl sh=currRingHdl;
389  ring cr=currRing;
390  if (sh!=NULL) changed=((IDLEV(sh)<v) || (IDRING(sh)->ref>0));
391  //if (changed) Print("currRing=%s(%x), lev=%d,ref=%d\n",IDID(sh),IDRING(sh),IDLEV(sh),IDRING(sh)->ref);
392 
393  killlocals_rec(&(basePack->idroot),v,currRing);
394 
396  {
397  int t=iiRETURNEXPR.Typ();
398  if ((/*iiRETURNEXPR.Typ()*/ t==RING_CMD)
399  || (/*iiRETURNEXPR.Typ()*/ t==QRING_CMD))
400  {
402  if (((ring)h->data)->idroot!=NULL)
403  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
404  }
405  else if (/*iiRETURNEXPR.Typ()*/ t==LIST_CMD)
406  {
407  leftv h=&iiRETURNEXPR;
408  changed |=killlocals_list(v,(lists)h->data);
409  }
410  }
411  if (changed)
412  {
414  if (currRingHdl==NULL)
415  currRing=NULL;
416  else if(cr!=currRing)
417  rChangeCurrRing(cr);
418  }
419 
420  if (myynest<=1) iiNoKeepRing=TRUE;
421  //Print("end killlocals >= %d\n",v);
422  //listall();
423 }
int iiRETURNEXPR_len
Definition: iplib.cc:528
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
sleftv iiRETURNEXPR
Definition: iplib.cc:527
#define TRUE
Definition: auxiliary.h:144
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:328
int Typ()
Definition: subexpr.cc:969
Definition: idrec.h:34
void * data
Definition: subexpr.h:89
int myynest
Definition: febase.cc:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:365
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:88
idhdl currRingHdl
Definition: ipid.cc:65
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1573
#define IDLEV(a)
Definition: ipid.h:120
void rChangeCurrRing(ring r)
Definition: polys.cc:14
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
#define IDRING(a)
Definition: ipid.h:126
Definition: tok.h:96
Definition: tok.h:126
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:293
BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3187 of file ipshell.cc.

3188 {
3189  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3190  if (res->data==NULL)
3191  res->data=(char *)new intvec(rVar(currRing));
3192  return FALSE;
3193 }
#define FALSE
Definition: auxiliary.h:140
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:540
intvec * id_QHomWeight(ideal id, const ring r)
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
Definition: intvec.h:16
#define NULL
Definition: omList.c:10
void * Data()
Definition: subexpr.cc:1111
BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3165 of file ipshell.cc.

3166 {
3167  ideal F=(ideal)id->Data();
3168  intvec * iv = new intvec(rVar(currRing));
3169  polyset s;
3170  int sl, n, i;
3171  int *x;
3172 
3173  res->data=(char *)iv;
3174  s = F->m;
3175  sl = IDELEMS(F) - 1;
3176  n = rVar(currRing);
3177  double wNsqr = (double)2.0 / (double)n;
3179  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3180  wCall(s, sl, x, wNsqr, currRing);
3181  for (i = n; i!=0; i--)
3182  (*iv)[i-1] = x[i + n + 1];
3183  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3184  return FALSE;
3185 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define FALSE
Definition: auxiliary.h:140
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:540
void * ADDRESS
Definition: auxiliary.h:161
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
Definition: intvec.h:16
double(* wFunctional)(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight.cc:28
int i
Definition: cfEzgcd.cc:123
#define IDELEMS(i)
Definition: simpleideals.h:24
poly * polyset
Definition: hutil.h:17
void wCall(poly *s, int sl, int *x, double wNsqr, const ring R)
Definition: weight.cc:116
Variable x
Definition: cfModGcd.cc:4023
void * Data()
Definition: subexpr.cc:1111
double wFunctionalBuch(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight0.c:82
void list_cmd ( int  typ,
const char *  what,
const char *  prefix,
BOOLEAN  iterate,
BOOLEAN  fullname = FALSE 
)

Definition at line 425 of file ipshell.cc.

426 {
427  package savePack=currPack;
428  idhdl h,start;
429  BOOLEAN all = typ<0;
430  BOOLEAN really_all=FALSE;
431 
432  if ( typ==0 )
433  {
434  if (strcmp(what,"all")==0)
435  {
436  if (currPack!=basePack)
437  list_cmd(-1,NULL,prefix,iterate,fullname); // list current package
438  really_all=TRUE;
439  h=basePack->idroot;
440  }
441  else
442  {
443  h = ggetid(what);
444  if (h!=NULL)
445  {
446  if (iterate) list1(prefix,h,TRUE,fullname);
447  if (IDTYP(h)==ALIAS_CMD) PrintS("A");
448  if ((IDTYP(h)==RING_CMD)
449  || (IDTYP(h)==QRING_CMD)
450  //|| (IDTYP(h)==PACKE_CMD)
451  )
452  {
453  h=IDRING(h)->idroot;
454  }
455  else if(IDTYP(h)==PACKAGE_CMD)
456  {
457  currPack=IDPACKAGE(h);
458  //Print("list_cmd:package\n");
459  all=TRUE;typ=PROC_CMD;fullname=TRUE;really_all=TRUE;
460  h=IDPACKAGE(h)->idroot;
461  }
462  else
463  {
464  currPack=savePack;
465  return;
466  }
467  }
468  else
469  {
470  Werror("%s is undefined",what);
471  currPack=savePack;
472  return;
473  }
474  }
475  all=TRUE;
476  }
477  else if (RingDependend(typ))
478  {
479  h = currRing->idroot;
480  }
481  else
482  h = IDROOT;
483  start=h;
484  while (h!=NULL)
485  {
486  if ((all
487  && (IDTYP(h)!=PROC_CMD)
488  &&(IDTYP(h)!=PACKAGE_CMD)
489  #ifdef SINGULAR_4_1
490  &&(IDTYP(h)!=CRING_CMD)
491  #endif
492  )
493  || (typ == IDTYP(h))
494  #ifdef SINGULAR_4_1
495  || ((IDTYP(h)==CRING_CMD) && (typ==RING_CMD))
496  #else
497  || ((IDTYP(h)==QRING_CMD) && (typ==RING_CMD))
498  #endif
499  )
500  {
501  list1(prefix,h,start==currRingHdl, fullname);
502  if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
503  && (really_all || (all && (h==currRingHdl)))
504  && ((IDLEV(h)==0)||(IDLEV(h)==myynest)))
505  {
506  list_cmd(0,IDID(h),"// ",FALSE);
507  }
508  if (IDTYP(h)==PACKAGE_CMD && really_all)
509  {
510  package save_p=currPack;
511  currPack=IDPACKAGE(h);
512  list_cmd(0,IDID(h),"// ",FALSE);
513  currPack=save_p;
514  }
515  }
516  h = IDNEXT(h);
517  }
518  currPack=savePack;
519 }
#define IDID(a)
Definition: ipid.h:121
#define FALSE
Definition: auxiliary.h:140
#define IDNEXT(a)
Definition: ipid.h:117
#define IDROOT
Definition: ipid.h:20
#define TRUE
Definition: auxiliary.h:144
static void list1(const char *s, idhdl h, BOOLEAN c, BOOLEAN fullname)
Definition: ipshell.cc:153
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:138
int myynest
Definition: febase.cc:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define IDTYP(a)
Definition: ipid.h:118
Definition: tok.h:56
int RingDependend(int t)
Definition: gentable.cc:23
void list_cmd(int typ, const char *what, const char *prefix, BOOLEAN iterate, BOOLEAN fullname)
Definition: ipshell.cc:425
idhdl currRingHdl
Definition: ipid.cc:65
void PrintS(const char *s)
Definition: reporter.cc:294
#define IDLEV(a)
Definition: ipid.h:120
Definition: tok.h:38
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
#define IDRING(a)
Definition: ipid.h:126
package currPack
Definition: ipid.cc:63
Definition: tok.h:126
static Poly * h
Definition: janet.cc:978
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
idhdl ggetid(const char *n, BOOLEAN, idhdl *packhdl)
Definition: ipid.cc:490
BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4427 of file ipshell.cc.

4428 {
4429  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4430  return FALSE;
4431 }
#define FALSE
Definition: auxiliary.h:140
ideal loNewtonPolytope(const ideal id)
Definition: mpr_base.cc:3192
void * data
Definition: subexpr.h:89
void * Data()
Definition: subexpr.cc:1111
BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4433 of file ipshell.cc.

4434 {
4435  if ( !(rField_is_long_R(currRing)) )
4436  {
4437  WerrorS("Ground field not implemented!");
4438  return TRUE;
4439  }
4440 
4441  simplex * LP;
4442  matrix m;
4443 
4444  leftv v= args;
4445  if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4446  return TRUE;
4447  else
4448  m= (matrix)(v->CopyD());
4449 
4450  LP = new simplex(MATROWS(m),MATCOLS(m));
4451  LP->mapFromMatrix(m);
4452 
4453  v= v->next;
4454  if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4455  return TRUE;
4456  else
4457  LP->m= (int)(long)(v->Data());
4458 
4459  v= v->next;
4460  if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4461  return TRUE;
4462  else
4463  LP->n= (int)(long)(v->Data());
4464 
4465  v= v->next;
4466  if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4467  return TRUE;
4468  else
4469  LP->m1= (int)(long)(v->Data());
4470 
4471  v= v->next;
4472  if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4473  return TRUE;
4474  else
4475  LP->m2= (int)(long)(v->Data());
4476 
4477  v= v->next;
4478  if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4479  return TRUE;
4480  else
4481  LP->m3= (int)(long)(v->Data());
4482 
4483 #ifdef mprDEBUG_PROT
4484  Print("m (constraints) %d\n",LP->m);
4485  Print("n (columns) %d\n",LP->n);
4486  Print("m1 (<=) %d\n",LP->m1);
4487  Print("m2 (>=) %d\n",LP->m2);
4488  Print("m3 (==) %d\n",LP->m3);
4489 #endif
4490 
4491  LP->compute();
4492 
4493  lists lres= (lists)omAlloc( sizeof(slists) );
4494  lres->Init( 6 );
4495 
4496  lres->m[0].rtyp= MATRIX_CMD; // output matrix
4497  lres->m[0].data=(void*)LP->mapToMatrix(m);
4498 
4499  lres->m[1].rtyp= INT_CMD; // found a solution?
4500  lres->m[1].data=(void*)(long)LP->icase;
4501 
4502  lres->m[2].rtyp= INTVEC_CMD;
4503  lres->m[2].data=(void*)LP->posvToIV();
4504 
4505  lres->m[3].rtyp= INTVEC_CMD;
4506  lres->m[3].data=(void*)LP->zrovToIV();
4507 
4508  lres->m[4].rtyp= INT_CMD;
4509  lres->m[4].data=(void*)(long)LP->m;
4510 
4511  lres->m[5].rtyp= INT_CMD;
4512  lres->m[5].data=(void*)(long)LP->n;
4513 
4514  res->data= (void*)lres;
4515 
4516  return FALSE;
4517 }
sleftv * m
Definition: lists.h:45
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
matrix mapToMatrix(matrix m)
void compute()
#define Print
Definition: emacs.cc:83
Definition: tok.h:85
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
Linear Programming / Linear Optimization using Simplex - Algorithm.
Definition: mpr_numeric.h:194
#define TRUE
Definition: auxiliary.h:144
intvec * zrovToIV()
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:969
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
intvec * posvToIV()
BOOLEAN mapFromMatrix(matrix m)
ip_smatrix * matrix
int m
Definition: cfEzgcd.cc:119
Definition: tok.h:88
leftv next
Definition: subexpr.h:87
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define MATCOLS(i)
Definition: matpol.h:28
slists * lists
Definition: mpr_numeric.h:146
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:491
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1111
#define MATROWS(i)
Definition: matpol.h:27
int icase
Definition: mpr_numeric.h:201
void * CopyD(int t)
Definition: subexpr.cc:676
BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 2934 of file ipshell.cc.

2935 {
2936  int i,j;
2937  matrix result;
2938  ideal id=(ideal)a->Data();
2939 
2940  result =mpNew(IDELEMS(id),rVar(currRing));
2941  for (i=1; i<=IDELEMS(id); i++)
2942  {
2943  for (j=1; j<=rVar(currRing); j++)
2944  {
2945  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
2946  }
2947  }
2948  res->data=(char *)result;
2949  return FALSE;
2950 }
#define FALSE
Definition: auxiliary.h:140
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:540
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
int j
Definition: myNF.cc:70
int i
Definition: cfEzgcd.cc:123
#define IDELEMS(i)
Definition: simpleideals.h:24
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:48
void * Data()
Definition: subexpr.cc:1111
#define pDiff(a, b)
Definition: polys.h:267
return result
Definition: facAbsBiFact.cc:76
#define MATELEM(mat, i, j)
Definition: matpol.h:29
BOOLEAN mpKoszul ( leftv  res,
leftv  c,
leftv  b,
leftv  id 
)

Definition at line 2956 of file ipshell.cc.

2957 {
2958  int n=(int)(long)b->Data();
2959  int d=(int)(long)c->Data();
2960  int k,l,sign,row,col;
2961  matrix result;
2962  ideal temp;
2963  BOOLEAN bo;
2964  poly p;
2965 
2966  if ((d>n) || (d<1) || (n<1))
2967  {
2968  res->data=(char *)mpNew(1,1);
2969  return FALSE;
2970  }
2971  int *choise = (int*)omAlloc(d*sizeof(int));
2972  if (id==NULL)
2973  temp=idMaxIdeal(1);
2974  else
2975  temp=(ideal)id->Data();
2976 
2977  k = binom(n,d);
2978  l = k*d;
2979  l /= n-d+1;
2980  result =mpNew(l,k);
2981  col = 1;
2982  idInitChoise(d,1,n,&bo,choise);
2983  while (!bo)
2984  {
2985  sign = 1;
2986  for (l=1;l<=d;l++)
2987  {
2988  if (choise[l-1]<=IDELEMS(temp))
2989  {
2990  p = pCopy(temp->m[choise[l-1]-1]);
2991  if (sign == -1) p = pNeg(p);
2992  sign *= -1;
2993  row = idGetNumberOfChoise(l-1,d,1,n,choise);
2994  MATELEM(result,row,col) = p;
2995  }
2996  }
2997  col++;
2998  idGetNextChoise(d,n,&bo,choise);
2999  }
3000  if (id==NULL) idDelete(&temp);
3001 
3002  res->data=(char *)result;
3003  return FALSE;
3004 }
#define idMaxIdeal(D)
initialise the maximal ideal (at 0)
Definition: ideals.h:35
#define idDelete(H)
delete an ideal
Definition: ideals.h:31
#define FALSE
Definition: auxiliary.h:140
return P p
Definition: myNF.cc:203
#define pNeg(p)
Definition: polys.h:169
int k
Definition: cfEzgcd.cc:93
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:89
void idGetNextChoise(int r, int end, BOOLEAN *endch, int *choise)
#define IDELEMS(i)
Definition: simpleideals.h:24
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:48
#define NULL
Definition: omList.c:10
void idInitChoise(int r, int beg, int end, BOOLEAN *endch, int *choise)
void * Data()
Definition: subexpr.cc:1111
int idGetNumberOfChoise(int t, int d, int begin, int end, int *choise)
polyrec * poly
Definition: hilb.h:10
int BOOLEAN
Definition: auxiliary.h:131
int binom(int n, int r)
return result
Definition: facAbsBiFact.cc:76
int l
Definition: cfEzgcd.cc:94
int sign(const CanonicalForm &a)
#define pCopy(p)
return a copy of the poly
Definition: polys.h:156
#define MATELEM(mat, i, j)
Definition: matpol.h:29
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 4542 of file ipshell.cc.

4543 {
4544 
4545  poly gls;
4546  gls= (poly)(arg1->Data());
4547  int howclean= (int)(long)arg3->Data();
4548 
4549  if ( !(rField_is_R(currRing) ||
4550  rField_is_Q(currRing) ||
4553  {
4554  WerrorS("Ground field not implemented!");
4555  return TRUE;
4556  }
4557 
4560  {
4561  unsigned long int ii = (unsigned long int)arg2->Data();
4562  setGMPFloatDigits( ii, ii );
4563  }
4564 
4565  if ( gls == NULL || pIsConstant( gls ) )
4566  {
4567  WerrorS("Input polynomial is constant!");
4568  return TRUE;
4569  }
4570 
4571  int ldummy;
4572  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4573  // int deg= pDeg( gls );
4574  // int len= pLength( gls );
4575  int i,vpos=0;
4576  poly piter;
4577  lists elist;
4578  lists rlist;
4579 
4580  elist= (lists)omAlloc( sizeof(slists) );
4581  elist->Init( 0 );
4582 
4583  if ( rVar(currRing) > 1 )
4584  {
4585  piter= gls;
4586  for ( i= 1; i <= rVar(currRing); i++ )
4587  if ( pGetExp( piter, i ) )
4588  {
4589  vpos= i;
4590  break;
4591  }
4592  while ( piter )
4593  {
4594  for ( i= 1; i <= rVar(currRing); i++ )
4595  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4596  {
4597  WerrorS("The input polynomial must be univariate!");
4598  return TRUE;
4599  }
4600  pIter( piter );
4601  }
4602  }
4603 
4604  rootContainer * roots= new rootContainer();
4605  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4606  piter= gls;
4607  for ( i= deg; i >= 0; i-- )
4608  {
4609  //if ( piter ) Print("deg %d, pDeg(piter) %d\n",i,pTotaldegree(piter));
4610  if ( piter && pTotaldegree(piter) == i )
4611  {
4612  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4613  //nPrint( pcoeffs[i] );PrintS(" ");
4614  pIter( piter );
4615  }
4616  else
4617  {
4618  pcoeffs[i]= nInit(0);
4619  }
4620  }
4621 
4622 #ifdef mprDEBUG_PROT
4623  for (i=deg; i >= 0; i--)
4624  {
4625  nPrint( pcoeffs[i] );PrintS(" ");
4626  }
4627  PrintLn();
4628 #endif
4629 
4630  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4631  roots->solver( howclean );
4632 
4633  int elem= roots->getAnzRoots();
4634  char *dummy;
4635  int j;
4636 
4637  rlist= (lists)omAlloc( sizeof(slists) );
4638  rlist->Init( elem );
4639 
4641  {
4642  for ( j= 0; j < elem; j++ )
4643  {
4644  rlist->m[j].rtyp=NUMBER_CMD;
4645  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4646  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4647  }
4648  }
4649  else
4650  {
4651  for ( j= 0; j < elem; j++ )
4652  {
4653  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4654  rlist->m[j].rtyp=STRING_CMD;
4655  rlist->m[j].data=(void *)dummy;
4656  }
4657  }
4658 
4659  elist->Clean();
4660  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4661 
4662  // this is (via fillContainer) the same data as in root
4663  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4664  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4665 
4666  delete roots;
4667 
4668  res->rtyp= LIST_CMD;
4669  res->data= (void*)rlist;
4670 
4671  return FALSE;
4672 }
complex root finder for univariate polynomials based on laguers algorithm
Definition: mpr_numeric.h:65
sleftv * m
Definition: lists.h:45
void PrintLn()
Definition: reporter.cc:327
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:467
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:540
#define TRUE
Definition: auxiliary.h:144
bool solver(const int polishmode=PM_NONE)
Definition: mpr_numeric.cc:450
void WerrorS(const char *s)
Definition: feFopen.cc:24
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy ...
Definition: monomials.h:51
#define omAlloc(size)
Definition: omAllocDecl.h:210
#define nPrint(a)
only for debug, over any initalized currRing
Definition: numbers.h:46
void * data
Definition: subexpr.h:89
#define pIter(p)
Definition: monomials.h:44
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
int j
Definition: myNF.cc:70
static long pTotaldegree(poly p)
Definition: polys.h:253
#define pIsConstant(p)
like above, except that Comp might be != 0
Definition: polys.h:209
void fillContainer(number *_coeffs, number *_ievpoint, const int _var, const int _tdg, const rootType _rt, const int _anz)
Definition: mpr_numeric.cc:313
int i
Definition: cfEzgcd.cc:123
void PrintS(const char *s)
Definition: reporter.cc:294
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:461
gmp_complex * getRoot(const int i)
Definition: mpr_numeric.h:88
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:494
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int getAnzRoots()
Definition: mpr_numeric.h:97
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:491
int rtyp
Definition: subexpr.h:92
#define nCopy(n)
Definition: numbers.h:15
void Clean(ring r=currRing)
Definition: lists.h:25
void * Data()
Definition: subexpr.cc:1111
Definition: tok.h:96
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition: mpr_complex.cc:717
size_t gmp_output_digits
Definition: mpr_complex.cc:44
void setGMPFloatDigits(size_t digits, size_t rest)
Set size of mantissa digits - the number of output digits (basis 10) the size of mantissa consists of...
Definition: mpr_complex.cc:62
polyrec * poly
Definition: hilb.h:10
#define nInit(i)
Definition: numbers.h:24
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 4519 of file ipshell.cc.

4520 {
4521  ideal gls = (ideal)(arg1->Data());
4522  int imtype= (int)(long)arg2->Data();
4523 
4524  uResultant::resMatType mtype= determineMType( imtype );
4525 
4526  // check input ideal ( = polynomial system )
4527  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4528  {
4529  return TRUE;
4530  }
4531 
4532  uResultant *resMat= new uResultant( gls, mtype, false );
4533  if (resMat!=NULL)
4534  {
4535  res->rtyp = MODUL_CMD;
4536  res->data= (void*)resMat->accessResMat()->getMatrix();
4537  if (!errorreported) delete resMat;
4538  }
4539  return errorreported;
4540 }
Base class for solving 0-dim poly systems using u-resultant.
Definition: mpr_base.h:62
resMatrixBase * accessResMat()
Definition: mpr_base.h:78
#define TRUE
Definition: auxiliary.h:144
uResultant::resMatType determineMType(int imtype)
const char * Name()
Definition: subexpr.h:121
Definition: mpr_base.h:98
void * data
Definition: subexpr.h:89
virtual ideal getMatrix()
Definition: mpr_base.h:31
mprState mprIdealCheck(const ideal theIdeal, const char *name, uResultant::resMatType mtype, BOOLEAN rmatrix=false)
short errorreported
Definition: feFopen.cc:23
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1111
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 4775 of file ipshell.cc.

4776 {
4777  leftv v= args;
4778 
4779  ideal gls;
4780  int imtype;
4781  int howclean;
4782 
4783  // get ideal
4784  if ( v->Typ() != IDEAL_CMD )
4785  return TRUE;
4786  else gls= (ideal)(v->Data());
4787  v= v->next;
4788 
4789  // get resultant matrix type to use (0,1)
4790  if ( v->Typ() != INT_CMD )
4791  return TRUE;
4792  else imtype= (int)(long)v->Data();
4793  v= v->next;
4794 
4795  if (imtype==0)
4796  {
4797  ideal test_id=idInit(1,1);
4798  int j;
4799  for(j=IDELEMS(gls)-1;j>=0;j--)
4800  {
4801  if (gls->m[j]!=NULL)
4802  {
4803  test_id->m[0]=gls->m[j];
4804  intvec *dummy_w=id_QHomWeight(test_id, currRing);
4805  if (dummy_w!=NULL)
4806  {
4807  WerrorS("Newton polytope not of expected dimension");
4808  delete dummy_w;
4809  return TRUE;
4810  }
4811  }
4812  }
4813  }
4814 
4815  // get and set precision in digits ( > 0 )
4816  if ( v->Typ() != INT_CMD )
4817  return TRUE;
4818  else if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
4820  {
4821  unsigned long int ii=(unsigned long int)v->Data();
4822  setGMPFloatDigits( ii, ii );
4823  }
4824  v= v->next;
4825 
4826  // get interpolation steps (0,1,2)
4827  if ( v->Typ() != INT_CMD )
4828  return TRUE;
4829  else howclean= (int)(long)v->Data();
4830 
4831  uResultant::resMatType mtype= determineMType( imtype );
4832  int i,count;
4833  lists listofroots= NULL;
4834  number smv= NULL;
4835  BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;
4836 
4837  //emptylist= (lists)omAlloc( sizeof(slists) );
4838  //emptylist->Init( 0 );
4839 
4840  //res->rtyp = LIST_CMD;
4841  //res->data= (void *)emptylist;
4842 
4843  // check input ideal ( = polynomial system )
4844  if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
4845  {
4846  return TRUE;
4847  }
4848 
4849  uResultant * ures;
4850  rootContainer ** iproots;
4851  rootContainer ** muiproots;
4852  rootArranger * arranger;
4853 
4854  // main task 1: setup of resultant matrix
4855  ures= new uResultant( gls, mtype );
4856  if ( ures->accessResMat()->initState() != resMatrixBase::ready )
4857  {
4858  WerrorS("Error occurred during matrix setup!");
4859  return TRUE;
4860  }
4861 
4862  // if dense resultant, check if minor nonsingular
4863  if ( mtype == uResultant::denseResMat )
4864  {
4865  smv= ures->accessResMat()->getSubDet();
4866 #ifdef mprDEBUG_PROT
4867  PrintS("// Determinant of submatrix: ");nPrint(smv);PrintLn();
4868 #endif
4869  if ( nIsZero(smv) )
4870  {
4871  WerrorS("Unsuitable input ideal: Minor of resultant matrix is singular!");
4872  return TRUE;
4873  }
4874  }
4875 
4876  // main task 2: Interpolate specialized resultant polynomials
4877  if ( interpolate_det )
4878  iproots= ures->interpolateDenseSP( false, smv );
4879  else
4880  iproots= ures->specializeInU( false, smv );
4881 
4882  // main task 3: Interpolate specialized resultant polynomials
4883  if ( interpolate_det )
4884  muiproots= ures->interpolateDenseSP( true, smv );
4885  else
4886  muiproots= ures->specializeInU( true, smv );
4887 
4888 #ifdef mprDEBUG_PROT
4889  int c= iproots[0]->getAnzElems();
4890  for (i=0; i < c; i++) pWrite(iproots[i]->getPoly());
4891  c= muiproots[0]->getAnzElems();
4892  for (i=0; i < c; i++) pWrite(muiproots[i]->getPoly());
4893 #endif
4894 
4895  // main task 4: Compute roots of specialized polys and match them up
4896  arranger= new rootArranger( iproots, muiproots, howclean );
4897  arranger->solve_all();
4898 
4899  // get list of roots
4900  if ( arranger->success() )
4901  {
4902  arranger->arrange();
4903  listofroots= listOfRoots(arranger, gmp_output_digits );
4904  }
4905  else
4906  {
4907  WerrorS("Solver was unable to find any roots!");
4908  return TRUE;
4909  }
4910 
4911  // free everything
4912  count= iproots[0]->getAnzElems();
4913  for (i=0; i < count; i++) delete iproots[i];
4914  omFreeSize( (ADDRESS) iproots, count * sizeof(rootContainer*) );
4915  count= muiproots[0]->getAnzElems();
4916  for (i=0; i < count; i++) delete muiproots[i];
4917  omFreeSize( (ADDRESS) muiproots, count * sizeof(rootContainer*) );
4918 
4919  delete ures;
4920  delete arranger;
4921  nDelete( &smv );
4922 
4923  res->data= (void *)listofroots;
4924 
4925  //emptylist->Clean();
4926  // omFreeSize( (ADDRESS) emptylist, sizeof(slists) );
4927 
4928  return FALSE;
4929 }
int status int void size_t count
Definition: si_signals.h:59
complex root finder for univariate polynomials based on laguers algorithm
Definition: mpr_numeric.h:65
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
void PrintLn()
Definition: reporter.cc:327
Base class for solving 0-dim poly systems using u-resultant.
Definition: mpr_base.h:62
Definition: tok.h:85
Definition: lists.h:22
virtual IStateType initState() const
Definition: mpr_base.h:41
#define FALSE
Definition: auxiliary.h:140
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:467
resMatrixBase * accessResMat()
Definition: mpr_base.h:78
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * id_QHomWeight(ideal id, const ring r)
#define TRUE
Definition: auxiliary.h:144
uResultant::resMatType determineMType(int imtype)
void * ADDRESS
Definition: auxiliary.h:161
void pWrite(poly p)
Definition: polys.h:279
void WerrorS(const char *s)
Definition: feFopen.cc:24
int getAnzElems()
Definition: mpr_numeric.h:95
rootContainer ** specializeInU(BOOLEAN matchUp=false, const number subDetVal=NULL)
Definition: mpr_base.cc:3060
int Typ()
Definition: subexpr.cc:969
const char * Name()
Definition: subexpr.h:121
Definition: mpr_base.h:98
#define nPrint(a)
only for debug, over any initalized currRing
Definition: numbers.h:46
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
Definition: intvec.h:16
int j
Definition: myNF.cc:70
bool success()
Definition: mpr_numeric.h:162
void arrange()
Definition: mpr_numeric.cc:896
int i
Definition: cfEzgcd.cc:123
void PrintS(const char *s)
Definition: reporter.cc:294
void solve_all()
Definition: mpr_numeric.cc:871
#define IDELEMS(i)
Definition: simpleideals.h:24
mprState mprIdealCheck(const ideal theIdeal, const char *name, uResultant::resMatType mtype, BOOLEAN rmatrix=false)
rootContainer ** interpolateDenseSP(BOOLEAN matchUp=false, const number subDetVal=NULL)
Definition: mpr_base.cc:2922
#define nDelete(n)
Definition: numbers.h:16
leftv next
Definition: subexpr.h:87
static BOOLEAN rField_is_long_C(const ring r)
Definition: ring.h:494
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
#define nIsZero(n)
Definition: numbers.h:19
#define NULL
Definition: omList.c:10
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:491
void * Data()
Definition: subexpr.cc:1111
size_t gmp_output_digits
Definition: mpr_complex.cc:44
void setGMPFloatDigits(size_t digits, size_t rest)
Set size of mantissa digits - the number of output digits (basis 10) the size of mantissa consists of...
Definition: mpr_complex.cc:62
int BOOLEAN
Definition: auxiliary.h:131
lists listOfRoots(rootArranger *self, const unsigned int oprec)
Definition: ipshell.cc:4932
virtual number getSubDet()
Definition: mpr_base.h:37
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 4674 of file ipshell.cc.

4675 {
4676  int i;
4677  ideal p,w;
4678  p= (ideal)arg1->Data();
4679  w= (ideal)arg2->Data();
4680 
4681  // w[0] = f(p^0)
4682  // w[1] = f(p^1)
4683  // ...
4684  // p can be a vector of numbers (multivariate polynom)
4685  // or one number (univariate polynom)
4686  // tdg = deg(f)
4687 
4688  int n= IDELEMS( p );
4689  int m= IDELEMS( w );
4690  int tdg= (int)(long)arg3->Data();
4691 
4692  res->data= (void*)NULL;
4693 
4694  // check the input
4695  if ( tdg < 1 )
4696  {
4697  WerrorS("Last input parameter must be > 0!");
4698  return TRUE;
4699  }
4700  if ( n != rVar(currRing) )
4701  {
4702  Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
4703  return TRUE;
4704  }
4705  if ( m != (int)pow((double)tdg+1,(double)n) )
4706  {
4707  Werror("Size of second input ideal must be equal to %d!",
4708  (int)pow((double)tdg+1,(double)n));
4709  return TRUE;
4710  }
4711  if ( !(rField_is_Q(currRing) /* ||
4712  rField_is_R() || rField_is_long_R() ||
4713  rField_is_long_C()*/ ) )
4714  {
4715  WerrorS("Ground field not implemented!");
4716  return TRUE;
4717  }
4718 
4719  number tmp;
4720  number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
4721  for ( i= 0; i < n; i++ )
4722  {
4723  pevpoint[i]=nInit(0);
4724  if ( (p->m)[i] )
4725  {
4726  tmp = pGetCoeff( (p->m)[i] );
4727  if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
4728  {
4729  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4730  WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
4731  return TRUE;
4732  }
4733  } else tmp= NULL;
4734  if ( !nIsZero(tmp) )
4735  {
4736  if ( !pIsConstant((p->m)[i]))
4737  {
4738  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4739  WerrorS("Elements of first input ideal must be numbers!");
4740  return TRUE;
4741  }
4742  pevpoint[i]= nCopy( tmp );
4743  }
4744  }
4745 
4746  number *wresults= (number *)omAlloc( m * sizeof( number ) );
4747  for ( i= 0; i < m; i++ )
4748  {
4749  wresults[i]= nInit(0);
4750  if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
4751  {
4752  if ( !pIsConstant((w->m)[i]))
4753  {
4754  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4755  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4756  WerrorS("Elements of second input ideal must be numbers!");
4757  return TRUE;
4758  }
4759  wresults[i]= nCopy(pGetCoeff((w->m)[i]));
4760  }
4761  }
4762 
4763  vandermonde vm( m, n, tdg, pevpoint, FALSE );
4764  number *ncpoly= vm.interpolateDense( wresults );
4765  // do not free ncpoly[]!!
4766  poly rpoly= vm.numvec2poly( ncpoly );
4767 
4768  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4769  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4770 
4771  res->data= (void*)rpoly;
4772  return FALSE;
4773 }
vandermonde system solver for interpolating polynomials from their values
Definition: mpr_numeric.h:28
#define FALSE
Definition: auxiliary.h:140
return P p
Definition: myNF.cc:203
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:540
#define TRUE
Definition: auxiliary.h:144
#define nIsOne(n)
Definition: numbers.h:25
void * ADDRESS
Definition: auxiliary.h:161
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define nIsMOne(n)
Definition: numbers.h:26
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy ...
Definition: monomials.h:51
#define omAlloc(size)
Definition: omAllocDecl.h:210
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
int m
Definition: cfEzgcd.cc:119
#define pIsConstant(p)
like above, except that Comp might be != 0
Definition: polys.h:209
int i
Definition: cfEzgcd.cc:123
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:461
#define IDELEMS(i)
Definition: simpleideals.h:24
#define nIsZero(n)
Definition: numbers.h:19
#define NULL
Definition: omList.c:10
const CanonicalForm & w
Definition: facAbsFact.cc:55
#define nCopy(n)
Definition: numbers.h:15
void * Data()
Definition: subexpr.cc:1111
polyrec * poly
Definition: hilb.h:10
#define nInit(i)
Definition: numbers.h:24
Rational pow(const Rational &a, int e)
Definition: GMPrat.cc:418
void Werror(const char *fmt,...)
Definition: reporter.cc:199
void paPrint ( const char *  n,
package  p 
)

Definition at line 6203 of file ipshell.cc.

6204 {
6205  Print(" %s (",n);
6206  switch (p->language)
6207  {
6208  case LANG_SINGULAR: PrintS("S"); break;
6209  case LANG_C: PrintS("C"); break;
6210  case LANG_TOP: PrintS("T"); break;
6211  case LANG_NONE: PrintS("N"); break;
6212  default: PrintS("U");
6213  }
6214  if(p->libname!=NULL)
6215  Print(",%s", p->libname);
6216  PrintS(")");
6217 }
#define Print
Definition: emacs.cc:83
return P p
Definition: myNF.cc:203
Definition: subexpr.h:20
void PrintS(const char *s)
Definition: reporter.cc:294
#define NULL
Definition: omList.c:10
BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1821 of file ipshell.cc.

1822 {
1823  assume( C != NULL );
1824 
1825  // sanity check: require currRing==r for rings with polynomial data
1826  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1827  {
1828  WerrorS("ring with polynomial data must be the base ring or compatible");
1829  return TRUE;
1830  }
1831  if (nCoeff_is_numeric(C))
1832  {
1833  rDecomposeC(res,C);
1834  }
1835 #ifdef HAVE_RINGS
1836  else if (nCoeff_is_Ring(C))
1837  {
1838  rDecomposeRing(res,C);
1839  }
1840 #endif
1841  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1842  {
1843  rDecomposeCF(res, C->extRing, currRing);
1844  }
1845  else if(nCoeff_is_GF(C))
1846  {
1848  Lc->Init(4);
1849  // char:
1850  Lc->m[0].rtyp=INT_CMD;
1851  Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1852  // var:
1854  Lv->Init(1);
1855  Lv->m[0].rtyp=STRING_CMD;
1856  Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1857  Lc->m[1].rtyp=LIST_CMD;
1858  Lc->m[1].data=(void*)Lv;
1859  // ord:
1861  Lo->Init(1);
1863  Loo->Init(2);
1864  Loo->m[0].rtyp=STRING_CMD;
1865  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1866 
1867  intvec *iv=new intvec(1); (*iv)[0]=1;
1868  Loo->m[1].rtyp=INTVEC_CMD;
1869  Loo->m[1].data=(void *)iv;
1870 
1871  Lo->m[0].rtyp=LIST_CMD;
1872  Lo->m[0].data=(void*)Loo;
1873 
1874  Lc->m[2].rtyp=LIST_CMD;
1875  Lc->m[2].data=(void*)Lo;
1876  // q-ideal:
1877  Lc->m[3].rtyp=IDEAL_CMD;
1878  Lc->m[3].data=(void *)idInit(1,1);
1879  // ----------------------
1880  res->rtyp=LIST_CMD;
1881  res->data=(void*)Lc;
1882  }
1883  else
1884  {
1885  res->rtyp=INT_CMD;
1886  res->data=(void *)(long)C->ch;
1887  }
1888  // ----------------------------------------
1889  return FALSE;
1890 }
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:796
sleftv * m
Definition: lists.h:45
static FORCE_INLINE BOOLEAN nCoeff_is_numeric(const coeffs r)
Definition: coeffs.h:830
Definition: tok.h:85
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
CanonicalForm Lc(const CanonicalForm &f)
static FORCE_INLINE BOOLEAN nCoeff_is_Ring(const coeffs r)
Definition: coeffs.h:753
void * data
Definition: subexpr.h:89
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1599
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:911
Definition: intvec.h:16
void rDecomposeRing(leftv h, const coeffs C)
Definition: ipshell.cc:1761
#define assume(x)
Definition: mod2.h:405
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:88
Definition: tok.h:88
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition: coeffs.h:837
INLINE_THIS void Init(int l=0)
Definition: lists.h:66
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:38
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
int rtyp
Definition: subexpr.h:92
Definition: tok.h:96
omBin slists_bin
Definition: lists.cc:23
static void rDecomposeC(leftv h, const coeffs C)
Definition: ipshell.cc:1688
#define omStrDup(s)
Definition: omAllocDecl.h:263
idhdl rDefault ( const char *  s)

Definition at line 1528 of file ipshell.cc.

1529 {
1530  idhdl tmp=NULL;
1531 
1532  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
1533  if (tmp==NULL) return NULL;
1534 
1535 // if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
1537  {
1539  memset(&sLastPrinted,0,sizeof(sleftv));
1540  }
1541 
1542  ring r = IDRING(tmp);
1543 
1544  r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1545  r->N = 3;
1546  /*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
1547  /*names*/
1548  r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
1549  r->names[0] = omStrDup("x");
1550  r->names[1] = omStrDup("y");
1551  r->names[2] = omStrDup("z");
1552  /*weights: entries for 3 blocks: NULL*/
1553  r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1554  /*order: dp,C,0*/
1555  r->order = (int *) omAlloc(3 * sizeof(int *));
1556  r->block0 = (int *)omAlloc0(3 * sizeof(int *));
1557  r->block1 = (int *)omAlloc0(3 * sizeof(int *));
1558  /* ringorder dp for the first block: var 1..3 */
1559  r->order[0] = ringorder_dp;
1560  r->block0[0] = 1;
1561  r->block1[0] = 3;
1562  /* ringorder C for the second block: no vars */
1563  r->order[1] = ringorder_C;
1564  /* the last block: everything is 0 */
1565  r->order[2] = 0;
1566 
1567  /* complete ring intializations */
1568  rComplete(r);
1569  rSetHdl(tmp);
1570  return currRingHdl;
1571 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
{p < 2^31}
Definition: coeffs.h:30
#define IDROOT
Definition: ipid.h:20
#define omAlloc(size)
Definition: omAllocDecl.h:210
Definition: idrec.h:34
int myynest
Definition: febase.cc:46
char * char_ptr
Definition: structs.h:56
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:259
const ring r
Definition: syzextra.cc:208
BOOLEAN RingDependend()
Definition: subexpr.cc:389
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:3436
idhdl currRingHdl
Definition: ipid.cc:65
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:126
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
void rSetHdl(idhdl h)
Definition: ipshell.cc:4979
int * int_ptr
Definition: structs.h:57
#define omAlloc0(size)
Definition: omAllocDecl.h:211
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:327
#define omStrDup(s)
Definition: omAllocDecl.h:263
idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1573 of file ipshell.cc.

1574 {
1576  if (h!=NULL) return h;
1577  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1578  if (h!=NULL) return h;
1580  while(p!=NULL)
1581  {
1582  if ((p->cPack!=basePack)
1583  && (p->cPack!=currPack))
1584  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1585  if (h!=NULL) return h;
1586  p=p->next;
1587  }
1588  idhdl tmp=basePack->idroot;
1589  while (tmp!=NULL)
1590  {
1591  if (IDTYP(tmp)==PACKAGE_CMD)
1592  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1593  if (h!=NULL) return h;
1594  tmp=IDNEXT(tmp);
1595  }
1596  return NULL;
1597 }
idhdl rSimpleFindHdl(ring r, idhdl root, idhdl n)
Definition: ipshell.cc:6087
return P p
Definition: myNF.cc:203
#define IDNEXT(a)
Definition: ipid.h:117
proclevel * procstack
Definition: ipid.cc:58
#define IDROOT
Definition: ipid.h:20
Definition: idrec.h:34
#define IDPACKAGE(a)
Definition: ipid.h:138
#define IDTYP(a)
Definition: ipid.h:118
const ring r
Definition: syzextra.cc:208
Definition: ipid.h:56
proclevel * next
Definition: ipid.h:59
#define NULL
Definition: omList.c:10
package basePack
Definition: ipid.cc:64
package currPack
Definition: ipid.cc:63
static Poly * h
Definition: janet.cc:978
package cPack
Definition: ipid.h:63
ring rInit ( sleftv pn,
sleftv rv,
sleftv ord 
)

Definition at line 5461 of file ipshell.cc.

5462 {
5463 #ifdef HAVE_RINGS
5464  //unsigned int ringtype = 0;
5465  mpz_ptr modBase = NULL;
5466  unsigned int modExponent = 1;
5467 #endif
5468  int float_len=0;
5469  int float_len2=0;
5470  ring R = NULL;
5471  //BOOLEAN ffChar=FALSE;
5472 
5473  /* ch -------------------------------------------------------*/
5474  // get ch of ground field
5475 
5476  // allocated ring
5477  R = (ring) omAlloc0Bin(sip_sring_bin);
5478 
5479  coeffs cf = NULL;
5480 
5481  assume( pn != NULL );
5482  const int P = pn->listLength();
5483 
5484  #ifdef SINGULAR_4_1
5485  if (pn->Typ()==CRING_CMD)
5486  {
5487  cf=(coeffs)pn->CopyD();
5488  if(P>1) /*parameter*/
5489  {
5490  pn = pn->next;
5491  const int pars = pn->listLength();
5492  assume( pars > 0 );
5493  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5494 
5495  if (rSleftvList2StringArray(pn, names))
5496  {
5497  WerrorS("parameter expected");
5498  goto rInitError;
5499  }
5500 
5501  TransExtInfo extParam;
5502 
5503  extParam.r = rDefault( cf, pars, names); // Q/Zp [ p_1, ... p_pars ]
5504  for(int i=pars-1; i>=0;i--)
5505  {
5506  omFree(names[i]);
5507  }
5508  omFree(names);
5509 
5510  cf = nInitChar(n_transExt, &extParam);
5511  }
5512  assume( cf != NULL );
5513  }
5514  else
5515  #endif
5516  if (pn->Typ()==INT_CMD)
5517  {
5518  int ch = (int)(long)pn->Data();
5519 
5520  /* parameter? -------------------------------------------------------*/
5521  pn = pn->next;
5522 
5523  if (pn == NULL) // no params!?
5524  {
5525  if (ch!=0)
5526  {
5527  int ch2=IsPrime(ch);
5528  if ((ch<2)||(ch!=ch2))
5529  {
5530  Warn("%d is invalid as characteristic of the ground field. 32003 is used.", ch);
5531  ch=32003;
5532  }
5533  cf = nInitChar(n_Zp, (void*)(long)ch);
5534  }
5535  else
5536  cf = nInitChar(n_Q, (void*)(long)ch);
5537  }
5538  else
5539  {
5540  const int pars = pn->listLength();
5541 
5542  assume( pars > 0 );
5543 
5544  // predefined finite field: (p^k, a)
5545  if ((ch!=0) && (ch!=IsPrime(ch)) && (pars == 1))
5546  {
5547  GFInfo param;
5548 
5549  param.GFChar = ch;
5550  param.GFDegree = 1;
5551  param.GFPar_name = pn->name;
5552 
5553  cf = nInitChar(n_GF, &param);
5554  }
5555  else // (0/p, a, b, ..., z)
5556  {
5557  if ((ch!=0) && (ch!=IsPrime(ch)))
5558  {
5559  WerrorS("too many parameters");
5560  goto rInitError;
5561  }
5562 
5563  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5564 
5565  if (rSleftvList2StringArray(pn, names))
5566  {
5567  WerrorS("parameter expected");
5568  goto rInitError;
5569  }
5570 
5571  TransExtInfo extParam;
5572 
5573  extParam.r = rDefault( ch, pars, names); // Q/Zp [ p_1, ... p_pars ]
5574  for(int i=pars-1; i>=0;i--)
5575  {
5576  omFree(names[i]);
5577  }
5578  omFree(names);
5579 
5580  cf = nInitChar(n_transExt, &extParam);
5581  }
5582  }
5583 
5584 // if (cf==NULL) goto rInitError;
5585  assume( cf != NULL );
5586  }
5587  else if ((pn->name != NULL)
5588  && ((strcmp(pn->name,"real")==0) || (strcmp(pn->name,"complex")==0)))
5589  {
5590  BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
5591  if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
5592  {
5593  float_len=(int)(long)pn->next->Data();
5594  float_len2=float_len;
5595  pn=pn->next;
5596  if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
5597  {
5598  float_len2=(int)(long)pn->next->Data();
5599  pn=pn->next;
5600  }
5601  }
5602 
5603  if (!complex_flag)
5604  complex_flag= pn->next != NULL;
5605  if( !complex_flag && (float_len2 <= (short)SHORT_REAL_LENGTH))
5606  cf=nInitChar(n_R, NULL);
5607  else // longR or longC?
5608  {
5609  LongComplexInfo param;
5610 
5611  param.float_len = si_min (float_len, 32767);
5612  param.float_len2 = si_min (float_len2, 32767);
5613 
5614  // set the parameter name
5615  if (complex_flag)
5616  {
5617  if (param.float_len < SHORT_REAL_LENGTH)
5618  {
5621  }
5622  if (pn->next == NULL)
5623  param.par_name=(const char*)"i"; //default to i
5624  else
5625  param.par_name = (const char*)pn->next->name;
5626  }
5627 
5628  cf = nInitChar(complex_flag ? n_long_C: n_long_R, (void*)&param);
5629  }
5630  assume( cf != NULL );
5631  }
5632 #ifdef HAVE_RINGS
5633  else if ((pn->name != NULL) && (strcmp(pn->name, "integer") == 0))
5634  {
5635  // TODO: change to use coeffs_BIGINT!?
5636  modBase = (mpz_ptr) omAlloc(sizeof(mpz_t));
5637  mpz_init_set_si(modBase, 0);
5638  if (pn->next!=NULL)
5639  {
5640  if (pn->next->Typ()==INT_CMD)
5641  {
5642  mpz_set_ui(modBase, (int)(long) pn->next->Data());
5643  pn=pn->next;
5644  if ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
5645  {
5646  modExponent = (long) pn->next->Data();
5647  pn=pn->next;
5648  }
5649  while ((pn->next!=NULL) && (pn->next->Typ()==INT_CMD))
5650  {
5651  mpz_mul_ui(modBase, modBase, (int)(long) pn->next->Data());
5652  pn=pn->next;
5653  }
5654  }
5655  else if (pn->next->Typ()==BIGINT_CMD)
5656  {
5657  number p=(number)pn->next->CopyD(); // FIXME: why CopyD() here if nlGMP should not overtake p!?
5658  nlGMP(p,(number)modBase,coeffs_BIGINT); // TODO? // extern void nlGMP(number &i, number n, const coeffs r); // FIXME: n_MPZ( modBase, p, coeffs_BIGINT); ?
5659  n_Delete(&p,coeffs_BIGINT);
5660  }
5661  }
5662  else
5663  cf=nInitChar(n_Z,NULL);
5664 
5665  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_cmp_ui(modBase, 0) < 0))
5666  {
5667  Werror("Wrong ground ring specification (module is 1)");
5668  goto rInitError;
5669  }
5670  if (modExponent < 1)
5671  {
5672  Werror("Wrong ground ring specification (exponent smaller than 1");
5673  goto rInitError;
5674  }
5675  // module is 0 ---> integers ringtype = 4;
5676  // we have an exponent
5677  if (modExponent > 1 && cf == NULL)
5678  {
5679  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
5680  {
5681  /* this branch should be active for modExponent = 2..32 resp. 2..64,
5682  depending on the size of a long on the respective platform */
5683  //ringtype = 1; // Use Z/2^ch
5684  cf=nInitChar(n_Z2m,(void*)(long)modExponent);
5685  mpz_clear(modBase);
5686  omFreeSize (modBase, sizeof (mpz_t));
5687  }
5688  else
5689  {
5690  if (mpz_cmp_ui(modBase,0)==0)
5691  {
5692  WerrorS("modulus must not be 0 or parameter not allowed");
5693  goto rInitError;
5694  }
5695  //ringtype = 3;
5696  ZnmInfo info;
5697  info.base= modBase;
5698  info.exp= modExponent;
5699  cf=nInitChar(n_Znm,(void*) &info); //exponent is missing
5700  }
5701  }
5702  // just a module m > 1
5703  else if (cf == NULL)
5704  {
5705  if (mpz_cmp_ui(modBase,0)==0)
5706  {
5707  WerrorS("modulus must not be 0 or parameter not allowed");
5708  goto rInitError;
5709  }
5710  //ringtype = 2;
5711  ZnmInfo info;
5712  info.base= modBase;
5713  info.exp= modExponent;
5714  cf=nInitChar(n_Zn,(void*) &info);
5715  }
5716  assume( cf != NULL );
5717  }
5718 #endif
5719  // ring NEW = OLD, (), (); where OLD is a polynomial ring...
5720  else if ((pn->Typ()==RING_CMD) && (P == 1))
5721  {
5722  TransExtInfo extParam;
5723  extParam.r = (ring)pn->Data();
5724  cf = nInitChar(n_transExt, &extParam);
5725  }
5726  else if ((pn->Typ()==QRING_CMD) && (P == 1)) // same for qrings - which should be fields!?
5727  {
5728  AlgExtInfo extParam;
5729  extParam.r = (ring)pn->Data();
5730 
5731  cf = nInitChar(n_algExt, &extParam); // Q[a]/<minideal>
5732  }
5733  else
5734  {
5735  Werror("Wrong or unknown ground field specification");
5736 #ifndef SING_NDEBUG
5737  sleftv* p = pn;
5738  while (p != NULL)
5739  {
5740  Print( "pn[%p]: type: %d [%s]: %p, name: %s", (void*)p, p->Typ(), Tok2Cmdname(p->Typ()), p->Data(), (p->name == NULL? "NULL" : p->name) );
5741  PrintLn();
5742  p = p->next;
5743  }
5744 #endif
5745  goto rInitError;
5746  }
5747 // pn=pn->next;
5748 
5749  /*every entry in the new ring is initialized to 0*/
5750 
5751  /* characteristic -----------------------------------------------*/
5752  /* input: 0 ch=0 : Q parameter=NULL ffChar=FALSE float_len
5753  * 0 1 : Q(a,...) *names FALSE
5754  * 0 -1 : R NULL FALSE 0
5755  * 0 -1 : R NULL FALSE prec. >6
5756  * 0 -1 : C *names FALSE prec. 0..?
5757  * p p : Fp NULL FALSE
5758  * p -p : Fp(a) *names FALSE
5759  * q q : GF(q=p^n) *names TRUE
5760  */
5761  if (cf==NULL)
5762  {
5763  Werror("Invalid ground field specification");
5764  goto rInitError;
5765 // const int ch=32003;
5766 // cf=nInitChar(n_Zp, (void*)(long)ch);
5767  }
5768 
5769  assume( R != NULL );
5770 
5771  R->cf = cf;
5772 
5773  /* names and number of variables-------------------------------------*/
5774  {
5775  int l=rv->listLength();
5776 
5777  if (l>MAX_SHORT)
5778  {
5779  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5780  goto rInitError;
5781  }
5782  R->N = l; /*rv->listLength();*/
5783  }
5784  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
5785  if (rSleftvList2StringArray(rv, R->names))
5786  {
5787  WerrorS("name of ring variable expected");
5788  goto rInitError;
5789  }
5790 
5791  /* check names and parameters for conflicts ------------------------- */
5792  rRenameVars(R); // conflicting variables will be renamed
5793  /* ordering -------------------------------------------------------------*/
5794  if (rSleftvOrdering2Ordering(ord, R))
5795  goto rInitError;
5796 
5797  // Complete the initialization
5798  if (rComplete(R,1))
5799  goto rInitError;
5800 
5801 /*#ifdef HAVE_RINGS
5802 // currently, coefficients which are ring elements require a global ordering:
5803  if (rField_is_Ring(R) && (R->OrdSgn==-1))
5804  {
5805  WerrorS("global ordering required for these coefficients");
5806  goto rInitError;
5807  }
5808 #endif*/
5809 
5810  rTest(R);
5811 
5812  // try to enter the ring into the name list
5813  // need to clean up sleftv here, before this ring can be set to
5814  // new currRing or currRing can be killed beacuse new ring has
5815  // same name
5816  if (pn != NULL) pn->CleanUp();
5817  if (rv != NULL) rv->CleanUp();
5818  if (ord != NULL) ord->CleanUp();
5819  //if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
5820  // goto rInitError;
5821 
5822  //memcpy(IDRING(tmp),R,sizeof(*R));
5823  // set current ring
5824  //omFreeBin(R, ip_sring_bin);
5825  //return tmp;
5826  return R;
5827 
5828  // error case:
5829  rInitError:
5830  if ((R != NULL)&&(R->cf!=NULL)) rDelete(R);
5831  if (pn != NULL) pn->CleanUp();
5832  if (rv != NULL) rv->CleanUp();
5833  if (ord != NULL) ord->CleanUp();
5834  return NULL;
5835 }
mpz_ptr base
Definition: rmodulon.h:18
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
void PrintLn()
Definition: reporter.cc:327
#define Print
Definition: emacs.cc:83
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:43
Definition: tok.h:85
ring r
Definition: algext.h:40
#define SHORT_REAL_LENGTH
Definition: numbers.h:54
const short MAX_SHORT
Definition: ipshell.cc:5448
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:45
used for all transcendental extensions, i.e., the top-most extension in an extension tower is transce...
Definition: coeffs.h:38
static int si_min(const int a, const int b)
Definition: auxiliary.h:167
BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R)
Definition: ipshell.cc:5145
Definition: tok.h:42
return P p
Definition: myNF.cc:203
rational (GMP) numbers
Definition: coeffs.h:31
const char * GFPar_name
Definition: coeffs.h:95
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
{p < 2^31}
Definition: coeffs.h:30
int listLength()
Definition: subexpr.cc:61
void WerrorS(const char *s)
Definition: feFopen.cc:24
void nlGMP(number &i, number n, const coeffs r)
Definition: longrat.cc:1410
coeffs coeffs_BIGINT
Definition: ipid.cc:54
int Typ()
Definition: subexpr.cc:969
#define omAlloc(size)
Definition: omAllocDecl.h:210
Creation data needed for finite fields.
Definition: coeffs.h:91
idhdl rDefault(const char *s)
Definition: ipshell.cc:1528
real floating point (GMP) numbers
Definition: coeffs.h:34
short float_len2
additional char-flags, rInit
Definition: coeffs.h:101
char * char_ptr
Definition: structs.h:56
single prescision (6,6) real numbers
Definition: coeffs.h:32
Definition: tok.h:56
short float_len
additional char-flags, rInit
Definition: coeffs.h:100
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:3436
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:44
const char * name
Definition: subexpr.h:88
#define omFree(addr)
Definition: omAllocDecl.h:261
#define assume(x)
Definition: mod2.h:405
The main handler for Singular numbers which are suitable for Singular polynomials.
int GFDegree
Definition: coeffs.h:94
const ExtensionInfo & info
< [in] sqrfree poly
const ring R
Definition: DebugPrint.cc:36
complex floating point (GMP) numbers
Definition: coeffs.h:41
#define rTest(r)
Definition: ring.h:781
omBin sip_sring_bin
Definition: ring.cc:54
only used if HAVE_RINGS is defined: ?
Definition: coeffs.h:42
struct for passing initialization parameters to naInitChar
Definition: transext.h:92
unsigned long exp
Definition: rmodulon.h:18
int i
Definition: cfEzgcd.cc:123
int IsPrime(int p)
Definition: prime.cc:61
static void rRenameVars(ring R)
Definition: ipshell.cc:2368
leftv next
Definition: subexpr.h:87
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
int GFChar
Definition: coeffs.h:93
CanonicalForm cf
Definition: cfModGcd.cc:4024
#define NULL
Definition: omList.c:10
{p^n < 2^16}
Definition: coeffs.h:33
struct for passing initialization parameters to naInitChar
Definition: algext.h:40
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:448
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:128
used for all algebraic extensions, i.e., the top-most extension in an extension tower is algebraic ...
Definition: coeffs.h:35
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
void * Data()
Definition: subexpr.cc:1111
const char * par_name
parameter name
Definition: coeffs.h:102
Definition: tok.h:126
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete &#39;p&#39;
Definition: coeffs.h:456
kBucketDestroy & P
Definition: myNF.cc:191
BOOLEAN rSleftvList2StringArray(sleftv *sl, char **p)
Definition: ipshell.cc:5417
int BOOLEAN
Definition: auxiliary.h:131
void Werror(const char *fmt,...)
Definition: reporter.cc:199
void * CopyD(int t)
Definition: subexpr.cc:676
#define omAlloc0(size)
Definition: omAllocDecl.h:211
int l
Definition: cfEzgcd.cc:94
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:327
#define Warn
Definition: emacs.cc:80
void rKill ( idhdl  h)

Definition at line 6068 of file ipshell.cc.

6069 {
6070  ring r = IDRING(h);
6071  int ref=0;
6072  if (r!=NULL)
6073  {
6074  ref=r->ref;
6075  rKill(r);
6076  }
6077  if (h==currRingHdl)
6078  {
6079  if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6080  else
6081  {
6083  }
6084  }
6085 }
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
const ring r
Definition: syzextra.cc:208
void rKill(ring r)
Definition: ipshell.cc:5999
idhdl currRingHdl
Definition: ipid.cc:65
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1573
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:126
void rKill ( ring  r)

Definition at line 5999 of file ipshell.cc.

6000 {
6001  if ((r->ref<=0)&&(r->order!=NULL))
6002  {
6003 #ifdef RDEBUG
6004  if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6005 #endif
6006  if (r->qideal!=NULL)
6007  {
6008  id_Delete(&r->qideal, r);
6009  r->qideal = NULL;
6010  }
6011  int j;
6012 #ifdef USE_IILOCALRING
6013  for (j=0;j<myynest;j++)
6014  {
6015  if (iiLocalRing[j]==r)
6016  {
6017  if (j+1==myynest) Warn("killing the basering for level %d",j);
6018  iiLocalRing[j]=NULL;
6019  }
6020  }
6021 #else /* USE_IILOCALRING */
6022 //#endif /* USE_IILOCALRING */
6023  {
6024  proclevel * nshdl = procstack;
6025  int lev=myynest-1;
6026 
6027  for(; nshdl != NULL; nshdl = nshdl->next)
6028  {
6029  if (nshdl->cRing==r)
6030  {
6031  Warn("killing the basering for level %d",lev);
6032  nshdl->cRing=NULL;
6033  nshdl->cRingHdl=NULL;
6034  }
6035  }
6036  }
6037 #endif /* USE_IILOCALRING */
6038 // any variables depending on r ?
6039  while (r->idroot!=NULL)
6040  {
6041  r->idroot->lev=myynest; // avoid warning about kill global objects
6042  killhdl2(r->idroot,&(r->idroot),r);
6043  }
6044  if (r==currRing)
6045  {
6046  // all dependend stuff is done, clean global vars:
6047  if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6049  {
6051  }
6052  //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6053  //{
6054  // WerrorS("return value depends on local ring variable (export missing ?)");
6055  // iiRETURNEXPR.CleanUp();
6056  //}
6057  currRing=NULL;
6058  currRingHdl=NULL;
6059  }
6060 
6061  /* nKillChar(r); will be called from inside of rDelete */
6062  rDelete(r);
6063  return;
6064  }
6065  r->ref--;
6066 }
#define TRACE_SHOW_RINGS
Definition: reporter.h:33
#define Print
Definition: emacs.cc:83
proclevel * procstack
Definition: ipid.cc:58
void id_Delete(ideal *h, ring r)
deletes an ideal/module/matrix
int traceit
Definition: febase.cc:47
idhdl cRingHdl
Definition: ipid.h:60
int myynest
Definition: febase.cc:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:403
const ring r
Definition: syzextra.cc:208
BOOLEAN RingDependend()
Definition: subexpr.cc:389
int j
Definition: myNF.cc:70
Definition: ipid.h:56
idhdl currRingHdl
Definition: ipid.cc:65
proclevel * next
Definition: ipid.h:59
ring * iiLocalRing
Definition: iplib.cc:525
#define NULL
Definition: omList.c:10
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:448
#define pDelete(p_ptr)
Definition: polys.h:157
ring cRing
Definition: ipid.h:61
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
#define Warn
Definition: emacs.cc:80
void rSetHdl ( idhdl  h)

Definition at line 4979 of file ipshell.cc.

4980 {
4981  ring rg = NULL;
4982  if (h!=NULL)
4983  {
4984 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
4985  rg = IDRING(h);
4986  if (rg==NULL) return; //id <>NULL, ring==NULL
4987  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
4988  if (IDID(h)) // OB: ????
4989  omCheckAddr((ADDRESS)IDID(h));
4990  rTest(rg);
4991  }
4992 
4993  // clean up history
4995  {
4997  memset(&sLastPrinted,0,sizeof(sleftv));
4998  }
4999 
5000  if ((rg!=currRing)&&(currRing!=NULL))
5001  {
5003  if (DENOMINATOR_LIST!=NULL)
5004  {
5005  if (TEST_V_ALLWARN)
5006  Warn("deleting denom_list for ring change to %s",IDID(h));
5007  do
5008  {
5009  n_Delete(&(dd->n),currRing->cf);
5010  dd=dd->next;
5012  DENOMINATOR_LIST=dd;
5013  } while(DENOMINATOR_LIST!=NULL);
5014  }
5015  }
5016 
5017  // test for valid "currRing":
5018  if ((rg!=NULL) && (rg->idroot==NULL))
5019  {
5020  ring old=rg;
5021  rg=rAssure_HasComp(rg);
5022  if (old!=rg)
5023  {
5024  rKill(old);
5025  IDRING(h)=rg;
5026  }
5027  }
5028  /*------------ change the global ring -----------------------*/
5029  rChangeCurrRing(rg);
5030  currRingHdl = h;
5031 }
#define omCheckAddrSize(addr, size)
Definition: omAllocDecl.h:327
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define IDID(a)
Definition: ipid.h:121
denominator_list DENOMINATOR_LIST
Definition: kutil.cc:81
void * ADDRESS
Definition: auxiliary.h:161
ring rAssure_HasComp(const ring r)
Definition: ring.cc:4559
Definition: idrec.h:34
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
BOOLEAN RingDependend()
Definition: subexpr.cc:389
void rKill(ring r)
Definition: ipshell.cc:5999
#define omFree(addr)
Definition: omAllocDecl.h:261
#define rTest(r)
Definition: ring.h:781
idhdl currRingHdl
Definition: ipid.cc:65
void rChangeCurrRing(ring r)
Definition: polys.cc:14
#define NULL
Definition: omList.c:10
denominator_list next
Definition: kutil.h:67
#define IDRING(a)
Definition: ipid.h:126
sleftv sLastPrinted
Definition: subexpr.cc:55
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
#define omCheckAddr(addr)
Definition: omAllocDecl.h:328
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete &#39;p&#39;
Definition: coeffs.h:456
static Poly * h
Definition: janet.cc:978
#define TEST_V_ALLWARN
Definition: options.h:135
#define Warn
Definition: emacs.cc:80
idhdl rSimpleFindHdl ( ring  r,
idhdl  root,
idhdl  n = NULL 
)

Definition at line 6087 of file ipshell.cc.

6088 {
6089  //idhdl next_best=NULL;
6090  idhdl h=root;
6091  while (h!=NULL)
6092  {
6093  if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
6094  && (h!=n)
6095  && (IDRING(h)==r)
6096  )
6097  {
6098  // if (IDLEV(h)==myynest)
6099  // return h;
6100  // if ((IDLEV(h)==0) || (next_best==NULL))
6101  // next_best=h;
6102  // else if (IDLEV(next_best)<IDLEV(h))
6103  // next_best=h;
6104  return h;
6105  }
6106  h=IDNEXT(h);
6107  }
6108  //return next_best;
6109  return NULL;
6110 }
#define IDNEXT(a)
Definition: ipid.h:117
Definition: idrec.h:34
#define IDTYP(a)
Definition: ipid.h:118
const ring r
Definition: syzextra.cc:208
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:126
Definition: tok.h:126
static Poly * h
Definition: janet.cc:978
lists scIndIndset ( ideal  S,
BOOLEAN  all,
ideal  Q 
)

Definition at line 1019 of file ipshell.cc.

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

Definition at line 4415 of file ipshell.cc.

4416 {
4417  sleftv tmp;
4418  memset(&tmp,0,sizeof(tmp));
4419  tmp.rtyp=INT_CMD;
4420  /* tmp.data = (void *)0; -- done by memset */
4421 
4422  return semicProc3(res,u,v,&tmp);
4423 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:85
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4375
poly res
Definition: myNF.cc:322
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
int rtyp
Definition: subexpr.h:92
BOOLEAN semicProc3 ( leftv  ,
leftv  ,
leftv  ,
leftv   
)

Definition at line 4375 of file ipshell.cc.

4376 {
4377  semicState state;
4378  BOOLEAN qh=(((int)(long)w->Data())==1);
4379 
4380  // -----------------
4381  // check arguments
4382  // -----------------
4383 
4384  lists l1 = (lists)u->Data( );
4385  lists l2 = (lists)v->Data( );
4386 
4387  if( (state=list_is_spectrum( l1 ))!=semicOK )
4388  {
4389  WerrorS( "first argument is not a spectrum" );
4390  list_error( state );
4391  }
4392  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4393  {
4394  WerrorS( "second argument is not a spectrum" );
4395  list_error( state );
4396  }
4397  else
4398  {
4399  spectrum s1= spectrumFromList( l1 );
4400  spectrum s2= spectrumFromList( l2 );
4401 
4402  res->rtyp = INT_CMD;
4403  if (qh)
4404  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4405  else
4406  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4407  }
4408 
4409  // -----------------
4410  // check status
4411  // -----------------
4412 
4413  return (state!=semicOK);
4414 }
Definition: tok.h:85
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3248
void list_error(semicState state)
Definition: ipshell.cc:3332
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
poly res
Definition: myNF.cc:322
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4117
int mult_spectrumh(spectrum &)
Definition: semic.cc:425
semicState
Definition: ipshell.cc:3298
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:37
slists * lists
Definition: mpr_numeric.h:146
const CanonicalForm & w
Definition: facAbsFact.cc:55
int BOOLEAN
Definition: auxiliary.h:131
int mult_spectrum(spectrum &)
Definition: semic.cc:396
BOOLEAN setOption ( leftv  res,
leftv  v 
)

Definition at line 581 of file misc_ip.cc.

582 {
583  const char *n;
584  do
585  {
586  if (v->Typ()==STRING_CMD)
587  {
588  n=(const char *)v->CopyD(STRING_CMD);
589  }
590  else
591  {
592  if (v->name==NULL)
593  return TRUE;
594  if (v->rtyp==0)
595  {
596  n=v->name;
597  v->name=NULL;
598  }
599  else
600  {
601  n=omStrDup(v->name);
602  }
603  }
604 
605  int i;
606 
607  if(strcmp(n,"get")==0)
608  {
609  intvec *w=new intvec(2);
610  (*w)[0]=si_opt_1;
611  (*w)[1]=si_opt_2;
612  res->rtyp=INTVEC_CMD;
613  res->data=(void *)w;
614  goto okay;
615  }
616  if(strcmp(n,"set")==0)
617  {
618  if((v->next!=NULL)
619  &&(v->next->Typ()==INTVEC_CMD))
620  {
621  v=v->next;
622  intvec *w=(intvec*)v->Data();
623  si_opt_1=(*w)[0];
624  si_opt_2=(*w)[1];
625 #if 0
628 #ifdef HAVE_RINGS
630 #endif
631  ) {
633  }
634 #endif
635  goto okay;
636  }
637  }
638  if(strcmp(n,"none")==0)
639  {
640  si_opt_1=0;
641  si_opt_2=0;
642  goto okay;
643  }
644  for (i=0; (i==0) || (optionStruct[i-1].setval!=0); i++)
645  {
646  if (strcmp(n,optionStruct[i].name)==0)
647  {
648  if (optionStruct[i].setval & validOpts)
649  {
651  // optOldStd disables redthrough
652  if (optionStruct[i].setval == Sy_bit(OPT_OLDSTD))
654  }
655  else
656  Warn("cannot set option");
657 #if 0
660 #ifdef HAVE_RINGS
662 #endif
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  Warn("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 }
unsigned si_opt_1
Definition: options.c:5
#define FALSE
Definition: auxiliary.h:140
#define OPT_OLDSTD
Definition: options.h:81
#define TRUE
Definition: auxiliary.h:144
void * ADDRESS
Definition: auxiliary.h:161
int Typ()
Definition: subexpr.cc:969
#define Sy_bit(x)
Definition: options.h:30
BITSET validOpts
Definition: kstd1.cc:70
static BOOLEAN rField_has_simple_inverse(const ring r)
Definition: ring.h:497
void * data
Definition: subexpr.h:89
unsigned setval
Definition: iplib.cc:315
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
#define V_SHOW_MEM
Definition: options.h:41
#define TEST_OPT_INTSTRATEGY
Definition: options.h:105
Definition: intvec.h:16
unsigned resetval
Definition: iplib.cc:316
const char * name
Definition: subexpr.h:88
#define omFree(addr)
Definition: omAllocDecl.h:261
struct soptionStruct verboseStruct[]
Definition: misc_ip.cc:552
struct soptionStruct optionStruct[]
Definition: misc_ip.cc:522
int i
Definition: cfEzgcd.cc:123
Definition: tok.h:88
leftv next
Definition: subexpr.h:87
#define OPT_INTSTRATEGY
Definition: options.h:87
#define BVERBOSE(a)
Definition: options.h:33
CanonicalForm test
Definition: cfModGcd.cc:4037
char name(const Variable &v)
Definition: variable.h:95
#define V_YACC
Definition: options.h:42
static BOOLEAN rField_is_Ring(const ring r)
Definition: ring.h:437
#define NULL
Definition: omList.c:10
int yydebug
Definition: grammar.cc:1862
const CanonicalForm & w
Definition: facAbsFact.cc:55
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1111
#define OPT_REDTHROUGH
Definition: options.h:77
#define TEST_RINGDEP_OPTS
Definition: options.h:95
unsigned si_opt_2
Definition: options.c:6
void Werror(const char *fmt,...)
Definition: reporter.cc:199
void * CopyD(int t)
Definition: subexpr.cc:676
#define Warn
Definition: emacs.cc:80
#define omStrDup(s)
Definition: omAllocDecl.h:263
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  {
742  StringAppend(" %s",optionStruct[i].name);
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  {
758  StringAppend(" %s",verboseStruct[i].name);
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 }
unsigned si_opt_1
Definition: options.c:5
char * StringEndS()
Definition: reporter.cc:151
#define BITSET
Definition: structs.h:17
#define Sy_bit(x)
Definition: options.h:30
unsigned setval
Definition: iplib.cc:315
unsigned resetval
Definition: iplib.cc:316
struct soptionStruct verboseStruct[]
Definition: misc_ip.cc:552
void StringSetS(const char *st)
Definition: reporter.cc:128
struct soptionStruct optionStruct[]
Definition: misc_ip.cc:522
void StringAppendS(const char *st)
Definition: reporter.cc:107
#define StringAppend
Definition: emacs.cc:82
int i
Definition: cfEzgcd.cc:123
char name(const Variable &v)
Definition: variable.h:95
unsigned si_opt_2
Definition: options.c:6
void singular_example ( char *  str)

Definition at line 438 of file misc_ip.cc.

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

Definition at line 4292 of file ipshell.cc.

4293 {
4294  semicState state;
4295 
4296  // -----------------
4297  // check arguments
4298  // -----------------
4299 
4300  lists l1 = (lists)first->Data( );
4301  lists l2 = (lists)second->Data( );
4302 
4303  if( (state=list_is_spectrum( l1 )) != semicOK )
4304  {
4305  WerrorS( "first argument is not a spectrum:" );
4306  list_error( state );
4307  }
4308  else if( (state=list_is_spectrum( l2 )) != semicOK )
4309  {
4310  WerrorS( "second argument is not a spectrum:" );
4311  list_error( state );
4312  }
4313  else
4314  {
4315  spectrum s1= spectrumFromList ( l1 );
4316  spectrum s2= spectrumFromList ( l2 );
4317  spectrum sum( s1+s2 );
4318 
4319  result->rtyp = LIST_CMD;
4320  result->data = (char*)(getList(sum));
4321  }
4322 
4323  return (state!=semicOK);
4324 }
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3248
void list_error(semicState state)
Definition: ipshell.cc:3332
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
lists getList(spectrum &spec)
Definition: ipshell.cc:3260
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4117
semicState
Definition: ipshell.cc:3298
slists * lists
Definition: mpr_numeric.h:146
Definition: tok.h:96
return result
Definition: facAbsBiFact.cc:76
BOOLEAN spectrumfProc ( leftv  ,
leftv   
)

Definition at line 4048 of file ipshell.cc.

4049 {
4050  spectrumState state = spectrumOK;
4051 
4052  // -------------------
4053  // check consistency
4054  // -------------------
4055 
4056  // check for a local polynomial ring
4057 
4058  if( currRing->OrdSgn != -1 )
4059  // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4060  // or should we use:
4061  //if( !ringIsLocal( ) )
4062  {
4063  WerrorS( "only works for local orderings" );
4064  state = spectrumWrongRing;
4065  }
4066  else if( currRing->qideal != NULL )
4067  {
4068  WerrorS( "does not work in quotient rings" );
4069  state = spectrumWrongRing;
4070  }
4071  else
4072  {
4073  lists L = (lists)NULL;
4074  int flag = 2; // symmetric optimization
4075 
4076  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4077 
4078  if( state==spectrumOK )
4079  {
4080  result->rtyp = LIST_CMD;
4081  result->data = (char*)L;
4082  }
4083  else
4084  {
4085  spectrumPrintError(state);
4086  }
4087  }
4088 
4089  return (state!=spectrumOK);
4090 }
spectrumState
Definition: ipshell.cc:3414
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:24
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:3966
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3674
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
Definition: tok.h:96
polyrec * poly
Definition: hilb.h:10
return result
Definition: facAbsBiFact.cc:76
BOOLEAN spectrumProc ( leftv  ,
leftv   
)

Definition at line 3997 of file ipshell.cc.

3998 {
3999  spectrumState state = spectrumOK;
4000 
4001  // -------------------
4002  // check consistency
4003  // -------------------
4004 
4005  // check for a local ring
4006 
4007  if( !ringIsLocal(currRing ) )
4008  {
4009  WerrorS( "only works for local orderings" );
4010  state = spectrumWrongRing;
4011  }
4012 
4013  // no quotient rings are allowed
4014 
4015  else if( currRing->qideal != NULL )
4016  {
4017  WerrorS( "does not work in quotient rings" );
4018  state = spectrumWrongRing;
4019  }
4020  else
4021  {
4022  lists L = (lists)NULL;
4023  int flag = 1; // weight corner optimization is safe
4024 
4025  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4026 
4027  if( state==spectrumOK )
4028  {
4029  result->rtyp = LIST_CMD;
4030  result->data = (char*)L;
4031  }
4032  else
4033  {
4034  spectrumPrintError(state);
4035  }
4036  }
4037 
4038  return (state!=spectrumOK);
4039 }
spectrumState
Definition: ipshell.cc:3414
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:24
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:3966
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3674
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
Definition: tok.h:96
BOOLEAN ringIsLocal(const ring r)
Definition: spectrum.cc:461
polyrec * poly
Definition: hilb.h:10
return result
Definition: facAbsBiFact.cc:76
BOOLEAN spmulProc ( leftv  ,
leftv  ,
leftv   
)

Definition at line 4334 of file ipshell.cc.

4335 {
4336  semicState state;
4337 
4338  // -----------------
4339  // check arguments
4340  // -----------------
4341 
4342  lists l = (lists)first->Data( );
4343  int k = (int)(long)second->Data( );
4344 
4345  if( (state=list_is_spectrum( l ))!=semicOK )
4346  {
4347  WerrorS( "first argument is not a spectrum" );
4348  list_error( state );
4349  }
4350  else if( k < 0 )
4351  {
4352  WerrorS( "second argument should be positive" );
4353  state = semicMulNegative;
4354  }
4355  else
4356  {
4357  spectrum s= spectrumFromList( l );
4358  spectrum product( k*s );
4359 
4360  result->rtyp = LIST_CMD;
4361  result->data = (char*)getList(product);
4362  }
4363 
4364  return (state!=semicOK);
4365 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3248
void list_error(semicState state)
Definition: ipshell.cc:3332
void WerrorS(const char *s)
Definition: feFopen.cc:24
int k
Definition: cfEzgcd.cc:93
Definition: semic.h:63
lists getList(spectrum &spec)
Definition: ipshell.cc:3260
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4117
semicState
Definition: ipshell.cc:3298
slists * lists
Definition: mpr_numeric.h:146
Definition: tok.h:96
return result
Definition: facAbsBiFact.cc:76
int l
Definition: cfEzgcd.cc:94
BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3034 of file ipshell.cc.

3035 {
3036  sleftv tmp;
3037  memset(&tmp,0,sizeof(tmp));
3038  tmp.rtyp=INT_CMD;
3039  tmp.data=(void *)1;
3040  return syBetti2(res,u,&tmp);
3041 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:85
void * data
Definition: subexpr.h:89
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3011
int rtyp
Definition: subexpr.h:92
BOOLEAN syBetti2 ( leftv  res,
leftv  u,
leftv  w 
)

Definition at line 3011 of file ipshell.cc.

3012 {
3013  syStrategy syzstr=(syStrategy)u->Data();
3014 
3015  BOOLEAN minim=(int)(long)w->Data();
3016  int row_shift=0;
3017  int add_row_shift=0;
3018  intvec *weights=NULL;
3019  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3020  if (ww!=NULL)
3021  {
3022  weights=ivCopy(ww);
3023  add_row_shift = ww->min_in();
3024  (*weights) -= add_row_shift;
3025  }
3026 
3027  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3028  //row_shift += add_row_shift;
3029  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3030  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3031 
3032  return FALSE;
3033 }
void atSet(idhdl root, const char *name, void *data, int typ)
Definition: attrib.cc:156
Definition: tok.h:85
#define FALSE
Definition: auxiliary.h:140
intvec * ivCopy(const intvec *o)
Definition: intvec.h:141
int min_in()
Definition: intvec.h:114
void * data
Definition: subexpr.h:89
Definition: intvec.h:16
Definition: tok.h:88
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:135
#define NULL
Definition: omList.c:10
intvec * syBettiOfComputation(syStrategy syzstr, BOOLEAN minim=TRUE, int *row_shift=NULL, intvec *weights=NULL)
Definition: syz1.cc:1767
void * Data()
Definition: subexpr.cc:1111
int BOOLEAN
Definition: auxiliary.h:131
ssyStrategy * syStrategy
Definition: syz.h:35
#define omStrDup(s)
Definition: omAllocDecl.h:263
syStrategy syConvList ( lists  li,
BOOLEAN  toDel 
)

Definition at line 3119 of file ipshell.cc.

3120 {
3121  int typ0;
3123 
3124  resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3125  if (fr != NULL)
3126  {
3127 
3128  result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3129  for (int i=result->length-1;i>=0;i--)
3130  {
3131  if (fr[i]!=NULL)
3132  result->fullres[i] = idCopy(fr[i]);
3133  }
3134  result->list_length=result->length;
3135  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3136  }
3137  else
3138  {
3139  omFreeSize(result, sizeof(ssyStrategy));
3140  result = NULL;
3141  }
3142  if (toDel) li->Clean();
3143  return result;
3144 }
int length
Definition: syz.h:60
intvec ** weights
Definition: syz.h:45
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:313
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:161
int i
Definition: cfEzgcd.cc:123
resolvente fullres
Definition: syz.h:57
ideal idCopy(ideal A)
Definition: ideals.h:73
#define NULL
Definition: omList.c:10
void Clean(ring r=currRing)
Definition: lists.h:25
short list_length
Definition: syz.h:62
ideal * resolvente
Definition: ideals.h:20
#define omAlloc0(size)
Definition: omAllocDecl.h:211
return result
Definition: facAbsBiFact.cc:76
ssyStrategy * syStrategy
Definition: syz.h:35
lists syConvRes ( syStrategy  syzstr,
BOOLEAN  toDel = FALSE,
int  add_row_shift = 0 
)

Definition at line 3046 of file ipshell.cc.

3047 {
3048  resolvente fullres = syzstr->fullres;
3049  resolvente minres = syzstr->minres;
3050 
3051  const int length = syzstr->length;
3052 
3053  if ((fullres==NULL) && (minres==NULL))
3054  {
3055  if (syzstr->hilb_coeffs==NULL)
3056  { // La Scala
3057  fullres = syReorder(syzstr->res, length, syzstr);
3058  }
3059  else
3060  { // HRES
3061  minres = syReorder(syzstr->orderedRes, length, syzstr);
3062  syKillEmptyEntres(minres, length);
3063  }
3064  }
3065 
3066  resolvente tr;
3067  int typ0=IDEAL_CMD;
3068 
3069  if (minres!=NULL)
3070  tr = minres;
3071  else
3072  tr = fullres;
3073 
3074  resolvente trueres=NULL; intvec ** w=NULL;
3075 
3076  if (length>0)
3077  {
3078  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3079  for (int i=(length)-1;i>=0;i--)
3080  {
3081  if (tr[i]!=NULL)
3082  {
3083  trueres[i] = idCopy(tr[i]);
3084  }
3085  }
3086  if ( id_RankFreeModule(trueres[0], currRing) > 0)
3087  typ0 = MODUL_CMD;
3088  if (syzstr->weights!=NULL)
3089  {
3090  w = (intvec**)omAlloc0(length*sizeof(intvec*));
3091  for (int i=length-1;i>=0;i--)
3092  {
3093  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3094  }
3095  }
3096  }
3097 
3098  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3099  w, add_row_shift);
3100 
3101  if (w != NULL) omFreeSize(w, length*sizeof(intvec*));
3102 
3103  if (toDel)
3104  syKillComputation(syzstr);
3105  else
3106  {
3107  if( fullres != NULL && syzstr->fullres == NULL )
3108  syzstr->fullres = fullres;
3109 
3110  if( minres != NULL && syzstr->minres == NULL )
3111  syzstr->minres = minres;
3112  }
3113  return li;
3114 }
int length
Definition: syz.h:60
intvec ** weights
Definition: syz.h:45
resolvente syReorder(resolvente res, int length, syStrategy syzstr, BOOLEAN toCopy=TRUE, resolvente totake=NULL)
Definition: syz1.cc:1653
Definition: lists.h:22
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
intvec * ivCopy(const intvec *o)
Definition: intvec.h:141
resolvente res
Definition: syz.h:47
intvec ** hilb_coeffs
Definition: syz.h:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
resolvente orderedRes
Definition: syz.h:48
Definition: intvec.h:16
long id_RankFreeModule(ideal s, ring lmRing, ring tailRing)
return the maximal component number found in any polynomial in s
int i
Definition: cfEzgcd.cc:123
resolvente fullres
Definition: syz.h:57
ideal idCopy(ideal A)
Definition: ideals.h:73
resolvente minres
Definition: syz.h:58
#define NULL
Definition: omList.c:10
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:216
const CanonicalForm & w
Definition: facAbsFact.cc:55
short list_length
Definition: syz.h:62
ideal * resolvente
Definition: ideals.h:20
void syKillEmptyEntres(resolvente res, int length)
Definition: syz1.cc:2209
void syKillComputation(syStrategy syzstr, ring r=currRing)
Definition: syz1.cc:1497
#define omAlloc0(size)
Definition: omAllocDecl.h:211
syStrategy syForceMin ( lists  li)

Definition at line 3149 of file ipshell.cc.

3150 {
3151  int typ0;
3153 
3154  resolvente fr = liFindRes(li,&(result->length),&typ0);
3155  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3156  for (int i=result->length-1;i>=0;i--)
3157  {
3158  if (fr[i]!=NULL)
3159  result->minres[i] = idCopy(fr[i]);
3160  }
3161  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3162  return result;
3163 }
int length
Definition: syz.h:60
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:313
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
void * ADDRESS
Definition: auxiliary.h:161
int i
Definition: cfEzgcd.cc:123
ideal idCopy(ideal A)
Definition: ideals.h:73
resolvente minres
Definition: syz.h:58
#define NULL
Definition: omList.c:10
ideal * resolvente
Definition: ideals.h:20
#define omAlloc0(size)
Definition: omAllocDecl.h:211
return result
Definition: facAbsBiFact.cc:76
ssyStrategy * syStrategy
Definition: syz.h:35
void test_cmd ( int  i)

Definition at line 521 of file ipshell.cc.

522 {
523  int ii;
524 
525  if (i<0)
526  {
527  ii= -i;
528  if (ii < 32)
529  {
530  si_opt_1 &= ~Sy_bit(ii);
531  }
532  else if (ii < 64)
533  {
534  si_opt_2 &= ~Sy_bit(ii-32);
535  }
536  else
537  WerrorS("out of bounds\n");
538  }
539  else if (i<32)
540  {
541  ii=i;
542  if (Sy_bit(ii) & kOptions)
543  {
544  Warn("Gerhard, use the option command");
545  si_opt_1 |= Sy_bit(ii);
546  }
547  else if (Sy_bit(ii) & validOpts)
548  si_opt_1 |= Sy_bit(ii);
549  }
550  else if (i<64)
551  {
552  ii=i-32;
553  si_opt_2 |= Sy_bit(ii);
554  }
555  else
556  WerrorS("out of bounds\n");
557 }
unsigned si_opt_1
Definition: options.c:5
void WerrorS(const char *s)
Definition: feFopen.cc:24
#define Sy_bit(x)
Definition: options.h:30
BITSET validOpts
Definition: kstd1.cc:70
int i
Definition: cfEzgcd.cc:123
BITSET kOptions
Definition: kstd1.cc:55
unsigned si_opt_2
Definition: options.c:6
#define Warn
Definition: emacs.cc:80
const char* Tok2Cmdname ( int  i)

Definition at line 128 of file gentable.cc.

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

Definition at line 251 of file ipshell.cc.

252 {
253  BOOLEAN oldShortOut = FALSE;
254 
255  if (currRing != NULL)
256  {
257  oldShortOut = currRing->ShortOut;
258  currRing->ShortOut = 1;
259  }
260  int t=v->Typ();
261  Print("// %s %s ",v->Name(),Tok2Cmdname(t));
262  switch (t)
263  {
264  case MAP_CMD:Print(" from %s\n",((map)(v->Data()))->preimage); break;
265  case INTMAT_CMD: Print(" %d x %d\n",((intvec*)(v->Data()))->rows(),
266  ((intvec*)(v->Data()))->cols()); break;
267  case MATRIX_CMD:Print(" %u x %u\n" ,
268  MATROWS((matrix)(v->Data())),
269  MATCOLS((matrix)(v->Data())));break;
270  case MODUL_CMD: Print(", rk %d\n", (int)(((ideal)(v->Data()))->rank));break;
271  case LIST_CMD: Print(", size %d\n",((lists)(v->Data()))->nr+1); break;
272 
273  case PROC_CMD:
274  case RING_CMD:
275  case IDEAL_CMD:
276  case QRING_CMD: PrintLn(); break;
277 
278  //case INT_CMD:
279  //case STRING_CMD:
280  //case INTVEC_CMD:
281  //case POLY_CMD:
282  //case VECTOR_CMD:
283  //case PACKAGE_CMD:
284 
285  default:
286  break;
287  }
288  v->Print();
289  if (currRing != NULL)
290  currRing->ShortOut = oldShortOut;
291 }
CanonicalForm map(const CanonicalForm &primElem, const Variable &alpha, const CanonicalForm &F, const Variable &beta)
map from to such that is mapped onto
Definition: cf_map_ext.cc:400
void PrintLn()
Definition: reporter.cc:327
#define Print
Definition: emacs.cc:83
Definition: lists.h:22
#define FALSE
Definition: auxiliary.h:140
int Typ()
Definition: subexpr.cc:969
const char * Name()
Definition: subexpr.h:121
void Print(leftv store=NULL, int spaces=0)
Called by type_cmd (e.g. "r;") or as default in jPRINT.
Definition: subexpr.cc:73
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
Definition: intvec.h:16
#define MATCOLS(i)
Definition: matpol.h:28
#define NULL
Definition: omList.c:10
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:128
void * Data()
Definition: subexpr.cc:1111
Definition: tok.h:96
Definition: tok.h:126
#define MATROWS(i)
Definition: matpol.h:27
int BOOLEAN
Definition: auxiliary.h:131
char* versionString ( )

Definition at line 784 of file misc_ip.cc.

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

Variable Documentation

const char* currid

Definition at line 172 of file grammar.cc.

struct sValCmd1 dArith1[]

Definition at line 19 of file table.h.

struct sValCmd2 dArith2[]

Definition at line 290 of file table.h.

struct sValCmd3 dArith3[]

Definition at line 706 of file table.h.

struct sValCmdM dArithM[]

Definition at line 816 of file table.h.

leftv iiCurrArgs

Definition at line 84 of file ipshell.cc.

idhdl iiCurrProc

Definition at line 85 of file ipshell.cc.

ring* iiLocalRing

Definition at line 525 of file iplib.cc.

int iiOp

Definition at line 240 of file iparith.cc.

sleftv iiRETURNEXPR

Definition at line 527 of file iplib.cc.

int iiRETURNEXPR_len

Definition at line 528 of file iplib.cc.

const char* lastreserved

Definition at line 86 of file ipshell.cc.

int myynest

Definition at line 46 of file febase.cc.

int printlevel

Definition at line 42 of file febase.cc.

int si_echo

Definition at line 41 of file febase.cc.

const char* singular_date

Definition at line 1164 of file misc_ip.cc.

BOOLEAN yyInRingConstruction

Definition at line 173 of file grammar.cc.