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

Go to the source code of this file.

Data Structures

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

Typedefs

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

Functions

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

Variables

EXTERN_VAR leftv iiCurrArgs
 
EXTERN_VAR idhdl iiCurrProc
 
EXTERN_VAR int iiOp
 
const char * currid
 
EXTERN_VAR int iiRETURNEXPR_len
 
EXTERN_INST_VAR sleftv iiRETURNEXPR
 
EXTERN_VAR ring * iiLocalRing
 
const char * lastreserved
 
EXTERN_VAR int myynest
 
EXTERN_VAR int printlevel
 
EXTERN_VAR int si_echo
 
EXTERN_VAR BOOLEAN yyInRingConstruction
 
const struct sValCmd2 dArith2 []
 
const struct sValCmd1 dArith1 []
 
const struct sValCmd3 dArith3 []
 
const struct sValCmdM dArithM []
 

Data Structure Documentation

◆ sValCmd1

struct sValCmd1

Definition at line 78 of file gentable.cc.

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

◆ sValCmd2

struct sValCmd2

Definition at line 69 of file gentable.cc.

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

◆ sValCmd3

struct sValCmd3

Definition at line 86 of file gentable.cc.

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

◆ sValCmdM

struct sValCmdM

Definition at line 96 of file gentable.cc.

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

◆ sValAssign_sys

struct sValAssign_sys

Definition at line 104 of file gentable.cc.

Data Fields
short arg
int p
proc1 p
short res

◆ sValAssign

struct sValAssign

Definition at line 111 of file gentable.cc.

Data Fields
short arg
int p
proci p
short res

Typedef Documentation

◆ proc1

typedef BOOLEAN(* proc1) (leftv, leftv)

Definition at line 122 of file ipshell.h.

◆ proc2

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

Definition at line 134 of file ipshell.h.

◆ proc3

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

Definition at line 145 of file ipshell.h.

◆ proci

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

Definition at line 175 of file ipshell.h.

Function Documentation

◆ exprlist_length()

int exprlist_length ( leftv  v)

Definition at line 552 of file ipshell.cc.

553 {
554  int rc = 0;
555  while (v!=NULL)
556  {
557  switch (v->Typ())
558  {
559  case INT_CMD:
560  case POLY_CMD:
561  case VECTOR_CMD:
562  case NUMBER_CMD:
563  rc++;
564  break;
565  case INTVEC_CMD:
566  case INTMAT_CMD:
567  rc += ((intvec *)(v->Data()))->length();
568  break;
569  case MATRIX_CMD:
570  case IDEAL_CMD:
571  case MODUL_CMD:
572  {
573  matrix mm = (matrix)(v->Data());
574  rc += mm->rows() * mm->cols();
575  }
576  break;
577  case LIST_CMD:
578  rc+=((lists)v->Data())->nr+1;
579  break;
580  default:
581  rc++;
582  }
583  v = v->next;
584  }
585  return rc;
586 }
Variable next() const
Definition: factory.h:146
Definition: intvec.h:23
int & rows()
Definition: matpol.h:23
int & cols()
Definition: matpol.h:24
const Variable & v
< [in] a sqrfree bivariate poly
Definition: facBivar.h:39
@ IDEAL_CMD
Definition: grammar.cc:284
@ MATRIX_CMD
Definition: grammar.cc:286
@ INTMAT_CMD
Definition: grammar.cc:279
@ MODUL_CMD
Definition: grammar.cc:287
@ VECTOR_CMD
Definition: grammar.cc:292
@ NUMBER_CMD
Definition: grammar.cc:288
@ POLY_CMD
Definition: grammar.cc:289
ip_smatrix * matrix
Definition: matpol.h:43
slists * lists
Definition: mpr_numeric.h:146
#define NULL
Definition: omList.c:12
@ LIST_CMD
Definition: tok.h:118
@ INTVEC_CMD
Definition: tok.h:101
@ INT_CMD
Definition: tok.h:96

◆ ii_CallLibProcM()

leftv ii_CallLibProcM ( const char *  n,
void **  args,
int *  arg_types,
const ring  R,
BOOLEAN err 
)

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

Definition at line 701 of file iplib.cc.

702 {
703  idhdl h=ggetid(n);
704  if ((h==NULL)
705  || (IDTYP(h)!=PROC_CMD))
706  {
707  err=2;
708  return NULL;
709  }
710  // ring handling
711  idhdl save_ringhdl=currRingHdl;
712  ring save_ring=currRing;
715  // argument:
716  if (arg_types[0]!=0)
717  {
718  sleftv tmp;
719  leftv tt=&tmp;
720  int i=1;
721  tmp.Init();
722  tmp.data=args[0];
723  tmp.rtyp=arg_types[0];
724  while(arg_types[i]!=0)
725  {
727  tt=tt->next;
728  tt->rtyp=arg_types[i];
729  tt->data=args[i];
730  i++;
731  }
732  // call proc
733  err=iiMake_proc(h,currPack,&tmp);
734  }
735  else
736  // call proc
737  err=iiMake_proc(h,currPack,NULL);
738  // clean up ring
739  iiCallLibProcEnd(save_ringhdl,save_ring);
740  // return
741  if (err==FALSE)
742  {
744  memcpy(h,&iiRETURNEXPR,sizeof(sleftv));
745  iiRETURNEXPR.Init();
746  return h;
747  }
748  return NULL;
749 }
#define FALSE
Definition: auxiliary.h:96
int i
Definition: cfEzgcd.cc:132
Definition: idrec.h:35
Class used for (list of) interpreter objects.
Definition: subexpr.h:83
int rtyp
Definition: subexpr.h:91
void Init()
Definition: subexpr.h:107
leftv next
Definition: subexpr.h:86
void * data
Definition: subexpr.h:88
@ PROC_CMD
Definition: grammar.cc:280
idhdl ggetid(const char *n)
Definition: ipid.cc:581
VAR idhdl currRingHdl
Definition: ipid.cc:59
VAR package currPack
Definition: ipid.cc:57
EXTERN_VAR omBin sleftv_bin
Definition: ipid.h:145
#define IDTYP(a)
Definition: ipid.h:119
static void iiCallLibProcEnd(idhdl save_ringhdl, ring save_ring)
Definition: iplib.cc:606
BOOLEAN iiMake_proc(idhdl pn, package pack, leftv args)
Definition: iplib.cc:504
INST_VAR sleftv iiRETURNEXPR
Definition: iplib.cc:474
static void iiCallLibProcBegin()
Definition: iplib.cc:589
STATIC_VAR Poly * h
Definition: janet.cc:971
#define omAllocBin(bin)
Definition: omAllocDecl.h:205
#define omAlloc0Bin(bin)
Definition: omAllocDecl.h:206
void rChangeCurrRing(ring r)
Definition: polys.cc:15
VAR ring currRing
Widely used global variable which specifies the current polynomial ring for Singular interpreter and ...
Definition: polys.cc:13
#define R
Definition: sirandom.c:27
sleftv * leftv
Definition: structs.h:57

◆ ii_CallProcId2Id()

ideal ii_CallProcId2Id ( const char *  lib,
const char *  proc,
ideal  arg,
const ring  R 
)

Definition at line 661 of file iplib.cc.

662 {
663  char *plib = iiConvName(lib);
664  idhdl h=ggetid(plib);
665  omFreeBinAddr(plib);
666  if (h==NULL)
667  {
668  BOOLEAN bo=iiLibCmd(lib,TRUE,TRUE,FALSE);
669  if (bo) return NULL;
670  }
671  ring oldR=currRing;
673  BOOLEAN err;
674  ideal I=(ideal)iiCallLibProc1(proc,idCopy(arg),IDEAL_CMD,err);
675  rChangeCurrRing(oldR);
676  if (err) return NULL;
677  return I;
678 }
int BOOLEAN
Definition: auxiliary.h:87
#define TRUE
Definition: auxiliary.h:100
unsigned char * proc[NUM_PROC]
Definition: checklibs.c:16
ideal idCopy(ideal A)
Definition: ideals.h:60
void * iiCallLibProc1(const char *n, void *arg, int arg_type, BOOLEAN &err)
Definition: iplib.cc:627
char * iiConvName(const char *libname)
Definition: iplib.cc:1429
BOOLEAN iiLibCmd(const char *newlib, BOOLEAN autoexport, BOOLEAN tellerror, BOOLEAN force)
Definition: iplib.cc:884
#define omFreeBinAddr(addr)
Definition: omAllocDecl.h:258

◆ ii_CallProcId2Int()

int ii_CallProcId2Int ( const char *  lib,
const char *  proc,
ideal  arg,
const ring  R 
)

Definition at line 680 of file iplib.cc.

681 {
682  char *plib = iiConvName(lib);
683  idhdl h=ggetid(plib);
684  omFreeBinAddr(plib);
685  if (h==NULL)
686  {
687  BOOLEAN bo=iiLibCmd(lib,TRUE,TRUE,FALSE);
688  if (bo) return 0;
689  }
690  BOOLEAN err;
691  ring oldR=currRing;
693  int I=(int)(long)iiCallLibProc1(proc,idCopy(arg),IDEAL_CMD,err);
694  rChangeCurrRing(oldR);
695  if (err) return 0;
696  return I;
697 }

◆ iiAddCproc()

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

Definition at line 1063 of file iplib.cc.

1065 {
1066  procinfov pi;
1067  idhdl h;
1068 
1069  #ifndef SING_NDEBUG
1070  int dummy;
1071  if (IsCmd(procname,dummy))
1072  {
1073  Werror(">>%s< is a reserved name",procname);
1074  return 0;
1075  }
1076  #endif
1077 
1078  h=IDROOT->get(procname,0);
1079  if ((h!=NULL)
1080  && (IDTYP(h)==PROC_CMD))
1081  {
1082  pi = IDPROC(h);
1083  #if 0
1084  if ((pi->language == LANG_SINGULAR)
1085  &&(BVERBOSE(V_REDEFINE)))
1086  Warn("extend `%s`",procname);
1087  #endif
1088  }
1089  else
1090  {
1091  h = enterid(procname,0, PROC_CMD, &IDROOT, TRUE);
1092  }
1093  if ( h!= NULL )
1094  {
1095  pi = IDPROC(h);
1096  if((pi->language == LANG_SINGULAR)
1097  ||(pi->language == LANG_NONE))
1098  {
1099  omfree(pi->libname);
1100  pi->libname = omStrDup(libname);
1101  omfree(pi->procname);
1102  pi->procname = omStrDup(procname);
1103  pi->language = LANG_C;
1104  pi->ref = 1;
1105  pi->is_static = pstatic;
1106  pi->data.o.function = func;
1107  }
1108  else if(pi->language == LANG_C)
1109  {
1110  if(pi->data.o.function == func)
1111  {
1112  pi->ref++;
1113  }
1114  else
1115  {
1116  omfree(pi->libname);
1117  pi->libname = omStrDup(libname);
1118  omfree(pi->procname);
1119  pi->procname = omStrDup(procname);
1120  pi->language = LANG_C;
1121  pi->ref = 1;
1122  pi->is_static = pstatic;
1123  pi->data.o.function = func;
1124  }
1125  }
1126  else
1127  Warn("internal error: unknown procedure type %d",pi->language);
1128  if (currPack->language==LANG_SINGULAR) currPack->language=LANG_MIX;
1129  return(1);
1130  }
1131  else
1132  {
1133  WarnS("iiAddCproc: failed.");
1134  }
1135  return(0);
1136 }
#define Warn
Definition: emacs.cc:77
#define WarnS
Definition: emacs.cc:78
int IsCmd(const char *n, int &tok)
Definition: iparith.cc:9503
idhdl enterid(const char *s, int lev, int t, idhdl *root, BOOLEAN init, BOOLEAN search)
Definition: ipid.cc:279
#define IDPROC(a)
Definition: ipid.h:140
#define IDROOT
Definition: ipid.h:19
#define pi
Definition: libparse.cc:1145
#define omStrDup(s)
Definition: omAllocDecl.h:263
#define omfree(addr)
Definition: omAllocDecl.h:237
#define BVERBOSE(a)
Definition: options.h:35
#define V_REDEFINE
Definition: options.h:45
void Werror(const char *fmt,...)
Definition: reporter.cc:189
@ LANG_SINGULAR
Definition: subexpr.h:22
@ LANG_NONE
Definition: subexpr.h:22
@ LANG_MIX
Definition: subexpr.h:22
@ LANG_C
Definition: subexpr.h:22

◆ iiAlias()

BOOLEAN iiAlias ( leftv  p)

Definition at line 844 of file ipid.cc.

845 {
846  if (iiCurrArgs==NULL)
847  {
848  Werror("not enough arguments for proc %s",VoiceName());
849  p->CleanUp();
850  return TRUE;
851  }
853  iiCurrArgs=h->next;
854  h->next=NULL;
855  if (h->rtyp!=IDHDL)
856  {
858  h->CleanUp();
860  return res;
861  }
862  if ((h->Typ()!=p->Typ()) &&(p->Typ()!=DEF_CMD))
863  {
864  WerrorS("type mismatch");
865  return TRUE;
866  }
867  idhdl pp=(idhdl)p->data;
868  switch(pp->typ)
869  {
870  case CRING_CMD:
871  nKillChar((coeffs)pp);
872  break;
873  case DEF_CMD:
874  case INT_CMD:
875  break;
876  case INTVEC_CMD:
877  case INTMAT_CMD:
878  delete IDINTVEC(pp);
879  break;
880  case NUMBER_CMD:
881  nDelete(&IDNUMBER(pp));
882  break;
883  case BIGINT_CMD:
885  break;
886  case MAP_CMD:
887  {
888  map im = IDMAP(pp);
889  omFreeBinAddr((ADDRESS)im->preimage);
890  im->preimage=NULL;// and continue
891  }
892  // continue as ideal:
893  case IDEAL_CMD:
894  case MODUL_CMD:
895  case MATRIX_CMD:
896  idDelete(&IDIDEAL(pp));
897  break;
898  case PROC_CMD:
899  case RESOLUTION_CMD:
900  case STRING_CMD:
902  break;
903  case LIST_CMD:
904  IDLIST(pp)->Clean();
905  break;
906  case LINK_CMD:
908  break;
909  // case ring: cannot happen
910  default:
911  Werror("unknown type %d",p->Typ());
912  return TRUE;
913  }
914  pp->typ=ALIAS_CMD;
915  IDDATA(pp)=(char*)h->data;
916  int eff_typ=h->Typ();
917  if ((RingDependend(eff_typ))
918  || ((eff_typ==LIST_CMD) && (lRingDependend((lists)h->Data()))))
919  {
920  ipSwapId(pp,IDROOT,currRing->idroot);
921  }
922  h->CleanUp();
924  return FALSE;
925 }
void * ADDRESS
Definition: auxiliary.h:119
CanonicalForm FACTORY_PUBLIC pp(const CanonicalForm &)
CanonicalForm pp ( const CanonicalForm & f )
Definition: cf_gcd.cc:676
int p
Definition: cfModGcd.cc:4078
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:504
Definition: lists.h:24
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete 'p'
Definition: coeffs.h:455
void nKillChar(coeffs r)
undo all initialisations
Definition: numbers.cc:547
CanonicalForm res
Definition: facAbsFact.cc:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
const char * VoiceName()
Definition: fevoices.cc:58
@ MAP_CMD
Definition: grammar.cc:285
@ RESOLUTION_CMD
Definition: grammar.cc:290
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1963
static int ipSwapId(idhdl tomove, idhdl &root1, idhdl &root2)
Definition: ipid.cc:679
VAR coeffs coeffs_BIGINT
Definition: ipid.cc:50
#define IDMAP(a)
Definition: ipid.h:135
#define IDSTRING(a)
Definition: ipid.h:136
#define IDDATA(a)
Definition: ipid.h:126
#define IDINTVEC(a)
Definition: ipid.h:128
#define IDLINK(a)
Definition: ipid.h:138
#define IDIDEAL(a)
Definition: ipid.h:133
#define IDNUMBER(a)
Definition: ipid.h:132
#define IDLIST(a)
Definition: ipid.h:137
VAR leftv iiCurrArgs
Definition: ipshell.cc:80
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:199
The main handler for Singular numbers which are suitable for Singular polynomials.
#define nDelete(n)
Definition: numbers.h:16
#define omFree(addr)
Definition: omAllocDecl.h:261
#define omFreeBin(addr, bin)
Definition: omAllocDecl.h:259
idrec * idhdl
Definition: ring.h:21
BOOLEAN RingDependend(int t)
Definition: subexpr.h:142
#define IDHDL
Definition: tok.h:31
@ ALIAS_CMD
Definition: tok.h:34
@ BIGINT_CMD
Definition: tok.h:38
@ CRING_CMD
Definition: tok.h:56
@ DEF_CMD
Definition: tok.h:58
@ LINK_CMD
Definition: tok.h:117
@ STRING_CMD
Definition: tok.h:185

◆ iiAllStart()

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

Definition at line 298 of file iplib.cc.

299 {
300  int save_trace=traceit;
301  int restore_traceit=0;
302  if (traceit_stop
303  && (traceit & TRACE_SHOW_LINE))
304  {
306  traceit_stop=0;
307  restore_traceit=1;
308  }
309  // see below:
310  BITSET save1=si_opt_1;
311  BITSET save2=si_opt_2;
312  newBuffer( omStrDup(p /*pi->data.s.body*/), t /*BT_proc*/,
313  pi, l );
314  BOOLEAN err=yyparse();
315 
316  if (sLastPrinted.rtyp!=0)
317  {
319  }
320 
321  if (restore_traceit) traceit=save_trace;
322 
323  // the access to optionStruct and verboseStruct do not work
324  // on x86_64-Linux for pic-code
325  if ((TEST_V_ALLWARN) &&
326  (t==BT_proc) &&
327  ((save1!=si_opt_1)||(save2!=si_opt_2)) &&
328  (pi->libname!=NULL) && (pi->libname[0]!='\0'))
329  {
330  if ((pi->libname!=NULL) && (pi->libname[0]!='\0'))
331  Warn("option changed in proc %s from %s",pi->procname,pi->libname);
332  else
333  Warn("option changed in proc %s",pi->procname);
334  int i;
335  for (i=0; optionStruct[i].setval!=0; i++)
336  {
337  if ((optionStruct[i].setval & si_opt_1)
338  && (!(optionStruct[i].setval & save1)))
339  {
340  Print(" +%s",optionStruct[i].name);
341  }
342  if (!(optionStruct[i].setval & si_opt_1)
343  && ((optionStruct[i].setval & save1)))
344  {
345  Print(" -%s",optionStruct[i].name);
346  }
347  }
348  for (i=0; verboseStruct[i].setval!=0; i++)
349  {
350  if ((verboseStruct[i].setval & si_opt_2)
351  && (!(verboseStruct[i].setval & save2)))
352  {
353  Print(" +%s",verboseStruct[i].name);
354  }
355  if (!(verboseStruct[i].setval & si_opt_2)
356  && ((verboseStruct[i].setval & save2)))
357  {
358  Print(" -%s",verboseStruct[i].name);
359  }
360  }
361  PrintLn();
362  }
363  return err;
364 }
int l
Definition: cfEzgcd.cc:100
void CleanUp(ring r=currRing)
Definition: subexpr.cc:348
#define Print
Definition: emacs.cc:80
char name(const Variable &v)
Definition: factory.h:189
void newBuffer(char *s, feBufferTypes t, procinfo *pi, int lineno)
Definition: fevoices.cc:166
@ BT_proc
Definition: fevoices.h:20
int yyparse(void)
Definition: grammar.cc:2111
const struct soptionStruct verboseStruct[]
Definition: misc_ip.cc:538
unsigned setval
Definition: ipid.h:153
const struct soptionStruct optionStruct[]
Definition: misc_ip.cc:507
VAR unsigned si_opt_2
Definition: options.c:6
VAR unsigned si_opt_1
Definition: options.c:5
#define TEST_V_ALLWARN
Definition: options.h:144
void PrintLn()
Definition: reporter.cc:310
#define TRACE_SHOW_LINE
Definition: reporter.h:33
EXTERN_VAR int traceit
Definition: reporter.h:24
EXTERN_VAR int traceit_stop
Definition: reporter.h:25
#define BITSET
Definition: structs.h:16
INST_VAR sleftv sLastPrinted
Definition: subexpr.cc:46

◆ iiApply()

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

Definition at line 6421 of file ipshell.cc.

