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

Go to the source code of this file.

Data Structures

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

Typedefs

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

Functions

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

Variables

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

Data Structure Documentation

◆ sValCmd1

struct sValCmd1

Definition at line 78 of file gentable.cc.

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

◆ sValCmd2

struct sValCmd2

Definition at line 69 of file gentable.cc.

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

◆ sValCmd3

struct sValCmd3

Definition at line 86 of file gentable.cc.

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

◆ sValCmdM

struct sValCmdM

Definition at line 96 of file gentable.cc.

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

◆ sValAssign_sys

struct sValAssign_sys

Definition at line 104 of file gentable.cc.

Data Fields
short arg
int p
proc1 p
short res

◆ sValAssign

struct sValAssign

Definition at line 111 of file gentable.cc.

Data Fields
short arg
int p
proci p
short res

Typedef Documentation

◆ proc1

typedef BOOLEAN(* proc1) (leftv, leftv)

Definition at line 122 of file ipshell.h.

◆ proc2

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

Definition at line 134 of file ipshell.h.

◆ proc3

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

Definition at line 145 of file ipshell.h.

◆ proci

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

Definition at line 175 of file ipshell.h.

Function Documentation

◆ exprlist_length()

int exprlist_length ( leftv  v)

Definition at line 552 of file ipshell.cc.

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

◆ ii_CallLibProcM()

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

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

Definition at line 701 of file iplib.cc.

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

◆ ii_CallProcId2Id()

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

Definition at line 661 of file iplib.cc.

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

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

◆ iiAddCproc()

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

Definition at line 1063 of file iplib.cc.

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

813{
814 if (iiCurrArgs==NULL)
815 {
816 Werror("not enough arguments for proc %s",VoiceName());
817 p->CleanUp();
818 return TRUE;
819 }
821 iiCurrArgs=h->next;
822 h->next=NULL;
823 if (h->rtyp!=IDHDL)
824 {
826 h->CleanUp();
828 return res;
829 }
830 if ((h->Typ()!=p->Typ()) &&(p->Typ()!=DEF_CMD))
831 {
832 WerrorS("type mismatch");
833 return TRUE;
834 }
835 idhdl pp=(idhdl)p->data;
836 switch(pp->typ)
837 {
838 case CRING_CMD:
840 break;
841 case DEF_CMD:
842 case INT_CMD:
843 break;
844 case INTVEC_CMD:
845 case INTMAT_CMD:
846 delete IDINTVEC(pp);
847 break;
848 case NUMBER_CMD:
850 break;
851 case BIGINT_CMD:
853 break;
854 case MAP_CMD:
855 {
856 map im = IDMAP(pp);
857 omFree((ADDRESS)im->preimage);
858 im->preimage=NULL;// and continue
859 }
860 // continue as ideal:
861 case IDEAL_CMD:
862 case MODUL_CMD:
863 case MATRIX_CMD:
865 break;
866 case PROC_CMD:
867 case RESOLUTION_CMD:
868 case STRING_CMD:
870 break;
871 case LIST_CMD:
872 IDLIST(pp)->Clean();
873 break;
874 case LINK_CMD:
876 break;
877 // case ring: cannot happen
878 default:
879 Werror("unknown type %d",p->Typ());
880 return TRUE;
881 }
882 pp->typ=ALIAS_CMD;
883 IDDATA(pp)=(char*)h->data;
884 int eff_typ=h->Typ();
885 if ((RingDependend(eff_typ))
886 || ((eff_typ==LIST_CMD) && (lRingDependend((lists)h->Data()))))
887 {
888 ipSwapId(pp,IDROOT,currRing->idroot);
889 }
890 h->CleanUp();
892 return FALSE;
893}
void * ADDRESS
Definition: auxiliary.h:119
CanonicalForm FACTORY_PUBLIC pp(const CanonicalForm &)
CanonicalForm pp ( const CanonicalForm & f )
Definition: cf_gcd.cc:676
int p
Definition: cfModGcd.cc:4077
CanonicalForm map(const CanonicalForm &primElem, const Variable &alpha, const CanonicalForm &F, const Variable &beta)
map from to such that is mapped onto
Definition: cf_map_ext.cc:504
Definition: lists.h:24
static FORCE_INLINE void n_Delete(number *p, const coeffs r)
delete 'p'
Definition: coeffs.h:455
void nKillChar(coeffs r)
undo all initialisations
Definition: numbers.cc:522
CanonicalForm res
Definition: facAbsFact.cc:60
void WerrorS(const char *s)
Definition: feFopen.cc:24
const char * VoiceName()
Definition: fevoices.cc:56
@ MAP_CMD
Definition: grammar.cc:285
@ RESOLUTION_CMD
Definition: grammar.cc:290
#define idDelete(H)
delete an ideal
Definition: ideals.h:29
BOOLEAN iiAssign(leftv l, leftv r, BOOLEAN toplevel)
Definition: ipassign.cc:1963
static int ipSwapId(idhdl tomove, idhdl &root1, idhdl &root2)
Definition: ipid.cc:647
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 298 of file iplib.cc.

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

