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 (leftv pn, leftv rv, leftv ord)
 
idhdl rDefault (const char *s)
 
idhdl rSimpleFindHdl (ring r, idhdl root, idhdl n=NULL)
 
idhdl rFindHdl (ring r, idhdl n)
 
void rKill (idhdl h)
 
void rKill (ring r)
 
lists scIndIndset (ideal S, BOOLEAN all, ideal Q)
 
BOOLEAN mpKoszul (leftv res, leftv c, leftv b, leftv id)
 
BOOLEAN mpJacobi (leftv res, leftv a)
 
BOOLEAN jjRESULTANT (leftv res, leftv u, leftv v, leftv w)
 
BOOLEAN kQHWeight (leftv res, leftv v)
 
BOOLEAN kWeight (leftv res, leftv id)
 
BOOLEAN loSimplex (leftv res, leftv args)
 Implementation of the Simplex Algorithm. More...
 
BOOLEAN loNewtonP (leftv res, leftv arg1)
 compute Newton Polytopes of input polynomials More...
 
BOOLEAN nuMPResMat (leftv res, leftv arg1, leftv arg2)
 returns module representing the multipolynomial resultant matrix Arguments 2: ideal i, int k k=0: use sparse resultant matrix of Gelfand, Kapranov and Zelevinsky k=1: use resultant matrix of Macaulay (k=0 is default) More...
 
BOOLEAN nuLagSolve (leftv res, leftv arg1, leftv arg2, leftv arg3)
 find the (complex) roots an univariate polynomial Determines the roots of an univariate polynomial using Laguerres' root-solver. More...
 
BOOLEAN nuVanderSys (leftv res, leftv arg1, leftv arg2, leftv arg3)
 COMPUTE: polynomial p with values given by v at points p1,..,pN derived from p; more precisely: consider p as point in K^n and v as N elements in K, let p1,..,pN be the points in K^n obtained by evaluating all monomials of degree 0,1,...,N at p in lexicographical order, then the procedure computes the polynomial f satisfying f(pi) = v[i] RETURN: polynomial f of degree d. More...
 
BOOLEAN nuUResSolve (leftv res, leftv args)
 solve a multipolynomial system using the u-resultant Input ideal must be 0-dimensional and (currRing->N) == IDELEMS(ideal). More...
 
BOOLEAN jjCHARSERIES (leftv res, leftv u)
 
void paPrint (const char *n, package p)
 
BOOLEAN iiTestAssume (leftv a, leftv b)
 
BOOLEAN iiExprArith1Tab (leftv res, leftv a, int op, const struct sValCmd1 *dA1, int at, const struct sConvertTypes *dConvertTypes)
 apply an operation 'op' to an argument a return TRUE on failure More...
 
BOOLEAN iiExprArith2Tab (leftv res, leftv a, int op, const struct sValCmd2 *dA2, int at, const struct sConvertTypes *dConvertTypes)
 apply an operation 'op' to arguments a and a->next return TRUE on failure More...
 
BOOLEAN iiExprArith3Tab (leftv res, leftv a, int op, const struct sValCmd3 *dA3, int at, const struct sConvertTypes *dConvertTypes)
 apply an operation 'op' to arguments a, a->next and a->next->next return TRUE on failure More...
 
BOOLEAN iiCheckTypes (leftv args, const short *type_list, int report=0)
 check a list of arguemys against a given field of types return TRUE if the types match return FALSE (and, if report) report an error via Werror otherwise More...
 
BOOLEAN iiBranchTo (leftv r, leftv args)
 
lists rDecompose (const ring r)
 
lists rDecompose_list_cf (const ring r)
 
BOOLEAN rDecompose_CF (leftv res, const coeffs C)
 

Variables

leftv iiCurrArgs
 
idhdl iiCurrProc
 
int iiOp
 
const char * currid
 
int iiRETURNEXPR_len
 
sleftv iiRETURNEXPR
 
ring * iiLocalRing
 
const char * lastreserved
 
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 1011 of file misc_ip.cc.

1012 {
1013  idhdl hh=basePack->idroot;
1014  while (hh!=NULL)
1015  {
1016  omCheckAddr(hh);
1017  omCheckAddr((ADDRESS)IDID(hh));
1018  if (RingDependend(IDTYP(hh)))
1019  {
1020  Print("%s typ %d in Top (should be in ring)\n",IDID(hh),IDTYP(hh));
1021  }
1022  hh=IDNEXT(hh);
1023  }
1024  hh=basePack->idroot;
1025  while (hh!=NULL)
1026  {
1027  if (IDTYP(hh)==PACKAGE_CMD)
1028  {
1029  idhdl h2=IDPACKAGE(hh)->idroot;
1030  if (IDPACKAGE(hh)!=basePack)
1031  {
1032  while (h2!=NULL)
1033  {
1034  omCheckAddr(h2);
1035  omCheckAddr((ADDRESS)IDID(h2));
1036  if (RingDependend(IDTYP(h2)))
1037  {
1038  Print("%s typ %d in %s (should be in ring)\n",IDID(h2),IDTYP(h2),IDID(hh));
1039  }
1040  h2=IDNEXT(h2);
1041  }
1042  }
1043  }
1044  hh=IDNEXT(hh);
1045  }
1046 }
#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 554 of file ipshell.cc.

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

Definition at line 993 of file iplib.cc.

995 {
996  procinfov pi;
997  idhdl h;
998 
999  #ifndef SING_NDEBUG
1000  int dummy;
1001  if (IsCmd(procname,dummy))
1002  {
1003  Werror(">>%s< is a reserved name",procname);
1004  return 0;
1005  }
1006  #endif
1007 
1008  h = enterid(procname,0, PROC_CMD, &IDROOT, TRUE);
1009  if ( h!= NULL )
1010  {
1011  pi = IDPROC(h);
1012  pi->libname = omStrDup(libname);
1013  pi->procname = omStrDup(procname);
1014  pi->language = LANG_C;
1015  pi->ref = 1;
1016  pi->is_static = pstatic;
1017  pi->data.o.function = func;
1018  return(1);
1019  }
1020  else
1021  {
1022  PrintS("iiAddCproc: failed.\n");
1023  }
1024  return(0);
1025 }
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:8822
#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:98
#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:976
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:59
Definition: tok.h:61
#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
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:119
#define NULL
Definition: omList.c:10
leftv iiCurrArgs
Definition: ipshell.cc:79
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
void * Data()
Definition: subexpr.cc:1118
int typ
Definition: idrec.h:43
Definition: tok.h:120
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:1783
BOOLEAN iiAllStart ( procinfov  pi,
char *  p,
feBufferTypes  t,
int  l 
)

Definition at line 312 of file iplib.cc.

313 {
314  // see below:
315  BITSET save1=si_opt_1;
316  BITSET save2=si_opt_2;
317  newBuffer( omStrDup(p /*pi->data.s.body*/), t /*BT_proc*/,
318  pi, l );
319  BOOLEAN err=yyparse();
320  if (sLastPrinted.rtyp!=0)
321  {
323  }
324  // the access to optionStruct and verboseStruct do not work
325  // on x86_64-Linux for pic-code
326  if ((TEST_V_ALLWARN) &&
327  (t==BT_proc) &&
328  ((save1!=si_opt_1)||(save2!=si_opt_2)) &&
329  (pi->libname!=NULL) && (pi->libname[0]!='\0'))
330  {
331  if ((pi->libname!=NULL) && (pi->libname[0]!='\0'))
332  Warn("option changed in proc %s from %s",pi->procname,pi->libname);
333  else
334  Warn("option changed in proc %s",pi->procname);
335  int i;
336  for (i=0; optionStruct[i].setval!=0; i++)
337  {
338  if ((optionStruct[i].setval & si_opt_1)
339  && (!(optionStruct[i].setval & save1)))
340  {
341  Print(" +%s",optionStruct[i].name);
342  }
343  if (!(optionStruct[i].setval & si_opt_1)
344  && ((optionStruct[i].setval & save1)))
345  {
346  Print(" -%s",optionStruct[i].name);
347  }
348  }
349  for (i=0; verboseStruct[i].setval!=0; i++)
350  {
351  if ((verboseStruct[i].setval & si_opt_2)
352  && (!(verboseStruct[i].setval & save2)))
353  {
354  Print(" +%s",verboseStruct[i].name);
355  }
356  if (!(verboseStruct[i].setval & si_opt_2)
357  && ((verboseStruct[i].setval & save2)))
358  {
359  Print(" -%s",verboseStruct[i].name);
360  }
361  }
362  PrintLn();
363  }
364  return err;
365 }
const struct soptionStruct optionStruct[]
Definition: misc_ip.cc:516
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
unsigned setval
Definition: ipid.h:154
#define BITSET
Definition: structs.h:17
char * procname
Definition: subexpr.h:56
char * libname
Definition: subexpr.h:55
int i
Definition: cfEzgcd.cc:123
int yyparse(void)
Definition: grammar.cc:2097
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
const struct soptionStruct verboseStruct[]
Definition: misc_ip.cc:546
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 6351 of file ipshell.cc.

6352 {
6353  memset(res,0,sizeof(sleftv));
6354  res->rtyp=a->Typ();
6355  switch (res->rtyp /*a->Typ()*/)
6356  {
6357  case INTVEC_CMD:
6358  case INTMAT_CMD:
6359  return iiApplyINTVEC(res,a,op,proc);
6360  case BIGINTMAT_CMD:
6361  return iiApplyBIGINTMAT(res,a,op,proc);
6362  case IDEAL_CMD:
6363  case MODUL_CMD:
6364  case MATRIX_CMD:
6365  return iiApplyIDEAL(res,a,op,proc);
6366  case LIST_CMD:
6367  return iiApplyLIST(res,a,op,proc);
6368  }
6369  WerrorS("first argument to `apply` must allow an index");
6370  return TRUE;
6371 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define TRUE
Definition: auxiliary.h:144
void WerrorS(const char *s)
Definition: feFopen.cc:24
int Typ()
Definition: subexpr.cc:976
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6309
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6319
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6314
int rtyp
Definition: subexpr.h:92
Definition: tok.h:120
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6277
BOOLEAN iiARROW ( leftv  ,
char *  ,
char *   
)

Definition at line 6400 of file ipshell.cc.

6401 {
6402  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6403  // find end of s:
6404  int end_s=strlen(s);
6405  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6406  s[end_s+1]='\0';
6407  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6408  sprintf(name,"%s->%s",a,s);
6409  // find start of last expression
6410  int start_s=end_s-1;
6411  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6412  if (start_s<0) // ';' not found
6413  {
6414  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6415  }
6416  else // s[start_s] is ';'
6417  {
6418  s[start_s]='\0';
6419  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6420  }
6421  memset(r,0,sizeof(*r));
6422  // now produce procinfo for PROC_CMD:
6423  r->data = (void *)omAlloc0Bin(procinfo_bin);
6424  ((procinfo *)(r->data))->language=LANG_NONE;
6425  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6426  ((procinfo *)r->data)->data.s.body=ss;
6427  omFree(name);
6428  r->rtyp=PROC_CMD;
6429  //r->rtyp=STRING_CMD;
6430  //r->data=ss;
6431  return FALSE;
6432 }
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:968
#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 1783 of file ipassign.cc.

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

6435 {
6436  int t=arg->Typ();
6437  char* ring_name=omStrDup((char*)r->Name());
6438  if ((t==RING_CMD) ||(t==QRING_CMD))
6439  {
6440  sleftv tmp;
6441  memset(&tmp,0,sizeof(tmp));
6442  tmp.rtyp=IDHDL;
6443  tmp.data=(char*)rDefault(ring_name);
6444  if (tmp.data!=NULL)
6445  {
6446  BOOLEAN b=iiAssign(&tmp,arg);
6447  if (b) return TRUE;
6448  rSetHdl(ggetid(ring_name));
6449  omFree(ring_name);
6450  return FALSE;
6451  }
6452  else
6453  return TRUE;
6454  }
6455  #ifdef SINGULAR_4_1
6456  else if (t==CRING_CMD)
6457  {
6458  sleftv tmp;
6459  sleftv n;
6460  memset(&n,0,sizeof(n));
6461  n.name=ring_name;
6462  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6463  if (iiAssign(&tmp,arg)) return TRUE;
6464  //Print("create %s\n",r->Name());
6465  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6466  return FALSE;
6467  }
6468  #endif
6469  //Print("create %s\n",r->Name());
6470  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6471  return TRUE;// not handled -> error for now
6472 }
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:1532
void * data
Definition: subexpr.h:89
int myynest
Definition: febase.cc:46
Definition: tok.h:59
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:1123
#define NULL
Definition: omList.c:10
int rtyp
Definition: subexpr.h:92
Definition: tok.h:159
void rSetHdl(idhdl h)
Definition: ipshell.cc:5030
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:1783
#define omStrDup(s)
Definition: omAllocDecl.h:263
BOOLEAN iiBranchTo ( leftv  r,
leftv  args 
)

Definition at line 1178 of file ipshell.cc.

1179 {
1180  // <string1...stringN>,<proc>
1181  // known: args!=NULL, l>=1
1182  int l=args->listLength();
1183  int ll=0;
1184  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1185  if (ll!=(l-1)) return FALSE;
1186  leftv h=args;
1187  short *t=(short*)omAlloc(l*sizeof(short));
1188  t[0]=l-1;
1189  int b;
1190  int i;
1191  for(i=1;i<l;i++,h=h->next)
1192  {
1193  if (h->Typ()!=STRING_CMD)
1194  {
1195  omFree(t);
1196  Werror("arg %d is not a string",i);
1197  return TRUE;
1198  }
1199  int tt;
1200  b=IsCmd((char *)h->Data(),tt);
1201  if(b) t[i]=tt;
1202  else
1203  {
1204  omFree(t);
1205  Werror("arg %d is not a type name",i);
1206  return TRUE;
1207  }
1208  }
1209  if (h->Typ()!=PROC_CMD)
1210  {
1211  omFree(t);
1212  Werror("last arg (%d) is not a proc",i);
1213  return TRUE;
1214  }
1215  b=iiCheckTypes(iiCurrArgs,t,0);
1216  omFree(t);
1217  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1218  {
1219  BOOLEAN err;
1220  //Print("branchTo: %s\n",h->Name());
1221  iiCurrProc=(idhdl)h->data;
1223  if( pi->data.s.body==NULL )
1224  {
1226  if (pi->data.s.body==NULL) return TRUE;
1227  }
1228  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1229  {
1230  currPack=pi->pack;
1233  //Print("set pack=%s\n",IDID(currPackHdl));
1234  }
1235  err=iiAllStart(pi,pi->data.s.body,BT_proc,pi->data.s.body_lineno-(iiCurrArgs==NULL));
1237  if (iiCurrArgs!=NULL)
1238  {
1239  if (!err) Warn("too many arguments for %s",IDID(iiCurrProc));
1240  iiCurrArgs->CleanUp();
1242  iiCurrArgs=NULL;
1243  }
1244  return 2-err;
1245  }
1246  return FALSE;
1247 }
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:80
#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:312
#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:6492
package currPack
Definition: ipid.cc:63
leftv iiCurrArgs
Definition: ipshell.cc:79
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
idhdl packFindHdl(package r)
Definition: ipid.cc:732
void iiCheckPack(package &p)
Definition: ipshell.cc:1516
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:211
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:8822
#define Warn
Definition: emacs.cc:80
void iiCheckPack ( package p)

Definition at line 1516 of file ipshell.cc.

1517 {
1518  if (p==basePack) return;
1519 
1520  idhdl t=basePack->idroot;
1521 
1522  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1523 
1524  if (t==NULL)
1525  {
1526  WarnS("package not found\n");
1527  p=basePack;
1528  }
1529  return;
1530 }
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 1472 of file ipshell.cc.

1473 {
1474  if (currRing==NULL)
1475  {
1476  #ifdef SIQ
1477  if (siq<=0)
1478  {
1479  #endif
1480  if (RingDependend(i))
1481  {
1482  WerrorS("no ring active");
1483  return TRUE;
1484  }
1485  #ifdef SIQ
1486  }
1487  #endif
1488  }
1489  return FALSE;
1490 }
#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 6492 of file ipshell.cc.

6493 {
6494  if (args==NULL)
6495  {
6496  if (type_list[0]==0) return TRUE;
6497  else
6498  {
6499  if (report) WerrorS("no arguments expected");
6500  return FALSE;
6501  }
6502  }
6503  int l=args->listLength();
6504  if (l!=(int)type_list[0])
6505  {
6506  if (report) iiReportTypes(0,l,type_list);
6507  return FALSE;
6508  }
6509  for(int i=1;i<=l;i++,args=args->next)
6510  {
6511  short t=type_list[i];
6512  if (t!=ANY_TYPE)
6513  {
6514  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6515  || (t!=args->Typ()))
6516  {
6517  if (report) iiReportTypes(i,args->Typ(),type_list);
6518  return FALSE;
6519  }
6520  }
6521  }
6522  return TRUE;
6523 }
#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:6474
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 1269 of file iplib.cc.