6422 {
6423  res->Init();
6424  res->rtyp=a->Typ();
6425  switch (res->rtyp /*a->Typ()*/)
6426  {
6427  case INTVEC_CMD:
6428  case INTMAT_CMD:
6429  return iiApplyINTVEC(res,a,op,proc);
6430  case BIGINTMAT_CMD:
6431  return iiApplyBIGINTMAT(res,a,op,proc);
6432  case IDEAL_CMD:
6433  case MODUL_CMD:
6434  case MATRIX_CMD:
6435  return iiApplyIDEAL(res,a,op,proc);
6436  case LIST_CMD:
6437  return iiApplyLIST(res,a,op,proc);
6438  }
6439  WerrorS("first argument to `apply` must allow an index");
6440  return TRUE;
6441 }
int Typ()
Definition: subexpr.cc:1011
@ BIGINTMAT_CMD
Definition: grammar.cc:278
BOOLEAN iiApplyINTVEC(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6340
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6382
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6377
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6372

◆ iiARROW()

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

Definition at line 6470 of file ipshell.cc.

6471 {
6472  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6473  // find end of s:
6474  int end_s=strlen(s);
6475  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6476  s[end_s+1]='\0';
6477  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6478  sprintf(name,"%s->%s",a,s);
6479  // find start of last expression
6480  int start_s=end_s-1;
6481  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6482  if (start_s<0) // ';' not found
6483  {
6484  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6485  }
6486  else // s[start_s] is ';'
6487  {
6488  s[start_s]='\0';
6489  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6490  }
6491  r->Init();
6492  // now produce procinfo for PROC_CMD:
6493  r->data = (void *)omAlloc0Bin(procinfo_bin);
6494  ((procinfo *)(r->data))->language=LANG_NONE;
6495  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6496  ((procinfo *)r->data)->data.s.body=ss;
6497  omFree(name);
6498  r->rtyp=PROC_CMD;
6499  //r->rtyp=STRING_CMD;
6500  //r->data=ss;
6501  return FALSE;
6502 }
const CanonicalForm int s
Definition: facAbsFact.cc:51
procinfo * iiInitSingularProcinfo(procinfov pi, const char *libname, const char *procname, int, long pos, BOOLEAN pstatic)
Definition: iplib.cc:1049
#define omAlloc(size)
Definition: omAllocDecl.h:210
VAR omBin procinfo_bin
Definition: subexpr.cc:42

◆ iiAssign()

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

Definition at line 1963 of file ipassign.cc.

1964 {
1965  if (errorreported) return TRUE;
1966  int ll=l->listLength();
1967  int rl;
1968  int lt=l->Typ();
1969  int rt=NONE;
1970  int is_qring=FALSE;
1971  BOOLEAN b=FALSE;
1972  if (l->rtyp==ALIAS_CMD)
1973  {
1974  Werror("`%s` is read-only",l->Name());
1975  }
1976 
1977  if (l->rtyp==IDHDL)
1978  {
1979  atKillAll((idhdl)l->data);
1980  is_qring=hasFlag((idhdl)l->data,FLAG_QRING_DEF);
1981  IDFLAG((idhdl)l->data)=0;
1982  l->attribute=NULL;
1983  toplevel=FALSE;
1984  }
1985  else if (l->attribute!=NULL)
1986  atKillAll((idhdl)l);
1987  if (ll==1)
1988  {
1989  /* l[..] = ... */
1990  if(l->e!=NULL)
1991  {
1992  BOOLEAN like_lists=0;
1993  blackbox *bb=NULL;
1994  int bt;
1995  if (((bt=l->rtyp)>MAX_TOK)
1996  || ((l->rtyp==IDHDL) && ((bt=IDTYP((idhdl)l->data))>MAX_TOK)))
1997  {
1998  bb=getBlackboxStuff(bt);
1999  like_lists=BB_LIKE_LIST(bb); // bb like a list
2000  }
2001  else if (((l->rtyp==IDHDL) && (IDTYP((idhdl)l->data)==LIST_CMD))
2002  || (l->rtyp==LIST_CMD))
2003  {
2004  like_lists=2; // bb in a list
2005  }
2006  if(like_lists)
2007  {
2008  if (traceit&TRACE_ASSIGN) PrintS("assign list[..]=...or similar\n");
2009  if (like_lists==1)
2010  {
2011  // check blackbox/newtype type:
2012  if(bb->blackbox_CheckAssign(bb,l,r)) return TRUE;
2013  }
2014  b=jiAssign_list(l,r);
2015  if((!b) && (like_lists==2))
2016  {
2017  //Print("jjA_L_LIST: - 2 \n");
2018  if((l->rtyp==IDHDL) && (l->data!=NULL))
2019  {
2020  ipMoveId((idhdl)l->data);
2021  l->attribute=IDATTR((idhdl)l->data);
2022  l->flag=IDFLAG((idhdl)l->data);
2023  }
2024  }
2025  r->CleanUp();
2026  Subexpr h;
2027  while (l->e!=NULL)
2028  {
2029  h=l->e->next;
2031  l->e=h;
2032  }
2033  return b;
2034  }
2035  }
2036  if (lt>MAX_TOK)
2037  {
2038  blackbox *bb=getBlackboxStuff(lt);
2039 #ifdef BLACKBOX_DEVEL
2040  Print("bb-assign: bb=%lx\n",bb);
2041 #endif
2042  return (bb==NULL) || bb->blackbox_Assign(l,r);
2043  }
2044  // end of handling elems of list and similar
2045  rl=r->listLength();
2046  if (rl==1)
2047  {
2048  /* system variables = ... */
2049  if(((l->rtyp>=VECHO)&&(l->rtyp<=VPRINTLEVEL))
2050  ||((l->rtyp>=VALTVARS)&&(l->rtyp<=VMINPOLY)))
2051  {
2052  b=iiAssign_sys(l,r);
2053  r->CleanUp();
2054  //l->CleanUp();
2055  return b;
2056  }
2057  rt=r->Typ();
2058  /* a = ... */
2059  if ((lt!=MATRIX_CMD)
2060  &&(lt!=BIGINTMAT_CMD)
2061  &&(lt!=CMATRIX_CMD)
2062  &&(lt!=INTMAT_CMD)
2063  &&((lt==rt)||(lt!=LIST_CMD)))
2064  {
2065  b=jiAssign_1(l,r,rt,toplevel,is_qring);
2066  if (l->rtyp==IDHDL)
2067  {
2068  if ((lt==DEF_CMD)||(lt==LIST_CMD))
2069  {
2070  ipMoveId((idhdl)l->data);
2071  }
2072  l->attribute=IDATTR((idhdl)l->data);
2073  l->flag=IDFLAG((idhdl)l->data);
2074  l->CleanUp();
2075  }
2076  r->CleanUp();
2077  return b;
2078  }
2079  if (((lt!=LIST_CMD)
2080  &&((rt==MATRIX_CMD)
2081  ||(rt==BIGINTMAT_CMD)
2082  ||(rt==CMATRIX_CMD)
2083  ||(rt==INTMAT_CMD)
2084  ||(rt==INTVEC_CMD)
2085  ||(rt==MODUL_CMD)))
2086  ||((lt==LIST_CMD)
2087  &&(rt==RESOLUTION_CMD))
2088  )
2089  {
2090  b=jiAssign_1(l,r,rt,toplevel);
2091  if((l->rtyp==IDHDL)&&(l->data!=NULL))
2092  {
2093  if ((lt==DEF_CMD) || (lt==LIST_CMD))
2094  {
2095  //Print("ipAssign - 3.0\n");
2096  ipMoveId((idhdl)l->data);
2097  }
2098  l->attribute=IDATTR((idhdl)l->data);
2099  l->flag=IDFLAG((idhdl)l->data);
2100  }
2101  r->CleanUp();
2102  Subexpr h;
2103  while (l->e!=NULL)
2104  {
2105  h=l->e->next;
2107  l->e=h;
2108  }
2109  return b;
2110  }
2111  }
2112  if (rt==NONE) rt=r->Typ();
2113  }
2114  else if (ll==(rl=r->listLength()))
2115  {
2116  b=jiAssign_rec(l,r);
2117  return b;
2118  }
2119  else
2120  {
2121  if (rt==NONE) rt=r->Typ();
2122  if (rt==INTVEC_CMD)
2123  return jiA_INTVEC_L(l,r);
2124  else if (rt==VECTOR_CMD)
2125  return jiA_VECTOR_L(l,r);
2126  else if ((rt==IDEAL_CMD)||(rt==MATRIX_CMD))
2127  return jiA_MATRIX_L(l,r);
2128  else if ((rt==STRING_CMD)&&(rl==1))
2129  return jiA_STRING_L(l,r);
2130  Werror("length of lists in assignment does not match (l:%d,r:%d)",
2131  ll,rl);
2132  return TRUE;
2133  }
2134 
2135  leftv hh=r;
2136  BOOLEAN map_assign=FALSE;
2137  switch (lt)
2138  {
2139  case INTVEC_CMD:
2140  b=jjA_L_INTVEC(l,r,new intvec(exprlist_length(r)));
2141  break;
2142  case INTMAT_CMD:
2143  {
2144  b=jjA_L_INTVEC(l,r,new intvec(IDINTVEC((idhdl)l->data)));
2145  break;
2146  }
2147  case BIGINTMAT_CMD:
2148  {
2149  b=jjA_L_BIGINTMAT(l, r, new bigintmat(IDBIMAT((idhdl)l->data)));
2150  break;
2151  }
2152  case MAP_CMD:
2153  {
2154  // first element in the list sl (r) must be a ring
2155  if ((rt == RING_CMD)&&(r->e==NULL))
2156  {
2157  omFreeBinAddr((ADDRESS)IDMAP((idhdl)l->data)->preimage);
2158  IDMAP((idhdl)l->data)->preimage = omStrDup (r->Fullname());
2159  /* advance the expressionlist to get the next element after the ring */
2160  hh = r->next;
2161  }
2162  else
2163  {
2164  WerrorS("expected ring-name");
2165  b=TRUE;
2166  break;
2167  }
2168  if (hh==NULL) /* map-assign: map f=r; */
2169  {
2170  WerrorS("expected image ideal");
2171  b=TRUE;
2172  break;
2173  }
2174  if ((hh->next==NULL)&&(hh->Typ()==IDEAL_CMD))
2175  {
2176  b=jiAssign_1(l,hh,IDEAL_CMD,toplevel); /* map-assign: map f=r,i; */
2177  omFreeBin(hh,sleftv_bin);
2178  return b;
2179  }
2180  //no break, handle the rest like an ideal:
2181  map_assign=TRUE; // and continue
2182  }
2183  case MATRIX_CMD:
2184  case IDEAL_CMD:
2185  case MODUL_CMD:
2186  {
2187  sleftv t;
2188  matrix olm = (matrix)l->Data();
2189  long rk;
2190  char *pr=((map)olm)->preimage;
2191  BOOLEAN module_assign=(/*l->Typ()*/ lt==MODUL_CMD);
2192  matrix lm ;
2193  long num;
2194  int j,k;
2195  int i=0;
2196  int mtyp=MATRIX_CMD; /*Type of left side object*/
2197  int etyp=POLY_CMD; /*Type of elements of left side object*/
2198 
2199  if (lt /*l->Typ()*/==MATRIX_CMD)
2200  {
2201  rk=olm->rows();
2202  num=olm->cols()*rk /*olm->rows()*/;
2203  lm=mpNew(olm->rows(),olm->cols());
2204  int el;
2205  if ((traceit&TRACE_ASSIGN) && (num!=(el=exprlist_length(hh))))
2206  {
2207  Warn("expression list length(%d) does not match matrix size(%d)",el,num);
2208  }
2209  }
2210  else /* IDEAL_CMD or MODUL_CMD */
2211  {
2212  num=exprlist_length(hh);
2213  lm=(matrix)idInit(num,1);
2214  if (module_assign)
2215  {
2216  rk=0;
2217  mtyp=MODUL_CMD;
2218  etyp=VECTOR_CMD;
2219  }
2220  else
2221  rk=1;
2222  }
2223 
2224  int ht;
2225  loop
2226  {
2227  if (hh==NULL)
2228  break;
2229  else
2230  {
2231  matrix rm;
2232  ht=hh->Typ();
2233  if ((j=iiTestConvert(ht,etyp))!=0)
2234  {
2235  b=iiConvert(ht,etyp,j,hh,&t);
2236  hh->next=t.next;
2237  if (b)
2238  { Werror("can not convert %s(%s) -> %s",Tok2Cmdname(ht),hh->Name(),Tok2Cmdname(etyp));
2239  break;
2240  }
2241  lm->m[i]=(poly)t.CopyD(etyp);
2242  pNormalize(lm->m[i]);
2243  if (module_assign) rk=si_max(rk,pMaxComp(lm->m[i]));
2244  i++;
2245  }
2246  else
2247  if ((j=iiTestConvert(ht,mtyp))!=0)
2248  {
2249  b=iiConvert(ht,mtyp,j,hh,&t);
2250  hh->next=t.next;
2251  if (b)
2252  { Werror("can not convert %s(%s) -> %s",Tok2Cmdname(ht),hh->Name(),Tok2Cmdname(mtyp));
2253  break;
2254  }
2255  rm = (matrix)t.CopyD(mtyp);
2256  if (module_assign)
2257  {
2258  j = si_min((int)num,rm->cols());
2259  rk=si_max(rk,rm->rank);
2260  }
2261  else
2262  j = si_min(num-i,(long)rm->rows() * (long)rm->cols());
2263  for(k=0;k<j;k++,i++)
2264  {
2265  lm->m[i]=rm->m[k];
2266  pNormalize(lm->m[i]);
2267  rm->m[k]=NULL;
2268  }
2269  idDelete((ideal *)&rm);
2270  }
2271  else
2272  {
2273  b=TRUE;
2274  Werror("can not convert %s(%s) -> %s",Tok2Cmdname(ht),hh->Name(),Tok2Cmdname(mtyp));
2275  break;
2276  }
2277  t.next=NULL;t.CleanUp();
2278  if (i==num) break;
2279  hh=hh->next;
2280  }
2281  }
2282  if (b)
2283  idDelete((ideal *)&lm);
2284  else
2285  {
2286  idDelete((ideal *)&olm);
2287  if (module_assign) lm->rank=rk;
2288  else if (map_assign) ((map)lm)->preimage=pr;
2289  l=l->LData();
2290  if (l->rtyp==IDHDL)
2291  IDMATRIX((idhdl)l->data)=lm;
2292  else
2293  l->data=(char *)lm;
2294  }
2295  break;
2296  }
2297  case STRING_CMD:
2298  b=jjA_L_STRING(l,r);
2299  break;
2300  //case DEF_CMD:
2301  case LIST_CMD:
2302  b=jjA_L_LIST(l,r);
2303  break;
2304  case NONE:
2305  case 0:
2306  Werror("cannot assign to %s",l->Fullname());
2307  b=TRUE;
2308  break;
2309  default:
2310  WerrorS("assign not impl.");
2311  b=TRUE;
2312  break;
2313  } /* end switch: typ */
2314  if (b && (!errorreported)) WerrorS("incompatible type in list assignment");
2315  r->CleanUp();
2316  return b;
2317 }
#define atKillAll(H)
Definition: attrib.h:47
static int si_max(const int a, const int b)
Definition: auxiliary.h:124
static int si_min(const int a, const int b)
Definition: auxiliary.h:125
blackbox * getBlackboxStuff(const int t)
return the structure to the type given by t
Definition: blackbox.cc:17
#define BB_LIKE_LIST(B)
Definition: blackbox.h:53
CanonicalForm num(const CanonicalForm &f)
int k
Definition: cfEzgcd.cc:99
CanonicalForm b
Definition: cfModGcd.cc:4103
Matrices of numbers.
Definition: bigintmat.h:51
long rank
Definition: matpol.h:19
poly * m
Definition: matpol.h:18
void * CopyD(int t)
Definition: subexpr.cc:710
const char * Name()
Definition: subexpr.h:120
int j
Definition: facHensel.cc:110
VAR short errorreported
Definition: feFopen.cc:23
const char * Tok2Cmdname(int tok)
Definition: gentable.cc:140
int iiTestConvert(int inputType, int outputType)
Definition: gentable.cc:301
@ VALTVARS
Definition: grammar.cc:305
@ VMINPOLY
Definition: grammar.cc:309
@ RING_CMD
Definition: grammar.cc:281
static BOOLEAN jiA_MATRIX_L(leftv l, leftv r)
Definition: ipassign.cc:1756
static BOOLEAN jiA_VECTOR_L(leftv l, leftv r)
Definition: ipassign.cc:1518
static BOOLEAN iiAssign_sys(leftv l, leftv r)
Definition: ipassign.cc:1418
static BOOLEAN jiAssign_rec(leftv l, leftv r)
Definition: ipassign.cc:1940
static BOOLEAN jiAssign_1(leftv l, leftv r, int rt, BOOLEAN toplevel, BOOLEAN is_qring=FALSE)
Definition: ipassign.cc:1235
static BOOLEAN jjA_L_LIST(leftv l, leftv r)
Definition: ipassign.cc:1559
static BOOLEAN jiA_STRING_L(leftv l, leftv r)
Definition: ipassign.cc:1832
static BOOLEAN jjA_L_BIGINTMAT(leftv l, leftv r, bigintmat *bim)
Definition: ipassign.cc:1673
static BOOLEAN jiAssign_list(leftv l, leftv r)
Definition: ipassign.cc:1868
static BOOLEAN jjA_L_STRING(leftv l, leftv r)
Definition: ipassign.cc:1722
static BOOLEAN jiA_INTVEC_L(leftv l, leftv r)
Definition: ipassign.cc:1492
static BOOLEAN jjA_L_INTVEC(leftv l, leftv r, intvec *iv)
Definition: ipassign.cc:1624
BOOLEAN iiConvert(int inputType, int outputType, int index, leftv input, leftv output, const struct sConvertTypes *dConvertTypes)
Definition: ipconv.cc:435
void ipMoveId(idhdl tomove)
Definition: ipid.cc:704
#define IDMATRIX(a)
Definition: ipid.h:134
#define hasFlag(A, F)
Definition: ipid.h:112
#define IDBIMAT(a)
Definition: ipid.h:129
#define IDFLAG(a)
Definition: ipid.h:120
#define FLAG_QRING_DEF
Definition: ipid.h:109
#define IDATTR(a)
Definition: ipid.h:123
int exprlist_length(leftv v)
Definition: ipshell.cc:552
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:37
#define pMaxComp(p)
Definition: polys.h:299
#define pNormalize(p)
Definition: polys.h:317
void PrintS(const char *s)
Definition: reporter.cc:284
#define TRACE_ASSIGN
Definition: reporter.h:46
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:35
#define loop
Definition: structs.h:75
VAR omBin sSubexpr_bin
Definition: subexpr.cc:40
@ VPRINTLEVEL
Definition: tok.h:215
@ CMATRIX_CMD
Definition: tok.h:46
@ VECHO
Definition: tok.h:208
@ MAX_TOK
Definition: tok.h:218
#define NONE
Definition: tok.h:221

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6504 of file ipshell.cc.

6505 {
6506  char* ring_name=omStrDup((char*)r->Name());
6507  int t=arg->Typ();
6508  if (t==RING_CMD)
6509  {
6510  sleftv tmp;
6511  tmp.Init();
6512  tmp.rtyp=IDHDL;
6513  idhdl h=rDefault(ring_name);
6514  tmp.data=(char*)h;
6515  if (h!=NULL)
6516  {
6517  tmp.name=h->id;
6518  BOOLEAN b=iiAssign(&tmp,arg);
6519  if (b) return TRUE;
6520  rSetHdl(ggetid(ring_name));
6521  omFree(ring_name);
6522  return FALSE;
6523  }
6524  else
6525  return TRUE;
6526  }
6527  else if (t==CRING_CMD)
6528  {
6529  sleftv tmp;
6530  sleftv n;
6531  n.Init();
6532  n.name=ring_name;
6533  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6534  if (iiAssign(&tmp,arg)) return TRUE;
6535  //Print("create %s\n",r->Name());
6536  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6537  return FALSE;
6538  }
6539  //Print("create %s\n",r->Name());
6540  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6541  return TRUE;// not handled -> error for now
6542 }
const char * name
Definition: subexpr.h:87
VAR int myynest
Definition: febase.cc:41
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition: ipshell.cc:1198
idhdl rDefault(const char *s)
Definition: ipshell.cc:1644
void rSetHdl(idhdl h)
Definition: ipshell.cc:5125

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  r,
leftv  args 
)

Definition at line 1273 of file ipshell.cc.

1274 {
1275  // must be inside a proc, as we simultae an proc_end at the end
1276  if (myynest==0)
1277  {
1278  WerrorS("branchTo can only occur in a proc");
1279  return TRUE;
1280  }
1281  // <string1...stringN>,<proc>
1282  // known: args!=NULL, l>=1
1283  int l=args->listLength();
1284  int ll=0;
1285  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1286  if (ll!=(l-1)) return FALSE;
1287  leftv h=args;
1288  // set up the table for type test:
1289  short *t=(short*)omAlloc(l*sizeof(short));
1290  t[0]=l-1;
1291  int b;
1292  int i;
1293  for(i=1;i<l;i++,h=h->next)
1294  {
1295  if (h->Typ()!=STRING_CMD)
1296  {
1297  omFreeBinAddr(t);
1298  Werror("arg %d is not a string",i);
1299  return TRUE;
1300  }
1301  int tt;
1302  b=IsCmd((char *)h->Data(),tt);
1303  if(b) t[i]=tt;
1304  else
1305  {
1306  omFreeBinAddr(t);
1307  Werror("arg %d is not a type name",i);
1308  return TRUE;
1309  }
1310  }
1311  if (h->Typ()!=PROC_CMD)
1312  {
1313  omFreeBinAddr(t);
1314  Werror("last(%d.) arg.(%s) is not a proc(but %s(%d)), nesting=%d",
1315  i,h->name,Tok2Cmdname(h->Typ()),h->Typ(),myynest);
1316  return TRUE;
1317  }
1318  b=iiCheckTypes(iiCurrArgs,t,0);
1319  omFreeBinAddr(t);
1320  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1321  {
1322  // get the proc:
1323  iiCurrProc=(idhdl)h->data;
1324  idhdl currProc=iiCurrProc; /*iiCurrProc may be changed after yyparse*/
1325  procinfo * pi=IDPROC(currProc);
1326  // already loaded ?
1327  if( pi->data.s.body==NULL )
1328  {
1330  if (pi->data.s.body==NULL) return TRUE;
1331  }
1332  // set currPackHdl/currPack
1333  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1334  {
1335  currPack=pi->pack;
1338  //Print("set pack=%s\n",IDID(currPackHdl));
1339  }
1340  // see iiAllStart:
1341  BITSET save1=si_opt_1;
1342  BITSET save2=si_opt_2;
1343  newBuffer( omStrDup(pi->data.s.body), BT_proc,
1344  pi, pi->data.s.body_lineno-(iiCurrArgs==NULL) );
1345  BOOLEAN err=yyparse();
1346  iiCurrProc=NULL;
1347  si_opt_1=save1;
1348  si_opt_2=save2;
1349  // now save the return-expr.
1351  memcpy(&sLastPrinted,&iiRETURNEXPR,sizeof(sleftv));
1352  iiRETURNEXPR.Init();
1353  // warning about args.:
1354  if (iiCurrArgs!=NULL)
1355  {
1356  if (err==0) Warn("too many arguments for %s",IDID(currProc));
1357  iiCurrArgs->CleanUp();
1359  iiCurrArgs=NULL;
1360  }
1361  // similate proc_end:
1362  // - leave input
1363  void myychangebuffer();
1364  myychangebuffer();
1365  // - set the current buffer to its end (this is a pointer in a buffer,
1366  // not a file ptr) "branchTo" is only valid in proc)
1368  // - kill local vars
1370  // - return
1371  newBuffer(omStrDup("\n;return(_);\n"),BT_execute);
1372  return (err!=0);
1373  }
1374  return FALSE;
1375 }
char * buffer
Definition: fevoices.h:69
long fptr
Definition: fevoices.h:70
int listLength()
Definition: subexpr.cc:51
VAR Voice * currentVoice
Definition: fevoices.cc:49
@ BT_execute
Definition: fevoices.h:23
VAR idhdl currPackHdl
Definition: ipid.cc:55
idhdl packFindHdl(package r)
Definition: ipid.cc:831
#define IDID(a)
Definition: ipid.h:122
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:197
VAR idhdl iiCurrProc
Definition: ipshell.cc:81
void iiCheckPack(package &p)
Definition: ipshell.cc:1630
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:6562
void killlocals(int v)
Definition: ipshell.cc:386
void myychangebuffer()
Definition: scanner.cc:2311

◆ iiCallLibProc1()

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

Definition at line 627 of file iplib.cc.

628 {
629  idhdl h=ggetid(n);
630  if ((h==NULL)
631  || (IDTYP(h)!=PROC_CMD))
632  {
633  err=2;
634  return NULL;
635  }
636  // ring handling
637  idhdl save_ringhdl=currRingHdl;
638  ring save_ring=currRing;
640  // argument:
641  sleftv tmp;
642  tmp.Init();
643  tmp.data=arg;
644  tmp.rtyp=arg_type;
645  // call proc
646  err=iiMake_proc(h,currPack,&tmp);
647  // clean up ring
648  iiCallLibProcEnd(save_ringhdl,save_ring);
649  // return
650  if (err==FALSE)
651  {
652  void*r=iiRETURNEXPR.data;
655  return r;
656  }
657  return NULL;
658 }

◆ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1630 of file ipshell.cc.

1631 {
1632  if (p!=basePack)
1633  {
1634  idhdl t=basePack->idroot;
1635  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1636  if (t==NULL)
1637  {
1638  WarnS("package not found\n");
1639  p=basePack;
1640  }
1641  }
1642 }
idhdl next
Definition: idrec.h:38
VAR package basePack
Definition: ipid.cc:58
#define IDPACKAGE(a)
Definition: ipid.h:139
@ PACKAGE_CMD
Definition: tok.h:149

◆ iiCheckRing()

BOOLEAN iiCheckRing ( int  i)

Definition at line 1586 of file ipshell.cc.

1587 {
1588  if (currRing==NULL)
1589  {
1590  #ifdef SIQ
1591  if (siq<=0)
1592  {
1593  #endif
1594  if (RingDependend(i))
1595  {
1596  WerrorS("no ring active (9)");
1597  return TRUE;
1598  }
1599  #ifdef SIQ
1600  }
1601  #endif
1602  }
1603  return FALSE;
1604 }
VAR BOOLEAN siq
Definition: subexpr.cc:48

◆ iiCheckTypes()

BOOLEAN iiCheckTypes ( leftv  args,
const short *  type_list,
int  report = 0 
)

check a list of arguemys against a given field of types return TRUE if the types match return FALSE (and, if report) report an error via Werror otherwise

Parameters
type_list< [in] argument list (may be NULL) [in] field of types len, t1,t2,...
report;in] report error?

Definition at line 6562 of file ipshell.cc.

6563 {
6564  int l=0;
6565  if (args==NULL)
6566  {
6567  if (type_list[0]==0) return TRUE;
6568  }
6569  else l=args->listLength();
6570  if (l!=(int)type_list[0])
6571  {
6572  if (report) iiReportTypes(0,l,type_list);
6573  return FALSE;
6574  }
6575  for(int i=1;i<=l;i++,args=args->next)
6576  {
6577  short t=type_list[i];
6578  if (t!=ANY_TYPE)
6579  {
6580  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6581  || (t!=args->Typ()))
6582  {
6583  if (report) iiReportTypes(i,args->Typ(),type_list);
6584  return FALSE;
6585  }
6586  }
6587  }
6588  return TRUE;
6589 }
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6544
void report(const char *fmt, const char *name)
Definition: shared.cc:666
#define ANY_TYPE
Definition: tok.h:30

◆ iiConvName()

char* iiConvName ( const char *  libname)

Definition at line 1429 of file iplib.cc.

1430 {
1431  char *tmpname = omStrDup(libname);
1432  char *p = strrchr(tmpname, DIR_SEP);
1433  char *r;
1434  if(p==NULL) p = tmpname; else p++;
1435  // p is now the start of the file name (without path)
1436  r=p;
1437  while(isalnum(*r)||(*r=='_')) r++;
1438  // r point the the end of the main part of the filename
1439  *r = '\0';
1440  r = omStrDup(p);
1441  *r = mytoupper(*r);
1442  // printf("iiConvName: '%s' '%s' => '%s'\n", libname, tmpname, r);
1443  omFree((ADDRESS)tmpname);
1444 
1445  return(r);
1446 }
#define DIR_SEP
Definition: feResource.h:6
char mytoupper(char c)
Definition: iplib.cc:1410

◆ iiDebug()

void iiDebug ( )

Definition at line 1065 of file ipshell.cc.

1066 {
1067 #ifdef HAVE_SDB
1068  sdb_flags=1;
1069 #endif
1070  Print("\n-- break point in %s --\n",VoiceName());
1072  char * s;
1074  s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
1075  loop
1076  {
1077  memset(s,0,BREAK_LINE_LENGTH+4);
1079  if (s[BREAK_LINE_LENGTH-1]!='\0')
1080  {
1081  Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
1082  }
1083  else
1084  break;
1085  }
1086  if (*s=='\n')
1087  {
1089  }
1090 #if MDEBUG
1091  else if(strncmp(s,"cont;",5)==0)
1092  {
1094  }
1095 #endif /* MDEBUG */
1096  else
1097  {
1098  strcat( s, "\n;~\n");
1100  }
1101 }
char *(* fe_fgets_stdin)(const char *pr, char *s, int size)
Definition: feread.cc:32
void VoiceBackTrack()
Definition: fevoices.cc:77
VAR BOOLEAN iiDebugMarker
Definition: ipshell.cc:1063
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:1064
VAR int sdb_flags
Definition: sdb.cc:31

◆ iiDeclCommand()

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

Definition at line 1198 of file ipshell.cc.

