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}
#define NULL
Definition: auxiliary.h:104
Variable next() const
Definition: factory.h:153
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
@ LIST_CMD
Definition: tok.h:118
@ INTVEC_CMD
Definition: tok.h:101
@ INT_CMD
Definition: tok.h:96

◆ ii_CallLibProcM()

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

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

Definition at line 697 of file iplib.cc.

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

◆ ii_CallProcId2Id()

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

Definition at line 657 of file iplib.cc.

658{
659 char *plib = iiConvName(lib);
660 idhdl h=ggetid(plib);
661 omFree(plib);
662 if (h==NULL)
663 {
665 if (bo) return NULL;
666 }
667 ring oldR=currRing;
669 BOOLEAN err;
670 ideal I=(ideal)iiCallLibProc1(proc,idCopy(arg),IDEAL_CMD,err);
671 rChangeCurrRing(oldR);
672 if (err) return NULL;
673 return I;
674}
int BOOLEAN
Definition: auxiliary.h:87
#define TRUE
Definition: auxiliary.h:100
unsigned char * proc[NUM_PROC]
Definition: checklibs.c:16
ideal idCopy(ideal A)
Definition: ideals.h:60
char * iiConvName(const char *libname)
Definition: iplib.cc:1424
BOOLEAN iiLibCmd(const char *newlib, BOOLEAN autoexport, BOOLEAN tellerror, BOOLEAN force)
Definition: iplib.cc:880
void * iiCallLibProc1(const char *n, void *arg, int arg_type, BOOLEAN &err)
Definition: iplib.cc:623
#define omFree(addr)
Definition: omAllocDecl.h:261

◆ ii_CallProcId2Int()

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

Definition at line 676 of file iplib.cc.

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

◆ iiAddCproc()

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

Definition at line 1059 of file iplib.cc.

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

◆ iiAlias()

BOOLEAN iiAlias ( leftv  p)

Definition at line 834 of file ipid.cc.

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

◆ iiAllStart()

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

Definition at line 294 of file iplib.cc.

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

◆ iiApply()

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

Definition at line 6499 of file ipshell.cc.

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

◆ iiARROW()

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

Definition at line 6548 of file ipshell.cc.

6549{
6550 char *ss=(char*)omAlloc(strlen(a)+strlen(s)+30); /* max. 27 currently */
6551 // find end of s:
6552 int end_s=strlen(s);
6553 while ((end_s>0) && ((s[end_s]<=' ')||(s[end_s]==';'))) end_s--;
6554 s[end_s+1]='\0';
6555 char *name=(char *)omAlloc(strlen(a)+strlen(s)+30);
6556 sprintf(name,"%s->%s",a,s);
6557 // find start of last expression
6558 int start_s=end_s-1;
6559 while ((start_s>=0) && (s[start_s]!=';')) start_s--;
6560 if (start_s<0) // ';' not found
6561 {
6562 sprintf(ss,"parameter def %s;return(%s);\n",a,s);
6563 }
6564 else // s[start_s] is ';'
6565 {
6566 s[start_s]='\0';
6567 sprintf(ss,"parameter def %s;%s;return(%s);\n",a,s,s+start_s+1);
6568 }
6569 r->Init();
6570 // now produce procinfo for PROC_CMD:
6571 r->data = (void *)omAlloc0Bin(procinfo_bin);
6572 ((procinfo *)(r->data))->language=LANG_NONE;
6574 ((procinfo *)r->data)->data.s.body=ss;
6575 omFree(name);
6576 r->rtyp=PROC_CMD;
6577 //r->rtyp=STRING_CMD;
6578 //r->data=ss;
6579 return FALSE;
6580}
const CanonicalForm int s
Definition: facAbsFact.cc:51
procinfo * iiInitSingularProcinfo(procinfov pi, const char *libname, const char *procname, int, long pos, BOOLEAN pstatic)
Definition: iplib.cc:1045
#define omAlloc(size)
Definition: omAllocDecl.h:210
VAR omBin procinfo_bin
Definition: subexpr.cc:42

