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

551 {
552  int rc = 0;
553  while (v!=NULL)
554  {
555  switch (v->Typ())
556  {
557  case INT_CMD:
558  case POLY_CMD:
559  case VECTOR_CMD:
560  case NUMBER_CMD:
561  rc++;
562  break;
563  case INTVEC_CMD:
564  case INTMAT_CMD:
565  rc += ((intvec *)(v->Data()))->length();
566  break;
567  case MATRIX_CMD:
568  case IDEAL_CMD:
569  case MODUL_CMD:
570  {
571  matrix mm = (matrix)(v->Data());
572  rc += mm->rows() * mm->cols();
573  }
574  break;
575  case LIST_CMD:
576  rc+=((lists)v->Data())->nr+1;
577  break;
578  default:
579  rc++;
580  }
581  v = v->next;
582  }
583  return rc;
584 }
Variable next() const
Definition: factory.h:153
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 697 of file iplib.cc.

698 {
699  idhdl h=ggetid(n);
700  if ((h==NULL)
701  || (IDTYP(h)!=PROC_CMD))
702  {
703  err=2;
704  return NULL;
705  }
706  // ring handling
707  idhdl save_ringhdl=currRingHdl;
708  ring save_ring=currRing;
711  // argument:
712  if (arg_types[0]!=0)
713  {
714  sleftv tmp;
715  leftv tt=&tmp;
716  int i=1;
717  tmp.Init();
718  tmp.data=args[0];
719  tmp.rtyp=arg_types[0];
720  while(arg_types[i]!=0)
721  {
723  tt=tt->next;
724  tt->rtyp=arg_types[i];
725  tt->data=args[i];
726  i++;
727  }
728  // call proc
729  err=iiMake_proc(h,currPack,&tmp);
730  }
731  else
732  // call proc
733  err=iiMake_proc(h,currPack,NULL);
734  // clean up ring
735  iiCallLibProcEnd(save_ringhdl,save_ring);
736  // return
737  if (err==FALSE)
738  {
740  memcpy(h,&iiRETURNEXPR,sizeof(sleftv));
741  iiRETURNEXPR.Init();
742  return h;
743  }
744  return NULL;
745 }
#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:571
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:602
BOOLEAN iiMake_proc(idhdl pn, package pack, leftv args)
Definition: iplib.cc:500
INST_VAR sleftv iiRETURNEXPR
Definition: iplib.cc:470
static void iiCallLibProcBegin()
Definition: iplib.cc:585
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:62

◆ ii_CallProcId2Id()

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

Definition at line 657 of file iplib.cc.

658 {
659  char *plib = iiConvName(lib);
660  idhdl h=ggetid(plib);
661  omFree(plib);
662  if (h==NULL)
663  {
664  BOOLEAN bo=iiLibCmd(lib,TRUE,TRUE,FALSE);
665  if (bo) return NULL;
666  }
667  ring oldR=currRing;
669  BOOLEAN err;
670  ideal I=(ideal)iiCallLibProc1(proc,idCopy(arg),IDEAL_CMD,err);
671  rChangeCurrRing(oldR);
672  if (err) return NULL;
673  return I;
674 }
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:623
char * iiConvName(const char *libname)
Definition: iplib.cc:1429
BOOLEAN iiLibCmd(const char *newlib, BOOLEAN autoexport, BOOLEAN tellerror, BOOLEAN force)
Definition: iplib.cc:880
#define omFree(addr)
Definition: omAllocDecl.h:261

◆ ii_CallProcId2Int()

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

Definition at line 676 of file iplib.cc.

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

◆ iiAddCproc()

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

Definition at line 1059 of file iplib.cc.

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

837 {
838  if (iiCurrArgs==NULL)
839  {
840  Werror("not enough arguments for proc %s",VoiceName());
841  p->CleanUp();
842  return TRUE;
843  }
845  iiCurrArgs=h->next;
846  h->next=NULL;
847  if (h->rtyp!=IDHDL)
848  {
850  h->CleanUp();
852  return res;
853  }
854  if ((h->Typ()!=p->Typ()) &&(p->Typ()!=DEF_CMD))
855  {
856  WerrorS("type mismatch");
857  return TRUE;
858  }
859  idhdl pp=(idhdl)p->data;
860  switch(pp->typ)
861  {
862  case CRING_CMD:
863  nKillChar((coeffs)pp);
864  break;
865  case DEF_CMD:
866  case INT_CMD:
867  break;
868  case INTVEC_CMD:
869  case INTMAT_CMD:
870  delete IDINTVEC(pp);
871  break;
872  case NUMBER_CMD:
873  nDelete(&IDNUMBER(pp));
874  break;
875  case BIGINT_CMD:
877  break;
878  case MAP_CMD:
879  {
880  map im = IDMAP(pp);
881  omFree((ADDRESS)im->preimage);
882  im->preimage=NULL;// and continue
883  }
884  // continue as ideal:
885  case IDEAL_CMD:
886  case MODUL_CMD:
887  case MATRIX_CMD:
888  idDelete(&IDIDEAL(pp));
889  break;
890  case PROC_CMD:
891  case RESOLUTION_CMD:
892  case STRING_CMD:
894  break;
895  case LIST_CMD:
896  IDLIST(pp)->Clean();
897  break;
898  case LINK_CMD:
900  break;
901  // case ring: cannot happen
902  default:
903  Werror("unknown type %d",p->Typ());
904  return TRUE;
905  }
906  pp->typ=ALIAS_CMD;
907  IDDATA(pp)=(char*)h->data;
908  int eff_typ=h->Typ();
909  if ((RingDependend(eff_typ))
910  || ((eff_typ==LIST_CMD) && (lRingDependend((lists)h->Data()))))
911  {
912  ipSwapId(pp,IDROOT,currRing->idroot);
913  }
914  h->CleanUp();
916  return FALSE;
917 }
void * ADDRESS
Definition: auxiliary.h:119
CanonicalForm pp(const CanonicalForm &)
CanonicalForm pp ( const CanonicalForm & f )
Definition: cf_gcd.cc:676
int p
Definition: cfModGcd.cc:4080
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:456
void nKillChar(coeffs r)
undo all initialisations
Definition: numbers.cc:513
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:1964
static int ipSwapId(idhdl tomove, idhdl &root1, idhdl &root2)
Definition: ipid.cc:669
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:78
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:199
The main handler for Singular numbers which are suitable for Singular polynomials.
#define nDelete(n)
Definition: numbers.h:16
#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 294 of file iplib.cc.

295 {
296  int save_trace=traceit;
297  int restore_traceit=0;
298  if (traceit_stop
299  && (traceit & TRACE_SHOW_LINE))
300  {
302  traceit_stop=0;
303  restore_traceit=1;
304  }
305  // see below:
306  BITSET save1=si_opt_1;
307  BITSET save2=si_opt_2;
308  newBuffer( omStrDup(p /*pi->data.s.body*/), t /*BT_proc*/,
309  pi, l );
310  BOOLEAN err=yyparse();
311 
312  if (sLastPrinted.rtyp!=0)
313  {
315  }
316 
317  if (restore_traceit) traceit=save_trace;
318 
319  // the access to optionStruct and verboseStruct do not work
320  // on x86_64-Linux for pic-code
321  if ((TEST_V_ALLWARN) &&
322  (t==BT_proc) &&
323  ((save1!=si_opt_1)||(save2!=si_opt_2)) &&
324  (pi->libname!=NULL) && (pi->libname[0]!='\0'))
325  {
326  if ((pi->libname!=NULL) && (pi->libname[0]!='\0'))
327  Warn("option changed in proc %s from %s",pi->procname,pi->libname);
328  else
329  Warn("option changed in proc %s",pi->procname);
330  int i;
331  for (i=0; optionStruct[i].setval!=0; i++)
332  {
333  if ((optionStruct[i].setval & si_opt_1)
334  && (!(optionStruct[i].setval & save1)))
335  {
336  Print(" +%s",optionStruct[i].name);
337  }
338  if (!(optionStruct[i].setval & si_opt_1)
339  && ((optionStruct[i].setval & save1)))
340  {
341  Print(" -%s",optionStruct[i].name);
342  }
343  }
344  for (i=0; verboseStruct[i].setval!=0; i++)
345  {
346  if ((verboseStruct[i].setval & si_opt_2)
347  && (!(verboseStruct[i].setval & save2)))
348  {
349  Print(" +%s",verboseStruct[i].name);
350  }
351  if (!(verboseStruct[i].setval & si_opt_2)
352  && ((verboseStruct[i].setval & save2)))
353  {
354  Print(" -%s",verboseStruct[i].name);
355  }
356  }
357  PrintLn();
358  }
359  return err;
360 }
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:196
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:550
unsigned setval
Definition: ipid.h:153
const struct soptionStruct optionStruct[]
Definition: misc_ip.cc:519
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:141
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:20
INST_VAR sleftv sLastPrinted
Definition: subexpr.cc:46

◆ iiApply()

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

Definition at line 6423 of file ipshell.cc.

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

◆ iiARROW()

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

Definition at line 6472 of file ipshell.cc.

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

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

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

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  r,
leftv  args 
)

Definition at line 1202 of file ipshell.cc.

1203 {
1204  // must be inside a proc, as we simultae an proc_end at the end
1205  if (myynest==0)
1206  {
1207  WerrorS("branchTo can only occur in a proc");
1208  return TRUE;
1209  }
1210  // <string1...stringN>,<proc>
1211  // known: args!=NULL, l>=1
1212  int l=args->listLength();
1213  int ll=0;
1214  if (iiCurrArgs!=NULL) ll=iiCurrArgs->listLength();
1215  if (ll!=(l-1)) return FALSE;
1216  leftv h=args;
1217  // set up the table for type test:
1218  short *t=(short*)omAlloc(l*sizeof(short));
1219  t[0]=l-1;
1220  int b;
1221  int i;
1222  for(i=1;i<l;i++,h=h->next)
1223  {
1224  if (h->Typ()!=STRING_CMD)
1225  {
1226  omFree(t);
1227  Werror("arg %d is not a string",i);
1228  return TRUE;
1229  }
1230  int tt;
1231  b=IsCmd((char *)h->Data(),tt);
1232  if(b) t[i]=tt;
1233  else
1234  {
1235  omFree(t);
1236  Werror("arg %d is not a type name",i);
1237  return TRUE;
1238  }
1239  }
1240  if (h->Typ()!=PROC_CMD)
1241  {
1242  omFree(t);
1243  Werror("last(%d.) arg.(%s) is not a proc(but %s(%d)), nesting=%d",
1244  i,h->name,Tok2Cmdname(h->Typ()),h->Typ(),myynest);
1245  return TRUE;
1246  }
1247  b=iiCheckTypes(iiCurrArgs,t,0);
1248  omFree(t);
1249  if (b && (h->rtyp==IDHDL) && (h->e==NULL))
1250  {
1251  // get the proc:
1252  iiCurrProc=(idhdl)h->data;
1253  idhdl currProc=iiCurrProc; /*iiCurrProc may be changed after yyparse*/
1254  procinfo * pi=IDPROC(currProc);
1255  // already loaded ?
1256  if( pi->data.s.body==NULL )
1257  {
1259  if (pi->data.s.body==NULL) return TRUE;
1260  }
1261  // set currPackHdl/currPack
1262  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
1263  {
1264  currPack=pi->pack;
1267  //Print("set pack=%s\n",IDID(currPackHdl));
1268  }
1269  // see iiAllStart:
1270  BITSET save1=si_opt_1;
1271  BITSET save2=si_opt_2;
1272  newBuffer( omStrDup(pi->data.s.body), BT_proc,
1273  pi, pi->data.s.body_lineno-(iiCurrArgs==NULL) );
1274  BOOLEAN err=yyparse();
1275  iiCurrProc=NULL;
1276  si_opt_1=save1;
1277  si_opt_2=save2;
1278  // now save the return-expr.
1280  memcpy(&sLastPrinted,&iiRETURNEXPR,sizeof(sleftv));
1281  iiRETURNEXPR.Init();
1282  // warning about args.:
1283  if (iiCurrArgs!=NULL)
1284  {
1285  if (err==0) Warn("too many arguments for %s",IDID(currProc));
1286  iiCurrArgs->CleanUp();
1288  iiCurrArgs=NULL;
1289  }
1290  // similate proc_end:
1291  // - leave input
1292  void myychangebuffer();
1293  myychangebuffer();
1294  // - set the current buffer to its end (this is a pointer in a buffer,
1295  // not a file ptr) "branchTo" is only valid in proc)
1297  // - kill local vars
1299  // - return
1300  newBuffer(omStrDup("\n;return(_);\n"),BT_execute);
1301  return (err!=0);
1302  }
1303  return FALSE;
1304 }
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:823
#define IDID(a)
Definition: ipid.h:122
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:193
VAR idhdl iiCurrProc
Definition: ipshell.cc:79
void iiCheckPack(package &p)
Definition: ipshell.cc:1561
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:6564
void killlocals(int v)
Definition: ipshell.cc:384
void myychangebuffer()
Definition: scanner.cc:2331