1199 {
1200  BOOLEAN res=FALSE;
1201  BOOLEAN is_qring=FALSE;
1202  const char *id = name->name;
1203 
1204  sy->Init();
1205  if ((name->name==NULL)||(isdigit(name->name[0])))
1206  {
1207  WerrorS("object to declare is not a name");
1208  res=TRUE;
1209  }
1210  else
1211  {
1212  if (root==NULL) return TRUE;
1213  if (*root!=IDROOT)
1214  {
1215  if ((currRing==NULL) || (*root!=currRing->idroot))
1216  {
1217  Werror("can not define `%s` in other package",name->name);
1218  return TRUE;
1219  }
1220  }
1221  if (t==QRING_CMD)
1222  {
1223  t=RING_CMD; // qring is always RING_CMD
1224  is_qring=TRUE;
1225  }
1226 
1227  if (TEST_V_ALLWARN
1228  && (name->rtyp!=0)
1229  && (name->rtyp!=IDHDL)
1230  && (currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1231  {
1232  Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1234  }
1235  {
1236  sy->data = (char *)enterid(id,lev,t,root,init_b);
1237  }
1238  if (sy->data!=NULL)
1239  {
1240  sy->rtyp=IDHDL;
1241  currid=sy->name=IDID((idhdl)sy->data);
1242  if (is_qring)
1243  {
1245  }
1246  // name->name=NULL; /* used in enterid */
1247  //sy->e = NULL;
1248  if (name->next!=NULL)
1249  {
1251  res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1252  }
1253  }
1254  else res=TRUE;
1255  }
1256  name->CleanUp();
1257  return res;
1258 }
char * filename
Definition: fevoices.h:63
BITSET flag
Definition: subexpr.h:90
VAR int yylineno
Definition: febase.cc:40
VAR char my_yylinebuf[80]
Definition: febase.cc:44
const char * currid
Definition: grammar.cc:171
#define IDLEV(a)
Definition: ipid.h:121
#define Sy_bit(x)
Definition: options.h:31
@ QRING_CMD
Definition: tok.h:158

◆ iiEStart()

BOOLEAN iiEStart ( char *  example,
procinfo pi 
)

Definition at line 754 of file iplib.cc.

755 {
756  BOOLEAN err;
757  int old_echo=si_echo;
758 
759  iiCheckNest();
760  procstack->push(example);
763  {
764  if (traceit&TRACE_SHOW_LINENO) printf("\n");
765  printf("entering example (level %d)\n",myynest);
766  }
767  myynest++;
768 
769  err=iiAllStart(pi,example,BT_example,(pi != NULL ? pi->data.s.example_lineno: 0));
770 
772  myynest--;
773  si_echo=old_echo;
775  {
776  if (traceit&TRACE_SHOW_LINENO) printf("\n");
777  printf("leaving -example- (level %d)\n",myynest);
778  }
779  if (iiLocalRing[myynest] != currRing)
780  {
781  if (iiLocalRing[myynest]!=NULL)
782  {
785  }
786  else
787  {
789  currRing=NULL;
790  }
791  }
792  procstack->pop();
793  return err;
794 }
void pop()
Definition: ipid.cc:813
void push(char *)
Definition: ipid.cc:803
VAR int si_echo
Definition: febase.cc:35
@ BT_example
Definition: fevoices.h:21
VAR proclevel * procstack
Definition: ipid.cc:52
static void iiCheckNest()
Definition: iplib.cc:493
VAR ring * iiLocalRing
Definition: iplib.cc:473
BOOLEAN iiAllStart(procinfov pi, const char *p, feBufferTypes t, int l)
Definition: iplib.cc:298
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1701
#define TRACE_SHOW_LINENO
Definition: reporter.h:31
#define TRACE_SHOW_PROC
Definition: reporter.h:29

◆ iiExport() [1/2]

BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1511 of file ipshell.cc.

1512 {
1513  BOOLEAN nok=FALSE;
1514  leftv r=v;
1515  while (v!=NULL)
1516  {
1517  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1518  {
1519  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1520  nok=TRUE;
1521  }
1522  else
1523  {
1524  if(iiInternalExport(v, toLev))
1525  nok=TRUE;
1526  }
1527  v=v->next;
1528  }
1529  r->CleanUp();
1530  return nok;
1531 }
char name() const
Definition: variable.cc:122
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1412

◆ iiExport() [2/2]

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

Definition at line 1534 of file ipshell.cc.

1535 {
1536 // if ((pack==basePack)&&(pack!=currPack))
1537 // { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
1538  BOOLEAN nok=FALSE;
1539  leftv rv=v;
1540  while (v!=NULL)
1541  {
1542  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
1543  )
1544  {
1545  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1546  nok=TRUE;
1547  }
1548  else
1549  {
1550  idhdl old=pack->idroot->get( v->name,toLev);
1551  if (old!=NULL)
1552  {
1553  if ((pack==currPack) && (old==(idhdl)v->data))
1554  {
1555  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
1556  break;
1557  }
1558  else if (IDTYP(old)==v->Typ())
1559  {
1560  if (BVERBOSE(V_REDEFINE))
1561  {
1562  Warn("redefining %s (%s)",IDID(old),my_yylinebuf);
1563  }
1564  v->name=omStrDup(v->name);
1565  killhdl2(old,&(pack->idroot),currRing);
1566  }
1567  else
1568  {
1569  rv->CleanUp();
1570  return TRUE;
1571  }
1572  }
1573  //Print("iiExport: pack=%s\n",IDID(root));
1574  if(iiInternalExport(v, toLev, pack))
1575  {
1576  rv->CleanUp();
1577  return TRUE;
1578  }
1579  }
1580  v=v->next;
1581  }
1582  rv->CleanUp();
1583  return nok;
1584 }
idhdl get(const char *s, int lev)
Definition: ipid.cc:72
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:445

◆ iiExprArith1()

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

◆ iiExprArith1Tab()

BOOLEAN iiExprArith1Tab ( leftv  res,
leftv  a,
int  op,
const struct sValCmd1 dA1,
int  at,
const struct sConvertTypes dConvertTypes 
)

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

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

Definition at line 8963 of file iparith.cc.

8964 {
8965  res->Init();
8966  BOOLEAN call_failed=FALSE;
8967 
8968  if (!errorreported)
8969  {
8970  BOOLEAN failed=FALSE;
8971  iiOp=op;
8972  int i = 0;
8973  while (dA1[i].cmd==op)
8974  {
8975  if (at==dA1[i].arg)
8976  {
8977  if (currRing!=NULL)
8978  {
8979  if (check_valid(dA1[i].valid_for,op)) break;
8980  }
8981  else
8982  {
8983  if (RingDependend(dA1[i].res))
8984  {
8985  WerrorS("no ring active (5)");
8986  break;
8987  }
8988  }
8989  if (traceit&TRACE_CALL)
8990  Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
8991  res->rtyp=dA1[i].res;
8992  if ((call_failed=dA1[i].p(res,a)))
8993  {
8994  break;// leave loop, goto error handling
8995  }
8996  if (a->Next()!=NULL)
8997  {
8998  res->next=(leftv)omAllocBin(sleftv_bin);
8999  failed=iiExprArith1(res->next,a->next,op);
9000  }
9001  a->CleanUp();
9002  return failed;
9003  }
9004  i++;
9005  }
9006  // implicite type conversion --------------------------------------------
9007  if (dA1[i].cmd!=op)
9008  {
9010  i=0;
9011  //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
9012  while (dA1[i].cmd==op)
9013  {
9014  int ai;
9015  //Print("test %s\n",Tok2Cmdname(dA1[i].arg));
9016  if ((dA1[i].valid_for & NO_CONVERSION)==0)
9017  {
9018  if ((ai=iiTestConvert(at,dA1[i].arg,dConvertTypes))!=0)
9019  {
9020  if (currRing!=NULL)
9021  {
9022  if (check_valid(dA1[i].valid_for,op)) break;
9023  }
9024  else
9025  {
9026  if (RingDependend(dA1[i].res))
9027  {
9028  WerrorS("no ring active (6)");
9029  break;
9030  }
9031  }
9032  if (traceit&TRACE_CALL)
9033  Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(dA1[i].arg));
9034  res->rtyp=dA1[i].res;
9035  failed= ((iiConvert(at,dA1[i].arg,ai,a,an,dConvertTypes))
9036  || (call_failed=dA1[i].p(res,an)));
9037  // everything done, clean up temp. variables
9038  if (failed)
9039  {
9040  // leave loop, goto error handling
9041  break;
9042  }
9043  else
9044  {
9045  if (an->Next() != NULL)
9046  {
9047  res->next = (leftv)omAllocBin(sleftv_bin);
9048  failed=iiExprArith1(res->next,an->next,op);
9049  }
9050  // everything ok, clean up and return
9051  an->CleanUp();
9053  return failed;
9054  }
9055  }
9056  }
9057  i++;
9058  }
9059  an->CleanUp();
9061  }
9062  // error handling
9063  if (!errorreported)
9064  {
9065  if ((at==0) && (a->Fullname()!=sNoName_fe))
9066  {
9067  Werror("`%s` is not defined",a->Fullname());
9068  }
9069  else
9070  {
9071  i=0;
9072  const char *s = iiTwoOps(op);
9073  Werror("%s(`%s`) failed"
9074  ,s,Tok2Cmdname(at));
9075  if ((!call_failed) && BVERBOSE(V_SHOW_USE))
9076  {
9077  while (dA1[i].cmd==op)
9078  {
9079  if ((dA1[i].res!=0)
9080  && (dA1[i].p!=jjWRONG))
9081  Werror("expected %s(`%s`)"
9082  ,s,Tok2Cmdname(dA1[i].arg));
9083  i++;
9084  }
9085  }
9086  }
9087  }
9088  res->rtyp = UNKNOWN;
9089  }
9090  a->CleanUp();
9091  return TRUE;
9092 }
const char * Fullname()
Definition: subexpr.h:125
leftv Next()
Definition: subexpr.h:136
const char sNoName_fe[]
Definition: fevoices.cc:57
const char * iiTwoOps(int t)
Definition: gentable.cc:261
static BOOLEAN jjWRONG(leftv, leftv)
Definition: iparith.cc:3680
const char * Tok2Cmdname(int tok)
Definition: iparith.cc:9627
#define NO_CONVERSION
Definition: iparith.cc:120
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:9093
static BOOLEAN check_valid(const int p, const int op)
Definition: iparith.cc:9907
VAR int iiOp
Definition: iparith.cc:222
const struct sConvertTypes dConvertTypes[]
Definition: table.h:1281
short res
Definition: gentable.cc:82
#define V_SHOW_USE
Definition: options.h:52
#define TRACE_CALL
Definition: reporter.h:44
#define UNKNOWN
Definition: tok.h:222

◆ iiExprArith2()

BOOLEAN iiExprArith2 ( leftv  res,
sleftv a,
int  op,
sleftv b,
BOOLEAN  proccall = FALSE 
)

◆ iiExprArith2Tab()

BOOLEAN iiExprArith2Tab ( leftv  res,
leftv  a,
int  op,
const struct sValCmd2 dA2,
int  at,
const struct sConvertTypes dConvertTypes 
)

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

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

Definition at line 8890 of file iparith.cc.

8894 {
8895  res->Init();
8896  leftv b=a->next;
8897  a->next=NULL;
8898  int bt=b->Typ();
8899  BOOLEAN bo=iiExprArith2TabIntern(res,a,op,b,TRUE,dA2,at,bt,dConvertTypes);
8900  a->next=b;
8901  a->CleanUp(); // to clean up the chain, content already done in iiExprArith2TabIntern
8902  return bo;
8903 }
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:8731

◆ iiExprArith3()

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

Definition at line 9303 of file iparith.cc.

9304 {
9305  res->Init();
9306 
9307  if (!errorreported)
9308  {
9309 #ifdef SIQ
9310  if (siq>0)
9311  {
9312  //Print("siq:%d\n",siq);
9314  memcpy(&d->arg1,a,sizeof(sleftv));
9315  a->Init();
9316  memcpy(&d->arg2,b,sizeof(sleftv));
9317  b->Init();
9318  memcpy(&d->arg3,c,sizeof(sleftv));
9319  c->Init();
9320  d->op=op;
9321  d->argc=3;
9322  res->data=(char *)d;
9323  res->rtyp=COMMAND;
9324  return FALSE;
9325  }
9326 #endif
9327  int at=a->Typ();
9328  // handling bb-objects ----------------------------------------------
9329  if (at>MAX_TOK)
9330  {
9331  blackbox *bb=getBlackboxStuff(at);
9332  if (bb!=NULL)
9333  {
9334  if(!bb->blackbox_Op3(op,res,a,b,c)) return FALSE;
9335  // else: no op defined
9336  }
9337  else
9338  return TRUE;
9339  if (errorreported) return TRUE;
9340  }
9341  int bt=b->Typ();
9342  int ct=c->Typ();
9343 
9344  iiOp=op;
9345  int i=0;
9346  while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
9347  return iiExprArith3TabIntern(res,op,a,b,c,dArith3+i,at,bt,ct,dConvertTypes);
9348  }
9349  a->CleanUp();
9350  b->CleanUp();
9351  c->CleanUp();
9352  //Print("op: %d,result typ:%d\n",op,res->rtyp);
9353  return TRUE;
9354 }
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:9150
VAR omBin sip_command_bin
Definition: ipid.cc:45
ip_command * command
Definition: ipid.h:23
const struct sValCmd3 dArith3[]
Definition: table.h:773
#define COMMAND
Definition: tok.h:29

◆ iiExprArith3Tab()

BOOLEAN iiExprArith3Tab ( leftv  res,
leftv  a,
int  op,
const struct sValCmd3 dA3,
int  at,
const struct sConvertTypes dConvertTypes 
)

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

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

Definition at line 9355 of file iparith.cc.

9359 {
9360  res->Init();
9361  leftv b=a->next;
9362  a->next=NULL;
9363  int bt=b->Typ();
9364  leftv c=b->next;
9365  b->next=NULL;
9366  int ct=c->Typ();
9367  BOOLEAN bo=iiExprArith3TabIntern(res,op,a,b,c,dA3,at,bt,ct,dConvertTypes);
9368  b->next=c;
9369  a->next=b;
9370  a->CleanUp(); // to cleanup the chain, content already done
9371  return bo;
9372 }

◆ iiExprArithM()

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

◆ iiGetLibName()

static char* iiGetLibName ( const procinfov  pi)
inlinestatic

find the library of an proc

Definition at line 66 of file ipshell.h.

66 { return pi->libname; }

◆ iiGetLibProcBuffer()

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

◆ iiGetLibStatus()

BOOLEAN iiGetLibStatus ( const char *  lib)

Definition at line 77 of file iplib.cc.

78 {
79  idhdl hl;
80 
81  char *plib = iiConvName(lib);
82  hl = basePack->idroot->get(plib,0);
83  omFreeBinAddr(plib);
84  if((hl==NULL) ||(IDTYP(hl)!=PACKAGE_CMD))
85  {
86  return FALSE;
87  }
88  if ((IDPACKAGE(hl)->language!=LANG_C)&&(IDPACKAGE(hl)->libname!=NULL))
89  return (strcmp(lib,IDPACKAGE(hl)->libname)==0);
90  return FALSE;
91 }

◆ iiHighCorner()

poly iiHighCorner ( ideal  i,
int  ak 
)

Definition at line 1606 of file ipshell.cc.

1607 {
1608  int i;
1609  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1610  poly po=NULL;
1612  {
1613  scComputeHC(I,currRing->qideal,ak,po);
1614  if (po!=NULL)
1615  {
1616  pGetCoeff(po)=nInit(1);
1617  for (i=rVar(currRing); i>0; i--)
1618  {
1619  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1620  }
1621  pSetComp(po,ak);
1622  pSetm(po);
1623  }
1624  }
1625  else
1626  po=pOne();
1627  return po;
1628 }
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge)
Definition: hdegree.cc:1101
static BOOLEAN idIsZeroDim(ideal i)
Definition: ideals.h:176
static number & pGetCoeff(poly p)
return an alias to the leading coefficient of p assumes that p != NULL NOTE: not copy
Definition: monomials.h:44
#define nInit(i)
Definition: numbers.h:24
#define pSetm(p)
Definition: polys.h:271
#define pSetComp(p, v)
Definition: polys.h:38
#define pGetExp(p, i)
Exponent.
Definition: polys.h:41
#define pOne()
Definition: polys.h:315
#define pDecrExp(p, i)
Definition: polys.h:44
static short rVar(const ring r)
#define rVar(r) (r->N)
Definition: ring.h:593
BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition: ring.h:761

◆ iiInternalExport()

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

Definition at line 1465 of file ipshell.cc.

1466 {
1467  idhdl h=(idhdl)v->data;
1468  if(h==NULL)
1469  {
1470  Warn("'%s': no such identifier\n", v->name);
1471  return FALSE;
1472  }
1473  package frompack=v->req_packhdl;
1474  if (frompack==NULL) frompack=currPack;
1475  if ((RingDependend(IDTYP(h)))
1476  || ((IDTYP(h)==LIST_CMD)
1477  && (lRingDependend(IDLIST(h)))
1478  )
1479  )
1480  {
1481  //Print("// ==> Ringdependent set nesting to 0\n");
1482  return (iiInternalExport(v, toLev));
1483  }
1484  else
1485  {
1486  IDLEV(h)=toLev;
1487  v->req_packhdl=rootpack;
1488  if (h==frompack->idroot)
1489  {
1490  frompack->idroot=h->next;
1491  }
1492  else
1493  {
1494  idhdl hh=frompack->idroot;
1495  while ((hh!=NULL) && (hh->next!=h))
1496  hh=hh->next;
1497  if ((hh!=NULL) && (hh->next==h))
1498  hh->next=h->next;
1499  else
1500  {
1501  Werror("`%s` not found",v->Name());
1502  return TRUE;
1503  }
1504  }
1505  h->next=rootpack->idroot;
1506  rootpack->idroot=h;
1507  }
1508  return FALSE;
1509 }

◆ iiLibCmd()

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

Definition at line 884 of file iplib.cc.

885 {
886  if (strcmp(newlib,"Singular")==0) return FALSE;
887  char libnamebuf[1024];
888  idhdl pl;
889  char *plib = iiConvName(newlib);
890  FILE * fp = feFopen( newlib, "r", libnamebuf, tellerror );
891  // int lines = 1;
892  BOOLEAN LoadResult = TRUE;
893 
894  if (fp==NULL)
895  {
896  return TRUE;
897  }
898  pl = basePack->idroot->get(plib,0);
899  if (pl==NULL)
900  {
901  pl = enterid( plib,0, PACKAGE_CMD,
902  &(basePack->idroot), TRUE );
903  IDPACKAGE(pl)->language = LANG_SINGULAR;
904  IDPACKAGE(pl)->libname=omStrDup(newlib);
905  }
906  else
907  {
908  if(IDTYP(pl)!=PACKAGE_CMD)
909  {
910  omFreeBinAddr(plib);
911  WarnS("not of type package.");
912  fclose(fp);
913  return TRUE;
914  }
915  if (!force)
916  {
917  omFreeBinAddr(plib);
918  return FALSE;
919  }
920  }
921  LoadResult = iiLoadLIB(fp, libnamebuf, newlib, pl, autoexport, tellerror);
922 
923  if(!LoadResult) IDPACKAGE(pl)->loaded = TRUE;
924  omFree((ADDRESS)plib);
925  return LoadResult;
926 }
CanonicalForm fp
Definition: cfModGcd.cc:4102
FILE * feFopen(const char *path, const char *mode, char *where, short useWerror, short path_only)
Definition: feFopen.cc:47
BOOLEAN iiLoadLIB(FILE *fp, const char *libnamebuf, const char *newlib, idhdl pl, BOOLEAN autoexport, BOOLEAN tellerror)
Definition: iplib.cc:973
VAR char libnamebuf[1024]
Definition: libparse.cc:1098

◆ iiLoadLIB()

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

Definition at line 973 of file iplib.cc.

975 {
976  EXTERN_VAR FILE *yylpin;
977  libstackv ls_start = library_stack;
978  lib_style_types lib_style;
979 
980  yylpin = fp;
981  #if YYLPDEBUG > 1
982  print_init();
983  #endif
984  EXTERN_VAR int lpverbose;
986  else lpverbose=0;
987  // yylplex sets also text_buffer
988  if (text_buffer!=NULL) *text_buffer='\0';
989  yylplex(newlib, libnamebuf, &lib_style, pl, autoexport);
990  if(yylp_errno)
991  {
992  Werror("Library %s: ERROR occurred: in line %d, %d.", newlib, yylplineno,
993  current_pos(0));
995  {
999  }
1000  else
1002  WerrorS("Cannot load library,... aborting.");
1003  reinit_yylp();
1004  fclose( yylpin );
1006  return TRUE;
1007  }
1008  if (BVERBOSE(V_LOAD_LIB))
1009  Print( "// ** loaded %s %s\n", libnamebuf, text_buffer);
1010  if( (lib_style == OLD_LIBSTYLE) && (BVERBOSE(V_LOAD_LIB)))
1011  {
1012  Warn( "library %s has old format. This format is still accepted,", newlib);
1013  WarnS( "but for functionality you may wish to change to the new");
1014  WarnS( "format. Please refer to the manual for further information.");
1015  }
1016  reinit_yylp();
1017  fclose( yylpin );
1018  fp = NULL;
1019  iiRunInit(IDPACKAGE(pl));
1020 
1021  {
1022  libstackv ls;
1023  for(ls = library_stack; (ls != NULL) && (ls != ls_start); )
1024  {
1025  if(ls->to_be_done)
1026  {
1027  ls->to_be_done=FALSE;
1028  iiLibCmd(ls->get(),autoexport,tellerror,FALSE);
1029  ls = ls->pop(newlib);
1030  }
1031  }
1032 #if 0
1033  PrintS("--------------------\n");
1034  for(ls = library_stack; ls != NULL; ls = ls->next)
1035  {
1036  Print("%s: LIB-stack:(%d), %s %s\n", newlib, ls->cnt, ls->get(),
1037  ls->to_be_done ? "not loaded" : "loaded");
1038  }
1039  PrintS("--------------------\n");
1040 #endif
1041  }
1042 
1043  if(fp != NULL) fclose(fp);
1044  return FALSE;
1045 }
libstackv next
Definition: subexpr.h:164
libstackv pop(const char *p)
Definition: iplib.cc:1520
int cnt
Definition: subexpr.h:167
char * get()
Definition: subexpr.h:170
BOOLEAN to_be_done
Definition: subexpr.h:166
#define EXTERN_VAR
Definition: globaldefs.h:6
int current_pos(int i=0)
Definition: libparse.cc:3346
void print_init()
Definition: libparse.cc:3482
static void iiCleanProcs(idhdl &root)
Definition: iplib.cc:928
VAR libstackv library_stack
Definition: iplib.cc:68
const char * yylp_errlist[]
Definition: libparse.cc:1114
EXTERN_VAR int yylplineno
Definition: iplib.cc:65
static void iiRunInit(package p)
Definition: iplib.cc:957
EXTERN_VAR int yylp_errno
Definition: iplib.cc:64
void reinit_yylp()
Definition: libparse.cc:3376
VAR char * text_buffer
Definition: libparse.cc:1099
VAR int lpverbose
Definition: libparse.cc:1106
lib_style_types
Definition: libparse.h:9
@ OLD_LIBSTYLE
Definition: libparse.h:9
#define YYLP_BAD_CHAR
Definition: libparse.h:93
int yylplex(const char *libname, const char *libfile, lib_style_types *lib_style, idhdl pl, BOOLEAN autoexport=FALSE, lp_modes=LOAD_LIB)
#define V_DEBUG_LIB
Definition: options.h:48
#define V_LOAD_LIB
Definition: options.h:47

◆ iiLocateLib()

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

Definition at line 870 of file iplib.cc.

871 {
872  char *plib = iiConvName(lib);
873  idhdl pl = basePack->idroot->get(plib,0);
874  if( (pl!=NULL) && (IDTYP(pl)==PACKAGE_CMD) &&
875  (IDPACKAGE(pl)->language == LANG_SINGULAR))
876  {
877  strncpy(where,IDPACKAGE(pl)->libname,127);
878  return TRUE;
879  }
880  else
881  return FALSE;;
882 }

◆ iiMake_proc()

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

Definition at line 504 of file iplib.cc.

505 {
506  int err;
507  procinfov pi = IDPROC(pn);
508  if(pi->is_static && myynest==0)
509  {
510  Werror("'%s::%s()' is a local procedure and cannot be accessed by an user.",
511  pi->libname, pi->procname);
512  return TRUE;
513  }
514  iiCheckNest();
516  //Print("currRing(%d):%s(%x) in %s\n",myynest,IDID(currRingHdl),currRing,IDID(pn));
517  iiRETURNEXPR.Init();
518  procstack->push(pi->procname);
520  || (pi->trace_flag&TRACE_SHOW_PROC))
521  {
523  Print("entering%-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
524  }
525 #ifdef RDEBUG
527 #endif
528  switch (pi->language)
529  {
530  default:
531  case LANG_NONE:
532  WerrorS("undefined proc");
533  err=TRUE;
534  break;
535 
536  case LANG_SINGULAR:
537  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
538  {
539  currPack=pi->pack;
542  //Print("set pack=%s\n",IDID(currPackHdl));
543  }
544  else if ((pack!=NULL)&&(currPack!=pack))
545  {
546  currPack=pack;
549  //Print("set pack=%s\n",IDID(currPackHdl));
550  }
551  err=iiPStart(pn,args);
552  break;
553  case LANG_C:
555  err = (pi->data.o.function)(res, args);
556  memcpy(&iiRETURNEXPR,res,sizeof(iiRETURNEXPR));
558  break;
559  }
561  || (pi->trace_flag&TRACE_SHOW_PROC))
562  {
564  Print("leaving %-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
565  }
566  //const char *n="NULL";
567  //if (currRingHdl!=NULL) n=IDID(currRingHdl);
568  //Print("currRing(%d):%s(%x) after %s\n",myynest,n,currRing,IDID(pn));
569 #ifdef RDEBUG
571 #endif
572  if (err)
573  {
575  //iiRETURNEXPR.Init(); //done by CleanUp
576  }
577  if (iiCurrArgs!=NULL)
578  {
579  if (!err) Warn("too many arguments for %s",IDID(pn));
580  iiCurrArgs->CleanUp();
583  }
584  procstack->pop();
585  if (err)
586  return TRUE;
587  return FALSE;
588 }
static void iiShowLevRings()
Definition: iplib.cc:478
BOOLEAN iiPStart(idhdl pn, leftv v)
Definition: iplib.cc:371
#define TRACE_SHOW_RINGS
Definition: reporter.h:36

◆ iiMakeResolv()

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

Definition at line 847 of file ipshell.cc.

849 {
850  lists L=liMakeResolv(r,length,rlen,typ0,weights);
851  int i=0;
852  idhdl h;
853  char * s=(char *)omAlloc(strlen(name)+5);
854 
855  while (i<=L->nr)
856  {
857  sprintf(s,"%s(%d)",name,i+1);
858  if (i==0)
859  h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
860  else
861  h=enterid(s,myynest,MODUL_CMD,&(currRing->idroot), FALSE);
862  if (h!=NULL)
863  {
864  h->data.uideal=(ideal)L->m[i].data;
865  h->attribute=L->m[i].attribute;
867  Print("//defining: %s as %d-th syzygy module\n",s,i+1);
868  }
869  else
870  {
871  idDelete((ideal *)&(L->m[i].data));
872  Warn("cannot define %s",s);
873  }
874  //L->m[i].data=NULL;
875  //L->m[i].rtyp=0;
876  //L->m[i].attribute=NULL;
877  i++;
878  }
879  omFreeSize((ADDRESS)L->m,(L->nr+1)*sizeof(sleftv));
881  omFreeSize((ADDRESS)s,strlen(name)+5);
882 }
attr attribute
Definition: subexpr.h:89
sleftv * m
Definition: lists.h:46
int nr
Definition: lists.h:44
if(!FE_OPT_NO_SHELL_FLAG)(void) system(sys)
static BOOLEAN length(leftv result, leftv arg)
Definition: interval.cc:257
VAR omBin slists_bin
Definition: lists.cc:23
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:216
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define V_DEF_RES
Definition: options.h:50

◆ iiMap()

leftv iiMap ( map  theMap,
const char *  what 
)

Definition at line 615 of file ipshell.cc.

