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:572
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:9480
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:34
#define V_REDEFINE
Definition: options.h:44
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 835 of file ipid.cc.

836 {
837  if (iiCurrArgs==NULL)
838  {
839  Werror("not enough arguments for proc %s",VoiceName());
840  p->CleanUp();
841  return TRUE;
842  }
844  iiCurrArgs=h->next;
845  h->next=NULL;
846  if (h->rtyp!=IDHDL)
847  {
849  h->CleanUp();
851  return res;
852  }
853  if ((h->Typ()!=p->Typ()) &&(p->Typ()!=DEF_CMD))
854  {
855  WerrorS("type mismatch");
856  return TRUE;
857  }
858  idhdl pp=(idhdl)p->data;
859  switch(pp->typ)
860  {
861  case CRING_CMD:
862  nKillChar((coeffs)pp);
863  break;
864  case DEF_CMD:
865  case INT_CMD:
866  break;
867  case INTVEC_CMD:
868  case INTMAT_CMD:
869  delete IDINTVEC(pp);
870  break;
871  case NUMBER_CMD:
872  nDelete(&IDNUMBER(pp));
873  break;
874  case BIGINT_CMD:
876  break;
877  case MAP_CMD:
878  {
879  map im = IDMAP(pp);
880  omFreeBinAddr((ADDRESS)im->preimage);
881  im->preimage=NULL;// and continue
882  }
883  // continue as ideal:
884  case IDEAL_CMD:
885  case MODUL_CMD:
886  case MATRIX_CMD:
887  idDelete(&IDIDEAL(pp));
888  break;
889  case PROC_CMD:
890  case RESOLUTION_CMD:
891  case STRING_CMD:
893  break;
894  case LIST_CMD:
895  IDLIST(pp)->Clean();
896  break;
897  case LINK_CMD:
899  break;
900  // case ring: cannot happen
901  default:
902  Werror("unknown type %d",p->Typ());
903  return TRUE;
904  }
905  pp->typ=ALIAS_CMD;
906  IDDATA(pp)=(char*)h->data;
907  int eff_typ=h->Typ();
908  if ((RingDependend(eff_typ))
909  || ((eff_typ==LIST_CMD) && (lRingDependend((lists)h->Data()))))
910  {
911  ipSwapId(pp,IDROOT,currRing->idroot);
912  }
913  h->CleanUp();
915  return FALSE;
916 }
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:522
CanonicalForm res
Definition: facAbsFact.cc:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
const char * VoiceName()
Definition: fevoices.cc:56
@ 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:670
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:164
@ 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:143
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 6425 of file ipshell.cc.

6426 {
6427  res->Init();
6428  res->rtyp=a->Typ();
6429  switch (res->rtyp /*a->Typ()*/)
6430  {
6431  case INTVEC_CMD:
6432  case INTMAT_CMD:
6433  return iiApplyINTVEC(res,a,op,proc);
6434  case BIGINTMAT_CMD:
6435  return iiApplyBIGINTMAT(res,a,op,proc);
6436  case IDEAL_CMD:
6437  case MODUL_CMD:
6438  case MATRIX_CMD:
6439  return iiApplyIDEAL(res,a,op,proc);
6440  case LIST_CMD:
6441  return iiApplyLIST(res,a,op,proc);
6442  }
6443  WerrorS("first argument to `apply` must allow an index");
6444  return TRUE;
6445 }
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:6344
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6386
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6381
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6376

◆ iiARROW()

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

Definition at line 6474 of file ipshell.cc.

6475 {
6476  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6477  // find end of s:
6478  int end_s=strlen(s);
6479  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6480  s[end_s+1]='\0';
6481  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6482  sprintf(name,"%s->%s",a,s);
6483  // find start of last expression
6484  int start_s=end_s-1;
6485  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6486  if (start_s<0) // ';' not found
6487  {
6488  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6489  }
6490  else // s[start_s] is ';'
6491  {
6492  s[start_s]='\0';
6493  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6494  }
6495  r->Init();
6496  // now produce procinfo for PROC_CMD:
6497  r->data = (void *)omAlloc0Bin(procinfo_bin);
6498  ((procinfo *)(r->data))->language=LANG_NONE;
6499  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6500  ((procinfo *)r->data)->data.s.body=ss;
6501  omFree(name);
6502  r->rtyp=PROC_CMD;
6503  //r->rtyp=STRING_CMD;
6504  //r->data=ss;
6505  return FALSE;
6506 }
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:695
#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 6508 of file ipshell.cc.

6509 {
6510  char* ring_name=omStrDup((char*)r->Name());
6511  int t=arg->Typ();
6512  if (t==RING_CMD)
6513  {
6514  sleftv tmp;
6515  tmp.Init();
6516  tmp.rtyp=IDHDL;
6517  idhdl h=rDefault(ring_name);
6518  tmp.data=(char*)h;
6519  if (h!=NULL)
6520  {
6521  tmp.name=h->id;
6522  BOOLEAN b=iiAssign(&tmp,arg);
6523  if (b) return TRUE;
6524  rSetHdl(ggetid(ring_name));
6525  omFree(ring_name);
6526  return FALSE;
6527  }
6528  else
6529  return TRUE;
6530  }
6531  else if (t==CRING_CMD)
6532  {
6533  sleftv tmp;
6534  sleftv n;
6535  n.Init();
6536  n.name=ring_name;
6537  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6538  if (iiAssign(&tmp,arg)) return TRUE;
6539  //Print("create %s\n",r->Name());
6540  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6541  return FALSE;
6542  }
6543  //Print("create %s\n",r->Name());
6544  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6545  return TRUE;// not handled -> error for now
6546 }
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:1202
idhdl rDefault(const char *s)
Definition: ipshell.cc:1648
void rSetHdl(idhdl h)
Definition: ipshell.cc:5129

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  r,
leftv  args 
)

Definition at line 1277 of file ipshell.cc.

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

1635 {
1636  if (p!=basePack)
1637  {
1638  idhdl t=basePack->idroot;
1639  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1640  if (t==NULL)
1641  {
1642  WarnS("package not found\n");
1643  p=basePack;
1644  }
1645  }
1646 }
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 1590 of file ipshell.cc.

1591 {
1592  if (currRing==NULL)
1593  {
1594  #ifdef SIQ
1595  if (siq<=0)
1596  {
1597  #endif
1598  if (RingDependend(i))
1599  {
1600  WerrorS("no ring active (9)");
1601  return TRUE;
1602  }
1603  #ifdef SIQ
1604  }
1605  #endif
1606  }
1607  return FALSE;
1608 }
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 6566 of file ipshell.cc.

6567 {
6568  int l=0;
6569  if (args==NULL)
6570  {
6571  if (type_list[0]==0) return TRUE;
6572  }
6573  else l=args->listLength();
6574  if (l!=(int)type_list[0])
6575  {
6576  if (report) iiReportTypes(0,l,type_list);
6577  return FALSE;
6578  }
6579  for(int i=1;i<=l;i++,args=args->next)
6580  {
6581  short t=type_list[i];
6582  if (t!=ANY_TYPE)
6583  {
6584  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6585  || (t!=args->Typ()))
6586  {
6587  if (report) iiReportTypes(i,args->Typ(),type_list);
6588  return FALSE;
6589  }
6590  }
6591  }
6592  return TRUE;
6593 }
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6548
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:75
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 1202 of file ipshell.cc.