◆ iiCallLibProc1()

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

Definition at line 623 of file iplib.cc.

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

◆ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1561 of file ipshell.cc.

1562 {
1563  if (p!=basePack)
1564  {
1565  idhdl t=basePack->idroot;
1566  while ((t!=NULL) && (IDTYP(t)!=PACKAGE_CMD) && (IDPACKAGE(t)!=p)) t=t->next;
1567  if (t==NULL)
1568  {
1569  WarnS("package not found\n");
1570  p=basePack;
1571  }
1572  }
1573 }
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 1517 of file ipshell.cc.

1518 {
1519  if (currRing==NULL)
1520  {
1521  #ifdef SIQ
1522  if (siq<=0)
1523  {
1524  #endif
1525  if (RingDependend(i))
1526  {
1527  WerrorS("no ring active (9)");
1528  return TRUE;
1529  }
1530  #ifdef SIQ
1531  }
1532  #endif
1533  }
1534  return FALSE;
1535 }
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 6564 of file ipshell.cc.

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

991 {
992 #ifdef HAVE_SDB
993  sdb_flags=1;
994 #endif
995  Print("\n-- break point in %s --\n",VoiceName());
997  char * s;
999  s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
1000  loop
1001  {
1002  memset(s,0,BREAK_LINE_LENGTH+4);
1004  if (s[BREAK_LINE_LENGTH-1]!='\0')
1005  {
1006  Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
1007  }
1008  else
1009  break;
1010  }
1011  if (*s=='\n')
1012  {
1014  }
1015 #if MDEBUG
1016  else if(strncmp(s,"cont;",5)==0)
1017  {
1019  }
1020 #endif /* MDEBUG */
1021  else
1022  {
1023  strcat( s, "\n;~\n");
1025  }
1026 }
char *(* fe_fgets_stdin)(const char *pr, char *s, int size)
Definition: feread.cc:34
void VoiceBackTrack()
Definition: fevoices.cc:75
VAR BOOLEAN iiDebugMarker
Definition: ipshell.cc:988
#define BREAK_LINE_LENGTH
Definition: ipshell.cc:989
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 1127 of file ipshell.cc.

1128 {
1129  BOOLEAN res=FALSE;
1130  BOOLEAN is_qring=FALSE;
1131  const char *id = name->name;
1132 
1133  sy->Init();
1134  if ((name->name==NULL)||(isdigit(name->name[0])))
1135  {
1136  WerrorS("object to declare is not a name");
1137  res=TRUE;
1138  }
1139  else
1140  {
1141  if (root==NULL) return TRUE;
1142  if (*root!=IDROOT)
1143  {
1144  if ((currRing==NULL) || (*root!=currRing->idroot))
1145  {
1146  Werror("can not define `%s` in other package",name->name);
1147  return TRUE;
1148  }
1149  }
1150  if (t==QRING_CMD)
1151  {
1152  t=RING_CMD; // qring is always RING_CMD
1153  is_qring=TRUE;
1154  }
1155 
1156  if (TEST_V_ALLWARN
1157  && (name->rtyp!=0)
1158  && (name->rtyp!=IDHDL)
1159  && (currRingHdl!=NULL) && (IDLEV(currRingHdl)==myynest))
1160  {
1161  Warn("`%s` is %s in %s:%d:%s",name->name,Tok2Cmdname(name->rtyp),
1163  }
1164  {
1165  sy->data = (char *)enterid(id,lev,t,root,init_b);
1166  }
1167  if (sy->data!=NULL)
1168  {
1169  sy->rtyp=IDHDL;
1170  currid=sy->name=IDID((idhdl)sy->data);
1171  if (is_qring)
1172  {
1174  }
1175  // name->name=NULL; /* used in enterid */
1176  //sy->e = NULL;
1177  if (name->next!=NULL)
1178  {
1180  res=iiDeclCommand(sy->next,name->next,lev,t,root, isring);
1181  }
1182  }
1183  else res=TRUE;
1184  }
1185  name->CleanUp();
1186  return res;
1187 }
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 750 of file iplib.cc.

751 {
752  BOOLEAN err;
753  int old_echo=si_echo;
754 
755  iiCheckNest();
756  procstack->push(example);
759  {
760  if (traceit&TRACE_SHOW_LINENO) printf("\n");
761  printf("entering example (level %d)\n",myynest);
762  }
763  myynest++;
764 
765  err=iiAllStart(pi,example,BT_example,(pi != NULL ? pi->data.s.example_lineno: 0));
766 
768  myynest--;
769  si_echo=old_echo;
771  {
772  if (traceit&TRACE_SHOW_LINENO) printf("\n");
773  printf("leaving -example- (level %d)\n",myynest);
774  }
775  if (iiLocalRing[myynest] != currRing)
776  {
777  if (iiLocalRing[myynest]!=NULL)
778  {
781  }
782  else
783  {
785  currRing=NULL;
786  }
787  }
788  procstack->pop();
789  return err;
790 }
void pop()
Definition: ipid.cc:805
void push(char *)
Definition: ipid.cc:795
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:489
VAR ring * iiLocalRing
Definition: iplib.cc:469
BOOLEAN iiAllStart(procinfov pi, const char *p, feBufferTypes t, int l)
Definition: iplib.cc:294
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1632
#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 1439 of file ipshell.cc.

1440 {
1441  BOOLEAN nok=FALSE;
1442  leftv r=v;
1443  while (v!=NULL)
1444  {
1445  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL))
1446  {
1447  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1448  nok=TRUE;
1449  }
1450  else
1451  {
1452  if(iiInternalExport(v, toLev))
1453  {
1454  r->CleanUp();
1455  return TRUE;
1456  }
1457  }
1458  v=v->next;
1459  }
1460  r->CleanUp();
1461  return nok;
1462 }
char name() const
Definition: variable.cc:122
static BOOLEAN iiInternalExport(leftv v, int toLev)
Definition: ipshell.cc:1341

◆ iiExport() [2/2]

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

Definition at line 1465 of file ipshell.cc.

1466 {
1467 // if ((pack==basePack)&&(pack!=currPack))
1468 // { Warn("'exportto' to Top is depreciated in >>%s<<",my_yylinebuf);}
1469  BOOLEAN nok=FALSE;
1470  leftv rv=v;
1471  while (v!=NULL)
1472  {
1473  if ((v->name==NULL)||(v->rtyp==0)||(v->e!=NULL)
1474  )
1475  {
1476  Werror("cannot export:%s of internal type %d",v->name,v->rtyp);
1477  nok=TRUE;
1478  }
1479  else
1480  {
1481  idhdl old=pack->idroot->get( v->name,toLev);
1482  if (old!=NULL)
1483  {
1484  if ((pack==currPack) && (old==(idhdl)v->data))
1485  {
1486  if (BVERBOSE(V_REDEFINE)) Warn("`%s` is already global",IDID(old));
1487  break;
1488  }
1489  else if (IDTYP(old)==v->Typ())
1490  {
1491  if (BVERBOSE(V_REDEFINE))
1492  {
1493  Warn("redefining %s (%s)",IDID(old),my_yylinebuf);
1494  }
1495  v->name=omStrDup(v->name);
1496  killhdl2(old,&(pack->idroot),currRing);
1497  }
1498  else
1499  {
1500  rv->CleanUp();
1501  return TRUE;
1502  }
1503  }
1504  //Print("iiExport: pack=%s\n",IDID(root));
1505  if(iiInternalExport(v, toLev, pack))
1506  {
1507  rv->CleanUp();
1508  return TRUE;
1509  }
1510  }
1511  v=v->next;
1512  }
1513  rv->CleanUp();
1514  return nok;
1515 }
idhdl get(const char *s, int lev)
Definition: ipid.cc:72
void killhdl2(idhdl h, idhdl *ih, ring r)
Definition: ipid.cc:437

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