616 {
617  idhdl w,r;
618  leftv v;
619  int i;
620  nMapFunc nMap;
621 
622  r=IDROOT->get(theMap->preimage,myynest);
623  if ((currPack!=basePack)
624  &&((r==NULL) || ((r->typ != RING_CMD) )))
625  r=basePack->idroot->get(theMap->preimage,myynest);
626  if ((r==NULL) && (currRingHdl!=NULL)
627  && (strcmp(theMap->preimage,IDID(currRingHdl))==0))
628  {
629  r=currRingHdl;
630  }
631  if ((r!=NULL) && (r->typ == RING_CMD))
632  {
633  ring src_ring=IDRING(r);
634  if ((nMap=n_SetMap(src_ring->cf, currRing->cf))==NULL)
635  {
636  Werror("can not map from ground field of %s to current ground field",
637  theMap->preimage);
638  return NULL;
639  }
640  if (IDELEMS(theMap)<src_ring->N)
641  {
642  theMap->m=(polyset)omReallocSize((ADDRESS)theMap->m,
643  IDELEMS(theMap)*sizeof(poly),
644  (src_ring->N)*sizeof(poly));
645 #ifdef HAVE_SHIFTBBA
646  if (rIsLPRing(src_ring))
647  {
648  // src_ring [x,y,z,...]
649  // curr_ring [a,b,c,...]
650  //
651  // map=[a,b,c,d] -> [a,b,c,...]
652  // map=[a,b] -> [a,b,0,...]
653 
654  short src_lV = src_ring->isLPring;
655  short src_ncGenCount = src_ring->LPncGenCount;
656  short src_nVars = src_lV - src_ncGenCount;
657  int src_nblocks = src_ring->N / src_lV;
658 
659  short dest_nVars = currRing->isLPring - currRing->LPncGenCount;
660  short dest_ncGenCount = currRing->LPncGenCount;
661 
662  // add missing NULL generators
663  for(i=IDELEMS(theMap); i < src_lV - src_ncGenCount; i++)
664  {
665  theMap->m[i]=NULL;
666  }
667 
668  // remove superfluous generators
669  for(i = src_nVars; i < IDELEMS(theMap); i++)
670  {
671  if (theMap->m[i] != NULL)
672  {
673  p_Delete(&(theMap->m[i]), currRing);
674  theMap->m[i] = NULL;
675  }
676  }
677 
678  // add ncgen mappings
679  for(i = src_nVars; i < src_lV; i++)
680  {
681  short ncGenIndex = i - src_nVars;
682  if (ncGenIndex < dest_ncGenCount)
683  {
684  poly p = p_One(currRing);
685  p_SetExp(p, dest_nVars + ncGenIndex + 1, 1, currRing);
686  p_Setm(p, currRing);
687  theMap->m[i] = p;
688  }
689  else
690  {
691  theMap->m[i] = NULL;
692  }
693  }
694 
695  // copy the first block to all other blocks
696  for(i = 1; i < src_nblocks; i++)
697  {
698  for(int j = 0; j < src_lV; j++)
699  {
700  theMap->m[(i * src_lV) + j] = p_Copy(theMap->m[j], currRing);
701  }
702  }
703  }
704  else
705  {
706 #endif
707  for(i=IDELEMS(theMap);i<src_ring->N;i++)
708  theMap->m[i]=NULL;
709 #ifdef HAVE_SHIFTBBA
710  }
711 #endif
712  IDELEMS(theMap)=src_ring->N;
713  }
714  if (what==NULL)
715  {
716  WerrorS("argument of a map must have a name");
717  }
718  else if ((w=src_ring->idroot->get(what,myynest))!=NULL)
719  {
720  char *save_r=NULL;
722  sleftv tmpW;
723  tmpW.Init();
724  tmpW.rtyp=IDTYP(w);
725  if (tmpW.rtyp==MAP_CMD)
726  {
727  tmpW.rtyp=IDEAL_CMD;
728  save_r=IDMAP(w)->preimage;
729  IDMAP(w)->preimage=0;
730  }
731  tmpW.data=IDDATA(w);
732  // check overflow
733  BOOLEAN overflow=FALSE;
734  if ((tmpW.rtyp==IDEAL_CMD)
735  || (tmpW.rtyp==MODUL_CMD)
736  || (tmpW.rtyp==MAP_CMD))
737  {
738  ideal id=(ideal)tmpW.data;
739  long *degs=(long*)omAlloc(IDELEMS(id)*sizeof(long));
740  for(int i=IDELEMS(id)-1;i>=0;i--)
741  {
742  poly p=id->m[i];
743  if (p!=NULL) degs[i]=p_Totaldegree(p,src_ring);
744  else degs[i]=0;
745  }
746  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
747  {
748  if (theMap->m[j]!=NULL)
749  {
750  long deg_monexp=pTotaldegree(theMap->m[j]);
751 
752  for(int i=IDELEMS(id)-1;i>=0;i--)
753  {
754  poly p=id->m[i];
755  if ((p!=NULL) && (degs[i]!=0) &&
756  ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)degs[i])/2)))
757  {
758  overflow=TRUE;
759  break;
760  }
761  }
762  }
763  }
764  omFreeSize(degs,IDELEMS(id)*sizeof(long));
765  }
766  else if (tmpW.rtyp==POLY_CMD)
767  {
768  for(int j=IDELEMS(theMap)-1;j>=0 && !overflow;j--)
769  {
770  if (theMap->m[j]!=NULL)
771  {
772  long deg_monexp=pTotaldegree(theMap->m[j]);
773  poly p=(poly)tmpW.data;
774  long deg=0;
775  if ((p!=NULL) && ((deg=p_Totaldegree(p,src_ring))!=0) &&
776  ((unsigned long)deg_monexp > (currRing->bitmask / ((unsigned long)deg)/2)))
777  {
778  overflow=TRUE;
779  break;
780  }
781  }
782  }
783  }
784  if (overflow)
785 #ifdef HAVE_SHIFTBBA
786  // in Letterplace rings the exponent is always 0 or 1! ignore this warning.
787  if (!rIsLPRing(currRing))
788  {
789 #endif
790  Warn("possible OVERFLOW in map, max exponent is %ld",currRing->bitmask/2);
791 #ifdef HAVE_SHIFTBBA
792  }
793 #endif
794 #if 0
795  if (((tmpW.rtyp==IDEAL_CMD)||(tmpW.rtyp==MODUL_CMD)) && idIs0(IDIDEAL(w)))
796  {
797  v->rtyp=tmpW.rtyp;
798  v->data=idInit(IDELEMS(IDIDEAL(w)),IDIDEAL(w)->rank);
799  }
800  else
801 #endif
802  {
803  if ((tmpW.rtyp==IDEAL_CMD)
804  ||(tmpW.rtyp==MODUL_CMD)
805  ||(tmpW.rtyp==MATRIX_CMD)
806  ||(tmpW.rtyp==MAP_CMD))
807  {
808  v->rtyp=tmpW.rtyp;
809  char *tmp = theMap->preimage;
810  theMap->preimage=(char*)1L;
811  // map gets 1 as its rank (as an ideal)
812  v->data=maMapIdeal(IDIDEAL(w), src_ring, (ideal)theMap, currRing,nMap);
813  theMap->preimage=tmp; // map gets its preimage back
814  }
815  if (v->data==NULL) /*i.e. not IDEAL_CMD/MODUL_CMD/MATRIX_CMD/MAP */
816  {
817  if (maApplyFetch(MAP_CMD,theMap,v,&tmpW,src_ring,NULL,NULL,0,nMap))
818  {
819  Werror("cannot map %s(%d)",Tok2Cmdname(w->typ),w->typ);
821  if (save_r!=NULL) IDMAP(w)->preimage=save_r;
822  return NULL;
823  }
824  }
825  }
826  if (save_r!=NULL)
827  {
828  IDMAP(w)->preimage=save_r;
829  IDMAP((idhdl)v)->preimage=omStrDup(save_r);
830  v->rtyp=MAP_CMD;
831  }
832  return v;
833  }
834  else
835  {
836  Werror("%s undefined in %s",what,theMap->preimage);
837  }
838  }
839  else
840  {
841  Werror("cannot find preimage %s",theMap->preimage);
842  }
843  return NULL;
844 }
int typ
Definition: idrec.h:43
static FORCE_INLINE nMapFunc n_SetMap(const coeffs src, const coeffs dst)
set the mapping function pointers for translating numbers from src to dst
Definition: coeffs.h:700
number(* nMapFunc)(number a, const coeffs src, const coeffs dst)
maps "a", which lives in src, into dst
Definition: coeffs.h:73
const CanonicalForm & w
Definition: facAbsFact.cc:51
ideal maMapIdeal(const ideal map_id, const ring preimage_r, const ideal image_id, const ring image_r, const nMapFunc nMap)
polynomial map for ideals/module/matrix map_id: the ideal to map map_r: the base ring for map_id imag...
Definition: gen_maps.cc:87
BOOLEAN idIs0(ideal h)
returns true if h is the zero ideal
#define IDRING(a)
Definition: ipid.h:127
BOOLEAN maApplyFetch(int what, map theMap, leftv res, leftv w, ring preimage_r, int *perm, int *par_perm, int P, nMapFunc nMap)
Definition: maps_ip.cc:45
#define omReallocSize(addr, o_size, size)
Definition: omAllocDecl.h:220
poly p_One(const ring r)
Definition: p_polys.cc:1313
static unsigned long p_SetExp(poly p, const unsigned long e, const unsigned long iBitmask, const int VarOffset)
set a single variable exponent @Note: VarOffset encodes the position in p->exp
Definition: p_polys.h:490
static void p_Setm(poly p, const ring r)
Definition: p_polys.h:235
static void p_Delete(poly *p, const ring r)
Definition: p_polys.h:903
static poly p_Copy(poly p, const ring r)
returns a copy of p
Definition: p_polys.h:848
static long p_Totaldegree(poly p, const ring r)
Definition: p_polys.h:1509
static long pTotaldegree(poly p)
Definition: polys.h:282
poly * polyset
Definition: polys.h:259
static BOOLEAN rIsLPRing(const ring r)
Definition: ring.h:411
#define IDELEMS(i)
Definition: simpleideals.h:23

◆ iiOpsTwoChar()

int iiOpsTwoChar ( const char *  s)

Definition at line 121 of file ipshell.cc.

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

◆ iiParameter()

BOOLEAN iiParameter ( leftv  p)

Definition at line 1376 of file ipshell.cc.

1377 {
1378  if (iiCurrArgs==NULL)
1379  {
1380  if (strcmp(p->name,"#")==0)
1381  return iiDefaultParameter(p);
1382  Werror("not enough arguments for proc %s",VoiceName());
1383  p->CleanUp();
1384  return TRUE;
1385  }
1386  leftv h=iiCurrArgs;
1387  leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1388  BOOLEAN is_default_list=FALSE;
1389  if (strcmp(p->name,"#")==0)
1390  {
1391  is_default_list=TRUE;
1392  rest=NULL;
1393  }
1394  else
1395  {
1396  h->next=NULL;
1397  }
1398  BOOLEAN res=iiAssign(p,h);
1399  if (is_default_list)
1400  {
1401  iiCurrArgs=NULL;
1402  }
1403  else
1404  {
1405  iiCurrArgs=rest;
1406  }
1407  h->CleanUp();
1409  return res;
1410 }
BOOLEAN iiDefaultParameter(leftv p)
Definition: ipshell.cc:1260

◆ iiProcArgs()

char* iiProcArgs ( char *  e,
BOOLEAN  withParenth 
)

Definition at line 114 of file iplib.cc.

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

◆ iiProcName()

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

Definition at line 100 of file iplib.cc.

101 {
102  char *s=buf+5;
103  while (*s==' ') s++;
104  e=s+1;
105  while ((*e>' ') && (*e!='(')) e++;
106  ct=*e;
107  *e='\0';
108  return s;
109 }
int status int void * buf
Definition: si_signals.h:59

◆ iiPStart()

BOOLEAN iiPStart ( idhdl  pn,
leftv  sl 
)

Definition at line 371 of file iplib.cc.

372 {
373  procinfov pi=NULL;
374  int old_echo=si_echo;
375  BOOLEAN err=FALSE;
376  char save_flags=0;
377 
378  /* init febase ======================================== */
379  /* we do not enter this case if filename != NULL !! */
380  if (pn!=NULL)
381  {
382  pi = IDPROC(pn);
383  if(pi!=NULL)
384  {
385  save_flags=pi->trace_flag;
386  if( pi->data.s.body==NULL )
387  {
389  if (pi->data.s.body==NULL) return TRUE;
390  }
391 // omUpdateInfo();
392 // int m=om_Info.UsedBytes;
393 // Print("proc %s, mem=%d\n",IDID(pn),m);
394  }
395  }
396  else return TRUE;
397  /* generate argument list ======================================*/
398  //iiCurrArgs should be NULL here, as the assignment for the parameters
399  // of the prevouis call are already done befor calling another routine
400  if (v!=NULL)
401  {
403  memcpy(iiCurrArgs,v,sizeof(sleftv)); // keeps track of v->next etc.
404  v->Init();
405  }
406  else
407  {
409  }
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  iiCurrProc=pn;
420  err=iiAllStart(pi,pi->data.s.body,BT_proc,pi->data.s.body_lineno-(v!=NULL));
422 
423  if (iiLocalRing[myynest-1] != currRing)
424  {
426  {
427  //idhdl hn;
428  const char *n;
429  const char *o;
430  idhdl nh=NULL, oh=NULL;
431  if (iiLocalRing[myynest-1]!=NULL)
433  if (oh!=NULL) o=oh->id;
434  else o="none";
435  if (currRing!=NULL)
436  nh=rFindHdl(currRing,NULL);
437  if (nh!=NULL) n=nh->id;
438  else n="none";
439  Werror("ring change during procedure call %s: %s -> %s (level %d)",pi->procname,o,n,myynest);
441  err=TRUE;
442  }
444  }
445  if ((currRing==NULL)
446  && (currRingHdl!=NULL))
448  else
449  if ((currRing!=NULL) &&
451  ||(IDLEV(currRingHdl)>=myynest-1)))
452  {
455  }
456  //Print("kill locals for %s (level %d)\n",IDID(pn),myynest);
458 #ifndef SING_NDEBUG
459  checkall();
460 #endif
461  //Print("end kill locals for %s (%d)\n",IDID(pn),myynest);
462  }
463  myynest--;
464  si_echo=old_echo;
465  if (pi!=NULL)
466  pi->trace_flag=save_flags;
467 // omUpdateInfo();
468 // int m=om_Info.UsedBytes;
469 // Print("exit %s, mem=%d\n",IDID(pn),m);
470  return err;
471 }
const char * id
Definition: idrec.h:39
BOOLEAN RingDependend()
Definition: subexpr.cc:418
#define SI_MAX_NEST
Definition: iplib.cc:27

◆ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 1037 of file ipshell.cc.

1038 {
1039  int len,reg,typ0;
1040 
1041  resolvente r=liFindRes(L,&len,&typ0);
1042 
1043  if (r==NULL)
1044  return -2;
1045  intvec *weights=NULL;
1046  int add_row_shift=0;
1047  intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
1048  if (ww!=NULL)
1049  {
1050  weights=ivCopy(ww);
1051  add_row_shift = ww->min_in();
1052  (*weights) -= add_row_shift;
1053  }
1054  //Print("attr:%x\n",weights);
1055 
1056  intvec *dummy=syBetti(r,len,&reg,weights);
1057  if (weights!=NULL) delete weights;
1058  delete dummy;
1059  omFreeSize((ADDRESS)r,len*sizeof(ideal));
1060  return reg+1+add_row_shift;
1061 }
void * atGet(idhdl root, const char *name, int t, void *defaultReturnValue)
Definition: attrib.cc:132
int min_in()
Definition: intvec.h:121
ideal * resolvente
Definition: ideals.h:18
intvec * ivCopy(const intvec *o)
Definition: intvec.h:145
resolvente liFindRes(lists L, int *len, int *typ0, intvec ***weights)
Definition: lists.cc:315
intvec * syBetti(resolvente res, int length, int *regularity, intvec *weights, BOOLEAN tomin, int *row_shift)
Definition: syz.cc:770

◆ iiSetReturn()

void iiSetReturn ( const leftv  h)

Definition at line 6591 of file ipshell.cc.

6592 {
6593  if ((source->next==NULL)&&(source->e==NULL))
6594  {
6595  if ((source->rtyp!=IDHDL)&&(source->rtyp!=ALIAS_CMD))
6596  {
6597  memcpy(&iiRETURNEXPR,source,sizeof(sleftv));
6598  source->Init();
6599  return;
6600  }
6601  if (source->rtyp==IDHDL)
6602  {
6603  if ((IDLEV((idhdl)source->data)==myynest)
6604  &&(IDTYP((idhdl)source->data)!=RING_CMD))
6605  {
6606  iiRETURNEXPR.Init();
6607  iiRETURNEXPR.rtyp=IDTYP((idhdl)source->data);
6608  iiRETURNEXPR.data=IDDATA((idhdl)source->data);
6609  iiRETURNEXPR.flag=IDFLAG((idhdl)source->data);
6610  iiRETURNEXPR.attribute=IDATTR((idhdl)source->data);
6611  IDATTR((idhdl)source->data)=NULL;
6612  IDDATA((idhdl)source->data)=NULL;
6613  source->name=NULL;
6614  source->attribute=NULL;
6615  return;
6616  }
6617  }
6618  }
6619  iiRETURNEXPR.Copy(source);
6620 }
void Copy(leftv e)
Definition: subexpr.cc:685

◆ iiTestAssume()

BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6443 of file ipshell.cc.

6444 {
6445  // assume a: level
6446  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6447  {
6448  if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6449  char assume_yylinebuf[80];
6450  strncpy(assume_yylinebuf,my_yylinebuf,79);
6451  int lev=(long)a->Data();
6452  int startlev=0;
6453  idhdl h=ggetid("assumeLevel");
6454  if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6455  if(lev <=startlev)
6456  {
6457  BOOLEAN bo=b->Eval();
6458  if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6459  if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6460  if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6461  }
6462  }
6463  b->CleanUp();
6464  a->CleanUp();
6465  return FALSE;
6466 }
void * Data()
Definition: subexpr.cc:1154
#define IDINT(a)
Definition: ipid.h:125

◆ iiTokType()

int iiTokType ( int  op)

Definition at line 237 of file iparith.cc.

238 {
239  for (unsigned i=0;i<sArithBase.nCmdUsed;i++)
240  {
241  if (sArithBase.sCmds[i].tokval==op)
242  return sArithBase.sCmds[i].toktype;
243  }
244  return 0;
245 }
cmdnames * sCmds
array of existing commands
Definition: iparith.cc:186
STATIC_VAR SArithBase sArithBase
Base entry for arithmetic.
Definition: iparith.cc:201
unsigned nCmdUsed
number of commands used
Definition: iparith.cc:191

◆ iiTryLoadLib()

BOOLEAN iiTryLoadLib ( leftv  v,
const char *  id 
)

Definition at line 823 of file iplib.cc.

824 {
825  BOOLEAN LoadResult = TRUE;
826  char libnamebuf[1024];
827  char *libname = (char *)omAlloc(strlen(id)+5);
828  const char *suffix[] = { "", ".lib", ".so", ".sl", NULL };
829  int i = 0;
830  // FILE *fp;
831  // package pack;
832  // idhdl packhdl;
833  lib_types LT;
834  for(i=0; suffix[i] != NULL; i++)
835  {
836  sprintf(libname, "%s%s", id, suffix[i]);
837  *libname = mytolower(*libname);
838  if((LT = type_of_LIB(libname, libnamebuf)) > LT_NOTFOUND)
839  {
840  #ifdef HAVE_DYNAMIC_LOADING
841  char libnamebuf[1024];
842  #endif
843 
844  if (LT==LT_SINGULAR)
845  LoadResult = iiLibCmd(libname, FALSE, FALSE,TRUE);
846  #ifdef HAVE_DYNAMIC_LOADING
847  else if ((LT==LT_ELF) || (LT==LT_HPUX))
848  LoadResult = load_modules(libname,libnamebuf,FALSE);
849  #endif
850  else if (LT==LT_BUILTIN)
851  {
852  LoadResult=load_builtin(libname,FALSE, iiGetBuiltinModInit(libname));
853  }
854  if(!LoadResult )
855  {
856  v->name = iiConvName(libname);
857  break;
858  }
859  }
860  }
861  omFree(libname);
862  return LoadResult;
863 }
BOOLEAN load_modules(const char *newlib, char *fullname, BOOLEAN autoexport)
Definition: iplib.cc:1284
char mytolower(char c)
Definition: iplib.cc:1416
BOOLEAN load_builtin(const char *newlib, BOOLEAN autoexport, SModulFunc_t init)
Definition: iplib.cc:1294
SModulFunc_t iiGetBuiltinModInit(const char *libname)
Definition: iplib.cc:807
lib_types type_of_LIB(const char *newlib, char *libnamebuf)
Definition: mod_lib.cc:27
lib_types
Definition: mod_raw.h:16
@ LT_HPUX
Definition: mod_raw.h:16
@ LT_SINGULAR
Definition: mod_raw.h:16
@ LT_BUILTIN
Definition: mod_raw.h:16
@ LT_ELF
Definition: mod_raw.h:16
@ LT_NOTFOUND
Definition: mod_raw.h:16

◆ iiTwoOps()

const char* iiTwoOps ( int  t)

Definition at line 261 of file gentable.cc.

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

◆ iiWRITE()

BOOLEAN iiWRITE ( leftv  res,
leftv  exprlist 
)

Definition at line 588 of file ipshell.cc.

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

◆ IsCmd()

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

Definition at line 9503 of file iparith.cc.

9504 {
9505  int i;
9506  int an=1;
9507  int en=sArithBase.nLastIdentifier;
9508 
9509  loop
9510  //for(an=0; an<sArithBase.nCmdUsed; )
9511  {
9512  if(an>=en-1)
9513  {
9514  if (strcmp(n, sArithBase.sCmds[an].name) == 0)
9515  {
9516  i=an;
9517  break;
9518  }
9519  else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
9520  {
9521  i=en;
9522  break;
9523  }
9524  else
9525  {
9526  // -- blackbox extensions:
9527  // return 0;
9528  return blackboxIsCmd(n,tok);
9529  }
9530  }
9531  i=(an+en)/2;
9532  if (*n < *(sArithBase.sCmds[i].name))
9533  {
9534  en=i-1;
9535  }
9536  else if (*n > *(sArithBase.sCmds[i].name))
9537  {
9538  an=i+1;
9539  }
9540  else
9541  {
9542  int v=strcmp(n,sArithBase.sCmds[i].name);
9543  if(v<0)
9544  {
9545  en=i-1;
9546  }
9547  else if(v>0)
9548  {
9549  an=i+1;
9550  }
9551  else /*v==0*/
9552  {
9553  break;
9554  }
9555  }
9556  }
9558  tok=sArithBase.sCmds[i].tokval;
9559  if(sArithBase.sCmds[i].alias==2)
9560  {
9561  Warn("outdated identifier `%s` used - please change your code",
9562  sArithBase.sCmds[i].name);
9563  sArithBase.sCmds[i].alias=1;
9564  }
9565  #if 0
9566  if (currRingHdl==NULL)
9567  {
9568  #ifdef SIQ
9569  if (siq<=0)
9570  {
9571  #endif
9572  if ((tok>=BEGIN_RING) && (tok<=END_RING))
9573  {
9574  WerrorS("no ring active");
9575  return 0;
9576  }
9577  #ifdef SIQ
9578  }
9579  #endif
9580  }
9581  #endif
9582  if (!expected_parms)
9583  {
9584  switch (tok)
9585  {
9586  case IDEAL_CMD:
9587  case INT_CMD:
9588  case INTVEC_CMD:
9589  case MAP_CMD:
9590  case MATRIX_CMD:
9591  case MODUL_CMD:
9592  case POLY_CMD:
9593  case PROC_CMD:
9594  case RING_CMD:
9595  case STRING_CMD:
9596  cmdtok = tok;
9597  break;
9598  }
9599  }
9600  return sArithBase.sCmds[i].toktype;
9601 }
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:218
@ END_RING
Definition: grammar.cc:310
@ BEGIN_RING
Definition: grammar.cc:282
unsigned nLastIdentifier
valid indentifieres are slot 1..nLastIdentifier
Definition: iparith.cc:193
EXTERN_VAR BOOLEAN expected_parms
Definition: iparith.cc:218
EXTERN_VAR int cmdtok
Definition: iparith.cc:217
const char * lastreserved
Definition: ipshell.cc:82

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv  res,
leftv  v 
)

Definition at line 967 of file ipshell.cc.

968 {
969  sleftv tmp;
970  tmp.Init();
971  tmp.rtyp=INT_CMD;
972  tmp.data=(void *)1;
973  if ((u->Typ()==IDEAL_CMD)
974  || (u->Typ()==MODUL_CMD))
975  return jjBETTI2_ID(res,u,&tmp);
976  else
977  return jjBETTI2(res,u,&tmp);
978 }
BOOLEAN jjBETTI2_ID(leftv res, leftv u, leftv v)
Definition: ipshell.cc:980
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:1001

◆ jjBETTI2()

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

Definition at line 1001 of file ipshell.cc.

1002 {
1003  resolvente r;
1004  int len;
1005  int reg,typ0;
1006  lists l=(lists)u->Data();
1007 
1008  intvec *weights=NULL;
1009  int add_row_shift=0;
1010  intvec *ww=NULL;
1011  if (l->nr>=0) ww=(intvec *)atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
1012  if (ww!=NULL)
1013  {
1014  weights=ivCopy(ww);
1015  add_row_shift = ww->min_in();
1016  (*weights) -= add_row_shift;
1017  }
1018  //Print("attr:%x\n",weights);
1019 
1020  r=liFindRes(l,&len,&typ0);
1021  if (r==NULL) return TRUE;
1022  intvec* res_im=syBetti(r,len,&reg,weights,(int)(long)v->Data());
1023  res->data=(void*)res_im;
1024  omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
1025  //Print("rowShift: %d ",add_row_shift);
1026  for(int i=1;i<=res_im->rows();i++)
1027  {
1028  if (IMATELEM(*res_im,1,i)==0) { add_row_shift--; }
1029  else break;
1030  }
1031  //Print(" %d\n",add_row_shift);
1032  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
1033  if (weights!=NULL) delete weights;
1034  return FALSE;
1035 }
void atSet(idhdl root, char *name, void *data, int typ)
Definition: attrib.cc:153
int rows() const
Definition: intvec.h:96
#define IMATELEM(M, I, J)
Definition: intvec.h:85

◆ jjBETTI2_ID()

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

Definition at line 980 of file ipshell.cc.

981 {
983  l->Init(1);
984  l->m[0].rtyp=u->Typ();
985  l->m[0].data=u->Data();
986  attr *a=u->Attribute();
987  if (a!=NULL)
988  l->m[0].attribute=*a;
989  sleftv tmp2;
990  tmp2.Init();
991  tmp2.rtyp=LIST_CMD;
992  tmp2.data=(void *)l;
993  BOOLEAN r=jjBETTI2(res,&tmp2,v);
994  l->m[0].data=NULL;
995  l->m[0].attribute=NULL;
996  l->m[0].rtyp=DEF_CMD;
997  l->Clean();
998  return r;
999 }
Definition: attrib.h:21
attr * Attribute()
Definition: subexpr.cc:1454
CFList tmp2
Definition: facFqBivar.cc:72

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3346 of file ipshell.cc.