◆ iiAssign()

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

Definition at line 1964 of file ipassign.cc.

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

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6582 of file ipshell.cc.

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

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  r,
leftv  args 
)

Definition at line 1277 of file ipshell.cc.

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

◆ iiCallLibProc1()

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

Definition at line 623 of file iplib.cc.

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

◆ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1636 of file ipshell.cc.

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

◆ iiCheckRing()

BOOLEAN iiCheckRing ( int  i)

Definition at line 1592 of file ipshell.cc.

1593{
1594 if (currRing==NULL)
1595 {
1596 #ifdef SIQ
1597 if (siq<=0)
1598 {
1599 #endif
1600 if (RingDependend(i))
1601 {
1602 WerrorS("no ring active (9)");
1603 return TRUE;
1604 }
1605 #ifdef SIQ
1606 }
1607 #endif
1608 }
1609 return FALSE;
1610}
VAR BOOLEAN siq
Definition: subexpr.cc:48

◆ iiCheckTypes()

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

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

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

Definition at line 6640 of file ipshell.cc.

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

◆ iiConvName()

char * iiConvName ( const char *  libname)

Definition at line 1424 of file iplib.cc.

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

◆ iiDebug()

void iiDebug ( )

Definition at line 1065 of file ipshell.cc.

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

◆ iiDeclCommand()

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

Definition at line 1202 of file ipshell.cc.

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

◆ iiEStart()

BOOLEAN iiEStart ( char *  example,
procinfo pi 
)

Definition at line 750 of file iplib.cc.

751{
752 BOOLEAN err;
753 int old_echo=si_echo;
754
755 iiCheckNest();
756 procstack->push(example);
759 {
760 if (traceit&TRACE_SHOW_LINENO) printf("\n");
761 printf("entering example (level %d)\n",myynest);
762 }
763 myynest++;
764
765 err=iiAllStart(pi,example,BT_example,(pi != NULL ? pi->data.s.example_lineno: 0));
766
768 myynest--;
769 si_echo=old_echo;
771 {
772 if (traceit&TRACE_SHOW_LINENO) printf("\n");
773 printf("leaving -example- (level %d)\n",myynest);
774 }
776 {
778 {
781 }
782 else
783 {
786 }
787 }
788 procstack->pop();
789 return err;
790}
void pop()
Definition: ipid.cc:803
void push(char *)
Definition: ipid.cc:793
VAR int si_echo
Definition: febase.cc:35
@ BT_example
Definition: fevoices.h:21
VAR proclevel * procstack
Definition: ipid.cc:52
static void iiCheckNest()
Definition: iplib.cc:489
VAR ring * iiLocalRing
Definition: iplib.cc:469
BOOLEAN iiAllStart(procinfov pi, const char *p, feBufferTypes t, int l)
Definition: iplib.cc:294
idhdl rFindHdl(ring r, idhdl n)
Definition: ipshell.cc:1707
#define TRACE_SHOW_LINENO
Definition: reporter.h:31
#define TRACE_SHOW_PROC
Definition: reporter.h:29

◆ iiExport() [1/2]

BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1514 of file ipshell.cc.

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

◆ iiExport() [2/2]

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

Definition at line 1540 of file ipshell.cc.

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

◆ iiExprArith1()

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

◆ iiExprArith1Tab()

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

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

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

Definition at line 8919 of file iparith.cc.

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

◆ iiExprArith2()

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

◆ iiExprArith2Tab()

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

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

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

Definition at line 8846 of file iparith.cc.

8850{
8851 res->Init();
8852 leftv b=a->next;
8853 a->next=NULL;
8854 int bt=b->Typ();
8856 a->next=b;
8857 a->CleanUp(); // to clean up the chain, content already done in iiExprArith2TabIntern
8858 return bo;
8859}
static BOOLEAN iiExprArith2TabIntern(leftv res, leftv a, int op, leftv b, BOOLEAN proccall, const struct sValCmd2 *dA2, int at, int bt, const struct sConvertTypes *dConvertTypes)
Definition: iparith.cc:8687