8906 {
8907  res->Init();
8908  BOOLEAN call_failed=FALSE;
8909 
8910  if (!errorreported)
8911  {
8912  BOOLEAN failed=FALSE;
8913  iiOp=op;
8914  int i = 0;
8915  while (dA1[i].cmd==op)
8916  {
8917  if (at==dA1[i].arg)
8918  {
8919  if (currRing!=NULL)
8920  {
8921  if (check_valid(dA1[i].valid_for,op)) break;
8922  }
8923  else
8924  {
8925  if (RingDependend(dA1[i].res))
8926  {
8927  WerrorS("no ring active (5)");
8928  break;
8929  }
8930  }
8931  if (traceit&TRACE_CALL)
8932  Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
8933  res->rtyp=dA1[i].res;
8934  if ((call_failed=dA1[i].p(res,a)))
8935  {
8936  break;// leave loop, goto error handling
8937  }
8938  if (a->Next()!=NULL)
8939  {
8940  res->next=(leftv)omAllocBin(sleftv_bin);
8941  failed=iiExprArith1(res->next,a->next,op);
8942  }
8943  a->CleanUp();
8944  return failed;
8945  }
8946  i++;
8947  }
8948  // implicite type conversion --------------------------------------------
8949  if (dA1[i].cmd!=op)
8950  {
8952  i=0;
8953  //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
8954  while (dA1[i].cmd==op)
8955  {
8956  int ai;
8957  //Print("test %s\n",Tok2Cmdname(dA1[i].arg));
8958  if ((dA1[i].valid_for & NO_CONVERSION)==0)
8959  {
8960  if ((ai=iiTestConvert(at,dA1[i].arg,dConvertTypes))!=0)
8961  {
8962  if (currRing!=NULL)
8963  {
8964  if (check_valid(dA1[i].valid_for,op)) break;
8965  }
8966  else
8967  {
8968  if (RingDependend(dA1[i].res))
8969  {
8970  WerrorS("no ring active (6)");
8971  break;
8972  }
8973  }
8974  if (traceit&TRACE_CALL)
8975  Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(dA1[i].arg));
8976  res->rtyp=dA1[i].res;
8977  failed= ((iiConvert(at,dA1[i].arg,ai,a,an,dConvertTypes))
8978  || (call_failed=dA1[i].p(res,an)));
8979  // everything done, clean up temp. variables
8980  if (failed)
8981  {
8982  // leave loop, goto error handling
8983  break;
8984  }
8985  else
8986  {
8987  if (an->Next() != NULL)
8988  {
8989  res->next = (leftv)omAllocBin(sleftv_bin);
8990  failed=iiExprArith1(res->next,an->next,op);
8991  }
8992  // everything ok, clean up and return
8993  an->CleanUp();
8995  return failed;
8996  }
8997  }
8998  }
8999  i++;
9000  }
9001  an->CleanUp();
9003  }
9004  // error handling
9005  if (!errorreported)
9006  {
9007  if ((at==0) && (a->Fullname()!=sNoName_fe))
9008  {
9009  Werror("`%s` is not defined",a->Fullname());
9010  }
9011  else
9012  {
9013  i=0;
9014  const char *s = iiTwoOps(op);
9015  Werror("%s(`%s`) failed"
9016  ,s,Tok2Cmdname(at));
9017  if ((!call_failed) && BVERBOSE(V_SHOW_USE))
9018  {
9019  while (dA1[i].cmd==op)
9020  {
9021  if ((dA1[i].res!=0)
9022  && (dA1[i].p!=jjWRONG))
9023  Werror("expected %s(`%s`)"
9024  ,s,Tok2Cmdname(dA1[i].arg));
9025  i++;
9026  }
9027  }
9028  }
9029  }
9030  res->rtyp = UNKNOWN;
9031  }
9032  a->CleanUp();
9033  return TRUE;
9034 }
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:3646
const char * Tok2Cmdname(int tok)
Definition: iparith.cc:9571
#define NO_CONVERSION
Definition: iparith.cc:119
BOOLEAN iiExprArith1(leftv res, leftv a, int op)
Definition: iparith.cc:9035
static BOOLEAN check_valid(const int p, const int op)
Definition: iparith.cc:9851
VAR int iiOp
Definition: iparith.cc:219
const struct sConvertTypes dConvertTypes[]
Definition: table.h:1277
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 8832 of file iparith.cc.

8836 {
8837  res->Init();
8838  leftv b=a->next;
8839  a->next=NULL;
8840  int bt=b->Typ();
8841  BOOLEAN bo=iiExprArith2TabIntern(res,a,op,b,TRUE,dA2,at,bt,dConvertTypes);
8842  a->next=b;
8843  a->CleanUp(); // to clean up the chain, content already done in iiExprArith2TabIntern
8844  return bo;
8845 }
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:8673

◆ iiExprArith3()

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

Definition at line 9247 of file iparith.cc.

9248 {
9249  res->Init();
9250 
9251  if (!errorreported)
9252  {
9253 #ifdef SIQ
9254  if (siq>0)
9255  {
9256  //Print("siq:%d\n",siq);
9258  memcpy(&d->arg1,a,sizeof(sleftv));
9259  a->Init();
9260  memcpy(&d->arg2,b,sizeof(sleftv));
9261  b->Init();
9262  memcpy(&d->arg3,c,sizeof(sleftv));
9263  c->Init();
9264  d->op=op;
9265  d->argc=3;
9266  res->data=(char *)d;
9267  res->rtyp=COMMAND;
9268  return FALSE;
9269  }
9270 #endif
9271  int at=a->Typ();
9272  // handling bb-objects ----------------------------------------------
9273  if (at>MAX_TOK)
9274  {
9275  blackbox *bb=getBlackboxStuff(at);
9276  if (bb!=NULL)
9277  {
9278  if(!bb->blackbox_Op3(op,res,a,b,c)) return FALSE;
9279  // else: no op defined
9280  }
9281  else
9282  return TRUE;
9283  if (errorreported) return TRUE;
9284  }
9285  int bt=b->Typ();
9286  int ct=c->Typ();
9287 
9288  iiOp=op;
9289  int i=0;
9290  while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
9291  return iiExprArith3TabIntern(res,op,a,b,c,dArith3+i,at,bt,ct,dConvertTypes);
9292  }
9293  a->CleanUp();
9294  b->CleanUp();
9295  c->CleanUp();
9296  //Print("op: %d,result typ:%d\n",op,res->rtyp);
9297  return TRUE;
9298 }
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:9094
VAR omBin sip_command_bin
Definition: ipid.cc:45
ip_command * command
Definition: ipid.h:23
const struct sValCmd3 dArith3[]
Definition: table.h:770
#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 9299 of file iparith.cc.

9303 {
9304  res->Init();
9305  leftv b=a->next;
9306  a->next=NULL;
9307  int bt=b->Typ();
9308  leftv c=b->next;
9309  b->next=NULL;
9310  int ct=c->Typ();
9311  BOOLEAN bo=iiExprArith3TabIntern(res,op,a,b,c,dA3,at,bt,ct,dConvertTypes);
9312  b->next=c;
9313  a->next=b;
9314  a->CleanUp(); // to cleanup the chain, content already done
9315  return bo;
9316 }

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

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

◆ iiHighCorner()

poly iiHighCorner ( ideal  i,
int  ak 
)

Definition at line 1537 of file ipshell.cc.

1538 {
1539  int i;
1540  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1541  poly po=NULL;
1543  {
1544  scComputeHC(I,currRing->qideal,ak,po);
1545  if (po!=NULL)
1546  {
1547  pGetCoeff(po)=nInit(1);
1548  for (i=rVar(currRing); i>0; i--)
1549  {
1550  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1551  }
1552  pSetComp(po,ak);
1553  pSetm(po);
1554  }
1555  }
1556  else
1557  po=pOne();
1558  return po;
1559 }
void scComputeHC(ideal S, ideal Q, int ak, poly &hEdge, ring tailRing)
Definition: hdegree.cc:1078
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:597
BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition: ring.h:765

◆ iiInternalExport()

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

Definition at line 1393 of file ipshell.cc.

1394 {
1395  idhdl h=(idhdl)v->data;
1396  if(h==NULL)
1397  {
1398  Warn("'%s': no such identifier\n", v->name);
1399  return FALSE;
1400  }
1401  package frompack=v->req_packhdl;
1402  if (frompack==NULL) frompack=currPack;
1403  if ((RingDependend(IDTYP(h)))
1404  || ((IDTYP(h)==LIST_CMD)
1405  && (lRingDependend(IDLIST(h)))
1406  )
1407  )
1408  {
1409  //Print("// ==> Ringdependent set nesting to 0\n");
1410  return (iiInternalExport(v, toLev));
1411  }
1412  else
1413  {
1414  IDLEV(h)=toLev;
1415  v->req_packhdl=rootpack;
1416  if (h==frompack->idroot)
1417  {
1418  frompack->idroot=h->next;
1419  }
1420  else
1421  {
1422  idhdl hh=frompack->idroot;
1423  while ((hh!=NULL) && (hh->next!=h))
1424  hh=hh->next;
1425  if ((hh!=NULL) && (hh->next==h))
1426  hh->next=h->next;
1427  else
1428  {
1429  Werror("`%s` not found",v->Name());
1430  return TRUE;
1431  }
1432  }
1433  h->next=rootpack->idroot;
1434  rootpack->idroot=h;
1435  }
1436  return FALSE;
1437 }

◆ iiLibCmd()

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

Definition at line 880 of file iplib.cc.

881 {
882  if (strcmp(newlib,"Singular")==0) return FALSE;
883  char libnamebuf[1024];
884  idhdl pl;
885  char *plib = iiConvName(newlib);
886  FILE * fp = feFopen( newlib, "r", libnamebuf, tellerror );
887  // int lines = 1;
888  BOOLEAN LoadResult = TRUE;
889 
890  if (fp==NULL)
891  {
892  return TRUE;
893  }
894  pl = basePack->idroot->get(plib,0);
895  if (pl==NULL)
896  {
897  pl = enterid( plib,0, PACKAGE_CMD,
898  &(basePack->idroot), TRUE );
899  IDPACKAGE(pl)->language = LANG_SINGULAR;
900  IDPACKAGE(pl)->libname=omStrDup(newlib);
901  }
902  else
903  {
904  if(IDTYP(pl)!=PACKAGE_CMD)
905  {
906  omFree(plib);
907  WarnS("not of type package.");
908  fclose(fp);
909  return TRUE;
910  }
911  if (!force)
912  {
913  omFree(plib);
914  return FALSE;
915  }
916  }
917  LoadResult = iiLoadLIB(fp, libnamebuf, newlib, pl, autoexport, tellerror);
918 
919  if(!LoadResult) IDPACKAGE(pl)->loaded = TRUE;
920  omFree((ADDRESS)plib);
921  return LoadResult;
922 }
CanonicalForm fp
Definition: cfModGcd.cc:4104
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:969
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 969 of file iplib.cc.

971 {
972  EXTERN_VAR FILE *yylpin;
973  libstackv ls_start = library_stack;
974  lib_style_types lib_style;
975 
976  yylpin = fp;
977  #if YYLPDEBUG > 1
978  print_init();
979  #endif
980  EXTERN_VAR int lpverbose;
982  else lpverbose=0;
983  // yylplex sets also text_buffer
984  if (text_buffer!=NULL) *text_buffer='\0';
985  yylplex(newlib, libnamebuf, &lib_style, pl, autoexport);
986  if(yylp_errno)
987  {
988  Werror("Library %s: ERROR occurred: in line %d, %d.", newlib, yylplineno,
989  current_pos(0));
991  {
995  }
996  else
998  WerrorS("Cannot load library,... aborting.");
999  reinit_yylp();
1000  fclose( yylpin );
1002  return TRUE;
1003  }
1004  if (BVERBOSE(V_LOAD_LIB))
1005  Print( "// ** loaded %s %s\n", libnamebuf, text_buffer);
1006  if( (lib_style == OLD_LIBSTYLE) && (BVERBOSE(V_LOAD_LIB)))
1007  {
1008  Warn( "library %s has old format. This format is still accepted,", newlib);
1009  WarnS( "but for functionality you may wish to change to the new");
1010  WarnS( "format. Please refer to the manual for further information.");
1011  }
1012  reinit_yylp();
1013  fclose( yylpin );
1014  fp = NULL;
1015  iiRunInit(IDPACKAGE(pl));
1016 
1017  {
1018  libstackv ls;
1019  for(ls = library_stack; (ls != NULL) && (ls != ls_start); )
1020  {
1021  if(ls->to_be_done)
1022  {
1023  ls->to_be_done=FALSE;
1024  iiLibCmd(ls->get(),autoexport,tellerror,FALSE);
1025  ls = ls->pop(newlib);
1026  }
1027  }
1028 #if 0
1029  PrintS("--------------------\n");
1030  for(ls = library_stack; ls != NULL; ls = ls->next)
1031  {
1032  Print("%s: LIB-stack:(%d), %s %s\n", newlib, ls->cnt, ls->get(),
1033  ls->to_be_done ? "not loaded" : "loaded");
1034  }
1035  PrintS("--------------------\n");
1036 #endif
1037  }
1038 
1039  if(fp != NULL) fclose(fp);
1040  return FALSE;
1041 }
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:924
VAR libstackv library_stack
Definition: iplib.cc:64
const char * yylp_errlist[]
Definition: libparse.cc:1114
EXTERN_VAR int yylplineno
Definition: iplib.cc:61
static void iiRunInit(package p)
Definition: iplib.cc:953
EXTERN_VAR int yylp_errno
Definition: iplib.cc:60
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 866 of file iplib.cc.

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