3347 {
3348  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3349  return (res->data==NULL);
3350 }
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition: clapsing.cc:1571

◆ jjIMPORTFROM()

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

Definition at line 2369 of file ipassign.cc.

2370 {
2371  //Print("importfrom %s::%s ->.\n",v->Name(),u->Name() );
2372  assume(u->Typ()==PACKAGE_CMD);
2373  char *vn=(char *)v->Name();
2374  idhdl h=((package)(u->Data()))->idroot->get(vn /*v->Name()*/, myynest);
2375  if (h!=NULL)
2376  {
2377  //check for existence
2378  if (((package)(u->Data()))==basePack)
2379  {
2380  WarnS("source and destination packages are identical");
2381  return FALSE;
2382  }
2383  idhdl t=basePack->idroot->get(vn /*v->Name()*/, myynest);
2384  if (t!=NULL)
2385  {
2386  if (BVERBOSE(V_REDEFINE)) Warn("redefining %s (%s)",vn,my_yylinebuf);
2387  killhdl(t);
2388  }
2389  sleftv tmp_expr;
2390  if (iiDeclCommand(&tmp_expr,v,myynest,DEF_CMD,&IDROOT)) return TRUE;
2391  sleftv h_expr;
2392  memset(&h_expr,0,sizeof(h_expr));
2393  h_expr.rtyp=IDHDL;
2394  h_expr.data=h;
2395  h_expr.name=vn;
2396  return iiAssign(&tmp_expr,&h_expr);
2397  }
2398  else
2399  {
2400  Werror("`%s` not found in `%s`",v->Name(), u->Name());
2401  return TRUE;
2402  }
2403  return FALSE;
2404 }
void killhdl(idhdl h, package proot)
Definition: ipid.cc:414
#define assume(x)
Definition: mod2.h:389
ip_package * package
Definition: structs.h:43

◆ jjLIST_PL()

BOOLEAN jjLIST_PL ( leftv  res,
leftv  v 
)

Definition at line 7978 of file iparith.cc.

7979 {
7980  int sl=0;
7981  if (v!=NULL) sl = v->listLength();
7982  lists L;
7983  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7984  {
7985  int add_row_shift = 0;
7986  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7987  if (weights!=NULL) add_row_shift=weights->min_in();
7988  L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7989  }
7990  else
7991  {
7993  leftv h=NULL;
7994  int i;
7995  int rt;
7996 
7997  L->Init(sl);
7998  for (i=0;i<sl;i++)
7999  {
8000  if (h!=NULL)
8001  { /* e.g. not in the first step:
8002  * h is the pointer to the old sleftv,
8003  * v is the pointer to the next sleftv
8004  * (in this moment) */
8005  h->next=v;
8006  }
8007  h=v;
8008  v=v->next;
8009  h->next=NULL;
8010  rt=h->Typ();
8011  if (rt==0)
8012  {
8013  L->Clean();
8014  Werror("`%s` is undefined",h->Fullname());
8015  return TRUE;
8016  }
8017  if (rt==RING_CMD)
8018  {
8019  L->m[i].rtyp=rt;
8020  L->m[i].data=rIncRefCnt(((ring)h->Data()));
8021  }
8022  else
8023  L->m[i].Copy(h);
8024  }
8025  }
8026  res->data=(char *)L;
8027  return FALSE;
8028 }
void Clean(ring r=currRing)
Definition: lists.h:26
INLINE_THIS void Init(int l=0)
lists syConvRes(syStrategy syzstr, BOOLEAN toDel, int add_row_shift)
Definition: ipshell.cc:3183
static ring rIncRefCnt(ring r)
Definition: ring.h:843

◆ jjLOAD()

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

load lib/module given in v

Definition at line 5492 of file iparith.cc.

5493 {
5494  char libnamebuf[1024];
5496 
5497 #ifdef HAVE_DYNAMIC_LOADING
5498  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5499 #endif /* HAVE_DYNAMIC_LOADING */
5500  switch(LT)
5501  {
5502  default:
5503  case LT_NONE:
5504  Werror("%s: unknown type", s);
5505  break;
5506  case LT_NOTFOUND:
5507  Werror("cannot open %s", s);
5508  break;
5509 
5510  case LT_SINGULAR:
5511  {
5512  char *plib = iiConvName(s);
5513  idhdl pl = IDROOT->get_level(plib,0);
5514  if (pl==NULL)
5515  {
5516  pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5517  IDPACKAGE(pl)->language = LANG_SINGULAR;
5518  IDPACKAGE(pl)->libname=omStrDup(s);
5519  }
5520  else if (IDTYP(pl)!=PACKAGE_CMD)
5521  {
5522  Werror("can not create package `%s`",plib);
5523  omFreeBinAddr(plib);
5524  return TRUE;
5525  }
5526  else /* package */
5527  {
5528  package pa=IDPACKAGE(pl);
5529  if ((pa->language==LANG_C)
5530  || (pa->language==LANG_MIX))
5531  {
5532  Werror("can not create package `%s` - binaries exists",plib);
5533  omFreeBinAddr(plib);
5534  return TRUE;
5535  }
5536  }
5537  omFreeBinAddr(plib);
5538  package savepack=currPack;
5539  currPack=IDPACKAGE(pl);
5540  IDPACKAGE(pl)->loaded=TRUE;
5541  char libnamebuf[1024];
5542  FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5543  BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5544  currPack=savepack;
5545  IDPACKAGE(pl)->loaded=(!bo);
5546  return bo;
5547  }
5548  case LT_BUILTIN:
5549  SModulFunc_t iiGetBuiltinModInit(const char*);
5550  return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5551  case LT_MACH_O:
5552  case LT_ELF:
5553  case LT_HPUX:
5554 #ifdef HAVE_DYNAMIC_LOADING
5555  return load_modules(s, libnamebuf, autoexport);
5556 #else /* HAVE_DYNAMIC_LOADING */
5557  WerrorS("Dynamic modules are not supported by this version of Singular");
5558  break;
5559 #endif /* HAVE_DYNAMIC_LOADING */
5560  }
5561  return TRUE;
5562 }
BOOLEAN pa(leftv res, leftv args)
Definition: cohomo.cc:4323
BOOLEAN load_builtin(const char *newlib, BOOLEAN autoexport, SModulFunc_t init)
Definition: iplib.cc:1294
int(* SModulFunc_t)(SModulFunctions *)
Definition: ipid.h:81
@ LT_MACH_O
Definition: mod_raw.h:16
@ LT_NONE
Definition: mod_raw.h:16

◆ jjLOAD_TRY()

BOOLEAN jjLOAD_TRY ( const char *  s)

Definition at line 5568 of file iparith.cc.

5569 {
5570  if (!iiGetLibStatus(s))
5571  {
5572  void (*WerrorS_save)(const char *s) = WerrorS_callback;
5575  BOOLEAN bo=jjLOAD(s,TRUE);
5576  if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
5577  Print("loading of >%s< failed\n",s);
5578  WerrorS_callback=WerrorS_save;
5579  errorreported=0;
5580  }
5581  return FALSE;
5582 }
VAR void(* WerrorS_callback)(const char *s)
Definition: feFopen.cc:21
BOOLEAN jjLOAD(const char *s, BOOLEAN autoexport)
load lib/module given in v
Definition: iparith.cc:5492
STATIC_VAR int WerrorS_dummy_cnt
Definition: iparith.cc:5563
static void WerrorS_dummy(const char *)
Definition: iparith.cc:5564
BOOLEAN iiGetLibStatus(const char *lib)
Definition: iplib.cc:77
#define TEST_OPT_PROT
Definition: options.h:104

◆ jjMINRES()

BOOLEAN jjMINRES ( leftv  res,
leftv  v 
)

Definition at line 946 of file ipshell.cc.

947 {
948  int len=0;
949  int typ0;
950  lists L=(lists)v->Data();
951  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
952  int add_row_shift = 0;
953  if (weights==NULL)
954  weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
955  if (weights!=NULL) add_row_shift=weights->min_in();
956  resolvente rr=liFindRes(L,&len,&typ0);
957  if (rr==NULL) return TRUE;
958  resolvente r=iiCopyRes(rr,len);
959 
960  syMinimizeResolvente(r,len,0);
961  omFreeSize((ADDRESS)rr,len*sizeof(ideal));
962  len++;
963  res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
964  return FALSE;
965 }
static resolvente iiCopyRes(resolvente r, int l)
Definition: ipshell.cc:936
void syMinimizeResolvente(resolvente res, int length, int first)
Definition: syz.cc:355

◆ jjRESULTANT()

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

Definition at line 3339 of file ipshell.cc.

3340 {
3341  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3342  (poly)w->CopyD(), currRing);
3343  return errorreported;
3344 }
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition: clapsing.cc:345

◆ jjSetMinpoly()

coeffs jjSetMinpoly ( coeffs  cf,
number  a 
)

Definition at line 175 of file ipassign.cc.

176 {
177  if ( !nCoeff_is_transExt(cf) )
178  {
179  if(!nCoeff_is_algExt(cf) )
180  {
181  WerrorS("cannot set minpoly for these coeffients");
182  return NULL;
183  }
184  }
185  if (rVar(cf->extRing)!=1)
186  {
187  WerrorS("only univariate minpoly allowed");
188  return NULL;
189  }
190 
191  number p = n_Copy(a,cf);
192  n_Normalize(p, cf);
193 
194  if (n_IsZero(p, cf))
195  {
196  n_Delete(&p, cf);
197  return cf;
198  }
199 
200  AlgExtInfo A;
201 
202  A.r = rCopy(cf->extRing); // Copy ground field!
203  // if minpoly was already set:
204  if( cf->extRing->qideal != NULL ) id_Delete(&(A.r->qideal),A.r);
205  ideal q = idInit(1,1);
206  if ((p==NULL) ||(NUM((fraction)p)==NULL))
207  {
208  WerrorS("Could not construct the alg. extension: minpoly==0");
209  // cleanup A: TODO
210  rDelete( A.r );
211  return NULL;
212  }
213  if (DEN((fraction)(p)) != NULL) // minpoly must be a fraction with poly numerator...!!
214  {
215  poly n=DEN((fraction)(p));
216  if(!p_IsConstant(n,cf->extRing))
217  {
218  WarnS("denominator must be constant - ignoring it");
219  }
220  p_Delete(&n,cf->extRing);
221  DEN((fraction)(p))=NULL;
222  }
223 
224  q->m[0] = NUM((fraction)p);
225  A.r->qideal = q;
226 
228  NUM((fractionObject *)p) = NULL; // not necessary, but still...
230 
231  coeffs new_cf = nInitChar(n_algExt, &A);
232  if (new_cf==NULL)
233  {
234  WerrorS("Could not construct the alg. extension: illegal minpoly?");
235  // cleanup A: TODO
236  rDelete( A.r );
237  return NULL;
238  }
239  return new_cf;
240 }
struct for passing initialization parameters to naInitChar
Definition: algext.h:37
CanonicalForm cf
Definition: cfModGcd.cc:4083
static FORCE_INLINE number n_Copy(number n, const coeffs r)
return a copy of 'n'
Definition: coeffs.h:451
@ n_algExt
used for all algebraic extensions, i.e., the top-most extension in an extension tower is algebraic
Definition: coeffs.h:35
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:392
static FORCE_INLINE BOOLEAN n_IsZero(number n, const coeffs r)
TRUE iff 'n' represents the zero element.
Definition: coeffs.h:464
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:910
static FORCE_INLINE void n_Normalize(number &n, const coeffs r)
inplace-normalization of n; produces some canonical representation of n;
Definition: coeffs.h:578
static FORCE_INLINE BOOLEAN nCoeff_is_transExt(const coeffs r)
TRUE iff r represents a transcendental extension field.
Definition: coeffs.h:918
omBin_t * omBin
Definition: omStructs.h:12
static BOOLEAN p_IsConstant(const poly p, const ring r)
Definition: p_polys.h:2005
@ NUM
Definition: readcf.cc:170
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:450
ring rCopy(ring r)
Definition: ring.cc:1731
void id_Delete(ideal *h, ring r)
deletes an ideal/module/matrix
#define A
Definition: sirandom.c:24
VAR omBin fractionObjectBin
Definition: transext.cc:89

◆ jjSYSTEM()

BOOLEAN jjSYSTEM ( leftv  res,
leftv  v 
)

Definition at line 232 of file extra.cc.

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

◆ jjVARIABLES_ID()

BOOLEAN jjVARIABLES_ID ( leftv  res,
leftv  u 
)

Definition at line 6308 of file ipshell.cc.

6309 {
6310  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6311  ideal I=(ideal)u->Data();
6312  int i;
6313  int n=0;
6314  for(i=I->nrows*I->ncols-1;i>=0;i--)
6315  {
6316  int n0=pGetVariables(I->m[i],e);
6317  if (n0>n) n=n0;
6318  }
6319  jjINT_S_TO_ID(n,e,res);
6320  return FALSE;
6321 }
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6278
#define omAlloc0(size)
Definition: omAllocDecl.h:211
#define pGetVariables(p, e)
Definition: polys.h:251

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6300 of file ipshell.cc.

6301 {
6302  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6303  int n=pGetVariables((poly)u->Data(),e);
6304  jjINT_S_TO_ID(n,e,res);
6305  return FALSE;
6306 }

◆ killlocals()

void killlocals ( int  v)

Definition at line 386 of file ipshell.cc.

387 {
388  BOOLEAN changed=FALSE;
389  idhdl sh=currRingHdl;
390  ring cr=currRing;
391  if (sh!=NULL) changed=((IDLEV(sh)<v) || (IDRING(sh)->ref>0));
392  //if (changed) Print("currRing=%s(%x), lev=%d,ref=%d\n",IDID(sh),IDRING(sh),IDLEV(sh),IDRING(sh)->ref);
393 
394  killlocals_rec(&(basePack->idroot),v,currRing);
395 
397  {
398  int t=iiRETURNEXPR.Typ();
399  if (/*iiRETURNEXPR.Typ()*/ t==RING_CMD)
400  {
402  if (((ring)h->data)->idroot!=NULL)
403  killlocals0(v,&(((ring)h->data)->idroot),(ring)h->data);
404  }
405  else if (/*iiRETURNEXPR.Typ()*/ t==LIST_CMD)
406  {
408  changed |=killlocals_list(v,(lists)h->data);
409  }
410  }
411  if (changed)
412  {
414  if (currRingHdl==NULL)
415  currRing=NULL;
416  else if(cr!=currRing)
417  rChangeCurrRing(cr);
418  }
419 
420  if (myynest<=1) iiNoKeepRing=TRUE;
421  //Print("end killlocals >= %d\n",v);
422  //listall();
423 }
VAR int iiRETURNEXPR_len
Definition: iplib.cc:475
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:366
STATIC_VAR BOOLEAN iiNoKeepRing
Definition: ipshell.cc:84
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:330
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:295

◆ kQHWeight()

BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3322 of file ipshell.cc.

3323 {
3324  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3325  if (res->data==NULL)
3326  res->data=(char *)new intvec(rVar(currRing));
3327  return FALSE;
3328 }
intvec * id_QHomWeight(ideal id, const ring r)

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3300 of file ipshell.cc.