1270 {
1271  char *tmpname = omStrDup(libname);
1272  char *p = strrchr(tmpname, DIR_SEP);
1273  char *r;
1274  if(p==NULL) p = tmpname;
1275  else p++;
1276  r = (char *)strchr(p, '.');
1277  if( r!= NULL) *r = '\0';
1278  r = omStrDup(p);
1279  *r = mytoupper(*r);
1280  // printf("iiConvName: '%s' '%s' => '%s'\n", libname, tmpname, r);
1281  omFree((ADDRESS)tmpname);
1282 
1283  return(r);
1284 }
char mytoupper(char c)
Definition: iplib.cc:1250
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 985 of file ipshell.cc.

986 {
987 #ifdef HAVE_SDB
988  sdb_flags=1;
989 #endif
990  Print("\n-- break point in %s --\n",VoiceName());
992  char * s;
994  s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
995  loop
996  {
997  memset(s,0,80);
999  if (s[BREAK_LINE_LENGTH-1]!='\0')
1000  {
1001  Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
1002  }
1003  else
1004  break;
1005  }
1006  if (*s=='\n')
1007  {
1009  }
1010 #if MDEBUG
1011  else if(strncmp(s,"cont;",5)==0)
1012  {
1014  }
1015 #endif /* MDEBUG */
1016  else
1017  {
1018  strcat( s, "\n;~\n");
1019  newBuffer(s,BT_execute);
1020  }
1021 }
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:983
const char * VoiceName()
Definition: fevoices.cc:66
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:984
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 1123 of file ipshell.cc.

1124 {
1125  BOOLEAN res=FALSE;
1126  const char *id = name->name;
1127 
1128  memset(sy,0,sizeof(sleftv));
1129  if ((name->name==NULL)||(isdigit(name->name[0])))
1130  {
1131  WerrorS("object to declare is not a name");
1132  res=TRUE;
1133  }
1134  else
1135  {
1136  if (TEST_V_ALLWARN
1137  && (name->rtyp!=0)
1138  && (name->rtyp!=IDHDL)
1139  && (currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1140  {
1141  Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1143  }
1144  {
1145  sy->data = (char *)enterid(id,lev,t,root,init_b);
1146  }
1147  if (sy->data!=NULL)
1148  {
1149  sy->rtyp=IDHDL;
1150  currid=sy->name=IDID((idhdl)sy->data);
1151  // name->name=NULL; /* used in enterid */
1152  //sy->e = NULL;
1153  if (name->next!=NULL)
1154  {
1156  res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1157  }
1158  }
1159  else res=TRUE;
1160  }
1161  name->CleanUp();
1162  return res;
1163 }
#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:1123
#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 655 of file iplib.cc.

656 {
657  BOOLEAN err;
658  int old_echo=si_echo;
659 
660  iiCheckNest();
661  procstack->push(example);
662 #ifdef USE_IILOCALRING
664 #endif
666  {
667  if (traceit&TRACE_SHOW_LINENO) printf("\n");
668  printf("entering example (level %d)\n",myynest);
669  }
670  myynest++;
671 
672  err=iiAllStart(pi,example,BT_example,(pi != NULL ? pi->data.s.example_lineno: 0));
673 
675  myynest--;
676  si_echo=old_echo;
677  if (traceit&TRACE_SHOW_PROC)
678  {
679  if (traceit&TRACE_SHOW_LINENO) printf("\n");
680  printf("leaving -example- (level %d)\n",myynest);
681  }
682 #ifdef USE_IILOCALRING
683  if (iiLocalRing[myynest] != currRing)
684  {
685  if (iiLocalRing[myynest]!=NULL)
686  {
689  }
690  else
691  {
693  currRing=NULL;
694  }
695  }
696 #else /* USE_IILOCALRING */
697 #endif /* USE_IILOCALRING */
698  if (NS_LRING != currRing)
699  {
700  if (NS_LRING!=NULL)
701  {
703  if ((rh==NULL)||(IDRING(rh)!=NS_LRING))
704  rh=rFindHdl(NS_LRING,NULL);
705  rSetHdl(rh);
706  }
707  else
708  {
710  currRing=NULL;
711  }
712  }
713 //#endif /* USE_IILOCALRING */
714  procstack->pop();
715  return err;
716 }
#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:550
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:380
procinfodata data
Definition: subexpr.h:62
idhdl currRingHdl
Definition: ipid.cc:65
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1577
BOOLEAN iiAllStart(procinfov pi, char *p, feBufferTypes t, int l)
Definition: iplib.cc:312
ring * iiLocalRing
Definition: iplib.cc:515
#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:5030
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:61
int si_echo
Definition: febase.cc:41
BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1392 of file ipshell.cc.

1393 {
1394  BOOLEAN nok=FALSE;
1395  leftv r=v;
1396  while (v!=NULL)
1397  {
1398  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1399  {
1400  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1401  nok=TRUE;
1402  }
1403  else
1404  {
1405  if(iiInternalExport(v, toLev))
1406  {
1407  r->CleanUp();
1408  return TRUE;
1409  }
1410  }
1411  v=v->next;
1412  }
1413  r->CleanUp();
1414  return nok;
1415 }
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:1284
#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 1418 of file ipshell.cc.

1419 {
1420 #ifdef SINGULAR_4_1
1421  if ((pack==basePack)&&(pack!=currPack))
1422  { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
1423 #endif
1424  BOOLEAN nok=FALSE;
1425  leftv rv=v;
1426  while (v!=NULL)
1427  {
1428  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
1429  )
1430  {
1431  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1432  nok=TRUE;
1433  }
1434  else
1435  {
1436  idhdl old=pack->idroot->get( v->name,toLev);
1437  if (old!=NULL)
1438  {
1439  if ((pack==currPack) && (old==(idhdl)v->data))
1440  {
1441  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
1442  break;
1443  }
1444  else if (IDTYP(old)==v->Typ())
1445  {
1446  if (BVERBOSE(V_REDEFINE))
1447  {
1448  Warn("redefining %s",IDID(old));
1449  }
1450  v->name=omStrDup(v->name);
1451  killhdl2(old,&(pack->idroot),currRing);
1452  }
1453  else
1454  {
1455  rv->CleanUp();
1456  return TRUE;
1457  }
1458  }
1459  //Print("iiExport: pack=%s\n",IDID(root));
1460  if(iiInternalExport(v, toLev, pack))
1461  {
1462  rv->CleanUp();
1463  return TRUE;
1464  }
1465  }
1466  v=v->next;
1467  }
1468  rv->CleanUp();
1469  return nok;
1470 }
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:976
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:1284
#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,
const struct sValCmd1 dA1,
int  at,
const struct sConvertTypes dConvertTypes 
)

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

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

Definition at line 8286 of file iparith.cc.

8287 {
8288  memset(res,0,sizeof(sleftv));
8289  BOOLEAN call_failed=FALSE;
8290 
8291  if (!errorreported)
8292  {
8293  BOOLEAN failed=FALSE;
8294  iiOp=op;
8295  int i = 0;
8296  while (dA1[i].cmd==op)
8297  {
8298  if (at==dA1[i].arg)
8299  {
8300  if (currRing!=NULL)
8301  {
8302  if (check_valid(dA1[i].valid_for,op)) break;
8303  }
8304  else
8305  {
8306  if (RingDependend(dA1[i].res))
8307  {
8308  WerrorS("no ring active");
8309  break;
8310  }
8311  }
8312  if (traceit&TRACE_CALL)
8313  Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
8314  res->rtyp=dA1[i].res;
8315  if ((call_failed=dA1[i].p(res,a)))
8316  {
8317  break;// leave loop, goto error handling
8318  }
8319  if (a->Next()!=NULL)
8320  {
8322  failed=iiExprArith1(res->next,a->next,op);
8323  }
8324  a->CleanUp();
8325  return failed;
8326  }
8327  i++;
8328  }
8329  // implicite type conversion --------------------------------------------
8330  if (dA1[i].cmd!=op)
8331  {
8333  i=0;
8334  //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
8335  while (dA1[i].cmd==op)
8336  {
8337  int ai;
8338  //Print("test %s\n",Tok2Cmdname(dA1[i].arg));
8339  if ((ai=iiTestConvert(at,dA1[i].arg,dConvertTypes))!=0)
8340  {
8341  if (currRing!=NULL)
8342  {
8343  if (check_valid(dA1[i].valid_for,op)) break;
8344  }
8345  else
8346  {
8347  if (RingDependend(dA1[i].res))
8348  {
8349  WerrorS("no ring active");
8350  break;
8351  }
8352  }
8353  if (traceit&TRACE_CALL)
8354  Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(dA1[i].arg));
8355  res->rtyp=dA1[i].res;
8356  failed= ((iiConvert(at,dA1[i].arg,ai,a,an,dConvertTypes))
8357  || (call_failed=dA1[i].p(res,an)));
8358  // everything done, clean up temp. variables
8359  if (failed)
8360  {
8361  // leave loop, goto error handling
8362  break;
8363  }
8364  else
8365  {
8366  if (an->Next() != NULL)
8367  {
8368  res->next = (leftv)omAllocBin(sleftv_bin);
8369  failed=iiExprArith1(res->next,an->next,op);
8370  }
8371  // everything ok, clean up and return
8372  an->CleanUp();
8374  a->CleanUp();
8375  return failed;
8376  }
8377  }
8378  i++;
8379  }
8380  an->CleanUp();
8382  }
8383  // error handling
8384  if (!errorreported)
8385  {
8386  if ((at==0) && (a->Fullname()!=sNoName))
8387  {
8388  Werror("`%s` is not defined",a->Fullname());
8389  }
8390  else
8391  {
8392  i=0;
8393  const char *s = iiTwoOps(op);
8394  Werror("%s(`%s`) failed"
8395  ,s,Tok2Cmdname(at));
8396  if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8397  {
8398  while (dA1[i].cmd==op)
8399  {
8400  if ((dA1[i].res!=0)
8401  && (dA1[i].p!=jjWRONG))
8402  Werror("expected %s(`%s`)"
8403  ,s,Tok2Cmdname(dA1[i].arg));
8404  i++;
8405  }
8406  }
8407  }
8408  }
8409  res->rtyp = UNKNOWN;
8410  }
8411  a->CleanUp();
8412  return TRUE;
8413 }
#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:8414
#define FALSE
Definition: auxiliary.h:140
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, const struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:358
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:221
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:9223
const char * Tok2Cmdname(int tok)
Definition: iparith.cc:8944
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:3656
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
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:229
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,
const struct sValCmd2 dA2,
int  at,
const struct sConvertTypes dConvertTypes 
)

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

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

Definition at line 8214 of file iparith.cc.

8218 {
8219  leftv b=a->next;
8220  a->next=NULL;
8221  int bt=b->Typ();
8222  BOOLEAN bo=iiExprArith2TabIntern(res,a,op,b,TRUE,dA2,at,bt,dConvertTypes);
8223  a->next=b;
8224  a->CleanUp();
8225  return bo;
8226 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
#define TRUE
Definition: auxiliary.h:144
int Typ()
Definition: subexpr.cc:976
static BOOLEAN iiExprArith2TabIntern(leftv res, leftv a, int op, leftv b, BOOLEAN proccall, const struct sValCmd2 *dA2, int at, int bt, const struct sConvertTypes *dConvertTypes)
Definition: iparith.cc:8055
leftv next
Definition: subexpr.h:87
#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 8626 of file iparith.cc.

8627 {
8628  memset(res,0,sizeof(sleftv));
8629 
8630  if (!errorreported)
8631  {
8632 #ifdef SIQ
8633  if (siq>0)
8634  {
8635  //Print("siq:%d\n",siq);
8637  memcpy(&d->arg1,a,sizeof(sleftv));
8638  //a->Init();
8639  memcpy(&d->arg2,b,sizeof(sleftv));
8640  //b->Init();
8641  memcpy(&d->arg3,c,sizeof(sleftv));
8642  //c->Init();
8643  d->op=op;
8644  d->argc=3;
8645  res->data=(char *)d;
8646  res->rtyp=COMMAND;
8647  return FALSE;
8648  }
8649 #endif
8650  int at=a->Typ();
8651  // handling bb-objects ----------------------------------------------
8652  if (at>MAX_TOK)
8653  {
8654  blackbox *bb=getBlackboxStuff(at);
8655  if (bb!=NULL)
8656  {
8657  if(!bb->blackbox_Op3(op,res,a,b,c)) return FALSE;
8658  if (errorreported) return TRUE;
8659  // else: no op defined
8660  }
8661  else return TRUE;
8662  if (errorreported) return TRUE;
8663  }
8664  int bt=b->Typ();
8665  int ct=c->Typ();
8666 
8667  iiOp=op;
8668  int i=0;
8669  while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8670  return iiExprArith3TabIntern(res,op,a,b,c,dArith3+i,at,bt,ct,dConvertTypes);
8671  }
8672  a->CleanUp();
8673  b->CleanUp();
8674  c->CleanUp();
8675  //Print("op: %d,result typ:%d\n",op,res->rtyp);
8676  return TRUE;
8677 }
static BOOLEAN iiExprArith3TabIntern(leftv res, int op, leftv a, leftv b, leftv c, const struct sValCmd3 *dA3, int at, int bt, int ct, const struct sConvertTypes *dConvertTypes)
Definition: iparith.cc:8472
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
ip_command * command
Definition: ipid.h:24
const struct sConvertTypes dConvertTypes[]
Definition: table.h:1172
#define FALSE
Definition: auxiliary.h:140
Definition: tok.h:217
BOOLEAN siq
Definition: subexpr.cc:58
#define TRUE
Definition: auxiliary.h:144
int Typ()
Definition: subexpr.cc:976
void * data
Definition: subexpr.h:89
struct sValCmd3 dArith3[]
Definition: table.h:709
int i
Definition: cfEzgcd.cc:123
short errorreported
Definition: feFopen.cc:23
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
#define NULL
Definition: omList.c:10
omBin sip_command_bin
Definition: ipid.cc:49
int rtyp
Definition: subexpr.h:92
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
int iiOp
Definition: iparith.cc:229
#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,
const struct sValCmd3 dA3,
int  at,
const struct sConvertTypes dConvertTypes 
)

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

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

Definition at line 8678 of file iparith.cc.

8682 {
8683  leftv b=a->next;
8684  a->next=NULL;
8685  int bt=b->Typ();
8686  leftv c=b->next;
8687  b->next=NULL;
8688  int ct=c->Typ();
8689  BOOLEAN bo=iiExprArith3TabIntern(res,op,a,b,c,dA3,at,bt,ct,dConvertTypes);
8690  b->next=c;
8691  a->next=b;
8692  a->CleanUp();
8693  return bo;
8694 }
static BOOLEAN iiExprArith3TabIntern(leftv res, int op, leftv a, leftv b, leftv c, const struct sValCmd3 *dA3, int at, int bt, int ct, const struct sConvertTypes *dConvertTypes)
Definition: iparith.cc:8472
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
int Typ()
Definition: subexpr.cc:976
leftv next
Definition: subexpr.h:87
#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 102 of file iplib.cc.

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

Definition at line 1492 of file ipshell.cc.

1493 {
1494  int i;
1495  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1496  poly po=NULL;
1498  {
1499  scComputeHC(I,currRing->qideal,ak,po);
1500  if (po!=NULL)
1501  {
1502  pGetCoeff(po)=nInit(1);
1503  for (i=rVar(currRing); i>0; i--)
1504  {
1505  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1506  }
1507  pSetComp(po,ak);
1508  pSetm(po);
1509  }
1510  }
1511  else
1512  po=pOne();
1513  return po;
1514 }
#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:537
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:757
#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 1346 of file ipshell.cc.