◆ iiMake_proc()

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

Definition at line 500 of file iplib.cc.

501 {
502  int err;
503  procinfov pi = IDPROC(pn);
504  if(pi->is_static && myynest==0)
505  {
506  Werror("'%s::%s()' is a local procedure and cannot be accessed by an user.",
507  pi->libname, pi->procname);
508  return TRUE;
509  }
510  iiCheckNest();
512  //Print("currRing(%d):%s(%x) in %s\n",myynest,IDID(currRingHdl),currRing,IDID(pn));
513  iiRETURNEXPR.Init();
514  procstack->push(pi->procname);
516  || (pi->trace_flag&TRACE_SHOW_PROC))
517  {
519  Print("entering%-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
520  }
521 #ifdef RDEBUG
523 #endif
524  switch (pi->language)
525  {
526  default:
527  case LANG_NONE:
528  WerrorS("undefined proc");
529  err=TRUE;
530  break;
531 
532  case LANG_SINGULAR:
533  if ((pi->pack!=NULL)&&(currPack!=pi->pack))
534  {
535  currPack=pi->pack;
538  //Print("set pack=%s\n",IDID(currPackHdl));
539  }
540  else if ((pack!=NULL)&&(currPack!=pack))
541  {
542  currPack=pack;
545  //Print("set pack=%s\n",IDID(currPackHdl));
546  }
547  err=iiPStart(pn,args);
548  break;
549  case LANG_C:
551  err = (pi->data.o.function)(res, args);
552  memcpy(&iiRETURNEXPR,res,sizeof(iiRETURNEXPR));
554  break;
555  }
557  || (pi->trace_flag&TRACE_SHOW_PROC))
558  {
560  Print("leaving %-*.*s %s (level %d)\n",myynest*2,myynest*2," ",IDID(pn),myynest);
561  }
562  //const char *n="NULL";
563  //if (currRingHdl!=NULL) n=IDID(currRingHdl);
564  //Print("currRing(%d):%s(%x) after %s\n",myynest,n,currRing,IDID(pn));
565 #ifdef RDEBUG
567 #endif
568  if (err)
569  {
571  //iiRETURNEXPR.Init(); //done by CleanUp
572  }
573  if (iiCurrArgs!=NULL)
574  {
575  if (!err) Warn("too many arguments for %s",IDID(pn));
576  iiCurrArgs->CleanUp();
579  }
580  procstack->pop();
581  if (err)
582  return TRUE;
583  return FALSE;
584 }
static void iiShowLevRings()
Definition: iplib.cc:474
BOOLEAN iiPStart(idhdl pn, leftv v)
Definition: iplib.cc:367
#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 772 of file ipshell.cc.

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

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

◆ iiOpsTwoChar()

int iiOpsTwoChar ( const char *  s)

Definition at line 119 of file ipshell.cc.

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

◆ iiParameter()

BOOLEAN iiParameter ( leftv  p)

Definition at line 1305 of file ipshell.cc.

1306 {
1307  if (iiCurrArgs==NULL)
1308  {
1309  if (strcmp(p->name,"#")==0)
1310  return iiDefaultParameter(p);
1311  Werror("not enough arguments for proc %s",VoiceName());
1312  p->CleanUp();
1313  return TRUE;
1314  }
1315  leftv h=iiCurrArgs;
1316  leftv rest=h->next; /*iiCurrArgs is not NULL here*/
1317  BOOLEAN is_default_list=FALSE;
1318  if (strcmp(p->name,"#")==0)
1319  {
1320  is_default_list=TRUE;
1321  rest=NULL;
1322  }
1323  else
1324  {
1325  h->next=NULL;
1326  }
1327  BOOLEAN res=iiAssign(p,h);
1328  if (is_default_list)
1329  {
1330  iiCurrArgs=NULL;
1331  }
1332  else
1333  {
1334  iiCurrArgs=rest;
1335  }
1336  h->CleanUp();
1338  return res;
1339 }
BOOLEAN iiDefaultParameter(leftv p)
Definition: ipshell.cc:1189

◆ iiProcArgs()

char* iiProcArgs ( char *  e,
BOOLEAN  withParenth 
)

Definition at line 110 of file iplib.cc.

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

◆ iiProcName()

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

Definition at line 96 of file iplib.cc.

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

◆ iiPStart()

BOOLEAN iiPStart ( idhdl  pn,
leftv  sl 
)

Definition at line 367 of file iplib.cc.

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

◆ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 962 of file ipshell.cc.

963 {
964  int len,reg,typ0;
965 
966  resolvente r=liFindRes(L,&len,&typ0);
967 
968  if (r==NULL)
969  return -2;
970  intvec *weights=NULL;
971  int add_row_shift=0;
972  intvec *ww=(intvec *)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
973  if (ww!=NULL)
974  {
975  weights=ivCopy(ww);
976  add_row_shift = ww->min_in();
977  (*weights) -= add_row_shift;
978  }
979  //Print("attr:%x\n",weights);
980 
981  intvec *dummy=syBetti(r,len,&reg,weights);
982  if (weights!=NULL) delete weights;
983  delete dummy;
984  omFreeSize((ADDRESS)r,len*sizeof(ideal));
985  return reg+1+add_row_shift;
986 }
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 6593 of file ipshell.cc.

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

◆ iiTestAssume()

BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6445 of file ipshell.cc.

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

◆ iiTokType()

int iiTokType ( int  op)

Definition at line 234 of file iparith.cc.

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

◆ iiTryLoadLib()

BOOLEAN iiTryLoadLib ( leftv  v,
const char *  id 
)

Definition at line 819 of file iplib.cc.

820 {
821  BOOLEAN LoadResult = TRUE;
822  char libnamebuf[1024];
823  char *libname = (char *)omAlloc(strlen(id)+5);
824  const char *suffix[] = { "", ".lib", ".so", ".sl", NULL };
825  int i = 0;
826  // FILE *fp;
827  // package pack;
828  // idhdl packhdl;
829  lib_types LT;
830  for(i=0; suffix[i] != NULL; i++)
831  {
832  sprintf(libname, "%s%s", id, suffix[i]);
833  *libname = mytolower(*libname);
834  if((LT = type_of_LIB(libname, libnamebuf)) > LT_NOTFOUND)
835  {
836  #ifdef HAVE_DYNAMIC_LOADING
837  char libnamebuf[1024];
838  #endif
839 
840  if (LT==LT_SINGULAR)
841  LoadResult = iiLibCmd(libname, FALSE, FALSE,TRUE);
842  #ifdef HAVE_DYNAMIC_LOADING
843  else if ((LT==LT_ELF) || (LT==LT_HPUX))
844  LoadResult = load_modules(libname,libnamebuf,FALSE);
845  #endif
846  else if (LT==LT_BUILTIN)
847  {
848  LoadResult=load_builtin(libname,FALSE, iiGetBuiltinModInit(libname));
849  }
850  if(!LoadResult )
851  {
852  v->name = iiConvName(libname);
853  break;
854  }
855  }
856  }
857  omFree(libname);
858  return LoadResult;
859 }
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:803
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 586 of file ipshell.cc.

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

◆ IsCmd()

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

Definition at line 9447 of file iparith.cc.

9448 {
9449  int i;
9450  int an=1;
9451  int en=sArithBase.nLastIdentifier;
9452 
9453  loop
9454  //for(an=0; an<sArithBase.nCmdUsed; )
9455  {
9456  if(an>=en-1)
9457  {
9458  if (strcmp(n, sArithBase.sCmds[an].name) == 0)
9459  {
9460  i=an;
9461  break;
9462  }
9463  else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
9464  {
9465  i=en;
9466  break;
9467  }
9468  else
9469  {
9470  // -- blackbox extensions:
9471  // return 0;
9472  return blackboxIsCmd(n,tok);
9473  }
9474  }
9475  i=(an+en)/2;
9476  if (*n < *(sArithBase.sCmds[i].name))
9477  {
9478  en=i-1;
9479  }
9480  else if (*n > *(sArithBase.sCmds[i].name))
9481  {
9482  an=i+1;
9483  }
9484  else
9485  {
9486  int v=strcmp(n,sArithBase.sCmds[i].name);
9487  if(v<0)
9488  {
9489  en=i-1;
9490  }
9491  else if(v>0)
9492  {
9493  an=i+1;
9494  }
9495  else /*v==0*/
9496  {
9497  break;
9498  }
9499  }
9500  }
9502  tok=sArithBase.sCmds[i].tokval;
9503  if(sArithBase.sCmds[i].alias==2)
9504  {
9505  Warn("outdated identifier `%s` used - please change your code",
9506  sArithBase.sCmds[i].name);
9507  sArithBase.sCmds[i].alias=1;
9508  }
9509  #if 0
9510  if (currRingHdl==NULL)
9511  {
9512  #ifdef SIQ
9513  if (siq<=0)
9514  {
9515  #endif
9516  if ((tok>=BEGIN_RING) && (tok<=END_RING))
9517  {
9518  WerrorS("no ring active");
9519  return 0;
9520  }
9521  #ifdef SIQ
9522  }
9523  #endif
9524  }
9525  #endif
9526  if (!expected_parms)
9527  {
9528  switch (tok)
9529  {
9530  case IDEAL_CMD:
9531  case INT_CMD:
9532  case INTVEC_CMD:
9533  case MAP_CMD:
9534  case MATRIX_CMD:
9535  case MODUL_CMD:
9536  case POLY_CMD:
9537  case PROC_CMD:
9538  case RING_CMD:
9539  case STRING_CMD:
9540  cmdtok = tok;
9541  break;
9542  }
9543  }
9544  return sArithBase.sCmds[i].toktype;
9545 }
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:190
EXTERN_VAR BOOLEAN expected_parms
Definition: iparith.cc:215
EXTERN_VAR int cmdtok
Definition: iparith.cc:214
const char * lastreserved
Definition: ipshell.cc:80

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv  res,
leftv  v 
)

Definition at line 892 of file ipshell.cc.

893 {
894  sleftv tmp;
895  tmp.Init();
896  tmp.rtyp=INT_CMD;
897  tmp.data=(void *)1;
898  if ((u->Typ()==IDEAL_CMD)
899  || (u->Typ()==MODUL_CMD))
900  return jjBETTI2_ID(res,u,&tmp);
901  else
902  return jjBETTI2(res,u,&tmp);
903 }
BOOLEAN jjBETTI2_ID(leftv res, leftv u, leftv v)
Definition: ipshell.cc:905
BOOLEAN jjBETTI2(leftv res, leftv u, leftv v)
Definition: ipshell.cc:926

◆ jjBETTI2()

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