◆ iiApply()

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

Definition at line 6425 of file ipshell.cc.

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

◆ iiARROW()

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

Definition at line 6474 of file ipshell.cc.

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

◆ iiAssign()

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

Definition at line 1963 of file ipassign.cc.

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

◆ iiAssignCR()

BOOLEAN iiAssignCR ( leftv  r,
leftv  arg 
)

Definition at line 6508 of file ipshell.cc.

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

◆ iiBranchTo()

BOOLEAN iiBranchTo ( leftv  r,
leftv  args 
)

Definition at line 1277 of file ipshell.cc.

1278{
1279 // must be inside a proc, as we simultae an proc_end at the end
1280 if (myynest==0)
1281 {
1282 WerrorS("branchTo can only occur in a proc");
1283 return TRUE;
1284 }
1285 // <string1...stringN>,<proc>
1286 // known: args!=NULL, l>=1
1287 int l=args->listLength();
1288 int ll=0;
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:799
#define IDID(a)
Definition: ipid.h:122
char * iiGetLibProcBuffer(procinfo *pi, int part)
Definition: iplib.cc:197
VAR idhdl iiCurrProc
Definition: ipshell.cc:81
void iiCheckPack(package &p)
Definition: ipshell.cc:1634
BOOLEAN iiCheckTypes(leftv args, const short *type_list, int report)
check a list of arguemys against a given field of types return TRUE if the types match return FALSE (...
Definition: ipshell.cc:6566
void killlocals(int v)
Definition: ipshell.cc:386
void myychangebuffer()
Definition: scanner.cc:2331

◆ iiCallLibProc1()

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

Definition at line 627 of file iplib.cc.

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

◆ iiCheckPack()

void iiCheckPack ( package p)

Definition at line 1634 of file ipshell.cc.

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

◆ iiCheckRing()

BOOLEAN iiCheckRing ( int  i)

Definition at line 1590 of file ipshell.cc.

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

◆ iiCheckTypes()

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

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

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

Definition at line 6566 of file ipshell.cc.

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

◆ iiConvName()

char * iiConvName ( const char *  libname)

Definition at line 1429 of file iplib.cc.

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

◆ iiDebug()

void iiDebug ( )

Definition at line 1065 of file ipshell.cc.

1066{
1067#ifdef HAVE_SDB
1068 sdb_flags=1;
1069#endif
1070 Print("\n-- break point in %s --\n",VoiceName());
1072 char * s;
1074 s = (char *)omAlloc(BREAK_LINE_LENGTH+4);
1075 loop
1076 {
1077 memset(s,0,BREAK_LINE_LENGTH+4);
1079 if (s[BREAK_LINE_LENGTH-1]!='\0')
1080 {
1081 Print("line too long, max is %d chars\n",BREAK_LINE_LENGTH);
1082 }
1083 else
1084 break;
1085 }
1086 if (*s=='\n')
1087 {
1089 }
1090#if MDEBUG
1091 else if(strncmp(s,"cont;",5)==0)
1092 {
1094 }
1095#endif /* MDEBUG */
1096 else
1097 {
1098 strcat( s, "\n;~\n");
1100 }
1101}
char *(* fe_fgets_stdin)(const char *pr, char *s, int size)
Definition: feread.cc: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 754 of file iplib.cc.

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

◆ iiExport() [1/2]

BOOLEAN iiExport ( leftv  v,
int  toLev 
)

Definition at line 1515 of file ipshell.cc.

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

◆ iiExport() [2/2]

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

Definition at line 1538 of file ipshell.cc.

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

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

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

8860{
8861 res->Init();
8862 leftv b=a->next;
8863 a->next=NULL;
8864 int bt=b->Typ();
8866 a->next=b;
8867 a->CleanUp(); // to clean up the chain, content already done in iiExprArith2TabIntern
8868 return bo;
8869}
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:8697

◆ iiExprArith3()

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

Definition at line 9269 of file iparith.cc.

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

9325{
9326 res->Init();
9327 leftv b=a->next;
9328 a->next=NULL;
9329 int bt=b->Typ();
9330 leftv c=b->next;
9331 b->next=NULL;
9332 int ct=c->Typ();
9333 BOOLEAN bo=iiExprArith3TabIntern(res,op,a,b,c,dA3,at,bt,ct,dConvertTypes);
9334 b->next=c;
9335 a->next=b;
9336 a->CleanUp(); // to cleanup the chain, content already done
9337 return bo;
9338}

◆ iiExprArithM()

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

◆ iiGetLibName()

static char * iiGetLibName ( const procinfov  pi)
inlinestatic

find the library of an proc

Definition at line 66 of file ipshell.h.

66{ return pi->libname; }

◆ iiGetLibProcBuffer()

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

◆ iiGetLibStatus()

BOOLEAN iiGetLibStatus ( const char *  lib)

Definition at line 77 of file iplib.cc.

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

◆ iiHighCorner()

poly iiHighCorner ( ideal  i,
int  ak 
)

Definition at line 1610 of file ipshell.cc.

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

◆ iiInternalExport()

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

Definition at line 1469 of file ipshell.cc.

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

◆ iiLibCmd()

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

Definition at line 884 of file iplib.cc.

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

◆ iiLoadLIB()

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

Definition at line 973 of file iplib.cc.

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

◆ iiLocateLib()

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

Definition at line 870 of file iplib.cc.

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

◆ iiMake_proc()

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

Definition at line 504 of file iplib.cc.

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

◆ iiMakeResolv()

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

Definition at line 847 of file ipshell.cc.

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

◆ iiMap()

leftv iiMap ( map  theMap,
const char *  what 
)

Definition at line 615 of file ipshell.cc.

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

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

◆ iiProcName()

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

Definition at line 100 of file iplib.cc.

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

◆ iiPStart()

BOOLEAN iiPStart ( idhdl  pn,
leftv  sl 
)

Definition at line 371 of file iplib.cc.

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

◆ iiRegularity()

int iiRegularity ( lists  L)

Definition at line 1037 of file ipshell.cc.

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

◆ iiSetReturn()

void iiSetReturn ( const leftv  h)

Definition at line 6595 of file ipshell.cc.

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

◆ iiTestAssume()

BOOLEAN iiTestAssume ( leftv  a,
leftv  b 
)

Definition at line 6447 of file ipshell.cc.

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

◆ iiTokType()

int iiTokType ( int  op)

Definition at line 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 823 of file iplib.cc.

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

◆ iiTwoOps()

const char * iiTwoOps ( int  t)

Definition at line 261 of file gentable.cc.

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

◆ iiWRITE()

BOOLEAN iiWRITE ( leftv  res,
leftv  exprlist 
)

Definition at line 588 of file ipshell.cc.

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

◆ IsCmd()

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

Definition at line 9469 of file iparith.cc.

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

3351{
3352 res->data=singclap_irrCharSeries((ideal)u->Data(), currRing);
3353 return (res->data==NULL);
3354}
matrix singclap_irrCharSeries(ideal I, const ring r)
Definition: clapsing.cc:1548

◆ jjIMPORTFROM()

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

Definition at line 2369 of file ipassign.cc.

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

◆ jjLIST_PL()

BOOLEAN jjLIST_PL ( leftv  res,
leftv  v 
)

Definition at line 7944 of file iparith.cc.

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

◆ jjLOAD()

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

load lib/module given in v

Definition at line 5466 of file iparith.cc.

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

◆ jjLOAD_TRY()

BOOLEAN jjLOAD_TRY ( const char *  s)

Definition at line 5542 of file iparith.cc.

5543{
5544 if (!iiGetLibStatus(s))
5545 {
5546 void (*WerrorS_save)(const char *s) = WerrorS_callback;
5549 BOOLEAN bo=jjLOAD(s,TRUE);
5550 if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
5551 Print("loading of >%s< failed\n",s);
5552 WerrorS_callback=WerrorS_save;
5553 errorreported=0;
5554 }
5555 return FALSE;
5556}
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:5466
STATIC_VAR int WerrorS_dummy_cnt
Definition: iparith.cc:5537
static void WerrorS_dummy(const char *)
Definition: iparith.cc:5538
BOOLEAN iiGetLibStatus(const char *lib)
Definition: iplib.cc:77
#define TEST_OPT_PROT
Definition: options.h:103

◆ jjMINRES()

BOOLEAN jjMINRES ( leftv  res,
leftv  v 
)

Definition at line 946 of file ipshell.cc.

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

◆ jjRESULTANT()

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

Definition at line 3343 of file ipshell.cc.

3344{
3345 res->data=singclap_resultant((poly)u->CopyD(),(poly)v->CopyD(),
3346 (poly)w->CopyD(), currRing);
3347 return errorreported;
3348}
poly singclap_resultant(poly f, poly g, poly x, const ring r)
Definition: clapsing.cc:322

◆ 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:4082
static FORCE_INLINE number n_Copy(number n, const coeffs r)
return a copy of 'n'
Definition: coeffs.h:451
@ n_algExt
used for all algebraic extensions, i.e., the top-most extension in an extension tower is algebraic
Definition: coeffs.h:35
coeffs nInitChar(n_coeffType t, void *parameter)
one-time initialisations for new coeffs in case of an error return NULL
Definition: numbers.cc:354
static FORCE_INLINE BOOLEAN n_IsZero(number n, const coeffs r)
TRUE iff 'n' represents the zero element.
Definition: coeffs.h:464
static FORCE_INLINE BOOLEAN nCoeff_is_algExt(const coeffs r)
TRUE iff r represents an algebraic extension field.
Definition: coeffs.h:910
static FORCE_INLINE void n_Normalize(number &n, const coeffs r)
inplace-normalization of n; produces some canonical representation of n;
Definition: coeffs.h:578
static FORCE_INLINE BOOLEAN nCoeff_is_transExt(const coeffs r)
TRUE iff r represents a transcendental extension field.
Definition: coeffs.h:918
omBin_t * omBin
Definition: omStructs.h:12
static BOOLEAN p_IsConstant(const poly p, const ring r)
Definition: p_polys.h:1983
@ 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 229 of file extra.cc.

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

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

◆ jjVARIABLES_P()

BOOLEAN jjVARIABLES_P ( leftv  res,
leftv  u 
)

Definition at line 6304 of file ipshell.cc.

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

◆ killlocals()

void killlocals ( int  v)

Definition at line 386 of file ipshell.cc.

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

◆ kQHWeight()

BOOLEAN kQHWeight ( leftv  res,
leftv  v 
)

Definition at line 3326 of file ipshell.cc.

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

◆ kWeight()

BOOLEAN kWeight ( leftv  res,
leftv  id 
)

Definition at line 3304 of file ipshell.cc.

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

◆ list_cmd()

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

Definition at line 425 of file ipshell.cc.

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

◆ loNewtonP()

BOOLEAN loNewtonP ( leftv  res,
leftv  arg1 
)

compute Newton Polytopes of input polynomials

Definition at line 4566 of file ipshell.cc.

4567{
4568 res->data= (void*)loNewtonPolytope( (ideal)arg1->Data() );
4569 return FALSE;
4570}
ideal loNewtonPolytope(const ideal id)
Definition: mpr_base.cc:3190

◆ loSimplex()

BOOLEAN loSimplex ( leftv  res,
leftv  args 
)

Implementation of the Simplex Algorithm.

For args, see class simplex.

Definition at line 4572 of file ipshell.cc.

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

◆ mpJacobi()

BOOLEAN mpJacobi ( leftv  res,
leftv  a 
)

Definition at line 3074 of file ipshell.cc.

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

◆ mpKoszul()

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

Definition at line 3096 of file ipshell.cc.

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

◆ nuLagSolve()

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

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

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

Definition at line 4681 of file ipshell.cc.

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

◆ nuMPResMat()

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

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

Definition at line 4658 of file ipshell.cc.

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

◆ nuUResSolve()

BOOLEAN nuUResSolve ( leftv  res,
leftv  args 
)

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

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

Definition at line 4925 of file ipshell.cc.

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

◆ nuVanderSys()

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

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

Definition at line 4824 of file ipshell.cc.

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

◆ paPrint()

void paPrint ( const char *  n,
package  p 
)

Definition at line 6327 of file ipshell.cc.

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

◆ rCompose()

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

Definition at line 2787 of file ipshell.cc.

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

◆ rDecompose()

lists rDecompose ( const ring  r)

Definition at line 2165 of file ipshell.cc.

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

◆ rDecompose_CF()

BOOLEAN rDecompose_CF ( leftv  res,
const coeffs  C 
)

Definition at line 1953 of file ipshell.cc.

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

◆ rDecompose_list_cf()

lists rDecompose_list_cf ( const ring  r)

Definition at line 2126 of file ipshell.cc.

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

◆ rDefault()

idhdl rDefault ( const char *  s)

Definition at line 1648 of file ipshell.cc.

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

◆ rFindHdl()

idhdl rFindHdl ( ring  r,
idhdl  n 
)

Definition at line 1705 of file ipshell.cc.

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

◆ rInit()

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

Definition at line 5628 of file ipshell.cc.

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

◆ rKill() [1/2]

void rKill ( idhdl  h)

Definition at line 6220 of file ipshell.cc.

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

◆ rKill() [2/2]

void rKill ( ring  r)

Definition at line 6174 of file ipshell.cc.

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

◆ rSetHdl()

void rSetHdl ( idhdl  h)

Definition at line 5129 of file ipshell.cc.

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

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

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

◆ semicProc3()

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

Definition at line 4514 of file ipshell.cc.

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

◆ setOption()

BOOLEAN setOption ( leftv  res,
leftv  v 
)

Definition at line 568 of file misc_ip.cc.

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

◆ showOption()

char * showOption ( )

Definition at line 709 of file misc_ip.cc.

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

◆ singular_example()

void singular_example ( char *  str)

Definition at line 430 of file misc_ip.cc.

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

◆ singular_system()

leftv singular_system ( sleftv  h)

◆ spaddProc()

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

Definition at line 4431 of file ipshell.cc.

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

◆ spectrumfProc()

BOOLEAN spectrumfProc ( leftv  result,
leftv  first 
)

Definition at line 4187 of file ipshell.cc.

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

◆ spectrumProc()

BOOLEAN spectrumProc ( leftv  result,
leftv  first 
)

Definition at line 4136 of file ipshell.cc.

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

◆ spmulProc()

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

Definition at line 4473 of file ipshell.cc.

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

◆ syBetti1()

BOOLEAN syBetti1 ( leftv  res,
leftv  u 
)

Definition at line 3175 of file ipshell.cc.

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

◆ syBetti2()

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

Definition at line 3152 of file ipshell.cc.

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

◆ syConvList()

syStrategy syConvList ( lists  li)

Definition at line 3259 of file ipshell.cc.

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

◆ syConvRes()

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

Definition at line 3187 of file ipshell.cc.

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

◆ syForceMin()

syStrategy syForceMin ( lists  li)

Definition at line 3288 of file ipshell.cc.

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

◆ test_cmd()

void test_cmd ( int  i)

Definition at line 514 of file ipshell.cc.

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

◆ Tok2Cmdname()

const char * Tok2Cmdname ( int  i)

Definition at line 140 of file gentable.cc.

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

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

Variable Documentation

◆ currid

const char* currid
extern

Definition at line 171 of file grammar.cc.

◆ dArith1

const struct sValCmd1 dArith1[]
extern

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