1347 {
1348  idhdl h=(idhdl)v->data;
1349  if(h==NULL)
1350  {
1351  Warn("'%s': no such identifier\n", v->name);
1352  return FALSE;
1353  }
1354  package frompack=v->req_packhdl;
1355  if (frompack==NULL) frompack=currPack;
1356  if ((RingDependend(IDTYP(h)))
1357  || ((IDTYP(h)==LIST_CMD)
1358  && (lRingDependend(IDLIST(h)))
1359  )
1360  )
1361  {
1362  //Print("// ==> Ringdependent set nesting to 0\n");
1363  return (iiInternalExport(v, toLev));
1364  }
1365  else
1366  {
1367  IDLEV(h)=toLev;
1368  v->req_packhdl=rootpack;
1369  if (h==frompack->idroot)
1370  {
1371  frompack->idroot=h->next;
1372  }
1373  else
1374  {
1375  idhdl hh=frompack->idroot;
1376  while ((hh!=NULL) && (hh->next!=h))
1377  hh=hh->next;
1378  if ((hh!=NULL) && (hh->next==h))
1379  hh->next=h->next;
1380  else
1381  {
1382  Werror("`%s` not found",v->Name());
1383  return TRUE;
1384  }
1385  }
1386  h->next=rootpack->idroot;
1387  rootpack->idroot=h;
1388  }
1389  return FALSE;
1390 }
#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:1284
#define NULL
Definition: omList.c:10
package req_packhdl
Definition: subexpr.h:107
package currPack
Definition: ipid.cc:63
Definition: tok.h:120
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 803 of file iplib.cc.

804 {
805  char libnamebuf[128];
806  // procinfov pi;
807  // idhdl h;
808  idhdl pl;
809  // idhdl hl;
810  // long pos = 0L;
811  char *plib = iiConvName(newlib);
812  FILE * fp = feFopen( newlib, "r", libnamebuf, tellerror );
813  // int lines = 1;
814  BOOLEAN LoadResult = TRUE;
815 
816  if (fp==NULL)
817  {
818  return TRUE;
819  }
820  pl = basePack->idroot->get(plib,0);
821  if (pl==NULL)
822  {
823  pl = enterid( plib,0, PACKAGE_CMD,
824  &(basePack->idroot), TRUE );
825  IDPACKAGE(pl)->language = LANG_SINGULAR;
826  IDPACKAGE(pl)->libname=omStrDup(newlib);
827  }
828  else
829  {
830  if(IDTYP(pl)!=PACKAGE_CMD)
831  {
832  WarnS("not of type package.");
833  fclose(fp);
834  return TRUE;
835  }
836  if (!force) return FALSE;
837  }
838  LoadResult = iiLoadLIB(fp, libnamebuf, newlib, pl, autoexport, tellerror);
839  omFree((ADDRESS)newlib);
840 
841  if(!LoadResult) IDPACKAGE(pl)->loaded = TRUE;
842  omFree((ADDRESS)plib);
843 
844  return LoadResult;
845 }
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:892
char * iiConvName(const char *libname)
Definition: iplib.cc:1269
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 892 of file iplib.cc.

894 {
895  extern FILE *yylpin;
896  libstackv ls_start = library_stack;
897  lib_style_types lib_style;
898 
899  yylpin = fp;
900  #if YYLPDEBUG > 1
901  print_init();
902  #endif
903  extern int lpverbose;
904  if (BVERBOSE(V_DEBUG_LIB)) lpverbose=1;
905  else lpverbose=0;
906  // yylplex sets also text_buffer
907  if (text_buffer!=NULL) *text_buffer='\0';
908  yylplex(newlib, libnamebuf, &lib_style, pl, autoexport);
909  if(yylp_errno)
910  {
911  Werror("Library %s: ERROR occurred: in line %d, %d.", newlib, yylplineno,
912  current_pos(0));
914  {
918  }
919  else
921  Werror("Cannot load library,... aborting.");
922  reinit_yylp();
923  fclose( yylpin );
925  return TRUE;
926  }
927  if (BVERBOSE(V_LOAD_LIB))
928  Print( "// ** loaded %s %s\n", libnamebuf, text_buffer);
929  if( (lib_style == OLD_LIBSTYLE) && (BVERBOSE(V_LOAD_LIB)))
930  {
931  Warn( "library %s has old format. This format is still accepted,", newlib);
932  Warn( "but for functionality you may wish to change to the new");
933  Warn( "format. Please refer to the manual for further information.");
934  }
935  reinit_yylp();
936  fclose( yylpin );
937  fp = NULL;
938  iiRunInit(IDPACKAGE(pl));
939 
940  {
941  libstackv ls;
942  for(ls = library_stack; (ls != NULL) && (ls != ls_start); )
943  {
944  if(ls->to_be_done)
945  {
946  ls->to_be_done=FALSE;
947  iiLibCmd(ls->get(),autoexport,tellerror,FALSE);
948  ls = ls->pop(newlib);
949  }
950  }
951 #if 0
952  PrintS("--------------------\n");
953  for(ls = library_stack; ls != NULL; ls = ls->next)
954  {
955  Print("%s: LIB-stack:(%d), %s %s\n", newlib, ls->cnt, ls->get(),
956  ls->to_be_done ? "not loaded" : "loaded");
957  }
958  PrintS("--------------------\n");
959 #endif
960  }
961 
962  if(fp != NULL) fclose(fp);
963  return FALSE;
964 }
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:876
#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:1358
BOOLEAN iiLibCmd(char *newlib, BOOLEAN autoexport, BOOLEAN tellerror, BOOLEAN force)
Definition: iplib.cc:803
#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:847
void Werror(const char *fmt,...)
Definition: reporter.cc:199
libstackv library_stack
Definition: iplib.cc:75
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 789 of file iplib.cc.

790 {
791  char *plib = iiConvName(lib);
792  idhdl pl = basePack->idroot->get(plib,0);
793  if( (pl!=NULL) && (IDTYP(pl)==PACKAGE_CMD) &&
794  (IDPACKAGE(pl)->language == LANG_SINGULAR))
795  {
796  strncpy(where,IDPACKAGE(pl)->libname,127);
797  return TRUE;
798  }
799  else
800  return FALSE;;
801 }
#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:1269
BOOLEAN iiMake_proc ( idhdl  pn,
package  pack,
sleftv sl 
)

Definition at line 563 of file iplib.cc.

564 {
565  int err;
566  procinfov pi = IDPROC(pn);
567  if(pi->is_static && myynest==0)
568  {
569  Werror("'%s::%s()' is a local procedure and cannot be accessed by an user.",
570  pi->libname, pi->procname);
571  return TRUE;
572  }
573  iiCheckNest();
574 #ifdef USE_IILOCALRING
576  //Print("currRing(%d):%s(%x) in %s\n",myynest,IDID(currRingHdl),currRing,IDID(pn));
577 #endif
578  iiRETURNEXPR.Init();
579  procstack->push(pi->procname);
581  || (pi->trace_flag&TRACE_SHOW_PROC))
582  {
584  Print("entering%-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
585  }
586 #ifdef RDEBUG
588 #endif
589  switch (pi->language)
590  {
591  default:
592  case LANG_NONE:
593  WerrorS("undefined proc");
594  err=TRUE;
595  break;
596 
597  case LANG_SINGULAR:
598  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
599  {
600  currPack=pi->pack;
603  //Print("set pack=%s\n",IDID(currPackHdl));
604  }
605  else if ((pack!=NULL)&&(currPack!=pack))
606  {
607  currPack=pack;
610  //Print("set pack=%s\n",IDID(currPackHdl));
611  }
612  err=iiPStart(pn,sl);
613  break;
614  case LANG_C:
616  err = (pi->data.o.function)(res, sl);
617  memcpy(&iiRETURNEXPR,res,sizeof(iiRETURNEXPR));
619  break;
620  }
621  if ((traceit&TRACE_SHOW_PROC)
622  || (pi->trace_flag&TRACE_SHOW_PROC))
623  {
624  if (traceit&TRACE_SHOW_LINENO) PrintLn();
625  Print("leaving %-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
626  }
627  //const char *n="NULL";
628  //if (currRingHdl!=NULL) n=IDID(currRingHdl);
629  //Print("currRing(%d):%s(%x) after %s\n",myynest,n,currRing,IDID(pn));
630 #ifdef RDEBUG
631  if (traceit&TRACE_SHOW_RINGS) iiShowLevRings();
632 #endif
633  if (err)
634  {
636  //iiRETURNEXPR.Init(); //done by CleanUp
637  }
638  if (iiCurrArgs!=NULL)
639  {
640  if (!err) Warn("too many arguments for %s",IDID(pn));
641  iiCurrArgs->CleanUp();
644  }
645  procstack->pop();
646  if (err)
647  return TRUE;
648  return FALSE;
649 }
#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:517
language_defs language
Definition: subexpr.h:58
proclevel * procstack
Definition: ipid.cc:58
static void iiShowLevRings()
Definition: iplib.cc:521
#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:550
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:515
#define NULL
Definition: omList.c:10
BOOLEAN iiPStart(idhdl pn, sleftv *v)
Definition: iplib.cc:372
package currPack
Definition: ipid.cc:63
leftv iiCurrArgs
Definition: ipshell.cc:79
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:1516
#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 776 of file ipshell.cc.

778 {
779  lists L=liMakeResolv(r,length,rlen,typ0,weights);
780  int i=0;
781  idhdl h;
782  char * s=(char *)omAlloc(strlen(name)+5);
783 
784  while (i<=L->nr)
785  {
786  sprintf(s,"%s(%d)",name,i+1);
787  if (i==0)
788  h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
789  else
790  h=enterid(s,myynest,MODUL_CMD,&(currRing->idroot), FALSE);
791  if (h!=NULL)
792  {
793  h->data.uideal=(ideal)L->m[i].data;
794  h->attribute=L->m[i].attribute;
796  Print("//defining: %s as %d-th syzygy module\n",s,i+1);
797  }
798  else
799  {
800  idDelete((ideal *)&(L->m[i].data));
801  Warn("cannot define %s",s);
802  }
803  //L->m[i].data=NULL;
804  //L->m[i].rtyp=0;
805  //L->m[i].attribute=NULL;
806  i++;
807  }
808  omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
810  omFreeSize((ADDRESS)s,strlen(name)+5);
811 }
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 617 of file ipshell.cc.

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

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

Definition at line 1248 of file ipshell.cc.

1249 {
1250  if (iiCurrArgs==NULL)
1251  {
1252  if (strcmp(p->name,"#")==0)
1253  return iiDefaultParameter(p);
1254  Werror("not enough arguments for proc %s",VoiceName());
1255  p->CleanUp();
1256  return TRUE;
1257  }
1258  leftv h=iiCurrArgs;
1259  leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1260  BOOLEAN is_default_list=FALSE;
1261  if (strcmp(p->name,"#")==0)
1262  {
1263  is_default_list=TRUE;
1264  rest=NULL;
1265  }
1266  else
1267  {
1268  h->next=NULL;
1269  }
1270  BOOLEAN res=iiAssign(p,h);
1271  if (is_default_list)
1272  {
1273  iiCurrArgs=NULL;
1274  }
1275  else
1276  {
1277  iiCurrArgs=rest;
1278  }
1279  h->CleanUp();
1281  return res;
1282 }
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:1165
leftv iiCurrArgs
Definition: ipshell.cc:79
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:1783
char* iiProcArgs ( char *  e,
BOOLEAN  withParenth 
)

Definition at line 128 of file iplib.cc.

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

115 {
116  char *s=buf+5;
117  while (*s==' ') s++;
118  e=s+1;
119  while ((*e>' ') && (*e!='(')) e++;
120  ct=*e;
121  *e='\0';
122  return s;
123 }
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 372 of file iplib.cc.

373 {
374  procinfov pi=NULL;
375  int old_echo=si_echo;
376  BOOLEAN err=FALSE;
377  char save_flags=0;
378 
379  /* init febase ======================================== */
380  /* we do not enter this case if filename != NULL !! */
381  if (pn!=NULL)
382  {
383  pi = IDPROC(pn);
384  if(pi!=NULL)
385  {
386  save_flags=pi->trace_flag;
387  if( pi->data.s.body==NULL )
388  {
389  iiGetLibProcBuffer(pi);
390  if (pi->data.s.body==NULL) return TRUE;
391  }
392 // omUpdateInfo();
393 // int m=om_Info.UsedBytes;
394 // Print("proc %s, mem=%d\n",IDID(pn),m);
395  }
396  }
397  else return TRUE;
398  /* generate argument list ======================================*/
399  if (v!=NULL)
400  {
402  memcpy(iiCurrArgs,v,sizeof(sleftv));
403  memset(v,0,sizeof(sleftv));
404  }
405  else
406  {
408  }
409  iiCurrProc=pn;
410  /* start interpreter ======================================*/
411  myynest++;
412  if (myynest > SI_MAX_NEST)
413  {
414  WerrorS("nesting too deep");
415  err=TRUE;
416  }
417  else
418  {
419  err=iiAllStart(pi,pi->data.s.body,BT_proc,pi->data.s.body_lineno-(v!=NULL));
420 
421 #ifdef USE_IILOCALRING
422 #if 0
423  if(procstack->cRing != iiLocalRing[myynest]) Print("iiMake_proc: 1 ring not saved procs:%x, iiLocal:%x\n",procstack->cRing, iiLocalRing[myynest]);
424 #endif
425  if (iiLocalRing[myynest-1] != currRing)
426  {
428  {
429  //idhdl hn;
430  const char *n;
431  const char *o;
432  idhdl nh=NULL, oh=NULL;
433  if (iiLocalRing[myynest-1]!=NULL)
434  oh=rFindHdl(iiLocalRing[myynest-1],NULL);
435  if (oh!=NULL) o=oh->id;
436  else o="none";
437  if (currRing!=NULL)
438  nh=rFindHdl(currRing,NULL);
439  if (nh!=NULL) n=nh->id;
440  else n="none";
441  Werror("ring change during procedure call: %s -> %s (level %d)",o,n,myynest);
443  err=TRUE;
444  }
445  currRing=iiLocalRing[myynest-1];
446  }
447  if ((currRing==NULL)
448  && (currRingHdl!=NULL))
450  else
451  if ((currRing!=NULL) &&
453  ||(IDLEV(currRingHdl)>=myynest-1)))
454  {
456  iiLocalRing[myynest-1]=NULL;
457  }
458 #else /* USE_IILOCALRING */
459  if (procstack->cRing != currRing)
460  {
461  //if (procstack->cRingHdl!=NULL)
462  //Print("procstack:%s,",IDID(procstack->cRingHdl));
463  //if (currRingHdl!=NULL)
464  //Print(" curr:%s\n",IDID(currRingHdl));
465  //Print("pr:%x, curr: %x\n",procstack->cRing,currRing);
467  {
468  //idhdl hn;
469  const char *n;
470  const char *o;
471  if (procstack->cRing!=NULL)
472  {
473  //PrintS("reset ring\n");
475  o=IDID(procstack->cRingHdl);
478  }
479  else o="none";
480  if (currRing!=NULL) n=IDID(currRingHdl);
481  else n="none";
482  if (currRing==NULL)
483  {
484  Werror("ring change during procedure call: %s -> %s (level %d)",o,n,myynest);
486  err=TRUE;
487  }
488  }
489  if (procstack->cRingHdl!=NULL)
490  {
492  }
493  else
495  }
496 #endif /* USE_IILOCALRING */
497  //Print("kill locals for %s (level %d)\n",IDID(pn),myynest);
498  killlocals(myynest);
499 #ifndef SING_NDEBUG
500  checkall();
501 #endif
502  //Print("end kill locals for %s (%d)\n",IDID(pn),myynest);
503  }
504  myynest--;
505  si_echo=old_echo;
506  if (pi!=NULL)
507  pi->trace_flag=save_flags;
508 // omUpdateInfo();
509 // int m=om_Info.UsedBytes;
510 // Print("exit %s, mem=%d\n",IDID(pn),m);
511  return err;
512 }
#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:517
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:80
#define SI_MAX_NEST
Definition: iplib.cc:33
int myynest
Definition: febase.cc:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
BOOLEAN RingDependend()
Definition: subexpr.cc:389
void checkall()
Definition: misc_ip.cc:1011
void killlocals(int v)
Definition: ipshell.cc:380
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:1577
#define IDLEV(a)
Definition: ipid.h:120
BOOLEAN iiAllStart(procinfov pi, char *p, feBufferTypes t, int l)
Definition: iplib.cc:312
#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:515
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:126
ring cRing
Definition: ipid.h:61
leftv iiCurrArgs
Definition: ipshell.cc:79
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
const char * id
Definition: idrec.h:39
void rSetHdl(idhdl h)
Definition: ipshell.cc:5030
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:211
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 957 of file ipshell.cc.