1203 {
1204  BOOLEAN res=FALSE;
1205  BOOLEAN is_qring=FALSE;
1206  const char *id = name->name;
1207 
1208  sy->Init();
1209  if ((name->name==NULL)||(isdigit(name->name[0])))
1210  {
1211  WerrorS("object to declare is not a name");
1212  res=TRUE;
1213  }
1214  else
1215  {
1216  if (root==NULL) return TRUE;
1217  if (*root!=IDROOT)
1218  {
1219  if ((currRing==NULL) || (*root!=currRing->idroot))
1220  {
1221  Werror("can not define `%s` in other package",name->name);
1222  return TRUE;
1223  }
1224  }
1225  if (t==QRING_CMD)
1226  {
1227  t=RING_CMD; // qring is always RING_CMD
1228  is_qring=TRUE;
1229  }
1230 
1231  if (TEST_V_ALLWARN
1232  && (name->rtyp!=0)
1233  && (name->rtyp!=IDHDL)
1234  && (currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1235  {
1236  Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1238  }
1239  {
1240  sy->data = (char *)enterid(id,lev,t,root,init_b);
1241  }
1242  if (sy->data!=NULL)
1243  {
1244  sy->rtyp=IDHDL;
1245  currid=sy->name=IDID((idhdl)sy->data);
1246  if (is_qring)
1247  {
1249  }
1250  // name->name=NULL; /* used in enterid */
1251  //sy->e = NULL;
1252  if (name->next!=NULL)
1253  {
1255  res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1256  }
1257  }
1258  else res=TRUE;
1259  }
1260  name->CleanUp();
1261  return res;
1262 }
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:804
void push(char *)
Definition: ipid.cc:794
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:1705
#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 1515 of file ipshell.cc.

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

◆ iiExport() [2/2]

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

Definition at line 1538 of file ipshell.cc.

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

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

8941 {
8942  res->Init();
8943  BOOLEAN call_failed=FALSE;
8944 
8945  if (!errorreported)
8946  {
8947  BOOLEAN failed=FALSE;
8948  iiOp=op;
8949  int i = 0;
8950  while (dA1[i].cmd==op)
8951  {
8952  if (at==dA1[i].arg)
8953  {
8954  if (currRing!=NULL)
8955  {
8956  if (check_valid(dA1[i].valid_for,op)) break;
8957  }
8958  else
8959  {
8960  if (RingDependend(dA1[i].res))
8961  {
8962  WerrorS("no ring active (5)");
8963  break;
8964  }
8965  }
8966  if (traceit&TRACE_CALL)
8967  Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
8968  res->rtyp=dA1[i].res;
8969  if ((call_failed=dA1[i].p(res,a)))
8970  {
8971  break;// leave loop, goto error handling
8972  }
8973  if (a->Next()!=NULL)
8974  {
8975  res->next=(leftv)omAllocBin(sleftv_bin);
8976  failed=iiExprArith1(res->next,a->next,op);
8977  }
8978  a->CleanUp();
8979  return failed;
8980  }
8981  i++;
8982  }
8983  // implicite type conversion --------------------------------------------
8984  if (dA1[i].cmd!=op)
8985  {
8987  i=0;
8988  //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
8989  while (dA1[i].cmd==op)
8990  {
8991  int ai;
8992  //Print("test %s\n",Tok2Cmdname(dA1[i].arg));
8993  if ((dA1[i].valid_for & NO_CONVERSION)==0)
8994  {
8995  if ((ai=iiTestConvert(at,dA1[i].arg,dConvertTypes))!=0)
8996  {
8997  if (currRing!=NULL)
8998  {
8999  if (check_valid(dA1[i].valid_for,op)) break;
9000  }
9001  else
9002  {
9003  if (RingDependend(dA1[i].res))
9004  {
9005  WerrorS("no ring active (6)");
9006  break;
9007  }
9008  }
9009  if (traceit&TRACE_CALL)
9010  Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(dA1[i].arg));
9011  res->rtyp=dA1[i].res;
9012  failed= ((iiConvert(at,dA1[i].arg,ai,a,an,dConvertTypes))
9013  || (call_failed=dA1[i].p(res,an)));
9014  // everything done, clean up temp. variables
9015  if (failed)
9016  {
9017  // leave loop, goto error handling
9018  break;
9019  }
9020  else
9021  {
9022  if (an->Next() != NULL)
9023  {
9024  res->next = (leftv)omAllocBin(sleftv_bin);
9025  failed=iiExprArith1(res->next,an->next,op);
9026  }
9027  // everything ok, clean up and return
9028  an->CleanUp();
9030  return failed;
9031  }
9032  }
9033  }
9034  i++;
9035  }
9036  an->CleanUp();
9038  }
9039  // error handling
9040  if (!errorreported)
9041  {
9042  if ((at==0) && (a->Fullname()!=sNoName_fe))
9043  {
9044  Werror("`%s` is not defined",a->Fullname());
9045  }
9046  else
9047  {
9048  i=0;
9049  const char *s = iiTwoOps(op);
9050  Werror("%s(`%s`) failed"
9051  ,s,Tok2Cmdname(at));
9052  if ((!call_failed) && BVERBOSE(V_SHOW_USE))
9053  {
9054  while (dA1[i].cmd==op)
9055  {
9056  if ((dA1[i].res!=0)
9057  && (dA1[i].p!=jjWRONG))
9058  Werror("expected %s(`%s`)"
9059  ,s,Tok2Cmdname(dA1[i].arg));
9060  i++;
9061  }
9062  }
9063  }
9064  }
9065  res->rtyp = UNKNOWN;
9066  }
9067  a->CleanUp();
9068  return TRUE;
9069 }
const char * Fullname()
Definition: subexpr.h:125
leftv Next()
Definition: subexpr.h:136
const char sNoName_fe[]
Definition: fevoices.cc:55
const char * iiTwoOps(int t)
Definition: gentable.cc:261
static BOOLEAN jjWRONG(leftv, leftv)
Definition: iparith.cc:3672
const char * Tok2Cmdname(int tok)
Definition: iparith.cc:9604
#define NO_CONVERSION
Definition: iparith.cc:120
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:9070
static BOOLEAN check_valid(const int p, const int op)
Definition: iparith.cc:9884
VAR int iiOp
Definition: iparith.cc:220
const struct sConvertTypes dConvertTypes[]
Definition: table.h:1280
short res
Definition: gentable.cc:82
#define V_SHOW_USE
Definition: options.h:51
#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 8867 of file iparith.cc.

8871 {
8872  res->Init();
8873  leftv b=a->next;
8874  a->next=NULL;
8875  int bt=b->Typ();
8876  BOOLEAN bo=iiExprArith2TabIntern(res,a,op,b,TRUE,dA2,at,bt,dConvertTypes);
8877  a->next=b;
8878  a->CleanUp(); // to clean up the chain, content already done in iiExprArith2TabIntern
8879  return bo;
8880 }
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:8708

◆ iiExprArith3()

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

Definition at line 9280 of file iparith.cc.

9281 {
9282  res->Init();
9283 
9284  if (!errorreported)
9285  {
9286 #ifdef SIQ
9287  if (siq>0)
9288  {
9289  //Print("siq:%d\n",siq);
9291  memcpy(&d->arg1,a,sizeof(sleftv));
9292  a->Init();
9293  memcpy(&d->arg2,b,sizeof(sleftv));
9294  b->Init();
9295  memcpy(&d->arg3,c,sizeof(sleftv));
9296  c->Init();
9297  d->op=op;
9298  d->argc=3;
9299  res->data=(char *)d;
9300  res->rtyp=COMMAND;
9301  return FALSE;
9302  }
9303 #endif
9304  int at=a->Typ();
9305  // handling bb-objects ----------------------------------------------
9306  if (at>MAX_TOK)
9307  {
9308  blackbox *bb=getBlackboxStuff(at);
9309  if (bb!=NULL)
9310  {
9311  if(!bb->blackbox_Op3(op,res,a,b,c)) return FALSE;
9312  // else: no op defined
9313  }
9314  else
9315  return TRUE;
9316  if (errorreported) return TRUE;
9317  }
9318  int bt=b->Typ();
9319  int ct=c->Typ();
9320 
9321  iiOp=op;
9322  int i=0;
9323  while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
9324  return iiExprArith3TabIntern(res,op,a,b,c,dArith3+i,at,bt,ct,dConvertTypes);
9325  }
9326  a->CleanUp();
9327  b->CleanUp();
9328  c->CleanUp();
9329  //Print("op: %d,result typ:%d\n",op,res->rtyp);
9330  return TRUE;
9331 }
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:9127
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 9332 of file iparith.cc.

9336 {
9337  res->Init();
9338  leftv b=a->next;
9339  a->next=NULL;
9340  int bt=b->Typ();
9341  leftv c=b->next;
9342  b->next=NULL;
9343  int ct=c->Typ();
9344  BOOLEAN bo=iiExprArith3TabIntern(res,op,a,b,c,dA3,at,bt,ct,dConvertTypes);
9345  b->next=c;
9346  a->next=b;
9347  a->CleanUp(); // to cleanup the chain, content already done
9348  return bo;
9349 }

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

1611 {
1612  int i;
1613  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1614  poly po=NULL;
1616  {
1617  scComputeHC(I,currRing->qideal,ak,po);
1618  if (po!=NULL)
1619  {
1620  pGetCoeff(po)=nInit(1);
1621  for (i=rVar(currRing); i>0; i--)
1622  {
1623  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1624  }
1625  pSetComp(po,ak);
1626  pSetm(po);
1627  }
1628  }
1629  else
1630  po=pOne();
1631  return po;
1632 }
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge, ring tailRing)
Definition: hdegree.cc:1079
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 1469 of file ipshell.cc.

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

