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

Go to the source code of this file.

Data Structures

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

Typedefs

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

Functions

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

Variables

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

Data Structure Documentation

◆ sValCmd1

struct sValCmd1

Definition at line 78 of file gentable.cc.

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

◆ sValCmd2

struct sValCmd2

Definition at line 69 of file gentable.cc.

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

◆ sValCmd3

struct sValCmd3

Definition at line 86 of file gentable.cc.

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

◆ sValCmdM

struct sValCmdM

Definition at line 96 of file gentable.cc.

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

◆ sValAssign_sys

struct sValAssign_sys

Definition at line 104 of file gentable.cc.

Data Fields
short arg
int p
proc1 p
short res

◆ sValAssign

struct sValAssign

Definition at line 111 of file gentable.cc.

Data Fields
short arg
int p
proci p
short res

Typedef Documentation

◆ proc1

typedef BOOLEAN(* proc1) (leftv, leftv)

Definition at line 122 of file ipshell.h.

◆ proc2

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

Definition at line 134 of file ipshell.h.

◆ proc3

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

Definition at line 145 of file ipshell.h.

◆ proci

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

Definition at line 175 of file ipshell.h.

Function Documentation

◆ exprlist_length()

int exprlist_length ( leftv  v)

Definition at line 552 of file ipshell.cc.

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

835 {
836  if (iiCurrArgs==NULL)
837  {
838  Werror("not enough arguments for proc %s",VoiceName());
839  p->CleanUp();
840  return TRUE;
841  }
843  iiCurrArgs=h->next;
844  h->next=NULL;
845  if (h->rtyp!=IDHDL)
846  {
848  h->CleanUp();
850  return res;
851  }
852  if ((h->Typ()!=p->Typ()) &&(p->Typ()!=DEF_CMD))
853  {
854  WerrorS("type mismatch");
855  return TRUE;
856  }
857  idhdl pp=(idhdl)p->data;
858  switch(pp->typ)
859  {
860  case CRING_CMD:
861  nKillChar((coeffs)pp);
862  break;
863  case DEF_CMD:
864  case INT_CMD:
865  break;
866  case INTVEC_CMD:
867  case INTMAT_CMD:
868  delete IDINTVEC(pp);
869  break;
870  case NUMBER_CMD:
871  nDelete(&IDNUMBER(pp));
872  break;
873  case BIGINT_CMD:
875  break;
876  case MAP_CMD:
877  {
878  map im = IDMAP(pp);
879  omFree((ADDRESS)im->preimage);
880  im->preimage=NULL;// and continue
881  }
882  // continue as ideal:
883  case IDEAL_CMD:
884  case MODUL_CMD:
885  case MATRIX_CMD:
886  idDelete(&IDIDEAL(pp));
887  break;
888  case PROC_CMD:
889  case RESOLUTION_CMD:
890  case STRING_CMD:
892  break;
893  case LIST_CMD:
894  IDLIST(pp)->Clean();
895  break;
896  case LINK_CMD:
898  break;
899  // case ring: cannot happen
900  default:
901  Werror("unknown type %d",p->Typ());
902  return TRUE;
903  }
904  pp->typ=ALIAS_CMD;
905  IDDATA(pp)=(char*)h->data;
906  int eff_typ=h->Typ();
907  if ((RingDependend(eff_typ))
908  || ((eff_typ==LIST_CMD) && (lRingDependend((lists)h->Data()))))
909  {
910  ipSwapId(pp,IDROOT,currRing->idroot);
911  }
912  h->CleanUp();
914  return FALSE;
915 }
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:526
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:80
BOOLEAN lRingDependend(lists L)
Definition: lists.cc:199
The main handler for Singular numbers which are suitable for Singular polynomials.
#define nDelete(n)
Definition: numbers.h:16
#define 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:546
unsigned setval
Definition: ipid.h:153
const struct soptionStruct optionStruct[]
Definition: misc_ip.cc:515
VAR unsigned si_opt_2
Definition: options.c:6
VAR unsigned si_opt_1
Definition: options.c:5
#define TEST_V_ALLWARN
Definition: options.h:143
void PrintLn()
Definition: reporter.cc:310
#define TRACE_SHOW_LINE
Definition: reporter.h:33
EXTERN_VAR int traceit
Definition: reporter.h:24
EXTERN_VAR int traceit_stop
Definition: reporter.h:25
#define BITSET
Definition: structs.h:20
INST_VAR sleftv sLastPrinted
Definition: subexpr.cc:46

◆ iiApply()

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

Definition at line 6499 of file ipshell.cc.

6500 {
6501  res->Init();
6502  res->rtyp=a->Typ();
6503  switch (res->rtyp /*a->Typ()*/)
6504  {
6505  case INTVEC_CMD:
6506  case INTMAT_CMD:
6507  return iiApplyINTVEC(res,a,op,proc);
6508  case BIGINTMAT_CMD:
6509  return iiApplyBIGINTMAT(res,a,op,proc);
6510  case IDEAL_CMD:
6511  case MODUL_CMD:
6512  case MATRIX_CMD:
6513  return iiApplyIDEAL(res,a,op,proc);
6514  case LIST_CMD:
6515  return iiApplyLIST(res,a,op,proc);
6516  }
6517  WerrorS("first argument to `apply` must allow an index");
6518  return TRUE;
6519 }
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:6425
BOOLEAN iiApplyLIST(leftv res, leftv a, int op, leftv proc)
Definition: ipshell.cc:6467
BOOLEAN iiApplyIDEAL(leftv, leftv, int, leftv)
Definition: ipshell.cc:6462
BOOLEAN iiApplyBIGINTMAT(leftv, leftv, int, leftv)
Definition: ipshell.cc:6457

◆ iiARROW()

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

Definition at line 6548 of file ipshell.cc.

6549 {
6550  char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6551  // find end of s:
6552  int end_s=strlen(s);
6553  while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6554  s[end_s+1]='\0';
6555  char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6556  sprintf(name,"%s->%s",a,s);
6557  // find start of last expression
6558  int start_s=end_s-1;
6559  while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6560  if (start_s<0) // ';' not found
6561  {
6562  sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6563  }
6564  else // s[start_s] is ';'
6565  {
6566  s[start_s]='\0';
6567  sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6568  }
6569  r->Init();
6570  // now produce procinfo for PROC_CMD:
6571  r->data = (void *)omAlloc0Bin(procinfo_bin);
6572  ((procinfo *)(r->data))->language=LANG_NONE;
6573  iiInitSingularProcinfo((procinfo *)r->data,"",name,0,0);
6574  ((procinfo *)r->data)->data.s.body=ss;
6575  omFree(name);
6576  r->rtyp=PROC_CMD;
6577  //r->rtyp=STRING_CMD;
6578  //r->data=ss;
6579  return FALSE;
6580 }
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:552
matrix mpNew(int r, int c)
create a r x c zero-matrix
Definition: matpol.cc:37
#define pMaxComp(p)
Definition: polys.h:299
#define pNormalize(p)
Definition: polys.h:317
void PrintS(const char *s)
Definition: reporter.cc:284
#define TRACE_ASSIGN
Definition: reporter.h:46
ideal idInit(int idsize, int rank)
initialise an ideal / module
Definition: simpleideals.cc:35
#define loop
Definition: structs.h: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 6582 of file ipshell.cc.

6583 {
6584  char* ring_name=omStrDup((char*)r->Name());
6585  int t=arg->Typ();
6586  if (t==RING_CMD)
6587  {
6588  sleftv tmp;
6589  tmp.Init();
6590  tmp.rtyp=IDHDL;
6591  idhdl h=rDefault(ring_name);
6592  tmp.data=(char*)h;
6593  if (h!=NULL)
6594  {
6595  tmp.name=h->id;
6596  BOOLEAN b=iiAssign(&tmp,arg);
6597  if (b) return TRUE;
6598  rSetHdl(ggetid(ring_name));
6599  omFree(ring_name);
6600  return FALSE;
6601  }
6602  else
6603  return TRUE;
6604  }
6605  else if (t==CRING_CMD)
6606  {
6607  sleftv tmp;
6608  sleftv n;
6609  n.Init();
6610  n.name=ring_name;
6611  if (iiDeclCommand(&tmp,&n,myynest,CRING_CMD,&IDROOT)) return TRUE;
6612  if (iiAssign(&tmp,arg)) return TRUE;
6613  //Print("create %s\n",r->Name());
6614  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6615  return FALSE;
6616  }
6617  //Print("create %s\n",r->Name());
6618  //Print("from %s(%d)\n",Tok2Cmdname(arg->Typ()),arg->Typ());
6619  return TRUE;// not handled -> error for now
6620 }
const char * name
Definition: subexpr.h:87
VAR int myynest
Definition: febase.cc:41
int iiDeclCommand(leftv sy, leftv name, int lev, int t, idhdl *root, BOOLEAN isring, BOOLEAN init_b)
Definition: ipshell.cc:1202
idhdl rDefault(const char *s)
Definition: ipshell.cc:1650
void rSetHdl(idhdl h)
Definition: ipshell.cc:5210

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  r,
leftv  args 
)

Definition at line 1277 of file ipshell.cc.

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

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

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

6641 {
6642  int l=0;
6643  if (args==NULL)
6644  {
6645  if (type_list[0]==0) return TRUE;
6646  }
6647  else l=args->listLength();
6648  if (l!=(int)type_list[0])
6649  {
6650  if (report) iiReportTypes(0,l,type_list);
6651  return FALSE;
6652  }
6653  for(int i=1;i<=l;i++,args=args->next)
6654  {
6655  short t=type_list[i];
6656  if (t!=ANY_TYPE)
6657  {
6658  if (((t==IDHDL)&&(args->rtyp!=IDHDL))
6659  || (t!=args->Typ()))
6660  {
6661  if (report) iiReportTypes(i,args->Typ(),type_list);
6662  return FALSE;
6663  }
6664  }
6665  }
6666  return TRUE;
6667 }
static void iiReportTypes(int nr, int t, const short *T)
Definition: ipshell.cc:6622
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 1424 of file iplib.cc.

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

◆ iiDebug()

void iiDebug ( )

Definition at line 1065 of file ipshell.cc.

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

◆ iiDeclCommand()

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

Definition at line 1202 of file ipshell.cc.

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

◆ iiEStart()

BOOLEAN iiEStart ( char *  example,
procinfo pi 
)

Definition at line 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:803
void push(char *)
Definition: ipid.cc:793
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:1707
#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 1514 of file ipshell.cc.

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

◆ iiExport() [2/2]

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

Definition at line 1540 of file ipshell.cc.

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

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

8850 {
8851  res->Init();
8852  leftv b=a->next;
8853  a->next=NULL;
8854  int bt=b->Typ();
8855  BOOLEAN bo=iiExprArith2TabIntern(res,a,op,b,TRUE,dA2,at,bt,dConvertTypes);
8856  a->next=b;
8857  a->CleanUp(); // to clean up the chain, content already done in iiExprArith2TabIntern
8858  return bo;
8859 }
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:8687

◆ iiExprArith3()

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

Definition at line 9261 of file iparith.cc.

9262 {
9263  res->Init();
9264 
9265  if (!errorreported)
9266  {
9267 #ifdef SIQ
9268  if (siq>0)
9269  {
9270  //Print("siq:%d\n",siq);
9272  memcpy(&d->arg1,a,sizeof(sleftv));
9273  a->Init();
9274  memcpy(&d->arg2,b,sizeof(sleftv));
9275  b->Init();
9276  memcpy(&d->arg3,c,sizeof(sleftv));
9277  c->Init();
9278  d->op=op;
9279  d->argc=3;
9280  res->data=(char *)d;
9281  res->rtyp=COMMAND;
9282  return FALSE;
9283  }
9284 #endif
9285  int at=a->Typ();
9286  // handling bb-objects ----------------------------------------------
9287  if (at>MAX_TOK)
9288  {
9289  blackbox *bb=getBlackboxStuff(at);
9290  if (bb!=NULL)
9291  {
9292  if(!bb->blackbox_Op3(op,res,a,b,c)) return FALSE;
9293  // else: no op defined
9294  }
9295  else
9296  return TRUE;
9297  if (errorreported) return TRUE;
9298  }
9299  int bt=b->Typ();
9300  int ct=c->Typ();
9301 
9302  iiOp=op;
9303  int i=0;
9304  while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
9305  return iiExprArith3TabIntern(res,op,a,b,c,dArith3+i,at,bt,ct,dConvertTypes);
9306  }
9307  a->CleanUp();
9308  b->CleanUp();
9309  c->CleanUp();
9310  //Print("op: %d,result typ:%d\n",op,res->rtyp);
9311  return TRUE;
9312 }
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:9108
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 9313 of file iparith.cc.