958 {
959  int len,reg,typ0;
960 
961  resolvente r=liFindRes(L,&len,&typ0);
962 
963  if (r==NULL)
964  return -2;
965  intvec *weights=NULL;
966  int add_row_shift=0;
967  intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
968  if (ww!=NULL)
969  {
970  weights=ivCopy(ww);
971  add_row_shift = ww->min_in();
972  (*weights) -= add_row_shift;
973  }
974  //Print("attr:%x\n",weights);
975 
976  intvec *dummy=syBetti(r,len,&reg,weights);
977  if (weights!=NULL) delete weights;
978  delete dummy;
979  omFreeSize((ADDRESS)r,len*sizeof(ideal));
980  return reg+1+add_row_shift;
981 }
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:126
void * ADDRESS
Definition: auxiliary.h:161
int min_in()
Definition: intvec.h:113
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:135
#define NULL
Definition: omList.c:10
ideal * resolvente
Definition: ideals.h: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 6373 of file ipshell.cc.

6374 {
6375  // assume a: level
6376  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6377  {
6378  if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6379  char assume_yylinebuf[80];
6380  strncpy(assume_yylinebuf,my_yylinebuf,79);
6381  int lev=(long)a->Data();
6382  int startlev=0;
6383  idhdl h=ggetid("assumeLevel");
6384  if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6385  if(lev <=startlev)
6386  {
6387  BOOLEAN bo=b->Eval();
6388  if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6389  if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6390  if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6391  }
6392  }
6393  b->CleanUp();
6394  a->CleanUp();
6395  return FALSE;
6396 }
int Eval()
Definition: subexpr.cc:1741
Definition: tok.h:98
#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:976
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:1118
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 244 of file iparith.cc.

245 {
246  for (int i=0;i<sArithBase.nCmdUsed;i++)
247  {
248  if (sArithBase.sCmds[i].tokval==op)
249  return sArithBase.sCmds[i].toktype;
250  }
251  return 0;
252 }
int nCmdUsed
number of commands used
Definition: iparith.cc:198
int i
Definition: cfEzgcd.cc:123
static SArithBase sArithBase
Base entry for arithmetic.
Definition: iparith.cc:208
cmdnames * sCmds
array of existing commands
Definition: iparith.cc:193
BOOLEAN iiTryLoadLib ( leftv  v,
const char *  id 
)

Definition at line 741 of file iplib.cc.

742 {
743  BOOLEAN LoadResult = TRUE;
744  char libnamebuf[128];
745  char *libname = (char *)omAlloc(strlen(id)+5);
746  const char *suffix[] = { "", ".lib", ".so", ".sl", NULL };
747  int i = 0;
748  // FILE *fp;
749  // package pack;
750  // idhdl packhdl;
751  lib_types LT;
752  for(i=0; suffix[i] != NULL; i++)
753  {
754  sprintf(libname, "%s%s", id, suffix[i]);
755  *libname = mytolower(*libname);
756  if((LT = type_of_LIB(libname, libnamebuf)) > LT_NOTFOUND)
757  {
758  char *s=omStrDup(libname);
759  #ifdef HAVE_DYNAMIC_LOADING
760  char libnamebuf[256];
761  #endif
762 
763  if (LT==LT_SINGULAR)
764  LoadResult = iiLibCmd(s, FALSE, FALSE,TRUE);
765  #ifdef HAVE_DYNAMIC_LOADING
766  else if ((LT==LT_ELF) || (LT==LT_HPUX))
767  LoadResult = load_modules(s,libnamebuf,FALSE);
768  #endif
769  else if (LT==LT_BUILTIN)
770  {
771  LoadResult=load_builtin(s,FALSE, iiGetBuiltinModInit(s));
772  }
773  if(!LoadResult )
774  {
775  v->name = iiConvName(libname);
776  break;
777  }
778  }
779  }
780  omFree(libname);
781  return LoadResult;
782 }
BOOLEAN load_builtin(const char *newlib, BOOLEAN autoexport, SModulFunc_t init)
Definition: iplib.cc:1137
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:803
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:1256
#define NULL
Definition: omList.c:10
SModulFunc_t iiGetBuiltinModInit(const char *libname)
Definition: iplib.cc:728
char libnamebuf[128]
Definition: libparse.cc:1096
char * iiConvName(const char *libname)
Definition: iplib.cc:1269
int BOOLEAN
Definition: auxiliary.h:131
BOOLEAN load_modules(const char *newlib, char *fullname, BOOLEAN autoexport)
Definition: iplib.cc:1040
#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 590 of file ipshell.cc.

591 {
592  sleftv vf;
593  if (iiConvert(v->Typ(),LINK_CMD,iiTestConvert(v->Typ(),LINK_CMD),v,&vf))
594  {
595  WerrorS("link expected");
596  return TRUE;
597  }
598  si_link l=(si_link)vf.Data();
599  if (vf.next == NULL)
600  {
601  WerrorS("write: need at least two arguments");
602  return TRUE;
603  }
604 
605  BOOLEAN b=slWrite(l,vf.next); /* iiConvert preserves next */
606  if (b)
607  {
608  const char *s;
609  if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
610  else s=sNoName;
611  Werror("cannot write to %s",s);
612  }
613  vf.CleanUp();
614  return b;
615 }
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
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, const struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:358
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:119
#define NULL
Definition: omList.c:10
void CleanUp(ring r=currRing)
Definition: subexpr.cc:321
void * Data()
Definition: subexpr.cc:1118
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 8822 of file iparith.cc.

8823 {
8824  int i;
8825  int an=1;
8826  int en=sArithBase.nLastIdentifier;
8827 
8828  loop
8829  //for(an=0; an<sArithBase.nCmdUsed; )
8830  {
8831  if(an>=en-1)
8832  {
8833  if (strcmp(n, sArithBase.sCmds[an].name) == 0)
8834  {
8835  i=an;
8836  break;
8837  }
8838  else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
8839  {
8840  i=en;
8841  break;
8842  }
8843  else
8844  {
8845  // -- blackbox extensions:
8846  // return 0;
8847  return blackboxIsCmd(n,tok);
8848  }
8849  }
8850  i=(an+en)/2;
8851  if (*n < *(sArithBase.sCmds[i].name))
8852  {
8853  en=i-1;
8854  }
8855  else if (*n > *(sArithBase.sCmds[i].name))
8856  {
8857  an=i+1;
8858  }
8859  else
8860  {
8861  int v=strcmp(n,sArithBase.sCmds[i].name);
8862  if(v<0)
8863  {
8864  en=i-1;
8865  }
8866  else if(v>0)
8867  {
8868  an=i+1;
8869  }
8870  else /*v==0*/
8871  {
8872  break;
8873  }
8874  }
8875  }
8877  tok=sArithBase.sCmds[i].tokval;
8878  if(sArithBase.sCmds[i].alias==2)
8879  {
8880  Warn("outdated identifier `%s` used - please change your code",
8881  sArithBase.sCmds[i].name);
8882  sArithBase.sCmds[i].alias=1;
8883  }
8884  #if 0
8885  if (currRingHdl==NULL)
8886  {
8887  #ifdef SIQ
8888  if (siq<=0)
8889  {
8890  #endif
8891  if ((tok>=BEGIN_RING) && (tok<=END_RING))
8892  {
8893  WerrorS("no ring active");
8894  return 0;
8895  }
8896  #ifdef SIQ
8897  }
8898  #endif
8899  }
8900  #endif
8901  if (!expected_parms)
8902  {
8903  switch (tok)
8904  {
8905  case IDEAL_CMD:
8906  case INT_CMD:
8907  case INTVEC_CMD:
8908  case MAP_CMD:
8909  case MATRIX_CMD:
8910  case MODUL_CMD:
8911  case POLY_CMD:
8912  case PROC_CMD:
8913  case RING_CMD:
8914  case STRING_CMD:
8915  cmdtok = tok;
8916  break;
8917  }
8918  }
8919  return sArithBase.sCmds[i].toktype;
8920 }
Definition: tok.h:98
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:200
idhdl currRingHdl
Definition: ipid.cc:65
int i
Definition: cfEzgcd.cc:123
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:208
cmdnames * sCmds
array of existing commands
Definition: iparith.cc:193
const char * lastreserved
Definition: ipshell.cc:81
#define Warn
Definition: emacs.cc:80
BOOLEAN jjBETTI ( leftv  res,
leftv  v 
)

Definition at line 896 of file ipshell.cc.

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

Definition at line 930 of file ipshell.cc.

931 {
932  resolvente r;
933  int len;
934  int reg,typ0;
935  lists l=(lists)u->Data();
936 
937  intvec *weights=NULL;
938  int add_row_shift=0;
939  intvec *ww=(intvec *)atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
940  if (ww!=NULL)
941  {
942  weights=ivCopy(ww);
943  add_row_shift = ww->min_in();
944  (*weights) -= add_row_shift;
945  }
946  //Print("attr:%x\n",weights);
947 
948  r=liFindRes(l,&len,&typ0);
949  if (r==NULL) return TRUE;
950  res->data=(char *)syBetti(r,len,&reg,weights,(int)(long)v->Data());
951  omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
952  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
953  if (weights!=NULL) delete weights;
954  return FALSE;
955 }
sleftv * m
Definition: lists.h:45
void atSet(idhdl root, const char *name, void *data, int typ)
Definition: attrib.cc:156
Definition: tok.h:98
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:126
#define TRUE
Definition: auxiliary.h:144
void * ADDRESS
Definition: auxiliary.h:161
int min_in()
Definition: intvec.h:113
void * data
Definition: subexpr.h:89
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:135
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
void * Data()
Definition: subexpr.cc:1118
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 909 of file ipshell.cc.

910 {
912  l->Init(1);
913  l->m[0].rtyp=u->Typ();
914  l->m[0].data=u->Data();
915  attr *a=u->Attribute();
916  if (a!=NULL)
917  l->m[0].attribute=*a;
918  sleftv tmp2;
919  memset(&tmp2,0,sizeof(tmp2));
920  tmp2.rtyp=LIST_CMD;
921  tmp2.data=(void *)l;
922  BOOLEAN r=jjBETTI2(res,&tmp2,v);
923  l->m[0].data=NULL;
924  l->m[0].attribute=NULL;
925  l->m[0].rtyp=DEF_CMD;
926  l->Clean();
927  return r;
928 }
#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:1373
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:930
int Typ()
Definition: subexpr.cc:976
void * data
Definition: subexpr.h:89
const ring r
Definition: syzextra.cc:208
Definition: tok.h:61
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:1118
Definition: tok.h:120
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 3262 of file ipshell.cc.

3263 {
3264  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3265  return (res->data==NULL);
3266 }
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:1118
BOOLEAN jjIMPORTFROM ( leftv  res,
leftv  u,
leftv  v 
)

Definition at line 2175 of file ipassign.cc.

2176 {
2177  //Print("importfrom %s::%s ->.\n",v->Name(),u->Name() );
2178  assume(u->Typ()==PACKAGE_CMD);
2179  char *vn=(char *)v->Name();
2180  idhdl h=((package)(u->Data()))->idroot->get(vn /*v->Name()*/, myynest);
2181  if (h!=NULL)
2182  {
2183  //check for existence
2184  if (((package)(u->Data()))==basePack)
2185  {
2186  WarnS("source and destination packages are identical");
2187  return FALSE;
2188  }
2189  idhdl t=basePack->idroot->get(vn /*v->Name()*/, myynest);
2190  if (t!=NULL)
2191  {
2192  Warn("redefining `%s`",vn);
2193  killhdl(t);
2194  }
2195  sleftv tmp_expr;
2196  if (iiDeclCommand(&tmp_expr,v,myynest,DEF_CMD,&IDROOT)) return TRUE;
2197  sleftv h_expr;
2198  memset(&h_expr,0,sizeof(h_expr));
2199  h_expr.rtyp=IDHDL;
2200  h_expr.data=h;
2201  h_expr.name=vn;
2202  return iiAssign(&tmp_expr,&h_expr);
2203  }
2204  else
2205  {
2206  Werror("`%s` not found in `%s`",v->Name(), u->Name());
2207  return TRUE;
2208  }
2209  return FALSE;
2210 }
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:976
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:61
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:1123
#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:1118
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:1783
#define Warn
Definition: emacs.cc:80
BOOLEAN jjLIST_PL ( leftv  res,
leftv  v 
)

Definition at line 7495 of file iparith.cc.

7496 {
7497  int sl=0;
7498  if (v!=NULL) sl = v->listLength();
7499  lists L;
7500  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7501  {
7502  int add_row_shift = 0;
7503  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7504  if (weights!=NULL) add_row_shift=weights->min_in();
7505  L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7506  }
7507  else
7508  {
7510  leftv h=NULL;
7511  int i;
7512  int rt;
7513 
7514  L->Init(sl);
7515  for (i=0;i<sl;i++)
7516  {
7517  if (h!=NULL)
7518  { /* e.g. not in the first step:
7519  * h is the pointer to the old sleftv,
7520  * v is the pointer to the next sleftv
7521  * (in this moment) */
7522  h->next=v;
7523  }
7524  h=v;
7525  v=v->next;
7526  h->next=NULL;
7527  rt=h->Typ();
7528  if (rt==0)
7529  {
7530  L->Clean();
7531  Werror("`%s` is undefined",h->Fullname());
7532  return TRUE;
7533  }
7534  if ((rt==RING_CMD)||(rt==QRING_CMD))
7535  {
7536  L->m[i].rtyp=rt; L->m[i].data=h->Data();
7537  ((ring)L->m[i].data)->ref++;
7538  }
7539  else
7540  L->m[i].Copy(h);
7541  }
7542  }
7543  res->data=(char *)L;
7544  return FALSE;
7545 }
#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:3097
int listLength()
Definition: subexpr.cc:61
#define TRUE
Definition: auxiliary.h:144
int min_in()
Definition: intvec.h:113
int Typ()
Definition: subexpr.cc:976
const char * Fullname()
Definition: subexpr.h:126
void * data
Definition: subexpr.h:89
Definition: intvec.h:14
void Copy(leftv e)
Definition: subexpr.cc:657
int i
Definition: cfEzgcd.cc:123
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:1118
omBin slists_bin
Definition: lists.cc:23
Definition: tok.h:159
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 5345 of file iparith.cc.

5346 {
5347  char libnamebuf[256];
5348  lib_types LT = type_of_LIB(s, libnamebuf);
5349 
5350 #ifdef HAVE_DYNAMIC_LOADING
5351  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5352 #endif /* HAVE_DYNAMIC_LOADING */
5353  switch(LT)
5354  {
5355  default:
5356  case LT_NONE:
5357  Werror("%s: unknown type", s);
5358  break;
5359  case LT_NOTFOUND:
5360  Werror("cannot open %s", s);
5361  break;
5362 
5363  case LT_SINGULAR:
5364  {
5365  char *plib = iiConvName(s);
5366  idhdl pl = IDROOT->get(plib,0);
5367  if (pl==NULL)
5368  {
5369  pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5370  IDPACKAGE(pl)->language = LANG_SINGULAR;
5371  IDPACKAGE(pl)->libname=omStrDup(plib);
5372  }
5373  else if (IDTYP(pl)!=PACKAGE_CMD)
5374  {
5375  Werror("can not create package `%s`",plib);
5376  omFree(plib);
5377  return TRUE;
5378  }
5379  package savepack=currPack;
5380  currPack=IDPACKAGE(pl);
5381  IDPACKAGE(pl)->loaded=TRUE;
5382  char libnamebuf[256];
5383  FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5384  BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5385  currPack=savepack;
5386  IDPACKAGE(pl)->loaded=(!bo);
5387  return bo;
5388  }
5389  case LT_BUILTIN:
5390  SModulFunc_t iiGetBuiltinModInit(const char*);
5391  return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5392  case LT_MACH_O:
5393  case LT_ELF:
5394  case LT_HPUX:
5395 #ifdef HAVE_DYNAMIC_LOADING
5396  return load_modules(s, libnamebuf, autoexport);
5397 #else /* HAVE_DYNAMIC_LOADING */
5398  WerrorS("Dynamic modules are not supported by this version of Singular");
5399  break;
5400 #endif /* HAVE_DYNAMIC_LOADING */
5401  }
5402  return TRUE;
5403 }
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:1137
#define NULL
Definition: omList.c:10
SModulFunc_t iiGetBuiltinModInit(const char *libname)
Definition: iplib.cc:728
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:892
char * iiConvName(const char *libname)
Definition: iplib.cc:1269
int BOOLEAN
Definition: auxiliary.h:131
BOOLEAN load_modules(const char *newlib, char *fullname, BOOLEAN autoexport)
Definition: iplib.cc:1040
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 5409 of file iparith.cc.