◆ 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:47
#define V_LOAD_LIB
Definition: options.h:46

◆ 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
static BOOLEAN length(leftv result, leftv arg)
Definition: interval.cc:257
if(yy_init)
Definition: libparse.cc:1420
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:49

◆ 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:488
static void p_Setm(poly p, const ring r)
Definition: p_polys.h:233
static void p_Delete(poly *p, const ring r)
Definition: p_polys.h:901
static poly p_Copy(poly p, const ring r)
returns a copy of p
Definition: p_polys.h:846
static long p_Totaldegree(poly p, const ring r)
Definition: p_polys.h:1507
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 1380 of file ipshell.cc.

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

◆ 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:135
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 6595 of file ipshell.cc.

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

◆ iiTestAssume()

BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6447 of file ipshell.cc.

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

◆ iiTokType()

int iiTokType ( int  op)

Definition at line 235 of file iparith.cc.

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

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

9481 {
9482  int i;
9483  int an=1;
9484  int en=sArithBase.nLastIdentifier;
9485 
9486  loop
9487  //for(an=0; an<sArithBase.nCmdUsed; )
9488  {
9489  if(an>=en-1)
9490  {
9491  if (strcmp(n, sArithBase.sCmds[an].name) == 0)
9492  {
9493  i=an;
9494  break;
9495  }
9496  else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
9497  {
9498  i=en;
9499  break;
9500  }
9501  else
9502  {
9503  // -- blackbox extensions:
9504  // return 0;
9505  return blackboxIsCmd(n,tok);
9506  }
9507  }
9508  i=(an+en)/2;
9509  if (*n < *(sArithBase.sCmds[i].name))
9510  {
9511  en=i-1;
9512  }
9513  else if (*n > *(sArithBase.sCmds[i].name))
9514  {
9515  an=i+1;
9516  }
9517  else
9518  {
9519  int v=strcmp(n,sArithBase.sCmds[i].name);
9520  if(v<0)
9521  {
9522  en=i-1;
9523  }
9524  else if(v>0)
9525  {
9526  an=i+1;
9527  }
9528  else /*v==0*/
9529  {
9530  break;
9531  }
9532  }
9533  }
9535  tok=sArithBase.sCmds[i].tokval;
9536  if(sArithBase.sCmds[i].alias==2)
9537  {
9538  Warn("outdated identifier `%s` used - please change your code",
9539  sArithBase.sCmds[i].name);
9540  sArithBase.sCmds[i].alias=1;
9541  }
9542  #if 0
9543  if (currRingHdl==NULL)
9544  {
9545  #ifdef SIQ
9546  if (siq<=0)
9547  {
9548  #endif
9549  if ((tok>=BEGIN_RING) && (tok<=END_RING))
9550  {
9551  WerrorS("no ring active");
9552  return 0;
9553  }
9554  #ifdef SIQ
9555  }
9556  #endif
9557  }
9558  #endif
9559  if (!expected_parms)
9560  {
9561  switch (tok)
9562  {
9563  case IDEAL_CMD:
9564  case INT_CMD:
9565  case INTVEC_CMD:
9566  case MAP_CMD:
9567  case MATRIX_CMD:
9568  case MODUL_CMD:
9569  case POLY_CMD:
9570  case PROC_CMD:
9571  case RING_CMD:
9572  case STRING_CMD:
9573  cmdtok = tok;
9574  break;
9575  }
9576  }
9577  return sArithBase.sCmds[i].toktype;
9578 }
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:191
EXTERN_VAR BOOLEAN expected_parms
Definition: iparith.cc:216
EXTERN_VAR int cmdtok
Definition: iparith.cc:215
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 3350 of file ipshell.cc.

3351 {
3352  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3353  return (res->data==NULL);
3354 }
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:407
#define assume(x)
Definition: mod2.h:387
ip_package * package
Definition: structs.h:43

◆ jjLIST_PL()

BOOLEAN jjLIST_PL ( leftv  res,
leftv  v 
)

Definition at line 7955 of file iparith.cc.

