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

Go to the source code of this file.

Data Structures

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

Typedefs

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

Functions

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

Variables

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

Data Structure Documentation

◆ sValCmd1

struct sValCmd1

Definition at line 78 of file gentable.cc.

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

◆ sValCmd2

struct sValCmd2

Definition at line 69 of file gentable.cc.

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

◆ sValCmd3

struct sValCmd3

Definition at line 86 of file gentable.cc.

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

◆ sValCmdM

struct sValCmdM

Definition at line 96 of file gentable.cc.

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

◆ sValAssign_sys

struct sValAssign_sys

Definition at line 104 of file gentable.cc.

Data Fields
short arg
int p
proc1 p
short res

◆ sValAssign

struct sValAssign

Definition at line 111 of file gentable.cc.

Data Fields
short arg
int p
proci p
short res

Typedef Documentation

◆ proc1

typedef BOOLEAN(* proc1) (leftv, leftv)

Definition at line 122 of file ipshell.h.

◆ proc2

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

Definition at line 134 of file ipshell.h.

◆ proc3

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

Definition at line 145 of file ipshell.h.

◆ proci

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

Definition at line 175 of file ipshell.h.

Function Documentation

◆ exprlist_length()

int exprlist_length ( leftv  v)

Definition at line 552 of file ipshell.cc.

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

◆ ii_CallLibProcM()

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

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

Definition at line 701 of file iplib.cc.

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

◆ ii_CallProcId2Id()

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

Definition at line 661 of file iplib.cc.

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

◆ ii_CallProcId2Int()

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

Definition at line 680 of file iplib.cc.

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

◆ iiAddCproc()

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

Definition at line 1063 of file iplib.cc.

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

◆ iiAlias()

BOOLEAN iiAlias ( leftv  p)

Definition at line 844 of file ipid.cc.

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

◆ iiAllStart()

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

Definition at line 298 of file iplib.cc.

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

◆ iiApply()

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

Definition at line 6421 of file ipshell.cc.

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

◆ iiARROW()

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

Definition at line 6470 of file ipshell.cc.

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

◆ iiAssign()

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

Definition at line 1963 of file ipassign.cc.

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

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6504 of file ipshell.cc.

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

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  r,
leftv  args 
)

Definition at line 1273 of file ipshell.cc.

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

◆ iiCallLibProc1()

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

Definition at line 627 of file iplib.cc.

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

◆ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1630 of file ipshell.cc.

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

◆ iiCheckRing()

BOOLEAN iiCheckRing ( int  i)

Definition at line 1586 of file ipshell.cc.

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

◆ iiCheckTypes()

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

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

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

Definition at line 6562 of file ipshell.cc.

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

◆ iiConvName()

char * iiConvName ( const char *  libname)

Definition at line 1429 of file iplib.cc.

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

◆ iiDebug()

void iiDebug ( )

Definition at line 1065 of file ipshell.cc.

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

◆ iiDeclCommand()

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

Definition at line 1198 of file ipshell.cc.

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

◆ iiEStart()

BOOLEAN iiEStart ( char *  example,
procinfo pi 
)

Definition at line 754 of file iplib.cc.

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

◆ iiExport() [1/2]

BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1511 of file ipshell.cc.

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

◆ iiExport() [2/2]

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

Definition at line 1534 of file ipshell.cc.

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

◆ iiExprArith1()

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

◆ iiExprArith1Tab()

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

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

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

Definition at line 8963 of file iparith.cc.

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

◆ iiExprArith2()

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

◆ iiExprArith2Tab()

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

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

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

Definition at line 8890 of file iparith.cc.

8894{
8895 res->Init();
8896 leftv b=a->next;
8897 a->next=NULL;
8898 int bt=b->Typ();
8900 a->next=b;
8901 a->CleanUp(); // to clean up the chain, content already done in iiExprArith2TabIntern
8902 return bo;
8903}
static BOOLEAN iiExprArith2TabIntern(leftv res, leftv a, int op, leftv b, BOOLEAN proccall, const struct sValCmd2 *dA2, int at, int bt, const struct sConvertTypes *dConvertTypes)
Definition: iparith.cc:8731

◆ iiExprArith3()

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

Definition at line 9303 of file iparith.cc.

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

◆ iiExprArith3Tab()

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

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

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

Definition at line 9355 of file iparith.cc.

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

◆ iiExprArithM()

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

◆ iiGetLibName()

static char * iiGetLibName ( const procinfov  pi)
inlinestatic

find the library of an proc