Definition at line 926 of file ipshell.cc.

927 {
928  resolvente r;
929  int len;
930  int reg,typ0;
931  lists l=(lists)u->Data();
932 
933  intvec *weights=NULL;
934  int add_row_shift=0;
935  intvec *ww=NULL;
936  if (l->nr>=0) ww=(intvec *)atGet(&(l->m[0]),"isHomog",INTVEC_CMD);
937  if (ww!=NULL)
938  {
939  weights=ivCopy(ww);
940  add_row_shift = ww->min_in();
941  (*weights) -= add_row_shift;
942  }
943  //Print("attr:%x\n",weights);
944 
945  r=liFindRes(l,&len,&typ0);
946  if (r==NULL) return TRUE;
947  intvec* res_im=syBetti(r,len,&reg,weights,(int)(long)v->Data());
948  res->data=(void*)res_im;
949  omFreeSize((ADDRESS)r,(len)*sizeof(ideal));
950  //Print("rowShift: %d ",add_row_shift);
951  for(int i=1;i<=res_im->rows();i++)
952  {
953  if (IMATELEM(*res_im,1,i)==0) { add_row_shift--; }
954  else break;
955  }
956  //Print(" %d\n",add_row_shift);
957  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
958  if (weights!=NULL) delete weights;
959  return FALSE;
960 }
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 905 of file ipshell.cc.

906 {
908  l->Init(1);
909  l->m[0].rtyp=u->Typ();
910  l->m[0].data=u->Data();
911  attr *a=u->Attribute();
912  if (a!=NULL)
913  l->m[0].attribute=*a;
914  sleftv tmp2;
915  tmp2.Init();
916  tmp2.rtyp=LIST_CMD;
917  tmp2.data=(void *)l;
918  BOOLEAN r=jjBETTI2(res,&tmp2,v);
919  l->m[0].data=NULL;
920  l->m[0].attribute=NULL;
921  l->m[0].rtyp=DEF_CMD;
922  l->Clean();
923  return r;
924 }
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 3356 of file ipshell.cc.

3357 {
3358  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3359  return (res->data==NULL);
3360 }
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition: clapsing.cc:1537

◆ jjIMPORTFROM()

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

Definition at line 2370 of file ipassign.cc.

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

◆ jjLIST_PL()

BOOLEAN jjLIST_PL ( leftv  res,
leftv  v 
)

Definition at line 7920 of file iparith.cc.

7921 {
7922  int sl=0;
7923  if (v!=NULL) sl = v->listLength();
7924  lists L;
7925  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7926  {
7927  int add_row_shift = 0;
7928  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7929  if (weights!=NULL) add_row_shift=weights->min_in();
7930  L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7931  }
7932  else
7933  {
7935  leftv h=NULL;
7936  int i;
7937  int rt;
7938 
7939  L->Init(sl);
7940  for (i=0;i<sl;i++)
7941  {
7942  if (h!=NULL)
7943  { /* e.g. not in the first step:
7944  * h is the pointer to the old sleftv,
7945  * v is the pointer to the next sleftv
7946  * (in this moment) */
7947  h->next=v;
7948  }
7949  h=v;
7950  v=v->next;
7951  h->next=NULL;
7952  rt=h->Typ();
7953  if (rt==0)
7954  {
7955  L->Clean();
7956  Werror("`%s` is undefined",h->Fullname());
7957  return TRUE;
7958  }
7959  if (rt==RING_CMD)
7960  {
7961  L->m[i].rtyp=rt;
7962  L->m[i].data=rIncRefCnt(((ring)h->Data()));
7963  }
7964  else
7965  L->m[i].Copy(h);
7966  }
7967  }
7968  res->data=(char *)L;
7969  return FALSE;
7970 }
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:3193
static ring rIncRefCnt(ring r)
Definition: ring.h:847

◆ jjLOAD()

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

load lib/module given in v

Definition at line 5443 of file iparith.cc.

5444 {
5445  char libnamebuf[1024];
5447 
5448 #ifdef HAVE_DYNAMIC_LOADING
5449  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5450 #endif /* HAVE_DYNAMIC_LOADING */
5451  switch(LT)
5452  {
5453  default:
5454  case LT_NONE:
5455  Werror("%s: unknown type", s);
5456  break;
5457  case LT_NOTFOUND:
5458  Werror("cannot open %s", s);
5459  break;
5460 
5461  case LT_SINGULAR:
5462  {
5463  char *plib = iiConvName(s);
5464  idhdl pl = IDROOT->get_level(plib,0);
5465  if (pl==NULL)
5466  {
5467  pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5468  IDPACKAGE(pl)->language = LANG_SINGULAR;
5469  IDPACKAGE(pl)->libname=omStrDup(s);
5470  }
5471  else if (IDTYP(pl)!=PACKAGE_CMD)
5472  {
5473  Werror("can not create package `%s`",plib);
5474  omFree(plib);
5475  return TRUE;
5476  }
5477  else /* package */
5478  {
5479  package pa=IDPACKAGE(pl);
5480  if ((pa->language==LANG_C)
5481  || (pa->language==LANG_MIX))
5482  {
5483  Werror("can not create package `%s` - binaries exists",plib);
5484  omfree(plib);
5485  return TRUE;
5486  }
5487  }
5488  omFree(plib);
5489  package savepack=currPack;
5490  currPack=IDPACKAGE(pl);
5491  IDPACKAGE(pl)->loaded=TRUE;
5492  char libnamebuf[1024];
5493  FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5494  BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5495  currPack=savepack;
5496  IDPACKAGE(pl)->loaded=(!bo);
5497  return bo;
5498  }
5499  case LT_BUILTIN:
5500  SModulFunc_t iiGetBuiltinModInit(const char*);
5501  return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5502  case LT_MACH_O:
5503  case LT_ELF:
5504  case LT_HPUX:
5505 #ifdef HAVE_DYNAMIC_LOADING
5506  return load_modules(s, libnamebuf, autoexport);
5507 #else /* HAVE_DYNAMIC_LOADING */
5508  WerrorS("Dynamic modules are not supported by this version of Singular");
5509  break;
5510 #endif /* HAVE_DYNAMIC_LOADING */
5511  }
5512  return TRUE;
5513 }
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 5519 of file iparith.cc.

5520 {
5521  if (!iiGetLibStatus(s))
5522  {
5523  void (*WerrorS_save)(const char *s) = WerrorS_callback;
5526  BOOLEAN bo=jjLOAD(s,TRUE);
5527  if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
5528  Print("loading of >%s< failed\n",s);
5529  WerrorS_callback=WerrorS_save;
5530  errorreported=0;
5531  }
5532  return FALSE;
5533 }
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:5443
STATIC_VAR int WerrorS_dummy_cnt
Definition: iparith.cc:5514
static void WerrorS_dummy(const char *)
Definition: iparith.cc:5515
BOOLEAN iiGetLibStatus(const char *lib)
Definition: iplib.cc:73
#define TEST_OPT_PROT
Definition: options.h:102

◆ jjMINRES()

BOOLEAN jjMINRES ( leftv  res,
leftv  v 
)

Definition at line 871 of file ipshell.cc.

872 {
873  int len=0;
874  int typ0;
875  lists L=(lists)v->Data();
876  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
877  int add_row_shift = 0;
878  if (weights==NULL)
879  weights=(intvec*)atGet(&(L->m[0]),"isHomog",INTVEC_CMD);
880  if (weights!=NULL) add_row_shift=weights->min_in();
881  resolvente rr=liFindRes(L,&len,&typ0);
882  if (rr==NULL) return TRUE;
883  resolvente r=iiCopyRes(rr,len);
884 
885  syMinimizeResolvente(r,len,0);
886  omFreeSize((ADDRESS)rr,len*sizeof(ideal));
887  len++;
888  res->data=(char *)liMakeResolv(r,len,-1,typ0,NULL,add_row_shift);
889  return FALSE;
890 }
static resolvente iiCopyRes(resolvente r, int l)
Definition: ipshell.cc:861
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 3349 of file ipshell.cc.

3350 {
3351  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3352  (poly)w->CopyD(), currRing);
3353  return errorreported;
3354 }
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition: clapsing.cc:311

◆ 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:4085
static FORCE_INLINE number n_Copy(number n, const coeffs r)
return a copy of 'n'
Definition: coeffs.h:452
@ n_algExt
used for all algebraic extensions, i.e., the top-most extension in an extension tower is algebraic
Definition: coeffs.h:36
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:353
static FORCE_INLINE BOOLEAN n_IsZero(number n, const coeffs r)
TRUE iff 'n' represents the zero element.
Definition: coeffs.h:465
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:934
static FORCE_INLINE void n_Normalize(number &n, const coeffs r)
inplace-normalization of n; produces some canonical representation of n;
Definition: coeffs.h:579
static FORCE_INLINE BOOLEAN nCoeff_is_transExt(const coeffs r)
TRUE iff r represents a transcendental extension field.
Definition: coeffs.h:942
omBin_t * omBin
Definition: omStructs.h:12
static BOOLEAN p_IsConstant(const poly p, const ring r)
Definition: p_polys.h:1971
static void p_Delete(poly *p, const ring r)
Definition: p_polys.h:861
@ NUM
Definition: readcf.cc:170
void rDelete(ring r)
unconditionally deletes fields in r
Definition: ring.cc:449
ring rCopy(ring r)
Definition: ring.cc:1648
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 230 of file extra.cc.

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

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

6310 {
6311  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6312  int n=pGetVariables((poly)u->Data(),e);
6313  jjINT_S_TO_ID(n,e,res);
6314  return FALSE;
6315 }

◆ killlocals()

void killlocals ( int  v)

Definition at line 384 of file ipshell.cc.

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

◆ kQHWeight()

BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3332 of file ipshell.cc.

3333 {
3334  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3335  if (res->data==NULL)
3336  res->data=(char *)new intvec(rVar(currRing));
3337  return FALSE;
3338 }
intvec * id_QHomWeight(ideal id, const ring r)

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3310 of file ipshell.cc.

3311 {
3312  ideal F=(ideal)id->Data();
3313  intvec * iv = new intvec(rVar(currRing));
3314  polyset s;
3315  int sl, n, i;
3316  int *x;
3317 
3318  res->data=(char *)iv;
3319  s = F->m;
3320  sl = IDELEMS(F) - 1;
3321  n = rVar(currRing);
3322  double wNsqr = (double)2.0 / (double)n;
3324  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3325  wCall(s, sl, x, wNsqr, currRing);
3326  for (i = n; i!=0; i--)
3327  (*iv)[i-1] = x[i + n + 1];
3328  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3329  return FALSE;
3330 }
Variable x
Definition: cfModGcd.cc:4084
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.c:78

◆ list_cmd()

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

Definition at line 423 of file ipshell.cc.

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

◆ loNewtonP()

BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4572 of file ipshell.cc.

4573 {
4574  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4575  return FALSE;
4576 }
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 4578 of file ipshell.cc.

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

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

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

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

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

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

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

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

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

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

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

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2082 of file ipshell.cc.