◆ iiExprArith3()

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

Definition at line 9261 of file iparith.cc.

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

◆ iiExprArith3Tab()

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

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

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

Definition at line 9313 of file iparith.cc.

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

◆ iiExprArithM()

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

◆ iiGetLibName()

static char * iiGetLibName ( const procinfov  pi)
inlinestatic

find the library of an proc

Definition at line 66 of file ipshell.h.

66{ return pi->libname; }

◆ iiGetLibProcBuffer()

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

◆ iiGetLibStatus()

BOOLEAN iiGetLibStatus ( const char *  lib)

Definition at line 73 of file iplib.cc.

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

◆ iiHighCorner()

poly iiHighCorner ( ideal  i,
int  ak 
)

Definition at line 1612 of file ipshell.cc.

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

◆ iiInternalExport()

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

Definition at line 1468 of file ipshell.cc.

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

◆ iiLibCmd()

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

Definition at line 880 of file iplib.cc.

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

◆ iiLoadLIB()

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

Definition at line 969 of file iplib.cc.

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

◆ iiLocateLib()

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

Definition at line 866 of file iplib.cc.

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

◆ iiMake_proc()

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

Definition at line 500 of file iplib.cc.

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

◆ iiMakeResolv()

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

Definition at line 847 of file ipshell.cc.