5410 {
5411  void (*WerrorS_save)(const char *s) = WerrorS_callback;
5414  BOOLEAN bo=jjLOAD(s,TRUE);
5415  if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
5416  Print("loading of >%s< failed\n",s);
5417  WerrorS_callback=WerrorS_save;
5418  errorreported=0;
5419  return FALSE;
5420 }
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:5404
#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:5345
static void WerrorS_dummy(const char *)
Definition: iparith.cc:5405
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 875 of file ipshell.cc.

876 {
877  int len=0;
878  int typ0;
879  lists L=(lists)v->Data();
880  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
881  int add_row_shift = 0;
882  if (weights==NULL)
883  weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
884  if (weights!=NULL) add_row_shift=weights->min_in();
885  resolvente rr=liFindRes(L,&len,&typ0);
886  if (rr==NULL) return TRUE;
887  resolvente r=iiCopyRes(rr,len);
888 
889  syMinimizeResolvente(r,len,0);
890  omFreeSize((ADDRESS)rr,len*sizeof(ideal));
891  len++;
892  res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
893  return FALSE;
894 }
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:113
void * data
Definition: subexpr.h:89
const ring r
Definition: syzextra.cc:208
Definition: intvec.h:14
static resolvente iiCopyRes(resolvente r, int l)
Definition: ipshell.cc:865
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:1118
ideal * resolvente
Definition: ideals.h:20
BOOLEAN jjRESULTANT ( leftv  res,
leftv  u,
leftv  v,
leftv  w 
)

Definition at line 3255 of file ipshell.cc.

3256 {
3257  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3258  (poly)w->CopyD(), currRing);
3259  return errorreported;
3260 }
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  #if __FLINT_RELEASE >= 20500
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:971
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:1737
intvec * Mfpertvector(ideal G, intvec *ivtarget)
Definition: walk.cc:1520
Definition: tok.h:98
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:5852
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:778
#define FALSE
Definition: auxiliary.h:140
return P p
Definition: myNF.cc:203
intvec * MivWeightOrderlp(intvec *ivstart)
Definition: walk.cc:1444
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4426
Matrices of numbers.
Definition: bigintmat.h:51
#define SINGULAR_VERSION
Definition: mod2.h:94
static char * feResource(feResourceConfig config, int warn)
Definition: feResource.cc:258
lists pcvPMulL(poly p, lists l1)
Definition: pcv.cc:56
static FORCE_INLINE number n_Init(long i, const coeffs r)
a number representing i in the given coeff field/ring r
Definition: coeffs.h: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:4048
#define TRUE
Definition: auxiliary.h:144
int MivSame(intvec *u, intvec *v)
Definition: walk.cc:901
intvec * MivWeightOrderdp(intvec *ivstart)
Definition: walk.cc:1464
BOOLEAN spmulProc(leftv result, leftv first, leftv second)
Definition: ipshell.cc:4385
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:976
const char * Name()
Definition: subexpr.h:121
matrix evSwap(matrix M, int i, int j)
Definition: eigenval.cc:25
Definition: idrec.h:34
#define ivTest(v)
Definition: intvec.h:149
idhdl get(const char *s, int lev)
Definition: ipid.cc:91
intvec * MPertVectorslp(ideal G, intvec *ivtarget, int pdeg)
Definition: walk.cc:1307
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:7927
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:513
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:9474
#define FLAG_TWOSTD
Definition: ipid.h:109
Definition: intvec.h:14
int pcvDim(int d0, int d1)
Definition: pcv.cc:361
void newstructShow(newstruct_desc d)
Definition: newstruct.cc:829
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:361
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:922
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:5206
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
FILE * f
Definition: checklibs.c:7
int i
Definition: cfEzgcd.cc:123
intvec * Mivperttarget(ideal G, int ndeg)
BOOLEAN spectrumfProc(leftv result, leftv first)
Definition: ipshell.cc:4099
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
intvec * MPertVectors(ideal G, intvec *ivtarget, int pdeg)
Definition: walk.cc:1096
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:491
intvec * Mivdp(int nR)
Definition: walk.cc:1015
#define BIMATELEM(M, I, J)
Definition: bigintmat.h:134
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:146
int & cols()
Definition: matpol.h:25
Definition: tok.h:119
lists evEigenvals(matrix M)
Definition: eigenval_ip.cc:118
static BOOLEAN rField_is_Ring(const ring r)
Definition: ring.h:434
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
BOOLEAN semicProc(leftv res, leftv u, leftv v)
Definition: ipshell.cc:4466
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:8292
#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:6492
coeffs basecoeffs() const
Definition: bigintmat.h:147
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:488
#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:1425
int rtyp
Definition: subexpr.h:92
#define TEST_FOR(A)
void * Data()
Definition: subexpr.cc:1118
ideal MAltwalk2(ideal Go, intvec *curr_weight, intvec *target_weight)
Definition: walk.cc:4239
ideal Mrwalk(ideal Go, intvec *orig_M, intvec *target_M, int weight_rad, int pert_deg, int reduction, int printout)
Definition: walk.cc:5507
poly pcvP2CV(poly p, int d0, int d1)
Definition: pcv.cc:246
Definition: tok.h:120
omBin slists_bin
Definition: lists.cc:23
BOOLEAN spaddProc(leftv result, leftv first, leftv second)
Definition: ipshell.cc:4343
intvec * MivUnit(int nV)
Definition: walk.cc:1504
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:1793
#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:6287
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:769
ideal Mfrwalk(ideal G, intvec *ivstart, intvec *ivtarget, int weight_rad, int reduction, int printout)
Definition: walk.cc:8108
static Poly * h
Definition: janet.cc:978
#define IMATELEM(M, I, J)
Definition: intvec.h:77
#define NONE
Definition: tok.h:220
void feReInitResources()
Definition: feResource.cc:207
void Werror(const char *fmt,...)
Definition: reporter.cc:199
intvec * MivMatrixOrderlp(int nV)
Definition: walk.cc:1409
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:1030
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:2579
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 6246 of file ipshell.cc.

6247 {
6248  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6249  ideal I=(ideal)u->Data();
6250  int i;
6251  int n=0;
6252  for(i=I->nrows*I->ncols-1;i>=0;i--)
6253  {
6254  int n0=pGetVariables(I->m[i],e);
6255  if (n0>n) n=n0;
6256  }
6257  jjINT_S_TO_ID(n,e,res);
6258  return FALSE;
6259 }
#define FALSE
Definition: auxiliary.h:140
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:537
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6216
#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:1118
#define omAlloc0(size)
Definition: omAllocDecl.h:211
BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6238 of file ipshell.cc.

6239 {
6240  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6241  int n=pGetVariables((poly)u->Data(),e);
6242  jjINT_S_TO_ID(n,e,res);
6243  return FALSE;
6244 }
#define FALSE
Definition: auxiliary.h:140
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:537
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6216
#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:1118
polyrec * poly
Definition: hilb.h:10
#define omAlloc0(size)
Definition: omAllocDecl.h:211
void killlocals ( int  v)

Definition at line 380 of file ipshell.cc.

381 {
382  BOOLEAN changed=FALSE;
383  idhdl sh=currRingHdl;
384  ring cr=currRing;
385  if (sh!=NULL) changed=((IDLEV(sh)<v) || (IDRING(sh)->ref>0));
386  //if (changed) Print("currRing=%s(%x), lev=%d,ref=%d\n",IDID(sh),IDRING(sh),IDLEV(sh),IDRING(sh)->ref);
387 
388  killlocals_rec(&(basePack->idroot),v,currRing);
389 
391  {
392  int t=iiRETURNEXPR.Typ();
393  if ((/*iiRETURNEXPR.Typ()*/ t==RING_CMD)
394  || (/*iiRETURNEXPR.Typ()*/ t==QRING_CMD))
395  {
397  if (((ring)h->data)->idroot!=NULL)
398  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
399  }
400  else if (/*iiRETURNEXPR.Typ()*/ t==LIST_CMD)
401  {
402  leftv h=&iiRETURNEXPR;
403  changed |=killlocals_list(v,(lists)h->data);
404  }
405  }
406  if (changed)
407  {
409  if (currRingHdl==NULL)
410  currRing=NULL;
411  else if(cr!=currRing)
412  rChangeCurrRing(cr);
413  }
414 
415  if (myynest<=1) iiNoKeepRing=TRUE;
416  //Print("end killlocals >= %d\n",v);
417  //listall();
418 }
int iiRETURNEXPR_len
Definition: iplib.cc:518
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:517
#define TRUE
Definition: auxiliary.h:144
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:323
int Typ()
Definition: subexpr.cc:976
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:360
static BOOLEAN iiNoKeepRing
Definition: ipshell.cc:83
idhdl currRingHdl
Definition: ipid.cc:65
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1577
#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:120
Definition: tok.h:159
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:288
BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3238 of file ipshell.cc.

3239 {
3240  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3241  if (res->data==NULL)
3242  res->data=(char *)new intvec(rVar(currRing));
3243  return FALSE;
3244 }
#define FALSE
Definition: auxiliary.h:140
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:537
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:14
#define NULL
Definition: omList.c:10
void * Data()
Definition: subexpr.cc:1118
BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3216 of file ipshell.cc.

3217 {
3218  ideal F=(ideal)id->Data();
3219  intvec * iv = new intvec(rVar(currRing));
3220  polyset s;
3221  int sl, n, i;
3222  int *x;
3223 
3224  res->data=(char *)iv;
3225  s = F->m;
3226  sl = IDELEMS(F) - 1;
3227  n = rVar(currRing);
3228  double wNsqr = (double)2.0 / (double)n;
3230  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3231  wCall(s, sl, x, wNsqr, currRing);
3232  for (i = n; i!=0; i--)
3233  (*iv)[i-1] = x[i + n + 1];
3234  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3235  return FALSE;
3236 }
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:537
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:14
double(* wFunctional)(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight.cc:28
int i
Definition: cfEzgcd.cc:123
#define IDELEMS(i)
Definition: simpleideals.h:24
poly * polyset
Definition: hutil.h:15
void wCall(poly *s, int sl, int *x, double wNsqr, const ring R)
Definition: weight.cc:116
Variable x
Definition: cfModGcd.cc:4023
void * Data()
Definition: subexpr.cc:1118
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 420 of file ipshell.cc.

421 {
422  package savePack=currPack;
423  idhdl h,start;
424  BOOLEAN all = typ<0;
425  BOOLEAN really_all=FALSE;
426 
427  if ( typ==0 )
428  {
429  if (strcmp(what,"all")==0)
430  {
431  if (currPack!=basePack)
432  list_cmd(-1,NULL,prefix,iterate,fullname); // list current package
433  really_all=TRUE;
434  h=basePack->idroot;
435  }
436  else
437  {
438  h = ggetid(what);
439  if (h!=NULL)
440  {
441  if (iterate) list1(prefix,h,TRUE,fullname);
442  if (IDTYP(h)==ALIAS_CMD) PrintS("A");
443  if ((IDTYP(h)==RING_CMD)
444  || (IDTYP(h)==QRING_CMD)
445  //|| (IDTYP(h)==PACKE_CMD)
446  )
447  {
448  h=IDRING(h)->idroot;
449  }
450  else if(IDTYP(h)==PACKAGE_CMD)
451  {
452  currPack=IDPACKAGE(h);
453  //Print("list_cmd:package\n");
454  all=TRUE;typ=PROC_CMD;fullname=TRUE;really_all=TRUE;
455  h=IDPACKAGE(h)->idroot;
456  }
457  else
458  {
459  currPack=savePack;
460  return;
461  }
462  }
463  else
464  {
465  Werror("%s is undefined",what);
466  currPack=savePack;
467  return;
468  }
469  }
470  all=TRUE;
471  }
472  else if (RingDependend(typ))
473  {
474  h = currRing->idroot;
475  }
476  else
477  h = IDROOT;
478  start=h;
479  while (h!=NULL)
480  {
481  if ((all
482  && (IDTYP(h)!=PROC_CMD)
483  &&(IDTYP(h)!=PACKAGE_CMD)
484  #ifdef SINGULAR_4_1
485  &&(IDTYP(h)!=CRING_CMD)
486  #endif
487  )
488  || (typ == IDTYP(h))
489  #ifdef SINGULAR_4_1
490  || ((IDTYP(h)==CRING_CMD) && (typ==RING_CMD))
491  #else
492  || ((IDTYP(h)==QRING_CMD) && (typ==RING_CMD))
493  #endif
494  )
495  {
496  list1(prefix,h,start==currRingHdl, fullname);
497  if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
498  && (really_all || (all && (h==currRingHdl)))
499  && ((IDLEV(h)==0)||(IDLEV(h)==myynest)))
500  {
501  list_cmd(0,IDID(h),"// ",FALSE);
502  }
503  if (IDTYP(h)==PACKAGE_CMD && really_all)
504  {
505  package save_p=currPack;
506  currPack=IDPACKAGE(h);
507  list_cmd(0,IDID(h),"// ",FALSE);
508  currPack=save_p;
509  }
510  }
511  h = IDNEXT(h);
512  }
513  currPack=savePack;
514 }
#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:148
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:59
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:420
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:159
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 4478 of file ipshell.cc.

4479 {
4480  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4481  return FALSE;
4482 }
#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:1118
BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4484 of file ipshell.cc.

4485 {
4486  if ( !(rField_is_long_R(currRing)) )
4487  {
4488  WerrorS("Ground field not implemented!");
4489  return TRUE;
4490  }
4491 
4492  simplex * LP;
4493  matrix m;
4494 
4495  leftv v= args;
4496  if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4497  return TRUE;
4498  else
4499  m= (matrix)(v->CopyD());
4500 
4501  LP = new simplex(MATROWS(m),MATCOLS(m));
4502  LP->mapFromMatrix(m);
4503 
4504  v= v->next;
4505  if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4506  return TRUE;
4507  else
4508  LP->m= (int)(long)(v->Data());
4509 
4510  v= v->next;
4511  if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4512  return TRUE;
4513  else
4514  LP->n= (int)(long)(v->Data());
4515 
4516  v= v->next;
4517  if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4518  return TRUE;
4519  else
4520  LP->m1= (int)(long)(v->Data());
4521 
4522  v= v->next;
4523  if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4524  return TRUE;
4525  else
4526  LP->m2= (int)(long)(v->Data());
4527 
4528  v= v->next;
4529  if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4530  return TRUE;
4531  else
4532  LP->m3= (int)(long)(v->Data());
4533 
4534 #ifdef mprDEBUG_PROT
4535  Print("m (constraints) %d\n",LP->m);
4536  Print("n (columns) %d\n",LP->n);
4537  Print("m1 (<=) %d\n",LP->m1);
4538  Print("m2 (>=) %d\n",LP->m2);
4539  Print("m3 (==) %d\n",LP->m3);
4540 #endif
4541 
4542  LP->compute();
4543 
4544  lists lres= (lists)omAlloc( sizeof(slists) );
4545  lres->Init( 6 );
4546 
4547  lres->m[0].rtyp= MATRIX_CMD; // output matrix
4548  lres->m[0].data=(void*)LP->mapToMatrix(m);
4549 
4550  lres->m[1].rtyp= INT_CMD; // found a solution?
4551  lres->m[1].data=(void*)(long)LP->icase;
4552 
4553  lres->m[2].rtyp= INTVEC_CMD;
4554  lres->m[2].data=(void*)LP->posvToIV();
4555 
4556  lres->m[3].rtyp= INTVEC_CMD;
4557  lres->m[3].data=(void*)LP->zrovToIV();
4558 
4559  lres->m[4].rtyp= INT_CMD;
4560  lres->m[4].data=(void*)(long)LP->m;
4561 
4562  lres->m[5].rtyp= INT_CMD;
4563  lres->m[5].data=(void*)(long)LP->n;
4564 
4565  res->data= (void*)lres;
4566 
4567  return FALSE;
4568 }
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:98
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:976
#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
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:488
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1118
#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 2985 of file ipshell.cc.