3301 {
3302  ideal F=(ideal)id->Data();
3303  intvec * iv = new intvec(rVar(currRing));
3304  polyset s;
3305  int sl, n, i;
3306  int *x;
3307 
3308  res->data=(char *)iv;
3309  s = F->m;
3310  sl = IDELEMS(F) - 1;
3311  n = rVar(currRing);
3312  double wNsqr = (double)2.0 / (double)n;
3314  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3315  wCall(s, sl, x, wNsqr, currRing);
3316  for (i = n; i!=0; i--)
3317  (*iv)[i-1] = x[i + n + 1];
3318  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3319  return FALSE;
3320 }
Variable x
Definition: cfModGcd.cc:4082
THREAD_VAR double(* wFunctional)(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight.cc:20
void wCall(poly *s, int sl, int *x, double wNsqr, const ring R)
Definition: weight.cc:108
double wFunctionalBuch(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight0.cc:78

◆ list_cmd()

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

Definition at line 425 of file ipshell.cc.

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

◆ loNewtonP()

BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4562 of file ipshell.cc.

4563 {
4564  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4565  return FALSE;
4566 }
ideal loNewtonPolytope(const ideal id)
Definition: mpr_base.cc:3190

◆ loSimplex()

BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4568 of file ipshell.cc.

4569 {
4570  if ( !(rField_is_long_R(currRing)) )
4571  {
4572  WerrorS("Ground field not implemented!");
4573  return TRUE;
4574  }
4575 
4576  simplex * LP;
4577  matrix m;
4578 
4579  leftv v= args;
4580  if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4581  return TRUE;
4582  else
4583  m= (matrix)(v->CopyD());
4584 
4585  LP = new simplex(MATROWS(m),MATCOLS(m));
4586  LP->mapFromMatrix(m);
4587 
4588  v= v->next;
4589  if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4590  return TRUE;
4591  else
4592  LP->m= (int)(long)(v->Data());
4593 
4594  v= v->next;
4595  if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4596  return TRUE;
4597  else
4598  LP->n= (int)(long)(v->Data());
4599 
4600  v= v->next;
4601  if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4602  return TRUE;
4603  else
4604  LP->m1= (int)(long)(v->Data());
4605 
4606  v= v->next;
4607  if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4608  return TRUE;
4609  else
4610  LP->m2= (int)(long)(v->Data());
4611 
4612  v= v->next;
4613  if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4614  return TRUE;
4615  else
4616  LP->m3= (int)(long)(v->Data());
4617 
4618 #ifdef mprDEBUG_PROT
4619  Print("m (constraints) %d\n",LP->m);
4620  Print("n (columns) %d\n",LP->n);
4621  Print("m1 (<=) %d\n",LP->m1);
4622  Print("m2 (>=) %d\n",LP->m2);
4623  Print("m3 (==) %d\n",LP->m3);
4624 #endif
4625 
4626  LP->compute();
4627 
4628  lists lres= (lists)omAlloc( sizeof(slists) );
4629  lres->Init( 6 );
4630 
4631  lres->m[0].rtyp= MATRIX_CMD; // output matrix
4632  lres->m[0].data=(void*)LP->mapToMatrix(m);
4633 
4634  lres->m[1].rtyp= INT_CMD; // found a solution?
4635  lres->m[1].data=(void*)(long)LP->icase;
4636 
4637  lres->m[2].rtyp= INTVEC_CMD;
4638  lres->m[2].data=(void*)LP->posvToIV();
4639 
4640  lres->m[3].rtyp= INTVEC_CMD;
4641  lres->m[3].data=(void*)LP->zrovToIV();
4642 
4643  lres->m[4].rtyp= INT_CMD;
4644  lres->m[4].data=(void*)(long)LP->m;
4645 
4646  lres->m[5].rtyp= INT_CMD;
4647  lres->m[5].data=(void*)(long)LP->n;
4648 
4649  res->data= (void*)lres;
4650 
4651  return FALSE;
4652 }
Linear Programming / Linear Optimization using Simplex - Algorithm.
Definition: mpr_numeric.h:195
intvec * zrovToIV()
BOOLEAN mapFromMatrix(matrix m)
int icase
Definition: mpr_numeric.h:201
void compute()
matrix mapToMatrix(matrix m)
intvec * posvToIV()
#define MATROWS(i)
Definition: matpol.h:26
#define MATCOLS(i)
Definition: matpol.h:27

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 3070 of file ipshell.cc.

3071 {
3072  int i,j;
3073  matrix result;
3074  ideal id=(ideal)a->Data();
3075 
3076  result =mpNew(IDELEMS(id),rVar(currRing));
3077  for (i=1; i<=IDELEMS(id); i++)
3078  {
3079  for (j=1; j<=rVar(currRing); j++)
3080  {
3081  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
3082  }
3083  }
3084  res->data=(char *)result;
3085  return FALSE;
3086 }
#define MATELEM(mat, i, j)
1-based access to matrix
Definition: matpol.h:29
#define pDiff(a, b)
Definition: polys.h:296

◆ mpKoszul()

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

Definition at line 3092 of file ipshell.cc.

3093 {
3094  int n=(int)(long)b->Data();
3095  int d=(int)(long)c->Data();
3096  int k,l,sign,row,col;
3097  matrix result;
3098  ideal temp;
3099  BOOLEAN bo;
3100  poly p;
3101 
3102  if ((d>n) || (d<1) || (n<1))
3103  {
3104  res->data=(char *)mpNew(1,1);
3105  return FALSE;
3106  }
3107  int *choise = (int*)omAlloc(d*sizeof(int));
3108  if (id==NULL)
3109  temp=idMaxIdeal(1);
3110  else
3111  temp=(ideal)id->Data();
3112 
3113  k = binom(n,d);
3114  l = k*d;
3115  l /= n-d+1;
3116  result =mpNew(l,k);
3117  col = 1;
3118  idInitChoise(d,1,n,&bo,choise);
3119  while (!bo)
3120  {
3121  sign = 1;
3122  for (l=1;l<=d;l++)
3123  {
3124  if (choise[l-1]<=IDELEMS(temp))
3125  {
3126  p = pCopy(temp->m[choise[l-1]-1]);
3127  if (sign == -1) p = pNeg(p);
3128  sign *= -1;
3129  row = idGetNumberOfChoise(l-1,d,1,n,choise);
3130  MATELEM(result,row,col) = p;
3131  }
3132  }
3133  col++;
3134  idGetNextChoise(d,n,&bo,choise);
3135  }
3136  omFreeSize(choise,d*sizeof(int));
3137  if (id==NULL) idDelete(&temp);
3138 
3139  res->data=(char *)result;
3140  return FALSE;
3141 }
int binom(int n, int r)
void idGetNextChoise(int r, int end, BOOLEAN *endch, int *choise)
#define idMaxIdeal(D)
initialise the maximal ideal (at 0)
Definition: ideals.h:33
int idGetNumberOfChoise(int t, int d, int begin, int end, int *choise)
void idInitChoise(int r, int beg, int end, BOOLEAN *endch, int *choise)
#define pNeg(p)
Definition: polys.h:198
#define pCopy(p)
return a copy of the poly
Definition: polys.h:185
static int sign(int x)
Definition: ring.cc:3469

◆ nuLagSolve()

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

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

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

Definition at line 4677 of file ipshell.cc.

4678 {
4679  poly gls;
4680  gls= (poly)(arg1->Data());
4681  int howclean= (int)(long)arg3->Data();
4682 
4683  if ( gls == NULL || pIsConstant( gls ) )
4684  {
4685  WerrorS("Input polynomial is constant!");
4686  return TRUE;
4687  }
4688 
4689  if (rField_is_Zp(currRing))
4690  {
4691  int* r=Zp_roots(gls, currRing);
4692  lists rlist;
4693  rlist= (lists)omAlloc( sizeof(slists) );
4694  rlist->Init( r[0] );
4695  for(int i=r[0];i>0;i--)
4696  {
4697  rlist->m[i-1].data=n_Init(r[i],currRing->cf);
4698  rlist->m[i-1].rtyp=NUMBER_CMD;
4699  }
4700  omFree(r);
4701  res->data=rlist;
4702  res->rtyp= LIST_CMD;
4703  return FALSE;
4704  }
4705  if ( !(rField_is_R(currRing) ||
4706  rField_is_Q(currRing) ||
4709  {
4710  WerrorS("Ground field not implemented!");
4711  return TRUE;
4712  }
4713 
4716  {
4717  unsigned long int ii = (unsigned long int)arg2->Data();
4718  setGMPFloatDigits( ii, ii );
4719  }
4720 
4721  int ldummy;
4722  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4723  int i,vpos=0;
4724  poly piter;
4725  lists elist;
4726 
4727  elist= (lists)omAlloc( sizeof(slists) );
4728  elist->Init( 0 );
4729 
4730  if ( rVar(currRing) > 1 )
4731  {
4732  piter= gls;
4733  for ( i= 1; i <= rVar(currRing); i++ )
4734  if ( pGetExp( piter, i ) )
4735  {
4736  vpos= i;
4737  break;
4738  }
4739  while ( piter )
4740  {
4741  for ( i= 1; i <= rVar(currRing); i++ )
4742  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4743  {
4744  WerrorS("The input polynomial must be univariate!");
4745  return TRUE;
4746  }
4747  pIter( piter );
4748  }
4749  }
4750 
4751  rootContainer * roots= new rootContainer();
4752  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4753  piter= gls;
4754  for ( i= deg; i >= 0; i-- )
4755  {
4756  if ( piter && pTotaldegree(piter) == i )
4757  {
4758  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4759  //nPrint( pcoeffs[i] );PrintS(" ");
4760  pIter( piter );
4761  }
4762  else
4763  {
4764  pcoeffs[i]= nInit(0);
4765  }
4766  }
4767 
4768 #ifdef mprDEBUG_PROT
4769  for (i=deg; i >= 0; i--)
4770  {
4771  nPrint( pcoeffs[i] );PrintS(" ");
4772  }
4773  PrintLn();
4774 #endif
4775 
4776  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4777  roots->solver( howclean );
4778 
4779  int elem= roots->getAnzRoots();
4780  char *dummy;
4781  int j;
4782 
4783  lists rlist;
4784  rlist= (lists)omAlloc( sizeof(slists) );
4785  rlist->Init( elem );
4786 
4788  {
4789  for ( j= 0; j < elem; j++ )
4790  {
4791  rlist->m[j].rtyp=NUMBER_CMD;
4792  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4793  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4794  }
4795  }
4796  else
4797  {
4798  for ( j= 0; j < elem; j++ )
4799  {
4800  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4801  rlist->m[j].rtyp=STRING_CMD;
4802  rlist->m[j].data=(void *)dummy;
4803  }
4804  }
4805 
4806  elist->Clean();
4807  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4808 
4809  // this is (via fillContainer) the same data as in root
4810  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4811  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4812 
4813  delete roots;
4814 
4815  res->data= (void*)rlist;
4816 
4817  return FALSE;
4818 }
int * Zp_roots(poly p, const ring r)
Definition: clapsing.cc:2188
complex root finder for univariate polynomials based on laguers algorithm
Definition: mpr_numeric.h:66
void fillContainer(number *_coeffs, number *_ievpoint, const int _var, const int _tdg, const rootType _rt, const int _anz)
Definition: mpr_numeric.cc:300
gmp_complex * getRoot(const int i)
Definition: mpr_numeric.h:88
int getAnzRoots()
Definition: mpr_numeric.h:97
bool solver(const int polishmode=PM_NONE)
Definition: mpr_numeric.cc:437
#define pIter(p)
Definition: monomials.h:37
char * complexToStr(gmp_complex &c, const unsigned int oprec, const coeffs src)
Definition: mpr_complex.cc:704
void setGMPFloatDigits(size_t digits, size_t rest)
Set size of mantissa digits - the number of output digits (basis 10) the size of mantissa consists of...
Definition: mpr_complex.cc:60
#define nCopy(n)
Definition: numbers.h:15
#define nPrint(a)
only for debug, over any initalized currRing
Definition: numbers.h:46
#define pIsConstant(p)
like above, except that Comp must be 0
Definition: polys.h:238
static BOOLEAN rField_is_R(const ring r)
Definition: ring.h:519
static BOOLEAN rField_is_Zp(const ring r)
Definition: ring.h:501
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:507

◆ nuMPResMat()

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

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

Definition at line 4654 of file ipshell.cc.

4655 {
4656  ideal gls = (ideal)(arg1->Data());
4657  int imtype= (int)(long)arg2->Data();
4658 
4659  uResultant::resMatType mtype= determineMType( imtype );
4660 
4661  // check input ideal ( = polynomial system )
4662  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4663  {
4664  return TRUE;
4665  }
4666 
4667  uResultant *resMat= new uResultant( gls, mtype, false );
4668  if (resMat!=NULL)
4669  {
4670  res->rtyp = MODUL_CMD;
4671  res->data= (void*)resMat->accessResMat()->getMatrix();
4672  if (!errorreported) delete resMat;
4673  }
4674  return errorreported;
4675 }
virtual ideal getMatrix()
Definition: mpr_base.h:31
Base class for solving 0-dim poly systems using u-resultant.
Definition: mpr_base.h:63
resMatrixBase * accessResMat()
Definition: mpr_base.h:78
@ mprOk
Definition: mpr_base.h:98
uResultant::resMatType determineMType(int imtype)
mprState mprIdealCheck(const ideal theIdeal, const char *name, uResultant::resMatType mtype, BOOLEAN rmatrix=false)

◆ nuUResSolve()

BOOLEAN nuUResSolve ( leftv  res,
leftv  args 
)

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

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

Definition at line 4921 of file ipshell.cc.

4922 {
4923  leftv v= args;
4924 
4925  ideal gls;
4926  int imtype;
4927  int howclean;
4928 
4929  // get ideal
4930  if ( v->Typ() != IDEAL_CMD )
4931  return TRUE;
4932  else gls= (ideal)(v->Data());
4933  v= v->next;
4934 
4935  // get resultant matrix type to use (0,1)
4936  if ( v->Typ() != INT_CMD )
4937  return TRUE;
4938  else imtype= (int)(long)v->Data();
4939  v= v->next;
4940 
4941  if (imtype==0)
4942  {
4943  ideal test_id=idInit(1,1);
4944  int j;
4945  for(j=IDELEMS(gls)-1;j>=0;j--)
4946  {
4947  if (gls->m[j]!=NULL)
4948  {
4949  test_id->m[0]=gls->m[j];
4950  intvec *dummy_w=id_QHomWeight(test_id, currRing);
4951  if (dummy_w!=NULL)
4952  {
4953  WerrorS("Newton polytope not of expected dimension");
4954  delete dummy_w;
4955  return TRUE;
4956  }
4957  }
4958  }
4959  }
4960 
4961  // get and set precision in digits ( > 0 )
4962  if ( v->Typ() != INT_CMD )
4963  return TRUE;
4964  else if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
4966  {
4967  unsigned long int ii=(unsigned long int)v->Data();
4968  setGMPFloatDigits( ii, ii );
4969  }
4970  v= v->next;
4971 
4972  // get interpolation steps (0,1,2)
4973  if ( v->Typ() != INT_CMD )
4974  return TRUE;
4975  else howclean= (int)(long)v->Data();
4976 
4977  uResultant::resMatType mtype= determineMType( imtype );
4978  int i,count;
4979  lists listofroots= NULL;
4980  number smv= NULL;
4981  BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;
4982 
4983  //emptylist= (lists)omAlloc( sizeof(slists) );
4984  //emptylist->Init( 0 );
4985 
4986  //res->rtyp = LIST_CMD;
4987  //res->data= (void *)emptylist;
4988 
4989  // check input ideal ( = polynomial system )
4990  if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
4991  {
4992  return TRUE;
4993  }
4994 
4995  uResultant * ures;
4996  rootContainer ** iproots;
4997  rootContainer ** muiproots;
4998  rootArranger * arranger;
4999 
5000  // main task 1: setup of resultant matrix
5001  ures= new uResultant( gls, mtype );
5002  if ( ures->accessResMat()->initState() != resMatrixBase::ready )
5003  {
5004  WerrorS("Error occurred during matrix setup!");
5005  return TRUE;
5006  }
5007 
5008  // if dense resultant, check if minor nonsingular
5009  if ( mtype == uResultant::denseResMat )
5010  {
5011  smv= ures->accessResMat()->getSubDet();
5012 #ifdef mprDEBUG_PROT
5013  PrintS("// Determinant of submatrix: ");nPrint(smv);PrintLn();
5014 #endif
5015  if ( nIsZero(smv) )
5016  {
5017  WerrorS("Unsuitable input ideal: Minor of resultant matrix is singular!");
5018  return TRUE;
5019  }
5020  }
5021 
5022  // main task 2: Interpolate specialized resultant polynomials
5023  if ( interpolate_det )
5024  iproots= ures->interpolateDenseSP( false, smv );
5025  else
5026  iproots= ures->specializeInU( false, smv );
5027 
5028  // main task 3: Interpolate specialized resultant polynomials
5029  if ( interpolate_det )
5030  muiproots= ures->interpolateDenseSP( true, smv );
5031  else
5032  muiproots= ures->specializeInU( true, smv );
5033 
5034 #ifdef mprDEBUG_PROT
5035  int c= iproots[0]->getAnzElems();
5036  for (i=0; i < c; i++) pWrite(iproots[i]->getPoly());
5037  c= muiproots[0]->getAnzElems();
5038  for (i=0; i < c; i++) pWrite(muiproots[i]->getPoly());
5039 #endif
5040 
5041  // main task 4: Compute roots of specialized polys and match them up
5042  arranger= new rootArranger( iproots, muiproots, howclean );
5043  arranger->solve_all();
5044 
5045  // get list of roots
5046  if ( arranger->success() )
5047  {
5048  arranger->arrange();
5049  listofroots= listOfRoots(arranger, gmp_output_digits );
5050  }
5051  else
5052  {
5053  WerrorS("Solver was unable to find any roots!");
5054  return TRUE;
5055  }
5056 
5057  // free everything
5058  count= iproots[0]->getAnzElems();
5059  for (i=0; i < count; i++) delete iproots[i];
5060  omFreeSize( (ADDRESS) iproots, count * sizeof(rootContainer*) );
5061  count= muiproots[0]->getAnzElems();
5062  for (i=0; i < count; i++) delete muiproots[i];
5063  omFreeSize( (ADDRESS) muiproots, count * sizeof(rootContainer*) );
5064 
5065  delete ures;
5066  delete arranger;
5067  if (smv!=NULL) nDelete( &smv );
5068 
5069  res->data= (void *)listofroots;
5070 
5071  //emptylist->Clean();
5072  // omFreeSize( (ADDRESS) emptylist, sizeof(slists) );
5073 
5074  return FALSE;
5075 }
virtual number getSubDet()
Definition: mpr_base.h:37
virtual IStateType initState() const
Definition: mpr_base.h:41
void solve_all()
Definition: mpr_numeric.cc:858
bool success()
Definition: mpr_numeric.h:162
void arrange()
Definition: mpr_numeric.cc:883
int getAnzElems()
Definition: mpr_numeric.h:95
rootContainer ** specializeInU(BOOLEAN matchUp=false, const number subDetVal=NULL)
Definition: mpr_base.cc:3059
rootContainer ** interpolateDenseSP(BOOLEAN matchUp=false, const number subDetVal=NULL)
Definition: mpr_base.cc:2921
@ denseResMat
Definition: mpr_base.h:65
lists listOfRoots(rootArranger *self, const unsigned int oprec)
Definition: ipshell.cc:5078
#define nIsZero(n)
Definition: numbers.h:19
void pWrite(poly p)
Definition: polys.h:308
int status int void size_t count
Definition: si_signals.h:59

◆ nuVanderSys()

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

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

Definition at line 4820 of file ipshell.cc.

4821 {
4822  int i;
4823  ideal p,w;
4824  p= (ideal)arg1->Data();
4825  w= (ideal)arg2->Data();
4826 
4827  // w[0] = f(p^0)
4828  // w[1] = f(p^1)
4829  // ...
4830  // p can be a vector of numbers (multivariate polynom)
4831  // or one number (univariate polynom)
4832  // tdg = deg(f)
4833 
4834  int n= IDELEMS( p );
4835  int m= IDELEMS( w );
4836  int tdg= (int)(long)arg3->Data();
4837 
4838  res->data= (void*)NULL;
4839 
4840  // check the input
4841  if ( tdg < 1 )
4842  {
4843  WerrorS("Last input parameter must be > 0!");
4844  return TRUE;
4845  }
4846  if ( n != rVar(currRing) )
4847  {
4848  Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
4849  return TRUE;
4850  }
4851  if ( m != (int)pow((double)tdg+1,(double)n) )
4852  {
4853  Werror("Size of second input ideal must be equal to %d!",
4854  (int)pow((double)tdg+1,(double)n));
4855  return TRUE;
4856  }
4857  if ( !(rField_is_Q(currRing) /* ||
4858  rField_is_R() || rField_is_long_R() ||
4859  rField_is_long_C()*/ ) )
4860  {
4861  WerrorS("Ground field not implemented!");
4862  return TRUE;
4863  }
4864 
4865  number tmp;
4866  number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
4867  for ( i= 0; i < n; i++ )
4868  {
4869  pevpoint[i]=nInit(0);
4870  if ( (p->m)[i] )
4871  {
4872  tmp = pGetCoeff( (p->m)[i] );
4873  if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
4874  {
4875  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4876  WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
4877  return TRUE;
4878  }
4879  } else tmp= NULL;
4880  if ( !nIsZero(tmp) )
4881  {
4882  if ( !pIsConstant((p->m)[i]))
4883  {
4884  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4885  WerrorS("Elements of first input ideal must be numbers!");
4886  return TRUE;
4887  }
4888  pevpoint[i]= nCopy( tmp );
4889  }
4890  }
4891 
4892  number *wresults= (number *)omAlloc( m * sizeof( number ) );
4893  for ( i= 0; i < m; i++ )
4894  {
4895  wresults[i]= nInit(0);
4896  if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
4897  {
4898  if ( !pIsConstant((w->m)[i]))
4899  {
4900  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4901  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4902  WerrorS("Elements of second input ideal must be numbers!");
4903  return TRUE;
4904  }
4905  wresults[i]= nCopy(pGetCoeff((w->m)[i]));
4906  }
4907  }
4908 
4909  vandermonde vm( m, n, tdg, pevpoint, FALSE );
4910  number *ncpoly= vm.interpolateDense( wresults );
4911  // do not free ncpoly[]!!
4912  poly rpoly= vm.numvec2poly( ncpoly );
4913 
4914  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4915  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4916 
4917  res->data= (void*)rpoly;
4918  return FALSE;
4919 }
Rational pow(const Rational &a, int e)
Definition: GMPrat.cc:411
vandermonde system solver for interpolating polynomials from their values
Definition: mpr_numeric.h:29
#define nIsMOne(n)
Definition: numbers.h:26
#define nIsOne(n)
Definition: numbers.h:25

◆ paPrint()

void paPrint ( const char *  n,
package  p 
)

Definition at line 6323 of file ipshell.cc.

6324 {
6325  Print(" %s (",n);
6326  switch (p->language)
6327  {
6328  case LANG_SINGULAR: PrintS("S"); break;
6329  case LANG_C: PrintS("C"); break;
6330  case LANG_TOP: PrintS("T"); break;
6331  case LANG_MAX: PrintS("M"); break;
6332  case LANG_NONE: PrintS("N"); break;
6333  default: PrintS("U");
6334  }
6335  if(p->libname!=NULL)
6336  Print(",%s", p->libname);
6337  PrintS(")");
6338 }
@ LANG_MAX
Definition: subexpr.h:22
@ LANG_TOP
Definition: subexpr.h:22

◆ rCompose()

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

Definition at line 2783 of file ipshell.cc.

2784 {
2785  if ((L->nr!=3)
2786 #ifdef HAVE_PLURAL
2787  &&(L->nr!=5)
2788 #endif
2789  )
2790  return NULL;
2791  int is_gf_char=0;
2792  // 0: char/ cf - ring
2793  // 1: list (var)
2794  // 2: list (ord)
2795  // 3: qideal
2796  // possibly:
2797  // 4: C
2798  // 5: D
2799 
2800  ring R = (ring) omAlloc0Bin(sip_sring_bin);
2801 
2802  // ------------------------------------------------------------------
2803  // 0: char:
2804  if (L->m[0].Typ()==CRING_CMD)
2805  {
2806  R->cf=(coeffs)L->m[0].Data();
2807  R->cf->ref++;
2808  }
2809  else if (L->m[0].Typ()==INT_CMD)
2810  {
2811  int ch = (int)(long)L->m[0].Data();
2812  assume( ch >= 0 );
2813 
2814  if (ch == 0) // Q?
2815  R->cf = nInitChar(n_Q, NULL);
2816  else
2817  {
2818  int l = IsPrime(ch); // Zp?
2819  if( l != ch )
2820  {
2821  Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
2822  ch = l;
2823  }
2824  #ifndef TEST_ZN_AS_ZP
2825  R->cf = nInitChar(n_Zp, (void*)(long)ch);
2826  #else
2827  mpz_t modBase;
2828  mpz_init_set_ui(modBase,(long) ch);
2829  ZnmInfo info;
2830  info.base= modBase;
2831  info.exp= 1;
2832  R->cf=nInitChar(n_Zn,(void*) &info); //exponent is missing
2833  R->cf->is_field=1;
2834  R->cf->is_domain=1;
2835  R->cf->has_simple_Inverse=1;
2836  #endif
2837  }
2838  }
2839  else if (L->m[0].Typ()==LIST_CMD) // something complicated...
2840  {
2841  lists LL=(lists)L->m[0].Data();
2842 
2843 #ifdef HAVE_RINGS
2844  if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
2845  {
2846  rComposeRing(LL, R); // Ring!?
2847  }
2848  else
2849 #endif
2850  if (LL->nr < 3)
2851  rComposeC(LL,R); // R, long_R, long_C
2852  else
2853  {
2854  if (LL->m[0].Typ()==INT_CMD)
2855  {
2856  int ch = (int)(long)LL->m[0].Data();
2857  while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
2858  if (fftable[is_gf_char]==0) is_gf_char=-1;
2859 
2860  if(is_gf_char!= -1)
2861  {
2862  GFInfo param;
2863 
2864  param.GFChar = ch;
2865  param.GFDegree = 1;
2866  param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
2867 
2868  // nfInitChar should be able to handle the case when ch is in fftables!
2869  R->cf = nInitChar(n_GF, (void*)&param);
2870  }
2871  }
2872 
2873  if( R->cf == NULL )
2874  {
2875  ring extRing = rCompose((lists)L->m[0].Data(),FALSE,0x7fff);
2876 
2877  if (extRing==NULL)
2878  {
2879  WerrorS("could not create the specified coefficient field");
2880  goto rCompose_err;
2881  }
2882 
2883  if( extRing->qideal != NULL ) // Algebraic extension
2884  {
2885  AlgExtInfo extParam;
2886 
2887  extParam.r = extRing;
2888 
2889  R->cf = nInitChar(n_algExt, (void*)&extParam);
2890  }
2891  else // Transcendental extension
2892  {
2893  TransExtInfo extParam;
2894  extParam.r = extRing;
2895  assume( extRing->qideal == NULL );
2896 
2897  R->cf = nInitChar(n_transExt, &extParam);
2898  }
2899  }
2900  }
2901  }
2902  else
2903  {
2904  WerrorS("coefficient field must be described by `int` or `list`");
2905  goto rCompose_err;
2906  }
2907 
2908  if( R->cf == NULL )
2909  {
2910  WerrorS("could not create coefficient field described by the input!");
2911  goto rCompose_err;
2912  }
2913 
2914  // ------------------------- VARS ---------------------------
2915  if (rComposeVar(L,R)) goto rCompose_err;
2916  // ------------------------ ORDER ------------------------------
2917  if (rComposeOrder(L,check_comp,R)) goto rCompose_err;
2918 
2919  // ------------------------ ??????? --------------------
2920 
2921  if (!isLetterplace) rRenameVars(R);
2922  #ifdef HAVE_SHIFTBBA
2923  else
2924  {
2925  R->isLPring=isLetterplace;
2926  R->ShortOut=FALSE;
2927  R->CanShortOut=FALSE;
2928  }
2929  #endif
2930  if ((bitmask!=0)&&(R->wanted_maxExp==0)) R->wanted_maxExp=bitmask;
2931  rComplete(R);
2932 
2933  // ------------------------ Q-IDEAL ------------------------
2934 
2935  if (L->m[3].Typ()==IDEAL_CMD)
2936  {
2937  ideal q=(ideal)L->m[3].Data();
2938  if (q->m[0]!=NULL)
2939  {
2940  if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
2941  {
2942  #if 0
2943  WerrorS("coefficient fields must be equal if q-ideal !=0");
2944  goto rCompose_err;
2945  #else
2946  ring orig_ring=currRing;
2947  rChangeCurrRing(R);
2948  int *perm=NULL;
2949  int *par_perm=NULL;
2950  int par_perm_size=0;
2951  nMapFunc nMap;
2952 
2953  if ((nMap=nSetMap(orig_ring->cf))==NULL)
2954  {
2955  if (rEqual(orig_ring,currRing))
2956  {
2957  nMap=n_SetMap(currRing->cf, currRing->cf);
2958  }
2959  else
2960  // Allow imap/fetch to be make an exception only for:
2961  if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2965  ||
2966  (rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
2967  (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
2968  rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
2969  {
2970  par_perm_size=rPar(orig_ring);
2971 
2972 // if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
2973 // naSetChar(rInternalChar(orig_ring),orig_ring);
2974 // else ntSetChar(rInternalChar(orig_ring),orig_ring);
2975 
2976  nSetChar(currRing->cf);
2977  }
2978  else
2979  {
2980  WerrorS("coefficient fields must be equal if q-ideal !=0");
2981  goto rCompose_err;
2982  }
2983  }
2984  perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
2985  if (par_perm_size!=0)
2986  par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2987  int i;
2988  #if 0
2989  // use imap:
2990  maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
2991  currRing->names,currRing->N,currRing->parameter, currRing->P,
2992  perm,par_perm, currRing->ch);
2993  #else
2994  // use fetch
2995  if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
2996  {
2997  for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
2998  }
2999  else if (par_perm_size!=0)
3000  for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
3001  for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
3002  #endif
3003  ideal dest_id=idInit(IDELEMS(q),1);
3004  for(i=IDELEMS(q)-1; i>=0; i--)
3005  {
3006  dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
3007  par_perm,par_perm_size);
3008  // PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
3009  pTest(dest_id->m[i]);
3010  }
3011  R->qideal=dest_id;
3012  if (perm!=NULL)
3013  omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
3014  if (par_perm!=NULL)
3015  omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
3016  rChangeCurrRing(orig_ring);
3017  #endif
3018  }
3019  else
3020  R->qideal=idrCopyR(q,currRing,R);
3021  }
3022  }
3023  else
3024  {
3025  WerrorS("q-ideal must be given as `ideal`");
3026  goto rCompose_err;
3027  }
3028 
3029 
3030  // ---------------------------------------------------------------
3031  #ifdef HAVE_PLURAL
3032  if (L->nr==5)
3033  {
3034  if (nc_CallPlural((matrix)L->m[4].Data(),
3035  (matrix)L->m[5].Data(),
3036  NULL,NULL,
3037  R,
3038  true, // !!!
3039  true, false,
3040  currRing, FALSE)) goto rCompose_err;
3041  // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
3042  }
3043  #endif
3044  return R;
3045 
3046 rCompose_err:
3047  if (R->N>0)
3048  {
3049  int i;
3050  if (R->names!=NULL)
3051  {
3052  i=R->N-1;
3053  while (i>=0) { omfree(R->names[i]); i--; }
3054  omFree(R->names);
3055  }
3056  }
3057  omfree(R->order);
3058  omfree(R->block0);
3059  omfree(R->block1);
3060  omfree(R->wvhdl);
3061  omFree(R);
3062  return NULL;
3063 }
ring r
Definition: algext.h:37
int GFDegree
Definition: coeffs.h:95
@ n_GF
\GF{p^n < 2^16}
Definition: coeffs.h:32
@ n_Q
rational (GMP) numbers
Definition: coeffs.h:30
@ n_Zn
only used if HAVE_RINGS is defined
Definition: coeffs.h:44
@ n_Zp
\F{p < 2^31}
Definition: coeffs.h:29
const unsigned short fftable[]
Definition: ffields.cc:31
static FORCE_INLINE void nSetChar(const coeffs r)
initialisations after each ring change
Definition: coeffs.h:436
const char * GFPar_name
Definition: coeffs.h:96
int GFChar
Definition: coeffs.h:94
Creation data needed for finite fields.
Definition: coeffs.h:93
const ExtensionInfo & info
< [in] sqrfree poly
static void rRenameVars(ring R)
Definition: ipshell.cc:2405
void rComposeC(lists L, ring R)
Definition: ipshell.cc:2260
static BOOLEAN rComposeOrder(const lists L, const BOOLEAN check_comp, ring R)
Definition: ipshell.cc:2491
ring rCompose(const lists L, const BOOLEAN check_comp, const long bitmask, const int isLetterplace)
Definition: ipshell.cc:2783
void rComposeRing(lists L, ring R)
Definition: ipshell.cc:2312
static BOOLEAN rComposeVar(const lists L, ring R)
Definition: ipshell.cc:2446
BOOLEAN nc_CallPlural(matrix cc, matrix dd, poly cn, poly dn, ring r, bool bSetupQuotient, bool bCopyInput, bool bBeQuiet, ring curr, bool dummy_ring=false)
returns TRUE if there were errors analyze inputs, check them for consistency detects nc_type,...
Definition: old.gring.cc:2682
void maFindPerm(char const *const *const preim_names, int preim_n, char const *const *const preim_par, int preim_p, char const *const *const names, int n, char const *const *const par, int nop, int *perm, int *par_perm, n_coeffType ch)
Definition: maps.cc:163
#define nSetMap(R)
Definition: numbers.h:43
poly p_PermPoly(poly p, const int *perm, const ring oldRing, const ring dst, nMapFunc nMap, const int *par_perm, int OldPar, BOOLEAN use_mult)
Definition: p_polys.cc:4246
#define pTest(p)
Definition: polys.h:415
ideal idrCopyR(ideal id, ring src_r, ring dest_r)
Definition: prCopy.cc:192
int IsPrime(int p)
Definition: prime.cc:61
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:3492
VAR omBin sip_sring_bin
Definition: ring.cc:43
BOOLEAN rEqual(ring r1, ring r2, BOOLEAN qr)
returns TRUE, if r1 equals r2 FALSE, otherwise Equality is determined componentwise,...
Definition: ring.cc:1746
static BOOLEAN rField_is_Zp_a(const ring r)
Definition: ring.h:530
static BOOLEAN rField_is_Zn(const ring r)
Definition: ring.h:513
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:600
static int rInternalChar(const ring r)
Definition: ring.h:690
static BOOLEAN rField_is_Q_a(const ring r)
Definition: ring.h:540
struct for passing initialization parameters to naInitChar
Definition: transext.h:88

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2161 of file ipshell.cc.

2162 {
2163  assume( r != NULL );
2164  const coeffs C = r->cf;
2165  assume( C != NULL );
2166 
2167  // sanity check: require currRing==r for rings with polynomial data
2168  if ( (r!=currRing) && (
2169  (nCoeff_is_algExt(C) && (C != currRing->cf))
2170  || (r->qideal != NULL)
2171 #ifdef HAVE_PLURAL
2172  || (rIsPluralRing(r))
2173 #endif
2174  )
2175  )
2176  {
2177  WerrorS("ring with polynomial data must be the base ring or compatible");
2178  return NULL;
2179  }
2180  // 0: char/ cf - ring
2181  // 1: list (var)
2182  // 2: list (ord)
2183  // 3: qideal
2184  // possibly:
2185  // 4: C
2186  // 5: D
2188  if (rIsPluralRing(r))
2189  L->Init(6);
2190  else
2191  L->Init(4);
2192  // ----------------------------------------
2193  // 0: char/ cf - ring
2194  if (rField_is_numeric(r))
2195  {
2196  rDecomposeC(&(L->m[0]),r);
2197  }
2198  else if (rField_is_Ring(r))
2199  {
2200  rDecomposeRing(&(L->m[0]),r);
2201  }
2202  else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2203  {
2204  rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2205  }
2206  else if(rField_is_GF(r))
2207  {
2209  Lc->Init(4);
2210  // char:
2211  Lc->m[0].rtyp=INT_CMD;
2212  Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2213  // var:
2215  Lv->Init(1);
2216  Lv->m[0].rtyp=STRING_CMD;
2217  Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2218  Lc->m[1].rtyp=LIST_CMD;
2219  Lc->m[1].data=(void*)Lv;
2220  // ord:
2222  Lo->Init(1);
2224  Loo->Init(2);
2225  Loo->m[0].rtyp=STRING_CMD;
2226  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2227 
2228  intvec *iv=new intvec(1); (*iv)[0]=1;
2229  Loo->m[1].rtyp=INTVEC_CMD;
2230  Loo->m[1].data=(void *)iv;
2231 
2232  Lo->m[0].rtyp=LIST_CMD;
2233  Lo->m[0].data=(void*)Loo;
2234 
2235  Lc->m[2].rtyp=LIST_CMD;
2236  Lc->m[2].data=(void*)Lo;
2237  // q-ideal:
2238  Lc->m[3].rtyp=IDEAL_CMD;
2239  Lc->m[3].data=(void *)idInit(1,1);
2240  // ----------------------
2241  L->m[0].rtyp=LIST_CMD;
2242  L->m[0].data=(void*)Lc;
2243  }
2244  else if (rField_is_Zp(r) || rField_is_Q(r))
2245  {
2246  L->m[0].rtyp=INT_CMD;
2247  L->m[0].data=(void *)(long)r->cf->ch;
2248  }
2249  else
2250  {
2251  L->m[0].rtyp=CRING_CMD;
2252  L->m[0].data=(void *)r->cf;
2253  r->cf->ref++;
2254  }
2255  // ----------------------------------------
2256  rDecompose_23456(r,L);
2257  return L;
2258 }
CanonicalForm Lc(const CanonicalForm &f)
static void rDecomposeC(leftv h, const ring R)
Definition: ipshell.cc:1853
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1729
void rDecomposeRing(leftv h, const ring R)
Definition: ipshell.cc:1917
static void rDecompose_23456(const ring r, lists L)
Definition: ipshell.cc:2021
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:77
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:626
@ ringorder_lp
Definition: ring.h:77
static BOOLEAN rField_is_numeric(const ring r)
Definition: ring.h:516
static BOOLEAN rField_is_GF(const ring r)
Definition: ring.h:522

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1949 of file ipshell.cc.

1950 {
1951  assume( C != NULL );
1952 
1953  // sanity check: require currRing==r for rings with polynomial data
1954  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1955  {
1956  WerrorS("ring with polynomial data must be the base ring or compatible");
1957  return TRUE;
1958  }
1959  if (nCoeff_is_numeric(C))
1960  {
1961  rDecomposeC_41(res,C);
1962  }
1963 #ifdef HAVE_RINGS
1964  else if (nCoeff_is_Ring(C))
1965  {
1967  }
1968 #endif
1969  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1970  {
1971  rDecomposeCF(res, C->extRing, currRing);
1972  }
1973  else if(nCoeff_is_GF(C))
1974  {
1976  Lc->Init(4);
1977  // char:
1978  Lc->m[0].rtyp=INT_CMD;
1979  Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1980  // var:
1982  Lv->Init(1);
1983  Lv->m[0].rtyp=STRING_CMD;
1984  Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1985  Lc->m[1].rtyp=LIST_CMD;
1986  Lc->m[1].data=(void*)Lv;
1987  // ord:
1989  Lo->Init(1);
1991  Loo->Init(2);
1992  Loo->m[0].rtyp=STRING_CMD;
1993  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1994 
1995  intvec *iv=new intvec(1); (*iv)[0]=1;
1996  Loo->m[1].rtyp=INTVEC_CMD;
1997  Loo->m[1].data=(void *)iv;
1998 
1999  Lo->m[0].rtyp=LIST_CMD;
2000  Lo->m[0].data=(void*)Loo;
2001 
2002  Lc->m[2].rtyp=LIST_CMD;
2003  Lc->m[2].data=(void*)Lo;
2004  // q-ideal:
2005  Lc->m[3].rtyp=IDEAL_CMD;
2006  Lc->m[3].data=(void *)idInit(1,1);
2007  // ----------------------
2008  res->rtyp=LIST_CMD;
2009  res->data=(void*)Lc;
2010  }
2011  else
2012  {
2013  res->rtyp=INT_CMD;
2014  res->data=(void *)(long)C->ch;
2015  }
2016  // ----------------------------------------
2017  return FALSE;
2018 }
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition: coeffs.h:839
static FORCE_INLINE BOOLEAN nCoeff_is_numeric(const coeffs r)
Definition: coeffs.h:832
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:778
static void rDecomposeC_41(leftv h, const coeffs C)
Definition: ipshell.cc:1819
void rDecomposeRing_41(leftv h, const coeffs C)
Definition: ipshell.cc:1889

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 2122 of file ipshell.cc.

2123 {
2124  assume( r != NULL );
2125  const coeffs C = r->cf;
2126  assume( C != NULL );
2127 
2128  // sanity check: require currRing==r for rings with polynomial data
2129  if ( (r!=currRing) && (
2130  (r->qideal != NULL)
2131 #ifdef HAVE_PLURAL
2132  || (rIsPluralRing(r))
2133 #endif
2134  )
2135  )
2136  {
2137  WerrorS("ring with polynomial data must be the base ring or compatible");
2138  return NULL;
2139  }
2140  // 0: char/ cf - ring
2141  // 1: list (var)
2142  // 2: list (ord)
2143  // 3: qideal
2144  // possibly:
2145  // 4: C
2146  // 5: D
2148  if (rIsPluralRing(r))
2149  L->Init(6);
2150  else
2151  L->Init(4);
2152  // ----------------------------------------
2153  // 0: char/ cf - ring
2154  L->m[0].rtyp=CRING_CMD;
2155  L->m[0].data=(char*)r->cf; r->cf->ref++;
2156  // ----------------------------------------
2157  rDecompose_23456(r,L);
2158  return L;
2159 }

◆ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1644 of file ipshell.cc.

1645 {
1646  idhdl tmp=NULL;
1647 
1648  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
1649  if (tmp==NULL) return NULL;
1650 
1651 // if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
1653  {
1655  }
1656 
1657  ring r = IDRING(tmp) = (ring) omAlloc0Bin(sip_sring_bin);
1658 
1659  #ifndef TEST_ZN_AS_ZP
1660  r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1661  #else
1662  mpz_t modBase;
1663  mpz_init_set_ui(modBase, (long)32003);
1664  ZnmInfo info;
1665  info.base= modBase;
1666  info.exp= 1;
1667  r->cf=nInitChar(n_Zn,(void*) &info);
1668  r->cf->is_field=1;
1669  r->cf->is_domain=1;
1670  r->cf->has_simple_Inverse=1;
1671  #endif
1672  r->N = 3;
1673  /*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
1674  /*names*/
1675  r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
1676  r->names[0] = omStrDup("x");
1677  r->names[1] = omStrDup("y");
1678  r->names[2] = omStrDup("z");
1679  /*weights: entries for 3 blocks: NULL*/
1680  r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1681  /*order: dp,C,0*/
1682  r->order = (rRingOrder_t *) omAlloc(3 * sizeof(rRingOrder_t *));
1683  r->block0 = (int *)omAlloc0(3 * sizeof(int *));
1684  r->block1 = (int *)omAlloc0(3 * sizeof(int *));
1685  /* ringorder dp for the first block: var 1..3 */
1686  r->order[0] = ringorder_dp;
1687  r->block0[0] = 1;
1688  r->block1[0] = 3;
1689  /* ringorder C for the second block: no vars */
1690  r->order[1] = ringorder_C;
1691  /* the last block: everything is 0 */
1692  r->order[2] = (rRingOrder_t)0;
1693 
1694  /* complete ring intializations */
1695  rComplete(r);
1696  rSetHdl(tmp);
1697  return currRingHdl;
1698 }
rRingOrder_t
order stuff
Definition: ring.h:68
@ ringorder_C
Definition: ring.h:73
@ ringorder_dp
Definition: ring.h:78
char * char_ptr
Definition: structs.h:53
int * int_ptr
Definition: structs.h:54

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1701 of file ipshell.cc.

1702 {
1703  if ((r==NULL)||(r->VarOffset==NULL))
1704  return NULL;
1706  if (h!=NULL) return h;
1707  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1708  if (h!=NULL) return h;
1710  while(p!=NULL)
1711  {
1712  if ((p->cPack!=basePack)
1713  && (p->cPack!=currPack))
1714  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1715  if (h!=NULL) return h;
1716  p=p->next;
1717  }
1718  idhdl tmp=basePack->idroot;
1719  while (tmp!=NULL)
1720  {
1721  if (IDTYP(tmp)==PACKAGE_CMD)
1722  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1723  if (h!=NULL) return h;
1724  tmp=IDNEXT(tmp);
1725  }
1726  return NULL;
1727 }
Definition: ipid.h:56
static idhdl rSimpleFindHdl(const ring r, const idhdl root, const idhdl n)
Definition: ipshell.cc:6259

◆ rInit()

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

Definition at line 5624 of file ipshell.cc.

5625 {
5626  int float_len=0;
5627  int float_len2=0;
5628  ring R = NULL;
5629  //BOOLEAN ffChar=FALSE;
5630 
5631  /* ch -------------------------------------------------------*/
5632  // get ch of ground field
5633 
5634  // allocated ring
5635  R = (ring) omAlloc0Bin(sip_sring_bin);
5636 
5637  coeffs cf = NULL;
5638 
5639  assume( pn != NULL );
5640  const int P = pn->listLength();
5641 
5642  if (pn->Typ()==CRING_CMD)
5643  {
5644  cf=(coeffs)pn->CopyD();
5645  leftv pnn=pn;
5646  if(P>1) /*parameter*/
5647  {
5648  pnn = pnn->next;
5649  const int pars = pnn->listLength();
5650  assume( pars > 0 );
5651  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5652 
5653  if (rSleftvList2StringArray(pnn, names))
5654  {
5655  WerrorS("parameter expected");
5656  goto rInitError;
5657  }
5658 
5659  TransExtInfo extParam;
5660 
5661  extParam.r = rDefault( cf, pars, names); // Q/Zp [ p_1, ... p_pars ]
5662  for(int i=pars-1; i>=0;i--)
5663  {
5664  omFree(names[i]);
5665  }
5666  omFree(names);
5667 
5668  cf = nInitChar(n_transExt, &extParam);
5669  }
5670  assume( cf != NULL );
5671  }
5672  else if (pn->Typ()==INT_CMD)
5673  {
5674  int ch = (int)(long)pn->Data();
5675  leftv pnn=pn;
5676 
5677  /* parameter? -------------------------------------------------------*/
5678  pnn = pnn->next;
5679 
5680  if (pnn == NULL) // no params!?
5681  {
5682  if (ch!=0)
5683  {
5684  int ch2=IsPrime(ch);
5685  if ((ch<2)||(ch!=ch2))
5686  {
5687  Warn("%d is invalid as characteristic of the ground field. 32003 is used.", ch);
5688  ch=32003;
5689  }
5690  #ifndef TEST_ZN_AS_ZP
5691  cf = nInitChar(n_Zp, (void*)(long)ch);
5692  #else
5693  mpz_t modBase;
5694  mpz_init_set_ui(modBase, (long)ch);
5695  ZnmInfo info;
5696  info.base= modBase;
5697  info.exp= 1;
5698  cf=nInitChar(n_Zn,(void*) &info);
5699  cf->is_field=1;
5700  cf->is_domain=1;
5701  cf->has_simple_Inverse=1;
5702  #endif
5703  }
5704  else
5705  cf = nInitChar(n_Q, (void*)(long)ch);
5706  }
5707  else
5708  {
5709  const int pars = pnn->listLength();
5710 
5711  assume( pars > 0 );
5712 
5713  // predefined finite field: (p^k, a)
5714  if ((ch!=0) && (ch!=IsPrime(ch)) && (pars == 1))
5715  {
5716  GFInfo param;
5717 
5718  param.GFChar = ch;
5719  param.GFDegree = 1;
5720  param.GFPar_name = pnn->name;
5721 
5722  cf = nInitChar(n_GF, &param);
5723  }
5724  else // (0/p, a, b, ..., z)
5725  {
5726  if ((ch!=0) && (ch!=IsPrime(ch)))
5727  {
5728  WerrorS("too many parameters");
5729  goto rInitError;
5730  }
5731 
5732  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5733 
5734  if (rSleftvList2StringArray(pnn, names))
5735  {
5736  WerrorS("parameter expected");
5737  goto rInitError;
5738  }
5739 
5740  TransExtInfo extParam;
5741 
5742  extParam.r = rDefault( ch, pars, names); // Q/Zp [ p_1, ... p_pars ]
5743  for(int i=pars-1; i>=0;i--)
5744  {
5745  omFree(names[i]);
5746  }
5747  omFree(names);
5748 
5749  cf = nInitChar(n_transExt, &extParam);
5750  }
5751  }
5752 
5753  //if (cf==NULL) ->Error: Invalid ground field specification
5754  }
5755  else if ((pn->name != NULL)
5756  && ((strcmp(pn->name,"real")==0) || (strcmp(pn->name,"complex")==0)))
5757  {
5758  leftv pnn=pn->next;
5759  BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
5760  if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5761  {
5762  float_len=(int)(long)pnn->Data();
5763  float_len2=float_len;
5764  pnn=pnn->next;
5765  if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5766  {
5767  float_len2=(int)(long)pnn->Data();
5768  pnn=pnn->next;
5769  }
5770  }
5771 
5772  if (!complex_flag)
5773  complex_flag= (pnn!=NULL) && (pnn->name!=NULL);
5774  if( !complex_flag && (float_len2 <= (short)SHORT_REAL_LENGTH))
5775  cf=nInitChar(n_R, NULL);
5776  else // longR or longC?
5777  {
5778  LongComplexInfo param;
5779 
5780  param.float_len = si_min (float_len, 32767);
5781  param.float_len2 = si_min (float_len2, 32767);
5782 
5783  // set the parameter name
5784  if (complex_flag)
5785  {
5786  if (param.float_len < SHORT_REAL_LENGTH)
5787  {
5790  }
5791  if ((pnn == NULL) || (pnn->name == NULL))
5792  param.par_name=(const char*)"i"; //default to i
5793  else
5794  param.par_name = (const char*)pnn->name;
5795  }
5796 
5797  cf = nInitChar(complex_flag ? n_long_C: n_long_R, (void*)&param);
5798  }
5799  assume( cf != NULL );
5800  }
5801 #ifdef HAVE_RINGS
5802  else if ((pn->name != NULL) && (strcmp(pn->name, "integer") == 0))
5803  {
5804  // TODO: change to use coeffs_BIGINT!?
5805  mpz_t modBase;
5806  unsigned int modExponent = 1;
5807  mpz_init_set_si(modBase, 0);
5808  if (pn->next!=NULL)
5809  {
5810  leftv pnn=pn;
5811  if (pnn->next->Typ()==INT_CMD)
5812  {
5813  pnn=pnn->next;
5814  mpz_set_ui(modBase, (long) pnn->Data());
5815  if ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5816  {
5817  pnn=pnn->next;
5818  modExponent = (long) pnn->Data();
5819  }
5820  while ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5821  {
5822  pnn=pnn->next;
5823  mpz_mul_ui(modBase, modBase, (int)(long) pnn->Data());
5824  }
5825  }
5826  else if (pnn->next->Typ()==BIGINT_CMD)
5827  {
5828  number p=(number)pnn->next->CopyD();
5829  n_MPZ(modBase,p,coeffs_BIGINT);
5831  }
5832  }
5833  else
5834  cf=nInitChar(n_Z,NULL);
5835 
5836  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_sgn1(modBase) < 0))
5837  {
5838  WerrorS("Wrong ground ring specification (module is 1)");
5839  goto rInitError;
5840  }
5841  if (modExponent < 1)
5842  {
5843  WerrorS("Wrong ground ring specification (exponent smaller than 1");
5844  goto rInitError;
5845  }
5846  // module is 0 ---> integers ringtype = 4;
5847  // we have an exponent
5848  if (modExponent > 1 && cf == NULL)
5849  {
5850  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
5851  {
5852  /* this branch should be active for modExponent = 2..32 resp. 2..64,
5853  depending on the size of a long on the respective platform */
5854  //ringtype = 1; // Use Z/2^ch
5855  cf=nInitChar(n_Z2m,(void*)(long)modExponent);
5856  }
5857  else
5858  {
5859  if (mpz_sgn1(modBase)==0)
5860  {
5861  WerrorS("modulus must not be 0 or parameter not allowed");
5862  goto rInitError;
5863  }
5864  //ringtype = 3;
5865  ZnmInfo info;
5866  info.base= modBase;
5867  info.exp= modExponent;
5868  cf=nInitChar(n_Znm,(void*) &info); //exponent is missing
5869  }
5870  }
5871  // just a module m > 1
5872  else if (cf == NULL)
5873  {
5874  if (mpz_sgn1(modBase)==0)
5875  {
5876  WerrorS("modulus must not be 0 or parameter not allowed");
5877  goto rInitError;
5878  }
5879  //ringtype = 2;
5880  ZnmInfo info;
5881  info.base= modBase;
5882  info.exp= modExponent;
5883  cf=nInitChar(n_Zn,(void*) &info);
5884  }
5885  assume( cf != NULL );
5886  mpz_clear(modBase);
5887  }
5888 #endif
5889  // ring NEW = OLD, (), (); where OLD is a polynomial ring...
5890  else if ((pn->Typ()==RING_CMD) && (P == 1))
5891  {
5892  TransExtInfo extParam;
5893  extParam.r = (ring)pn->Data();
5894  extParam.r->ref++;
5895  cf = nInitChar(n_transExt, &extParam);
5896  }
5897  //else if ((pn->Typ()==QRING_CMD) && (P == 1)) // same for qrings - which should be fields!?
5898  //{
5899  // AlgExtInfo extParam;
5900  // extParam.r = (ring)pn->Data();
5901 
5902  // cf = nInitChar(n_algExt, &extParam); // Q[a]/<minideal>
5903  //}
5904  else
5905  {
5906  WerrorS("Wrong or unknown ground field specification");
5907 #if 0
5908 // debug stuff for unknown cf descriptions:
5909  sleftv* p = pn;
5910  while (p != NULL)
5911  {
5912  Print( "pn[%p]: type: %d [%s]: %p, name: %s", (void*)p, p->Typ(), Tok2Cmdname(p->Typ()), p->Data(), (p->name == NULL? "NULL" : p->name) );
5913  PrintLn();
5914  p = p->next;
5915  }
5916 #endif
5917  goto rInitError;
5918  }
5919 
5920  /*every entry in the new ring is initialized to 0*/
5921 
5922  /* characteristic -----------------------------------------------*/
5923  /* input: 0 ch=0 : Q parameter=NULL ffChar=FALSE float_len
5924  * 0 1 : Q(a,...) *names FALSE
5925  * 0 -1 : R NULL FALSE 0
5926  * 0 -1 : R NULL FALSE prec. >6
5927  * 0 -1 : C *names FALSE prec. 0..?
5928  * p p : Fp NULL FALSE
5929  * p -p : Fp(a) *names FALSE
5930  * q q : GF(q=p^n) *names TRUE
5931  */
5932  if (cf==NULL)
5933  {
5934  WerrorS("Invalid ground field specification");
5935  goto rInitError;
5936 // const int ch=32003;
5937 // cf=nInitChar(n_Zp, (void*)(long)ch);
5938  }
5939 
5940  assume( R != NULL );
5941 
5942  R->cf = cf;
5943 
5944  /* names and number of variables-------------------------------------*/
5945  {
5946  int l=rv->listLength();
5947 
5948  if (l>MAX_SHORT)
5949  {
5950  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
5951  goto rInitError;
5952  }
5953  R->N = l; /*rv->listLength();*/
5954  }
5955  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
5956  if (rSleftvList2StringArray(rv, R->names))
5957  {
5958  WerrorS("name of ring variable expected");
5959  goto rInitError;
5960  }
5961 
5962  /* check names and parameters for conflicts ------------------------- */
5963  rRenameVars(R); // conflicting variables will be renamed
5964  /* ordering -------------------------------------------------------------*/
5965  if (rSleftvOrdering2Ordering(ord, R))
5966  goto rInitError;
5967 
5968  // Complete the initialization
5969  if (rComplete(R,1))
5970  goto rInitError;
5971 
5972 /*#ifdef HAVE_RINGS
5973 // currently, coefficients which are ring elements require a global ordering:
5974  if (rField_is_Ring(R) && (R->OrdSgn==-1))
5975  {
5976  WerrorS("global ordering required for these coefficients");
5977  goto rInitError;
5978  }
5979 #endif*/
5980 
5981  rTest(R);
5982 
5983  // try to enter the ring into the name list
5984  // need to clean up sleftv here, before this ring can be set to
5985  // new currRing or currRing can be killed beacuse new ring has
5986  // same name
5987  pn->CleanUp();
5988  rv->CleanUp();
5989  ord->CleanUp();
5990  //if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
5991  // goto rInitError;
5992 
5993  //memcpy(IDRING(tmp),R,sizeof(*R));
5994  // set current ring
5995  //omFreeBin(R, ip_sring_bin);
5996  //return tmp;
5997  return R;
5998 
5999  // error case:
6000  rInitError:
6001  if ((R != NULL)&&(R->cf!=NULL)) rDelete(R);
6002  pn->CleanUp();
6003  rv->CleanUp();
6004  ord->CleanUp();
6005  return NULL;
6006 }
@ n_R
single prescision (6,6) real numbers
Definition: coeffs.h:31
@ n_Znm
only used if HAVE_RINGS is defined
Definition: coeffs.h:45
@ n_long_R
real floating point (GMP) numbers
Definition: coeffs.h:33
@ n_Z2m
only used if HAVE_RINGS is defined
Definition: coeffs.h:46
@ n_Z
only used if HAVE_RINGS is defined
Definition: coeffs.h:43
@ n_long_C
complex floating point (GMP) numbers
Definition: coeffs.h:41
short float_len2
additional char-flags, rInit
Definition: coeffs.h:102
static FORCE_INLINE void n_MPZ(mpz_t result, number &n, const coeffs r)
conversion of n to a GMP integer; 0 if not possible
Definition: coeffs.h:551
const char * par_name
parameter name
Definition: coeffs.h:103
short float_len
additional char-flags, rInit
Definition: coeffs.h:101
const short MAX_SHORT
Definition: ipshell.cc:5612
BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R)
Definition: ipshell.cc:5304
static BOOLEAN rSleftvList2StringArray(leftv sl, char **p)
Definition: ipshell.cc:5576
#define SHORT_REAL_LENGTH
Definition: numbers.h:57
#define rTest(r)
Definition: ring.h:786
#define mpz_sgn1(A)
Definition: si_gmp.h:18

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6216 of file ipshell.cc.

6217 {
6218  ring r = IDRING(h);
6219  int ref=0;
6220  if (r!=NULL)
6221  {
6222  // avoid, that sLastPrinted is the last reference to the base ring:
6223  // clean up before killing the last "named" refrence:
6224  if ((sLastPrinted.rtyp==RING_CMD)
6225  && (sLastPrinted.data==(void*)r))
6226  {
6227  sLastPrinted.CleanUp(r);
6228  }
6229  ref=r->ref;
6230  if ((ref<=0)&&(r==currRing))
6231  {
6232  // cleanup DENOMINATOR_LIST
6233  if (DENOMINATOR_LIST!=NULL)
6234  {
6236  if (TEST_V_ALLWARN)
6237  Warn("deleting denom_list for ring change from %s",IDID(h));
6238  do
6239  {
6240  n_Delete(&(dd->n),currRing->cf);
6241  dd=dd->next;
6243  DENOMINATOR_LIST=dd;
6244  } while(DENOMINATOR_LIST!=NULL);
6245  }
6246  }
6247  rKill(r);
6248  }
6249  if (h==currRingHdl)
6250  {
6251  if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6252  else
6253  {
6255  }
6256  }
6257 }
void rKill(ring r)
Definition: ipshell.cc:6170
VAR denominator_list DENOMINATOR_LIST
Definition: kutil.cc:84
denominator_list next
Definition: kutil.h:65

◆ rKill() [2/2]

void rKill ( ring  r)

Definition at line 6170 of file ipshell.cc.

6171 {
6172  if ((r->ref<=0)&&(r->order!=NULL))
6173  {
6174 #ifdef RDEBUG
6175  if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6176 #endif
6177  int j;
6178  for (j=0;j<myynest;j++)
6179  {
6180  if (iiLocalRing[j]==r)
6181  {
6182  if (j==0) WarnS("killing the basering for level 0");
6183  iiLocalRing[j]=NULL;
6184  }
6185  }
6186 // any variables depending on r ?
6187  while (r->idroot!=NULL)
6188  {
6189  r->idroot->lev=myynest; // avoid warning about kill global objects
6190  killhdl2(r->idroot,&(r->idroot),r);
6191  }
6192  if (r==currRing)
6193  {
6194  // all dependend stuff is done, clean global vars:
6195  if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6197  {
6199  }
6200  //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6201  //{
6202  // WerrorS("return value depends on local ring variable (export missing ?)");
6203  // iiRETURNEXPR.CleanUp();
6204  //}
6205  currRing=NULL;
6206  currRingHdl=NULL;
6207  }
6208 
6209  /* nKillChar(r); will be called from inside of rDelete */
6210  rDelete(r);
6211  return;
6212  }
6213  rDecRefCnt(r);
6214 }
#define pDelete(p_ptr)
Definition: polys.h:186
static void rDecRefCnt(ring r)
Definition: ring.h:844

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5125 of file ipshell.cc.

5126 {
5127  ring rg = NULL;
5128  if (h!=NULL)
5129  {
5130 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5131  rg = IDRING(h);
5132  if (rg==NULL) return; //id <>NULL, ring==NULL
5133  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5134  if (IDID(h)) // OB: ????
5136  rTest(rg);
5137  }
5138  else return;
5139 
5140  // clean up history
5141  if (currRing!=NULL)
5142  {
5144  {
5146  }
5147 
5148  if (rg!=currRing)/*&&(currRing!=NULL)*/
5149  {
5150  if (rg->cf!=currRing->cf)
5151  {
5153  if (DENOMINATOR_LIST!=NULL)
5154  {
5155  if (TEST_V_ALLWARN)
5156  Warn("deleting denom_list for ring change to %s",IDID(h));
5157  do
5158  {
5159  n_Delete(&(dd->n),currRing->cf);
5160  dd=dd->next;
5162  DENOMINATOR_LIST=dd;
5163  } while(DENOMINATOR_LIST!=NULL);
5164  }
5165  }
5166  }
5167  }
5168 
5169  // test for valid "currRing":
5170  if ((rg!=NULL) && (rg->idroot==NULL))
5171  {
5172  ring old=rg;
5173  rg=rAssure_HasComp(rg);
5174  if (old!=rg)
5175  {
5176  rKill(old);
5177  IDRING(h)=rg;
5178  }
5179  }
5180  /*------------ change the global ring -----------------------*/
5181  rChangeCurrRing(rg);
5182  currRingHdl = h;
5183 }
#define omCheckAddr(addr)
Definition: omAllocDecl.h:328
#define omCheckAddrSize(addr, size)
Definition: omAllocDecl.h:327
ring rAssure_HasComp(const ring r)
Definition: ring.cc:4705

◆ scIndIndset()

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

Definition at line 1103 of file ipshell.cc.

1105 {
1106  int i;
1107  indset save;
1109 
1110  hexist = hInit(S, Q, &hNexist);
1111  if (hNexist == 0)
1112  {
1113  intvec *iv=new intvec(rVar(currRing));
1114  for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1115  res->Init(1);
1116  res->m[0].rtyp=INTVEC_CMD;
1117  res->m[0].data=(intvec*)iv;
1118  return res;
1119  }
1120  save = ISet = (indset)omAlloc0Bin(indlist_bin);
1121  hMu = 0;
1122  hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1123  hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1124  hpure = (scmon)omAlloc0((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1125  hrad = hexist;
1126  hNrad = hNexist;
1127  radmem = hCreate(rVar(currRing) - 1);
1128  hCo = rVar(currRing) + 1;
1129  hNvar = rVar(currRing);
1130  hRadical(hrad, &hNrad, hNvar);
1131  hSupp(hrad, hNrad, hvar, &hNvar);
1132  if (hNvar)
1133  {
1134  hCo = hNvar;
1135  hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1136  hLexR(hrad, hNrad, hvar, hNvar);
1138  }
1139  if (hCo && (hCo < rVar(currRing)))
1140  {
1142  }
1143  if (hMu!=0)
1144  {
1145  ISet = save;
1146  hMu2 = 0;
1147  if (all && (hCo+1 < rVar(currRing)))
1148  {
1151  i=hMu+hMu2;
1152  res->Init(i);
1153  if (hMu2 == 0)
1154  {
1156  }
1157  }
1158  else
1159  {
1160  res->Init(hMu);
1161  }
1162  for (i=0;i<hMu;i++)
1163  {
1164  res->m[i].data = (void *)save->set;
1165  res->m[i].rtyp = INTVEC_CMD;
1166  ISet = save;
1167  save = save->nx;
1169  }
1170  omFreeBin((ADDRESS)save, indlist_bin);
1171  if (hMu2 != 0)
1172  {
1173  save = JSet;
1174  for (i=hMu;i<hMu+hMu2;i++)
1175  {
1176  res->m[i].data = (void *)save->set;
1177  res->m[i].rtyp = INTVEC_CMD;
1178  JSet = save;
1179  save = save->nx;
1181  }
1182  omFreeBin((ADDRESS)save, indlist_bin);
1183  }
1184  }
1185  else
1186  {
1187  res->Init(0);
1189  }
1190  hKill(radmem, rVar(currRing) - 1);
1191  omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1192  omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1193  omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1195  return res;
1196 }
void hIndMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:384
VAR omBin indlist_bin
Definition: hdegree.cc:29
VAR int hMu2
Definition: hdegree.cc:27
VAR int hCo
Definition: hdegree.cc:27
VAR indset ISet
Definition: hdegree.cc:353
VAR long hMu
Definition: hdegree.cc:28
VAR indset JSet
Definition: hdegree.cc:353
void hDimSolve(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:35
void hIndAllMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:564
monf hCreate(int Nvar)
Definition: hutil.cc:996
VAR varset hvar
Definition: hutil.cc:18
void hKill(monf xmem, int Nvar)
Definition: hutil.cc:1010
VAR int hNexist
Definition: hutil.cc:19
void hDelete(scfmon ev, int ev_length)
Definition: hutil.cc:140
void hPure(scfmon stc, int a, int *Nstc, varset var, int Nvar, scmon pure, int *Npure)
Definition: hutil.cc:621
VAR scfmon hwork
Definition: hutil.cc:16
void hSupp(scfmon stc, int Nstc, varset var, int *Nvar)
Definition: hutil.cc:174
void hLexR(scfmon rad, int Nrad, varset var, int Nvar)
Definition: hutil.cc:565
VAR scmon hpure
Definition: hutil.cc:17
VAR scfmon hrad
Definition: hutil.cc:16
VAR monf radmem
Definition: hutil.cc:21
VAR int hNpure
Definition: hutil.cc:19
VAR int hNrad
Definition: hutil.cc:19
scfmon hInit(ideal S, ideal Q, int *Nexist)
Definition: hutil.cc:31
VAR scfmon hexist
Definition: hutil.cc:16
void hRadical(scfmon rad, int *Nrad, int Nvar)
Definition: hutil.cc:411
VAR int hNvar
Definition: hutil.cc:19
scmon * scfmon
Definition: hutil.h:15
indlist * indset
Definition: hutil.h:28
int * varset
Definition: hutil.h:16
int * scmon
Definition: hutil.h:14
STATIC_VAR jList * Q
Definition: janet.cc:30

◆ semicProc()

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

Definition at line 4550 of file ipshell.cc.

4551 {
4552  sleftv tmp;
4553  tmp.Init();
4554  tmp.rtyp=INT_CMD;
4555  /* tmp.data = (void *)0; -- done by Init */
4556 
4557  return semicProc3(res,u,v,&tmp);
4558 }

◆ semicProc3()

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

Definition at line 4510 of file ipshell.cc.

4511 {
4512  semicState state;
4513  BOOLEAN qh=(((int)(long)w->Data())==1);
4514 
4515  // -----------------
4516  // check arguments
4517  // -----------------
4518 
4519  lists l1 = (lists)u->Data( );
4520  lists l2 = (lists)v->Data( );
4521 
4522  if( (state=list_is_spectrum( l1 ))!=semicOK )
4523  {
4524  WerrorS( "first argument is not a spectrum" );
4525  list_error( state );
4526  }
4527  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4528  {
4529  WerrorS( "second argument is not a spectrum" );
4530  list_error( state );
4531  }
4532  else
4533  {
4534  spectrum s1= spectrumFromList( l1 );
4535  spectrum s2= spectrumFromList( l2 );
4536 
4537  res->rtyp = INT_CMD;
4538  if (qh)
4539  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4540  else
4541  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4542  }
4543 
4544  // -----------------
4545  // check status
4546  // -----------------
4547 
4548  return (state!=semicOK);
4549 }
Definition: semic.h:64
int mult_spectrum(spectrum &)
Definition: semic.cc:396
int mult_spectrumh(spectrum &)
Definition: semic.cc:425
semicState
Definition: ipshell.cc:3434
@ semicOK
Definition: ipshell.cc:3435
void list_error(semicState state)
Definition: ipshell.cc:3467
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3383
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4252

◆ setOption()

BOOLEAN setOption ( leftv  res,
leftv  v 
)

Definition at line 568 of file misc_ip.cc.

569 {
570  const char *n;
571  do
572  {
573  if (v->Typ()==STRING_CMD)
574  {
575  n=(const char *)v->CopyD(STRING_CMD);
576  }
577  else
578  {
579  if (v->name==NULL)
580  return TRUE;
581  if (v->rtyp==0)
582  {
583  n=v->name;
584  v->name=NULL;
585  }
586  else
587  {
588  n=omStrDup(v->name);
589  }
590  }
591 
592  int i;
593 
594  if(strcmp(n,"get")==0)
595  {
596  intvec *w=new intvec(2);
597  (*w)[0]=si_opt_1;
598  (*w)[1]=si_opt_2;
599  res->rtyp=INTVEC_CMD;
600  res->data=(void *)w;
601  goto okay;
602  }
603  if(strcmp(n,"set")==0)
604  {
605  if((v->next!=NULL)
606  &&(v->next->Typ()==INTVEC_CMD))
607  {
608  v=v->next;
609  intvec *w=(intvec*)v->Data();
610  si_opt_1=(*w)[0];
611  si_opt_2=(*w)[1];
612 #if 0
616  ) {
618  }
619 #endif
620  goto okay;
621  }
622  }
623  if(strcmp(n,"none")==0)
624  {
625  si_opt_1=0;
626  si_opt_2=0;
627  goto okay;
628  }
629  for (i=0; (i==0) || (optionStruct[i-1].setval!=0); i++)
630  {
631  if (strcmp(n,optionStruct[i].name)==0)
632  {
633  if (optionStruct[i].setval & validOpts)
634  {
636  // optOldStd disables redthrough
637  if (optionStruct[i].setval == Sy_bit(OPT_OLDSTD))
639  }
640  else
641  WarnS("cannot set option");
642 #if 0
646  ) {
648  }
649 #endif
650  goto okay;
651  }
652  else if ((strncmp(n,"no",2)==0)
653  && (strcmp(n+2,optionStruct[i].name)==0))
654  {
655  if (optionStruct[i].setval & validOpts)
656  {
658  }
659  else
660  WarnS("cannot clear option");
661  goto okay;
662  }
663  }
664  for (i=0; (i==0) || (verboseStruct[i-1].setval!=0); i++)
665  {
666  if (strcmp(n,verboseStruct[i].name)==0)
667  {
669  #ifdef YYDEBUG
670  #if YYDEBUG
671  /*debugging the bison grammar --> grammar.cc*/
672  EXTERN_VAR int yydebug;
673  if (BVERBOSE(V_YACC)) yydebug=1;
674  else yydebug=0;
675  #endif
676  #endif
677  goto okay;
678  }
679  else if ((strncmp(n,"no",2)==0)
680  && (strcmp(n+2,verboseStruct[i].name)==0))
681  {
683  #ifdef YYDEBUG
684  #if YYDEBUG
685  /*debugging the bison grammar --> grammar.cc*/
686  EXTERN_VAR int yydebug;
687  if (BVERBOSE(V_YACC)) yydebug=1;
688  else yydebug=0;
689  #endif
690  #endif
691  goto okay;
692  }
693  }
694  Werror("unknown option `%s`",n);
695  okay:
696  if (currRing != NULL)
697  currRing->options = si_opt_1 & TEST_RINGDEP_OPTS;
699  v=v->next;
700  } while (v!=NULL);
701 
702  // set global variable to show memory usage
704  else om_sing_opt_show_mem = 0;
705 
706  return FALSE;
707 }
CanonicalForm test
Definition: cfModGcd.cc:4096
VAR int yydebug
Definition: grammar.cc:1805
unsigned resetval
Definition: ipid.h:154
VAR BITSET validOpts
Definition: kstd1.cc:60
const struct soptionStruct verboseStruct[]
Definition: misc_ip.cc:538
const struct soptionStruct optionStruct[]
Definition: misc_ip.cc:507
int om_sing_opt_show_mem
#define OPT_INTSTRATEGY
Definition: options.h:93
#define TEST_OPT_INTSTRATEGY
Definition: options.h:111
#define V_SHOW_MEM
Definition: options.h:43
#define V_YACC
Definition: options.h:44
#define OPT_REDTHROUGH
Definition: options.h:83
#define TEST_RINGDEP_OPTS
Definition: options.h:101
#define OPT_OLDSTD
Definition: options.h:87
static BOOLEAN rField_has_simple_inverse(const ring r)
Definition: ring.h:549

◆ showOption()

char* showOption ( )

Definition at line 709 of file misc_ip.cc.

710 {
711  int i;
712  BITSET tmp;
713 
714  StringSetS("//options:");
715  if ((si_opt_1!=0)||(si_opt_2!=0))
716  {
717  tmp=si_opt_1;
718  if(tmp)
719  {
720  for (i=0; optionStruct[i].setval!=0; i++)
721  {
722  if (optionStruct[i].setval & tmp)
723  {
725  tmp &=optionStruct[i].resetval;
726  }
727  }
728  for (i=0; i<32; i++)
729  {
730  if (tmp & Sy_bit(i)) StringAppend(" %d",i);
731  }
732  }
733  tmp=si_opt_2;
734  if (tmp)
735  {
736  for (i=0; verboseStruct[i].setval!=0; i++)
737  {
738  if (verboseStruct[i].setval & tmp)
739  {
741  tmp &=verboseStruct[i].resetval;
742  }
743  }
744  for (i=1; i<32; i++)
745  {
746  if (tmp & Sy_bit(i)) StringAppend(" %d",i+32);
747  }
748  }
749  return StringEndS();
750  }
751  StringAppendS(" none");
752  return StringEndS();
753 }
#define StringAppend
Definition: emacs.cc:79
void StringAppendS(const char *st)
Definition: reporter.cc:107

◆ singular_example()

void singular_example ( char *  str)

Definition at line 430 of file misc_ip.cc.

431 {
432  assume(str!=NULL);
433  char *s=str;
434  while (*s==' ') s++;
435  char *ss=s;
436  while (*ss!='\0') ss++;
437  while (*ss<=' ')
438  {
439  *ss='\0';
440  ss--;
441  }
442  idhdl h=IDROOT->get_level(s,0);
443  if ((h!=NULL) && (IDTYP(h)==PROC_CMD))
444  {
445  char *lib=iiGetLibName(IDPROC(h));
446  if((lib!=NULL)&&(*lib!='\0'))
447  {
448  Print("// proc %s from lib %s\n",s,lib);
450  if (s!=NULL)
451  {
452  if (strlen(s)>5)
453  {
454  iiEStart(s,IDPROC(h));
455  omFree((ADDRESS)s);
456  return;
457  }
458  else omFree((ADDRESS)s);
459  }
460  }
461  }
462  else
463  {
464  char sing_file[MAXPATHLEN];
465  FILE *fd=NULL;
466  char *res_m=feResource('m', 0);
467  if (res_m!=NULL)
468  {
469  sprintf(sing_file, "%s/%s.sing", res_m, s);
470  fd = feFopen(sing_file, "r");
471  }
472  if (fd != NULL)
473  {
474 
475  int old_echo = si_echo;
476  int length, got;
477  char* s;
478 
479  fseek(fd, 0, SEEK_END);
480  length = ftell(fd);
481  fseek(fd, 0, SEEK_SET);
482  s = (char*) omAlloc((length+20)*sizeof(char));
483  got = fread(s, sizeof(char), length, fd);
484  fclose(fd);
485  if (got != length)
486  {
487  Werror("Error while reading file %s", sing_file);
488  }
489  else
490  {
491  s[length] = '\0';
492  strcat(s, "\n;return();\n\n");
493  si_echo = 2;
494  iiEStart(s, NULL);
495  si_echo = old_echo;
496  }
497  omFree(s);
498  }
499  else
500  {
501  Werror("no example for %s", str);
502  }
503  }
504 }
BOOLEAN iiEStart(char *example, procinfo *pi)
Definition: iplib.cc:754
static char * iiGetLibName(const procinfov pi)
find the library of an proc
Definition: ipshell.h:66
#define SEEK_SET
Definition: mod2.h:115
#define SEEK_END
Definition: mod2.h:111
char * str(leftv arg)
Definition: shared.cc:704
int status int fd
Definition: si_signals.h:59

◆ singular_system()

leftv singular_system ( sleftv  h)

◆ spaddProc()

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

Definition at line 4427 of file ipshell.cc.

4428 {
4429  semicState state;
4430 
4431  // -----------------
4432  // check arguments
4433  // -----------------
4434 
4435  lists l1 = (lists)first->Data( );
4436  lists l2 = (lists)second->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  spectrum sum( s1+s2 );
4453 
4454  result->rtyp = LIST_CMD;
4455  result->data = (char*)(getList(sum));
4456  }
4457 
4458  return (state!=semicOK);
4459 }
lists getList(spectrum &spec)
Definition: ipshell.cc:3395

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv  result,
leftv  first 
)