2083 {
2084  assume( r != NULL );
2085  const coeffs C = r->cf;
2086  assume( C != NULL );
2087 
2088  // sanity check: require currRing==r for rings with polynomial data
2089  if ( (r!=currRing) && (
2090  (nCoeff_is_algExt(C) && (C != currRing->cf))
2091  || (r->qideal != NULL)
2092 #ifdef HAVE_PLURAL
2093  || (rIsPluralRing(r))
2094 #endif
2095  )
2096  )
2097  {
2098  WerrorS("ring with polynomial data must be the base ring or compatible");
2099  return NULL;
2100  }
2101  // 0: char/ cf - ring
2102  // 1: list (var)
2103  // 2: list (ord)
2104  // 3: qideal
2105  // possibly:
2106  // 4: C
2107  // 5: D
2109  if (rIsPluralRing(r))
2110  L->Init(6);
2111  else
2112  L->Init(4);
2113  // ----------------------------------------
2114  // 0: char/ cf - ring
2115  if (rField_is_numeric(r))
2116  {
2117  rDecomposeC(&(L->m[0]),r);
2118  }
2119  else if (rField_is_Ring(r))
2120  {
2121  rDecomposeRing(&(L->m[0]),r);
2122  }
2123  else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2124  {
2125  rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2126  }
2127  else if(rField_is_GF(r))
2128  {
2130  Lc->Init(4);
2131  // char:
2132  Lc->m[0].rtyp=INT_CMD;
2133  Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2134  // var:
2136  Lv->Init(1);
2137  Lv->m[0].rtyp=STRING_CMD;
2138  Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2139  Lc->m[1].rtyp=LIST_CMD;
2140  Lc->m[1].data=(void*)Lv;
2141  // ord:
2143  Lo->Init(1);
2145  Loo->Init(2);
2146  Loo->m[0].rtyp=STRING_CMD;
2147  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2148 
2149  intvec *iv=new intvec(1); (*iv)[0]=1;
2150  Loo->m[1].rtyp=INTVEC_CMD;
2151  Loo->m[1].data=(void *)iv;
2152 
2153  Lo->m[0].rtyp=LIST_CMD;
2154  Lo->m[0].data=(void*)Loo;
2155 
2156  Lc->m[2].rtyp=LIST_CMD;
2157  Lc->m[2].data=(void*)Lo;
2158  // q-ideal:
2159  Lc->m[3].rtyp=IDEAL_CMD;
2160  Lc->m[3].data=(void *)idInit(1,1);
2161  // ----------------------
2162  L->m[0].rtyp=LIST_CMD;
2163  L->m[0].data=(void*)Lc;
2164  }
2165  else
2166  {
2167  L->m[0].rtyp=INT_CMD;
2168  L->m[0].data=(void *)(long)r->cf->ch;
2169  }
2170  // ----------------------------------------
2171  // 1: list (var)
2173  LL->Init(r->N);
2174  int i;
2175  for(i=0; i<r->N; i++)
2176  {
2177  LL->m[i].rtyp=STRING_CMD;
2178  LL->m[i].data=(void *)omStrDup(r->names[i]);
2179  }
2180  L->m[1].rtyp=LIST_CMD;
2181  L->m[1].data=(void *)LL;
2182  // ----------------------------------------
2183  // 2: list (ord)
2185  i=rBlocks(r)-1;
2186  LL->Init(i);
2187  i--;
2188  lists LLL;
2189  for(; i>=0; i--)
2190  {
2191  intvec *iv;
2192  int j;
2193  LL->m[i].rtyp=LIST_CMD;
2195  LLL->Init(2);
2196  LLL->m[0].rtyp=STRING_CMD;
2197  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2198 
2199  if((r->order[i] == ringorder_IS)
2200  || (r->order[i] == ringorder_s)) //|| r->order[i] == ringorder_S)
2201  {
2202  assume( r->block0[i] == r->block1[i] );
2203  const int s = r->block0[i];
2204  assume( (-2 < s && s < 2)||(r->order[i] != ringorder_IS));
2205 
2206  iv=new intvec(1);
2207  (*iv)[0] = s;
2208  }
2209  else if (r->block1[i]-r->block0[i] >=0 )
2210  {
2211  int bl=j=r->block1[i]-r->block0[i];
2212  if (r->order[i]==ringorder_M)
2213  {
2214  j=(j+1)*(j+1)-1;
2215  bl=j+1;
2216  }
2217  else if (r->order[i]==ringorder_am)
2218  {
2219  j+=r->wvhdl[i][bl+1];
2220  }
2221  iv=new intvec(j+1);
2222  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2223  {
2224  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2225  }
2226  else switch (r->order[i])
2227  {
2228  case ringorder_dp:
2229  case ringorder_Dp:
2230  case ringorder_ds:
2231  case ringorder_Ds:
2232  case ringorder_lp:
2233  case ringorder_ls:
2234  case ringorder_rp:
2235  for(;j>=0; j--) (*iv)[j]=1;
2236  break;
2237  default: /* do nothing */;
2238  }
2239  }
2240  else
2241  {
2242  iv=new intvec(1);
2243  }
2244  LLL->m[1].rtyp=INTVEC_CMD;
2245  LLL->m[1].data=(void *)iv;
2246  LL->m[i].data=(void *)LLL;
2247  }
2248  L->m[2].rtyp=LIST_CMD;
2249  L->m[2].data=(void *)LL;
2250  // ----------------------------------------
2251  // 3: qideal
2252  L->m[3].rtyp=IDEAL_CMD;
2253  if (r->qideal==NULL)
2254  L->m[3].data=(void *)idInit(1,1);
2255  else
2256  L->m[3].data=(void *)idCopy(r->qideal);
2257  // ----------------------------------------
2258 #ifdef HAVE_PLURAL // NC! in rDecompose
2259  if (rIsPluralRing(r))
2260  {
2261  L->m[4].rtyp=MATRIX_CMD;
2262  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2263  L->m[5].rtyp=MATRIX_CMD;
2264  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2265  }
2266 #endif
2267  return L;
2268 }
CanonicalForm Lc(const CanonicalForm &f)
static void rDecomposeC(leftv h, const ring R)
Definition: ipshell.cc:1784
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1660
void rDecomposeRing(leftv h, const ring R)
Definition: ipshell.cc:1848
matrix mp_Copy(matrix a, const ring r)
copies matrix a (from ring r to r)
Definition: matpol.cc:64
const char * rSimpleOrdStr(int ord)
Definition: ring.cc:77
static char const ** rParameter(const ring r)
(r->cf->parameter)
Definition: ring.h:630
@ ringorder_lp
Definition: ring.h:77
@ ringorder_am
Definition: ring.h:88
@ ringorder_ds
Definition: ring.h:84
@ ringorder_Dp
Definition: ring.h:80
@ ringorder_Ds
Definition: ring.h:85
@ ringorder_dp
Definition: ring.h:78
@ ringorder_rp
Definition: ring.h:79
@ ringorder_IS
Induced (Schreyer) ordering.
Definition: ring.h:93
@ ringorder_ls
Definition: ring.h:83
@ ringorder_s
s?
Definition: ring.h:76
@ ringorder_M
Definition: ring.h:74
static BOOLEAN rField_is_numeric(const ring r)
Definition: ring.h:520
static BOOLEAN rField_is_GF(const ring r)
Definition: ring.h:526

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1880 of file ipshell.cc.

1881 {
1882  assume( C != NULL );
1883 
1884  // sanity check: require currRing==r for rings with polynomial data
1885  if ( nCoeff_is_algExt(C) && (C != currRing->cf))
1886  {
1887  WerrorS("ring with polynomial data must be the base ring or compatible");
1888  return TRUE;
1889  }
1890  if (nCoeff_is_numeric(C))
1891  {
1892  rDecomposeC_41(res,C);
1893  }
1894 #ifdef HAVE_RINGS
1895  else if (nCoeff_is_Ring(C))
1896  {
1898  }
1899 #endif
1900  else if ( C->extRing!=NULL )// nCoeff_is_algExt(r->cf))
1901  {
1902  rDecomposeCF(res, C->extRing, currRing);
1903  }
1904  else if(nCoeff_is_GF(C))
1905  {
1907  Lc->Init(4);
1908  // char:
1909  Lc->m[0].rtyp=INT_CMD;
1910  Lc->m[0].data=(void*)(long)C->m_nfCharQ;
1911  // var:
1913  Lv->Init(1);
1914  Lv->m[0].rtyp=STRING_CMD;
1915  Lv->m[0].data=(void *)omStrDup(*n_ParameterNames(C));
1916  Lc->m[1].rtyp=LIST_CMD;
1917  Lc->m[1].data=(void*)Lv;
1918  // ord:
1920  Lo->Init(1);
1922  Loo->Init(2);
1923  Loo->m[0].rtyp=STRING_CMD;
1924  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
1925 
1926  intvec *iv=new intvec(1); (*iv)[0]=1;
1927  Loo->m[1].rtyp=INTVEC_CMD;
1928  Loo->m[1].data=(void *)iv;
1929 
1930  Lo->m[0].rtyp=LIST_CMD;
1931  Lo->m[0].data=(void*)Loo;
1932 
1933  Lc->m[2].rtyp=LIST_CMD;
1934  Lc->m[2].data=(void*)Lo;
1935  // q-ideal:
1936  Lc->m[3].rtyp=IDEAL_CMD;
1937  Lc->m[3].data=(void *)idInit(1,1);
1938  // ----------------------
1939  res->rtyp=LIST_CMD;
1940  res->data=(void*)Lc;
1941  }
1942  else
1943  {
1944  res->rtyp=INT_CMD;
1945  res->data=(void *)(long)C->ch;
1946  }
1947  // ----------------------------------------
1948  return FALSE;
1949 }
static FORCE_INLINE BOOLEAN nCoeff_is_GF(const coeffs r)
Definition: coeffs.h:863
static FORCE_INLINE BOOLEAN nCoeff_is_numeric(const coeffs r)
Definition: coeffs.h:856
static FORCE_INLINE char const ** n_ParameterNames(const coeffs r)
Returns a (const!) pointer to (const char*) names of parameters.
Definition: coeffs.h:802
static FORCE_INLINE BOOLEAN nCoeff_is_Ring(const coeffs r)
Definition: coeffs.h:754
static void rDecomposeC_41(leftv h, const coeffs C)
Definition: ipshell.cc:1750
void rDecomposeRing_41(leftv h, const coeffs C)
Definition: ipshell.cc:1820

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 1951 of file ipshell.cc.