849{
850 lists L=liMakeResolv(r,length,rlen,typ0,weights);
851 int i=0;
852 idhdl h;
853 char * s=(char *)omAlloc(strlen(name)+5);
854
855 while (i<=L->nr)
856 {
857 sprintf(s,"%s(%d)",name,i+1);
858 if (i==0)
859 h=enterid(s,myynest,typ0,&(currRing->idroot), FALSE);
860 else
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}
if(both_non_zero==0)
Definition: cfEzgcd.cc:91
attr attribute
Definition: subexpr.h:89
sleftv * m
Definition: lists.h:46
int nr
Definition: lists.h:44
static BOOLEAN length(leftv result, leftv arg)
Definition: interval.cc:257
VAR omBin slists_bin
Definition: lists.cc:23
lists liMakeResolv(resolvente r, int length, int reallen, int typ0, intvec **weights, int add_row_shift)
Definition: lists.cc:216
#define omFreeSize(addr, size)
Definition: omAllocDecl.h:260
#define V_DEF_RES
Definition: options.h:49

◆ iiMap()

leftv iiMap ( map  theMap,
const char *  what 
)

Definition at line 615 of file ipshell.cc.

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

◆ iiOpsTwoChar()

int iiOpsTwoChar ( const char *  s)

Definition at line 121 of file ipshell.cc.

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

◆ iiParameter()

BOOLEAN iiParameter ( leftv  p)

Definition at line 1380 of file ipshell.cc.

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

◆ iiProcArgs()

char * iiProcArgs ( char *  e,
BOOLEAN  withParenth 
)

Definition at line 110 of file iplib.cc.

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

◆ iiProcName()

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

Definition at line 96 of file iplib.cc.

97{
98 char *s=buf+5;
99 while (*s==' ') s++;
100 e=s+1;
101 while ((*e>' ') && (*e!='(')) e++;
102 ct=*e;
103 *e='\0';
104 return s;
105}
fq_nmod_t buf
Definition: facHensel.cc:101

◆ iiPStart()

BOOLEAN iiPStart ( idhdl  pn,
leftv  sl 
)

Definition at line 367 of file iplib.cc.

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

◆ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 1037 of file ipshell.cc.

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

◆ iiSetReturn()

void iiSetReturn ( const leftv  h)

Definition at line 6669 of file ipshell.cc.

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

◆ iiTestAssume()

BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6521 of file ipshell.cc.

6522{
6523 // assume a: level
6524 if ((a->Typ()==INT_CMD)&&((long)a->Data()>=0))
6525 {
6526 if ((TEST_V_ALLWARN) && (myynest==0)) WarnS("ASSUME at top level is of no use: see documentation");
6527 char assume_yylinebuf[80];
6528 strncpy(assume_yylinebuf,my_yylinebuf,79);
6529 int lev=(long)a->Data();
6530 int startlev=0;
6531 idhdl h=ggetid("assumeLevel");
6532 if ((h!=NULL)&&(IDTYP(h)==INT_CMD)) startlev=(long)IDINT(h);
6533 if(lev <=startlev)
6534 {
6535 BOOLEAN bo=b->Eval();
6536 if (bo) { WerrorS("syntax error in ASSUME");return TRUE;}
6537 if (b->Typ()!=INT_CMD) { WerrorS("ASUMME(<level>,<int expr>)");return TRUE; }
6538 if (b->Data()==NULL) { Werror("ASSUME failed:%s",assume_yylinebuf);return TRUE;}
6539 }
6540 }
6541 b->CleanUp();
6542 a->CleanUp();
6543 return FALSE;
6544}
void * Data()
Definition: subexpr.cc:1154
#define IDINT(a)
Definition: ipid.h:125

◆ iiTokType()

int iiTokType ( int  op)

Definition at line 234 of file iparith.cc.

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

◆ iiTryLoadLib()

BOOLEAN iiTryLoadLib ( leftv  v,
const char *  id 
)

Definition at line 819 of file iplib.cc.

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

◆ iiTwoOps()

const char * iiTwoOps ( int  t)

Definition at line 261 of file gentable.cc.

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

◆ iiWRITE()

BOOLEAN iiWRITE ( leftv  res,
leftv  exprlist 
)

Definition at line 588 of file ipshell.cc.

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

◆ IsCmd()

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

Definition at line 9461 of file iparith.cc.

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

◆ jjBETTI()

BOOLEAN jjBETTI ( leftv  res,
leftv  v 
)

Definition at line 967 of file ipshell.cc.

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

◆ jjBETTI2()

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

Definition at line 1001 of file ipshell.cc.

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

◆ jjBETTI2_ID()

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

Definition at line 980 of file ipshell.cc.

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

◆ jjCHARSERIES()

BOOLEAN jjCHARSERIES ( leftv  res,
leftv  u 
)

Definition at line 3431 of file ipshell.cc.

3432{
3433 res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3434 return (res->data==NULL);
3435}
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition: clapsing.cc:1537

◆ jjIMPORTFROM()

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

Definition at line 2370 of file ipassign.cc.

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

◆ jjLIST_PL()

BOOLEAN jjLIST_PL ( leftv  res,
leftv  v 
)

Definition at line 7934 of file iparith.cc.

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

◆ jjLOAD()

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

load lib/module given in v

Definition at line 5457 of file iparith.cc.

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

◆ jjLOAD_TRY()

BOOLEAN jjLOAD_TRY ( const char *  s)

Definition at line 5533 of file iparith.cc.

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

◆ jjMINRES()

BOOLEAN jjMINRES ( leftv  res,
leftv  v 
)

Definition at line 946 of file ipshell.cc.

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

◆ jjRESULTANT()

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

Definition at line 3424 of file ipshell.cc.

3425{
3426 res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3427 (poly)w->CopyD(), currRing);
3428 return errorreported;
3429}
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition: clapsing.cc:311

◆ jjSetMinpoly()

coeffs jjSetMinpoly ( coeffs  cf,
number  a 
)

Definition at line 175 of file ipassign.cc.

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

◆ jjSYSTEM()

BOOLEAN jjSYSTEM ( leftv  res,
leftv  v 
)

Definition at line 230 of file extra.cc.

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