2986 {
2987  int i,j;
2988  matrix result;
2989  ideal id=(ideal)a->Data();
2990 
2991  result =mpNew(IDELEMS(id),rVar(currRing));
2992  for (i=1; i<=IDELEMS(id); i++)
2993  {
2994  for (j=1; j<=rVar(currRing); j++)
2995  {
2996  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
2997  }
2998  }
2999  res->data=(char *)result;
3000  return FALSE;
3001 }
#define FALSE
Definition: auxiliary.h:140
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:537
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:1118
#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 3007 of file ipshell.cc.

3008 {
3009  int n=(int)(long)b->Data();
3010  int d=(int)(long)c->Data();
3011  int k,l,sign,row,col;
3012  matrix result;
3013  ideal temp;
3014  BOOLEAN bo;
3015  poly p;
3016 
3017  if ((d>n) || (d<1) || (n<1))
3018  {
3019  res->data=(char *)mpNew(1,1);
3020  return FALSE;
3021  }
3022  int *choise = (int*)omAlloc(d*sizeof(int));
3023  if (id==NULL)
3024  temp=idMaxIdeal(1);
3025  else
3026  temp=(ideal)id->Data();
3027 
3028  k = binom(n,d);
3029  l = k*d;
3030  l /= n-d+1;
3031  result =mpNew(l,k);
3032  col = 1;
3033  idInitChoise(d,1,n,&bo,choise);
3034  while (!bo)
3035  {
3036  sign = 1;
3037  for (l=1;l<=d;l++)
3038  {
3039  if (choise[l-1]<=IDELEMS(temp))
3040  {
3041  p = pCopy(temp->m[choise[l-1]-1]);
3042  if (sign == -1) p = pNeg(p);
3043  sign *= -1;
3044  row = idGetNumberOfChoise(l-1,d,1,n,choise);
3045  MATELEM(result,row,col) = p;
3046  }
3047  }
3048  col++;
3049  idGetNextChoise(d,n,&bo,choise);
3050  }
3051  if (id==NULL) idDelete(&temp);
3052 
3053  res->data=(char *)result;
3054  return FALSE;
3055 }
#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:1118
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 4593 of file ipshell.cc.

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

4571 {
4572  ideal gls = (ideal)(arg1->Data());
4573  int imtype= (int)(long)arg2->Data();
4574 
4575  uResultant::resMatType mtype= determineMType( imtype );
4576 
4577  // check input ideal ( = polynomial system )
4578  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4579  {
4580  return TRUE;
4581  }
4582 
4583  uResultant *resMat= new uResultant( gls, mtype, false );
4584  if (resMat!=NULL)
4585  {
4586  res->rtyp = MODUL_CMD;
4587  res->data= (void*)resMat->accessResMat()->getMatrix();
4588  if (!errorreported) delete resMat;
4589  }
4590  return errorreported;
4591 }
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:1118
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 4826 of file ipshell.cc.

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

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

6262 {
6263  Print(" %s (",n);
6264  switch (p->language)
6265  {
6266  case LANG_SINGULAR: PrintS("S"); break;
6267  case LANG_C: PrintS("C"); break;
6268  case LANG_TOP: PrintS("T"); break;
6269  case LANG_NONE: PrintS("N"); break;
6270  default: PrintS("U");
6271  }
6272  if(p->libname!=NULL)
6273  Print(",%s", p->libname);
6274  PrintS(")");
6275 }
#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
lists rDecompose ( const ring  r)

Definition at line 2030 of file ipshell.cc.

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

Definition at line 1824 of file ipshell.cc.

1825 {
1826  assume( C != NULL );
1827 
1828  // sanity check: require currRing==r for rings with polynomial data
1829  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1830  {
1831  WerrorS("ring with polynomial data must be the base ring or compatible");
1832  return TRUE;
1833  }
1834  if (nCoeff_is_numeric(C))
1835  {
1836  rDecomposeC_41(res,C);
1837  }
1838 #ifdef HAVE_RINGS
1839  else if (nCoeff_is_Ring(C))
1840  {
1841  rDecomposeRing_41(res,C);
1842  }
1843 #endif
1844  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1845  {
1846  rDecomposeCF(res, C->extRing, currRing);
1847  }
1848  else if(nCoeff_is_GF(C))
1849  {
1851  Lc->Init(4);
1852  // char:
1853  Lc->m[0].rtyp=INT_CMD;
1854  Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1855  // var:
1857  Lv->Init(1);
1858  Lv->m[0].rtyp=STRING_CMD;
1859  Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1860  Lc->m[1].rtyp=LIST_CMD;
1861  Lc->m[1].data=(void*)Lv;
1862  // ord:
1864  Lo->Init(1);
1866  Loo->Init(2);
1867  Loo->m[0].rtyp=STRING_CMD;
1868  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1869 
1870  intvec *iv=new intvec(1); (*iv)[0]=1;
1871  Loo->m[1].rtyp=INTVEC_CMD;
1872  Loo->m[1].data=(void *)iv;
1873 
1874  Lo->m[0].rtyp=LIST_CMD;
1875  Lo->m[0].data=(void*)Loo;
1876 
1877  Lc->m[2].rtyp=LIST_CMD;
1878  Lc->m[2].data=(void*)Lo;
1879  // q-ideal:
1880  Lc->m[3].rtyp=IDEAL_CMD;
1881  Lc->m[3].data=(void *)idInit(1,1);
1882  // ----------------------
1883  res->rtyp=LIST_CMD;
1884  res->data=(void*)Lc;
1885  }
1886  else
1887  {
1888  res->rtyp=INT_CMD;
1889  res->data=(void *)(long)C->ch;
1890  }
1891  // ----------------------------------------
1892  return FALSE;
1893 }
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:801
sleftv * m
Definition: lists.h:45
static FORCE_INLINE BOOLEAN nCoeff_is_numeric(const coeffs r)
Definition: coeffs.h:835
Definition: tok.h:98
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:758
void rDecomposeRing_41(leftv h, const coeffs C)
Definition: ipshell.cc:1764
void * data
Definition: subexpr.h:89
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1603
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:913
Definition: intvec.h:14
#define assume(x)
Definition: mod2.h:405
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:88
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition: coeffs.h:842
static void rDecomposeC_41(leftv h, const coeffs C)
Definition: ipshell.cc:1692
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:120
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263
lists rDecompose_list_cf ( const ring  r)

Definition at line 1897 of file ipshell.cc.