Definition at line 66 of file ipshell.h.

66{ return pi->libname; }

◆ iiGetLibProcBuffer()

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

◆ iiGetLibStatus()

BOOLEAN iiGetLibStatus ( const char *  lib)

Definition at line 77 of file iplib.cc.

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

◆ iiHighCorner()

poly iiHighCorner ( ideal  i,
int  ak 
)

Definition at line 1606 of file ipshell.cc.

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

◆ iiInternalExport()

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

Definition at line 1465 of file ipshell.cc.

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

◆ iiLibCmd()

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

Definition at line 884 of file iplib.cc.

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

◆ iiLoadLIB()

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

Definition at line 973 of file iplib.cc.

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

◆ iiLocateLib()

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

Definition at line 870 of file iplib.cc.

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

◆ iiMake_proc()

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

Definition at line 504 of file iplib.cc.

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

◆ iiMakeResolv()

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

Definition at line 847 of file ipshell.cc.

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

◆ iiMap()

leftv iiMap ( map  theMap,
const char *  what 
)

Definition at line 615 of file ipshell.cc.

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

◆ iiOpsTwoChar()

int iiOpsTwoChar ( const char *  s)

Definition at line 121 of file ipshell.cc.

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

◆ iiParameter()

BOOLEAN iiParameter ( leftv  p)

Definition at line 1376 of file ipshell.cc.

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

◆ iiProcArgs()

char * iiProcArgs ( char *  e,
BOOLEAN  withParenth 
)

Definition at line 114 of file iplib.cc.

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

◆ iiProcName()

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

Definition at line 100 of file iplib.cc.

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

◆ iiPStart()

BOOLEAN iiPStart ( idhdl  pn,
leftv  sl 
)

Definition at line 371 of file iplib.cc.

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

◆ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 1037 of file ipshell.cc.

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

◆ iiSetReturn()

void iiSetReturn ( const leftv  h)

Definition at line 6591 of file ipshell.cc.

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

◆ iiTestAssume()

BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6443 of file ipshell.cc.

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

◆ iiTokType()

int iiTokType ( int  op)

Definition at line 237 of file iparith.cc.

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

◆ iiTryLoadLib()

BOOLEAN iiTryLoadLib ( leftv  v,
const char *  id 
)

Definition at line 823 of file iplib.cc.

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

◆ iiTwoOps()

const char * iiTwoOps ( int  t)

Definition at line 261 of file gentable.cc.

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

◆ iiWRITE()

BOOLEAN iiWRITE ( leftv  res,
leftv  exprlist 
)

Definition at line 588 of file ipshell.cc.

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

◆ IsCmd()

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

Definition at line 9503 of file iparith.cc.

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

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv  res,
leftv  v 
)

Definition at line 967 of file ipshell.cc.

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

◆ jjBETTI2()

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

Definition at line 1001 of file ipshell.cc.

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

◆ jjBETTI2_ID()

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

Definition at line 980 of file ipshell.cc.

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

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3346 of file ipshell.cc.

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

◆ jjIMPORTFROM()

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

Definition at line 2369 of file ipassign.cc.

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

◆ jjLIST_PL()

BOOLEAN jjLIST_PL ( leftv  res,
leftv  v 
)

Definition at line 7978 of file iparith.cc.

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

◆ jjLOAD()

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

load lib/module given in v

Definition at line 5492 of file iparith.cc.

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

◆ jjLOAD_TRY()

BOOLEAN jjLOAD_TRY ( const char *  s)

Definition at line 5568 of file iparith.cc.

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

◆ jjMINRES()

BOOLEAN jjMINRES ( leftv  res,
leftv  v 
)

Definition at line 946 of file ipshell.cc.

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

◆ jjRESULTANT()

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

Definition at line 3339 of file ipshell.cc.

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

◆ jjSetMinpoly()

coeffs jjSetMinpoly ( coeffs  cf,
number  a 
)

Definition at line 175 of file ipassign.cc.

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

◆ jjSYSTEM()

BOOLEAN jjSYSTEM ( leftv  res,
leftv  v 
)

Definition at line 232 of file extra.cc.

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

◆ jjVARIABLES_ID()

BOOLEAN jjVARIABLES_ID ( leftv  res,
leftv  u 
)

Definition at line 6308 of file ipshell.cc.

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

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6300 of file ipshell.cc.

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

◆ killlocals()

void killlocals ( int  v)

Definition at line 386 of file ipshell.cc.