1952 {
1953  assume( r != NULL );
1954  const coeffs C = r->cf;
1955  assume( C != NULL );
1956 
1957  // sanity check: require currRing==r for rings with polynomial data
1958  if ( (r!=currRing) && (
1959  (r->qideal != NULL)
1960 #ifdef HAVE_PLURAL
1961  || (rIsPluralRing(r))
1962 #endif
1963  )
1964  )
1965  {
1966  WerrorS("ring with polynomial data must be the base ring or compatible");
1967  return NULL;
1968  }
1969  // 0: char/ cf - ring
1970  // 1: list (var)
1971  // 2: list (ord)
1972  // 3: qideal
1973  // possibly:
1974  // 4: C
1975  // 5: D
1977  if (rIsPluralRing(r))
1978  L->Init(6);
1979  else
1980  L->Init(4);
1981  // ----------------------------------------
1982  // 0: char/ cf - ring
1983  L->m[0].rtyp=CRING_CMD;
1984  L->m[0].data=(char*)r->cf; r->cf->ref++;
1985  // ----------------------------------------
1986  // 1: list (var)
1988  LL->Init(r->N);
1989  int i;
1990  for(i=0; i<r->N; i++)
1991  {
1992  LL->m[i].rtyp=STRING_CMD;
1993  LL->m[i].data=(void *)omStrDup(r->names[i]);
1994  }
1995  L->m[1].rtyp=LIST_CMD;
1996  L->m[1].data=(void *)LL;
1997  // ----------------------------------------
1998  // 2: list (ord)
2000  i=rBlocks(r)-1;
2001  LL->Init(i);
2002  i--;
2003  lists LLL;
2004  for(; i>=0; i--)
2005  {
2006  intvec *iv;
2007  int j;
2008  LL->m[i].rtyp=LIST_CMD;
2010  LLL->Init(2);
2011  LLL->m[0].rtyp=STRING_CMD;
2012  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2013 
2014  if(r->order[i] == ringorder_IS) // || r->order[i] == ringorder_s || r->order[i] == ringorder_S)
2015  {
2016  assume( r->block0[i] == r->block1[i] );
2017  const int s = r->block0[i];
2018  assume( -2 < s && s < 2);
2019 
2020  iv=new intvec(1);
2021  (*iv)[0] = s;
2022  }
2023  else if (r->block1[i]-r->block0[i] >=0 )
2024  {
2025  int bl=j=r->block1[i]-r->block0[i];
2026  if (r->order[i]==ringorder_M)
2027  {
2028  j=(j+1)*(j+1)-1;
2029  bl=j+1;
2030  }
2031  else if (r->order[i]==ringorder_am)
2032  {
2033  j+=r->wvhdl[i][bl+1];
2034  }
2035  iv=new intvec(j+1);
2036  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2037  {
2038  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2039  }
2040  else switch (r->order[i])
2041  {
2042  case ringorder_dp:
2043  case ringorder_Dp:
2044  case ringorder_ds:
2045  case ringorder_Ds:
2046  case ringorder_lp:
2047  for(;j>=0; j--) (*iv)[j]=1;
2048  break;
2049  default: /* do nothing */;
2050  }
2051  }
2052  else
2053  {
2054  iv=new intvec(1);
2055  }
2056  LLL->m[1].rtyp=INTVEC_CMD;
2057  LLL->m[1].data=(void *)iv;
2058  LL->m[i].data=(void *)LLL;
2059  }
2060  L->m[2].rtyp=LIST_CMD;
2061  L->m[2].data=(void *)LL;
2062  // ----------------------------------------
2063  // 3: qideal
2064  L->m[3].rtyp=IDEAL_CMD;
2065  if (r->qideal==NULL)
2066  L->m[3].data=(void *)idInit(1,1);
2067  else
2068  L->m[3].data=(void *)idCopy(r->qideal);
2069  // ----------------------------------------
2070 #ifdef HAVE_PLURAL // NC! in rDecompose
2071  if (rIsPluralRing(r))
2072  {
2073  L->m[4].rtyp=MATRIX_CMD;
2074  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2075  L->m[5].rtyp=MATRIX_CMD;
2076  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2077  }
2078 #endif
2079  return L;
2080 }

◆ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1575 of file ipshell.cc.

1576 {
1577  idhdl tmp=NULL;
1578 
1579  if (s!=NULL) tmp = enterid(s, myynest, RING_CMD, &IDROOT);
1580  if (tmp==NULL) return NULL;
1581 
1582 // if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
1584  {
1586  }
1587 
1588  ring r = IDRING(tmp) = (ring) omAlloc0Bin(sip_sring_bin);
1589 
1590  #ifndef TEST_ZN_AS_ZP
1591  r->cf = nInitChar(n_Zp, (void*)32003); // r->cf->ch = 32003;
1592  #else
1593  mpz_t modBase;
1594  mpz_init_set_ui(modBase, (long)32003);
1595  ZnmInfo info;
1596  info.base= modBase;
1597  info.exp= 1;
1598  r->cf=nInitChar(n_Zn,(void*) &info);
1599  r->cf->is_field=1;
1600  r->cf->is_domain=1;
1601  r->cf->has_simple_Inverse=1;
1602  #endif
1603  r->N = 3;
1604  /*r->P = 0; Alloc0 in idhdl::set, ipid.cc*/
1605  /*names*/
1606  r->names = (char **) omAlloc0(3 * sizeof(char_ptr));
1607  r->names[0] = omStrDup("x");
1608  r->names[1] = omStrDup("y");
1609  r->names[2] = omStrDup("z");
1610  /*weights: entries for 3 blocks: NULL*/
1611  r->wvhdl = (int **)omAlloc0(3 * sizeof(int_ptr));
1612  /*order: dp,C,0*/
1613  r->order = (rRingOrder_t *) omAlloc(3 * sizeof(rRingOrder_t *));
1614  r->block0 = (int *)omAlloc0(3 * sizeof(int *));
1615  r->block1 = (int *)omAlloc0(3 * sizeof(int *));
1616  /* ringorder dp for the first block: var 1..3 */
1617  r->order[0] = ringorder_dp;
1618  r->block0[0] = 1;
1619  r->block1[0] = 3;
1620  /* ringorder C for the second block: no vars */
1621  r->order[1] = ringorder_C;
1622  /* the last block: everything is 0 */
1623  r->order[2] = (rRingOrder_t)0;
1624 
1625  /* complete ring intializations */
1626  rComplete(r);
1627  rSetHdl(tmp);
1628  return currRingHdl;
1629 }
rRingOrder_t
order stuff
Definition: ring.h:68
@ ringorder_C
Definition: ring.h:73
char * char_ptr
Definition: structs.h:58
int * int_ptr
Definition: structs.h:59

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1632 of file ipshell.cc.

1633 {
1634  if ((r==NULL)||(r->VarOffset==NULL))
1635  return NULL;
1637  if (h!=NULL) return h;
1638  if (IDROOT!=basePack->idroot) h=rSimpleFindHdl(r,basePack->idroot,n);
1639  if (h!=NULL) return h;
1641  while(p!=NULL)
1642  {
1643  if ((p->cPack!=basePack)
1644  && (p->cPack!=currPack))
1645  h=rSimpleFindHdl(r,p->cPack->idroot,n);
1646  if (h!=NULL) return h;
1647  p=p->next;
1648  }
1649  idhdl tmp=basePack->idroot;
1650  while (tmp!=NULL)
1651  {
1652  if (IDTYP(tmp)==PACKAGE_CMD)
1653  h=rSimpleFindHdl(r,IDPACKAGE(tmp)->idroot,n);
1654  if (h!=NULL) return h;
1655  tmp=IDNEXT(tmp);
1656  }
1657  return NULL;
1658 }
Definition: ipid.h:56
static idhdl rSimpleFindHdl(const ring r, const idhdl root, const idhdl n)
Definition: ipshell.cc:6268

◆ rInit()

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

Definition at line 5634 of file ipshell.cc.

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

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6225 of file ipshell.cc.

6226 {
6227  ring r = IDRING(h);
6228  int ref=0;
6229  if (r!=NULL)
6230  {
6231  // avoid, that sLastPrinted is the last reference to the base ring:
6232  // clean up before killing the last "named" refrence:
6233  if ((sLastPrinted.rtyp==RING_CMD)
6234  && (sLastPrinted.data==(void*)r))
6235  {
6236  sLastPrinted.CleanUp(r);
6237  }
6238  ref=r->ref;
6239  if ((ref<=0)&&(r==currRing))
6240  {
6241  // cleanup DENOMINATOR_LIST
6242  if (DENOMINATOR_LIST!=NULL)
6243  {
6245  if (TEST_V_ALLWARN)
6246  Warn("deleting denom_list for ring change from %s",IDID(h));
6247  do
6248  {
6249  n_Delete(&(dd->n),currRing->cf);
6250  dd=dd->next;
6252  DENOMINATOR_LIST=dd;
6253  } while(DENOMINATOR_LIST!=NULL);
6254  }
6255  }
6256  rKill(r);
6257  }
6258  if (h==currRingHdl)
6259  {
6260  if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6261  else
6262  {
6264  }
6265  }
6266 }
void rKill(ring r)
Definition: ipshell.cc:6179
VAR denominator_list DENOMINATOR_LIST
Definition: kutil.cc:84
denominator_list next
Definition: kutil.h:61

◆ rKill() [2/2]

void rKill ( ring  r)

Definition at line 6179 of file ipshell.cc.

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

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5135 of file ipshell.cc.

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

◆ scIndIndset()

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

Definition at line 1028 of file ipshell.cc.