1898 {
1899  assume( r != NULL );
1900  const coeffs C = r->cf;
1901  assume( C != NULL );
1902 
1903  // sanity check: require currRing==r for rings with polynomial data
1904  if ( (r!=currRing) && (
1905  (nCoeff_is_algExt(C) && (C != currRing->cf))
1906  || (r->qideal != NULL)
1907 #ifdef HAVE_PLURAL
1908  || (rIsPluralRing(r))
1909 #endif
1910  )
1911  )
1912  {
1913  WerrorS("ring with polynomial data must be the base ring or compatible");
1914  return NULL;
1915  }
1916  // 0: char/ cf - ring
1917  // 1: list (var)
1918  // 2: list (ord)
1919  // 3: qideal
1920  // possibly:
1921  // 4: C
1922  // 5: D
1924  if (rIsPluralRing(r))
1925  L->Init(6);
1926  else
1927  L->Init(4);
1928  // ----------------------------------------
1929  // 0: char/ cf - ring
1930  L->m[0].rtyp=CRING_CMD;
1931  L->m[0].data=(char*)r->cf; r->cf->ref++;
1932  // ----------------------------------------
1933  // 1: list (var)
1935  LL->Init(r->N);
1936  int i;
1937  for(i=0; i<r->N; i++)
1938  {
1939  LL->m[i].rtyp=STRING_CMD;
1940  LL->m[i].data=(void *)omStrDup(r->names[i]);
1941  }
1942  L->m[1].rtyp=LIST_CMD;
1943  L->m[1].data=(void *)LL;
1944  // ----------------------------------------
1945  // 2: list (ord)
1947  i=rBlocks(r)-1;
1948  LL->Init(i);
1949  i--;
1950  lists LLL;
1951  for(; i>=0; i--)
1952  {
1953  intvec *iv;
1954  int j;
1955  LL->m[i].rtyp=LIST_CMD;
1957  LLL->Init(2);
1958  LLL->m[0].rtyp=STRING_CMD;
1959  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
1960 
1961  if(r->order[i] == ringorder_IS) // || r->order[i] == ringorder_s || r->order[i] == ringorder_S)
1962  {
1963  assume( r->block0[i] == r->block1[i] );
1964  const int s = r->block0[i];
1965  assume( -2 < s && s < 2);
1966 
1967  iv=new intvec(1);
1968  (*iv)[0] = s;
1969  }
1970  else if (r->block1[i]-r->block0[i] >=0 )
1971  {
1972  int bl=j=r->block1[i]-r->block0[i];
1973  if (r->order[i]==ringorder_M)
1974  {
1975  j=(j+1)*(j+1)-1;
1976  bl=j+1;
1977  }
1978  else if (r->order[i]==ringorder_am)
1979  {
1980  j+=r->wvhdl[i][bl+1];
1981  }
1982  iv=new intvec(j+1);
1983  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
1984  {
1985  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
1986  }
1987  else switch (r->order[i])
1988  {
1989  case ringorder_dp:
1990  case ringorder_Dp:
1991  case ringorder_ds:
1992  case ringorder_Ds:
1993  case ringorder_lp:
1994  for(;j>=0; j--) (*iv)[j]=1;
1995  break;
1996  default: /* do nothing */;
1997  }
1998  }
1999  else
2000  {
2001  iv=new intvec(1);
2002  }
2003  LLL->m[1].rtyp=INTVEC_CMD;
2004  LLL->m[1].data=(void *)iv;
2005  LL->m[i].data=(void *)LLL;
2006  }
2007  L->m[2].rtyp=LIST_CMD;
2008  L->m[2].data=(void *)LL;
2009  // ----------------------------------------
2010  // 3: qideal
2011  L->m[3].rtyp=IDEAL_CMD;
2012  if (r->qideal==NULL)
2013  L->m[3].data=(void *)idInit(1,1);
2014  else
2015  L->m[3].data=(void *)idCopy(r->qideal);
2016  // ----------------------------------------
2017 #ifdef HAVE_PLURAL // NC! in rDecompose
2018  if (rIsPluralRing(r))
2019  {
2020  L->m[4].rtyp=MATRIX_CMD;
2021  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2022  L->m[5].rtyp=MATRIX_CMD;
2023  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2024  }
2025 #endif
2026  return L;
2027 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
sleftv * m
Definition: lists.h:45
Definition: lists.h:22
void WerrorS(const char *s)
Definition: feFopen.cc:24
void * data
Definition: subexpr.h:89
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
static int rBlocks(ring r)
Definition: ring.h:513
Definition: tok.h:59
const ring r
Definition: syzextra.cc:208
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:913
Definition: intvec.h:14
int j
Definition: myNF.cc:70
#define assume(x)
Definition: mod2.h:405
static BOOLEAN rIsPluralRing(const ring r)
we must always have this test!
Definition: ring.h:361
The main handler for Singular numbers which are suitable for Singular polynomials.
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:88
int i
Definition: cfEzgcd.cc:123
Induced (Schreyer) ordering.
Definition: ring.h:692
ideal idCopy(ideal A)
Definition: ideals.h:73
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:120
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:75
omBin slists_bin
Definition: lists.cc:23
#define omStrDup(s)
Definition: omAllocDecl.h:263
idhdl rDefault ( const char *  s)

Definition at line 1532 of file ipshell.cc.

1533 {
1534  idhdl tmp=NULL;
1535 
1536  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
1537  if (tmp==NULL) return NULL;
1538 
1539 // if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
1541  {
1543  memset(&sLastPrinted,0,sizeof(sleftv));
1544  }
1545 
1546  ring r = IDRING(tmp);
1547 
1548  r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1549  r->N = 3;
1550  /*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
1551  /*names*/
1552  r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
1553  r->names[0] = omStrDup("x");
1554  r->names[1] = omStrDup("y");
1555  r->names[2] = omStrDup("z");
1556  /*weights: entries for 3 blocks: NULL*/
1557  r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1558  /*order: dp,C,0*/
1559  r->order = (int *) omAlloc(3 * sizeof(int *));
1560  r->block0 = (int *)omAlloc0(3 * sizeof(int *));
1561  r->block1 = (int *)omAlloc0(3 * sizeof(int *));
1562  /* ringorder dp for the first block: var 1..3 */
1563  r->order[0] = ringorder_dp;
1564  r->block0[0] = 1;
1565  r->block1[0] = 3;
1566  /* ringorder C for the second block: no vars */
1567  r->order[1] = ringorder_C;
1568  /* the last block: everything is 0 */
1569  r->order[2] = 0;
1570 
1571  /* complete ring intializations */
1572  rComplete(r);
1573  rSetHdl(tmp);
1574  return currRingHdl;
1575 }
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:5030
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 1577 of file ipshell.cc.

1578 {
1580  if (h!=NULL) return h;
1581  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1582  if (h!=NULL) return h;
1584  while(p!=NULL)
1585  {
1586  if ((p->cPack!=basePack)
1587  && (p->cPack!=currPack))
1588  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1589  if (h!=NULL) return h;
1590  p=p->next;
1591  }
1592  idhdl tmp=basePack->idroot;
1593  while (tmp!=NULL)
1594  {
1595  if (IDTYP(tmp)==PACKAGE_CMD)
1596  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1597  if (h!=NULL) return h;
1598  tmp=IDNEXT(tmp);
1599  }
1600  return NULL;
1601 }
idhdl rSimpleFindHdl(ring r, idhdl root, idhdl n)
Definition: ipshell.cc:6145
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 ( leftv  pn,
leftv  rv,
leftv  ord 
)

Definition at line 5516 of file ipshell.cc.

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

6127 {
6128  ring r = IDRING(h);
6129  int ref=0;
6130  if (r!=NULL)
6131  {
6132  ref=r->ref;
6133  rKill(r);
6134  }
6135  if (h==currRingHdl)
6136  {
6137  if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6138  else
6139  {
6141  }
6142  }
6143 }
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:6057
idhdl currRingHdl
Definition: ipid.cc:65
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1577
#define NULL
Definition: omList.c:10
#define IDRING(a)
Definition: ipid.h:126
void rKill ( ring  r)

Definition at line 6057 of file ipshell.cc.

6058 {
6059  if ((r->ref<=0)&&(r->order!=NULL))
6060  {
6061 #ifdef RDEBUG
6062  if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6063 #endif
6064  if (r->qideal!=NULL)
6065  {
6066  id_Delete(&r->qideal, r);
6067  r->qideal = NULL;
6068  }
6069  int j;
6070 #ifdef USE_IILOCALRING
6071  for (j=0;j<myynest;j++)
6072  {
6073  if (iiLocalRing[j]==r)
6074  {
6075  if (j+1==myynest) Warn("killing the basering for level %d",j);
6076  iiLocalRing[j]=NULL;
6077  }
6078  }
6079 #else /* USE_IILOCALRING */
6080 //#endif /* USE_IILOCALRING */
6081  {
6082  proclevel * nshdl = procstack;
6083  int lev=myynest-1;
6084 
6085  for(; nshdl != NULL; nshdl = nshdl->next)
6086  {
6087  if (nshdl->cRing==r)
6088  {
6089  Warn("killing the basering for level %d",lev);
6090  nshdl->cRing=NULL;
6091  nshdl->cRingHdl=NULL;
6092  }
6093  }
6094  }
6095 #endif /* USE_IILOCALRING */
6096 // any variables depending on r ?
6097  while (r->idroot!=NULL)
6098  {
6099  r->idroot->lev=myynest; // avoid warning about kill global objects
6100  killhdl2(r->idroot,&(r->idroot),r);
6101  }
6102  if (r==currRing)
6103  {
6104  // all dependend stuff is done, clean global vars:
6105  if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6107  {
6109  }
6110  //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6111  //{
6112  // WerrorS("return value depends on local ring variable (export missing ?)");
6113  // iiRETURNEXPR.CleanUp();
6114  //}
6115  currRing=NULL;
6116  currRingHdl=NULL;
6117  }
6118 
6119  /* nKillChar(r); will be called from inside of rDelete */
6120  rDelete(r);
6121  return;
6122  }
6123  r->ref--;
6124 }
#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:515
#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 5030 of file ipshell.cc.

5031 {
5032  ring rg = NULL;
5033  if (h!=NULL)
5034  {
5035 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5036  rg = IDRING(h);
5037  if (rg==NULL) return; //id <>NULL, ring==NULL
5038  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5039  if (IDID(h)) // OB: ????
5040  omCheckAddr((ADDRESS)IDID(h));
5041  rTest(rg);
5042  }
5043 
5044  // clean up history
5046  {
5048  memset(&sLastPrinted,0,sizeof(sleftv));
5049  }
5050 
5051  if ((rg!=currRing)&&(currRing!=NULL))
5052  {
5054  if (DENOMINATOR_LIST!=NULL)
5055  {
5056  if (TEST_V_ALLWARN)
5057  Warn("deleting denom_list for ring change to %s",IDID(h));
5058  do
5059  {
5060  n_Delete(&(dd->n),currRing->cf);
5061  dd=dd->next;
5063  DENOMINATOR_LIST=dd;
5064  } while(DENOMINATOR_LIST!=NULL);
5065  }
5066  }
5067 
5068  // test for valid "currRing":
5069  if ((rg!=NULL) && (rg->idroot==NULL))
5070  {
5071  ring old=rg;
5072  rg=rAssure_HasComp(rg);
5073  if (old!=rg)
5074  {
5075  rKill(old);
5076  IDRING(h)=rg;
5077  }
5078  }
5079  /*------------ change the global ring -----------------------*/
5080  rChangeCurrRing(rg);
5081  currRingHdl = h;
5082 }
#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:6057
#define omFree(addr)
Definition: omAllocDecl.h:261
#define rTest(r)
Definition: ring.h:778
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 6145 of file ipshell.cc.

6146 {
6147  //idhdl next_best=NULL;
6148  idhdl h=root;
6149  while (h!=NULL)
6150  {
6151  if (((IDTYP(h)==RING_CMD)||(IDTYP(h)==QRING_CMD))
6152  && (h!=n)
6153  && (IDRING(h)==r)
6154  )
6155  {
6156  // if (IDLEV(h)==myynest)
6157  // return h;
6158  // if ((IDLEV(h)==0) || (next_best==NULL))
6159  // next_best=h;
6160  // else if (IDLEV(next_best)<IDLEV(h))
6161  // next_best=h;
6162  return h;
6163  }
6164  h=IDNEXT(h);
6165  }
6166  //return next_best;
6167  return NULL;
6168 }
#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:159
static Poly * h
Definition: janet.cc:978
lists scIndIndset ( ideal  S,
BOOLEAN  all,
ideal  Q 
)

Definition at line 1023 of file ipshell.cc.

1024 {
1025  int i;
1026  indset save;
1028 
1029  hexist = hInit(S, Q, &hNexist, currRing);
1030  if (hNexist == 0)
1031  {
1032  intvec *iv=new intvec(rVar(currRing));
1033  for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1034  res->Init(1);
1035  res->m[0].rtyp=INTVEC_CMD;
1036  res->m[0].data=(intvec*)iv;
1037  return res;
1038  }
1039  else if (hisModule!=0)
1040  {
1041  res->Init(0);
1042  return res;
1043  }
1044  save = ISet = (indset)omAlloc0Bin(indlist_bin);
1045  hMu = 0;
1046  hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1047  hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1048  hpure = (scmon)omAlloc((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1049  hrad = hexist;
1050  hNrad = hNexist;
1051  radmem = hCreate(rVar(currRing) - 1);
1052  hCo = rVar(currRing) + 1;
1053  hNvar = rVar(currRing);
1054  hRadical(hrad, &hNrad, hNvar);
1055  hSupp(hrad, hNrad, hvar, &hNvar);
1056  if (hNvar)
1057  {
1058  hCo = hNvar;
1059  memset(hpure, 0, (rVar(currRing) + 1) * sizeof(long));
1060  hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1061  hLexR(hrad, hNrad, hvar, hNvar);
1063  }
1064  if (hCo && (hCo < rVar(currRing)))
1065  {
1067  }
1068  if (hMu!=0)
1069  {
1070  ISet = save;
1071  hMu2 = 0;
1072  if (all && (hCo+1 < rVar(currRing)))
1073  {
1076  i=hMu+hMu2;
1077  res->Init(i);
1078  if (hMu2 == 0)
1079  {
1081  }
1082  }
1083  else
1084  {
1085  res->Init(hMu);
1086  }
1087  for (i=0;i<hMu;i++)
1088  {
1089  res->m[i].data = (void *)save->set;
1090  res->m[i].rtyp = INTVEC_CMD;
1091  ISet = save;
1092  save = save->nx;
1094  }
1095  omFreeBin((ADDRESS)save, indlist_bin);
1096  if (hMu2 != 0)
1097  {
1098  save = JSet;
1099  for (i=hMu;i<hMu+hMu2;i++)
1100  {
1101  res->m[i].data = (void *)save->set;
1102  res->m[i].rtyp = INTVEC_CMD;
1103  JSet = save;
1104  save = save->nx;
1106  }
1107  omFreeBin((ADDRESS)save, indlist_bin);
1108  }
1109  }
1110  else
1111  {
1112  res->Init(0);
1114  }
1115  hKill(radmem, rVar(currRing) - 1);
1116  omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1117  omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1118  omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1120  return res;
1121 }
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:21
int hCo
Definition: hdegree.cc:22
Definition: lists.h:22
scmon * scfmon
Definition: hutil.h:20
#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:537
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:14
void hKill(monf xmem, int Nvar)
Definition: hutil.cc:1016
varset hvar
Definition: hutil.cc:21
void hIndMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:313
indlist * indset
Definition: hutil.h:33
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:19
int i
Definition: cfEzgcd.cc:123
void hLexR(scfmon rad, int Nrad, varset var, int Nvar)
Definition: hutil.cc:571
INLINE_THIS void Init(int l=0)
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 4466 of file ipshell.cc.

4467 {
4468  sleftv tmp;
4469  memset(&tmp,0,sizeof(tmp));
4470  tmp.rtyp=INT_CMD;
4471  /* tmp.data = (void *)0; -- done by memset */
4472 
4473  return semicProc3(res,u,v,&tmp);
4474 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:98
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4426
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 4426 of file ipshell.cc.

4427 {
4428  semicState state;
4429  BOOLEAN qh=(((int)(long)w->Data())==1);
4430 
4431  // -----------------
4432  // check arguments
4433  // -----------------
4434 
4435  lists l1 = (lists)u->Data( );
4436  lists l2 = (lists)v->Data( );
4437 
4438  if( (state=list_is_spectrum( l1 ))!=semicOK )
4439  {
4440  WerrorS( "first argument is not a spectrum" );
4441  list_error( state );
4442  }
4443  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4444  {
4445  WerrorS( "second argument is not a spectrum" );
4446  list_error( state );
4447  }
4448  else
4449  {
4450  spectrum s1= spectrumFromList( l1 );
4451  spectrum s2= spectrumFromList( l2 );
4452 
4453  res->rtyp = INT_CMD;
4454  if (qh)
4455  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4456  else
4457  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4458  }
4459 
4460  // -----------------
4461  // check status
4462  // -----------------
4463 
4464  return (state!=semicOK);
4465 }
Definition: tok.h:98
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3299
void list_error(semicState state)
Definition: ipshell.cc:3383
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:4168
int mult_spectrumh(spectrum &)
Definition: semic.cc:425
semicState
Definition: ipshell.cc:3349
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 575 of file misc_ip.cc.

576 {
577  const char *n;
578  do
579  {
580  if (v->Typ()==STRING_CMD)
581  {
582  n=(const char *)v->CopyD(STRING_CMD);
583  }
584  else
585  {
586  if (v->name==NULL)
587  return TRUE;
588  if (v->rtyp==0)
589  {
590  n=v->name;
591  v->name=NULL;
592  }
593  else
594  {
595  n=omStrDup(v->name);
596  }
597  }
598 
599  int i;
600 
601  if(strcmp(n,"get")==0)
602  {
603  intvec *w=new intvec(2);
604  (*w)[0]=si_opt_1;
605  (*w)[1]=si_opt_2;
606  res->rtyp=INTVEC_CMD;
607  res->data=(void *)w;
608  goto okay;
609  }
610  if(strcmp(n,"set")==0)
611  {
612  if((v->next!=NULL)
613  &&(v->next->Typ()==INTVEC_CMD))
614  {
615  v=v->next;
616  intvec *w=(intvec*)v->Data();
617  si_opt_1=(*w)[0];
618  si_opt_2=(*w)[1];
619 #if 0
622 #ifdef HAVE_RINGS
624 #endif
625  ) {
627  }
628 #endif
629  goto okay;
630  }
631  }
632  if(strcmp(n,"none")==0)
633  {
634  si_opt_1=0;
635  si_opt_2=0;
636  goto okay;
637  }
638  for (i=0; (i==0) || (optionStruct[i-1].setval!=0); i++)
639  {
640  if (strcmp(n,optionStruct[i].name)==0)
641  {
642  if (optionStruct[i].setval & validOpts)
643  {
645  // optOldStd disables redthrough
646  if (optionStruct[i].setval == Sy_bit(OPT_OLDSTD))
648  }
649  else
650  Warn("cannot set option");
651 #if 0
654 #ifdef HAVE_RINGS
656 #endif
657  ) {
659  }
660 #endif
661  goto okay;
662  }
663  else if ((strncmp(n,"no",2)==0)
664  && (strcmp(n+2,optionStruct[i].name)==0))
665  {
666  if (optionStruct[i].setval & validOpts)
667  {
669  }
670  else
671  Warn("cannot clear option");
672  goto okay;
673  }
674  }
675  for (i=0; (i==0) || (verboseStruct[i-1].setval!=0); i++)
676  {
677  if (strcmp(n,verboseStruct[i].name)==0)
678  {
680  #ifdef YYDEBUG
681  #if YYDEBUG
682  /*debugging the bison grammar --> grammar.cc*/
683  extern int yydebug;
684  if (BVERBOSE(V_YACC)) yydebug=1;
685  else yydebug=0;
686  #endif
687  #endif
688  goto okay;
689  }
690  else if ((strncmp(n,"no",2)==0)
691  && (strcmp(n+2,verboseStruct[i].name)==0))
692  {
694  #ifdef YYDEBUG
695  #if YYDEBUG
696  /*debugging the bison grammar --> grammar.cc*/
697  extern int yydebug;
698  if (BVERBOSE(V_YACC)) yydebug=1;
699  else yydebug=0;
700  #endif
701  #endif
702  goto okay;
703  }
704  }
705  Werror("unknown option `%s`",n);
706  okay:
707  if (currRing != NULL)
708  currRing->options = si_opt_1 & TEST_RINGDEP_OPTS;
709  omFree((ADDRESS)n);
710  v=v->next;
711  } while (v!=NULL);
712 
713  // set global variable to show memory usage
714  extern int om_sing_opt_show_mem;
715  if (BVERBOSE(V_SHOW_MEM)) om_sing_opt_show_mem = 1;
716  else om_sing_opt_show_mem = 0;
717 
718  return FALSE;
719 }
unsigned si_opt_1
Definition: options.c:5
#define FALSE
Definition: auxiliary.h:140
const struct soptionStruct optionStruct[]
Definition: misc_ip.cc:516
#define OPT_OLDSTD
Definition: options.h:81
#define TRUE
Definition: auxiliary.h:144
void * ADDRESS
Definition: auxiliary.h:161
unsigned setval
Definition: ipid.h:154
unsigned resetval
Definition: ipid.h:155
int Typ()
Definition: subexpr.cc:976
#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:494
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 V_SHOW_MEM
Definition: options.h:41
#define TEST_OPT_INTSTRATEGY
Definition: options.h:105
Definition: intvec.h:14
const char * name
Definition: subexpr.h:88
#define omFree(addr)
Definition: omAllocDecl.h:261
int i
Definition: cfEzgcd.cc:123
const struct soptionStruct verboseStruct[]
Definition: misc_ip.cc:546
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:434
#define NULL
Definition: omList.c:10
int yydebug
Definition: grammar.cc:1791
const CanonicalForm & w
Definition: facAbsFact.cc:55
int rtyp
Definition: subexpr.h:92
void * Data()
Definition: subexpr.cc:1118
#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 721 of file misc_ip.cc.

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

Definition at line 439 of file misc_ip.cc.

440 {
441  assume(str!=NULL);
442  char *s=str;
443  while (*s==' ') s++;
444  char *ss=s;
445  while (*ss!='\0') ss++;
446  while (*ss<=' ')
447  {
448  *ss='\0';
449  ss--;
450  }
451  idhdl h=IDROOT->get(s,myynest);
452  if ((h!=NULL) && (IDTYP(h)==PROC_CMD))
453  {
454  char *lib=iiGetLibName(IDPROC(h));
455  if((lib!=NULL)&&(*lib!='\0'))
456  {
457  Print("// proc %s from lib %s\n",s,lib);
458  s=iiGetLibProcBuffer(IDPROC(h), 2);
459  if (s!=NULL)
460  {
461  if (strlen(s)>5)
462  {
463  iiEStart(s,IDPROC(h));
464  omFree((ADDRESS)s);
465  return;
466  }
467  else omFree((ADDRESS)s);
468  }
469  }
470  }
471  else
472  {
473  char sing_file[MAXPATHLEN];
474  FILE *fd=NULL;
475  char *res_m=feResource('m', 0);
476  if (res_m!=NULL)
477  {
478  sprintf(sing_file, "%s/%s.sing", res_m, s);
479  fd = feFopen(sing_file, "r");
480  }
481  if (fd != NULL)
482  {
483 
484  int old_echo = si_echo;
485  int length, got;
486  char* s;
487 
488  fseek(fd, 0, SEEK_END);
489  length = ftell(fd);
490  fseek(fd, 0, SEEK_SET);
491  s = (char*) omAlloc((length+20)*sizeof(char));
492  got = fread(s, sizeof(char), length, fd);
493  fclose(fd);
494  if (got != length)
495  {
496  Werror("Error while reading file %s", sing_file);
497  }
498  else
499  {
500  s[length] = '\0';
501  strcat(s, "\n;return();\n\n");
502  si_echo = 2;
503  iiEStart(s, NULL);
504  si_echo = old_echo;
505  }
506  omFree(s);
507  }
508  else
509  {
510  Werror("no example for %s", str);
511  }
512  }
513 }
int status int fd
Definition: si_signals.h:59
const CanonicalForm int s
Definition: facAbsFact.cc:55
#define MAXPATHLEN
Definition: omRet2Info.c:22
#define Print
Definition: emacs.cc:83
static char * feResource(feResourceConfig config, int warn)
Definition: feResource.cc:258
#define IDROOT
Definition: ipid.h:20
void * ADDRESS
Definition: auxiliary.h: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:655
#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:102
#define SEEK_SET
Definition: mod2.h:125
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:211
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 4343 of file ipshell.cc.

4344 {
4345  semicState state;
4346 
4347  // -----------------
4348  // check arguments
4349  // -----------------
4350 
4351  lists l1 = (lists)first->Data( );
4352  lists l2 = (lists)second->Data( );
4353 
4354  if( (state=list_is_spectrum( l1 )) != semicOK )
4355  {
4356  WerrorS( "first argument is not a spectrum:" );
4357  list_error( state );
4358  }
4359  else if( (state=list_is_spectrum( l2 )) != semicOK )
4360  {
4361  WerrorS( "second argument is not a spectrum:" );
4362  list_error( state );
4363  }
4364  else
4365  {
4366  spectrum s1= spectrumFromList ( l1 );
4367  spectrum s2= spectrumFromList ( l2 );
4368  spectrum sum( s1+s2 );
4369 
4370  result->rtyp = LIST_CMD;
4371  result->data = (char*)(getList(sum));
4372  }
4373 
4374  return (state!=semicOK);
4375 }
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3299
void list_error(semicState state)
Definition: ipshell.cc:3383
void WerrorS(const char *s)
Definition: feFopen.cc:24
Definition: semic.h:63
lists getList(spectrum &spec)
Definition: ipshell.cc:3311
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4168
semicState
Definition: ipshell.cc:3349
slists * lists
Definition: mpr_numeric.h:146
Definition: tok.h:120
return result
Definition: facAbsBiFact.cc:76
BOOLEAN spectrumfProc ( leftv  ,
leftv   
)

Definition at line 4099 of file ipshell.cc.

4100 {
4101  spectrumState state = spectrumOK;
4102 
4103  // -------------------
4104  // check consistency
4105  // -------------------
4106 
4107  // check for a local polynomial ring
4108 
4109  if( currRing->OrdSgn != -1 )
4110  // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4111  // or should we use:
4112  //if( !ringIsLocal( ) )
4113  {
4114  WerrorS( "only works for local orderings" );
4115  state = spectrumWrongRing;
4116  }
4117  else if( currRing->qideal != NULL )
4118  {
4119  WerrorS( "does not work in quotient rings" );
4120  state = spectrumWrongRing;
4121  }
4122  else
4123  {
4124  lists L = (lists)NULL;
4125  int flag = 2; // symmetric optimization
4126 
4127  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4128 
4129  if( state==spectrumOK )
4130  {
4131  result->rtyp = LIST_CMD;
4132  result->data = (char*)L;
4133  }
4134  else
4135  {
4136  spectrumPrintError(state);
4137  }
4138  }
4139 
4140  return (state!=spectrumOK);
4141 }
spectrumState
Definition: ipshell.cc:3465
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:4017
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3725
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
Definition: tok.h:120
polyrec * poly
Definition: hilb.h:10
return result
Definition: facAbsBiFact.cc:76
BOOLEAN spectrumProc ( 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 ring
4057 
4058  if( !ringIsLocal(currRing ) )
4059  {
4060  WerrorS( "only works for local orderings" );
4061  state = spectrumWrongRing;
4062  }
4063 
4064  // no quotient rings are allowed
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 = 1; // weight corner optimization is safe
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:3465
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:4017
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3725
#define NULL
Definition: omList.c:10
slists * lists
Definition: mpr_numeric.h:146
Definition: tok.h:120
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 4385 of file ipshell.cc.

4386 {
4387  semicState state;
4388 
4389  // -----------------
4390  // check arguments
4391  // -----------------
4392 
4393  lists l = (lists)first->Data( );
4394  int k = (int)(long)second->Data( );
4395 
4396  if( (state=list_is_spectrum( l ))!=semicOK )
4397  {
4398  WerrorS( "first argument is not a spectrum" );
4399  list_error( state );
4400  }
4401  else if( k < 0 )
4402  {
4403  WerrorS( "second argument should be positive" );
4404  state = semicMulNegative;
4405  }
4406  else
4407  {
4408  spectrum s= spectrumFromList( l );
4409  spectrum product( k*s );
4410 
4411  result->rtyp = LIST_CMD;
4412  result->data = (char*)getList(product);
4413  }
4414 
4415  return (state!=semicOK);
4416 }
const CanonicalForm int s
Definition: facAbsFact.cc:55
Definition: lists.h:22
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3299
void list_error(semicState state)
Definition: ipshell.cc:3383
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:3311
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4168
semicState
Definition: ipshell.cc:3349
slists * lists
Definition: mpr_numeric.h:146
Definition: tok.h:120
return result
Definition: facAbsBiFact.cc:76
int l
Definition: cfEzgcd.cc:94
BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3085 of file ipshell.cc.

3086 {
3087  sleftv tmp;
3088  memset(&tmp,0,sizeof(tmp));
3089  tmp.rtyp=INT_CMD;
3090  tmp.data=(void *)1;
3091  return syBetti2(res,u,&tmp);
3092 }
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
Definition: tok.h:98
void * data
Definition: subexpr.h:89
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3062
int rtyp
Definition: subexpr.h:92
BOOLEAN syBetti2 ( leftv  res,
leftv  u,
leftv  w 
)

Definition at line 3062 of file ipshell.cc.

3063 {
3064  syStrategy syzstr=(syStrategy)u->Data();
3065 
3066  BOOLEAN minim=(int)(long)w->Data();
3067  int row_shift=0;
3068  int add_row_shift=0;
3069  intvec *weights=NULL;
3070  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3071  if (ww!=NULL)
3072  {
3073  weights=ivCopy(ww);
3074  add_row_shift = ww->min_in();
3075  (*weights) -= add_row_shift;
3076  }
3077 
3078  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3079  //row_shift += add_row_shift;
3080  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3081  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3082 
3083  return FALSE;
3084 }
void atSet(idhdl root, const char *name, void *data, int typ)
Definition: attrib.cc:156
Definition: tok.h:98
#define FALSE
Definition: auxiliary.h:140
intvec * ivCopy(const intvec *o)
Definition: intvec.h:126
int min_in()
Definition: intvec.h:113
void * data
Definition: subexpr.h:89
Definition: intvec.h:14
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:135
#define NULL
Definition: omList.c:10
intvec * syBettiOfComputation(syStrategy syzstr, BOOLEAN minim=TRUE, int *row_shift=NULL, intvec *weights=NULL)
Definition: syz1.cc:1767
void * Data()
Definition: subexpr.cc:1118
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 3170 of file ipshell.cc.

3171 {
3172  int typ0;
3174 
3175  resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3176  if (fr != NULL)
3177  {
3178 
3179  result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3180  for (int i=result->length-1;i>=0;i--)
3181  {
3182  if (fr[i]!=NULL)
3183  result->fullres[i] = idCopy(fr[i]);
3184  }
3185  result->list_length=result->length;
3186  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3187  }
3188  else
3189  {
3190  omFreeSize(result, sizeof(ssyStrategy));
3191  result = NULL;
3192  }
3193  if (toDel) li->Clean();
3194  return result;
3195 }
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 3097 of file ipshell.cc.

3098 {
3099  resolvente fullres = syzstr->fullres;
3100  resolvente minres = syzstr->minres;
3101 
3102  const int length = syzstr->length;
3103 
3104  if ((fullres==NULL) && (minres==NULL))
3105  {
3106  if (syzstr->hilb_coeffs==NULL)
3107  { // La Scala
3108  fullres = syReorder(syzstr->res, length, syzstr);
3109  }
3110  else
3111  { // HRES
3112  minres = syReorder(syzstr->orderedRes, length, syzstr);
3113  syKillEmptyEntres(minres, length);
3114  }
3115  }
3116 
3117  resolvente tr;
3118  int typ0=IDEAL_CMD;
3119 
3120  if (minres!=NULL)
3121  tr = minres;
3122  else
3123  tr = fullres;
3124 
3125  resolvente trueres=NULL; intvec ** w=NULL;
3126 
3127  if (length>0)
3128  {
3129  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3130  for (int i=(length)-1;i>=0;i--)
3131  {
3132  if (tr[i]!=NULL)
3133  {
3134  trueres[i] = idCopy(tr[i]);
3135  }
3136  }
3137  if ( id_RankFreeModule(trueres[0], currRing) > 0)
3138  typ0 = MODUL_CMD;
3139  if (syzstr->weights!=NULL)
3140  {
3141  w = (intvec**)omAlloc0(length*sizeof(intvec*));
3142  for (int i=length-1;i>=0;i--)
3143  {
3144  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3145  }
3146  }
3147  }
3148 
3149  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3150  w, add_row_shift);
3151 
3152  if (w != NULL) omFreeSize(w, length*sizeof(intvec*));
3153 
3154  if (toDel)
3155  syKillComputation(syzstr);
3156  else
3157  {
3158  if( fullres != NULL && syzstr->fullres == NULL )
3159  syzstr->fullres = fullres;
3160 
3161  if( minres != NULL && syzstr->minres == NULL )
3162  syzstr->minres = minres;
3163  }
3164  return li;
3165 }
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:126
resolvente res
Definition: syz.h:47
intvec ** hilb_coeffs
Definition: syz.h:46
ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:12
resolvente orderedRes
Definition: syz.h:48
Definition: intvec.h:14
long id_RankFreeModule(ideal s, ring lmRing, ring tailRing)
return the maximal component number found in any polynomial in s
int i
Definition: cfEzgcd.cc:123
resolvente fullres
Definition: syz.h:57
ideal idCopy(ideal A)
Definition: ideals.h: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 3200 of file ipshell.cc.

3201 {
3202  int typ0;
3204 
3205  resolvente fr = liFindRes(li,&(result->length),&typ0);
3206  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3207  for (int i=result->length-1;i>=0;i--)
3208  {
3209  if (fr[i]!=NULL)
3210  result->minres[i] = idCopy(fr[i]);
3211  }
3212  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3213  return result;
3214 }
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 516 of file ipshell.cc.

517 {
518  int ii;
519 
520  if (i<0)
521  {
522  ii= -i;
523  if (ii < 32)
524  {
525  si_opt_1 &= ~Sy_bit(ii);
526  }
527  else if (ii < 64)
528  {
529  si_opt_2 &= ~Sy_bit(ii-32);
530  }
531  else
532  WerrorS("out of bounds\n");
533  }
534  else if (i<32)
535  {
536  ii=i;
537  if (Sy_bit(ii) & kOptions)
538  {
539  Warn("Gerhard, use the option command");
540  si_opt_1 |= Sy_bit(ii);
541  }
542  else if (Sy_bit(ii) & validOpts)
543  si_opt_1 |= Sy_bit(ii);
544  }
545  else if (i<64)
546  {
547  ii=i-32;
548  si_opt_2 |= Sy_bit(ii);
549  }
550  else
551  WerrorS("out of bounds\n");
552 }
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:59
void * malloc(size_t size)
Definition: omalloc.c:92
int i
Definition: cfEzgcd.cc:123
cmdnames cmds[]
Definition: table.h:888
#define NONE
Definition: tok.h:220
#define COMMAND
Definition: tok.h:33
void type_cmd ( leftv  v)

Definition at line 246 of file ipshell.cc.

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

Definition at line 778 of file misc_ip.cc.

779 {
780  StringSetS("");
781  StringAppend("Singular for %s version %s (%d, %d bit) %s #%s",
782  S_UNAME, VERSION, // SINGULAR_VERSION,
783  SINGULAR_VERSION, SIZEOF_VOIDP*8, VERSION_DATE, GIT_VERSION);
784  StringAppendS("\nwith\n\t");
785 
786 #if defined(mpir_version)
787  StringAppend("MPIR(%s)~GMP(%s),", mpir_version, gmp_version);
788 #elif defined(gmp_version)
789  // #if defined (__GNU_MP_VERSION) && defined (__GNU_MP_VERSION_MINOR)
790  // StringAppend("GMP(%d.%d),",__GNU_MP_VERSION,__GNU_MP_VERSION_MINOR);
791  StringAppend("GMP(%s),", gmp_version);
792 #endif
793 #ifdef HAVE_NTL
794 #include <NTL/version.h>
795  StringAppend("NTL(%s),",NTL_VERSION);
796 #endif
797 
798 #ifdef HAVE_FLINT
799  StringAppend("FLINT(%s),",version);
800 #endif
801  StringAppend("factory(%s),\n\t", factoryVersion);
802 #if defined(HAVE_DYN_RL)
804  StringAppendS("no input,");
805  else if (fe_fgets_stdin==fe_fgets)
806  StringAppendS("fgets,");
808  StringAppendS("dynamic readline,");
809  #ifdef HAVE_FEREAD
811  StringAppendS("emulated readline,");
812  #endif
813  else
814  StringAppendS("unknown fgets method,");
815 #else
816  #if defined(HAVE_READLINE) && !defined(FEREAD)
817  StringAppendS("static readline,");
818  #else
819  #ifdef HAVE_FEREAD
820  StringAppendS("emulated readline,");
821  #else
822  StringAppendS("fgets,");
823  #endif
824  #endif
825 #endif
826 #ifdef HAVE_PLURAL
827  StringAppendS("Plural,");
828 #endif
829 #ifdef HAVE_DBM
830  StringAppendS("DBM,\n\t");
831 #else
832  StringAppendS("\n\t");
833 #endif
834 #ifdef HAVE_DYNAMIC_LOADING
835  StringAppendS("dynamic modules,");
836 #endif
837  if (p_procs_dynamic) StringAppendS("dynamic p_Procs,");
838 #if YYDEBUG
839  StringAppendS("YYDEBUG=1,");
840 #endif
841 #ifdef HAVE_ASSUME
842  StringAppendS("ASSUME,");
843 #endif
844 #ifdef MDEBUG
845  StringAppend("MDEBUG=%d,",MDEBUG);
846 #endif
847 #ifdef OM_CHECK
848  StringAppend("OM_CHECK=%d,",OM_CHECK);
849 #endif
850 #ifdef OM_TRACK
851  StringAppend("OM_TRACK=%d,",OM_TRACK);
852 #endif
853 #ifdef OM_NDEBUG
854  StringAppendS("OM_NDEBUG,");
855 #endif
856 #ifdef SING_NDEBUG
857  StringAppendS("SING_NDEBUG,");
858 #endif
859 #ifdef PDEBUG
860  StringAppendS("PDEBUG,");
861 #endif
862 #ifdef KDEBUG
863  StringAppendS("KDEBUG,");
864 #endif
865 #ifdef __OPTIMIZE__
866  StringAppendS("CC:OPTIMIZE,");
867 #endif
868 #ifdef __OPTIMIZE_SIZE__
869  StringAppendS("CC:OPTIMIZE_SIZE,");
870 #endif
871 #ifdef __NO_INLINE__
872  StringAppendS("CC:NO_INLINE,");
873 #endif
874 #ifdef HAVE_EIGENVAL
875  StringAppendS("eigenvalues,");
876 #endif
877 #ifdef HAVE_GMS
878  StringAppendS("Gauss-Manin system,");
879 #endif
880 #ifdef HAVE_RATGRING
881  StringAppendS("ratGB,");
882 #endif
883  StringAppend("random=%d\n",siRandomStart);
884 
885 #define SI_SHOW_BUILTIN_MODULE(name) StringAppend(" %s", #name);
886  StringAppendS("built-in modules: {");
888  StringAppendS("}\n");
889 #undef SI_SHOW_BUILTIN_MODULE
890 
891  StringAppend("AC_CONFIGURE_ARGS = %s,\n"
892  "CC = %s,FLAGS : %s,\n"
893  "CXX = %s,FLAGS : %s,\n"
894  "DEFS : %s,CPPFLAGS : %s,\n"
895  "LDFLAGS : %s,LIBS : %s "
896 #ifdef __GNUC__
897  "(ver: " __VERSION__ ")"
898 #endif
899  "\n",AC_CONFIGURE_ARGS, CC,CFLAGS, CXX,CXXFLAGS, DEFS,CPPFLAGS, LDFLAGS,LIBS);
902  StringAppendS("\n");
903  return StringEndS();
904 }
#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
#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 293 of file table.h.

struct sValCmd3 dArith3[]

Definition at line 709 of file table.h.

struct sValCmdM dArithM[]

Definition at line 818 of file table.h.

leftv iiCurrArgs

Definition at line 79 of file ipshell.cc.

idhdl iiCurrProc

Definition at line 80 of file ipshell.cc.

ring* iiLocalRing

Definition at line 515 of file iplib.cc.

int iiOp

Definition at line 229 of file iparith.cc.

sleftv iiRETURNEXPR

Definition at line 517 of file iplib.cc.

int iiRETURNEXPR_len

Definition at line 518 of file iplib.cc.

const char* lastreserved

Definition at line 81 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
BOOLEAN yyInRingConstruction

Definition at line 173 of file grammar.cc.