7956 {
7957  int sl=0;
7958  if (v!=NULL) sl = v->listLength();
7959  lists L;
7960  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7961  {
7962  int add_row_shift = 0;
7963  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7964  if (weights!=NULL) add_row_shift=weights->min_in();
7965  L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7966  }
7967  else
7968  {
7970  leftv h=NULL;
7971  int i;
7972  int rt;
7973 
7974  L->Init(sl);
7975  for (i=0;i<sl;i++)
7976  {
7977  if (h!=NULL)
7978  { /* e.g. not in the first step:
7979  * h is the pointer to the old sleftv,
7980  * v is the pointer to the next sleftv
7981  * (in this moment) */
7982  h->next=v;
7983  }
7984  h=v;
7985  v=v->next;
7986  h->next=NULL;
7987  rt=h->Typ();
7988  if (rt==0)
7989  {
7990  L->Clean();
7991  Werror("`%s` is undefined",h->Fullname());
7992  return TRUE;
7993  }
7994  if (rt==RING_CMD)
7995  {
7996  L->m[i].rtyp=rt;
7997  L->m[i].data=rIncRefCnt(((ring)h->Data()));
7998  }
7999  else
8000  L->m[i].Copy(h);
8001  }
8002  }
8003  res->data=(char *)L;
8004  return FALSE;
8005 }
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:3187
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 5477 of file iparith.cc.

5478 {
5479  char libnamebuf[1024];
5481 
5482 #ifdef HAVE_DYNAMIC_LOADING
5483  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5484 #endif /* HAVE_DYNAMIC_LOADING */
5485  switch(LT)
5486  {
5487  default:
5488  case LT_NONE:
5489  Werror("%s: unknown type", s);
5490  break;
5491  case LT_NOTFOUND:
5492  Werror("cannot open %s", s);
5493  break;
5494 
5495  case LT_SINGULAR:
5496  {
5497  char *plib = iiConvName(s);
5498  idhdl pl = IDROOT->get_level(plib,0);
5499  if (pl==NULL)
5500  {
5501  pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5502  IDPACKAGE(pl)->language = LANG_SINGULAR;
5503  IDPACKAGE(pl)->libname=omStrDup(s);
5504  }
5505  else if (IDTYP(pl)!=PACKAGE_CMD)
5506  {
5507  Werror("can not create package `%s`",plib);
5508  omFreeBinAddr(plib);
5509  return TRUE;
5510  }
5511  else /* package */
5512  {
5513  package pa=IDPACKAGE(pl);
5514  if ((pa->language==LANG_C)
5515  || (pa->language==LANG_MIX))
5516  {
5517  Werror("can not create package `%s` - binaries exists",plib);
5518  omFreeBinAddr(plib);
5519  return TRUE;
5520  }
5521  }
5522  omFreeBinAddr(plib);
5523  package savepack=currPack;
5524  currPack=IDPACKAGE(pl);
5525  IDPACKAGE(pl)->loaded=TRUE;
5526  char libnamebuf[1024];
5527  FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5528  BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5529  currPack=savepack;
5530  IDPACKAGE(pl)->loaded=(!bo);
5531  return bo;
5532  }
5533  case LT_BUILTIN:
5534  SModulFunc_t iiGetBuiltinModInit(const char*);
5535  return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5536  case LT_MACH_O:
5537  case LT_ELF:
5538  case LT_HPUX:
5539 #ifdef HAVE_DYNAMIC_LOADING
5540  return load_modules(s, libnamebuf, autoexport);
5541 #else /* HAVE_DYNAMIC_LOADING */
5542  WerrorS("Dynamic modules are not supported by this version of Singular");
5543  break;
5544 #endif /* HAVE_DYNAMIC_LOADING */
5545  }
5546  return TRUE;
5547 }
BOOLEAN pa(leftv res, leftv args)
Definition: cohomo.cc:4344
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 5553 of file iparith.cc.

5554 {
5555  if (!iiGetLibStatus(s))
5556  {
5557  void (*WerrorS_save)(const char *s) = WerrorS_callback;
5560  BOOLEAN bo=jjLOAD(s,TRUE);
5561  if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
5562  Print("loading of >%s< failed\n",s);
5563  WerrorS_callback=WerrorS_save;
5564  errorreported=0;
5565  }
5566  return FALSE;
5567 }
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:5477
STATIC_VAR int WerrorS_dummy_cnt
Definition: iparith.cc:5548
static void WerrorS_dummy(const char *)
Definition: iparith.cc:5549
BOOLEAN iiGetLibStatus(const char *lib)
Definition: iplib.cc:77
#define TEST_OPT_PROT
Definition: options.h:103

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

3344 {
3345  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3346  (poly)w->CopyD(), currRing);
3347  return errorreported;
3348 }
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:354
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:2011
@ 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 229 of file extra.cc.

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

6313 {
6314  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6315  ideal I=(ideal)u->Data();
6316  int i;
6317  int n=0;
6318  for(i=I->nrows*I->ncols-1;i>=0;i--)
6319  {
6320  int n0=pGetVariables(I->m[i],e);
6321  if (n0>n) n=n0;
6322  }
6323  jjINT_S_TO_ID(n,e,res);
6324  return FALSE;
6325 }
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6282
#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 6304 of file ipshell.cc.

6305 {
6306  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6307  int n=pGetVariables((poly)u->Data(),e);
6308  jjINT_S_TO_ID(n,e,res);
6309  return FALSE;
6310 }

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

3327 {
3328  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3329  if (res->data==NULL)
3330  res->data=(char *)new intvec(rVar(currRing));
3331  return FALSE;
3332 }
intvec * id_QHomWeight(ideal id, const ring r)

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3304 of file ipshell.cc.

3305 {
3306  ideal F=(ideal)id->Data();
3307  intvec * iv = new intvec(rVar(currRing));
3308  polyset s;
3309  int sl, n, i;
3310  int *x;
3311 
3312  res->data=(char *)iv;
3313  s = F->m;
3314  sl = IDELEMS(F) - 1;
3315  n = rVar(currRing);
3316  double wNsqr = (double)2.0 / (double)n;
3318  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3319  wCall(s, sl, x, wNsqr, currRing);
3320  for (i = n; i!=0; i--)
3321  (*iv)[i-1] = x[i + n + 1];
3322  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3323  return FALSE;
3324 }
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 4566 of file ipshell.cc.

4567 {
4568  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4569  return FALSE;
4570 }
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 4572 of file ipshell.cc.

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

3075 {
3076  int i,j;
3077  matrix result;
3078  ideal id=(ideal)a->Data();
3079 
3080  result =mpNew(IDELEMS(id),rVar(currRing));
3081  for (i=1; i<=IDELEMS(id); i++)
3082  {
3083  for (j=1; j<=rVar(currRing); j++)
3084  {
3085  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
3086  }
3087  }
3088  res->data=(char *)result;
3089  return FALSE;
3090 }
#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 3096 of file ipshell.cc.