9317 {
9318  res->Init();
9319  leftv b=a->next;
9320  a->next=NULL;
9321  int bt=b->Typ();
9322  leftv c=b->next;
9323  b->next=NULL;
9324  int ct=c->Typ();
9325  BOOLEAN bo=iiExprArith3TabIntern(res,op,a,b,c,dA3,at,bt,ct,dConvertTypes);
9326  b->next=c;
9327  a->next=b;
9328  a->CleanUp(); // to cleanup the chain, content already done
9329  return bo;
9330 }

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

1613 {
1614  int i;
1615  if(!idIsZeroDim(I)) return NULL; // not zero-dim.
1616  poly po=NULL;
1618  {
1619  scComputeHC(I,currRing->qideal,ak,po);
1620  if (po!=NULL)
1621  {
1622  pGetCoeff(po)=nInit(1);
1623  for (i=rVar(currRing); i>0; i--)
1624  {
1625  if (pGetExp(po, i) > 0) pDecrExp(po,i);
1626  }
1627  pSetComp(po,ak);
1628  pSetm(po);
1629  }
1630  }
1631  else
1632  po=pOne();
1633  return po;
1634 }
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:594
BOOLEAN rHasLocalOrMixedOrdering(const ring r)
Definition: ring.h:762

◆ iiInternalExport()

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

Definition at line 1468 of file ipshell.cc.

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

◆ 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:1515
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 847 of file ipshell.cc.

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

◆ iiMap()

leftv iiMap ( map  theMap,
const char *  what 
)

Definition at line 615 of file ipshell.cc.

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

◆ iiOpsTwoChar()

int iiOpsTwoChar ( const char *  s)

Definition at line 121 of file ipshell.cc.

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

◆ iiParameter()

BOOLEAN iiParameter ( leftv  p)

Definition at line 1380 of file ipshell.cc.

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

◆ iiProcArgs()

char* iiProcArgs ( char *  e,
BOOLEAN  withParenth 
)

Definition at line 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 1037 of file ipshell.cc.

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

◆ iiSetReturn()

void iiSetReturn ( const leftv  h)

Definition at line 6669 of file ipshell.cc.

6670 {
6671  if ((source->next==NULL)&&(source->e==NULL))
6672  {
6673  if ((source->rtyp!=IDHDL)&&(source->rtyp!=ALIAS_CMD))
6674  {
6675  memcpy(&iiRETURNEXPR,source,sizeof(sleftv));
6676  source->Init();
6677  return;
6678  }
6679  if (source->rtyp==IDHDL)
6680  {
6681  if ((IDLEV((idhdl)source->data)==myynest)
6682  &&(IDTYP((idhdl)source->data)!=RING_CMD))
6683  {
6684  iiRETURNEXPR.Init();
6685  iiRETURNEXPR.rtyp=IDTYP((idhdl)source->data);
6686  iiRETURNEXPR.data=IDDATA((idhdl)source->data);
6687  iiRETURNEXPR.flag=IDFLAG((idhdl)source->data);
6688  iiRETURNEXPR.attribute=IDATTR((idhdl)source->data);
6689  IDATTR((idhdl)source->data)=NULL;
6690  IDDATA((idhdl)source->data)=NULL;
6691  source->name=NULL;
6692  source->attribute=NULL;
6693  return;
6694  }
6695  }
6696  }
6697  iiRETURNEXPR.Copy(source);
6698 }
void Copy(leftv e)
Definition: subexpr.cc:685

◆ iiTestAssume()

BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6521 of file ipshell.cc.

6522 {
6523  // assume a: level
6524  if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6525  {
6526  if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6527  char assume_yylinebuf[80];
6528  strncpy(assume_yylinebuf,my_yylinebuf,79);
6529  int lev=(long)a->Data();
6530  int startlev=0;
6531  idhdl h=ggetid("assumeLevel");
6532  if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6533  if(lev <=startlev)
6534  {
6535  BOOLEAN bo=b->Eval();
6536  if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6537  if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6538  if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6539  }
6540  }
6541  b->CleanUp();
6542  a->CleanUp();
6543  return FALSE;
6544 }
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:1279
char mytolower(char c)
Definition: iplib.cc:1411
BOOLEAN load_builtin(const char *newlib, BOOLEAN autoexport, SModulFunc_t init)
Definition: iplib.cc:1289
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 588 of file ipshell.cc.

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

◆ IsCmd()

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

Definition at line 9461 of file iparith.cc.

9462 {
9463  int i;
9464  int an=1;
9465  int en=sArithBase.nLastIdentifier;
9466 
9467  loop
9468  //for(an=0; an<sArithBase.nCmdUsed; )
9469  {
9470  if(an>=en-1)
9471  {
9472  if (strcmp(n, sArithBase.sCmds[an].name) == 0)
9473  {
9474  i=an;
9475  break;
9476  }
9477  else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
9478  {
9479  i=en;
9480  break;
9481  }
9482  else
9483  {
9484  // -- blackbox extensions:
9485  // return 0;
9486  return blackboxIsCmd(n,tok);
9487  }
9488  }
9489  i=(an+en)/2;
9490  if (*n < *(sArithBase.sCmds[i].name))
9491  {
9492  en=i-1;
9493  }
9494  else if (*n > *(sArithBase.sCmds[i].name))
9495  {
9496  an=i+1;
9497  }
9498  else
9499  {
9500  int v=strcmp(n,sArithBase.sCmds[i].name);
9501  if(v<0)
9502  {
9503  en=i-1;
9504  }
9505  else if(v>0)
9506  {
9507  an=i+1;
9508  }
9509  else /*v==0*/
9510  {
9511  break;
9512  }
9513  }
9514  }
9516  tok=sArithBase.sCmds[i].tokval;
9517  if(sArithBase.sCmds[i].alias==2)
9518  {
9519  Warn("outdated identifier `%s` used - please change your code",
9520  sArithBase.sCmds[i].name);
9521  sArithBase.sCmds[i].alias=1;
9522  }
9523  #if 0
9524  if (currRingHdl==NULL)
9525  {
9526  #ifdef SIQ
9527  if (siq<=0)
9528  {
9529  #endif
9530  if ((tok>=BEGIN_RING) && (tok<=END_RING))
9531  {
9532  WerrorS("no ring active");
9533  return 0;
9534  }
9535  #ifdef SIQ
9536  }
9537  #endif
9538  }
9539  #endif
9540  if (!expected_parms)
9541  {
9542  switch (tok)
9543  {
9544  case IDEAL_CMD:
9545  case INT_CMD:
9546  case INTVEC_CMD:
9547  case MAP_CMD:
9548  case MATRIX_CMD:
9549  case MODUL_CMD:
9550  case POLY_CMD:
9551  case PROC_CMD:
9552  case RING_CMD:
9553  case STRING_CMD:
9554  cmdtok = tok;
9555  break;
9556  }
9557  }
9558  return sArithBase.sCmds[i].toktype;
9559 }
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:82

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv  res,
leftv  v 
)

Definition at line 967 of file ipshell.cc.

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

◆ jjBETTI2()

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

Definition at line 1001 of file ipshell.cc.

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

◆ jjBETTI2_ID()

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

Definition at line 980 of file ipshell.cc.

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

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3431 of file ipshell.cc.

3432 {
3433  res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3434  return (res->data==NULL);
3435 }
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 7934 of file iparith.cc.

7935 {
7936  int sl=0;
7937  if (v!=NULL) sl = v->listLength();
7938  lists L;
7939  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7940  {
7941  int add_row_shift = 0;
7942  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7943  if (weights!=NULL) add_row_shift=weights->min_in();
7944  L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7945  }
7946  else
7947  {
7949  leftv h=NULL;
7950  int i;
7951  int rt;
7952 
7953  L->Init(sl);
7954  for (i=0;i<sl;i++)
7955  {
7956  if (h!=NULL)
7957  { /* e.g. not in the first step:
7958  * h is the pointer to the old sleftv,
7959  * v is the pointer to the next sleftv
7960  * (in this moment) */
7961  h->next=v;
7962  }
7963  h=v;
7964  v=v->next;
7965  h->next=NULL;
7966  rt=h->Typ();
7967  if (rt==0)
7968  {
7969  L->Clean();
7970  Werror("`%s` is undefined",h->Fullname());
7971  return TRUE;
7972  }
7973  if (rt==RING_CMD)
7974  {
7975  L->m[i].rtyp=rt;
7976  L->m[i].data=rIncRefCnt(((ring)h->Data()));
7977  }
7978  else
7979  L->m[i].Copy(h);
7980  }
7981  }
7982  res->data=(char *)L;
7983  return FALSE;
7984 }
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:3268
static ring rIncRefCnt(ring r)
Definition: ring.h:844

◆ jjLOAD()

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

load lib/module given in v

Definition at line 5457 of file iparith.cc.

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

5534 {
5535  if (!iiGetLibStatus(s))
5536  {
5537  void (*WerrorS_save)(const char *s) = WerrorS_callback;
5540  BOOLEAN bo=jjLOAD(s,TRUE);
5541  if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
5542  Print("loading of >%s< failed\n",s);
5543  WerrorS_callback=WerrorS_save;
5544  errorreported=0;
5545  }
5546  return FALSE;
5547 }
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:5457
STATIC_VAR int WerrorS_dummy_cnt
Definition: iparith.cc:5528
static void WerrorS_dummy(const char *)
Definition: iparith.cc:5529
BOOLEAN iiGetLibStatus(const char *lib)
Definition: iplib.cc:73
#define TEST_OPT_PROT
Definition: options.h:103

◆ jjMINRES()

BOOLEAN jjMINRES ( leftv  res,
leftv  v 
)

Definition at line 946 of file ipshell.cc.

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

◆ jjRESULTANT()

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

Definition at line 3424 of file ipshell.cc.

3425 {
3426  res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3427  (poly)w->CopyD(), currRing);
3428  return errorreported;
3429 }
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:358
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
@ 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:1645
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:2269
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:4512
BOOLEAN semicProc3(leftv res, leftv u, leftv v, leftv w)
Definition: ipshell.cc:4595
BOOLEAN spectrumfProc(leftv result, leftv first)
Definition: ipshell.cc:4268
BOOLEAN spmulProc(leftv result, leftv first, leftv second)
Definition: ipshell.cc:4554
BOOLEAN spectrumProc(leftv result, leftv first)
Definition: ipshell.cc:4217
BOOLEAN semicProc(leftv res, leftv u, leftv v)
Definition: ipshell.cc:4635
char * versionString()
Definition: misc_ip.cc:778
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:3224
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:5250
ring rEnvelope(ring R)
Definition: ring.cc:5640
static BOOLEAN rField_is_Ring(const ring r)
Definition: ring.h:486
static int rBlocks(ring r)
Definition: ring.h:570
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:547
static BOOLEAN rIsNCRing(const ring r)
Definition: ring.h:421
static BOOLEAN rField_is_long_R(const ring r)
Definition: ring.h:544
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 6393 of file ipshell.cc.

6394 {
6395  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6396  ideal I=(ideal)u->Data();
6397  int i;
6398  int n=0;
6399  for(i=I->nrows*I->ncols-1;i>=0;i--)
6400  {
6401  int n0=pGetVariables(I->m[i],e);
6402  if (n0>n) n=n0;
6403  }
6404  jjINT_S_TO_ID(n,e,res);
6405  return FALSE;
6406 }
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6363
#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 6385 of file ipshell.cc.

6386 {
6387  int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6388  int n=pGetVariables((poly)u->Data(),e);
6389  jjINT_S_TO_ID(n,e,res);
6390  return FALSE;
6391 }

◆ killlocals()

void killlocals ( int  v)

Definition at line 386 of file ipshell.cc.

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

◆ kQHWeight()

BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3407 of file ipshell.cc.

3408 {
3409  res->data=(char *)id_QHomWeight((ideal)v->Data(), currRing);
3410  if (res->data==NULL)
3411  res->data=(char *)new intvec(rVar(currRing));
3412  return FALSE;
3413 }
intvec * id_QHomWeight(ideal id, const ring r)

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3385 of file ipshell.cc.

3386 {
3387  ideal F=(ideal)id->Data();
3388  intvec * iv = new intvec(rVar(currRing));
3389  polyset s;
3390  int sl, n, i;
3391  int *x;
3392 
3393  res->data=(char *)iv;
3394  s = F->m;
3395  sl = IDELEMS(F) - 1;
3396  n = rVar(currRing);
3397  double wNsqr = (double)2.0 / (double)n;
3399  x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3400  wCall(s, sl, x, wNsqr, currRing);
3401  for (i = n; i!=0; i--)
3402  (*iv)[i-1] = x[i + n + 1];
3403  omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3404  return FALSE;
3405 }
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 425 of file ipshell.cc.

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