6394{
6395 int *e=(int *)omAlloc0((rVar(currRing)+1)*sizeof(int));
6396 ideal I=(ideal)u->Data();
6397 int i;
6398 int n=0;
6399 for(i=I->nrows*I->ncols-1;i>=0;i--)
6400 {
6401 int n0=pGetVariables(I->m[i],e);
6402 if (n0>n) n=n0;
6403 }
6404 jjINT_S_TO_ID(n,e,res);
6405 return FALSE;
6406}
static void jjINT_S_TO_ID(int n, int *e, leftv res)
Definition: ipshell.cc:6363
#define omAlloc0(size)
Definition: omAllocDecl.h:211
#define pGetVariables(p, e)
Definition: polys.h:251

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6385 of file ipshell.cc.

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

◆ killlocals()

void killlocals ( int  v)

Definition at line 386 of file ipshell.cc.

387{
388 BOOLEAN changed=FALSE;
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:471
BOOLEAN killlocals_list(int v, lists L)
Definition: ipshell.cc:366
STATIC_VAR BOOLEAN iiNoKeepRing
Definition: ipshell.cc:84
void killlocals_rec(idhdl *root, int v, ring r)
Definition: ipshell.cc:330
static void killlocals0(int v, idhdl *localhdl, const ring r)
Definition: ipshell.cc:295

◆ kQHWeight()

BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3407 of file ipshell.cc.

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

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3385 of file ipshell.cc.

3386{
3387 ideal F=(ideal)id->Data();
3388 intvec * iv = new intvec(rVar(currRing));
3389 polyset s;
3390 int sl, n, i;
3391 int *x;
3392
3393 res->data=(char *)iv;
3394 s = F->m;
3395 sl = IDELEMS(F) - 1;
3396 n = rVar(currRing);
3397 double wNsqr = (double)2.0 / (double)n;
3399 x = (int * )omAlloc(2 * (n + 1) * sizeof(int));
3400 wCall(s, sl, x, wNsqr, currRing);
3401 for (i = n; i!=0; i--)
3402 (*iv)[i-1] = x[i + n + 1];
3403 omFreeSize((ADDRESS)x, 2 * (n + 1) * sizeof(int));
3404 return FALSE;
3405}
Variable x
Definition: cfModGcd.cc:4084
THREAD_VAR double(* wFunctional)(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight.cc:20
void wCall(poly *s, int sl, int *x, double wNsqr, const ring R)
Definition: weight.cc:108
double wFunctionalBuch(int *degw, int *lpol, int npol, double *rel, double wx, double wNsqr)
Definition: weight0.c:78

◆ list_cmd()

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

Definition at line 425 of file ipshell.cc.

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

◆ loNewtonP()

BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4647 of file ipshell.cc.

4648{
4649 res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4650 return FALSE;
4651}
ideal loNewtonPolytope(const ideal id)
Definition: mpr_base.cc:3190

◆ loSimplex()

BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4653 of file ipshell.cc.

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

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 3155 of file ipshell.cc.

3156{
3157 int i,j;
3158 matrix result;
3159 ideal id=(ideal)a->Data();
3160
3162 for (i=1; i<=IDELEMS(id); i++)
3163 {
3164 for (j=1; j<=rVar(currRing); j++)
3165 {
3166 MATELEM(result,i,j) = pDiff(id->m[i-1],j);
3167 }
3168 }
3169 res->data=(char *)result;
3170 return FALSE;
3171}
#define MATELEM(mat, i, j)
1-based access to matrix
Definition: matpol.h:29
#define pDiff(a, b)
Definition: polys.h:296

◆ mpKoszul()

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

Definition at line 3177 of file ipshell.cc.

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

◆ nuLagSolve()

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

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

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

Definition at line 4762 of file ipshell.cc.

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

◆ nuMPResMat()

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

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

Definition at line 4739 of file ipshell.cc.

4740{
4741 ideal gls = (ideal)(arg1->Data());
4742 int imtype= (int)(long)arg2->Data();
4743
4744 uResultant::resMatType mtype= determineMType( imtype );
4745
4746 // check input ideal ( = polynomial system )
4747 if ( mprIdealCheck( gls, arg1->Name(), mtype, true ) != mprOk )
4748 {
4749 return TRUE;
4750 }
4751
4752 uResultant *resMat= new uResultant( gls, mtype, false );
4753 if (resMat!=NULL)
4754 {
4755 res->rtyp = MODUL_CMD;
4756 res->data= (void*)resMat->accessResMat()->getMatrix();
4757 if (!errorreported) delete resMat;
4758 }
4759 return errorreported;
4760}
virtual ideal getMatrix()
Definition: mpr_base.h:31
Base class for solving 0-dim poly systems using u-resultant.
Definition: mpr_base.h:63
resMatrixBase * accessResMat()
Definition: mpr_base.h:78
@ mprOk
Definition: mpr_base.h:98
uResultant::resMatType determineMType(int imtype)
mprState mprIdealCheck(const ideal theIdeal, const char *name, uResultant::resMatType mtype, BOOLEAN rmatrix=false)

◆ nuUResSolve()

BOOLEAN nuUResSolve ( leftv  res,
leftv  args 
)

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

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

Definition at line 5006 of file ipshell.cc.

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

◆ nuVanderSys()

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

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

Definition at line 4905 of file ipshell.cc.

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

◆ paPrint()

void paPrint ( const char *  n,
package  p 
)

Definition at line 6408 of file ipshell.cc.

6409{
6410 Print(" %s (",n);
6411 switch (p->language)
6412 {
6413 case LANG_SINGULAR: PrintS("S"); break;
6414 case LANG_C: PrintS("C"); break;
6415 case LANG_TOP: PrintS("T"); break;
6416 case LANG_MAX: PrintS("M"); break;
6417 case LANG_NONE: PrintS("N"); break;
6418 default: PrintS("U");
6419 }
6420 if(p->libname!=NULL)
6421 Print(",%s", p->libname);
6422 PrintS(")");
6423}
@ LANG_MAX
Definition: subexpr.h:22
@ LANG_TOP
Definition: subexpr.h:22

◆ rCompose()

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

Definition at line 2868 of file ipshell.cc.

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

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2157 of file ipshell.cc.

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

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1955 of file ipshell.cc.

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

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 2026 of file ipshell.cc.

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

◆ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1650 of file ipshell.cc.

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

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1707 of file ipshell.cc.

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

◆ rInit()

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

Definition at line 5709 of file ipshell.cc.

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

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6301 of file ipshell.cc.

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

◆ rKill() [2/2]

void rKill ( ring  r)

Definition at line 6255 of file ipshell.cc.

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

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5210 of file ipshell.cc.

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

◆ scIndIndset()

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

Definition at line 1103 of file ipshell.cc.

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

◆ semicProc()

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

Definition at line 4635 of file ipshell.cc.

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

◆ semicProc3()

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

Definition at line 4595 of file ipshell.cc.

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

◆ setOption()

BOOLEAN setOption ( leftv  res,
leftv  v 
)

Definition at line 576 of file misc_ip.cc.

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

◆ showOption()

char * showOption ( )

Definition at line 717 of file misc_ip.cc.

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

◆ singular_example()

void singular_example ( char *  str)

Definition at line 438 of file misc_ip.cc.

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

◆ singular_system()

leftv singular_system ( sleftv  h)

◆ spaddProc()

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

Definition at line 4512 of file ipshell.cc.

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

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv  result,
leftv  first 
)

Definition at line 4268 of file ipshell.cc.

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

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4217 of file ipshell.cc.

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

◆ spmulProc()

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

Definition at line 4554 of file ipshell.cc.

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

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3256 of file ipshell.cc.

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

◆ syBetti2()

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

Definition at line 3233 of file ipshell.cc.

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

◆ syConvList()

syStrategy syConvList ( lists  li)

Definition at line 3340 of file ipshell.cc.

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

◆ syConvRes()

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

Definition at line 3268 of file ipshell.cc.

3269{
3270 resolvente fullres = syzstr->fullres;
3271 resolvente minres = syzstr->minres;
3272
3273 const int length = syzstr->length;
3274
3275 if ((fullres==NULL) && (minres==NULL))
3276 {
3277 if (syzstr->hilb_coeffs==NULL)
3278 { // La Scala
3279 fullres = syReorder(syzstr->res, length, syzstr);
3280 }
3281 else
3282 { // HRES
3283 minres = syReorder(syzstr->orderedRes, length, syzstr);
3284 syKillEmptyEntres(minres, length);
3285 }
3286 }
3287
3288 resolvente tr;
3289 int typ0=IDEAL_CMD;
3290
3291 if (minres!=NULL)
3292 tr = minres;
3293 else
3294 tr = fullres;
3295
3296 resolvente trueres=NULL;
3297 intvec ** w=NULL;
3298
3299 if (length>0)
3300 {
3301 trueres = (resolvente)omAlloc0((length)*sizeof(ideal));
3302 for (int i=length-1;i>=0;i--)
3303 {
3304 if (tr[i]!=NULL)
3305 {
3306 trueres[i] = idCopy(tr[i]);
3307 }
3308 }
3309 if ( id_RankFreeModule(trueres[0], currRing) > 0)
3310 typ0 = MODUL_CMD;
3311 if (syzstr->weights!=NULL)
3312 {
3313 w = (intvec**)omAlloc0(length*sizeof(intvec*));
3314 for (int i=length-1;i>=0;i--)
3315 {
3316 if (syzstr->weights[i]!=NULL) w[i] = ivCopy(syzstr->weights[i]);
3317 }
3318 }
3319 }
3320
3321 lists li = liMakeResolv(trueres, length, syzstr->list_length,typ0,
3322 w, add_row_shift);
3323
3324 if (toDel)
3325 syKillComputation(syzstr);
3326 else
3327 {
3328 if( fullres != NULL && syzstr->fullres == NULL )
3329 syzstr->fullres = fullres;
3330
3331 if( minres != NULL && syzstr->minres == NULL )
3332 syzstr->minres = minres;
3333 }
3334 return li;
3335}
long id_RankFreeModule(ideal s, ring lmRing, ring tailRing)
return the maximal component number found in any polynomial in s
intvec ** hilb_coeffs
Definition: syz.h:46
resolvente minres
Definition: syz.h:58
void syKillComputation(syStrategy syzstr, ring r=currRing)
Definition: syz1.cc:1495
resolvente syReorder(resolvente res, int length, syStrategy syzstr, BOOLEAN toCopy=TRUE, resolvente totake=NULL)
Definition: syz1.cc:1641
void syKillEmptyEntres(resolvente res, int length)
Definition: syz1.cc:2199
short list_length
Definition: syz.h:62
resolvente res
Definition: syz.h:47
resolvente fullres
Definition: syz.h:57
intvec ** weights
Definition: syz.h:45
resolvente orderedRes
Definition: syz.h:48
int length
Definition: syz.h:60

◆ syForceMin()

syStrategy syForceMin ( lists  li)

Definition at line 3369 of file ipshell.cc.

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

◆ test_cmd()

void test_cmd ( int  i)

Definition at line 514 of file ipshell.cc.

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

◆ Tok2Cmdname()

const char * Tok2Cmdname ( int  i)

Definition at line 140 of file gentable.cc.

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

◆ type_cmd()

void type_cmd ( leftv  v)

Definition at line 254 of file ipshell.cc.

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

◆ versionString()

char * versionString ( )

Definition at line 778 of file misc_ip.cc.

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

◆ dArith3

const struct sValCmd3 dArith3[]
extern

Definition at line 770 of file table.h.

◆ dArithM

const struct sValCmdM dArithM[]
extern

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