387{
388 BOOLEAN changed=FALSE;
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)
416 else if(cr!=currRing)
417 rChangeCurrRing(cr);
418 }
419
420 if (myynest<=1) iiNoKeepRing=TRUE;
421 //Print("end killlocals >= %d\n",v);
422 //listall();
423}
VAR int iiRETURNEXPR_len
Definition: iplib.cc:475
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:366
STATIC_VAR BOOLEAN iiNoKeepRing
Definition: ipshell.cc:84
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:330
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:295

◆ kQHWeight()

BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3322 of file ipshell.cc.

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

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3300 of file ipshell.cc.

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

◆ list_cmd()

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

Definition at line 425 of file ipshell.cc.

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

◆ loNewtonP()

BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4562 of file ipshell.cc.

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

◆ loSimplex()

BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4568 of file ipshell.cc.

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

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 3070 of file ipshell.cc.

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

◆ mpKoszul()

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

Definition at line 3092 of file ipshell.cc.

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

◆ nuLagSolve()

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

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

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

Definition at line 4677 of file ipshell.cc.

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

◆ nuMPResMat()

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

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

Definition at line 4654 of file ipshell.cc.

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

◆ nuUResSolve()

BOOLEAN nuUResSolve ( leftv  res,
leftv  args 
)

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

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

Definition at line 4921 of file ipshell.cc.

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

◆ nuVanderSys()

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

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

Definition at line 4820 of file ipshell.cc.

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

◆ paPrint()

void paPrint ( const char *  n,
package  p 
)

Definition at line 6323 of file ipshell.cc.

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

◆ rCompose()

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

Definition at line 2783 of file ipshell.cc.

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

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2161 of file ipshell.cc.

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

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1949 of file ipshell.cc.

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

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 2122 of file ipshell.cc.

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

◆ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1644 of file ipshell.cc.

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

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1701 of file ipshell.cc.

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

◆ rInit()

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

Definition at line 5624 of file ipshell.cc.

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

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6216 of file ipshell.cc.

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

◆ rKill() [2/2]

void rKill ( ring  r)

Definition at line 6170 of file ipshell.cc.

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

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5125 of file ipshell.cc.

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

◆ scIndIndset()

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

Definition at line 1103 of file ipshell.cc.

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

◆ semicProc()

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

Definition at line 4550 of file ipshell.cc.

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

◆ semicProc3()

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

Definition at line 4510 of file ipshell.cc.

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

◆ setOption()

BOOLEAN setOption ( leftv  res,
leftv  v 
)

Definition at line 568 of file misc_ip.cc.

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

◆ showOption()

char * showOption ( )

Definition at line 709 of file misc_ip.cc.

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

◆ singular_example()

void singular_example ( char *  str)

Definition at line 430 of file misc_ip.cc.

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

◆ singular_system()

leftv singular_system ( sleftv  h)

◆ spaddProc()

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

Definition at line 4427 of file ipshell.cc.

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

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv  result,
leftv  first 
)

Definition at line 4183 of file ipshell.cc.

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

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4132 of file ipshell.cc.

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

◆ spmulProc()

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

Definition at line 4469 of file ipshell.cc.

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

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3171 of file ipshell.cc.

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

◆ syBetti2()

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

Definition at line 3148 of file ipshell.cc.

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

◆ syConvList()

syStrategy syConvList ( lists  li)

Definition at line 3255 of file ipshell.cc.

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

◆ syConvRes()

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

Definition at line 3183 of file ipshell.cc.

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

◆ syForceMin()

syStrategy syForceMin ( lists  li)

Definition at line 3284 of file ipshell.cc.

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

◆ test_cmd()

void test_cmd ( int  i)

Definition at line 514 of file ipshell.cc.

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

◆ Tok2Cmdname()

const char * Tok2Cmdname ( int  i)

Definition at line 140 of file gentable.cc.

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

◆ type_cmd()

void type_cmd ( leftv  v)

Definition at line 254 of file ipshell.cc.

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

◆ versionString()

char * versionString ( )

Definition at line 770 of file misc_ip.cc.

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

Variable Documentation

◆ currid

const char* currid
extern

Definition at line 171 of file grammar.cc.

◆ dArith1

const struct sValCmd1 dArith1[]
extern

Definition at line 37 of file table.h.

◆ dArith2

const struct sValCmd2 dArith2[]
extern

Definition at line 320 of file table.h.

◆ dArith3

const struct sValCmd3 dArith3[]
extern

Definition at line 773 of file table.h.

◆ dArithM

const struct sValCmdM dArithM[]
extern

Definition at line 905 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.