◆ loNewtonP()

BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4647 of file ipshell.cc.

4648 {
4649  res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4650  return FALSE;
4651 }
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 4653 of file ipshell.cc.

4654 {
4655  if ( !(rField_is_long_R(currRing)) )
4656  {
4657  WerrorS("Ground field not implemented!");
4658  return TRUE;
4659  }
4660 
4661  simplex * LP;
4662  matrix m;
4663 
4664  leftv v= args;
4665  if ( v->Typ() != MATRIX_CMD ) // 1: matrix
4666  return TRUE;
4667  else
4668  m= (matrix)(v->CopyD());
4669 
4670  LP = new simplex(MATROWS(m),MATCOLS(m));
4671  LP->mapFromMatrix(m);
4672 
4673  v= v->next;
4674  if ( v->Typ() != INT_CMD ) // 2: m = number of constraints
4675  return TRUE;
4676  else
4677  LP->m= (int)(long)(v->Data());
4678 
4679  v= v->next;
4680  if ( v->Typ() != INT_CMD ) // 3: n = number of variables
4681  return TRUE;
4682  else
4683  LP->n= (int)(long)(v->Data());
4684 
4685  v= v->next;
4686  if ( v->Typ() != INT_CMD ) // 4: m1 = number of <= constraints
4687  return TRUE;
4688  else
4689  LP->m1= (int)(long)(v->Data());
4690 
4691  v= v->next;
4692  if ( v->Typ() != INT_CMD ) // 5: m2 = number of >= constraints
4693  return TRUE;
4694  else
4695  LP->m2= (int)(long)(v->Data());
4696 
4697  v= v->next;
4698  if ( v->Typ() != INT_CMD ) // 6: m3 = number of == constraints
4699  return TRUE;
4700  else
4701  LP->m3= (int)(long)(v->Data());
4702 
4703 #ifdef mprDEBUG_PROT
4704  Print("m (constraints) %d\n",LP->m);
4705  Print("n (columns) %d\n",LP->n);
4706  Print("m1 (<=) %d\n",LP->m1);
4707  Print("m2 (>=) %d\n",LP->m2);
4708  Print("m3 (==) %d\n",LP->m3);
4709 #endif
4710 
4711  LP->compute();
4712 
4713  lists lres= (lists)omAlloc( sizeof(slists) );
4714  lres->Init( 6 );
4715 
4716  lres->m[0].rtyp= MATRIX_CMD; // output matrix
4717  lres->m[0].data=(void*)LP->mapToMatrix(m);
4718 
4719  lres->m[1].rtyp= INT_CMD; // found a solution?
4720  lres->m[1].data=(void*)(long)LP->icase;
4721 
4722  lres->m[2].rtyp= INTVEC_CMD;
4723  lres->m[2].data=(void*)LP->posvToIV();
4724 
4725  lres->m[3].rtyp= INTVEC_CMD;
4726  lres->m[3].data=(void*)LP->zrovToIV();
4727 
4728  lres->m[4].rtyp= INT_CMD;
4729  lres->m[4].data=(void*)(long)LP->m;
4730 
4731  lres->m[5].rtyp= INT_CMD;
4732  lres->m[5].data=(void*)(long)LP->n;
4733 
4734  res->data= (void*)lres;
4735 
4736  return FALSE;
4737 }
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 3155 of file ipshell.cc.

3156 {
3157  int i,j;
3158  matrix result;
3159  ideal id=(ideal)a->Data();
3160 
3161  result =mpNew(IDELEMS(id),rVar(currRing));
3162  for (i=1; i<=IDELEMS(id); i++)
3163  {
3164  for (j=1; j<=rVar(currRing); j++)
3165  {
3166  MATELEM(result,i,j) = pDiff(id->m[i-1],j);
3167  }
3168  }
3169  res->data=(char *)result;
3170  return FALSE;
3171 }
#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 3177 of file ipshell.cc.

3178 {
3179  int n=(int)(long)b->Data();
3180  int d=(int)(long)c->Data();
3181  int k,l,sign,row,col;
3182  matrix result;
3183  ideal temp;
3184  BOOLEAN bo;
3185  poly p;
3186 
3187  if ((d>n) || (d<1) || (n<1))
3188  {
3189  res->data=(char *)mpNew(1,1);
3190  return FALSE;
3191  }
3192  int *choise = (int*)omAlloc(d*sizeof(int));
3193  if (id==NULL)
3194  temp=idMaxIdeal(1);
3195  else
3196  temp=(ideal)id->Data();
3197 
3198  k = binom(n,d);
3199  l = k*d;
3200  l /= n-d+1;
3201  result =mpNew(l,k);
3202  col = 1;
3203  idInitChoise(d,1,n,&bo,choise);
3204  while (!bo)
3205  {
3206  sign = 1;
3207  for (l=1;l<=d;l++)
3208  {
3209  if (choise[l-1]<=IDELEMS(temp))
3210  {
3211  p = pCopy(temp->m[choise[l-1]-1]);
3212  if (sign == -1) p = pNeg(p);
3213  sign *= -1;
3214  row = idGetNumberOfChoise(l-1,d,1,n,choise);
3215  MATELEM(result,row,col) = p;
3216  }
3217  }
3218  col++;
3219  idGetNextChoise(d,n,&bo,choise);
3220  }
3221  omFreeSize(choise,d*sizeof(int));
3222  if (id==NULL) idDelete(&temp);
3223 
3224  res->data=(char *)result;
3225  return FALSE;
3226 }
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:3377

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