Definition at line 4183 of file ipshell.cc.

4184 {
4185  spectrumState state = spectrumOK;
4186 
4187  // -------------------
4188  // check consistency
4189  // -------------------
4190 
4191  // check for a local polynomial ring
4192 
4193  if( currRing->OrdSgn != -1 )
4194  // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4195  // or should we use:
4196  //if( !ringIsLocal( ) )
4197  {
4198  WerrorS( "only works for local orderings" );
4199  state = spectrumWrongRing;
4200  }
4201  else if( currRing->qideal != NULL )
4202  {
4203  WerrorS( "does not work in quotient rings" );
4204  state = spectrumWrongRing;
4205  }
4206  else
4207  {
4208  lists L = (lists)NULL;
4209  int flag = 2; // symmetric optimization
4210 
4211  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4212 
4213  if( state==spectrumOK )
4214  {
4215  result->rtyp = LIST_CMD;
4216  result->data = (char*)L;
4217  }
4218  else
4219  {
4220  spectrumPrintError(state);
4221  }
4222  }
4223 
4224  return (state!=spectrumOK);
4225 }
spectrumState
Definition: ipshell.cc:3550
@ spectrumWrongRing
Definition: ipshell.cc:3557
@ spectrumOK
Definition: ipshell.cc:3551
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3809
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:4101

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4132 of file ipshell.cc.