1029 {
1030  int i;
1031  indset save;
1033 
1034  hexist = hInit(S, Q, &hNexist, currRing);
1035  if (hNexist == 0)
1036  {
1037  intvec *iv=new intvec(rVar(currRing));
1038  for(i=0; i<rVar(currRing); i++) (*iv)[i]=1;
1039  res->Init(1);
1040  res->m[0].rtyp=INTVEC_CMD;
1041  res->m[0].data=(intvec*)iv;
1042  return res;
1043  }
1044  else if (hisModule!=0)
1045  {
1046  res->Init(0);
1047  return res;
1048  }
1049  save = ISet = (indset)omAlloc0Bin(indlist_bin);
1050  hMu = 0;
1051  hwork = (scfmon)omAlloc(hNexist * sizeof(scmon));
1052  hvar = (varset)omAlloc((rVar(currRing) + 1) * sizeof(int));
1053  hpure = (scmon)omAlloc0((1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1054  hrad = hexist;
1055  hNrad = hNexist;
1056  radmem = hCreate(rVar(currRing) - 1);
1057  hCo = rVar(currRing) + 1;
1058  hNvar = rVar(currRing);
1059  hRadical(hrad, &hNrad, hNvar);
1060  hSupp(hrad, hNrad, hvar, &hNvar);
1061  if (hNvar)
1062  {
1063  hCo = hNvar;
1064  hPure(hrad, 0, &hNrad, hvar, hNvar, hpure, &hNpure);
1065  hLexR(hrad, hNrad, hvar, hNvar);
1067  }
1068  if (hCo && (hCo < rVar(currRing)))
1069  {
1071  }
1072  if (hMu!=0)
1073  {
1074  ISet = save;
1075  hMu2 = 0;
1076  if (all && (hCo+1 < rVar(currRing)))
1077  {
1080  i=hMu+hMu2;
1081  res->Init(i);
1082  if (hMu2 == 0)
1083  {
1085  }
1086  }
1087  else
1088  {
1089  res->Init(hMu);
1090  }
1091  for (i=0;i<hMu;i++)
1092  {
1093  res->m[i].data = (void *)save->set;
1094  res->m[i].rtyp = INTVEC_CMD;
1095  ISet = save;
1096  save = save->nx;
1098  }
1099  omFreeBin((ADDRESS)save, indlist_bin);
1100  if (hMu2 != 0)
1101  {
1102  save = JSet;
1103  for (i=hMu;i<hMu+hMu2;i++)
1104  {
1105  res->m[i].data = (void *)save->set;
1106  res->m[i].rtyp = INTVEC_CMD;
1107  JSet = save;
1108  save = save->nx;
1110  }
1111  omFreeBin((ADDRESS)save, indlist_bin);
1112  }
1113  }
1114  else
1115  {
1116  res->Init(0);
1118  }
1119  hKill(radmem, rVar(currRing) - 1);
1120  omFreeSize((ADDRESS)hpure, (1 + (rVar(currRing) * rVar(currRing))) * sizeof(long));
1121  omFreeSize((ADDRESS)hvar, (rVar(currRing) + 1) * sizeof(int));
1122  omFreeSize((ADDRESS)hwork, hNexist * sizeof(scmon));
1124  return res;
1125 }
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 4560 of file ipshell.cc.

4561 {
4562  sleftv tmp;
4563  tmp.Init();
4564  tmp.rtyp=INT_CMD;
4565  /* tmp.data = (void *)0; -- done by Init */
4566 
4567  return semicProc3(res,u,v,&tmp);
4568 }

◆ semicProc3()

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

Definition at line 4520 of file ipshell.cc.

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

◆ setOption()

BOOLEAN setOption ( leftv  res,
leftv  v 
)

Definition at line 580 of file misc_ip.cc.

581 {
582  const char *n;
583  do
584  {
585  if (v->Typ()==STRING_CMD)
586  {
587  n=(const char *)v->CopyD(STRING_CMD);
588  }
589  else
590  {
591  if (v->name==NULL)
592  return TRUE;
593  if (v->rtyp==0)
594  {
595  n=v->name;
596  v->name=NULL;
597  }
598  else
599  {
600  n=omStrDup(v->name);
601  }
602  }
603 
604  int i;
605 
606  if(strcmp(n,"get")==0)
607  {
608  intvec *w=new intvec(2);
609  (*w)[0]=si_opt_1;
610  (*w)[1]=si_opt_2;
611  res->rtyp=INTVEC_CMD;
612  res->data=(void *)w;
613  goto okay;
614  }
615  if(strcmp(n,"set")==0)
616  {
617  if((v->next!=NULL)
618  &&(v->next->Typ()==INTVEC_CMD))
619  {
620  v=v->next;
621  intvec *w=(intvec*)v->Data();
622  si_opt_1=(*w)[0];
623  si_opt_2=(*w)[1];
624 #if 0
628  ) {
630  }
631 #endif
632  goto okay;
633  }
634  }
635  if(strcmp(n,"none")==0)
636  {
637  si_opt_1=0;
638  si_opt_2=0;
639  goto okay;
640  }
641  for (i=0; (i==0) || (optionStruct[i-1].setval!=0); i++)
642  {
643  if (strcmp(n,optionStruct[i].name)==0)
644  {
645  if (optionStruct[i].setval & validOpts)
646  {
648  // optOldStd disables redthrough
649  if (optionStruct[i].setval == Sy_bit(OPT_OLDSTD))
651  }
652  else
653  WarnS("cannot set option");
654 #if 0
658  ) {
660  }
661 #endif
662  goto okay;
663  }
664  else if ((strncmp(n,"no",2)==0)
665  && (strcmp(n+2,optionStruct[i].name)==0))
666  {
667  if (optionStruct[i].setval & validOpts)
668  {
670  }
671  else
672  WarnS("cannot clear option");
673  goto okay;
674  }
675  }
676  for (i=0; (i==0) || (verboseStruct[i-1].setval!=0); i++)
677  {
678  if (strcmp(n,verboseStruct[i].name)==0)
679  {
681  #ifdef YYDEBUG
682  #if YYDEBUG
683  /*debugging the bison grammar --> grammar.cc*/
684  EXTERN_VAR int yydebug;
685  if (BVERBOSE(V_YACC)) yydebug=1;
686  else yydebug=0;
687  #endif
688  #endif
689  goto okay;
690  }
691  else if ((strncmp(n,"no",2)==0)
692  && (strcmp(n+2,verboseStruct[i].name)==0))
693  {
695  #ifdef YYDEBUG
696  #if YYDEBUG
697  /*debugging the bison grammar --> grammar.cc*/
698  EXTERN_VAR int yydebug;
699  if (BVERBOSE(V_YACC)) yydebug=1;
700  else yydebug=0;
701  #endif
702  #endif
703  goto okay;
704  }
705  }
706  Werror("unknown option `%s`",n);
707  okay:
708  if (currRing != NULL)
709  currRing->options = si_opt_1 & TEST_RINGDEP_OPTS;
710  omFree((ADDRESS)n);
711  v=v->next;
712  } while (v!=NULL);
713 
714  // set global variable to show memory usage
716  else om_sing_opt_show_mem = 0;
717 
718  return FALSE;
719 }
CanonicalForm test
Definition: cfModGcd.cc:4098
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:550
const struct soptionStruct optionStruct[]
Definition: misc_ip.cc:519
int om_sing_opt_show_mem
#define OPT_INTSTRATEGY
Definition: options.h:91
#define TEST_OPT_INTSTRATEGY
Definition: options.h:109
#define V_SHOW_MEM
Definition: options.h:42
#define V_YACC
Definition: options.h:43
#define OPT_REDTHROUGH
Definition: options.h:81
#define TEST_RINGDEP_OPTS
Definition: options.h:99
#define OPT_OLDSTD
Definition: options.h:85
static BOOLEAN rField_has_simple_inverse(const ring r)
Definition: ring.h:553

◆ showOption()

char* showOption ( )

Definition at line 721 of file misc_ip.cc.

722 {
723  int i;
724  BITSET tmp;
725 
726  StringSetS("//options:");
727  if ((si_opt_1!=0)||(si_opt_2!=0))
728  {
729  tmp=si_opt_1;
730  if(tmp)
731  {
732  for (i=0; optionStruct[i].setval!=0; i++)
733  {
734  if (optionStruct[i].setval & tmp)
735  {
737  tmp &=optionStruct[i].resetval;
738  }
739  }
740  for (i=0; i<32; i++)
741  {
742  if (tmp & Sy_bit(i)) StringAppend(" %d",i);
743  }
744  }
745  tmp=si_opt_2;
746  if (tmp)
747  {
748  for (i=0; verboseStruct[i].setval!=0; i++)
749  {
750  if (verboseStruct[i].setval & tmp)
751  {
753  tmp &=verboseStruct[i].resetval;
754  }
755  }
756  for (i=1; i<32; i++)
757  {
758  if (tmp & Sy_bit(i)) StringAppend(" %d",i+32);
759  }
760  }
761  return StringEndS();
762  }
763  StringAppendS(" none");
764  return StringEndS();
765 }
#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 442 of file misc_ip.cc.

443 {
444  assume(str!=NULL);
445  char *s=str;
446  while (*s==' ') s++;
447  char *ss=s;
448  while (*ss!='\0') ss++;
449  while (*ss<=' ')
450  {
451  *ss='\0';
452  ss--;
453  }
454  idhdl h=IDROOT->get_level(s,0);
455  if ((h!=NULL) && (IDTYP(h)==PROC_CMD))
456  {
457  char *lib=iiGetLibName(IDPROC(h));
458  if((lib!=NULL)&&(*lib!='\0'))
459  {
460  Print("// proc %s from lib %s\n",s,lib);
462  if (s!=NULL)
463  {
464  if (strlen(s)>5)
465  {
466  iiEStart(s,IDPROC(h));
467  omFree((ADDRESS)s);
468  return;
469  }
470  else omFree((ADDRESS)s);
471  }
472  }
473  }
474  else
475  {
476  char sing_file[MAXPATHLEN];
477  FILE *fd=NULL;
478  char *res_m=feResource('m', 0);
479  if (res_m!=NULL)
480  {
481  sprintf(sing_file, "%s/%s.sing", res_m, s);
482  fd = feFopen(sing_file, "r");
483  }
484  if (fd != NULL)
485  {
486 
487  int old_echo = si_echo;
488  int length, got;
489  char* s;
490 
491  fseek(fd, 0, SEEK_END);
492  length = ftell(fd);
493  fseek(fd, 0, SEEK_SET);
494  s = (char*) omAlloc((length+20)*sizeof(char));
495  got = fread(s, sizeof(char), length, fd);
496  fclose(fd);
497  if (got != length)
498  {
499  Werror("Error while reading file %s", sing_file);
500  }
501  else
502  {
503  s[length] = '\0';
504  strcat(s, "\n;return();\n\n");
505  si_echo = 2;
506  iiEStart(s, NULL);
507  si_echo = old_echo;
508  }
509  omFree(s);
510  }
511  else
512  {
513  Werror("no example for %s", str);
514  }
515  }
516 }
BOOLEAN iiEStart(char *example, procinfo *pi)
Definition: iplib.cc:750
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 4437 of file ipshell.cc.

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

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv  result,
leftv  first 
)

Definition at line 4193 of file ipshell.cc.

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

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4142 of file ipshell.cc.

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

◆ spmulProc()

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

Definition at line 4479 of file ipshell.cc.

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

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3181 of file ipshell.cc.

3182 {
3183  sleftv tmp;
3184  tmp.Init();
3185  tmp.rtyp=INT_CMD;
3186  tmp.data=(void *)1;
3187  return syBetti2(res,u,&tmp);
3188 }
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3158

◆ syBetti2()

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

Definition at line 3158 of file ipshell.cc.

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

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

◆ syConvRes()

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

Definition at line 3193 of file ipshell.cc.

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

3295 {
3296  int typ0;
3298 
3299  resolvente fr = liFindRes(li,&(result->length),&typ0);
3300  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3301  for (int i=result->length-1;i>=0;i--)
3302  {
3303  if (fr[i]!=NULL)
3304  result->minres[i] = idCopy(fr[i]);
3305  }
3306  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3307  return result;
3308 }

◆ test_cmd()

void test_cmd ( int  i)

Definition at line 512 of file ipshell.cc.

513 {
514  int ii;
515 
516  if (i<0)
517  {
518  ii= -i;
519  if (ii < 32)
520  {
521  si_opt_1 &= ~Sy_bit(ii);
522  }
523  else if (ii < 64)
524  {
525  si_opt_2 &= ~Sy_bit(ii-32);
526  }
527  else
528  WerrorS("out of bounds\n");
529  }
530  else if (i<32)
531  {
532  ii=i;
533  if (Sy_bit(ii) & kOptions)
534  {
535  WarnS("Gerhard, use the option command");
536  si_opt_1 |= Sy_bit(ii);
537  }
538  else if (Sy_bit(ii) & validOpts)
539  si_opt_1 |= Sy_bit(ii);
540  }
541  else if (i<64)
542  {
543  ii=i-32;
544  si_opt_2 |= Sy_bit(ii);
545  }
546  else
547  WerrorS("out of bounds\n");
548 }
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:92
VAR cmdnames cmds[]
Definition: table.h:986

◆ type_cmd()

void type_cmd ( leftv  v)

Definition at line 252 of file ipshell.cc.

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

◆ versionString()

char* versionString ( )

Definition at line 782 of file misc_ip.cc.

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

Variable Documentation

◆ currid

const char* currid
extern

Definition at line 171 of file grammar.cc.

◆ dArith1

const struct sValCmd1 dArith1[]
extern

Definition at line 1 of file table.h.

◆ dArith2

const struct sValCmd2 dArith2[]
extern

Definition at line 1 of file table.h.

◆ dArith3

const struct sValCmd3 dArith3[]
extern

Definition at line 1 of file table.h.

◆ dArithM

const struct sValCmdM dArithM[]
extern

Definition at line 1 of file table.h.

◆ iiCurrArgs

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 80 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.