4763 {
4764  poly gls;
4765  gls= (poly)(arg1->Data());
4766  int howclean= (int)(long)arg3->Data();
4767 
4768  if ( gls == NULL || pIsConstant( gls ) )
4769  {
4770  WerrorS("Input polynomial is constant!");
4771  return TRUE;
4772  }
4773 
4774  if (rField_is_Zp(currRing))
4775  {
4776  int* r=Zp_roots(gls, currRing);
4777  lists rlist;
4778  rlist= (lists)omAlloc( sizeof(slists) );
4779  rlist->Init( r[0] );
4780  for(int i=r[0];i>0;i--)
4781  {
4782  rlist->m[i-1].data=n_Init(r[i],currRing);
4783  rlist->m[i-1].rtyp=NUMBER_CMD;
4784  }
4785  omFree(r);
4786  res->data=rlist;
4787  res->rtyp= LIST_CMD;
4788  return FALSE;
4789  }
4790  if ( !(rField_is_R(currRing) ||
4791  rField_is_Q(currRing) ||
4794  {
4795  WerrorS("Ground field not implemented!");
4796  return TRUE;
4797  }
4798 
4801  {
4802  unsigned long int ii = (unsigned long int)arg2->Data();
4803  setGMPFloatDigits( ii, ii );
4804  }
4805 
4806  int ldummy;
4807  int deg= currRing->pLDeg( gls, &ldummy, currRing );
4808  int i,vpos=0;
4809  poly piter;
4810  lists elist;
4811 
4812  elist= (lists)omAlloc( sizeof(slists) );
4813  elist->Init( 0 );
4814 
4815  if ( rVar(currRing) > 1 )
4816  {
4817  piter= gls;
4818  for ( i= 1; i <= rVar(currRing); i++ )
4819  if ( pGetExp( piter, i ) )
4820  {
4821  vpos= i;
4822  break;
4823  }
4824  while ( piter )
4825  {
4826  for ( i= 1; i <= rVar(currRing); i++ )
4827  if ( (vpos != i) && (pGetExp( piter, i ) != 0) )
4828  {
4829  WerrorS("The input polynomial must be univariate!");
4830  return TRUE;
4831  }
4832  pIter( piter );
4833  }
4834  }
4835 
4836  rootContainer * roots= new rootContainer();
4837  number * pcoeffs= (number *)omAlloc( (deg+1) * sizeof( number ) );
4838  piter= gls;
4839  for ( i= deg; i >= 0; i-- )
4840  {
4841  if ( piter && pTotaldegree(piter) == i )
4842  {
4843  pcoeffs[i]= nCopy( pGetCoeff( piter ) );
4844  //nPrint( pcoeffs[i] );PrintS(" ");
4845  pIter( piter );
4846  }
4847  else
4848  {
4849  pcoeffs[i]= nInit(0);
4850  }
4851  }
4852 
4853 #ifdef mprDEBUG_PROT
4854  for (i=deg; i >= 0; i--)
4855  {
4856  nPrint( pcoeffs[i] );PrintS(" ");
4857  }
4858  PrintLn();
4859 #endif
4860 
4861  roots->fillContainer( pcoeffs, NULL, 1, deg, rootContainer::onepoly, 1 );
4862  roots->solver( howclean );
4863 
4864  int elem= roots->getAnzRoots();
4865  char *dummy;
4866  int j;
4867 
4868  lists rlist;
4869  rlist= (lists)omAlloc( sizeof(slists) );
4870  rlist->Init( elem );
4871 
4873  {
4874  for ( j= 0; j < elem; j++ )
4875  {
4876  rlist->m[j].rtyp=NUMBER_CMD;
4877  rlist->m[j].data=(void *)nCopy((number)(roots->getRoot(j)));
4878  //rlist->m[j].data=(void *)(number)(roots->getRoot(j));
4879  }
4880  }
4881  else
4882  {
4883  for ( j= 0; j < elem; j++ )
4884  {
4885  dummy = complexToStr( (*roots)[j], gmp_output_digits, currRing->cf );
4886  rlist->m[j].rtyp=STRING_CMD;
4887  rlist->m[j].data=(void *)dummy;
4888  }
4889  }
4890 
4891  elist->Clean();
4892  //omFreeSize( (ADDRESS) elist, sizeof(slists) );
4893 
4894  // this is (via fillContainer) the same data as in root
4895  //for ( i= deg; i >= 0; i-- ) nDelete( &pcoeffs[i] );
4896  //omFreeSize( (ADDRESS) pcoeffs, (deg+1) * sizeof( number ) );
4897 
4898  delete roots;
4899 
4900  res->data= (void*)rlist;
4901 
4902  return FALSE;
4903 }
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:520
static BOOLEAN rField_is_Zp(const ring r)
Definition: ring.h:502
static BOOLEAN rField_is_Q(const ring r)
Definition: ring.h:508

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

4740 {
4741  ideal gls = (ideal)(arg1->Data());
4742  int imtype= (int)(long)arg2->Data();
4743 
4744  uResultant::resMatType mtype= determineMType( imtype );
4745 
4746  // check input ideal ( = polynomial system )
4747  if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4748  {
4749  return TRUE;
4750  }
4751 
4752  uResultant *resMat= new uResultant( gls, mtype, false );
4753  if (resMat!=NULL)
4754  {
4755  res->rtyp = MODUL_CMD;
4756  res->data= (void*)resMat->accessResMat()->getMatrix();
4757  if (!errorreported) delete resMat;
4758  }
4759  return errorreported;
4760 }
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 5006 of file ipshell.cc.

5007 {
5008  leftv v= args;
5009 
5010  ideal gls;
5011  int imtype;
5012  int howclean;
5013 
5014  // get ideal
5015  if ( v->Typ() != IDEAL_CMD )
5016  return TRUE;
5017  else gls= (ideal)(v->Data());
5018  v= v->next;
5019 
5020  // get resultant matrix type to use (0,1)
5021  if ( v->Typ() != INT_CMD )
5022  return TRUE;
5023  else imtype= (int)(long)v->Data();
5024  v= v->next;
5025 
5026  if (imtype==0)
5027  {
5028  ideal test_id=idInit(1,1);
5029  int j;
5030  for(j=IDELEMS(gls)-1;j>=0;j--)
5031  {
5032  if (gls->m[j]!=NULL)
5033  {
5034  test_id->m[0]=gls->m[j];
5035  intvec *dummy_w=id_QHomWeight(test_id, currRing);
5036  if (dummy_w!=NULL)
5037  {
5038  WerrorS("Newton polytope not of expected dimension");
5039  delete dummy_w;
5040  return TRUE;
5041  }
5042  }
5043  }
5044  }
5045 
5046  // get and set precision in digits ( > 0 )
5047  if ( v->Typ() != INT_CMD )
5048  return TRUE;
5049  else if ( !(rField_is_R(currRing) || rField_is_long_R(currRing) || \
5051  {
5052  unsigned long int ii=(unsigned long int)v->Data();
5053  setGMPFloatDigits( ii, ii );
5054  }
5055  v= v->next;
5056 
5057  // get interpolation steps (0,1,2)
5058  if ( v->Typ() != INT_CMD )
5059  return TRUE;
5060  else howclean= (int)(long)v->Data();
5061 
5062  uResultant::resMatType mtype= determineMType( imtype );
5063  int i,count;
5064  lists listofroots= NULL;
5065  number smv= NULL;
5066  BOOLEAN interpolate_det= (mtype==uResultant::denseResMat)?TRUE:FALSE;
5067 
5068  //emptylist= (lists)omAlloc( sizeof(slists) );
5069  //emptylist->Init( 0 );
5070 
5071  //res->rtyp = LIST_CMD;
5072  //res->data= (void *)emptylist;
5073 
5074  // check input ideal ( = polynomial system )
5075  if ( mprIdealCheck( gls, args->Name(), mtype ) != mprOk )
5076  {
5077  return TRUE;
5078  }
5079 
5080  uResultant * ures;
5081  rootContainer ** iproots;
5082  rootContainer ** muiproots;
5083  rootArranger * arranger;
5084 
5085  // main task 1: setup of resultant matrix
5086  ures= new uResultant( gls, mtype );
5087  if ( ures->accessResMat()->initState() != resMatrixBase::ready )
5088  {
5089  WerrorS("Error occurred during matrix setup!");
5090  return TRUE;
5091  }
5092 
5093  // if dense resultant, check if minor nonsingular
5094  if ( mtype == uResultant::denseResMat )
5095  {
5096  smv= ures->accessResMat()->getSubDet();
5097 #ifdef mprDEBUG_PROT
5098  PrintS("// Determinant of submatrix: ");nPrint(smv);PrintLn();
5099 #endif
5100  if ( nIsZero(smv) )
5101  {
5102  WerrorS("Unsuitable input ideal: Minor of resultant matrix is singular!");
5103  return TRUE;
5104  }
5105  }
5106 
5107  // main task 2: Interpolate specialized resultant polynomials
5108  if ( interpolate_det )
5109  iproots= ures->interpolateDenseSP( false, smv );
5110  else
5111  iproots= ures->specializeInU( false, smv );
5112 
5113  // main task 3: Interpolate specialized resultant polynomials
5114  if ( interpolate_det )
5115  muiproots= ures->interpolateDenseSP( true, smv );
5116  else
5117  muiproots= ures->specializeInU( true, smv );
5118 
5119 #ifdef mprDEBUG_PROT
5120  int c= iproots[0]->getAnzElems();
5121  for (i=0; i < c; i++) pWrite(iproots[i]->getPoly());
5122  c= muiproots[0]->getAnzElems();
5123  for (i=0; i < c; i++) pWrite(muiproots[i]->getPoly());
5124 #endif
5125 
5126  // main task 4: Compute roots of specialized polys and match them up
5127  arranger= new rootArranger( iproots, muiproots, howclean );
5128  arranger->solve_all();
5129 
5130  // get list of roots
5131  if ( arranger->success() )
5132  {
5133  arranger->arrange();
5134  listofroots= listOfRoots(arranger, gmp_output_digits );
5135  }
5136  else
5137  {
5138  WerrorS("Solver was unable to find any roots!");
5139  return TRUE;
5140  }
5141 
5142  // free everything
5143  count= iproots[0]->getAnzElems();
5144  for (i=0; i < count; i++) delete iproots[i];
5145  omFreeSize( (ADDRESS) iproots, count * sizeof(rootContainer*) );
5146  count= muiproots[0]->getAnzElems();
5147  for (i=0; i < count; i++) delete muiproots[i];
5148  omFreeSize( (ADDRESS) muiproots, count * sizeof(rootContainer*) );
5149 
5150  delete ures;
5151  delete arranger;
5152  nDelete( &smv );
5153 
5154  res->data= (void *)listofroots;
5155 
5156  //emptylist->Clean();
5157  // omFreeSize( (ADDRESS) emptylist, sizeof(slists) );
5158 
5159  return FALSE;
5160 }
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:5163
#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 4905 of file ipshell.cc.

4906 {
4907  int i;
4908  ideal p,w;
4909  p= (ideal)arg1->Data();
4910  w= (ideal)arg2->Data();
4911 
4912  // w[0] = f(p^0)
4913  // w[1] = f(p^1)
4914  // ...
4915  // p can be a vector of numbers (multivariate polynom)
4916  // or one number (univariate polynom)
4917  // tdg = deg(f)
4918 
4919  int n= IDELEMS( p );
4920  int m= IDELEMS( w );
4921  int tdg= (int)(long)arg3->Data();
4922 
4923  res->data= (void*)NULL;
4924 
4925  // check the input
4926  if ( tdg < 1 )
4927  {
4928  WerrorS("Last input parameter must be > 0!");
4929  return TRUE;
4930  }
4931  if ( n != rVar(currRing) )
4932  {
4933  Werror("Size of first input ideal must be equal to %d!",rVar(currRing));
4934  return TRUE;
4935  }
4936  if ( m != (int)pow((double)tdg+1,(double)n) )
4937  {
4938  Werror("Size of second input ideal must be equal to %d!",
4939  (int)pow((double)tdg+1,(double)n));
4940  return TRUE;
4941  }
4942  if ( !(rField_is_Q(currRing) /* ||
4943  rField_is_R() || rField_is_long_R() ||
4944  rField_is_long_C()*/ ) )
4945  {
4946  WerrorS("Ground field not implemented!");
4947  return TRUE;
4948  }
4949 
4950  number tmp;
4951  number *pevpoint= (number *)omAlloc( n * sizeof( number ) );
4952  for ( i= 0; i < n; i++ )
4953  {
4954  pevpoint[i]=nInit(0);
4955  if ( (p->m)[i] )
4956  {
4957  tmp = pGetCoeff( (p->m)[i] );
4958  if ( nIsZero(tmp) || nIsOne(tmp) || nIsMOne(tmp) )
4959  {
4960  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4961  WerrorS("Elements of first input ideal must not be equal to -1, 0, 1!");
4962  return TRUE;
4963  }
4964  } else tmp= NULL;
4965  if ( !nIsZero(tmp) )
4966  {
4967  if ( !pIsConstant((p->m)[i]))
4968  {
4969  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4970  WerrorS("Elements of first input ideal must be numbers!");
4971  return TRUE;
4972  }
4973  pevpoint[i]= nCopy( tmp );
4974  }
4975  }
4976 
4977  number *wresults= (number *)omAlloc( m * sizeof( number ) );
4978  for ( i= 0; i < m; i++ )
4979  {
4980  wresults[i]= nInit(0);
4981  if ( (w->m)[i] && !nIsZero(pGetCoeff((w->m)[i])) )
4982  {
4983  if ( !pIsConstant((w->m)[i]))
4984  {
4985  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
4986  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
4987  WerrorS("Elements of second input ideal must be numbers!");
4988  return TRUE;
4989  }
4990  wresults[i]= nCopy(pGetCoeff((w->m)[i]));
4991  }
4992  }
4993 
4994  vandermonde vm( m, n, tdg, pevpoint, FALSE );
4995  number *ncpoly= vm.interpolateDense( wresults );
4996  // do not free ncpoly[]!!
4997  poly rpoly= vm.numvec2poly( ncpoly );
4998 
4999  omFreeSize( (ADDRESS)pevpoint, n * sizeof( number ) );
5000  omFreeSize( (ADDRESS)wresults, m * sizeof( number ) );
5001 
5002  res->data= (void*)rpoly;
5003  return FALSE;
5004 }
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 6408 of file ipshell.cc.

6409 {
6410  Print(" %s (",n);
6411  switch (p->language)
6412  {
6413  case LANG_SINGULAR: PrintS("S"); break;
6414  case LANG_C: PrintS("C"); break;
6415  case LANG_TOP: PrintS("T"); break;
6416  case LANG_MAX: PrintS("M"); break;
6417  case LANG_NONE: PrintS("N"); break;
6418  default: PrintS("U");
6419  }
6420  if(p->libname!=NULL)
6421  Print(",%s", p->libname);
6422  PrintS(")");
6423 }
@ 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 2868 of file ipshell.cc.

2869 {
2870  if ((L->nr!=3)
2871 #ifdef HAVE_PLURAL
2872  &&(L->nr!=5)
2873 #endif
2874  )
2875  return NULL;
2876  int is_gf_char=0;
2877  // 0: char/ cf - ring
2878  // 1: list (var)
2879  // 2: list (ord)
2880  // 3: qideal
2881  // possibly:
2882  // 4: C
2883  // 5: D
2884 
2885  ring R = (ring) omAlloc0Bin(sip_sring_bin);
2886 
2887  // ------------------------------------------------------------------
2888  // 0: char:
2889  if (L->m[0].Typ()==CRING_CMD)
2890  {
2891  R->cf=(coeffs)L->m[0].Data();
2892  R->cf->ref++;
2893  }
2894  else if (L->m[0].Typ()==INT_CMD)
2895  {
2896  int ch = (int)(long)L->m[0].Data();
2897  assume( ch >= 0 );
2898 
2899  if (ch == 0) // Q?
2900  R->cf = nInitChar(n_Q, NULL);
2901  else
2902  {
2903  int l = IsPrime(ch); // Zp?
2904  if( l != ch )
2905  {
2906  Warn("%d is invalid characteristic of ground field. %d is used.", ch, l);
2907  ch = l;
2908  }
2909  #ifndef TEST_ZN_AS_ZP
2910  R->cf = nInitChar(n_Zp, (void*)(long)ch);
2911  #else
2912  mpz_t modBase;
2913  mpz_init_set_ui(modBase,(long) ch);
2914  ZnmInfo info;
2915  info.base= modBase;
2916  info.exp= 1;
2917  R->cf=nInitChar(n_Zn,(void*) &info); //exponent is missing
2918  R->cf->is_field=1;
2919  R->cf->is_domain=1;
2920  R->cf->has_simple_Inverse=1;
2921  #endif
2922  }
2923  }
2924  else if (L->m[0].Typ()==LIST_CMD) // something complicated...
2925  {
2926  lists LL=(lists)L->m[0].Data();
2927 
2928 #ifdef HAVE_RINGS
2929  if (LL->m[0].Typ() == STRING_CMD) // 1st comes a string?
2930  {
2931  rComposeRing(LL, R); // Ring!?
2932  }
2933  else
2934 #endif
2935  if (LL->nr < 3)
2936  rComposeC(LL,R); // R, long_R, long_C
2937  else
2938  {
2939  if (LL->m[0].Typ()==INT_CMD)
2940  {
2941  int ch = (int)(long)LL->m[0].Data();
2942  while ((ch!=fftable[is_gf_char]) && (fftable[is_gf_char])) is_gf_char++;
2943  if (fftable[is_gf_char]==0) is_gf_char=-1;
2944 
2945  if(is_gf_char!= -1)
2946  {
2947  GFInfo param;
2948 
2949  param.GFChar = ch;
2950  param.GFDegree = 1;
2951  param.GFPar_name = (const char*)(((lists)(LL->m[1].Data()))->m[0].Data());
2952 
2953  // nfInitChar should be able to handle the case when ch is in fftables!
2954  R->cf = nInitChar(n_GF, (void*)&param);
2955  }
2956  }
2957 
2958  if( R->cf == NULL )
2959  {
2960  ring extRing = rCompose((lists)L->m[0].Data(),FALSE,0x7fff);
2961 
2962  if (extRing==NULL)
2963  {
2964  WerrorS("could not create the specified coefficient field");
2965  goto rCompose_err;
2966  }
2967 
2968  if( extRing->qideal != NULL ) // Algebraic extension
2969  {
2970  AlgExtInfo extParam;
2971 
2972  extParam.r = extRing;
2973 
2974  R->cf = nInitChar(n_algExt, (void*)&extParam);
2975  }
2976  else // Transcendental extension
2977  {
2978  TransExtInfo extParam;
2979  extParam.r = extRing;
2980  assume( extRing->qideal == NULL );
2981 
2982  R->cf = nInitChar(n_transExt, &extParam);
2983  }
2984  }
2985  }
2986  }
2987  else
2988  {
2989  WerrorS("coefficient field must be described by `int` or `list`");
2990  goto rCompose_err;
2991  }
2992 
2993  if( R->cf == NULL )
2994  {
2995  WerrorS("could not create coefficient field described by the input!");
2996  goto rCompose_err;
2997  }
2998 
2999  // ------------------------- VARS ---------------------------
3000  if (rComposeVar(L,R)) goto rCompose_err;
3001  // ------------------------ ORDER ------------------------------
3002  if (rComposeOrder(L,check_comp,R)) goto rCompose_err;
3003 
3004  // ------------------------ ??????? --------------------
3005 
3006  if (!isLetterplace) rRenameVars(R);
3007  #ifdef HAVE_SHIFTBBA
3008  else
3009  {
3010  R->isLPring=isLetterplace;
3011  R->ShortOut=FALSE;
3012  R->CanShortOut=FALSE;
3013  }
3014  #endif
3015  if ((bitmask!=0)&&(R->wanted_maxExp==0)) R->wanted_maxExp=bitmask;
3016  rComplete(R);
3017 
3018  // ------------------------ Q-IDEAL ------------------------
3019 
3020  if (L->m[3].Typ()==IDEAL_CMD)
3021  {
3022  ideal q=(ideal)L->m[3].Data();
3023  if (q->m[0]!=NULL)
3024  {
3025  if (R->cf != currRing->cf) //->cf->ch!=currRing->cf->ch)
3026  {
3027  #if 0
3028  WerrorS("coefficient fields must be equal if q-ideal !=0");
3029  goto rCompose_err;
3030  #else
3031  ring orig_ring=currRing;
3032  rChangeCurrRing(R);
3033  int *perm=NULL;
3034  int *par_perm=NULL;
3035  int par_perm_size=0;
3036  nMapFunc nMap;
3037 
3038  if ((nMap=nSetMap(orig_ring->cf))==NULL)
3039  {
3040  if (rEqual(orig_ring,currRing))
3041  {
3042  nMap=n_SetMap(currRing->cf, currRing->cf);
3043  }
3044  else
3045  // Allow imap/fetch to be make an exception only for:
3046  if ( (rField_is_Q_a(orig_ring) && // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
3050  ||
3051  (rField_is_Zp_a(orig_ring) && // Zp(a..) -> Zp(a..) || Zp
3052  (rField_is_Zp(currRing, rInternalChar(orig_ring)) ||
3053  rField_is_Zp_a(currRing, rInternalChar(orig_ring)))) )
3054  {
3055  par_perm_size=rPar(orig_ring);
3056 
3057 // if ((orig_ring->minpoly != NULL) || (orig_ring->qideal != NULL))
3058 // naSetChar(rInternalChar(orig_ring),orig_ring);
3059 // else ntSetChar(rInternalChar(orig_ring),orig_ring);
3060 
3061  nSetChar(currRing->cf);
3062  }
3063  else
3064  {
3065  WerrorS("coefficient fields must be equal if q-ideal !=0");
3066  goto rCompose_err;
3067  }
3068  }
3069  perm=(int *)omAlloc0((orig_ring->N+1)*sizeof(int));
3070  if (par_perm_size!=0)
3071  par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
3072  int i;
3073  #if 0
3074  // use imap:
3075  maFindPerm(orig_ring->names,orig_ring->N,orig_ring->parameter,orig_ring->P,
3076  currRing->names,currRing->N,currRing->parameter, currRing->P,
3077  perm,par_perm, currRing->ch);
3078  #else
3079  // use fetch
3080  if ((rPar(orig_ring)>0) && (rPar(currRing)==0))
3081  {
3082  for(i=si_min(rPar(orig_ring),rVar(currRing))-1;i>=0;i--) par_perm[i]=i+1;
3083  }
3084  else if (par_perm_size!=0)
3085  for(i=si_min(rPar(orig_ring),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
3086  for(i=si_min(orig_ring->N,rVar(currRing));i>0;i--) perm[i]=i;
3087  #endif
3088  ideal dest_id=idInit(IDELEMS(q),1);
3089  for(i=IDELEMS(q)-1; i>=0; i--)
3090  {
3091  dest_id->m[i]=p_PermPoly(q->m[i],perm,orig_ring, currRing,nMap,
3092  par_perm,par_perm_size);
3093  // PrintS("map:");pWrite(dest_id->m[i]);PrintLn();
3094  pTest(dest_id->m[i]);
3095  }
3096  R->qideal=dest_id;
3097  if (perm!=NULL)
3098  omFreeSize((ADDRESS)perm,(orig_ring->N+1)*sizeof(int));
3099  if (par_perm!=NULL)
3100  omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
3101  rChangeCurrRing(orig_ring);
3102  #endif
3103  }
3104  else
3105  R->qideal=idrCopyR(q,currRing,R);
3106  }
3107  }
3108  else
3109  {
3110  WerrorS("q-ideal must be given as `ideal`");
3111  goto rCompose_err;
3112  }
3113 
3114 
3115  // ---------------------------------------------------------------
3116  #ifdef HAVE_PLURAL
3117  if (L->nr==5)
3118  {
3119  if (nc_CallPlural((matrix)L->m[4].Data(),
3120  (matrix)L->m[5].Data(),
3121  NULL,NULL,
3122  R,
3123  true, // !!!
3124  true, false,
3125  currRing, FALSE)) goto rCompose_err;
3126  // takes care about non-comm. quotient! i.e. calls "nc_SetupQuotient" due to last true
3127  }
3128  #endif
3129  return R;
3130 
3131 rCompose_err:
3132  if (R->N>0)
3133  {
3134  int i;
3135  if (R->names!=NULL)
3136  {
3137  i=R->N-1;
3138  while (i>=0) { omfree(R->names[i]); i--; }
3139  omFree(R->names);
3140  }
3141  }
3142  omfree(R->order);
3143  omfree(R->block0);
3144  omfree(R->block1);
3145  omfree(R->wvhdl);
3146  omFree(R);
3147  return NULL;
3148 }
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:2490
void rComposeC(lists L, ring R)
Definition: ipshell.cc:2345
static BOOLEAN rComposeOrder(const lists L, const BOOLEAN check_comp, ring R)
Definition: ipshell.cc:2576
ring rCompose(const lists L, const BOOLEAN check_comp, const long bitmask, const int isLetterplace)
Definition: ipshell.cc:2868
void rComposeRing(lists L, ring R)
Definition: ipshell.cc:2397
static BOOLEAN rComposeVar(const lists L, ring R)
Definition: ipshell.cc:2531
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:4158
#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:3400
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:1660
static BOOLEAN rField_is_Zp_a(const ring r)
Definition: ring.h:531
static BOOLEAN rField_is_Zn(const ring r)
Definition: ring.h:514
static int rPar(const ring r)
(r->cf->P)
Definition: ring.h:601
static int rInternalChar(const ring r)
Definition: ring.h:691
static BOOLEAN rField_is_Q_a(const ring r)
Definition: ring.h:541
struct for passing initialization parameters to naInitChar
Definition: transext.h:88

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2157 of file ipshell.cc.

2158 {
2159  assume( r != NULL );
2160  const coeffs C = r->cf;
2161  assume( C != NULL );
2162 
2163  // sanity check: require currRing==r for rings with polynomial data
2164  if ( (r!=currRing) && (
2165  (nCoeff_is_algExt(C) && (C != currRing->cf))
2166  || (r->qideal != NULL)
2167 #ifdef HAVE_PLURAL
2168  || (rIsPluralRing(r))
2169 #endif
2170  )
2171  )
2172  {
2173  WerrorS("ring with polynomial data must be the base ring or compatible");
2174  return NULL;
2175  }
2176  // 0: char/ cf - ring
2177  // 1: list (var)
2178  // 2: list (ord)
2179  // 3: qideal
2180  // possibly:
2181  // 4: C
2182  // 5: D
2184  if (rIsPluralRing(r))
2185  L->Init(6);
2186  else
2187  L->Init(4);
2188  // ----------------------------------------
2189  // 0: char/ cf - ring
2190  if (rField_is_numeric(r))
2191  {
2192  rDecomposeC(&(L->m[0]),r);
2193  }
2194  else if (rField_is_Ring(r))
2195  {
2196  rDecomposeRing(&(L->m[0]),r);
2197  }
2198  else if ( r->cf->extRing!=NULL )// nCoeff_is_algExt(r->cf))
2199  {
2200  rDecomposeCF(&(L->m[0]), r->cf->extRing, r);
2201  }
2202  else if(rField_is_GF(r))
2203  {
2205  Lc->Init(4);
2206  // char:
2207  Lc->m[0].rtyp=INT_CMD;
2208  Lc->m[0].data=(void*)(long)r->cf->m_nfCharQ;
2209  // var:
2211  Lv->Init(1);
2212  Lv->m[0].rtyp=STRING_CMD;
2213  Lv->m[0].data=(void *)omStrDup(*rParameter(r));
2214  Lc->m[1].rtyp=LIST_CMD;
2215  Lc->m[1].data=(void*)Lv;
2216  // ord:
2218  Lo->Init(1);
2220  Loo->Init(2);
2221  Loo->m[0].rtyp=STRING_CMD;
2222  Loo->m[0].data=(void *)omStrDup(rSimpleOrdStr(ringorder_lp));
2223 
2224  intvec *iv=new intvec(1); (*iv)[0]=1;
2225  Loo->m[1].rtyp=INTVEC_CMD;
2226  Loo->m[1].data=(void *)iv;
2227 
2228  Lo->m[0].rtyp=LIST_CMD;
2229  Lo->m[0].data=(void*)Loo;
2230 
2231  Lc->m[2].rtyp=LIST_CMD;
2232  Lc->m[2].data=(void*)Lo;
2233  // q-ideal:
2234  Lc->m[3].rtyp=IDEAL_CMD;
2235  Lc->m[3].data=(void *)idInit(1,1);
2236  // ----------------------
2237  L->m[0].rtyp=LIST_CMD;
2238  L->m[0].data=(void*)Lc;
2239  }
2240  else
2241  {
2242  L->m[0].rtyp=INT_CMD;
2243  L->m[0].data=(void *)(long)r->cf->ch;
2244  }
2245  // ----------------------------------------
2246  // 1: list (var)
2248  LL->Init(r->N);
2249  int i;
2250  for(i=0; i<r->N; i++)
2251  {
2252  LL->m[i].rtyp=STRING_CMD;
2253  LL->m[i].data=(void *)omStrDup(r->names[i]);
2254  }
2255  L->m[1].rtyp=LIST_CMD;
2256  L->m[1].data=(void *)LL;
2257  // ----------------------------------------
2258  // 2: list (ord)
2260  i=rBlocks(r)-1;
2261  LL->Init(i);
2262  i--;
2263  lists LLL;
2264  for(; i>=0; i--)
2265  {
2266  intvec *iv;
2267  int j;
2268  LL->m[i].rtyp=LIST_CMD;
2270  LLL->Init(2);
2271  LLL->m[0].rtyp=STRING_CMD;
2272  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2273 
2274  if((r->order[i] == ringorder_IS)
2275  || (r->order[i] == ringorder_s)) //|| r->order[i] == ringorder_S)
2276  {
2277  assume( r->block0[i] == r->block1[i] );
2278  const int s = r->block0[i];
2279  assume( (-2 < s && s < 2)||(r->order[i] != ringorder_IS));
2280 
2281  iv=new intvec(1);
2282  (*iv)[0] = s;
2283  }
2284  else if (r->block1[i]-r->block0[i] >=0 )
2285  {
2286  int bl=j=r->block1[i]-r->block0[i];
2287  if (r->order[i]==ringorder_M)
2288  {
2289  j=(j+1)*(j+1)-1;
2290  bl=j+1;
2291  }
2292  else if (r->order[i]==ringorder_am)
2293  {
2294  j+=r->wvhdl[i][bl+1];
2295  }
2296  iv=new intvec(j+1);
2297  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2298  {
2299  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2300  }
2301  else switch (r->order[i])
2302  {
2303  case ringorder_dp:
2304  case ringorder_Dp:
2305  case ringorder_ds:
2306  case ringorder_Ds:
2307  case ringorder_lp:
2308  case ringorder_ls:
2309  case ringorder_rp:
2310  for(;j>=0; j--) (*iv)[j]=1;
2311  break;
2312  default: /* do nothing */;
2313  }
2314  }
2315  else
2316  {
2317  iv=new intvec(1);
2318  }
2319  LLL->m[1].rtyp=INTVEC_CMD;
2320  LLL->m[1].data=(void *)iv;
2321  LL->m[i].data=(void *)LLL;
2322  }
2323  L->m[2].rtyp=LIST_CMD;
2324  L->m[2].data=(void *)LL;
2325  // ----------------------------------------
2326  // 3: qideal
2327  L->m[3].rtyp=IDEAL_CMD;
2328  if (r->qideal==NULL)
2329  L->m[3].data=(void *)idInit(1,1);
2330  else
2331  L->m[3].data=(void *)idCopy(r->qideal);
2332  // ----------------------------------------
2333 #ifdef HAVE_PLURAL // NC! in rDecompose
2334  if (rIsPluralRing(r))
2335  {
2336  L->m[4].rtyp=MATRIX_CMD;
2337  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2338  L->m[5].rtyp=MATRIX_CMD;
2339  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2340  }
2341 #endif
2342  return L;
2343 }
CanonicalForm Lc(const CanonicalForm &f)
static void rDecomposeC(leftv h, const ring R)
Definition: ipshell.cc:1859
void rDecomposeCF(leftv h, const ring r, const ring R)
Definition: ipshell.cc:1735
void rDecomposeRing(leftv h, const ring R)
Definition: ipshell.cc:1923
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:627
@ 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:517
static BOOLEAN rField_is_GF(const ring r)
Definition: ring.h:523

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1955 of file ipshell.cc.

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

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 2026 of file ipshell.cc.

2027 {
2028  assume( r != NULL );
2029  const coeffs C = r->cf;
2030  assume( C != NULL );
2031 
2032  // sanity check: require currRing==r for rings with polynomial data
2033  if ( (r!=currRing) && (
2034  (r->qideal != NULL)
2035 #ifdef HAVE_PLURAL
2036  || (rIsPluralRing(r))
2037 #endif
2038  )
2039  )
2040  {
2041  WerrorS("ring with polynomial data must be the base ring or compatible");
2042  return NULL;
2043  }
2044  // 0: char/ cf - ring
2045  // 1: list (var)
2046  // 2: list (ord)
2047  // 3: qideal
2048  // possibly:
2049  // 4: C
2050  // 5: D
2052  if (rIsPluralRing(r))
2053  L->Init(6);
2054  else
2055  L->Init(4);
2056  // ----------------------------------------
2057  // 0: char/ cf - ring
2058  L->m[0].rtyp=CRING_CMD;
2059  L->m[0].data=(char*)r->cf; r->cf->ref++;
2060  // ----------------------------------------
2061  // 1: list (var)
2063  LL->Init(r->N);
2064  int i;
2065  for(i=0; i<r->N; i++)
2066  {
2067  LL->m[i].rtyp=STRING_CMD;
2068  LL->m[i].data=(void *)omStrDup(r->names[i]);
2069  }
2070  L->m[1].rtyp=LIST_CMD;
2071  L->m[1].data=(void *)LL;
2072  // ----------------------------------------
2073  // 2: list (ord)
2075  i=rBlocks(r)-1;
2076  LL->Init(i);
2077  i--;
2078  lists LLL;
2079  for(; i>=0; i--)
2080  {
2081  intvec *iv;
2082  int j;
2083  LL->m[i].rtyp=LIST_CMD;
2085  LLL->Init(2);
2086  LLL->m[0].rtyp=STRING_CMD;
2087  LLL->m[0].data=(void *)omStrDup(rSimpleOrdStr(r->order[i]));
2088 
2089  if(r->order[i] == ringorder_IS) // || r->order[i] == ringorder_s || r->order[i] == ringorder_S)
2090  {
2091  assume( r->block0[i] == r->block1[i] );
2092  const int s = r->block0[i];
2093  assume( -2 < s && s < 2);
2094 
2095  iv=new intvec(1);
2096  (*iv)[0] = s;
2097  }
2098  else if (r->block1[i]-r->block0[i] >=0 )
2099  {
2100  int bl=j=r->block1[i]-r->block0[i];
2101  if (r->order[i]==ringorder_M)
2102  {
2103  j=(j+1)*(j+1)-1;
2104  bl=j+1;
2105  }
2106  else if (r->order[i]==ringorder_am)
2107  {
2108  j+=r->wvhdl[i][bl+1];
2109  }
2110  iv=new intvec(j+1);
2111  if ((r->wvhdl!=NULL) && (r->wvhdl[i]!=NULL))
2112  {
2113  for(;j>=0; j--) (*iv)[j]=r->wvhdl[i][j+(j>bl)];
2114  }
2115  else switch (r->order[i])
2116  {
2117  case ringorder_dp:
2118  case ringorder_Dp:
2119  case ringorder_ds:
2120  case ringorder_Ds:
2121  case ringorder_lp:
2122  for(;j>=0; j--) (*iv)[j]=1;
2123  break;
2124  default: /* do nothing */;
2125  }
2126  }
2127  else
2128  {
2129  iv=new intvec(1);
2130  }
2131  LLL->m[1].rtyp=INTVEC_CMD;
2132  LLL->m[1].data=(void *)iv;
2133  LL->m[i].data=(void *)LLL;
2134  }
2135  L->m[2].rtyp=LIST_CMD;
2136  L->m[2].data=(void *)LL;
2137  // ----------------------------------------
2138  // 3: qideal
2139  L->m[3].rtyp=IDEAL_CMD;
2140  if (r->qideal==NULL)
2141  L->m[3].data=(void *)idInit(1,1);
2142  else
2143  L->m[3].data=(void *)idCopy(r->qideal);
2144  // ----------------------------------------
2145 #ifdef HAVE_PLURAL // NC! in rDecompose
2146  if (rIsPluralRing(r))
2147  {
2148  L->m[4].rtyp=MATRIX_CMD;
2149  L->m[4].data=(void *)mp_Copy(r->GetNC()->C, r, r);
2150  L->m[5].rtyp=MATRIX_CMD;
2151  L->m[5].data=(void *)mp_Copy(r->GetNC()->D, r, r);
2152  }
2153 #endif
2154  return L;
2155 }

◆ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1650 of file ipshell.cc.

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

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

◆ rInit()

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

Definition at line 5709 of file ipshell.cc.

5710 {
5711  int float_len=0;
5712  int float_len2=0;
5713  ring R = NULL;
5714  //BOOLEAN ffChar=FALSE;
5715 
5716  /* ch -------------------------------------------------------*/
5717  // get ch of ground field
5718 
5719  // allocated ring
5720  R = (ring) omAlloc0Bin(sip_sring_bin);
5721 
5722  coeffs cf = NULL;
5723 
5724  assume( pn != NULL );
5725  const int P = pn->listLength();
5726 
5727  if (pn->Typ()==CRING_CMD)
5728  {
5729  cf=(coeffs)pn->CopyD();
5730  leftv pnn=pn;
5731  if(P>1) /*parameter*/
5732  {
5733  pnn = pnn->next;
5734  const int pars = pnn->listLength();
5735  assume( pars > 0 );
5736  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5737 
5738  if (rSleftvList2StringArray(pnn, names))
5739  {
5740  WerrorS("parameter expected");
5741  goto rInitError;
5742  }
5743 
5744  TransExtInfo extParam;
5745 
5746  extParam.r = rDefault( cf, pars, names); // Q/Zp [ p_1, ... p_pars ]
5747  for(int i=pars-1; i>=0;i--)
5748  {
5749  omFree(names[i]);
5750  }
5751  omFree(names);
5752 
5753  cf = nInitChar(n_transExt, &extParam);
5754  }
5755  assume( cf != NULL );
5756  }
5757  else if (pn->Typ()==INT_CMD)
5758  {
5759  int ch = (int)(long)pn->Data();
5760  leftv pnn=pn;
5761 
5762  /* parameter? -------------------------------------------------------*/
5763  pnn = pnn->next;
5764 
5765  if (pnn == NULL) // no params!?
5766  {
5767  if (ch!=0)
5768  {
5769  int ch2=IsPrime(ch);
5770  if ((ch<2)||(ch!=ch2))
5771  {
5772  Warn("%d is invalid as characteristic of the ground field. 32003 is used.", ch);
5773  ch=32003;
5774  }
5775  #ifndef TEST_ZN_AS_ZP
5776  cf = nInitChar(n_Zp, (void*)(long)ch);
5777  #else
5778  mpz_t modBase;
5779  mpz_init_set_ui(modBase, (long)ch);
5780  ZnmInfo info;
5781  info.base= modBase;
5782  info.exp= 1;
5783  cf=nInitChar(n_Zn,(void*) &info);
5784  cf->is_field=1;
5785  cf->is_domain=1;
5786  cf->has_simple_Inverse=1;
5787  #endif
5788  }
5789  else
5790  cf = nInitChar(n_Q, (void*)(long)ch);
5791  }
5792  else
5793  {
5794  const int pars = pnn->listLength();
5795 
5796  assume( pars > 0 );
5797 
5798  // predefined finite field: (p^k, a)
5799  if ((ch!=0) && (ch!=IsPrime(ch)) && (pars == 1))
5800  {
5801  GFInfo param;
5802 
5803  param.GFChar = ch;
5804  param.GFDegree = 1;
5805  param.GFPar_name = pnn->name;
5806 
5807  cf = nInitChar(n_GF, &param);
5808  }
5809  else // (0/p, a, b, ..., z)
5810  {
5811  if ((ch!=0) && (ch!=IsPrime(ch)))
5812  {
5813  WerrorS("too many parameters");
5814  goto rInitError;
5815  }
5816 
5817  char ** names = (char**)omAlloc0(pars * sizeof(char_ptr));
5818 
5819  if (rSleftvList2StringArray(pnn, names))
5820  {
5821  WerrorS("parameter expected");
5822  goto rInitError;
5823  }
5824 
5825  TransExtInfo extParam;
5826 
5827  extParam.r = rDefault( ch, pars, names); // Q/Zp [ p_1, ... p_pars ]
5828  for(int i=pars-1; i>=0;i--)
5829  {
5830  omFree(names[i]);
5831  }
5832  omFree(names);
5833 
5834  cf = nInitChar(n_transExt, &extParam);
5835  }
5836  }
5837 
5838  //if (cf==NULL) ->Error: Invalid ground field specification
5839  }
5840  else if ((pn->name != NULL)
5841  && ((strcmp(pn->name,"real")==0) || (strcmp(pn->name,"complex")==0)))
5842  {
5843  leftv pnn=pn->next;
5844  BOOLEAN complex_flag=(strcmp(pn->name,"complex")==0);
5845  if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5846  {
5847  float_len=(int)(long)pnn->Data();
5848  float_len2=float_len;
5849  pnn=pnn->next;
5850  if ((pnn!=NULL) && (pnn->Typ()==INT_CMD))
5851  {
5852  float_len2=(int)(long)pnn->Data();
5853  pnn=pnn->next;
5854  }
5855  }
5856 
5857  if (!complex_flag)
5858  complex_flag= (pnn!=NULL) && (pnn->name!=NULL);
5859  if( !complex_flag && (float_len2 <= (short)SHORT_REAL_LENGTH))
5860  cf=nInitChar(n_R, NULL);
5861  else // longR or longC?
5862  {
5863  LongComplexInfo param;
5864 
5865  param.float_len = si_min (float_len, 32767);
5866  param.float_len2 = si_min (float_len2, 32767);
5867 
5868  // set the parameter name
5869  if (complex_flag)
5870  {
5871  if (param.float_len < SHORT_REAL_LENGTH)
5872  {
5875  }
5876  if ((pnn == NULL) || (pnn->name == NULL))
5877  param.par_name=(const char*)"i"; //default to i
5878  else
5879  param.par_name = (const char*)pnn->name;
5880  }
5881 
5882  cf = nInitChar(complex_flag ? n_long_C: n_long_R, (void*)&param);
5883  }
5884  assume( cf != NULL );
5885  }
5886 #ifdef HAVE_RINGS
5887  else if ((pn->name != NULL) && (strcmp(pn->name, "integer") == 0))
5888  {
5889  // TODO: change to use coeffs_BIGINT!?
5890  mpz_t modBase;
5891  unsigned int modExponent = 1;
5892  mpz_init_set_si(modBase, 0);
5893  if (pn->next!=NULL)
5894  {
5895  leftv pnn=pn;
5896  if (pnn->next->Typ()==INT_CMD)
5897  {
5898  pnn=pnn->next;
5899  mpz_set_ui(modBase, (long) pnn->Data());
5900  if ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5901  {
5902  pnn=pnn->next;
5903  modExponent = (long) pnn->Data();
5904  }
5905  while ((pnn->next!=NULL) && (pnn->next->Typ()==INT_CMD))
5906  {
5907  pnn=pnn->next;
5908  mpz_mul_ui(modBase, modBase, (int)(long) pnn->Data());
5909  }
5910  }
5911  else if (pnn->next->Typ()==BIGINT_CMD)
5912  {
5913  number p=(number)pnn->next->CopyD();
5914  n_MPZ(modBase,p,coeffs_BIGINT);
5916  }
5917  }
5918  else
5919  cf=nInitChar(n_Z,NULL);
5920 
5921  if ((mpz_cmp_ui(modBase, 1) == 0) && (mpz_sgn1(modBase) < 0))
5922  {
5923  WerrorS("Wrong ground ring specification (module is 1)");
5924  goto rInitError;
5925  }
5926  if (modExponent < 1)
5927  {
5928  WerrorS("Wrong ground ring specification (exponent smaller than 1");
5929  goto rInitError;
5930  }
5931  // module is 0 ---> integers ringtype = 4;
5932  // we have an exponent
5933  if (modExponent > 1 && cf == NULL)
5934  {
5935  if ((mpz_cmp_ui(modBase, 2) == 0) && (modExponent <= 8*sizeof(unsigned long)))
5936  {
5937  /* this branch should be active for modExponent = 2..32 resp. 2..64,
5938  depending on the size of a long on the respective platform */
5939  //ringtype = 1; // Use Z/2^ch
5940  cf=nInitChar(n_Z2m,(void*)(long)modExponent);
5941  }
5942  else
5943  {
5944  if (mpz_sgn1(modBase)==0)
5945  {
5946  WerrorS("modulus must not be 0 or parameter not allowed");
5947  goto rInitError;
5948  }
5949  //ringtype = 3;
5950  ZnmInfo info;
5951  info.base= modBase;
5952  info.exp= modExponent;
5953  cf=nInitChar(n_Znm,(void*) &info); //exponent is missing
5954  }
5955  }
5956  // just a module m > 1
5957  else if (cf == NULL)
5958  {
5959  if (mpz_sgn1(modBase)==0)
5960  {
5961  WerrorS("modulus must not be 0 or parameter not allowed");
5962  goto rInitError;
5963  }
5964  //ringtype = 2;
5965  ZnmInfo info;
5966  info.base= modBase;
5967  info.exp= modExponent;
5968  cf=nInitChar(n_Zn,(void*) &info);
5969  }
5970  assume( cf != NULL );
5971  mpz_clear(modBase);
5972  }
5973 #endif
5974  // ring NEW = OLD, (), (); where OLD is a polynomial ring...
5975  else if ((pn->Typ()==RING_CMD) && (P == 1))
5976  {
5977  TransExtInfo extParam;
5978  extParam.r = (ring)pn->Data();
5979  extParam.r->ref++;
5980  cf = nInitChar(n_transExt, &extParam);
5981  }
5982  //else if ((pn->Typ()==QRING_CMD) && (P == 1)) // same for qrings - which should be fields!?
5983  //{
5984  // AlgExtInfo extParam;
5985  // extParam.r = (ring)pn->Data();
5986 
5987  // cf = nInitChar(n_algExt, &extParam); // Q[a]/<minideal>
5988  //}
5989  else
5990  {
5991  WerrorS("Wrong or unknown ground field specification");
5992 #if 0
5993 // debug stuff for unknown cf descriptions:
5994  sleftv* p = pn;
5995  while (p != NULL)
5996  {
5997  Print( "pn[%p]: type: %d [%s]: %p, name: %s", (void*)p, p->Typ(), Tok2Cmdname(p->Typ()), p->Data(), (p->name == NULL? "NULL" : p->name) );
5998  PrintLn();
5999  p = p->next;
6000  }
6001 #endif
6002  goto rInitError;
6003  }
6004 
6005  /*every entry in the new ring is initialized to 0*/
6006 
6007  /* characteristic -----------------------------------------------*/
6008  /* input: 0 ch=0 : Q parameter=NULL ffChar=FALSE float_len
6009  * 0 1 : Q(a,...) *names FALSE
6010  * 0 -1 : R NULL FALSE 0
6011  * 0 -1 : R NULL FALSE prec. >6
6012  * 0 -1 : C *names FALSE prec. 0..?
6013  * p p : Fp NULL FALSE
6014  * p -p : Fp(a) *names FALSE
6015  * q q : GF(q=p^n) *names TRUE
6016  */
6017  if (cf==NULL)
6018  {
6019  WerrorS("Invalid ground field specification");
6020  goto rInitError;
6021 // const int ch=32003;
6022 // cf=nInitChar(n_Zp, (void*)(long)ch);
6023  }
6024 
6025  assume( R != NULL );
6026 
6027  R->cf = cf;
6028 
6029  /* names and number of variables-------------------------------------*/
6030  {
6031  int l=rv->listLength();
6032 
6033  if (l>MAX_SHORT)
6034  {
6035  Werror("too many ring variables(%d), max is %d",l,MAX_SHORT);
6036  goto rInitError;
6037  }
6038  R->N = l; /*rv->listLength();*/
6039  }
6040  R->names = (char **)omAlloc0(R->N * sizeof(char_ptr));
6041  if (rSleftvList2StringArray(rv, R->names))
6042  {
6043  WerrorS("name of ring variable expected");
6044  goto rInitError;
6045  }
6046 
6047  /* check names and parameters for conflicts ------------------------- */
6048  rRenameVars(R); // conflicting variables will be renamed
6049  /* ordering -------------------------------------------------------------*/
6050  if (rSleftvOrdering2Ordering(ord, R))
6051  goto rInitError;
6052 
6053  // Complete the initialization
6054  if (rComplete(R,1))
6055  goto rInitError;
6056 
6057 /*#ifdef HAVE_RINGS
6058 // currently, coefficients which are ring elements require a global ordering:
6059  if (rField_is_Ring(R) && (R->OrdSgn==-1))
6060  {
6061  WerrorS("global ordering required for these coefficients");
6062  goto rInitError;
6063  }
6064 #endif*/
6065 
6066  rTest(R);
6067 
6068  // try to enter the ring into the name list
6069  // need to clean up sleftv here, before this ring can be set to
6070  // new currRing or currRing can be killed beacuse new ring has
6071  // same name
6072  pn->CleanUp();
6073  rv->CleanUp();
6074  ord->CleanUp();
6075  //if ((tmp = enterid(s, myynest, RING_CMD, &IDROOT))==NULL)
6076  // goto rInitError;
6077 
6078  //memcpy(IDRING(tmp),R,sizeof(*R));
6079  // set current ring
6080  //omFreeBin(R, ip_sring_bin);
6081  //return tmp;
6082  return R;
6083 
6084  // error case:
6085  rInitError:
6086  if ((R != NULL)&&(R->cf!=NULL)) rDelete(R);
6087  pn->CleanUp();
6088  rv->CleanUp();
6089  ord->CleanUp();
6090  return NULL;
6091 }
@ 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:5697
BOOLEAN rSleftvOrdering2Ordering(sleftv *ord, ring R)
Definition: ipshell.cc:5389
static BOOLEAN rSleftvList2StringArray(leftv sl, char **p)
Definition: ipshell.cc:5661
#define SHORT_REAL_LENGTH
Definition: numbers.h:57
#define rTest(r)
Definition: ring.h:787
#define mpz_sgn1(A)
Definition: si_gmp.h:13

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6301 of file ipshell.cc.

6302 {
6303  ring r = IDRING(h);
6304  int ref=0;
6305  if (r!=NULL)
6306  {
6307  // avoid, that sLastPrinted is the last reference to the base ring:
6308  // clean up before killing the last "named" refrence:
6309  if ((sLastPrinted.rtyp==RING_CMD)
6310  && (sLastPrinted.data==(void*)r))
6311  {
6312  sLastPrinted.CleanUp(r);
6313  }
6314  ref=r->ref;
6315  if ((ref<=0)&&(r==currRing))
6316  {
6317  // cleanup DENOMINATOR_LIST
6318  if (DENOMINATOR_LIST!=NULL)
6319  {
6321  if (TEST_V_ALLWARN)
6322  Warn("deleting denom_list for ring change from %s",IDID(h));
6323  do
6324  {
6325  n_Delete(&(dd->n),currRing->cf);
6326  dd=dd->next;
6328  DENOMINATOR_LIST=dd;
6329  } while(DENOMINATOR_LIST!=NULL);
6330  }
6331  }
6332  rKill(r);
6333  }
6334  if (h==currRingHdl)
6335  {
6336  if (ref<=0) { currRing=NULL; currRingHdl=NULL;}
6337  else
6338  {
6340  }
6341  }
6342 }
void rKill(ring r)
Definition: ipshell.cc:6255
VAR denominator_list DENOMINATOR_LIST
Definition: kutil.cc:84
denominator_list next
Definition: kutil.h:65

◆ rKill() [2/2]

void rKill ( ring  r)

Definition at line 6255 of file ipshell.cc.

6256 {
6257  if ((r->ref<=0)&&(r->order!=NULL))
6258  {
6259 #ifdef RDEBUG
6260  if (traceit &TRACE_SHOW_RINGS) Print("kill ring %lx\n",(long)r);
6261 #endif
6262  int j;
6263  for (j=0;j<myynest;j++)
6264  {
6265  if (iiLocalRing[j]==r)
6266  {
6267  if (j==0) WarnS("killing the basering for level 0");
6268  iiLocalRing[j]=NULL;
6269  }
6270  }
6271 // any variables depending on r ?
6272  while (r->idroot!=NULL)
6273  {
6274  r->idroot->lev=myynest; // avoid warning about kill global objects
6275  killhdl2(r->idroot,&(r->idroot),r);
6276  }
6277  if (r==currRing)
6278  {
6279  // all dependend stuff is done, clean global vars:
6280  if ((currRing->ppNoether)!=NULL) pDelete(&(currRing->ppNoether));
6282  {
6284  }
6285  //if ((myynest>0) && (iiRETURNEXPR.RingDependend()))
6286  //{
6287  // WerrorS("return value depends on local ring variable (export missing ?)");
6288  // iiRETURNEXPR.CleanUp();
6289  //}
6290  currRing=NULL;
6291  currRingHdl=NULL;
6292  }
6293 
6294  /* nKillChar(r); will be called from inside of rDelete */
6295  rDelete(r);
6296  return;
6297  }
6298  rDecRefCnt(r);
6299 }
#define pDelete(p_ptr)
Definition: polys.h:186
static void rDecRefCnt(ring r)
Definition: ring.h:845

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5210 of file ipshell.cc.

5211 {
5212  ring rg = NULL;
5213  if (h!=NULL)
5214  {
5215 // Print(" new ring:%s (l:%d)\n",IDID(h),IDLEV(h));
5216  rg = IDRING(h);
5217  if (rg==NULL) return; //id <>NULL, ring==NULL
5218  omCheckAddrSize((ADDRESS)h,sizeof(idrec));
5219  if (IDID(h)) // OB: ????
5221  rTest(rg);
5222  }
5223  else return;
5224 
5225  // clean up history
5226  if (currRing!=NULL)
5227  {
5229  {
5231  }
5232 
5233  if (rg!=currRing)/*&&(currRing!=NULL)*/
5234  {
5235  if (rg->cf!=currRing->cf)
5236  {
5238  if (DENOMINATOR_LIST!=NULL)
5239  {
5240  if (TEST_V_ALLWARN)
5241  Warn("deleting denom_list for ring change to %s",IDID(h));
5242  do
5243  {
5244  n_Delete(&(dd->n),currRing->cf);
5245  dd=dd->next;
5247  DENOMINATOR_LIST=dd;
5248  } while(DENOMINATOR_LIST!=NULL);
5249  }
5250  }
5251  }
5252  }
5253 
5254  // test for valid "currRing":
5255  if ((rg!=NULL) && (rg->idroot==NULL))
5256  {
5257  ring old=rg;
5258  rg=rAssure_HasComp(rg);
5259  if (old!=rg)
5260  {
5261  rKill(old);
5262  IDRING(h)=rg;
5263  }
5264  }
5265  /*------------ change the global ring -----------------------*/
5266  rChangeCurrRing(rg);
5267  currRingHdl = h;
5268 }
#define omCheckAddr(addr)
Definition: omAllocDecl.h:328
#define omCheckAddrSize(addr, size)
Definition: omAllocDecl.h:327
ring rAssure_HasComp(const ring r)
Definition: ring.cc:4600

◆ scIndIndset()

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

Definition at line 1103 of file ipshell.cc.

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

◆ semicProc()

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

Definition at line 4635 of file ipshell.cc.

4636 {
4637  sleftv tmp;
4638  tmp.Init();
4639  tmp.rtyp=INT_CMD;
4640  /* tmp.data = (void *)0; -- done by Init */
4641 
4642  return semicProc3(res,u,v,&tmp);
4643 }

◆ semicProc3()

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

Definition at line 4595 of file ipshell.cc.

4596 {
4597  semicState state;
4598  BOOLEAN qh=(((int)(long)w->Data())==1);
4599 
4600  // -----------------
4601  // check arguments
4602  // -----------------
4603 
4604  lists l1 = (lists)u->Data( );
4605  lists l2 = (lists)v->Data( );
4606 
4607  if( (state=list_is_spectrum( l1 ))!=semicOK )
4608  {
4609  WerrorS( "first argument is not a spectrum" );
4610  list_error( state );
4611  }
4612  else if( (state=list_is_spectrum( l2 ))!=semicOK )
4613  {
4614  WerrorS( "second argument is not a spectrum" );
4615  list_error( state );
4616  }
4617  else
4618  {
4619  spectrum s1= spectrumFromList( l1 );
4620  spectrum s2= spectrumFromList( l2 );
4621 
4622  res->rtyp = INT_CMD;
4623  if (qh)
4624  res->data = (void*)(long)(s1.mult_spectrumh( s2 ));
4625  else
4626  res->data = (void*)(long)(s1.mult_spectrum( s2 ));
4627  }
4628 
4629  // -----------------
4630  // check status
4631  // -----------------
4632 
4633  return (state!=semicOK);
4634 }
Definition: semic.h:64
int mult_spectrum(spectrum &)
Definition: semic.cc:396
int mult_spectrumh(spectrum &)
Definition: semic.cc:425
semicState
Definition: ipshell.cc:3519
@ semicOK
Definition: ipshell.cc:3520
void list_error(semicState state)
Definition: ipshell.cc:3552
spectrum spectrumFromList(lists l)
Definition: ipshell.cc:3468
semicState list_is_spectrum(lists l)
Definition: ipshell.cc:4337

◆ setOption()

BOOLEAN setOption ( leftv  res,
leftv  v 
)

Definition at line 576 of file misc_ip.cc.

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

◆ showOption()

char* showOption ( )

Definition at line 717 of file misc_ip.cc.

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

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

4513 {
4514  semicState state;
4515 
4516  // -----------------
4517  // check arguments
4518  // -----------------
4519 
4520  lists l1 = (lists)first->Data( );
4521  lists l2 = (lists)second->Data( );
4522 
4523  if( (state=list_is_spectrum( l1 )) != semicOK )
4524  {
4525  WerrorS( "first argument is not a spectrum:" );
4526  list_error( state );
4527  }
4528  else if( (state=list_is_spectrum( l2 )) != semicOK )
4529  {
4530  WerrorS( "second argument is not a spectrum:" );
4531  list_error( state );
4532  }
4533  else
4534  {
4535  spectrum s1= spectrumFromList ( l1 );
4536  spectrum s2= spectrumFromList ( l2 );
4537  spectrum sum( s1+s2 );
4538 
4539  result->rtyp = LIST_CMD;
4540  result->data = (char*)(getList(sum));
4541  }
4542 
4543  return (state!=semicOK);
4544 }
lists getList(spectrum &spec)
Definition: ipshell.cc:3480

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv  result,
leftv  first 
)

Definition at line 4268 of file ipshell.cc.

4269 {
4270  spectrumState state = spectrumOK;
4271 
4272  // -------------------
4273  // check consistency
4274  // -------------------
4275 
4276  // check for a local polynomial ring
4277 
4278  if( currRing->OrdSgn != -1 )
4279  // ?? HS: the test above is also true for k[x][[y]], k[[x]][y]
4280  // or should we use:
4281  //if( !ringIsLocal( ) )
4282  {
4283  WerrorS( "only works for local orderings" );
4284  state = spectrumWrongRing;
4285  }
4286  else if( currRing->qideal != NULL )
4287  {
4288  WerrorS( "does not work in quotient rings" );
4289  state = spectrumWrongRing;
4290  }
4291  else
4292  {
4293  lists L = (lists)NULL;
4294  int flag = 2; // symmetric optimization
4295 
4296  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4297 
4298  if( state==spectrumOK )
4299  {
4300  result->rtyp = LIST_CMD;
4301  result->data = (char*)L;
4302  }
4303  else
4304  {
4305  spectrumPrintError(state);
4306  }
4307  }
4308 
4309  return (state!=spectrumOK);
4310 }
spectrumState
Definition: ipshell.cc:3635
@ spectrumWrongRing
Definition: ipshell.cc:3642
@ spectrumOK
Definition: ipshell.cc:3636
spectrumState spectrumCompute(poly h, lists *L, int fast)
Definition: ipshell.cc:3894
void spectrumPrintError(spectrumState state)
Definition: ipshell.cc:4186

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4217 of file ipshell.cc.

4218 {
4219  spectrumState state = spectrumOK;
4220 
4221  // -------------------
4222  // check consistency
4223  // -------------------
4224 
4225  // check for a local ring
4226 
4227  if( !ringIsLocal(currRing ) )
4228  {
4229  WerrorS( "only works for local orderings" );
4230  state = spectrumWrongRing;
4231  }
4232 
4233  // no quotient rings are allowed
4234 
4235  else if( currRing->qideal != NULL )
4236  {
4237  WerrorS( "does not work in quotient rings" );
4238  state = spectrumWrongRing;
4239  }
4240  else
4241  {
4242  lists L = (lists)NULL;
4243  int flag = 1; // weight corner optimization is safe
4244 
4245  state = spectrumCompute( (poly)first->Data( ),&L,flag );
4246 
4247  if( state==spectrumOK )
4248  {
4249  result->rtyp = LIST_CMD;
4250  result->data = (char*)L;
4251  }
4252  else
4253  {
4254  spectrumPrintError(state);
4255  }
4256  }
4257 
4258  return (state!=spectrumOK);
4259 }
BOOLEAN ringIsLocal(const ring r)
Definition: spectrum.cc:461

◆ spmulProc()

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

Definition at line 4554 of file ipshell.cc.

4555 {
4556  semicState state;
4557 
4558  // -----------------
4559  // check arguments
4560  // -----------------
4561 
4562  lists l = (lists)first->Data( );
4563  int k = (int)(long)second->Data( );
4564 
4565  if( (state=list_is_spectrum( l ))!=semicOK )
4566  {
4567  WerrorS( "first argument is not a spectrum" );
4568  list_error( state );
4569  }
4570  else if( k < 0 )
4571  {
4572  WerrorS( "second argument should be positive" );
4573  state = semicMulNegative;
4574  }
4575  else
4576  {
4578  spectrum product( k*s );
4579 
4580  result->rtyp = LIST_CMD;
4581  result->data = (char*)getList(product);
4582  }
4583 
4584  return (state!=semicOK);
4585 }
@ semicMulNegative
Definition: ipshell.cc:3521

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3256 of file ipshell.cc.

3257 {
3258  sleftv tmp;
3259  tmp.Init();
3260  tmp.rtyp=INT_CMD;
3261  tmp.data=(void *)1;
3262  return syBetti2(res,u,&tmp);
3263 }
BOOLEAN syBetti2(leftv res, leftv u, leftv w)
Definition: ipshell.cc:3233

◆ syBetti2()

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

Definition at line 3233 of file ipshell.cc.

3234 {
3235  syStrategy syzstr=(syStrategy)u->Data();
3236 
3237  BOOLEAN minim=(int)(long)w->Data();
3238  int row_shift=0;
3239  int add_row_shift=0;
3240  intvec *weights=NULL;
3241  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3242  if (ww!=NULL)
3243  {
3244  weights=ivCopy(ww);
3245  add_row_shift = ww->min_in();
3246  (*weights) -= add_row_shift;
3247  }
3248 
3249  res->data=(void *)syBettiOfComputation(syzstr,minim,&row_shift,weights);
3250  //row_shift += add_row_shift;
3251  //Print("row_shift=%d, add_row_shift=%d\n",row_shift,add_row_shift);
3252  atSet(res,omStrDup("rowShift"),(void*)(long)add_row_shift,INT_CMD);
3253 
3254  return FALSE;
3255 }
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 3340 of file ipshell.cc.

3341 {
3342  int typ0;
3344 
3345  resolvente fr = liFindRes(li,&(result->length),&typ0,&(result->weights));
3346  if (fr != NULL)
3347  {
3348 
3349  result->fullres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3350  for (int i=result->length-1;i>=0;i--)
3351  {
3352  if (fr[i]!=NULL)
3353  result->fullres[i] = idCopy(fr[i]);
3354  }
3355  result->list_length=result->length;
3356  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3357  }
3358  else
3359  {
3360  omFreeSize(result, sizeof(ssyStrategy));
3361  result = NULL;
3362  }
3363  return result;
3364 }

◆ syConvRes()

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

Definition at line 3268 of file ipshell.cc.

3269 {
3270  resolvente fullres = syzstr->fullres;
3271  resolvente minres = syzstr->minres;
3272 
3273  const int length = syzstr->length;
3274 
3275  if ((fullres==NULL) && (minres==NULL))
3276  {
3277  if (syzstr->hilb_coeffs==NULL)
3278  { // La Scala
3279  fullres = syReorder(syzstr->res, length, syzstr);
3280  }
3281  else
3282  { // HRES
3283  minres = syReorder(syzstr->orderedRes, length, syzstr);
3284  syKillEmptyEntres(minres, length);
3285  }
3286  }
3287 
3288  resolvente tr;
3289  int typ0=IDEAL_CMD;
3290 
3291  if (minres!=NULL)
3292  tr = minres;
3293  else
3294  tr = fullres;
3295 
3296  resolvente trueres=NULL;
3297  intvec ** w=NULL;
3298 
3299  if (length>0)
3300  {
3301  trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3302  for (int i=length-1;i>=0;i--)
3303  {
3304  if (tr[i]!=NULL)
3305  {
3306  trueres[i] = idCopy(tr[i]);
3307  }
3308  }
3309  if ( id_RankFreeModule(trueres[0], currRing) > 0)
3310  typ0 = MODUL_CMD;
3311  if (syzstr->weights!=NULL)
3312  {
3313  w = (intvec**)omAlloc0(length*sizeof(intvec*));
3314  for (int i=length-1;i>=0;i--)
3315  {
3316  if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3317  }
3318  }
3319  }
3320 
3321  lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3322  w, add_row_shift);
3323 
3324  if (toDel)
3325  syKillComputation(syzstr);
3326  else
3327  {
3328  if( fullres != NULL && syzstr->fullres == NULL )
3329  syzstr->fullres = fullres;
3330 
3331  if( minres != NULL && syzstr->minres == NULL )
3332  syzstr->minres = minres;
3333  }
3334  return li;
3335 }
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 3369 of file ipshell.cc.

3370 {
3371  int typ0;
3373 
3374  resolvente fr = liFindRes(li,&(result->length),&typ0);
3375  result->minres = (resolvente)omAlloc0((result->length+1)*sizeof(ideal));
3376  for (int i=result->length-1;i>=0;i--)
3377  {
3378  if (fr[i]!=NULL)
3379  result->minres[i] = idCopy(fr[i]);
3380  }
3381  omFreeSize((ADDRESS)fr,(result->length)*sizeof(ideal));
3382  return result;
3383 }

◆ test_cmd()

void test_cmd ( int  i)

Definition at line 514 of file ipshell.cc.

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

◆ Tok2Cmdname()

const char* Tok2Cmdname ( int  i)

Definition at line 140 of file gentable.cc.

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

◆ type_cmd()

void type_cmd ( leftv  v)

Definition at line 254 of file ipshell.cc.

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

◆ versionString()

char* versionString ( )

Definition at line 778 of file misc_ip.cc.

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

Variable Documentation

◆ currid

const char* currid
extern

Definition at line 171 of file grammar.cc.

◆ dArith1

const struct sValCmd1 dArith1[]
extern

Definition at line 1 of file table.h.

◆ dArith2

const struct sValCmd2 dArith2[]
extern

Definition at line 1 of file table.h.

◆ dArith3

const struct sValCmd3 dArith3[]
extern

Definition at line 1 of file table.h.

◆ dArithM

const struct sValCmdM dArithM[]
extern

Definition at line 1 of file table.h.

◆ iiCurrArgs

EXTERN_VAR leftv iiCurrArgs

Definition at line 29 of file ipshell.h.

◆ iiCurrProc

EXTERN_VAR idhdl iiCurrProc

Definition at line 30 of file ipshell.h.

◆ iiLocalRing

EXTERN_VAR ring* iiLocalRing

Definition at line 35 of file ipshell.h.

◆ iiOp

EXTERN_VAR int iiOp

Definition at line 31 of file ipshell.h.

◆ iiRETURNEXPR

EXTERN_INST_VAR sleftv iiRETURNEXPR

Definition at line 34 of file ipshell.h.

◆ iiRETURNEXPR_len

EXTERN_VAR int iiRETURNEXPR_len

Definition at line 33 of file ipshell.h.

◆ lastreserved

const char* lastreserved
extern

Definition at line 82 of file ipshell.cc.

◆ myynest

EXTERN_VAR int myynest

Definition at line 38 of file ipshell.h.

◆ printlevel

EXTERN_VAR int printlevel

Definition at line 39 of file ipshell.h.

◆ si_echo

EXTERN_VAR int si_echo

Definition at line 40 of file ipshell.h.

◆ yyInRingConstruction

EXTERN_VAR BOOLEAN yyInRingConstruction

Definition at line 43 of file ipshell.h.