3097 {
3098  int n=(int)(long)b->Data();
3099  int d=(int)(long)c->Data();
3100  int k,l,sign,row,col;
3101  matrix result;
3102  ideal temp;
3103  BOOLEAN bo;
3104  poly p;
3105 
3106  if ((d>n) || (d<1) || (n<1))
3107  {
3108  res->data=(char *)mpNew(1,1);
3109  return FALSE;
3110  }
3111  int *choise = (int*)omAlloc(d*sizeof(int));
3112  if (id==NULL)
3113  temp=idMaxIdeal(1);
3114  else
3115  temp=(ideal)id->Data();
3116 
3117  k = binom(n,d);
3118  l = k*d;
3119  l /= n-d+1;
3120  result =mpNew(l,k);
3121  col = 1;
3122  idInitChoise(d,1,n,&bo,choise);
3123  while (!bo)
3124  {
3125  sign = 1;
3126  for (l=1;l<=d;l++)
3127  {
3128  if (choise[l-1]<=IDELEMS(temp))
3129  {
3130  p = pCopy(temp->m[choise[l-1]-1]);
3131  if (sign == -1) p = pNeg(p);
3132  sign *= -1;
3133  row = idGetNumberOfChoise(l-1,d,1,n,choise);
3134  MATELEM(result,row,col) = p;
3135  }
3136  }
3137  col++;
3138  idGetNextChoise(d,n,&bo,choise);
3139  }
3140  omFreeSize(choise,d*sizeof(int));
3141  if (id==NULL) idDelete(&temp);
3142 
3143  res->data=(char *)result;
3144  return FALSE;
3145 }
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 4681 of file ipshell.cc.