4133 {
4134  spectrumState state = spectrumOK;
4135 
4136  // -------------------
4137  // check consistency
4138  // -------------------
4139 
4140  // check for a local ring
4141 
4142  if( !ringIsLocal(currRing ) )
4143  {
4144  WerrorS( "only works for local orderings" );
4145  state = spectrumWrongRing;
4146  }
4147 
4148  // no quotient rings are allowed
4149 
4150  else if( currRing->qideal != NULL )
4151  {
4152  WerrorS( "does not work in quotient rings" );
4153  state = spectrumWrongRing;
4154  }
4155  else
4156  {
4157  lists L = (lists)NULL;
4158  int flag = 1; // weight corner optimization is safe
4159 
4160  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4161 
4162  if( state==spectrumOK )
4163  {
4164  result->rtyp = LIST_CMD;
4165  result->data = (char*)L;
4166  }
4167  else
4168  {
4169  spectrumPrintError(state);
4170  }
4171  }
4172 
4173  return (state!=spectrumOK);
4174 }
BOOLEAN ringIsLocal(const ring r)
Definition: spectrum.cc:461

◆ spmulProc()

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

Definition at line 4469 of file ipshell.cc.

4470 {
4471  semicState state;
4472 
4473  // -----------------
4474  // check arguments
4475  // -----------------
4476 
4477  lists l = (lists)first->Data( );
4478  int k = (int)(long)second->Data( );
4479 
4480  if( (state=list_is_spectrum( l ))!=semicOK )
4481  {
4482  WerrorS( "first argument is not a spectrum" );
4483  list_error( state );
4484  }
4485  else if( k < 0 )
4486  {
4487  WerrorS( "second argument should be positive" );
4488  state = semicMulNegative;
4489  }
4490  else
4491  {
4493  spectrum product( k*s );
4494 
4495  result->rtyp = LIST_CMD;
4496  result->data = (char*)getList(product);
4497  }
4498 
4499  return (state!=semicOK);
4500 }
@ semicMulNegative
Definition: ipshell.cc:3436

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3171 of file ipshell.cc.

3172 {
3173  sleftv tmp;
3174  tmp.Init();
3175  tmp.rtyp=INT_CMD;
3176  tmp.data=(void *)1;
3177  return syBetti2(res,u,&tmp);
3178 }
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3148

◆ syBetti2()

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

Definition at line 3148 of file ipshell.cc.

3149 {
3150  syStrategy syzstr=(syStrategy)u->Data();
3151 
3152  BOOLEAN minim=(int)(long)w->Data();
3153  int row_shift=0;
3154  int add_row_shift=0;
3155  intvec *weights=NULL;
3156  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3157  if (ww!=NULL)
3158  {
3159  weights=ivCopy(ww);
3160  add_row_shift = ww->min_in();
3161  (*weights) -= add_row_shift;
3162  }
3163 
3164  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3165  //row_shift += add_row_shift;
3166  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3167  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3168 
3169  return FALSE;
3170 }
intvec * syBettiOfComputation(syStrategy syzstr, BOOLEAN minim=TRUE, int *row_shift=NULL, intvec *weights=NULL)
Definition: syz1.cc:1755
ssyStrategy * syStrategy
Definition: syz.h:35

◆ syConvList()

syStrategy syConvList ( lists  li)

Definition at line 3255 of file ipshell.cc.

3256 {
3257  int typ0;
3259 
3260  resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3261  if (fr != NULL)
3262  {
3263 
3264  result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3265  for (int i=result->length-1;i>=0;i--)
3266  {
3267  if (fr[i]!=NULL)
3268  result->fullres[i] = idCopy(fr[i]);
3269  }
3270  result->list_length=result->length;
3271  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3272  }
3273  else
3274  {
3275  omFreeSize(result, sizeof(ssyStrategy));
3276  result = NULL;
3277  }
3278  return result;
3279 }

◆ syConvRes()

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

Definition at line 3183 of file ipshell.cc.

3184 {
3185  resolvente fullres = syzstr->fullres;
3186  resolvente minres = syzstr->minres;
3187 
3188  const int length = syzstr->length;
3189 
3190  if ((fullres==NULL) && (minres==NULL))
3191  {
3192  if (syzstr->hilb_coeffs==NULL)
3193  { // La Scala
3194  fullres = syReorder(syzstr->res, length, syzstr);
3195  }
3196  else
3197  { // HRES
3198  minres = syReorder(syzstr->orderedRes, length, syzstr);
3199  syKillEmptyEntres(minres, length);
3200  }
3201  }
3202 
3203  resolvente tr;
3204  int typ0=IDEAL_CMD;
3205 
3206  if (minres!=NULL)
3207  tr = minres;
3208  else
3209  tr = fullres;
3210 
3211  resolvente trueres=NULL;
3212  intvec ** w=NULL;
3213 
3214  if (length>0)
3215  {
3216  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3217  for (int i=length-1;i>=0;i--)
3218  {
3219  if (tr[i]!=NULL)
3220  {
3221  trueres[i] = idCopy(tr[i]);
3222  }
3223  }
3224  if ( id_RankFreeModule(trueres[0], currRing) > 0)
3225  typ0 = MODUL_CMD;
3226  if (syzstr->weights!=NULL)
3227  {
3228  w = (intvec**)omAlloc0(length*sizeof(intvec*));
3229  for (int i=length-1;i>=0;i--)
3230  {
3231  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3232  }
3233  }
3234  }
3235 
3236  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3237  w, add_row_shift);
3238 
3239  if (toDel)
3240  syKillComputation(syzstr);
3241  else
3242  {
3243  if( fullres != NULL && syzstr->fullres == NULL )
3244  syzstr->fullres = fullres;
3245 
3246  if( minres != NULL && syzstr->minres == NULL )
3247  syzstr->minres = minres;
3248  }
3249  return li;
3250 }
long id_RankFreeModule(ideal s, ring lmRing, ring tailRing)
return the maximal component number found in any polynomial in s
intvec ** hilb_coeffs
Definition: syz.h:46
resolvente minres
Definition: syz.h:58
void syKillComputation(syStrategy syzstr, ring r=currRing)
Definition: syz1.cc:1495
resolvente syReorder(resolvente res, int length, syStrategy syzstr, BOOLEAN toCopy=TRUE, resolvente totake=NULL)
Definition: syz1.cc:1641
void syKillEmptyEntres(resolvente res, int length)
Definition: syz1.cc:2199
short list_length
Definition: syz.h:62
resolvente res
Definition: syz.h:47
resolvente fullres
Definition: syz.h:57
intvec ** weights
Definition: syz.h:45
resolvente orderedRes
Definition: syz.h:48
int length
Definition: syz.h:60

◆ syForceMin()

syStrategy syForceMin ( lists  li)

Definition at line 3284 of file ipshell.cc.

3285 {
3286  int typ0;
3288 
3289  resolvente fr = liFindRes(li,&(result->length),&typ0);
3290  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3291  for (int i=result->length-1;i>=0;i--)
3292  {
3293  if (fr[i]!=NULL)
3294  result->minres[i] = idCopy(fr[i]);
3295  }
3296  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3297  return result;
3298 }

◆ test_cmd()

void test_cmd ( int  i)

Definition at line 514 of file ipshell.cc.

515 {
516  int ii;
517 
518  if (i<0)
519  {
520  ii= -i;
521  if (ii < 32)
522  {
523  si_opt_1 &= ~Sy_bit(ii);
524  }
525  else if (ii < 64)
526  {
527  si_opt_2 &= ~Sy_bit(ii-32);
528  }
529  else
530  WerrorS("out of bounds\n");
531  }
532  else if (i<32)
533  {
534  ii=i;
535  if (Sy_bit(ii) & kOptions)
536  {
537  WarnS("Gerhard, use the option command");
538  si_opt_1 |= Sy_bit(ii);
539  }
540  else if (Sy_bit(ii) & validOpts)
541  si_opt_1 |= Sy_bit(ii);
542  }
543  else if (i<64)
544  {
545  ii=i-32;
546  si_opt_2 |= Sy_bit(ii);
547  }
548  else
549  WerrorS("out of bounds\n");
550 }
VAR BITSET kOptions
Definition: kstd1.cc:45

◆ Tok2Cmdname()

const char* Tok2Cmdname ( int  i)

Definition at line 140 of file gentable.cc.

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

◆ type_cmd()

void type_cmd ( leftv  v)

Definition at line 254 of file ipshell.cc.

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

◆ versionString()

char* versionString ( )

Definition at line 770 of file misc_ip.cc.

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

Variable Documentation

◆ currid

const char* currid
extern

Definition at line 171 of file grammar.cc.

◆ dArith1

const struct sValCmd1 dArith1[]
extern

Definition at line 1 of file table.h.

◆ dArith2

const struct sValCmd2 dArith2[]
extern

Definition at line 1 of file table.h.

◆ dArith3

const struct sValCmd3 dArith3[]
extern

Definition at line 1 of file table.h.

◆ dArithM

const struct sValCmdM dArithM[]
extern

Definition at line 1 of file table.h.

◆ iiCurrArgs

EXTERN_VAR leftv iiCurrArgs

Definition at line 29 of file ipshell.h.

◆ iiCurrProc

EXTERN_VAR idhdl iiCurrProc

Definition at line 30 of file ipshell.h.

◆ iiLocalRing

EXTERN_VAR ring* iiLocalRing

Definition at line 35 of file ipshell.h.

◆ iiOp

EXTERN_VAR int iiOp

Definition at line 31 of file ipshell.h.

◆ iiRETURNEXPR

EXTERN_INST_VAR sleftv iiRETURNEXPR

Definition at line 34 of file ipshell.h.

◆ iiRETURNEXPR_len

EXTERN_VAR int iiRETURNEXPR_len

Definition at line 33 of file ipshell.h.

◆ lastreserved

const char* lastreserved
extern

Definition at line 82 of file ipshell.cc.

◆ myynest

EXTERN_VAR int myynest

Definition at line 38 of file ipshell.h.

◆ printlevel

EXTERN_VAR int printlevel

Definition at line 39 of file ipshell.h.

◆ si_echo

EXTERN_VAR int si_echo

Definition at line 40 of file ipshell.h.

◆ yyInRingConstruction

EXTERN_VAR BOOLEAN yyInRingConstruction

Definition at line 43 of file ipshell.h.