4682 {
4683  poly gls;
4684  gls= (poly)(arg1->Data());
4685  int howclean= (int)(long)arg3->Data();
4686 
4687  if ( gls == NULL || pIsConstant( gls ) )
4688  {
4689  WerrorS("Input polynomial is constant!");
4690  return TRUE;
4691  }
4692 
4693  if (rField_is_Zp(currRing))
4694  {
4695  int* r=Zp_roots(gls, currRing);
4696  lists rlist;
4697  rlist= (lists)omAlloc( sizeof(slists) );
4698  rlist->Init( r[0] );
4699  for(int i=r[0];i>0;i--)
4700  {
4701  rlist->m[i-1].data=n_Init(r[i],currRing->cf);
4702  rlist->m[i-1].rtyp=NUMBER_CMD;
4703  }
4704  omFree(r);
4705  res->data=rlist;
4706  res->rtyp= LIST_CMD;
4707  return FALSE;
4708  }
4709  if ( !(rField_is_R(currRing) ||
4710  rField_is_Q(currRing) ||
4713  {
4714  WerrorS("Ground field not implemented!");
4715  return TRUE;
4716  }
4717 
4720  {
4721  unsigned long int ii = (unsigned long int)arg2->Data();
4722  setGMPFloatDigits( ii, ii );
4723  }
4724 
4725  int ldummy;
4726  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4727  int i,vpos=0;
4728  poly piter;
4729  lists elist;
4730 
4731  elist= (lists)omAlloc( sizeof(slists) );
4732  elist->Init( 0 );
4733 
4734  if ( rVar(currRing) > 1 )
4735  {
4736  piter= gls;
4737  for ( i= 1; i <= rVar(currRing); i++ )
4738  if ( pGetExp( piter, i ) )
4739  {
4740  vpos= i;
4741  break;
4742  }
4743  while ( piter )
4744  {
4745  for ( i= 1; i <= rVar(currRing); i++ )
4746  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4747  {
4748  WerrorS("The input polynomial must be univariate!");
4749  return TRUE;
4750  }
4751  pIter( piter );
4752  }
4753  }
4754 
4755  rootContainer * roots= new rootContainer();
4756  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4757  piter= gls;
4758  for ( i= deg; i >= 0; i-- )
4759  {
4760  if ( piter && pTotaldegree(piter) == i )
4761  {
4762  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4763  //nPrint( pcoeffs[i] );PrintS(" ");
4764  pIter( piter );
4765  }
4766  else
4767  {
4768  pcoeffs[i]= nInit(0);
4769  }
4770  }
4771 
4772 #ifdef mprDEBUG_PROT
4773  for (i=deg; i >= 0; i--)
4774  {
4775  nPrint( pcoeffs[i] );PrintS(" ");
4776  }
4777  PrintLn();
4778 #endif
4779 
4780  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4781  roots->solver( howclean );
4782 
4783  int elem= roots->getAnzRoots();
4784  char *dummy;
4785  int j;
4786 
4787  lists rlist;
4788  rlist= (lists)omAlloc( sizeof(slists) );
4789  rlist->Init( elem );
4790 
4792  {
4793  for ( j= 0; j < elem; j++ )
4794  {
4795  rlist->m[j].rtyp=NUMBER_CMD;
4796  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4797  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4798  }
4799  }
4800  else
4801  {
4802  for ( j= 0; j < elem; j++ )
4803  {
4804  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4805  rlist->m[j].rtyp=STRING_CMD;
4806  rlist->m[j].data=(void *)dummy;
4807  }
4808  }
4809 
4810  elist->Clean();
4811  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4812 
4813  // this is (via fillContainer) the same data as in root
4814  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4815  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4816 
4817  delete roots;
4818 
4819  res->data= (void*)rlist;
4820 
4821  return FALSE;
4822 }
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 4658 of file ipshell.cc.

4659 {
4660  ideal gls = (ideal)(arg1->Data());
4661  int imtype= (int)(long)arg2->Data();
4662 
4663  uResultant::resMatType mtype= determineMType( imtype );
4664 
4665  // check input ideal ( = polynomial system )
4666  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4667  {
4668  return TRUE;
4669  }
4670 
4671  uResultant *resMat= new uResultant( gls, mtype, false );
4672  if (resMat!=NULL)
4673  {
4674  res->rtyp = MODUL_CMD;
4675  res->data= (void*)resMat->accessResMat()->getMatrix();
4676  if (!errorreported) delete resMat;
4677  }
4678  return errorreported;
4679 }
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 4925 of file ipshell.cc.

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

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

6328 {
6329  Print(" %s (",n);
6330  switch (p->language)
6331  {
6332  case LANG_SINGULAR: PrintS("S"); break;
6333  case LANG_C: PrintS("C"); break;
6334  case LANG_TOP: PrintS("T"); break;
6335  case LANG_MAX: PrintS("M"); break;
6336  case LANG_NONE: PrintS("N"); break;
6337  default: PrintS("U");
6338  }
6339  if(p->libname!=NULL)
6340  Print(",%s", p->libname);
6341  PrintS(")");
6342 }
@ 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 2787 of file ipshell.cc.

2788 {
2789  if ((L->nr!=3)
2790 #ifdef HAVE_PLURAL
2791  &&(L->nr!=5)
2792 #endif
2793  )
2794  return NULL;
2795  int is_gf_char=0;
2796  // 0: char/ cf - ring
2797  // 1: list (var)
2798  // 2: list (ord)
2799  // 3: qideal
2800  // possibly:
2801  // 4: C
2802  // 5: D
2803 
2804  ring R = (ring) omAlloc0Bin(sip_sring_bin);
2805 
2806  // ------------------------------------------------------------------
2807  // 0: char:
2808  if (L->m[0].Typ()==CRING_CMD)
2809  {
2810  R->cf=(coeffs)L->m[0].Data();
2811  R->cf->ref++;
2812  }
2813  else if (L->m[0].Typ()==INT_CMD)
2814  {
2815  int ch = (int)(long)L->m[0].Data();
2816  assume( ch >= 0 );
2817 
2818  if (ch == 0) // Q?
2819  R->cf = nInitChar(n_Q, NULL);
2820  else
2821  {
2822  int l = IsPrime(ch); // Zp?
2823  if( l != ch )
2824  {
2825  Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
2826  ch = l;
2827  }
2828  #ifndef TEST_ZN_AS_ZP
2829  R->cf = nInitChar(n_Zp, (void*)(long)ch);
2830  #else
2831  mpz_t modBase;
2832  mpz_init_set_ui(modBase,(long) ch);
2833  ZnmInfo info;
2834  info.base= modBase;
2835  info.exp= 1;
2836  R->cf=nInitChar(n_Zn,(void*) &info); //exponent is missing
2837  R->cf->is_field=1;
2838  R->cf->is_domain=1;
2839  R->cf->has_simple_Inverse=1;
2840  #endif
2841  }
2842  }
2843  else if (L->m[0].Typ()==LIST_CMD) // something complicated...
2844  {
2845  lists LL=(lists)L->m[0].Data();
2846 
2847 #ifdef HAVE_RINGS
2848  if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
2849  {
2850  rComposeRing(LL, R); // Ring!?
2851  }
2852  else
2853 #endif
2854  if (LL->nr < 3)
2855  rComposeC(LL,R); // R, long_R, long_C
2856  else
2857  {
2858  if (LL->m[0].Typ()==INT_CMD)
2859  {
2860  int ch = (int)(long)LL->m[0].Data();
2861  while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
2862  if (fftable[is_gf_char]==0) is_gf_char=-1;
2863 
2864  if(is_gf_char!= -1)
2865  {
2866  GFInfo param;
2867 
2868  param.GFChar = ch;
2869  param.GFDegree = 1;
2870  param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
2871 
2872  // nfInitChar should be able to handle the case when ch is in fftables!
2873  R->cf = nInitChar(n_GF, (void*)&param);
2874  }
2875  }
2876 
2877  if( R->cf == NULL )
2878  {
2879  ring extRing = rCompose((lists)L->m[0].Data(),FALSE,0x7fff);
2880 
2881  if (extRing==NULL)
2882  {
2883  WerrorS("could not create the specified coefficient field");
2884  goto rCompose_err;
2885  }
2886 
2887  if( extRing->qideal != NULL ) // Algebraic extension
2888  {
2889  AlgExtInfo extParam;
2890 
2891  extParam.r = extRing;
2892 
2893  R->cf = nInitChar(n_algExt, (void*)&extParam);
2894  }
2895  else // Transcendental extension
2896  {
2897  TransExtInfo extParam;
2898  extParam.r = extRing;
2899  assume( extRing->qideal == NULL );
2900 
2901  R->cf = nInitChar(n_transExt, &extParam);
2902  }
2903  }
2904  }
2905  }
2906  else
2907  {
2908  WerrorS("coefficient field must be described by `int` or `list`");
2909  goto rCompose_err;
2910  }
2911 
2912  if( R->cf == NULL )
2913  {
2914  WerrorS("could not create coefficient field described by the input!");
2915  goto rCompose_err;
2916  }
2917 
2918  // ------------------------- VARS ---------------------------
2919  if (rComposeVar(L,R)) goto rCompose_err;
2920  // ------------------------ ORDER ------------------------------
2921  if (rComposeOrder(L,check_comp,R)) goto rCompose_err;
2922 
2923  // ------------------------ ??????? --------------------
2924 
2925  if (!isLetterplace) rRenameVars(R);
2926  #ifdef HAVE_SHIFTBBA
2927  else
2928  {
2929  R->isLPring=isLetterplace;
2930  R->ShortOut=FALSE;
2931  R->CanShortOut=FALSE;
2932  }
2933  #endif
2934  if ((bitmask!=0)&&(R->wanted_maxExp==0)) R->wanted_maxExp=bitmask;
2935  rComplete(R);
2936 
2937  // ------------------------ Q-IDEAL ------------------------
2938 
2939  if (L->m[3].Typ()==IDEAL_CMD)
2940  {
2941  ideal q=(ideal)L->m[3].Data();
2942  if (q->m[0]!=NULL)
2943  {
2944  if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
2945  {
2946  #if 0
2947  WerrorS("coefficient fields must be equal if q-ideal !=0");
2948  goto rCompose_err;
2949  #else
2950  ring orig_ring=currRing;
2951  rChangeCurrRing(R);
2952  int *perm=NULL;
2953  int *par_perm=NULL;
2954  int par_perm_size=0;
2955  nMapFunc nMap;
2956 
2957  if ((nMap=nSetMap(orig_ring->cf))==NULL)
2958  {
2959  if (rEqual(orig_ring,currRing))
2960  {
2961  nMap=n_SetMap(currRing->cf, currRing->cf);
2962  }
2963  else
2964  // Allow imap/fetch to be make an exception only for:
2965  if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2969  ||
2970  (rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
2971  (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
2972  rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
2973  {
2974  par_perm_size=rPar(orig_ring);
2975 
2976 // if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
2977 // naSetChar(rInternalChar(orig_ring),orig_ring);
2978 // else ntSetChar(rInternalChar(orig_ring),orig_ring);
2979 
2980  nSetChar(currRing->cf);
2981  }
2982  else
2983  {
2984  WerrorS("coefficient fields must be equal if q-ideal !=0");
2985  goto rCompose_err;
2986  }
2987  }
2988  perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
2989  if (par_perm_size!=0)
2990  par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2991  int i;
2992  #if 0
2993  // use imap:
2994  maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
2995  currRing->names,currRing->N,currRing->parameter, currRing->P,
2996  perm,par_perm, currRing->ch);
2997  #else
2998  // use fetch
2999  if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
3000  {
3001  for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
3002  }
3003  else if (par_perm_size!=0)
3004  for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
3005  for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
3006  #endif
3007  ideal dest_id=idInit(IDELEMS(q),1);
3008  for(i=IDELEMS(q)-1; i>=0; i--)
3009  {
3010  dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
3011  par_perm,par_perm_size);
3012  // PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
3013  pTest(dest_id->m[i]);
3014  }
3015  R->qideal=dest_id;
3016  if (perm!=NULL)
3017  omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
3018  if (par_perm!=NULL)
3019  omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
3020  rChangeCurrRing(orig_ring);
3021  #endif
3022  }
3023  else
3024  R->qideal=idrCopyR(q,currRing,R);
3025  }
3026  }
3027  else
3028  {
3029  WerrorS("q-ideal must be given as `ideal`");
3030  goto rCompose_err;
3031  }
3032 
3033 
3034  // ---------------------------------------------------------------
3035  #ifdef HAVE_PLURAL
3036  if (L->nr==5)
3037  {
3038  if (nc_CallPlural((matrix)L->m[4].Data(),
3039  (matrix)L->m[5].Data(),
3040  NULL,NULL,
3041  R,
3042  true, // !!!
3043  true, false,
3044  currRing, FALSE)) goto rCompose_err;
3045  // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
3046  }
3047  #endif
3048  return R;
3049 
3050 rCompose_err:
3051  if (R->N>0)
3052  {
3053  int i;
3054  if (R->names!=NULL)
3055  {
3056  i=R->N-1;
3057  while (i>=0) { omfree(R->names[i]); i--; }
3058  omFree(R->names);
3059  }
3060  }
3061  omfree(R->order);
3062  omfree(R->block0);
3063  omfree(R->block1);
3064  omfree(R->wvhdl);
3065  omFree(R);
3066  return NULL;
3067 }
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:2409
void rComposeC(lists L, ring R)
Definition: ipshell.cc:2264
static BOOLEAN rComposeOrder(const lists L, const BOOLEAN check_comp, ring R)
Definition: ipshell.cc:2495
ring rCompose(const lists L, const BOOLEAN check_comp, const long bitmask, const int isLetterplace)
Definition: ipshell.cc:2787
void rComposeRing(lists L, ring R)
Definition: ipshell.cc:2316
static BOOLEAN rComposeVar(const lists L, ring R)
Definition: ipshell.cc:2450
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:4195
#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 2165 of file ipshell.cc.

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

1954 {
1955  assume( C != NULL );
1956 
1957  // sanity check: require currRing==r for rings with polynomial data
1958  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1959  {
1960  WerrorS("ring with polynomial data must be the base ring or compatible");
1961  return TRUE;
1962  }
1963  if (nCoeff_is_numeric(C))
1964  {
1965  rDecomposeC_41(res,C);
1966  }
1967 #ifdef HAVE_RINGS
1968  else if (nCoeff_is_Ring(C))
1969  {
1971  }
1972 #endif
1973  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1974  {
1975  rDecomposeCF(res, C->extRing, currRing);
1976  }
1977  else if(nCoeff_is_GF(C))
1978  {
1980  Lc->Init(4);
1981  // char:
1982  Lc->m[0].rtyp=INT_CMD;
1983  Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1984  // var:
1986  Lv->Init(1);
1987  Lv->m[0].rtyp=STRING_CMD;
1988  Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1989  Lc->m[1].rtyp=LIST_CMD;
1990  Lc->m[1].data=(void*)Lv;
1991  // ord:
1993  Lo->Init(1);
1995  Loo->Init(2);
1996  Loo->m[0].rtyp=STRING_CMD;
1997  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1998 
1999  intvec *iv=new intvec(1); (*iv)[0]=1;
2000  Loo->m[1].rtyp=INTVEC_CMD;
2001  Loo->m[1].data=(void *)iv;
2002 
2003  Lo->m[0].rtyp=LIST_CMD;
2004  Lo->m[0].data=(void*)Loo;
2005 
2006  Lc->m[2].rtyp=LIST_CMD;
2007  Lc->m[2].data=(void*)Lo;
2008  // q-ideal:
2009  Lc->m[3].rtyp=IDEAL_CMD;
2010  Lc->m[3].data=(void *)idInit(1,1);
2011  // ----------------------
2012  res->rtyp=LIST_CMD;
2013  res->data=(void*)Lc;
2014  }
2015  else
2016  {
2017  res->rtyp=INT_CMD;
2018  res->data=(void *)(long)C->ch;
2019  }
2020  // ----------------------------------------
2021  return FALSE;
2022 }
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:1823
void rDecomposeRing_41(leftv h, const coeffs C)
Definition: ipshell.cc:1893

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 2126 of file ipshell.cc.

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

◆ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1648 of file ipshell.cc.

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

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

◆ rInit()

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

Definition at line 5628 of file ipshell.cc.

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

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

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

5130 {
5131  ring rg = NULL;
5132  if (h!=NULL)
5133  {
5134 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5135  rg = IDRING(h);
5136  if (rg==NULL) return; //id <>NULL, ring==NULL
5137  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5138  if (IDID(h)) // OB: ????
5140  rTest(rg);
5141  }
5142  else return;
5143 
5144  // clean up history
5145  if (currRing!=NULL)
5146  {
5148  {
5150  }
5151 
5152  if (rg!=currRing)/*&&(currRing!=NULL)*/
5153  {
5154  if (rg->cf!=currRing->cf)
5155  {
5157  if (DENOMINATOR_LIST!=NULL)
5158  {
5159  if (TEST_V_ALLWARN)
5160  Warn("deleting denom_list for ring change to %s",IDID(h));
5161  do
5162  {
5163  n_Delete(&(dd->n),currRing->cf);
5164  dd=dd->next;
5166  DENOMINATOR_LIST=dd;
5167  } while(DENOMINATOR_LIST!=NULL);
5168  }
5169  }
5170  }
5171  }
5172 
5173  // test for valid "currRing":
5174  if ((rg!=NULL) && (rg->idroot==NULL))
5175  {
5176  ring old=rg;
5177  rg=rAssure_HasComp(rg);
5178  if (old!=rg)
5179  {
5180  rKill(old);
5181  IDRING(h)=rg;
5182  }
5183  }
5184  /*------------ change the global ring -----------------------*/
5185  rChangeCurrRing(rg);
5186  currRingHdl = h;
5187 }
#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.

1104 {
1105  int i;
1106  indset save;
1108 
1109  hexist = hInit(S, Q, &hNexist, currRing);
1110  if (hNexist == 0)
1111  {
1112  intvec *iv=new intvec(rVar(currRing));
1113  for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1114  res->Init(1);
1115  res->m[0].rtyp=INTVEC_CMD;
1116  res->m[0].data=(intvec*)iv;
1117  return res;
1118  }
1119  else if (hisModule!=0)
1120  {
1121  res->Init(0);
1122  return res;
1123  }
1124  save = ISet = (indset)omAlloc0Bin(indlist_bin);
1125  hMu = 0;
1126  hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1127  hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1128  hpure = (scmon)omAlloc0((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1129  hrad = hexist;
1130  hNrad = hNexist;
1131  radmem = hCreate(rVar(currRing) - 1);
1132  hCo = rVar(currRing) + 1;
1133  hNvar = rVar(currRing);
1134  hRadical(hrad, &hNrad, hNvar);
1135  hSupp(hrad, hNrad, hvar, &hNvar);
1136  if (hNvar)
1137  {
1138  hCo = hNvar;
1139  hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1140  hLexR(hrad, hNrad, hvar, hNvar);
1142  }
1143  if (hCo && (hCo < rVar(currRing)))
1144  {
1146  }
1147  if (hMu!=0)
1148  {
1149  ISet = save;
1150  hMu2 = 0;
1151  if (all && (hCo+1 < rVar(currRing)))
1152  {
1155  i=hMu+hMu2;
1156  res->Init(i);
1157  if (hMu2 == 0)
1158  {
1160  }
1161  }
1162  else
1163  {
1164  res->Init(hMu);
1165  }
1166  for (i=0;i<hMu;i++)
1167  {
1168  res->m[i].data = (void *)save->set;
1169  res->m[i].rtyp = INTVEC_CMD;
1170  ISet = save;
1171  save = save->nx;
1173  }
1174  omFreeBin((ADDRESS)save, indlist_bin);
1175  if (hMu2 != 0)
1176  {
1177  save = JSet;
1178  for (i=hMu;i<hMu+hMu2;i++)
1179  {
1180  res->m[i].data = (void *)save->set;
1181  res->m[i].rtyp = INTVEC_CMD;
1182  JSet = save;
1183  save = save->nx;
1185  }
1186  omFreeBin((ADDRESS)save, indlist_bin);
1187  }
1188  }
1189  else
1190  {
1191  res->Init(0);
1193  }
1194  hKill(radmem, rVar(currRing) - 1);
1195  omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1196  omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1197  omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1199  return res;
1200 }
void hIndMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:386
VAR int hMu
Definition: hdegree.cc:27
VAR omBin indlist_bin
Definition: hdegree.cc:28
VAR int hMu2
Definition: hdegree.cc:27
VAR int hCo
Definition: hdegree.cc:27
VAR indset ISet
Definition: hdegree.cc:352
VAR indset JSet
Definition: hdegree.cc:352
void hDimSolve(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:34
void hIndAllMult(scmon pure, int Npure, scfmon rad, int Nrad, varset var, int Nvar)
Definition: hdegree.cc:569
monf hCreate(int Nvar)
Definition: hutil.cc:999
scfmon hInit(ideal S, ideal Q, int *Nexist, ring tailRing)
Definition: hutil.cc:31
VAR varset hvar
Definition: hutil.cc:18
void hKill(monf xmem, int Nvar)
Definition: hutil.cc:1013
VAR int hNexist
Definition: hutil.cc:19
void hDelete(scfmon ev, int ev_length)
Definition: hutil.cc:143
void hPure(scfmon stc, int a, int *Nstc, varset var, int Nvar, scmon pure, int *Npure)
Definition: hutil.cc:624
VAR scfmon hwork
Definition: hutil.cc:16
void hSupp(scfmon stc, int Nstc, varset var, int *Nvar)
Definition: hutil.cc:177
void hLexR(scfmon rad, int Nrad, varset var, int Nvar)
Definition: hutil.cc:568
VAR scmon hpure
Definition: hutil.cc:17
VAR scfmon hrad
Definition: hutil.cc:16
VAR int hisModule
Definition: hutil.cc:20
VAR monf radmem
Definition: hutil.cc:21
VAR int hNpure
Definition: hutil.cc:19
VAR int hNrad
Definition: hutil.cc:19
VAR scfmon hexist
Definition: hutil.cc:16
void hRadical(scfmon rad, int *Nrad, int Nvar)
Definition: hutil.cc:414
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 4554 of file ipshell.cc.

4555 {
4556  sleftv tmp;
4557  tmp.Init();
4558  tmp.rtyp=INT_CMD;
4559  /* tmp.data = (void *)0; -- done by Init */
4560 
4561  return semicProc3(res,u,v,&tmp);
4562 }

◆ semicProc3()

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

Definition at line 4514 of file ipshell.cc.

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

◆ 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:92
#define TEST_OPT_INTSTRATEGY
Definition: options.h:110
#define V_SHOW_MEM
Definition: options.h:42
#define V_YACC
Definition: options.h:43
#define OPT_REDTHROUGH
Definition: options.h:82
#define TEST_RINGDEP_OPTS
Definition: options.h:100
#define OPT_OLDSTD
Definition: options.h:86
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:113
#define SEEK_END
Definition: mod2.h:109
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 4431 of file ipshell.cc.

4432 {
4433  semicState state;
4434 
4435  // -----------------
4436  // check arguments
4437  // -----------------
4438 
4439  lists l1 = (lists)first->Data( );
4440  lists l2 = (lists)second->Data( );
4441 
4442  if( (state=list_is_spectrum( l1 )) != semicOK )
4443  {
4444  WerrorS( "first argument is not a spectrum:" );
4445  list_error( state );
4446  }
4447  else if( (state=list_is_spectrum( l2 )) != semicOK )
4448  {
4449  WerrorS( "second argument is not a spectrum:" );
4450  list_error( state );
4451  }
4452  else
4453  {
4454  spectrum s1= spectrumFromList ( l1 );
4455  spectrum s2= spectrumFromList ( l2 );
4456  spectrum sum( s1+s2 );
4457 
4458  result->rtyp = LIST_CMD;
4459  result->data = (char*)(getList(sum));
4460  }
4461 
4462  return (state!=semicOK);
4463 }
lists getList(spectrum &spec)
Definition: ipshell.cc:3399

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv  result,
leftv  first 
)

Definition at line 4187 of file ipshell.cc.

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

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4136 of file ipshell.cc.

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

◆ spmulProc()

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

Definition at line 4473 of file ipshell.cc.

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

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3175 of file ipshell.cc.

3176 {
3177  sleftv tmp;
3178  tmp.Init();
3179  tmp.rtyp=INT_CMD;
3180  tmp.data=(void *)1;
3181  return syBetti2(res,u,&tmp);
3182 }
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3152

◆ syBetti2()

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

Definition at line 3152 of file ipshell.cc.

3153 {
3154  syStrategy syzstr=(syStrategy)u->Data();
3155 
3156  BOOLEAN minim=(int)(long)w->Data();
3157  int row_shift=0;
3158  int add_row_shift=0;
3159  intvec *weights=NULL;
3160  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3161  if (ww!=NULL)
3162  {
3163  weights=ivCopy(ww);
3164  add_row_shift = ww->min_in();
3165  (*weights) -= add_row_shift;
3166  }
3167 
3168  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3169  //row_shift += add_row_shift;
3170  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3171  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3172 
3173  return FALSE;
3174 }
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 3259 of file ipshell.cc.

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

◆ syConvRes()

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

Definition at line 3187 of file ipshell.cc.

3188 {
3189  resolvente fullres = syzstr->fullres;
3190  resolvente minres = syzstr->minres;
3191 
3192  const int length = syzstr->length;
3193 
3194  if ((fullres==NULL) && (minres==NULL))
3195  {
3196  if (syzstr->hilb_coeffs==NULL)
3197  { // La Scala
3198  fullres = syReorder(syzstr->res, length, syzstr);
3199  }
3200  else
3201  { // HRES
3202  minres = syReorder(syzstr->orderedRes, length, syzstr);
3203  syKillEmptyEntres(minres, length);
3204  }
3205  }
3206 
3207  resolvente tr;
3208  int typ0=IDEAL_CMD;
3209 
3210  if (minres!=NULL)
3211  tr = minres;
3212  else
3213  tr = fullres;
3214 
3215  resolvente trueres=NULL;
3216  intvec ** w=NULL;
3217 
3218  if (length>0)
3219  {
3220  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3221  for (int i=length-1;i>=0;i--)
3222  {
3223  if (tr[i]!=NULL)
3224  {
3225  trueres[i] = idCopy(tr[i]);
3226  }
3227  }
3228  if ( id_RankFreeModule(trueres[0], currRing) > 0)
3229  typ0 = MODUL_CMD;
3230  if (syzstr->weights!=NULL)
3231  {
3232  w = (intvec**)omAlloc0(length*sizeof(intvec*));
3233  for (int i=length-1;i>=0;i--)
3234  {
3235  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3236  }
3237  }
3238  }
3239 
3240  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3241  w, add_row_shift);
3242 
3243  if (toDel)
3244  syKillComputation(syzstr);
3245  else
3246  {
3247  if( fullres != NULL && syzstr->fullres == NULL )
3248  syzstr->fullres = fullres;
3249 
3250  if( minres != NULL && syzstr->minres == NULL )
3251  syzstr->minres = minres;
3252  }
3253  return li;
3254 }
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 3288 of file ipshell.cc.

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

◆ 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:989

◆ 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:178
#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.