source: git/Singular/iparith.cc @ a4771e1

spielwiese
Last change on this file since a4771e1 was a4771e1, checked in by Oleksandr Motsak <motsak@…>, 9 years ago
Separation of hilbert function into kernel/combinatorics/hilb.h + include cleanup
  • Property mode set to 100644
File size: 219.4 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4
5/*
6* ABSTRACT: table driven kernel interface, used by interpreter
7*/
8
9
10#include <kernel/mod2.h>
11
12#include <omalloc/omalloc.h>
13
14#include <factory/factory.h>
15
16#include <coeffs/bigintmat.h>
17#include <coeffs/coeffs.h>
18#include <coeffs/numbers.h>
19
20#ifdef HAVE_RINGS
21#include <coeffs/rmodulon.h>
22#include <coeffs/rmodulo2m.h>
23#include <coeffs/rintegers.h>
24#endif
25
26#include <misc/options.h>
27#include <misc/intvec.h>
28#include <misc/sirandom.h>
29
30#include <polys/prCopy.h>
31#include <polys/matpol.h>
32#include <polys/monomials/maps.h>
33#include <polys/coeffrings.h>
34#include <polys/sparsmat.h>
35#include <polys/weight.h>
36#include <polys/ext_fields/transext.h>
37#include <polys/clapsing.h>
38
39#include <kernel/combinatorics/stairc.h>
40#include <kernel/combinatorics/hilb.h>
41
42#include <kernel/linear_algebra/interpolation.h>
43#include <kernel/linear_algebra/linearAlgebra.h>
44#include <kernel/linear_algebra/MinorInterface.h>
45
46#include <kernel/spectrum/GMPrat.h>
47#include <kernel/groebner_walk/walkProc.h>
48#include <kernel/oswrapper/timer.h>
49#include <kernel/fglm/fglm.h>
50
51#include <kernel/GBEngine/kstdfac.h>
52#include <kernel/GBEngine/syz.h>
53#include <kernel/GBEngine/kstd1.h>
54#include <kernel/GBEngine/units.h>
55#include <kernel/GBEngine/tgb.h>
56
57#include <kernel/preimage.h>
58#include <kernel/polys.h>
59#include <kernel/ideals.h>
60
61#include <Singular/mod_lib.h>
62#include <Singular/fevoices.h>
63#include <Singular/tok.h>
64#include <Singular/ipid.h>
65#include <Singular/sdb.h>
66#include <Singular/subexpr.h>
67#include <Singular/lists.h>
68#include <Singular/maps_ip.h>
69
70#include <Singular/ipconv.h>
71#include <Singular/ipprint.h>
72#include <Singular/attrib.h>
73#include <Singular/links/silink.h>
74#include <Singular/misc_ip.h>
75#include <Singular/linearAlgebra_ip.h>
76
77#ifdef SINGULAR_4_1
78#include <Singular/number2.h>
79#endif
80
81#  include <Singular/fglm.h>
82
83#include <Singular/blackbox.h>
84#include <Singular/newstruct.h>
85#include <Singular/ipshell.h>
86//#include <kernel/mpr_inout.h>
87
88#include <reporter/si_signals.h>
89
90
91#include <stdlib.h>
92#include <string.h>
93#include <ctype.h>
94#include <stdio.h>
95#include <time.h>
96#include <unistd.h>
97#include <vector>
98
99lists rDecompose(const ring r);
100ring rCompose(const lists  L, const BOOLEAN check_comp=TRUE);
101
102
103// defaults for all commands: NO_PLURAL | NO_RING | ALLOW_ZERODIVISOR
104
105#ifdef HAVE_PLURAL
106  #include <kernel/GBEngine/ratgring.h>
107  #include <kernel/GBEngine/nc.h>
108  #include <polys/nc/nc.h>
109  #include <polys/nc/sca.h>
110  #define ALLOW_PLURAL     1
111  #define NO_PLURAL        0
112  #define COMM_PLURAL      2
113  #define  PLURAL_MASK 3
114#else /* HAVE_PLURAL */
115  #define ALLOW_PLURAL     0
116  #define NO_PLURAL        0
117  #define COMM_PLURAL      0
118  #define  PLURAL_MASK     0
119#endif /* HAVE_PLURAL */
120
121#ifdef HAVE_RINGS
122  #define RING_MASK        4
123  #define ZERODIVISOR_MASK 8
124#else
125  #define RING_MASK        0
126  #define ZERODIVISOR_MASK 0
127#endif
128#define ALLOW_RING       4
129#define NO_RING          0
130#define NO_ZERODIVISOR   8
131#define ALLOW_ZERODIVISOR  0
132
133// bit 4 for warning, if used at toplevel
134#define WARN_RING        16
135
136static BOOLEAN check_valid(const int p, const int op);
137
138#ifdef SINGULAR_4_1
139// helper routine to catch all library/test parts which need to be changed
140// shall go away after the transition
141static void iiReWrite(const char *s)
142{
143  Print("please rewrite the use of >>%s<< in >>%s<<\n"
144        "%s is depreciated or changed in Singular 4-1\n",s,my_yylinebuf,s);
145}
146#endif
147
148/*=============== types =====================*/
149struct sValCmdTab
150{
151  short cmd;
152  short start;
153};
154
155typedef sValCmdTab jjValCmdTab[];
156
157struct _scmdnames
158{
159  char *name;
160  short alias;
161  short tokval;
162  short toktype;
163};
164typedef struct _scmdnames cmdnames;
165
166
167typedef char * (*Proc1)(char *);
168struct sValCmd1
169{
170  proc1 p;
171  short cmd;
172  short res;
173  short arg;
174  short valid_for;
175};
176
177typedef BOOLEAN (*proc2)(leftv,leftv,leftv);
178struct sValCmd2
179{
180  proc2 p;
181  short cmd;
182  short res;
183  short arg1;
184  short arg2;
185  short valid_for;
186};
187
188typedef BOOLEAN (*proc3)(leftv,leftv,leftv,leftv);
189struct sValCmd3
190{
191  proc3 p;
192  short cmd;
193  short res;
194  short arg1;
195  short arg2;
196  short arg3;
197  short valid_for;
198};
199struct sValCmdM
200{
201  proc1 p;
202  short cmd;
203  short res;
204  short number_of_args; /* -1: any, -2: any >0, .. */
205  short valid_for;
206};
207
208typedef struct
209{
210  cmdnames *sCmds;             /**< array of existing commands */
211  struct sValCmd1 *psValCmd1;
212  struct sValCmd2 *psValCmd2;
213  struct sValCmd3 *psValCmd3;
214  struct sValCmdM *psValCmdM;
215  int nCmdUsed;      /**< number of commands used */
216  int nCmdAllocated; /**< number of commands-slots allocated */
217  int nLastIdentifier; /**< valid indentifieres are slot 1..nLastIdentifier */
218} SArithBase;
219
220/*---------------------------------------------------------------------*
221 * File scope Variables (Variables share by several functions in
222 *                       the same file )
223 *
224 *---------------------------------------------------------------------*/
225static SArithBase sArithBase;  /**< Base entry for arithmetic */
226
227/*---------------------------------------------------------------------*
228 * Extern Functions declarations
229 *
230 *---------------------------------------------------------------------*/
231static int _gentable_sort_cmds(const void *a, const void *b);
232extern int iiArithRemoveCmd(char *szName);
233extern int iiArithAddCmd(const char *szName, short nAlias, short nTokval,
234                         short nToktype, short nPos=-1);
235
236/*============= proc =======================*/
237static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op);
238static Subexpr jjMakeSub(leftv e);
239
240/*============= vars ======================*/
241extern int cmdtok;
242extern BOOLEAN expected_parms;
243
244#define ii_div_by_0 "div. by 0"
245
246int iiOp; /* the current operation*/
247
248/*=================== simple helpers =================*/
249poly pHeadProc(poly p)
250{
251  return pHead(p);
252}
253
254int iiTokType(int op)
255{
256  for (int i=0;i<sArithBase.nCmdUsed;i++)
257  {
258    if (sArithBase.sCmds[i].tokval==op)
259      return sArithBase.sCmds[i].toktype;
260  }
261  return 0;
262}
263
264/*=================== operations with 2 args.: static proc =================*/
265/* must be ordered: first operations for chars (infix ops),
266 * then alphabetically */
267
268static BOOLEAN jjOP_BIM_I(leftv res, leftv u, leftv v)
269{
270  bigintmat* aa= (bigintmat *)u->Data();
271  int bb = (int)(long)(v->Data());
272  if (errorreported) return TRUE;
273  bigintmat *cc=NULL;
274  switch (iiOp)
275  {
276    case '+': cc=bimAdd(aa,bb); break;
277    case '-': cc=bimSub(aa,bb); break;
278    case '*': cc=bimMult(aa,bb); break;
279  }
280  res->data=(char *)cc;
281  return cc==NULL;
282}
283static BOOLEAN jjOP_I_BIM(leftv res, leftv u, leftv v)
284{
285  return jjOP_BIM_I(res, v, u);
286}
287static BOOLEAN jjOP_BIM_BI(leftv res, leftv u, leftv v)
288{
289  bigintmat* aa= (bigintmat *)u->Data();
290  number bb = (number)(v->Data());
291  if (errorreported) return TRUE;
292  bigintmat *cc=NULL;
293  switch (iiOp)
294  {
295    case '*': cc=bimMult(aa,bb,coeffs_BIGINT); break;
296  }
297  res->data=(char *)cc;
298  return cc==NULL;
299}
300static BOOLEAN jjOP_BI_BIM(leftv res, leftv u, leftv v)
301{
302  return jjOP_BIM_BI(res, v, u);
303}
304static BOOLEAN jjOP_IV_I(leftv res, leftv u, leftv v)
305{
306  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
307  int bb = (int)(long)(v->Data());
308  if (errorreported) return TRUE;
309  switch (iiOp)
310  {
311    case '+': (*aa) += bb; break;
312    case '-': (*aa) -= bb; break;
313    case '*': (*aa) *= bb; break;
314    case '/':
315    case INTDIV_CMD: (*aa) /= bb; break;
316    case '%': (*aa) %= bb; break;
317  }
318  res->data=(char *)aa;
319  return FALSE;
320}
321static BOOLEAN jjOP_I_IV(leftv res, leftv u, leftv v)
322{
323  return jjOP_IV_I(res,v,u);
324}
325static BOOLEAN jjOP_IM_I(leftv res, leftv u, leftv v)
326{
327  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
328  int bb = (int)(long)(v->Data());
329  int i=si_min(aa->rows(),aa->cols());
330  switch (iiOp)
331  {
332    case '+': for (;i>0;i--) IMATELEM(*aa,i,i) += bb;
333              break;
334    case '-': for (;i>0;i--) IMATELEM(*aa,i,i) -= bb;
335              break;
336  }
337  res->data=(char *)aa;
338  return FALSE;
339}
340static BOOLEAN jjOP_I_IM(leftv res, leftv u, leftv v)
341{
342  return jjOP_IM_I(res,v,u);
343}
344static BOOLEAN jjCOLON(leftv res, leftv u, leftv v)
345{
346  int l=(int)(long)v->Data();
347  if (l>0)
348  {
349    int d=(int)(long)u->Data();
350    intvec *vv=new intvec(l);
351    int i;
352    for(i=l-1;i>=0;i--) { (*vv)[i]=d; }
353    res->data=(char *)vv;
354  }
355  return (l<=0);
356}
357static BOOLEAN jjDOTDOT(leftv res, leftv u, leftv v)
358{
359  res->data=(char *)new intvec((int)(long)u->Data(),(int)(long)v->Data());
360  return FALSE;
361}
362static void jjEQUAL_REST(leftv res,leftv u,leftv v);
363static BOOLEAN jjCOMPARE_IV(leftv res, leftv u, leftv v)
364{
365  intvec*    a = (intvec * )(u->Data());
366  intvec*    b = (intvec * )(v->Data());
367  int r=a->compare(b);
368  switch  (iiOp)
369  {
370    case '<':
371      res->data  = (char *) (r<0);
372      break;
373    case '>':
374      res->data  = (char *) (r>0);
375      break;
376    case LE:
377      res->data  = (char *) (r<=0);
378      break;
379    case GE:
380      res->data  = (char *) (r>=0);
381      break;
382    case EQUAL_EQUAL:
383    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
384      res->data  = (char *) (r==0);
385      break;
386  }
387  jjEQUAL_REST(res,u,v);
388  if(r==-2) { WerrorS("size incompatible"); return TRUE; }
389  return FALSE;
390}
391static BOOLEAN jjCOMPARE_BIM(leftv res, leftv u, leftv v)
392{
393  bigintmat*    a = (bigintmat * )(u->Data());
394  bigintmat*    b = (bigintmat * )(v->Data());
395  int r=a->compare(b);
396  switch  (iiOp)
397  {
398    case '<':
399      res->data  = (char *) (r<0);
400      break;
401    case '>':
402      res->data  = (char *) (r>0);
403      break;
404    case LE:
405      res->data  = (char *) (r<=0);
406      break;
407    case GE:
408      res->data  = (char *) (r>=0);
409      break;
410    case EQUAL_EQUAL:
411    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
412      res->data  = (char *) (r==0);
413      break;
414  }
415  jjEQUAL_REST(res,u,v);
416  if(r==-2) { WerrorS("size incompatible"); return TRUE; }
417  return FALSE;
418}
419static BOOLEAN jjCOMPARE_IV_I(leftv res, leftv u, leftv v)
420{
421  intvec* a = (intvec * )(u->Data());
422  int     b = (int)(long)(v->Data());
423  int r=a->compare(b);
424  switch  (iiOp)
425  {
426    case '<':
427      res->data  = (char *) (r<0);
428      break;
429    case '>':
430      res->data  = (char *) (r>0);
431      break;
432    case LE:
433      res->data  = (char *) (r<=0);
434      break;
435    case GE:
436      res->data  = (char *) (r>=0);
437      break;
438    case EQUAL_EQUAL:
439    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
440      res->data  = (char *) (r==0);
441      break;
442  }
443  jjEQUAL_REST(res,u,v);
444  return FALSE;
445}
446static BOOLEAN jjCOMPARE_P(leftv res, leftv u, leftv v)
447{
448  poly p=(poly)u->Data();
449  poly q=(poly)v->Data();
450  int r=pCmp(p,q);
451  if (r==0)
452  {
453    number h=nSub(pGetCoeff(p),pGetCoeff(q));
454    /* compare lead coeffs */
455    r = -1+nIsZero(h)+2*nGreaterZero(h); /* -1: <, 0:==, 1: > */
456    nDelete(&h);
457  }
458  else if (p==NULL)
459  {
460    if (q==NULL)
461    {
462      /* compare 0, 0 */
463      r=0;
464    }
465    else if(pIsConstant(q))
466    {
467      /* compare 0, const */
468      r = 1-2*nGreaterZero(pGetCoeff(q)); /* -1: <, 1: > */
469    }
470  }
471  else if (q==NULL)
472  {
473    if (pIsConstant(p))
474    {
475      /* compare const, 0 */
476      r = -1+2*nGreaterZero(pGetCoeff(p)); /* -1: <, 1: > */
477    }
478  }
479  switch  (iiOp)
480  {
481    case '<':
482      res->data  = (char *) (r < 0);
483      break;
484    case '>':
485      res->data  = (char *) (r > 0);
486      break;
487    case LE:
488      res->data  = (char *) (r <= 0);
489      break;
490    case GE:
491      res->data  = (char *) (r >= 0);
492      break;
493    //case EQUAL_EQUAL:
494    //case NOTEQUAL: /* negation handled by jjEQUAL_REST */
495    //  res->data  = (char *) (r == 0);
496    //  break;
497  }
498  jjEQUAL_REST(res,u,v);
499  return FALSE;
500}
501static BOOLEAN jjCOMPARE_S(leftv res, leftv u, leftv v)
502{
503  char*    a = (char * )(u->Data());
504  char*    b = (char * )(v->Data());
505  int result = strcmp(a,b);
506  switch  (iiOp)
507  {
508    case '<':
509      res->data  = (char *) (result  < 0);
510      break;
511    case '>':
512      res->data  = (char *) (result  > 0);
513      break;
514    case LE:
515      res->data  = (char *) (result  <= 0);
516      break;
517    case GE:
518      res->data  = (char *) (result  >= 0);
519      break;
520    case EQUAL_EQUAL:
521    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
522      res->data  = (char *) (result  == 0);
523      break;
524  }
525  jjEQUAL_REST(res,u,v);
526  return FALSE;
527}
528static BOOLEAN jjOP_REST(leftv res, leftv u, leftv v)
529{
530  if (u->Next()!=NULL)
531  {
532    u=u->next;
533    res->next = (leftv)omAllocBin(sleftv_bin);
534    return iiExprArith2(res->next,u,iiOp,v);
535  }
536  else if (v->Next()!=NULL)
537  {
538    v=v->next;
539    res->next = (leftv)omAllocBin(sleftv_bin);
540    return iiExprArith2(res->next,u,iiOp,v);
541  }
542  return FALSE;
543}
544static BOOLEAN jjPOWER_I(leftv res, leftv u, leftv v)
545{
546  int b=(int)(long)u->Data();
547  int e=(int)(long)v->Data();
548  int rc = 1;
549  BOOLEAN overflow=FALSE;
550  if (e >= 0)
551  {
552    if (b==0)
553    {
554      rc=(e==0);
555    }
556    else if ((e==0)||(b==1))
557    {
558      rc= 1;
559    }
560    else if (b== -1)
561    {
562      if (e&1) rc= -1;
563      else     rc= 1;
564    }
565    else
566    {
567      int oldrc;
568      while ((e--)!=0)
569      {
570        oldrc=rc;
571        rc *= b;
572        if (!overflow)
573        {
574          if(rc/b!=oldrc) overflow=TRUE;
575        }
576      }
577      if (overflow)
578        WarnS("int overflow(^), result may be wrong");
579    }
580    res->data = (char *)((long)rc);
581    if (u!=NULL) return jjOP_REST(res,u,v);
582    return FALSE;
583  }
584  else
585  {
586    WerrorS("exponent must be non-negative");
587    return TRUE;
588  }
589}
590static BOOLEAN jjPOWER_BI(leftv res, leftv u, leftv v)
591{
592  int e=(int)(long)v->Data();
593  number n=(number)u->Data();
594  if (e>=0)
595  {
596    n_Power(n,e,(number*)&res->data,coeffs_BIGINT);
597  }
598  else
599  {
600    WerrorS("exponent must be non-negative");
601    return TRUE;
602  }
603  if (u!=NULL) return jjOP_REST(res,u,v);
604  return FALSE;
605}
606static BOOLEAN jjPOWER_N(leftv res, leftv u, leftv v)
607{
608  int e=(int)(long)v->Data();
609  number n=(number)u->Data();
610  int d=0;
611  if (e<0)
612  {
613    n=nInvers(n);
614    e=-e;
615    d=1;
616  }
617  number r;
618  nPower(n,e,(number*)&r);
619  res->data=(char*)r;
620  if (d) nDelete(&n);
621  if (u!=NULL) return jjOP_REST(res,u,v);
622  return FALSE;
623}
624static BOOLEAN jjPOWER_P(leftv res, leftv u, leftv v)
625{
626  int v_i=(int)(long)v->Data();
627  if (v_i<0)
628  {
629    WerrorS("exponent must be non-negative");
630    return TRUE;
631  }
632  poly u_p=(poly)u->CopyD(POLY_CMD);
633  if ((u_p!=NULL)
634  && ((v_i!=0) &&
635      ((long)pTotaldegree(u_p) > (signed long)currRing->bitmask / (signed long)v_i/2)))
636  {
637    Werror("OVERFLOW in power(d=%ld, e=%d, max=%ld)",
638                                    pTotaldegree(u_p),v_i,currRing->bitmask/2);
639    pDelete(&u_p);
640    return TRUE;
641  }
642  res->data = (char *)pPower(u_p,v_i);
643  if (u!=NULL) return jjOP_REST(res,u,v);
644  return errorreported; /* pPower may set errorreported via Werror */
645}
646static BOOLEAN jjPOWER_ID(leftv res, leftv u, leftv v)
647{
648  res->data = (char *)id_Power((ideal)(u->Data()),(int)(long)(v->Data()), currRing);
649  if (u!=NULL) return jjOP_REST(res,u,v);
650  return FALSE;
651}
652static BOOLEAN jjPLUSMINUS_Gen(leftv res, leftv u, leftv v)
653{
654  u=u->next;
655  v=v->next;
656  if (u==NULL)
657  {
658    if (v==NULL) return FALSE;      /* u==NULL, v==NULL */
659    if (iiOp=='-')                  /* u==NULL, v<>NULL, iiOp=='-'*/
660    {
661      do
662      {
663        if (res->next==NULL)
664          res->next = (leftv)omAlloc0Bin(sleftv_bin);
665        leftv tmp_v=v->next;
666        v->next=NULL;
667        BOOLEAN b=iiExprArith1(res->next,v,'-');
668        v->next=tmp_v;
669        if (b)
670          return TRUE;
671        v=tmp_v;
672        res=res->next;
673      } while (v!=NULL);
674      return FALSE;
675    }
676    loop                            /* u==NULL, v<>NULL, iiOp=='+' */
677    {
678      res->next = (leftv)omAlloc0Bin(sleftv_bin);
679      res=res->next;
680      res->data = v->CopyD();
681      res->rtyp = v->Typ();
682      v=v->next;
683      if (v==NULL) return FALSE;
684    }
685  }
686  if (v!=NULL)                     /* u<>NULL, v<>NULL */
687  {
688    do
689    {
690      res->next = (leftv)omAlloc0Bin(sleftv_bin);
691      leftv tmp_u=u->next; u->next=NULL;
692      leftv tmp_v=v->next; v->next=NULL;
693      BOOLEAN b=iiExprArith2(res->next,u,iiOp,v);
694      u->next=tmp_u;
695      v->next=tmp_v;
696      if (b)
697        return TRUE;
698      u=tmp_u;
699      v=tmp_v;
700      res=res->next;
701    } while ((u!=NULL) && (v!=NULL));
702    return FALSE;
703  }
704  loop                             /* u<>NULL, v==NULL */
705  {
706    res->next = (leftv)omAlloc0Bin(sleftv_bin);
707    res=res->next;
708    res->data = u->CopyD();
709    res->rtyp = u->Typ();
710    u=u->next;
711    if (u==NULL) return FALSE;
712  }
713}
714static BOOLEAN jjCOLCOL(leftv res, leftv u, leftv v)
715{
716  idhdl packhdl;
717  switch(u->Typ())
718  {
719      case 0:
720      {
721        int name_err=0;
722        if(isupper(u->name[0]))
723        {
724          const char *c=u->name+1;
725          while((*c!='\0')&&(islower(*c)||(isdigit(*c)))) c++;
726          if (*c!='\0')
727            name_err=1;
728          else
729          {
730            Print("%s of type 'ANY'. Trying load.\n", u->name);
731            if(iiTryLoadLib(u, u->name))
732            {
733              Werror("'%s' no such package", u->name);
734              return TRUE;
735            }
736            syMake(u,u->name,NULL);
737          }
738        }
739        else name_err=1;
740        if(name_err)
741        { Werror("'%s' is an invalid package name",u->name);return TRUE;}
742        // and now, after the loading: use next case !!! no break !!!
743      }
744      case PACKAGE_CMD:
745        packhdl = (idhdl)u->data;
746        if((!IDPACKAGE(packhdl)->loaded)
747        && (IDPACKAGE(packhdl)->language > LANG_TOP))
748        {
749          Werror("'%s' not loaded", u->name);
750          return TRUE;
751        }
752        if(v->rtyp == IDHDL)
753        {
754          v->name = omStrDup(v->name);
755        }
756        v->req_packhdl=IDPACKAGE(packhdl);
757        syMake(v, v->name, packhdl);
758        memcpy(res, v, sizeof(sleftv));
759        memset(v, 0, sizeof(sleftv));
760        break;
761      case DEF_CMD:
762        break;
763      default:
764        WerrorS("<package>::<id> expected");
765        return TRUE;
766  }
767  return FALSE;
768}
769static BOOLEAN jjPLUS_I(leftv res, leftv u, leftv v)
770{
771  unsigned int a=(unsigned int)(unsigned long)u->Data();
772  unsigned int b=(unsigned int)(unsigned long)v->Data();
773  unsigned int c=a+b;
774  res->data = (char *)((long)c);
775  if (((Sy_bit(31)&a)==(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
776  {
777    WarnS("int overflow(+), result may be wrong");
778  }
779  return jjPLUSMINUS_Gen(res,u,v);
780}
781static BOOLEAN jjPLUS_BI(leftv res, leftv u, leftv v)
782{
783  res->data = (char *)(n_Add((number)u->Data(), (number)v->Data(),coeffs_BIGINT));
784  return jjPLUSMINUS_Gen(res,u,v);
785}
786static BOOLEAN jjPLUS_N(leftv res, leftv u, leftv v)
787{
788  res->data = (char *)(nAdd((number)u->Data(), (number)v->Data()));
789  return jjPLUSMINUS_Gen(res,u,v);
790}
791static BOOLEAN jjPLUS_P(leftv res, leftv u, leftv v)
792{
793  res->data = (char *)(pAdd((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
794  return jjPLUSMINUS_Gen(res,u,v);
795}
796static BOOLEAN jjPLUS_IV(leftv res, leftv u, leftv v)
797{
798  res->data = (char *)ivAdd((intvec*)(u->Data()), (intvec*)(v->Data()));
799  if (res->data==NULL)
800  {
801     WerrorS("intmat size not compatible");
802     return TRUE;
803  }
804  return jjPLUSMINUS_Gen(res,u,v);
805}
806static BOOLEAN jjPLUS_BIM(leftv res, leftv u, leftv v)
807{
808  res->data = (char *)bimAdd((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
809  if (res->data==NULL)
810  {
811    WerrorS("bigintmat/cmatrix not compatible");
812    return TRUE;
813  }
814  return jjPLUSMINUS_Gen(res,u,v);
815}
816static BOOLEAN jjPLUS_MA(leftv res, leftv u, leftv v)
817{
818  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
819  res->data = (char *)(mp_Add(A , B, currRing));
820  if (res->data==NULL)
821  {
822     Werror("matrix size not compatible(%dx%d, %dx%d)",
823             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
824     return TRUE;
825  }
826  return jjPLUSMINUS_Gen(res,u,v);
827}
828static BOOLEAN jjPLUS_MA_P(leftv res, leftv u, leftv v)
829{
830  matrix m=(matrix)u->Data();
831  matrix p= mp_InitP(m->nrows,m->ncols,(poly)(v->CopyD(POLY_CMD)),currRing);
832  if (iiOp=='+')
833    res->data = (char *)mp_Add(m , p,currRing);
834  else
835    res->data = (char *)mp_Sub(m , p,currRing);
836  idDelete((ideal *)&p);
837  return jjPLUSMINUS_Gen(res,u,v);
838}
839static BOOLEAN jjPLUS_P_MA(leftv res, leftv u, leftv v)
840{
841  return jjPLUS_MA_P(res,v,u);
842}
843static BOOLEAN jjPLUS_S(leftv res, leftv u, leftv v)
844{
845  char*    a = (char * )(u->Data());
846  char*    b = (char * )(v->Data());
847  char*    r = (char * )omAlloc(strlen(a) + strlen(b) + 1);
848  strcpy(r,a);
849  strcat(r,b);
850  res->data=r;
851  return jjPLUSMINUS_Gen(res,u,v);
852}
853static BOOLEAN jjPLUS_ID(leftv res, leftv u, leftv v)
854{
855  res->data = (char *)idAdd((ideal)u->Data(),(ideal)v->Data());
856  return jjPLUSMINUS_Gen(res,u,v);
857}
858static BOOLEAN jjMINUS_I(leftv res, leftv u, leftv v)
859{
860  void *ap=u->Data(); void *bp=v->Data();
861  int aa=(int)(long)ap;
862  int bb=(int)(long)bp;
863  int cc=aa-bb;
864  unsigned int a=(unsigned int)(unsigned long)ap;
865  unsigned int b=(unsigned int)(unsigned long)bp;
866  unsigned int c=a-b;
867  if (((Sy_bit(31)&a)!=(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
868  {
869    WarnS("int overflow(-), result may be wrong");
870  }
871  res->data = (char *)((long)cc);
872  return jjPLUSMINUS_Gen(res,u,v);
873}
874static BOOLEAN jjMINUS_BI(leftv res, leftv u, leftv v)
875{
876  res->data = (char *)(n_Sub((number)u->Data(), (number)v->Data(),coeffs_BIGINT));
877  return jjPLUSMINUS_Gen(res,u,v);
878}
879static BOOLEAN jjMINUS_N(leftv res, leftv u, leftv v)
880{
881  res->data = (char *)(nSub((number)u->Data(), (number)v->Data()));
882  return jjPLUSMINUS_Gen(res,u,v);
883}
884static BOOLEAN jjMINUS_P(leftv res, leftv u, leftv v)
885{
886  res->data = (char *)(pSub((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
887  return jjPLUSMINUS_Gen(res,u,v);
888}
889static BOOLEAN jjMINUS_IV(leftv res, leftv u, leftv v)
890{
891  res->data = (char *)ivSub((intvec*)(u->Data()), (intvec*)(v->Data()));
892  if (res->data==NULL)
893  {
894     WerrorS("intmat size not compatible");
895     return TRUE;
896  }
897  return jjPLUSMINUS_Gen(res,u,v);
898}
899static BOOLEAN jjMINUS_BIM(leftv res, leftv u, leftv v)
900{
901  res->data = (char *)bimSub((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
902  if (res->data==NULL)
903  {
904    WerrorS("bigintmat/cmatrix not compatible");
905    return TRUE;
906  }
907  return jjPLUSMINUS_Gen(res,u,v);
908}
909static BOOLEAN jjMINUS_MA(leftv res, leftv u, leftv v)
910{
911  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
912  res->data = (char *)(mp_Sub(A , B, currRing));
913  if (res->data==NULL)
914  {
915     Werror("matrix size not compatible(%dx%d, %dx%d)",
916             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
917     return TRUE;
918  }
919  return jjPLUSMINUS_Gen(res,u,v);
920  return FALSE;
921}
922static BOOLEAN jjTIMES_I(leftv res, leftv u, leftv v)
923{
924  int a=(int)(long)u->Data();
925  int b=(int)(long)v->Data();
926  int64 c=(int64)a * (int64)b;
927  if ((c>INT_MAX)||(c<INT_MIN))
928    WarnS("int overflow(*), result may be wrong");
929  res->data = (char *)((long)((int)c));
930  if ((u->Next()!=NULL) || (v->Next()!=NULL))
931    return jjOP_REST(res,u,v);
932  return FALSE;
933}
934static BOOLEAN jjTIMES_BI(leftv res, leftv u, leftv v)
935{
936  res->data = (char *)(n_Mult( (number)u->Data(), (number)v->Data(),coeffs_BIGINT));
937  if ((v->next!=NULL) || (u->next!=NULL))
938    return jjOP_REST(res,u,v);
939  return FALSE;
940}
941static BOOLEAN jjTIMES_N(leftv res, leftv u, leftv v)
942{
943  res->data = (char *)(nMult( (number)u->Data(), (number)v->Data()));
944  number n=(number)res->data;
945  nNormalize(n);
946  res->data=(char *)n;
947  if ((v->next!=NULL) || (u->next!=NULL))
948    return jjOP_REST(res,u,v);
949  return FALSE;
950}
951static BOOLEAN jjTIMES_P(leftv res, leftv u, leftv v)
952{
953  poly a;
954  poly b;
955  if (v->next==NULL)
956  {
957    a=(poly)u->CopyD(POLY_CMD); // works also for VECTOR_CMD
958    if (u->next==NULL)
959    {
960      b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
961      if ((a!=NULL) && (b!=NULL)
962      && ((long)pTotaldegree(a)>si_max((long)rVar(currRing),(long)currRing->bitmask/2)-(long)pTotaldegree(b)))
963      {
964        Warn("possible OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
965          pTotaldegree(a),pTotaldegree(b),currRing->bitmask/2);
966      }
967      res->data = (char *)(pMult( a, b));
968      pNormalize((poly)res->data);
969      return FALSE;
970    }
971    // u->next exists: copy v
972    b=pCopy((poly)v->Data());
973    if ((a!=NULL) && (b!=NULL)
974    && (pTotaldegree(a)+pTotaldegree(b)>si_max((long)rVar(currRing),(long)currRing->bitmask/2)))
975    {
976      Warn("possible OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
977          pTotaldegree(a),pTotaldegree(b),currRing->bitmask/2);
978    }
979    res->data = (char *)(pMult( a, b));
980    pNormalize((poly)res->data);
981    return jjOP_REST(res,u,v);
982  }
983  // v->next exists: copy u
984  a=pCopy((poly)u->Data());
985  b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
986  if ((a!=NULL) && (b!=NULL)
987  && ((unsigned long)(pTotaldegree(a)+pTotaldegree(b))>=currRing->bitmask/2))
988  {
989    pDelete(&a);
990    pDelete(&b);
991    WerrorS("OVERFLOW");
992    return TRUE;
993  }
994  res->data = (char *)(pMult( a, b));
995  pNormalize((poly)res->data);
996  return jjOP_REST(res,u,v);
997}
998static BOOLEAN jjTIMES_ID(leftv res, leftv u, leftv v)
999{
1000  res->data = (char *)idMult((ideal)u->Data(),(ideal)v->Data());
1001  id_Normalize((ideal)res->data,currRing);
1002  if ((v->next!=NULL) || (u->next!=NULL))
1003    return jjOP_REST(res,u,v);
1004  return FALSE;
1005}
1006static BOOLEAN jjTIMES_IV(leftv res, leftv u, leftv v)
1007{
1008  res->data = (char *)ivMult((intvec*)(u->Data()), (intvec*)(v->Data()));
1009  if (res->data==NULL)
1010  {
1011     WerrorS("intmat size not compatible");
1012     return TRUE;
1013  }
1014  if ((v->next!=NULL) || (u->next!=NULL))
1015    return jjOP_REST(res,u,v);
1016  return FALSE;
1017}
1018static BOOLEAN jjTIMES_BIM(leftv res, leftv u, leftv v)
1019{
1020  res->data = (char *)bimMult((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
1021  if (res->data==NULL)
1022  {
1023    WerrorS("bigintmat/cmatrix not compatible");
1024    return TRUE;
1025  }
1026  if ((v->next!=NULL) || (u->next!=NULL))
1027    return jjOP_REST(res,u,v);
1028  return FALSE;
1029}
1030static BOOLEAN jjTIMES_MA_BI1(leftv res, leftv u, leftv v)
1031{
1032  nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
1033  if (nMap==NULL) return TRUE;
1034  number n=nMap((number)v->Data(),coeffs_BIGINT,currRing->cf);
1035  poly p=pNSet(n);
1036  ideal I= (ideal)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
1037  res->data = (char *)I;
1038  return FALSE;
1039}
1040static BOOLEAN jjTIMES_MA_BI2(leftv res, leftv u, leftv v)
1041{
1042  return jjTIMES_MA_BI1(res,v,u);
1043}
1044static BOOLEAN jjTIMES_MA_P1(leftv res, leftv u, leftv v)
1045{
1046  poly p=(poly)v->CopyD(POLY_CMD);
1047  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
1048  ideal I= (ideal)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
1049  if (r>0) I->rank=r;
1050  id_Normalize(I,currRing);
1051  res->data = (char *)I;
1052  return FALSE;
1053}
1054static BOOLEAN jjTIMES_MA_P2(leftv res, leftv u, leftv v)
1055{
1056  poly p=(poly)u->CopyD(POLY_CMD);
1057  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
1058  ideal I= (ideal)pMultMp(p,(matrix)v->CopyD(MATRIX_CMD),currRing);
1059  if (r>0) I->rank=r;
1060  id_Normalize(I,currRing);
1061  res->data = (char *)I;
1062  return FALSE;
1063}
1064static BOOLEAN jjTIMES_MA_N1(leftv res, leftv u, leftv v)
1065{
1066  number n=(number)v->CopyD(NUMBER_CMD);
1067  poly p=pNSet(n);
1068  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
1069  id_Normalize((ideal)res->data,currRing);
1070  return FALSE;
1071}
1072static BOOLEAN jjTIMES_MA_N2(leftv res, leftv u, leftv v)
1073{
1074  return jjTIMES_MA_N1(res,v,u);
1075}
1076static BOOLEAN jjTIMES_MA_I1(leftv res, leftv u, leftv v)
1077{
1078  res->data = (char *)mp_MultI((matrix)u->CopyD(MATRIX_CMD),(int)(long)v->Data(),currRing);
1079  id_Normalize((ideal)res->data,currRing);
1080  return FALSE;
1081}
1082static BOOLEAN jjTIMES_MA_I2(leftv res, leftv u, leftv v)
1083{
1084  return jjTIMES_MA_I1(res,v,u);
1085}
1086static BOOLEAN jjTIMES_MA(leftv res, leftv u, leftv v)
1087{
1088  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
1089  res->data = (char *)mp_Mult(A,B,currRing);
1090  if (res->data==NULL)
1091  {
1092     Werror("matrix size not compatible(%dx%d, %dx%d)",
1093             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
1094     return TRUE;
1095  }
1096  id_Normalize((ideal)res->data,currRing);
1097  if ((v->next!=NULL) || (u->next!=NULL))
1098    return jjOP_REST(res,u,v);
1099  return FALSE;
1100}
1101static BOOLEAN jjGE_BI(leftv res, leftv u, leftv v)
1102{
1103  number h=n_Sub((number)u->Data(),(number)v->Data(),coeffs_BIGINT);
1104  res->data = (char *) (n_GreaterZero(h,coeffs_BIGINT)||(n_IsZero(h,coeffs_BIGINT)));
1105  n_Delete(&h,coeffs_BIGINT);
1106  return FALSE;
1107}
1108static BOOLEAN jjGE_I(leftv res, leftv u, leftv v)
1109{
1110  res->data = (char *)(long)((int)((long)u->Data()) >= (int)((long)v->Data()));
1111  return FALSE;
1112}
1113static BOOLEAN jjGE_N(leftv res, leftv u, leftv v)
1114{
1115  res->data = (char *)(long) (nGreater((number)u->Data(),(number)v->Data())
1116                       || nEqual((number)u->Data(),(number)v->Data()));
1117  return FALSE;
1118}
1119static BOOLEAN jjGT_BI(leftv res, leftv u, leftv v)
1120{
1121  number h=n_Sub((number)u->Data(),(number)v->Data(),coeffs_BIGINT);
1122  res->data = (char *)(long) (n_GreaterZero(h,coeffs_BIGINT)&&(!n_IsZero(h,coeffs_BIGINT)));
1123  n_Delete(&h,coeffs_BIGINT);
1124  return FALSE;
1125}
1126static BOOLEAN jjGT_I(leftv res, leftv u, leftv v)
1127{
1128  res->data = (char *)(long)((int)((long)u->Data()) > (int)((long)v->Data()));
1129  return FALSE;
1130}
1131static BOOLEAN jjGT_N(leftv res, leftv u, leftv v)
1132{
1133  res->data = (char *)(long)(nGreater((number)u->Data(),(number)v->Data()));
1134  return FALSE;
1135}
1136static BOOLEAN jjLE_BI(leftv res, leftv u, leftv v)
1137{
1138  return jjGE_BI(res,v,u);
1139}
1140static BOOLEAN jjLE_I(leftv res, leftv u, leftv v)
1141{
1142  res->data = (char *)(long)((int)((long)u->Data()) <= (int)((long)v->Data()));
1143  return FALSE;
1144}
1145static BOOLEAN jjLE_N(leftv res, leftv u, leftv v)
1146{
1147  return jjGE_N(res,v,u);
1148}
1149static BOOLEAN jjLT_BI(leftv res, leftv u, leftv v)
1150{
1151  return jjGT_BI(res,v,u);
1152}
1153static BOOLEAN jjLT_I(leftv res, leftv u, leftv v)
1154{
1155  res->data = (char *)(long)((int)((long)u->Data()) < (int)((long)v->Data()));
1156  return FALSE;
1157}
1158static BOOLEAN jjLT_N(leftv res, leftv u, leftv v)
1159{
1160  return jjGT_N(res,v,u);
1161}
1162static BOOLEAN jjDIVMOD_I(leftv res, leftv u, leftv v)
1163{
1164  if (iiOp=='/') Warn("int division with `/`: use `div` instead in line >>%s<<",my_yylinebuf);
1165  int a= (int)(long)u->Data();
1166  int b= (int)(long)v->Data();
1167  if (b==0)
1168  {
1169    WerrorS(ii_div_by_0);
1170    return TRUE;
1171  }
1172  int c=a%b;
1173  int r=0;
1174  switch (iiOp)
1175  {
1176    case '%':
1177        r=c;            break;
1178    case '/':
1179    case INTDIV_CMD:
1180        r=((a-c) /b);   break;
1181  }
1182  res->data=(void *)((long)r);
1183  return FALSE;
1184}
1185static BOOLEAN jjDIV_BI(leftv res, leftv u, leftv v)
1186{
1187  number q=(number)v->Data();
1188  if (n_IsZero(q,coeffs_BIGINT))
1189  {
1190    WerrorS(ii_div_by_0);
1191    return TRUE;
1192  }
1193  q = n_Div((number)u->Data(),q,coeffs_BIGINT);
1194  n_Normalize(q,coeffs_BIGINT);
1195  res->data = (char *)q;
1196  return FALSE;
1197}
1198static BOOLEAN jjDIV_N(leftv res, leftv u, leftv v)
1199{
1200  number q=(number)v->Data();
1201  if (nIsZero(q))
1202  {
1203    WerrorS(ii_div_by_0);
1204    return TRUE;
1205  }
1206  q = nDiv((number)u->Data(),q);
1207  nNormalize(q);
1208  res->data = (char *)q;
1209  return FALSE;
1210}
1211static BOOLEAN jjDIV_P(leftv res, leftv u, leftv v)
1212{
1213  poly q=(poly)v->Data();
1214  if (q==NULL)
1215  {
1216    WerrorS(ii_div_by_0);
1217    return TRUE;
1218  }
1219  poly p=(poly)(u->Data());
1220  if (p==NULL)
1221  {
1222    res->data=NULL;
1223    return FALSE;
1224  }
1225  if ((pNext(q)!=NULL) && (!rField_is_Ring(currRing)))
1226  { /* This means that q != 0 consists of at least two terms.
1227       Moreover, currRing is over a field. */
1228    if(pGetComp(p)==0)
1229    {
1230      res->data=(void*)(singclap_pdivide(p /*(poly)(u->Data())*/ ,
1231                                         q /*(poly)(v->Data())*/ ,currRing));
1232    }
1233    else
1234    {
1235      int comps=pMaxComp(p);
1236      ideal I=idInit(comps,1);
1237      p=pCopy(p);
1238      poly h;
1239      int i;
1240      // conversion to a list of polys:
1241      while (p!=NULL)
1242      {
1243        i=pGetComp(p)-1;
1244        h=pNext(p);
1245        pNext(p)=NULL;
1246        pSetComp(p,0);
1247        I->m[i]=pAdd(I->m[i],p);
1248        p=h;
1249      }
1250      // division and conversion to vector:
1251      h=NULL;
1252      p=NULL;
1253      for(i=comps-1;i>=0;i--)
1254      {
1255        if (I->m[i]!=NULL)
1256        {
1257          h=singclap_pdivide(I->m[i],q,currRing);
1258          pSetCompP(h,i+1);
1259          p=pAdd(p,h);
1260        }
1261      }
1262      idDelete(&I);
1263      res->data=(void *)p;
1264    }
1265  }
1266  else
1267  { /* This means that q != 0 consists of just one term,
1268       or that currRing is over a coefficient ring. */
1269#ifdef HAVE_RINGS
1270    if (!rField_is_Domain(currRing))
1271    {
1272      WerrorS("division only defined over coefficient domains");
1273      return TRUE;
1274    }
1275    if (pNext(q)!=NULL)
1276    {
1277      WerrorS("division over a coefficient domain only implemented for terms");
1278      return TRUE;
1279    }
1280#endif
1281    res->data = (char *)pDivideM(pCopy(p),pHead(q));
1282  }
1283  pNormalize((poly)res->data);
1284  return FALSE;
1285}
1286static BOOLEAN jjDIV_Ma(leftv res, leftv u, leftv v)
1287{
1288  poly q=(poly)v->Data();
1289  if (q==NULL)
1290  {
1291    WerrorS(ii_div_by_0);
1292    return TRUE;
1293  }
1294  matrix m=(matrix)(u->Data());
1295  int r=m->rows();
1296  int c=m->cols();
1297  matrix mm=mpNew(r,c);
1298  int i,j;
1299  for(i=r;i>0;i--)
1300  {
1301    for(j=c;j>0;j--)
1302    {
1303      if (pNext(q)!=NULL)
1304      {
1305        MATELEM(mm,i,j) = singclap_pdivide( MATELEM(m,i,j) ,
1306                                           q /*(poly)(v->Data())*/, currRing );
1307      }
1308      else
1309        MATELEM(mm,i,j) = pDivideM(pCopy(MATELEM(m,i,j)),pHead(q));
1310    }
1311  }
1312  id_Normalize((ideal)mm,currRing);
1313  res->data=(char *)mm;
1314  return FALSE;
1315}
1316static BOOLEAN jjEQUAL_BI(leftv res, leftv u, leftv v)
1317{
1318  res->data = (char *)((long)n_Equal((number)u->Data(),(number)v->Data(),coeffs_BIGINT));
1319  jjEQUAL_REST(res,u,v);
1320  return FALSE;
1321}
1322static BOOLEAN jjEQUAL_I(leftv res, leftv u, leftv v)
1323{
1324  res->data = (char *)((int)((long)u->Data()) == (int)((long)v->Data()));
1325  jjEQUAL_REST(res,u,v);
1326  return FALSE;
1327}
1328static BOOLEAN jjEQUAL_Ma(leftv res, leftv u, leftv v)
1329{
1330  res->data = (char *)((long)mp_Equal((matrix)u->Data(),(matrix)v->Data(),currRing));
1331  jjEQUAL_REST(res,u,v);
1332  return FALSE;
1333}
1334static BOOLEAN jjEQUAL_N(leftv res, leftv u, leftv v)
1335{
1336  res->data = (char *)((long)nEqual((number)u->Data(),(number)v->Data()));
1337  jjEQUAL_REST(res,u,v);
1338  return FALSE;
1339}
1340static BOOLEAN jjEQUAL_P(leftv res, leftv u, leftv v)
1341{
1342  poly p=(poly)u->Data();
1343  poly q=(poly)v->Data();
1344  res->data = (char *) ((long)pEqualPolys(p,q));
1345  jjEQUAL_REST(res,u,v);
1346  return FALSE;
1347}
1348static void jjEQUAL_REST(leftv res,leftv u,leftv v)
1349{
1350  if ((res->data) && (u->next!=NULL) && (v->next!=NULL))
1351  {
1352    int save_iiOp=iiOp;
1353    if (iiOp==NOTEQUAL)
1354      iiExprArith2(res,u->next,EQUAL_EQUAL,v->next);
1355    else
1356      iiExprArith2(res,u->next,iiOp,v->next);
1357    iiOp=save_iiOp;
1358  }
1359  if (iiOp==NOTEQUAL) res->data=(char *)(!(long)res->data);
1360}
1361static BOOLEAN jjAND_I(leftv res, leftv u, leftv v)
1362{
1363  res->data = (char *)((long)u->Data() && (long)v->Data());
1364  return FALSE;
1365}
1366static BOOLEAN jjOR_I(leftv res, leftv u, leftv v)
1367{
1368  res->data = (char *)((long)u->Data() || (long)v->Data());
1369  return FALSE;
1370}
1371static BOOLEAN jjINDEX_I(leftv res, leftv u, leftv v)
1372{
1373  res->rtyp=u->rtyp; u->rtyp=0;
1374  res->data=u->data; u->data=NULL;
1375  res->name=u->name; u->name=NULL;
1376  res->e=u->e;       u->e=NULL;
1377  if (res->e==NULL) res->e=jjMakeSub(v);
1378  else
1379  {
1380    Subexpr sh=res->e;
1381    while (sh->next != NULL) sh=sh->next;
1382    sh->next=jjMakeSub(v);
1383  }
1384  if (u->next!=NULL)
1385  {
1386    leftv rn=(leftv)omAlloc0Bin(sleftv_bin);
1387    BOOLEAN bo=iiExprArith2(rn,u->next,iiOp,v);
1388    res->next=rn;
1389    return bo;
1390  }
1391  return FALSE;
1392}
1393static BOOLEAN jjINDEX_IV(leftv res, leftv u, leftv v)
1394{
1395  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1396  {
1397    WerrorS("indexed object must have a name");
1398    return TRUE;
1399  }
1400  intvec * iv=(intvec *)v->Data();
1401  leftv p=NULL;
1402  int i;
1403  sleftv t;
1404  memset(&t,0,sizeof(t));
1405  t.rtyp=INT_CMD;
1406  for (i=0;i<iv->length(); i++)
1407  {
1408    t.data=(char *)((long)(*iv)[i]);
1409    if (p==NULL)
1410    {
1411      p=res;
1412    }
1413    else
1414    {
1415      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1416      p=p->next;
1417    }
1418    p->rtyp=IDHDL;
1419    p->data=u->data;
1420    p->name=u->name;
1421    p->flag=u->flag;
1422    p->e=jjMakeSub(&t);
1423  }
1424  u->rtyp=0;
1425  u->data=NULL;
1426  u->name=NULL;
1427  return FALSE;
1428}
1429static BOOLEAN jjINDEX_P(leftv res, leftv u, leftv v)
1430{
1431  poly p=(poly)u->Data();
1432  int i=(int)(long)v->Data();
1433  int j=0;
1434  while (p!=NULL)
1435  {
1436    j++;
1437    if (j==i)
1438    {
1439      res->data=(char *)pHead(p);
1440      return FALSE;
1441    }
1442    pIter(p);
1443  }
1444  return FALSE;
1445}
1446static BOOLEAN jjINDEX_P_IV(leftv res, leftv u, leftv v)
1447{
1448  poly p=(poly)u->Data();
1449  poly r=NULL;
1450  intvec *iv=(intvec *)v->CopyD(INTVEC_CMD);
1451  int i;
1452  int sum=0;
1453  for(i=iv->length()-1;i>=0;i--)
1454    sum+=(*iv)[i];
1455  int j=0;
1456  while ((p!=NULL) && (sum>0))
1457  {
1458    j++;
1459    for(i=iv->length()-1;i>=0;i--)
1460    {
1461      if (j==(*iv)[i])
1462      {
1463        r=pAdd(r,pHead(p));
1464        sum-=j;
1465        (*iv)[i]=0;
1466        break;
1467      }
1468    }
1469    pIter(p);
1470  }
1471  delete iv;
1472  res->data=(char *)r;
1473  return FALSE;
1474}
1475static BOOLEAN jjINDEX_V(leftv res, leftv u, leftv v)
1476{
1477  poly p=(poly)u->CopyD(VECTOR_CMD);
1478  poly r=p; // pointer to the beginning of component i
1479  poly o=NULL;
1480  unsigned i=(unsigned)(long)v->Data();
1481  while (p!=NULL)
1482  {
1483    if (pGetComp(p)!=i)
1484    {
1485      if (r==p) r=pNext(p);
1486      if (o!=NULL)
1487      {
1488        if (pNext(o)!=NULL) pLmDelete(&pNext(o));
1489        p=pNext(o);
1490      }
1491      else
1492        pLmDelete(&p);
1493    }
1494    else
1495    {
1496      pSetComp(p, 0);
1497      p_SetmComp(p, currRing);
1498      o=p;
1499      p=pNext(o);
1500    }
1501  }
1502  res->data=(char *)r;
1503  return FALSE;
1504}
1505static BOOLEAN jjINDEX_V_IV(leftv res, leftv u, leftv v)
1506{
1507  poly p=(poly)u->CopyD(VECTOR_CMD);
1508  if (p!=NULL)
1509  {
1510    poly r=pOne();
1511    poly hp=r;
1512    intvec *iv=(intvec *)v->Data();
1513    int i;
1514    loop
1515    {
1516      for(i=0;i<iv->length();i++)
1517      {
1518        if (((int)pGetComp(p))==(*iv)[i])
1519        {
1520          poly h;
1521          pSplit(p,&h);
1522          pNext(hp)=p;
1523          p=h;
1524          pIter(hp);
1525          break;
1526        }
1527      }
1528      if (p==NULL) break;
1529      if (i==iv->length())
1530      {
1531        pLmDelete(&p);
1532        if (p==NULL) break;
1533      }
1534    }
1535    pLmDelete(&r);
1536    res->data=(char *)r;
1537  }
1538  return FALSE;
1539}
1540static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v);
1541static BOOLEAN jjKLAMMER(leftv res, leftv u, leftv v)
1542{
1543  if(u->name==NULL) return TRUE;
1544  char * nn = (char *)omAlloc(strlen(u->name) + 14);
1545  sprintf(nn,"%s(%d)",u->name,(int)(long)v->Data());
1546  omFree((ADDRESS)u->name);
1547  u->name=NULL;
1548  char *n=omStrDup(nn);
1549  omFree((ADDRESS)nn);
1550  syMake(res,n);
1551  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1552  return FALSE;
1553}
1554static BOOLEAN jjKLAMMER_IV(leftv res, leftv u, leftv v)
1555{
1556  intvec * iv=(intvec *)v->Data();
1557  leftv p=NULL;
1558  int i;
1559  long slen = strlen(u->name) + 14;
1560  char *n = (char*) omAlloc(slen);
1561
1562  for (i=0;i<iv->length(); i++)
1563  {
1564    if (p==NULL)
1565    {
1566      p=res;
1567    }
1568    else
1569    {
1570      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1571      p=p->next;
1572    }
1573    sprintf(n,"%s(%d)",u->name,(*iv)[i]);
1574    syMake(p,omStrDup(n));
1575  }
1576  omFree((ADDRESS)u->name);
1577  u->name = NULL;
1578  omFreeSize(n, slen);
1579  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1580  return FALSE;
1581}
1582static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v)
1583{
1584  leftv tmp=(leftv)omAllocBin(sleftv_bin);
1585  memset(tmp,0,sizeof(sleftv));
1586  BOOLEAN b;
1587  if (v->Typ()==INTVEC_CMD)
1588    b=jjKLAMMER_IV(tmp,u,v);
1589  else
1590    b=jjKLAMMER(tmp,u,v);
1591  if (b)
1592  {
1593    omFreeBin(tmp,sleftv_bin);
1594    return TRUE;
1595  }
1596  leftv h=res;
1597  while (h->next!=NULL) h=h->next;
1598  h->next=tmp;
1599  return FALSE;
1600}
1601BOOLEAN jjPROC(leftv res, leftv u, leftv v)
1602{
1603  void *d;
1604  Subexpr e;
1605  int typ;
1606  BOOLEAN t=FALSE;
1607  idhdl tmp_proc=NULL;
1608  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1609  {
1610    tmp_proc=(idhdl)omAlloc0(sizeof(idrec));
1611    tmp_proc->id="_auto";
1612    tmp_proc->typ=PROC_CMD;
1613    tmp_proc->data.pinf=(procinfo *)u->Data();
1614    tmp_proc->ref=1;
1615    d=u->data; u->data=(void *)tmp_proc;
1616    e=u->e; u->e=NULL;
1617    t=TRUE;
1618    typ=u->rtyp; u->rtyp=IDHDL;
1619  }
1620  BOOLEAN sl;
1621  if (u->req_packhdl==currPack)
1622    sl = iiMake_proc((idhdl)u->data,NULL,v);
1623  else
1624    sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1625  if (t)
1626  {
1627    u->rtyp=typ;
1628    u->data=d;
1629    u->e=e;
1630    omFreeSize(tmp_proc,sizeof(idrec));
1631  }
1632  if (sl) return TRUE;
1633  memcpy(res,&iiRETURNEXPR,sizeof(sleftv));
1634  iiRETURNEXPR.Init();
1635  return FALSE;
1636}
1637static BOOLEAN jjMAP(leftv res, leftv u, leftv v)
1638{
1639  //Print("try to map %s with %s\n",$3.Name(),$1.Name());
1640  leftv sl=NULL;
1641  if ((v->e==NULL)&&(v->name!=NULL))
1642  {
1643    map m=(map)u->Data();
1644    sl=iiMap(m,v->name);
1645  }
1646  else
1647  {
1648    Werror("%s(<name>) expected",u->Name());
1649  }
1650  if (sl==NULL) return TRUE;
1651  memcpy(res,sl,sizeof(sleftv));
1652  omFreeBin((ADDRESS)sl, sleftv_bin);
1653  return FALSE;
1654}
1655static BOOLEAN jjCHINREM_BI(leftv res, leftv u, leftv v)
1656{
1657  intvec *c=(intvec*)u->Data();
1658  intvec* p=(intvec*)v->Data();
1659  int rl=p->length();
1660  number *x=(number *)omAlloc(rl*sizeof(number));
1661  number *q=(number *)omAlloc(rl*sizeof(number));
1662  int i;
1663  for(i=rl-1;i>=0;i--)
1664  {
1665    q[i]=n_Init((*p)[i], coeffs_BIGINT);
1666    x[i]=n_Init((*c)[i], coeffs_BIGINT);
1667  }
1668  number n=n_ChineseRemainderSym(x,q,rl,FALSE,coeffs_BIGINT);
1669  for(i=rl-1;i>=0;i--)
1670  {
1671    n_Delete(&(q[i]),coeffs_BIGINT);
1672    n_Delete(&(x[i]),coeffs_BIGINT);
1673  }
1674  omFree(x); omFree(q);
1675  res->data=(char *)n;
1676  return FALSE;
1677}
1678#if 0
1679static BOOLEAN jjCHINREM_P(leftv res, leftv u, leftv v)
1680{
1681  lists c=(lists)u->CopyD(); // list of poly
1682  intvec* p=(intvec*)v->Data();
1683  int rl=p->length();
1684  poly r=NULL,h, result=NULL;
1685  number *x=(number *)omAlloc(rl*sizeof(number));
1686  number *q=(number *)omAlloc(rl*sizeof(number));
1687  int i;
1688  for(i=rl-1;i>=0;i--)
1689  {
1690    q[i]=nlInit((*p)[i]);
1691  }
1692  loop
1693  {
1694    for(i=rl-1;i>=0;i--)
1695    {
1696      if (c->m[i].Typ()!=POLY_CMD)
1697      {
1698        Werror("poly expected at pos %d",i+1);
1699        for(i=rl-1;i>=0;i--)
1700        {
1701          nlDelete(&(q[i]),currRing);
1702        }
1703        omFree(x); omFree(q); // delete c
1704        return TRUE;
1705      }
1706      h=((poly)c->m[i].Data());
1707      if (r==NULL) r=h;
1708      else if (pLmCmp(r,h)==-1) r=h;
1709    }
1710    if (r==NULL) break;
1711    for(i=rl-1;i>=0;i--)
1712    {
1713      h=((poly)c->m[i].Data());
1714      if (pLmCmp(r,h)==0)
1715      {
1716        x[i]=pGetCoeff(h);
1717        h=pLmFreeAndNext(h);
1718        c->m[i].data=(char*)h;
1719      }
1720      else
1721        x[i]=nlInit(0);
1722    }
1723    number n=n_ChineseRemainder(x,q,rl,currRing->cf);
1724    for(i=rl-1;i>=0;i--)
1725    {
1726      nlDelete(&(x[i]),currRing);
1727    }
1728    h=pHead(r);
1729    pSetCoeff(h,n);
1730    result=pAdd(result,h);
1731  }
1732  for(i=rl-1;i>=0;i--)
1733  {
1734    nlDelete(&(q[i]),currRing);
1735  }
1736  omFree(x); omFree(q);
1737  res->data=(char *)result;
1738  return FALSE;
1739}
1740#endif
1741static BOOLEAN jjCHINREM_ID(leftv res, leftv u, leftv v)
1742{
1743  coeffs cf;
1744  lists c=(lists)u->CopyD(); // list of ideal or bigint/int
1745  lists pl=NULL;
1746  intvec *p=NULL;
1747  if (v->Typ()==LIST_CMD) pl=(lists)v->Data();
1748  else                    p=(intvec*)v->Data();
1749  int rl=c->nr+1;
1750  ideal result;
1751  ideal *x=(ideal *)omAlloc(rl*sizeof(ideal));
1752  number *xx=NULL;
1753  int i;
1754  int return_type=c->m[0].Typ();
1755  if ((return_type!=IDEAL_CMD)
1756  && (return_type!=MODUL_CMD)
1757  && (return_type!=MATRIX_CMD)
1758  && (return_type!=POLY_CMD))
1759  {
1760    if((return_type!=BIGINT_CMD)&&(return_type!=INT_CMD))
1761    {
1762      WerrorS("poly/ideal/module/matrix expected");
1763      omFree(x); // delete c
1764      return TRUE;
1765    }
1766    else
1767      return_type=BIGINT_CMD;
1768  }
1769  if (return_type==BIGINT_CMD)
1770    cf=coeffs_BIGINT;
1771  else
1772  {
1773    cf=currRing->cf;
1774    if (nCoeff_is_Extension(cf) && (cf->extRing!=NULL))
1775      cf=cf->extRing->cf;
1776  }
1777  nMapFunc nMap=n_SetMap(coeffs_BIGINT,cf);
1778  if (return_type!=BIGINT_CMD)
1779  {
1780    for(i=rl-1;i>=0;i--)
1781    {
1782      if (c->m[i].Typ()!=return_type)
1783      {
1784        Werror("%s expected at pos %d",Tok2Cmdname(return_type),i+1);
1785        omFree(x); // delete c
1786        return TRUE;
1787      }
1788      if (return_type==POLY_CMD)
1789      {
1790        x[i]=idInit(1,1);
1791        x[i]->m[0]=(poly)c->m[i].CopyD();
1792      }
1793      else
1794      {
1795        x[i]=(ideal)c->m[i].CopyD();
1796      }
1797      //c->m[i].Init();
1798    }
1799  }
1800  else
1801  {
1802    xx=(number *)omAlloc(rl*sizeof(number));
1803    if (nMap==NULL)
1804    {
1805      Werror("not implemented: map bigint -> %s",cf->cfCoeffString(cf));
1806      return TRUE;
1807    }
1808    for(i=rl-1;i>=0;i--)
1809    {
1810      if (c->m[i].Typ()==INT_CMD)
1811      {
1812        xx[i]=n_Init(((int)(long)c->m[i].Data()),cf);
1813      }
1814      else if (c->m[i].Typ()==BIGINT_CMD)
1815      {
1816        xx[i]=nMap((number)c->m[i].Data(),coeffs_BIGINT,cf);
1817      }
1818      else
1819      {
1820        Werror("bigint expected at pos %d",i+1);
1821        omFree(x); // delete c
1822        omFree(xx); // delete c
1823        return TRUE;
1824      }
1825    }
1826  }
1827  number *q=(number *)omAlloc(rl*sizeof(number));
1828  if (p!=NULL)
1829  {
1830    for(i=rl-1;i>=0;i--)
1831    {
1832      q[i]=n_Init((*p)[i], cf);
1833    }
1834  }
1835  else
1836  {
1837    for(i=rl-1;i>=0;i--)
1838    {
1839      if (pl->m[i].Typ()==INT_CMD)
1840      {
1841        q[i]=n_Init((int)(long)pl->m[i].Data(),cf);
1842      }
1843      else if (pl->m[i].Typ()==BIGINT_CMD)
1844      {
1845        q[i]=nMap((number)(pl->m[i].Data()),coeffs_BIGINT,cf);
1846      }
1847      else
1848      {
1849        Werror("bigint expected at pos %d",i+1);
1850        for(i++;i<rl;i++)
1851        {
1852          n_Delete(&(q[i]),cf);
1853        }
1854        omFree(x); // delete c
1855        omFree(q); // delete pl
1856        if (xx!=NULL) omFree(xx); // delete c
1857        return TRUE;
1858      }
1859    }
1860  }
1861  if (return_type==BIGINT_CMD)
1862  {
1863    number n=n_ChineseRemainderSym(xx,q,rl,TRUE,coeffs_BIGINT);
1864    res->data=(char *)n;
1865  }
1866  else
1867  {
1868    result=id_ChineseRemainder(x,q,rl,currRing);
1869    // deletes also x
1870    c->Clean();
1871    if (return_type==POLY_CMD)
1872    {
1873      res->data=(char *)result->m[0];
1874      result->m[0]=NULL;
1875      idDelete(&result);
1876    }
1877    else
1878      res->data=(char *)result;
1879  }
1880  for(i=rl-1;i>=0;i--)
1881  {
1882    n_Delete(&(q[i]),cf);
1883  }
1884  omFree(q);
1885  res->rtyp=return_type;
1886  return FALSE;
1887}
1888static BOOLEAN jjCOEF(leftv res, leftv u, leftv v)
1889{
1890  poly p=(poly)v->Data();
1891  if ((p==NULL)||(pNext(p)!=NULL)) return TRUE;
1892  res->data=(char *)mp_CoeffProc((poly)u->Data(),p /*(poly)v->Data()*/,currRing);
1893  return FALSE;
1894}
1895static BOOLEAN jjCOEFFS_Id(leftv res, leftv u, leftv v)
1896{
1897  int i=pVar((poly)v->Data());
1898  if (i==0)
1899  {
1900    WerrorS("ringvar expected");
1901    return TRUE;
1902  }
1903  res->data=(char *)mp_Coeffs((ideal)u->CopyD(),i,currRing);
1904  return FALSE;
1905}
1906static BOOLEAN jjCOEFFS2_KB(leftv res, leftv u, leftv v)
1907{
1908  poly p = pInit();
1909  int i;
1910  for (i=1; i<=currRing->N; i++)
1911  {
1912    pSetExp(p, i, 1);
1913  }
1914  pSetm(p);
1915  res->data = (void*)idCoeffOfKBase((ideal)(u->Data()),
1916                                    (ideal)(v->Data()), p);
1917  pDelete(&p);
1918  return FALSE;
1919}
1920static BOOLEAN jjCONTRACT(leftv res, leftv u, leftv v)
1921{
1922  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data(),FALSE);
1923  return FALSE;
1924}
1925static BOOLEAN jjDEG_M_IV(leftv res, leftv u, leftv v)
1926{
1927  short *iv=iv2array((intvec *)v->Data(),currRing);
1928  ideal I=(ideal)u->Data();
1929  int d=-1;
1930  int i;
1931  for(i=IDELEMS(I);i>=0;i--) d=si_max(d,(int)p_DegW(I->m[i],iv,currRing));
1932  omFreeSize( (ADDRESS)iv, (rVar(currRing)+1)*sizeof(short) );
1933  res->data = (char *)((long)d);
1934  return FALSE;
1935}
1936static BOOLEAN jjDEG_IV(leftv res, leftv u, leftv v)
1937{
1938  poly p=(poly)u->Data();
1939  if (p!=NULL)
1940  {
1941    short *iv=iv2array((intvec *)v->Data(),currRing);
1942    const long d = p_DegW(p,iv,currRing);
1943    omFreeSize( (ADDRESS)iv, (rVar(currRing)+1)*sizeof(short) );
1944    res->data = (char *)(d);
1945  }
1946  else
1947    res->data=(char *)(long)(-1);
1948  return FALSE;
1949}
1950static BOOLEAN jjDIFF_P(leftv res, leftv u, leftv v)
1951{
1952  int i=pVar((poly)v->Data());
1953  if (i==0)
1954  {
1955    WerrorS("ringvar expected");
1956    return TRUE;
1957  }
1958  res->data=(char *)pDiff((poly)(u->Data()),i);
1959  return FALSE;
1960}
1961static BOOLEAN jjDIFF_ID(leftv res, leftv u, leftv v)
1962{
1963  int i=pVar((poly)v->Data());
1964  if (i==0)
1965  {
1966    WerrorS("ringvar expected");
1967    return TRUE;
1968  }
1969  res->data=(char *)idDiff((matrix)(u->Data()),i);
1970  return FALSE;
1971}
1972static BOOLEAN jjDIFF_ID_ID(leftv res, leftv u, leftv v)
1973{
1974  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data());
1975  return FALSE;
1976}
1977static BOOLEAN jjDIM2(leftv res, leftv v, leftv w)
1978{
1979  assumeStdFlag(v);
1980#ifdef HAVE_RINGS
1981  if (rField_is_Ring(currRing))
1982  {
1983    //ring origR = currRing;
1984    //ring tempR = rCopy(origR);
1985    //coeffs new_cf=nInitChar(n_Q,NULL);
1986    //nKillChar(tempR->cf);
1987    //tempR->cf=new_cf;
1988    //rComplete(tempR);
1989    ideal vid = (ideal)v->Data();
1990    int i = idPosConstant(vid);
1991    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
1992    { /* ideal v contains unit; dim = -1 */
1993      res->data = (char *)-1;
1994      return FALSE;
1995    }
1996    //rChangeCurrRing(tempR);
1997    //ideal vv = idrCopyR(vid, origR, currRing);
1998    ideal vv = id_Copy(vid, currRing);
1999    //ideal ww = idrCopyR((ideal)w->Data(), origR, currRing);
2000    ideal ww = id_Copy((ideal)w->Data(), currRing);
2001    /* drop degree zero generator from vv (if any) */
2002    if (i != -1) pDelete(&vv->m[i]);
2003    long d = (long)scDimInt(vv, ww);
2004    if (rField_is_Ring_Z(currRing) && (i == -1)) d++;
2005    res->data = (char *)d;
2006    idDelete(&vv); idDelete(&ww);
2007    //rChangeCurrRing(origR);
2008    //rDelete(tempR);
2009    return FALSE;
2010  }
2011#endif
2012  if(currRing->qideal==NULL)
2013    res->data = (char *)((long)scDimInt((ideal)(v->Data()),(ideal)w->Data()));
2014  else
2015  {
2016    ideal q=idSimpleAdd(currRing->qideal,(ideal)w->Data());
2017    res->data = (char *)((long)scDimInt((ideal)(v->Data()),q));
2018    idDelete(&q);
2019  }
2020  return FALSE;
2021}
2022static BOOLEAN jjDIVISION(leftv res, leftv u, leftv v)
2023{
2024  ideal vi=(ideal)v->Data();
2025  int vl= IDELEMS(vi);
2026  ideal ui=(ideal)u->Data();
2027  int ul= IDELEMS(ui);
2028  ideal R; matrix U;
2029  ideal m = idLift(vi,ui,&R, FALSE,hasFlag(v,FLAG_STD),TRUE,&U);
2030  if (m==NULL) return TRUE;
2031  // now make sure that all matices have the corect size:
2032  matrix T = id_Module2formatedMatrix(m,vl,ul,currRing);
2033  int i;
2034  if (MATCOLS(U) != ul)
2035  {
2036    int mul=si_min(ul,MATCOLS(U));
2037    matrix UU=mpNew(ul,ul);
2038    int j;
2039    for(i=mul;i>0;i--)
2040    {
2041      for(j=mul;j>0;j--)
2042      {
2043        MATELEM(UU,i,j)=MATELEM(U,i,j);
2044        MATELEM(U,i,j)=NULL;
2045      }
2046    }
2047    idDelete((ideal *)&U);
2048    U=UU;
2049  }
2050  // make sure that U is a diagonal matrix of units
2051  for(i=ul;i>0;i--)
2052  {
2053    if(MATELEM(U,i,i)==NULL) MATELEM(U,i,i)=pOne();
2054  }
2055  lists L=(lists)omAllocBin(slists_bin);
2056  L->Init(3);
2057  L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)T;
2058  L->m[1].rtyp=u->Typ();     L->m[1].data=(void *)R;
2059  L->m[2].rtyp=MATRIX_CMD;   L->m[2].data=(void *)U;
2060  res->data=(char *)L;
2061  return FALSE;
2062}
2063static BOOLEAN jjELIMIN(leftv res, leftv u, leftv v)
2064{
2065  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data());
2066  //setFlag(res,FLAG_STD);
2067  return v->next!=NULL; //do not allow next like in eliminate(I,a(1..4))
2068}
2069static BOOLEAN jjELIMIN_IV(leftv res, leftv u, leftv v)
2070{
2071  poly p=pOne();
2072  intvec *iv=(intvec*)v->Data();
2073  for(int i=iv->length()-1; i>=0; i--)
2074  {
2075    pSetExp(p,(*iv)[i],1);
2076  }
2077  pSetm(p);
2078  res->data=(char *)idElimination((ideal)u->Data(),p);
2079  pLmDelete(&p);
2080  //setFlag(res,FLAG_STD);
2081  return FALSE;
2082}
2083static BOOLEAN jjEXPORTTO(leftv, leftv u, leftv v)
2084{
2085  //Print("exportto %s -> %s\n",v->Name(),u->Name() );
2086  return iiExport(v,0,IDPACKAGE((idhdl)u->data));
2087}
2088static BOOLEAN jjERROR(leftv, leftv u)
2089{
2090  WerrorS((char *)u->Data());
2091  extern int inerror;
2092  inerror=3;
2093  return TRUE;
2094}
2095static BOOLEAN jjEXTGCD_BI(leftv res, leftv u, leftv v)
2096{
2097  number uu=(number)u->Data();number vv=(number)v->Data();
2098  lists L=(lists)omAllocBin(slists_bin);
2099  number a,b;
2100  number p0=n_ExtGcd(uu,vv,&a,&b,coeffs_BIGINT);
2101  L->Init(3);
2102  L->m[0].rtyp=BIGINT_CMD;   L->m[0].data=(void *)p0;
2103  L->m[1].rtyp=BIGINT_CMD;   L->m[1].data=(void *)a;
2104  L->m[2].rtyp=BIGINT_CMD;   L->m[2].data=(void *)b;
2105  res->rtyp=LIST_CMD;
2106  res->data=(char *)L;
2107  return FALSE;
2108}
2109static BOOLEAN jjEXTGCD_I(leftv res, leftv u, leftv v)
2110{
2111  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2112  int p0=ABS(uu),p1=ABS(vv);
2113  int f0 = 1, f1 = 0, g0 = 0, g1 = 1, q, r;
2114
2115  while ( p1!=0 )
2116  {
2117    q=p0 / p1;
2118    r=p0 % p1;
2119    p0 = p1; p1 = r;
2120    r = g0 - g1 * q;
2121    g0 = g1; g1 = r;
2122    r = f0 - f1 * q;
2123    f0 = f1; f1 = r;
2124  }
2125  int a = f0;
2126  int b = g0;
2127  if ( uu /*(int)(long)u->Data()*/ < 0 ) a=-a;
2128  if ( vv /*(int)(long)v->Data()*/ < 0 ) b=-b;
2129  lists L=(lists)omAllocBin(slists_bin);
2130  L->Init(3);
2131  L->m[0].rtyp=INT_CMD;   L->m[0].data=(void *)(long)p0;
2132  L->m[1].rtyp=INT_CMD;   L->m[1].data=(void *)(long)a;
2133  L->m[2].rtyp=INT_CMD;   L->m[2].data=(void *)(long)b;
2134  res->rtyp=LIST_CMD;
2135  res->data=(char *)L;
2136  return FALSE;
2137}
2138static BOOLEAN jjEXTGCD_P(leftv res, leftv u, leftv v)
2139{
2140  poly r,pa,pb;
2141  BOOLEAN ret=singclap_extgcd((poly)u->Data(),(poly)v->Data(),r,pa,pb,currRing);
2142  if (ret) return TRUE;
2143  lists L=(lists)omAllocBin(slists_bin);
2144  L->Init(3);
2145  res->data=(char *)L;
2146  L->m[0].data=(void *)r;
2147  L->m[0].rtyp=POLY_CMD;
2148  L->m[1].data=(void *)pa;
2149  L->m[1].rtyp=POLY_CMD;
2150  L->m[2].data=(void *)pb;
2151  L->m[2].rtyp=POLY_CMD;
2152  return FALSE;
2153}
2154extern int singclap_factorize_retry;
2155static BOOLEAN jjFAC_P2(leftv res, leftv u,leftv dummy)
2156{
2157  intvec *v=NULL;
2158  int sw=(int)(long)dummy->Data();
2159  int fac_sw=sw;
2160  if ((sw<0)||(sw>2)) fac_sw=1;
2161  singclap_factorize_retry=0;
2162  ideal f=singclap_factorize((poly)(u->CopyD()), &v, fac_sw,currRing);
2163  if (f==NULL)
2164    return TRUE;
2165  switch(sw)
2166  {
2167    case 0:
2168    case 2:
2169    {
2170      lists l=(lists)omAllocBin(slists_bin);
2171      l->Init(2);
2172      l->m[0].rtyp=IDEAL_CMD;
2173      l->m[0].data=(void *)f;
2174      l->m[1].rtyp=INTVEC_CMD;
2175      l->m[1].data=(void *)v;
2176      res->data=(void *)l;
2177      res->rtyp=LIST_CMD;
2178      return FALSE;
2179    }
2180    case 1:
2181      res->data=(void *)f;
2182      return FALSE;
2183    case 3:
2184      {
2185        poly p=f->m[0];
2186        int i=IDELEMS(f);
2187        f->m[0]=NULL;
2188        while(i>1)
2189        {
2190          i--;
2191          p=pMult(p,f->m[i]);
2192          f->m[i]=NULL;
2193        }
2194        res->data=(void *)p;
2195        res->rtyp=POLY_CMD;
2196      }
2197      return FALSE;
2198  }
2199  WerrorS("invalid switch");
2200  return TRUE;
2201}
2202static BOOLEAN jjFACSTD2(leftv res, leftv v, leftv w)
2203{
2204  ideal_list p,h;
2205  h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL,(ideal)w->Data());
2206  p=h;
2207  int l=0;
2208  while (p!=NULL) { p=p->next;l++; }
2209  lists L=(lists)omAllocBin(slists_bin);
2210  L->Init(l);
2211  l=0;
2212  while(h!=NULL)
2213  {
2214    L->m[l].data=(char *)h->d;
2215    L->m[l].rtyp=IDEAL_CMD;
2216    p=h->next;
2217    omFreeSize(h,sizeof(*h));
2218    h=p;
2219    l++;
2220  }
2221  res->data=(void *)L;
2222  return FALSE;
2223}
2224static BOOLEAN jjFAREY_BI(leftv res, leftv u, leftv v)
2225{
2226  if (rField_is_Q(currRing))
2227  {
2228    number uu=(number)u->Data();
2229    number vv=(number)v->Data();
2230    res->data=(char *)n_Farey(uu,vv,currRing->cf);
2231    return FALSE;
2232  }
2233  else return TRUE;
2234}
2235static BOOLEAN jjFAREY_ID(leftv res, leftv u, leftv v)
2236{
2237  ideal uu=(ideal)u->Data();
2238  number vv=(number)v->Data();
2239  res->data=(void*)id_Farey(uu,vv,currRing);
2240  res->rtyp=u->Typ();
2241  return FALSE;
2242}
2243static BOOLEAN jjFETCH(leftv res, leftv u, leftv v)
2244{
2245  ring r=(ring)u->Data();
2246  idhdl w;
2247  int op=iiOp;
2248  nMapFunc nMap;
2249
2250  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
2251  {
2252    int *perm=NULL;
2253    int *par_perm=NULL;
2254    int par_perm_size=0;
2255    BOOLEAN bo;
2256    if ((nMap=n_SetMap(r->cf,currRing->cf))==NULL)
2257    {
2258      // Allow imap/fetch to be make an exception only for:
2259      if ( (rField_is_Q_a(r) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2260            (rField_is_Q(currRing) || rField_is_Q_a(currRing) ||
2261             (rField_is_Zp(currRing) || rField_is_Zp_a(currRing))))
2262           ||
2263           (rField_is_Zp_a(r) &&  // Zp(a..) -> Zp(a..) || Zp
2264            (rField_is_Zp(currRing, r->cf->ch) ||
2265             rField_is_Zp_a(currRing, r->cf->ch))) )
2266      {
2267        par_perm_size=rPar(r);
2268      }
2269      else
2270      {
2271        goto err_fetch;
2272      }
2273    }
2274    if ((iiOp!=FETCH_CMD) || (r->N!=currRing->N) || (rPar(r)!=rPar(currRing)))
2275    {
2276      perm=(int *)omAlloc0((r->N+1)*sizeof(int));
2277      if (par_perm_size!=0)
2278        par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2279      op=IMAP_CMD;
2280      if (iiOp==IMAP_CMD)
2281      {
2282        int r_par=0;
2283        char ** r_par_names=NULL;
2284        if (r->cf->extRing!=NULL)
2285        {
2286          r_par=r->cf->extRing->N;
2287          r_par_names=r->cf->extRing->names;
2288        }
2289        int c_par=0;
2290        char ** c_par_names=NULL;
2291        if (currRing->cf->extRing!=NULL)
2292        {
2293          c_par=currRing->cf->extRing->N;
2294          c_par_names=currRing->cf->extRing->names;
2295        }
2296        maFindPerm(r->names,       r->N,       r_par_names, r_par,
2297                   currRing->names,currRing->N,c_par_names, c_par,
2298                   perm,par_perm, currRing->cf->type);
2299      }
2300      else
2301      {
2302        int i;
2303        if (par_perm_size!=0)
2304          for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2305        for(i=si_min(r->N,currRing->N);i>0;i--) perm[i]=i;
2306      }
2307    }
2308    if ((iiOp==FETCH_CMD) &&(BVERBOSE(V_IMAP)))
2309    {
2310      int i;
2311      for(i=0;i<si_min(r->N,currRing->N);i++)
2312      {
2313        Print("// var nr %d: %s -> %s\n",i,r->names[i],currRing->names[i]);
2314      }
2315      for(i=0;i<si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
2316      {
2317        Print("// par nr %d: %s -> %s\n",
2318              i,rParameter(r)[i],rParameter(currRing)[i]);
2319      }
2320    }
2321    sleftv tmpW;
2322    memset(&tmpW,0,sizeof(sleftv));
2323    tmpW.rtyp=IDTYP(w);
2324    tmpW.data=IDDATA(w);
2325    if ((bo=maApplyFetch(op,NULL,res,&tmpW, r,
2326                         perm,par_perm,par_perm_size,nMap)))
2327    {
2328      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
2329    }
2330    if (perm!=NULL)
2331      omFreeSize((ADDRESS)perm,(r->N+1)*sizeof(int));
2332    if (par_perm!=NULL)
2333      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2334    return bo;
2335  }
2336  else
2337  {
2338    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
2339  }
2340  return TRUE;
2341err_fetch:
2342  Werror("no identity map from %s (%s -> %s)",u->Fullname(),
2343    r->cf->cfCoeffString(r->cf),
2344    currRing->cf->cfCoeffString(currRing->cf));
2345  return TRUE;
2346}
2347static BOOLEAN jjFIND2(leftv res, leftv u, leftv v)
2348{
2349  /*4
2350  * look for the substring what in the string where
2351  * return the position of the first char of what in where
2352  * or 0
2353  */
2354  char *where=(char *)u->Data();
2355  char *what=(char *)v->Data();
2356  char *found = strstr(where,what);
2357  if (found != NULL)
2358  {
2359    res->data=(char *)((found-where)+1);
2360  }
2361  /*else res->data=NULL;*/
2362  return FALSE;
2363}
2364static BOOLEAN jjFWALK(leftv res, leftv u, leftv v)
2365{
2366  res->data=(char *)fractalWalkProc(u,v);
2367  setFlag( res, FLAG_STD );
2368  return FALSE;
2369}
2370static BOOLEAN jjGCD_I(leftv res, leftv u, leftv v)
2371{
2372  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2373  int p0=ABS(uu),p1=ABS(vv);
2374  int r;
2375  while ( p1!=0 )
2376  {
2377    r=p0 % p1;
2378    p0 = p1; p1 = r;
2379  }
2380  res->rtyp=INT_CMD;
2381  res->data=(char *)(long)p0;
2382  return FALSE;
2383}
2384static BOOLEAN jjGCD_BI(leftv res, leftv u, leftv v)
2385{
2386  number n1 = (number) u->Data();
2387  number n2 = (number) v->Data();
2388  res->data = n_Gcd(n1,n2,coeffs_BIGINT);
2389  return FALSE;
2390}
2391static BOOLEAN jjGCD_N(leftv res, leftv u, leftv v)
2392{
2393  number a=(number) u->Data();
2394  number b=(number) v->Data();
2395  if (nIsZero(a))
2396  {
2397    if (nIsZero(b)) res->data=(char *)nInit(1);
2398    else            res->data=(char *)nCopy(b);
2399  }
2400  else
2401  {
2402    if (nIsZero(b))  res->data=(char *)nCopy(a);
2403    //else res->data=(char *)n_Gcd(a, b, currRing->cf);
2404    else res->data=(char *)n_SubringGcd(a, b, currRing->cf);
2405  }
2406  return FALSE;
2407}
2408static BOOLEAN jjGCD_P(leftv res, leftv u, leftv v)
2409{
2410  res->data=(void *)singclap_gcd((poly)(u->CopyD(POLY_CMD)),
2411                                 (poly)(v->CopyD(POLY_CMD)),currRing);
2412  return FALSE;
2413}
2414static BOOLEAN jjHILBERT2(leftv res, leftv u, leftv v)
2415{
2416#ifdef HAVE_RINGS
2417  if (rField_is_Ring_Z(currRing))
2418  {
2419    ring origR = currRing;
2420    ring tempR = rCopy(origR);
2421    coeffs new_cf=nInitChar(n_Q,NULL);
2422    nKillChar(tempR->cf);
2423    tempR->cf=new_cf;
2424    rComplete(tempR);
2425    ideal uid = (ideal)u->Data();
2426    rChangeCurrRing(tempR);
2427    ideal uu = idrCopyR(uid, origR, currRing);
2428    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
2429    uuAsLeftv.rtyp = IDEAL_CMD;
2430    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
2431    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
2432    assumeStdFlag(&uuAsLeftv);
2433    Print("// NOTE: computation of Hilbert series etc. is being\n");
2434    Print("//       performed for generic fibre, that is, over Q\n");
2435    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
2436    intvec *iv=hFirstSeries(uu,module_w,currRing->qideal);
2437    int returnWithTrue = 1;
2438    switch((int)(long)v->Data())
2439    {
2440      case 1:
2441        res->data=(void *)iv;
2442        returnWithTrue = 0;
2443      case 2:
2444        res->data=(void *)hSecondSeries(iv);
2445        delete iv;
2446        returnWithTrue = 0;
2447    }
2448    if (returnWithTrue)
2449    {
2450      WerrorS(feNotImplemented);
2451      delete iv;
2452    }
2453    idDelete(&uu);
2454    rChangeCurrRing(origR);
2455    rDelete(tempR);
2456    if (returnWithTrue) return TRUE; else return FALSE;
2457  }
2458#endif
2459  assumeStdFlag(u);
2460  intvec *module_w=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2461  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currRing->qideal);
2462  switch((int)(long)v->Data())
2463  {
2464    case 1:
2465      res->data=(void *)iv;
2466      return FALSE;
2467    case 2:
2468      res->data=(void *)hSecondSeries(iv);
2469      delete iv;
2470      return FALSE;
2471  }
2472  WerrorS(feNotImplemented);
2473  delete iv;
2474  return TRUE;
2475}
2476static BOOLEAN jjHOMOG_P(leftv res, leftv u, leftv v)
2477{
2478  int i=pVar((poly)v->Data());
2479  if (i==0)
2480  {
2481    WerrorS("ringvar expected");
2482    return TRUE;
2483  }
2484  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2485  int d=pWTotaldegree(p);
2486  pLmDelete(p);
2487  if (d==1)
2488    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
2489  else
2490    WerrorS("variable must have weight 1");
2491  return (d!=1);
2492}
2493static BOOLEAN jjHOMOG_ID(leftv res, leftv u, leftv v)
2494{
2495  int i=pVar((poly)v->Data());
2496  if (i==0)
2497  {
2498    WerrorS("ringvar expected");
2499    return TRUE;
2500  }
2501  pFDegProc deg;
2502  if (currRing->pLexOrder && (currRing->order[0]==ringorder_lp))
2503    deg=p_Totaldegree;
2504   else
2505    deg=currRing->pFDeg;
2506  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2507  int d=deg(p,currRing);
2508  pLmDelete(p);
2509  if (d==1)
2510    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
2511  else
2512    WerrorS("variable must have weight 1");
2513  return (d!=1);
2514}
2515static BOOLEAN jjHOMOG1_W(leftv res, leftv v, leftv u)
2516{
2517  intvec *w=new intvec(rVar(currRing));
2518  intvec *vw=(intvec*)u->Data();
2519  ideal v_id=(ideal)v->Data();
2520  pFDegProc save_FDeg=currRing->pFDeg;
2521  pLDegProc save_LDeg=currRing->pLDeg;
2522  BOOLEAN save_pLexOrder=currRing->pLexOrder;
2523  currRing->pLexOrder=FALSE;
2524  kHomW=vw;
2525  kModW=w;
2526  pSetDegProcs(currRing,kHomModDeg);
2527  res->data=(void *)(long)idHomModule(v_id,currRing->qideal,&w);
2528  currRing->pLexOrder=save_pLexOrder;
2529  kHomW=NULL;
2530  kModW=NULL;
2531  pRestoreDegProcs(currRing,save_FDeg,save_LDeg);
2532  if (w!=NULL) delete w;
2533  return FALSE;
2534}
2535static BOOLEAN jjINDEPSET2(leftv res, leftv u, leftv v)
2536{
2537  assumeStdFlag(u);
2538  res->data=(void *)scIndIndset((ideal)(u->Data()),(int)(long)(v->Data()),
2539                    currRing->qideal);
2540  return FALSE;
2541}
2542static BOOLEAN jjINTERSECT(leftv res, leftv u, leftv v)
2543{
2544  res->data=(char *)idSect((ideal)u->Data(),(ideal)v->Data());
2545  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
2546  return FALSE;
2547}
2548static BOOLEAN jjINTERPOLATION (leftv res, leftv l, leftv v)
2549{
2550  const lists L = (lists)l->Data();
2551  const int n = L->nr; assume (n >= 0);
2552  std::vector<ideal> V(n + 1);
2553
2554  for(int i = n; i >= 0; i--) V[i] = (ideal)(L->m[i].Data());
2555
2556  res->data=interpolation(V, (intvec*)v->Data());
2557  setFlag(res,FLAG_STD);
2558  return errorreported;
2559}
2560static BOOLEAN jjJanetBasis2(leftv res, leftv u, leftv v)
2561{
2562  extern BOOLEAN jjStdJanetBasis(leftv res, leftv v,int flag);
2563  return jjStdJanetBasis(res,u,(int)(long)v->Data());
2564}
2565
2566static BOOLEAN jjJanetBasis(leftv res, leftv v)
2567{
2568  extern BOOLEAN jjStdJanetBasis(leftv res, leftv v,int flag);
2569  return jjStdJanetBasis(res,v,0);
2570}
2571static BOOLEAN jjJET_P(leftv res, leftv u, leftv v)
2572{
2573  res->data = (char *)pJet((poly)u->CopyD(), (int)(long)v->Data());
2574  return FALSE;
2575}
2576static BOOLEAN jjJET_ID(leftv res, leftv u, leftv v)
2577{
2578  res->data = (char *)id_Jet((ideal)u->Data(),(int)(long)v->Data(),currRing);
2579  return FALSE;
2580}
2581static BOOLEAN jjKBASE2(leftv res, leftv u, leftv v)
2582{
2583  assumeStdFlag(u);
2584  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2585  res->data = (char *)scKBase((int)(long)v->Data(),
2586                              (ideal)(u->Data()),currRing->qideal, w_u);
2587  if (w_u!=NULL)
2588  {
2589    atSet(res,omStrDup("isHomog"),ivCopy(w_u),INTVEC_CMD);
2590  }
2591  return FALSE;
2592}
2593static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w);
2594static BOOLEAN jjKERNEL(leftv res, leftv u, leftv v)
2595{
2596  return jjPREIMAGE(res,u,v,NULL);
2597}
2598static BOOLEAN jjKoszul(leftv res, leftv u, leftv v)
2599{
2600  return mpKoszul(res, u,v,NULL);
2601}
2602static BOOLEAN jjKoszul_Id(leftv res, leftv u, leftv v)
2603{
2604  sleftv h;
2605  memset(&h,0,sizeof(sleftv));
2606  h.rtyp=INT_CMD;
2607  h.data=(void *)(long)IDELEMS((ideal)v->Data());
2608  return mpKoszul(res, u, &h, v);
2609}
2610static BOOLEAN jjLIFT(leftv res, leftv u, leftv v)
2611{
2612  int ul= IDELEMS((ideal)u->Data());
2613  int vl= IDELEMS((ideal)v->Data());
2614  ideal m = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,
2615                   hasFlag(u,FLAG_STD));
2616  if (m==NULL) return TRUE;
2617  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
2618  return FALSE;
2619}
2620static BOOLEAN jjLIFTSTD(leftv res, leftv u, leftv v)
2621{
2622  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
2623  idhdl h=(idhdl)v->data;
2624  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
2625  res->data = (char *)idLiftStd((ideal)u->Data(),
2626                                &(h->data.umatrix),testHomog);
2627  setFlag(res,FLAG_STD); v->flag=0;
2628  return FALSE;
2629}
2630static BOOLEAN jjLOAD2(leftv /*res*/, leftv, leftv v)
2631{
2632  return jjLOAD((char*)v->Data(),TRUE);
2633}
2634static BOOLEAN jjLOAD_E(leftv /*res*/, leftv v, leftv u)
2635{
2636  char * s=(char *)u->Data();
2637  if(strcmp(s, "with")==0)
2638    return jjLOAD((char*)v->Data(), TRUE);
2639  WerrorS("invalid second argument");
2640  WerrorS("load(\"libname\" [,\"with\"]);");
2641  return TRUE;
2642}
2643static BOOLEAN jjMODULO(leftv res, leftv u, leftv v)
2644{
2645  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2646  tHomog hom=testHomog;
2647  if (w_u!=NULL)
2648  {
2649    w_u=ivCopy(w_u);
2650    hom=isHomog;
2651  }
2652  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
2653  if (w_v!=NULL)
2654  {
2655    w_v=ivCopy(w_v);
2656    hom=isHomog;
2657  }
2658  if ((w_u!=NULL) && (w_v==NULL))
2659    w_v=ivCopy(w_u);
2660  if ((w_v!=NULL) && (w_u==NULL))
2661    w_u=ivCopy(w_v);
2662  ideal u_id=(ideal)u->Data();
2663  ideal v_id=(ideal)v->Data();
2664  if (w_u!=NULL)
2665  {
2666     if ((*w_u).compare((w_v))!=0)
2667     {
2668       WarnS("incompatible weights");
2669       delete w_u; w_u=NULL;
2670       hom=testHomog;
2671     }
2672     else
2673     {
2674       if ((!idTestHomModule(u_id,currRing->qideal,w_v))
2675       || (!idTestHomModule(v_id,currRing->qideal,w_v)))
2676       {
2677         WarnS("wrong weights");
2678         delete w_u; w_u=NULL;
2679         hom=testHomog;
2680       }
2681     }
2682  }
2683  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u);
2684  if (w_u!=NULL)
2685  {
2686    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
2687  }
2688  delete w_v;
2689  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
2690  return FALSE;
2691}
2692static BOOLEAN jjMOD_BI(leftv res, leftv u, leftv v)
2693{
2694  number q=(number)v->Data();
2695  if (n_IsZero(q,coeffs_BIGINT))
2696  {
2697    WerrorS(ii_div_by_0);
2698    return TRUE;
2699  }
2700  res->data =(char *) n_IntMod((number)u->Data(),q,coeffs_BIGINT);
2701  return FALSE;
2702}
2703static BOOLEAN jjMOD_N(leftv res, leftv u, leftv v)
2704{
2705  number q=(number)v->Data();
2706  if (nIsZero(q))
2707  {
2708    WerrorS(ii_div_by_0);
2709    return TRUE;
2710  }
2711  res->data =(char *) n_IntMod((number)u->Data(),q,currRing->cf);
2712  return FALSE;
2713}
2714static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v);
2715static BOOLEAN jjMONITOR1(leftv res, leftv v)
2716{
2717  return jjMONITOR2(res,v,NULL);
2718}
2719static BOOLEAN jjMONITOR2(leftv, leftv u,leftv v)
2720{
2721#if 0
2722  char *opt=(char *)v->Data();
2723  int mode=0;
2724  while(*opt!='\0')
2725  {
2726    if (*opt=='i') mode |= SI_PROT_I;
2727    else if (*opt=='o') mode |= SI_PROT_O;
2728    opt++;
2729  }
2730  monitor((char *)(u->Data()),mode);
2731#else
2732  si_link l=(si_link)u->Data();
2733  if (slOpen(l,SI_LINK_WRITE,u)) return TRUE;
2734  if(strcmp(l->m->type,"ASCII")!=0)
2735  {
2736    Werror("ASCII link required, not `%s`",l->m->type);
2737    slClose(l);
2738    return TRUE;
2739  }
2740  SI_LINK_SET_CLOSE_P(l); // febase handles the FILE*
2741  if ( l->name[0]!='\0') // "" is the stop condition
2742  {
2743    const char *opt;
2744    int mode=0;
2745    if (v==NULL) opt=(const char*)"i";
2746    else         opt=(const char *)v->Data();
2747    while(*opt!='\0')
2748    {
2749      if (*opt=='i') mode |= SI_PROT_I;
2750      else if (*opt=='o') mode |= SI_PROT_O;
2751      opt++;
2752    }
2753    monitor((FILE *)l->data,mode);
2754  }
2755  else
2756    monitor(NULL,0);
2757  return FALSE;
2758#endif
2759}
2760static BOOLEAN jjMONOM(leftv res, leftv v)
2761{
2762  intvec *iv=(intvec *)v->Data();
2763  poly p=pOne();
2764  int i,e;
2765  BOOLEAN err=FALSE;
2766  for(i=si_min(currRing->N,iv->length()); i>0; i--)
2767  {
2768    e=(*iv)[i-1];
2769    if (e>=0) pSetExp(p,i,e);
2770    else err=TRUE;
2771  }
2772  if (iv->length()==(currRing->N+1))
2773  {
2774    res->rtyp=VECTOR_CMD;
2775    e=(*iv)[currRing->N];
2776    if (e>=0) pSetComp(p,e);
2777    else err=TRUE;
2778  }
2779  pSetm(p);
2780  res->data=(char*)p;
2781  if(err) { pDelete(&p); WerrorS("no negative exponent allowed"); }
2782  return err;
2783}
2784static BOOLEAN jjNEWSTRUCT2(leftv, leftv u, leftv v)
2785{
2786  // u: the name of the new type
2787  // v: the elements
2788  newstruct_desc d=newstructFromString((const char *)v->Data());
2789  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
2790  return d==NULL;
2791}
2792static BOOLEAN jjPARSTR2(leftv res, leftv u, leftv v)
2793{
2794  idhdl h=(idhdl)u->data;
2795  int i=(int)(long)v->Data();
2796  int p=0;
2797  if ((0<i)
2798  && (rParameter(IDRING(h))!=NULL)
2799  && (i<=(p=rPar(IDRING(h)))))
2800    res->data=omStrDup(rParameter(IDRING(h))[i-1]);
2801  else
2802  {
2803    Werror("par number %d out of range 1..%d",i,p);
2804    return TRUE;
2805  }
2806  return FALSE;
2807}
2808#ifdef HAVE_PLURAL
2809static BOOLEAN jjPlural_num_poly(leftv res, leftv a, leftv b)
2810{
2811  if( currRing->qideal != NULL )
2812  {
2813    WerrorS("basering must NOT be a qring!");
2814    return TRUE;
2815  }
2816
2817  if (iiOp==NCALGEBRA_CMD)
2818  {
2819    return nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),currRing,false,true,false,currRing);
2820  }
2821  else
2822  {
2823    ring r=rCopy(currRing);
2824    BOOLEAN result=nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),r,false,true,false,currRing);
2825    res->data=r;
2826    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2827    return result;
2828  }
2829}
2830static BOOLEAN jjPlural_num_mat(leftv res, leftv a, leftv b)
2831{
2832  if( currRing->qideal != NULL )
2833  {
2834    WerrorS("basering must NOT be a qring!");
2835    return TRUE;
2836  }
2837
2838  if (iiOp==NCALGEBRA_CMD)
2839  {
2840    return nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,currRing,false,true,false,currRing);
2841  }
2842  else
2843  {
2844    ring r=rCopy(currRing);
2845    BOOLEAN result=nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,r,false,true,false,currRing);
2846    res->data=r;
2847    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2848    return result;
2849  }
2850}
2851static BOOLEAN jjPlural_mat_poly(leftv res, leftv a, leftv b)
2852{
2853  if( currRing->qideal != NULL )
2854  {
2855    WerrorS("basering must NOT be a qring!");
2856    return TRUE;
2857  }
2858
2859  if (iiOp==NCALGEBRA_CMD)
2860  {
2861    return nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),currRing,false,true,false,currRing);
2862  }
2863  else
2864  {
2865    ring r=rCopy(currRing);
2866    BOOLEAN result=nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),r,false,true,false,currRing);
2867    res->data=r;
2868    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2869    return result;
2870  }
2871}
2872static BOOLEAN jjPlural_mat_mat(leftv res, leftv a, leftv b)
2873{
2874  if( currRing->qideal != NULL )
2875  {
2876    WerrorS("basering must NOT be a qring!");
2877    return TRUE;
2878  }
2879
2880  if (iiOp==NCALGEBRA_CMD)
2881  {
2882    return nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,currRing,false,true,false,currRing);
2883  }
2884  else
2885  {
2886    ring r=rCopy(currRing);
2887    BOOLEAN result=nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,r,false,true,false,currRing);
2888    res->data=r;
2889    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2890    return result;
2891  }
2892}
2893static BOOLEAN jjBRACKET(leftv res, leftv a, leftv b)
2894{
2895  res->data=NULL;
2896
2897  if (rIsPluralRing(currRing))
2898  {
2899    const poly q = (poly)b->Data();
2900
2901    if( q != NULL )
2902    {
2903      if( (poly)a->Data() != NULL )
2904      {
2905        poly p = (poly)a->CopyD(POLY_CMD); // p = copy!
2906        res->data = nc_p_Bracket_qq(p,q, currRing); // p will be destroyed!
2907      }
2908    }
2909  }
2910  return FALSE;
2911}
2912static BOOLEAN jjOPPOSE(leftv res, leftv a, leftv b)
2913{
2914  /* number, poly, vector, ideal, module, matrix */
2915  ring  r = (ring)a->Data();
2916  if (r == currRing)
2917  {
2918    res->data = b->Data();
2919    res->rtyp = b->rtyp;
2920    return FALSE;
2921  }
2922  if (!rIsLikeOpposite(currRing, r))
2923  {
2924    Werror("%s is not an opposite ring to current ring",a->Fullname());
2925    return TRUE;
2926  }
2927  idhdl w;
2928  if( ((w=r->idroot->get(b->Name(),myynest))!=NULL) && (b->e==NULL))
2929  {
2930    int argtype = IDTYP(w);
2931    switch (argtype)
2932    {
2933    case NUMBER_CMD:
2934      {
2935        /* since basefields are equal, we can apply nCopy */
2936        res->data = nCopy((number)IDDATA(w));
2937        res->rtyp = argtype;
2938        break;
2939      }
2940    case POLY_CMD:
2941    case VECTOR_CMD:
2942      {
2943        poly    q = (poly)IDDATA(w);
2944        res->data = pOppose(r,q,currRing);
2945        res->rtyp = argtype;
2946        break;
2947      }
2948    case IDEAL_CMD:
2949    case MODUL_CMD:
2950      {
2951        ideal   Q = (ideal)IDDATA(w);
2952        res->data = idOppose(r,Q,currRing);
2953        res->rtyp = argtype;
2954        break;
2955      }
2956    case MATRIX_CMD:
2957      {
2958        ring save = currRing;
2959        rChangeCurrRing(r);
2960        matrix  m = (matrix)IDDATA(w);
2961        ideal   Q = id_Matrix2Module(mp_Copy(m, currRing),currRing);
2962        rChangeCurrRing(save);
2963        ideal   S = idOppose(r,Q,currRing);
2964        id_Delete(&Q, r);
2965        res->data = id_Module2Matrix(S,currRing);
2966        res->rtyp = argtype;
2967        break;
2968      }
2969    default:
2970      {
2971        WerrorS("unsupported type in oppose");
2972        return TRUE;
2973      }
2974    }
2975  }
2976  else
2977  {
2978    Werror("identifier %s not found in %s",b->Fullname(),a->Fullname());
2979    return TRUE;
2980  }
2981  return FALSE;
2982}
2983#endif /* HAVE_PLURAL */
2984
2985static BOOLEAN jjQUOT(leftv res, leftv u, leftv v)
2986{
2987  res->data = (char *)idQuot((ideal)u->Data(),(ideal)v->Data(),
2988    hasFlag(u,FLAG_STD),u->Typ()==v->Typ());
2989  id_DelMultiples((ideal)(res->data),currRing);
2990  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
2991  return FALSE;
2992}
2993static BOOLEAN jjRANDOM(leftv res, leftv u, leftv v)
2994{
2995  int i=(int)(long)u->Data();
2996  int j=(int)(long)v->Data();
2997  if (j-i <0) {WerrorS("invalid range for random"); return TRUE;}
2998  res->data =(char *)(long)((i > j) ? i : (siRand() % (j-i+1)) + i);
2999  return FALSE;
3000}
3001static BOOLEAN jjRANK2(leftv res, leftv u, leftv v)
3002{
3003  matrix m =(matrix)u->Data();
3004  int isRowEchelon = (int)(long)v->Data();
3005  if (isRowEchelon != 1) isRowEchelon = 0;
3006  int rank = luRank(m, isRowEchelon);
3007  res->data =(char *)(long)rank;
3008  return FALSE;
3009}
3010static BOOLEAN jjREAD2(leftv res, leftv u, leftv v)
3011{
3012  si_link l=(si_link)u->Data();
3013  leftv r=slRead(l,v);
3014  if (r==NULL)
3015  {
3016    const char *s;
3017    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3018    else                            s=sNoName;
3019    Werror("cannot read from `%s`",s);
3020    return TRUE;
3021  }
3022  memcpy(res,r,sizeof(sleftv));
3023  omFreeBin((ADDRESS)r, sleftv_bin);
3024  return FALSE;
3025}
3026static BOOLEAN jjREDUCE_P(leftv res, leftv u, leftv v)
3027{
3028  assumeStdFlag(v);
3029  res->data = (char *)kNF((ideal)v->Data(),currRing->qideal,(poly)u->Data());
3030  return FALSE;
3031}
3032static BOOLEAN jjREDUCE_ID(leftv res, leftv u, leftv v)
3033{
3034  assumeStdFlag(v);
3035  ideal ui=(ideal)u->Data();
3036  ideal vi=(ideal)v->Data();
3037  res->data = (char *)kNF(vi,currRing->qideal,ui);
3038  return FALSE;
3039}
3040#if 0
3041static BOOLEAN jjRES(leftv res, leftv u, leftv v)
3042{
3043  int maxl=(int)(long)v->Data();
3044  if (maxl<0)
3045  {
3046    WerrorS("length for res must not be negative");
3047    return TRUE;
3048  }
3049  int l=0;
3050  //resolvente r;
3051  syStrategy r;
3052  intvec *weights=NULL;
3053  int wmaxl=maxl;
3054  ideal u_id=(ideal)u->Data();
3055
3056  maxl--;
3057  if (/*(*/ maxl==-1 /*)*/) /*&& (iiOp!=MRES_CMD)*/
3058  {
3059    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3060    if (currRing->qideal!=NULL)
3061    {
3062      Warn(
3063      "full resolution in a qring may be infinite, setting max length to %d",
3064      maxl+1);
3065    }
3066  }
3067  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3068  if (weights!=NULL)
3069  {
3070    if (!idTestHomModule(u_id,currRing->qideal,weights))
3071    {
3072      WarnS("wrong weights given:");weights->show();PrintLn();
3073      weights=NULL;
3074    }
3075  }
3076  intvec *ww=NULL;
3077  int add_row_shift=0;
3078  if (weights!=NULL)
3079  {
3080     ww=ivCopy(weights);
3081     add_row_shift = ww->min_in();
3082     (*ww) -= add_row_shift;
3083  }
3084  else
3085    idHomModule(u_id,currRing->qideal,&ww);
3086  weights=ww;
3087
3088  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3089  {
3090    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3091  }
3092  else if (iiOp==SRES_CMD)
3093  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3094    r=sySchreyer(u_id,maxl+1);
3095  else if (iiOp == LRES_CMD)
3096  {
3097    int dummy;
3098    if((currRing->qideal!=NULL)||
3099    (!idHomIdeal (u_id,NULL)))
3100    {
3101       WerrorS
3102       ("`lres` not implemented for inhomogeneous input or qring");
3103       return TRUE;
3104    }
3105    r=syLaScala3(u_id,&dummy);
3106  }
3107  else if (iiOp == KRES_CMD)
3108  {
3109    int dummy;
3110    if((currRing->qideal!=NULL)||
3111    (!idHomIdeal (u_id,NULL)))
3112    {
3113       WerrorS
3114       ("`kres` not implemented for inhomogeneous input or qring");
3115       return TRUE;
3116    }
3117    r=syKosz(u_id,&dummy);
3118  }
3119  else
3120  {
3121    int dummy;
3122    if((currRing->qideal!=NULL)||
3123    (!idHomIdeal (u_id,NULL)))
3124    {
3125       WerrorS
3126       ("`hres` not implemented for inhomogeneous input or qring");
3127       return TRUE;
3128    }
3129    r=syHilb(u_id,&dummy);
3130  }
3131  if (r==NULL) return TRUE;
3132  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3133  r->list_length=wmaxl;
3134  res->data=(void *)r;
3135  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3136  {
3137    intvec *w=ivCopy(r->weights[0]);
3138    if (weights!=NULL) (*w) += add_row_shift;
3139    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3140    w=NULL;
3141  }
3142  else
3143  {
3144//#if 0
3145// need to set weights for ALL components (sres)
3146    if (weights!=NULL)
3147    {
3148      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3149      r->weights = (intvec**)omAlloc0Bin(char_ptr_bin);
3150      (r->weights)[0] = ivCopy(weights);
3151    }
3152//#endif
3153  }
3154  if (ww!=NULL) { delete ww; ww=NULL; }
3155  return FALSE;
3156}
3157#else
3158static BOOLEAN jjRES(leftv res, leftv u, leftv v)
3159{
3160  int maxl=(int)(long)v->Data();
3161  if (maxl<0)
3162  {
3163    WerrorS("length for res must not be negative");
3164    return TRUE;
3165  }
3166  syStrategy r;
3167  intvec *weights=NULL;
3168  int wmaxl=maxl;
3169  ideal u_id=(ideal)u->Data();
3170
3171  maxl--;
3172  if (/*(*/ maxl==-1 /*)*/) /*&& (iiOp!=MRES_CMD)*/
3173  {
3174    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3175    if (currRing->qideal!=NULL)
3176    {
3177      Warn(
3178      "full resolution in a qring may be infinite, setting max length to %d",
3179      maxl+1);
3180    }
3181  }
3182  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3183  if (weights!=NULL)
3184  {
3185    if (!idTestHomModule(u_id,currRing->qideal,weights))
3186    {
3187      WarnS("wrong weights given:");weights->show();PrintLn();
3188      weights=NULL;
3189    }
3190  }
3191  intvec *ww=NULL;
3192  int add_row_shift=0;
3193  if (weights!=NULL)
3194  {
3195     ww=ivCopy(weights);
3196     add_row_shift = ww->min_in();
3197     (*ww) -= add_row_shift;
3198  }
3199  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3200  {
3201    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3202  }
3203  else if (iiOp==SRES_CMD)
3204  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3205    r=sySchreyer(u_id,maxl+1);
3206  else if (iiOp == LRES_CMD)
3207  {
3208    int dummy;
3209    if((currRing->qideal!=NULL)||
3210    (!idHomIdeal (u_id,NULL)))
3211    {
3212       WerrorS
3213       ("`lres` not implemented for inhomogeneous input or qring");
3214       return TRUE;
3215    }
3216    if(currRing->N == 1)
3217      WarnS("the current implementation of `lres` may not work in the case of a single variable");
3218    r=syLaScala3(u_id,&dummy);
3219  }
3220  else if (iiOp == KRES_CMD)
3221  {
3222    int dummy;
3223    if((currRing->qideal!=NULL)||
3224    (!idHomIdeal (u_id,NULL)))
3225    {
3226       WerrorS
3227       ("`kres` not implemented for inhomogeneous input or qring");
3228       return TRUE;
3229    }
3230    r=syKosz(u_id,&dummy);
3231  }
3232  else
3233  {
3234    int dummy;
3235    if((currRing->qideal!=NULL)||
3236    (!idHomIdeal (u_id,NULL)))
3237    {
3238       WerrorS
3239       ("`hres` not implemented for inhomogeneous input or qring");
3240       return TRUE;
3241    }
3242    ideal u_id_copy=idCopy(u_id);
3243    idSkipZeroes(u_id_copy);
3244    r=syHilb(u_id_copy,&dummy);
3245    idDelete(&u_id_copy);
3246  }
3247  if (r==NULL) return TRUE;
3248  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3249  r->list_length=wmaxl;
3250  res->data=(void *)r;
3251  if ((weights!=NULL) && (ww!=NULL)) { delete ww; ww=NULL; }
3252  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3253  {
3254    ww=ivCopy(r->weights[0]);
3255    if (weights!=NULL) (*ww) += add_row_shift;
3256    atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
3257  }
3258  else
3259  {
3260    if (weights!=NULL)
3261    {
3262      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3263    }
3264  }
3265
3266  // test the La Scala case' output
3267  assume( ((iiOp == LRES_CMD) || (iiOp == HRES_CMD)) == (r->syRing != NULL) );
3268  assume( (r->syRing != NULL) == (r->resPairs != NULL) );
3269
3270  if(iiOp != HRES_CMD)
3271    assume( (r->minres != NULL) || (r->fullres != NULL) ); // is wrong for HRES_CMD...
3272  else
3273    assume( (r->orderedRes != NULL) || (r->res != NULL) ); // analog for hres...
3274
3275  return FALSE;
3276}
3277#endif
3278static BOOLEAN jjPFAC2(leftv res, leftv u, leftv v)
3279{
3280  number n1; int i;
3281
3282  if ((u->Typ() == BIGINT_CMD) ||
3283     ((u->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3284  {
3285    n1 = (number)u->CopyD();
3286  }
3287  else if (u->Typ() == INT_CMD)
3288  {
3289    i = (int)(long)u->Data();
3290    n1 = n_Init(i, coeffs_BIGINT);
3291  }
3292  else
3293  {
3294    return TRUE;
3295  }
3296
3297  i = (int)(long)v->Data();
3298
3299  lists l = primeFactorisation(n1, i);
3300  n_Delete(&n1, coeffs_BIGINT);
3301  res->data = (char*)l;
3302  return FALSE;
3303}
3304static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
3305{
3306  ring r;
3307  int i=rSum((ring)u->Data(),(ring)v->Data(),r);
3308  res->data = (char *)r;
3309  return (i==-1);
3310}
3311#define SIMPL_LMDIV 32
3312#define SIMPL_LMEQ  16
3313#define SIMPL_MULT 8
3314#define SIMPL_EQU  4
3315#define SIMPL_NULL 2
3316#define SIMPL_NORM 1
3317static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
3318{
3319  int sw = (int)(long)v->Data();
3320  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
3321  ideal id = (ideal)u->CopyD(IDEAL_CMD);
3322  if (sw & SIMPL_LMDIV)
3323  {
3324    id_DelDiv(id,currRing);
3325  }
3326  if (sw & SIMPL_LMEQ)
3327  {
3328    id_DelLmEquals(id,currRing);
3329  }
3330  if (sw & SIMPL_MULT)
3331  {
3332    id_DelMultiples(id,currRing);
3333  }
3334  else if(sw & SIMPL_EQU)
3335  {
3336    id_DelEquals(id,currRing);
3337  }
3338  if (sw & SIMPL_NULL)
3339  {
3340    idSkipZeroes(id);
3341  }
3342  if (sw & SIMPL_NORM)
3343  {
3344    id_Norm(id,currRing);
3345  }
3346  res->data = (char * )id;
3347  return FALSE;
3348}
3349extern int singclap_factorize_retry;
3350static BOOLEAN jjSQR_FREE2(leftv res, leftv u, leftv dummy)
3351{
3352  intvec *v=NULL;
3353  int sw=(int)(long)dummy->Data();
3354  int fac_sw=sw;
3355  if (sw<0) fac_sw=1;
3356  singclap_factorize_retry=0;
3357  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, fac_sw, currRing);
3358  if (f==NULL)
3359    return TRUE;
3360  switch(sw)
3361  {
3362    case 0:
3363    case 2:
3364    {
3365      lists l=(lists)omAllocBin(slists_bin);
3366      l->Init(2);
3367      l->m[0].rtyp=IDEAL_CMD;
3368      l->m[0].data=(void *)f;
3369      l->m[1].rtyp=INTVEC_CMD;
3370      l->m[1].data=(void *)v;
3371      res->data=(void *)l;
3372      res->rtyp=LIST_CMD;
3373      return FALSE;
3374    }
3375    case 1:
3376      res->data=(void *)f;
3377      return FALSE;
3378    case 3:
3379      {
3380        poly p=f->m[0];
3381        int i=IDELEMS(f);
3382        f->m[0]=NULL;
3383        while(i>1)
3384        {
3385          i--;
3386          p=pMult(p,f->m[i]);
3387          f->m[i]=NULL;
3388        }
3389        res->data=(void *)p;
3390        res->rtyp=POLY_CMD;
3391      }
3392      return FALSE;
3393  }
3394  WerrorS("invalid switch");
3395  return FALSE;
3396}
3397static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
3398{
3399  res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
3400  return FALSE;
3401}
3402static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
3403{
3404  res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
3405  //return (res->data== (void*)(long)-2);
3406  return FALSE;
3407}
3408static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
3409{
3410  int sw = (int)(long)v->Data();
3411  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3412  poly p = (poly)u->CopyD(POLY_CMD);
3413  if (sw & SIMPL_NORM)
3414  {
3415    pNorm(p);
3416  }
3417  res->data = (char * )p;
3418  return FALSE;
3419}
3420static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
3421{
3422  ideal result;
3423  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3424  tHomog hom=testHomog;
3425  ideal u_id=(ideal)(u->Data());
3426  if (w!=NULL)
3427  {
3428    if (!idTestHomModule(u_id,currRing->qideal,w))
3429    {
3430      WarnS("wrong weights:");w->show();PrintLn();
3431      w=NULL;
3432    }
3433    else
3434    {
3435      w=ivCopy(w);
3436      hom=isHomog;
3437    }
3438  }
3439  result=kStd(u_id,currRing->qideal,hom,&w,(intvec *)v->Data());
3440  idSkipZeroes(result);
3441  res->data = (char *)result;
3442  setFlag(res,FLAG_STD);
3443  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3444  return FALSE;
3445}
3446static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v);
3447static void jjSTD_1_ID(leftv res, ideal i0, int t0, ideal p0, attr a)
3448/* destroys i0, p0 */
3449/* result (with attributes) in res */
3450/* i0: SB*/
3451/* t0: type of p0*/
3452/* p0 new elements*/
3453/* a attributes of i0*/
3454{
3455  int tp;
3456  if (t0==IDEAL_CMD) tp=POLY_CMD;
3457  else               tp=VECTOR_CMD;
3458  for (int i=IDELEMS(p0)-1; i>=0; i--)
3459  {
3460    poly p=p0->m[i];
3461    p0->m[i]=NULL;
3462    if (p!=NULL)
3463    {
3464      sleftv u0,v0;
3465      memset(&u0,0,sizeof(sleftv));
3466      memset(&v0,0,sizeof(sleftv));
3467      v0.rtyp=tp;
3468      v0.data=(void*)p;
3469      u0.rtyp=t0;
3470      u0.data=i0;
3471      u0.attribute=a;
3472      setFlag(&u0,FLAG_STD);
3473      jjSTD_1(res,&u0,&v0);
3474      i0=(ideal)res->data;
3475      res->data=NULL;
3476      a=res->attribute;
3477      res->attribute=NULL;
3478      u0.CleanUp();
3479      v0.CleanUp();
3480      res->CleanUp();
3481    }
3482  }
3483  idDelete(&p0);
3484  res->attribute=a;
3485  res->data=(void *)i0;
3486  res->rtyp=t0;
3487}
3488static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
3489{
3490  ideal result;
3491  assumeStdFlag(u);
3492  ideal i1=(ideal)(u->Data());
3493  ideal i0;
3494  int r=v->Typ();
3495  if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
3496  {
3497    i0=idInit(1,i1->rank); // TODO: rank is wrong (if v is a vector!)
3498    i0->m[0]=(poly)v->Data();
3499    int ii0=idElem(i0); /* size of i0 */
3500    i1=idSimpleAdd(i1,i0); //
3501    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3502    idDelete(&i0);
3503    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3504    tHomog hom=testHomog;
3505
3506    if (w!=NULL)
3507    {
3508      if (!idTestHomModule(i1,currRing->qideal,w))
3509      {
3510        // no warnung: this is legal, if i in std(i,p)
3511        // is homogeneous, but p not
3512        w=NULL;
3513      }
3514      else
3515      {
3516        w=ivCopy(w);
3517        hom=isHomog;
3518      }
3519    }
3520    BITSET save1;
3521    SI_SAVE_OPT1(save1);
3522    si_opt_1|=Sy_bit(OPT_SB_1);
3523    /* ii0 appears to be the position of the first element of il that
3524       does not belong to the old SB ideal */
3525    result=kStd(i1,currRing->qideal,hom,&w,NULL,0,ii0);
3526    SI_RESTORE_OPT1(save1);
3527    idDelete(&i1);
3528    idSkipZeroes(result);
3529    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3530    res->data = (char *)result;
3531  }
3532  else /*IDEAL/MODULE*/
3533  {
3534    attr *aa=u->Attribute();
3535    attr a=NULL;
3536    if (aa!=NULL) a=(*aa)->Copy();
3537    jjSTD_1_ID(res,(ideal)u->CopyD(),r,(ideal)v->CopyD(),a);
3538  }
3539  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
3540  return FALSE;
3541}
3542static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3543{
3544  idhdl h=(idhdl)u->data;
3545  int i=(int)(long)v->Data();
3546  if ((0<i) && (i<=IDRING(h)->N))
3547    res->data=omStrDup(IDRING(h)->names[i-1]);
3548  else
3549  {
3550    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3551    return TRUE;
3552  }
3553  return FALSE;
3554}
3555static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3556{
3557// input: u: a list with links of type
3558//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3559//        v: timeout for select in milliseconds
3560//           or 0 for polling
3561// returns: ERROR (via Werror): timeout negative
3562//           -1: the read state of all links is eof
3563//            0: timeout (or polling): none ready
3564//           i>0: (at least) L[i] is ready
3565  lists Lforks = (lists)u->Data();
3566  int t = (int)(long)v->Data();
3567  if(t < 0)
3568  {
3569    WerrorS("negative timeout"); return TRUE;
3570  }
3571  int i = slStatusSsiL(Lforks, t*1000);
3572  if(i == -2) /* error */
3573  {
3574    return TRUE;
3575  }
3576  res->data = (void*)(long)i;
3577  return FALSE;
3578}
3579static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3580{
3581// input: u: a list with links of type
3582//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3583//        v: timeout for select in milliseconds
3584//           or 0 for polling
3585// returns: ERROR (via Werror): timeout negative
3586//           -1: the read state of all links is eof
3587//           0: timeout (or polling): none ready
3588//           1: all links are ready
3589//              (caution: at least one is ready, but some maybe dead)
3590  lists Lforks = (lists)u->CopyD();
3591  int timeout = 1000*(int)(long)v->Data();
3592  if(timeout < 0)
3593  {
3594    WerrorS("negative timeout"); return TRUE;
3595  }
3596  int t = getRTimer()/TIMER_RESOLUTION;  // in seconds
3597  int i;
3598  int ret = -1;
3599  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
3600  {
3601    i = slStatusSsiL(Lforks, timeout);
3602    if(i > 0) /* Lforks[i] is ready */
3603    {
3604      ret = 1;
3605      Lforks->m[i-1].CleanUp();
3606      Lforks->m[i-1].rtyp=DEF_CMD;
3607      Lforks->m[i-1].data=NULL;
3608      timeout = si_max(0,timeout - 1000*(getRTimer()/TIMER_RESOLUTION - t));
3609    }
3610    else /* terminate the for loop */
3611    {
3612      if(i == -2) /* error */
3613      {
3614        return TRUE;
3615      }
3616      if(i == 0) /* timeout */
3617      {
3618        ret = 0;
3619      }
3620      break;
3621    }
3622  }
3623  Lforks->Clean();
3624  res->data = (void*)(long)ret;
3625  return FALSE;
3626}
3627static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3628{
3629  res->data = (char *)mp_Wedge((matrix)u->Data(),(int)(long)v->Data(),currRing);
3630  return FALSE;
3631}
3632#define jjWRONG2 (proc2)jjWRONG
3633#define jjWRONG3 (proc3)jjWRONG
3634static BOOLEAN jjWRONG(leftv, leftv)
3635{
3636  return TRUE;
3637}
3638
3639/*=================== operations with 1 arg.: static proc =================*/
3640/* must be ordered: first operations for chars (infix ops),
3641 * then alphabetically */
3642
3643static BOOLEAN jjDUMMY(leftv res, leftv u)
3644{
3645  res->data = (char *)u->CopyD();
3646  return FALSE;
3647}
3648static BOOLEAN jjNULL(leftv, leftv)
3649{
3650  return FALSE;
3651}
3652//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3653//{
3654//  res->data = (char *)((int)(long)u->Data()+1);
3655//  return FALSE;
3656//}
3657//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3658//{
3659//  res->data = (char *)((int)(long)u->Data()-1);
3660//  return FALSE;
3661//}
3662static BOOLEAN jjPLUSPLUS(leftv, leftv u)
3663{
3664  if (IDTYP((idhdl)u->data)==INT_CMD)
3665  {
3666    int i=IDINT((idhdl)u->data);
3667    if (iiOp==PLUSPLUS) i++;
3668    else                i--;
3669    IDDATA((idhdl)u->data)=(char *)(long)i;
3670    return FALSE;
3671  }
3672  return TRUE;
3673}
3674static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3675{
3676  number n=(number)u->CopyD(BIGINT_CMD);
3677  n=n_InpNeg(n,coeffs_BIGINT);
3678  res->data = (char *)n;
3679  return FALSE;
3680}
3681static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3682{
3683  res->data = (char *)(-(long)u->Data());
3684  return FALSE;
3685}
3686static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3687{
3688  number n=(number)u->CopyD(NUMBER_CMD);
3689  n=nInpNeg(n);
3690  res->data = (char *)n;
3691  return FALSE;
3692}
3693static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3694{
3695  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3696  return FALSE;
3697}
3698static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3699{
3700  poly m1=pISet(-1);
3701  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),m1,currRing);
3702  return FALSE;
3703}
3704static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3705{
3706  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3707  (*iv)*=(-1);
3708  res->data = (char *)iv;
3709  return FALSE;
3710}
3711static BOOLEAN jjUMINUS_BIM(leftv res, leftv u)
3712{
3713  bigintmat *bim=(bigintmat *)u->CopyD(BIGINTMAT_CMD);
3714  (*bim)*=(-1);
3715  res->data = (char *)bim;
3716  return FALSE;
3717}
3718static BOOLEAN jjPROC1(leftv res, leftv u)
3719{
3720  return jjPROC(res,u,NULL);
3721}
3722static BOOLEAN jjBAREISS(leftv res, leftv v)
3723{
3724  //matrix m=(matrix)v->Data();
3725  //lists l=mpBareiss(m,FALSE);
3726  intvec *iv;
3727  ideal m;
3728  sm_CallBareiss((ideal)v->Data(),0,0,m,&iv, currRing);
3729  lists l=(lists)omAllocBin(slists_bin);
3730  l->Init(2);
3731  l->m[0].rtyp=MODUL_CMD;
3732  l->m[1].rtyp=INTVEC_CMD;
3733  l->m[0].data=(void *)m;
3734  l->m[1].data=(void *)iv;
3735  res->data = (char *)l;
3736  return FALSE;
3737}
3738//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3739//{
3740//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3741//  ivTriangMat(m);
3742//  res->data = (char *)m;
3743//  return FALSE;
3744//}
3745static BOOLEAN jjBI2N(leftv res, leftv u)
3746{
3747  BOOLEAN bo=FALSE;
3748  number n=(number)u->CopyD();
3749  nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
3750  if (nMap!=NULL)
3751    res->data=nMap(n,coeffs_BIGINT,currRing->cf);
3752  else
3753  {
3754    Werror("cannot convert bigint to cring %s",currRing->cf->cfCoeffString(currRing->cf));
3755    bo=TRUE;
3756  }
3757  n_Delete(&n,coeffs_BIGINT);
3758  return bo;
3759}
3760static BOOLEAN jjBI2P(leftv res, leftv u)
3761{
3762  sleftv tmp;
3763  BOOLEAN bo=jjBI2N(&tmp,u);
3764  if (!bo)
3765  {
3766    number n=(number) tmp.data;
3767    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3768    else
3769    {
3770      res->data=(void *)pNSet(n);
3771    }
3772  }
3773  return bo;
3774}
3775static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3776{
3777  return iiExprArithM(res,u,iiOp);
3778}
3779static BOOLEAN jjCHAR(leftv res, leftv v)
3780{
3781  res->data = (char *)(long)rChar((ring)v->Data());
3782  return FALSE;
3783}
3784static BOOLEAN jjCOLS(leftv res, leftv v)
3785{
3786  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3787  return FALSE;
3788}
3789static BOOLEAN jjCOLS_BIM(leftv res, leftv v)
3790{
3791  res->data = (char *)(long)((bigintmat*)(v->Data()))->cols();
3792  return FALSE;
3793}
3794static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3795{
3796  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3797  return FALSE;
3798}
3799static BOOLEAN jjCONTENT(leftv res, leftv v)
3800{
3801  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3802  poly p=(poly)v->CopyD(POLY_CMD);
3803  if (p!=NULL) p_Cleardenom(p, currRing);
3804  res->data = (char *)p;
3805  return FALSE;
3806}
3807static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3808{
3809  res->data = (char *)(long)n_Size((number)v->Data(),coeffs_BIGINT);
3810  return FALSE;
3811}
3812static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3813{
3814  res->data = (char *)(long)nSize((number)v->Data());
3815  return FALSE;
3816}
3817static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3818{
3819  lists l=(lists)v->Data();
3820  res->data = (char *)(long)(lSize(l)+1);
3821  return FALSE;
3822}
3823static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3824{
3825  matrix m=(matrix)v->Data();
3826  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3827  return FALSE;
3828}
3829static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3830{
3831  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3832  return FALSE;
3833}
3834static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3835{
3836  ring r=(ring)v->Data();
3837  int elems=-1;
3838  if (rField_is_Zp(r)||rField_is_GF(r)) elems=r->cf->ch;
3839  else if (rField_is_Zp_a(r) && (r->cf->type==n_algExt))
3840  {
3841    extern int ipower ( int b, int n ); /* factory/cf_util */
3842    elems=ipower(r->cf->ch,r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3843  }
3844  res->data = (char *)(long)elems;
3845  return FALSE;
3846}
3847static BOOLEAN jjDEG(leftv res, leftv v)
3848{
3849  int dummy;
3850  poly p=(poly)v->Data();
3851  if (p!=NULL) res->data = (char *)currRing->pLDeg(p,&dummy,currRing);
3852  else res->data=(char *)-1;
3853  return FALSE;
3854}
3855static BOOLEAN jjDEG_M(leftv res, leftv u)
3856{
3857  ideal I=(ideal)u->Data();
3858  int d=-1;
3859  int dummy;
3860  int i;
3861  for(i=IDELEMS(I)-1;i>=0;i--)
3862    if (I->m[i]!=NULL) d=si_max(d,(int)currRing->pLDeg(I->m[i],&dummy,currRing));
3863  res->data = (char *)(long)d;
3864  return FALSE;
3865}
3866static BOOLEAN jjDEGREE(leftv res, leftv v)
3867{
3868  SPrintStart();
3869#ifdef HAVE_RINGS
3870  if (rField_is_Ring_Z(currRing))
3871  {
3872    ring origR = currRing;
3873    ring tempR = rCopy(origR);
3874    coeffs new_cf=nInitChar(n_Q,NULL);
3875    nKillChar(tempR->cf);
3876    tempR->cf=new_cf;
3877    rComplete(tempR);
3878    ideal vid = (ideal)v->Data();
3879    rChangeCurrRing(tempR);
3880    ideal vv = idrCopyR(vid, origR, currRing);
3881    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
3882    vvAsLeftv.rtyp = IDEAL_CMD;
3883    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
3884    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
3885    assumeStdFlag(&vvAsLeftv);
3886    Print("// NOTE: computation of degree is being performed for\n");
3887    Print("//       generic fibre, that is, over Q\n");
3888    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
3889    scDegree(vv,module_w,currRing->qideal);
3890    idDelete(&vv);
3891    rChangeCurrRing(origR);
3892    rDelete(tempR);
3893  }
3894#endif
3895  assumeStdFlag(v);
3896  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3897  scDegree((ideal)v->Data(),module_w,currRing->qideal);
3898  char *s=SPrintEnd();
3899  int l=strlen(s)-1;
3900  s[l]='\0';
3901  res->data=(void*)s;
3902  return FALSE;
3903}
3904static BOOLEAN jjDEFINED(leftv res, leftv v)
3905{
3906  if ((v->rtyp==IDHDL)
3907  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3908  {
3909    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3910  }
3911  else if (v->rtyp!=0) res->data=(void *)(-1);
3912  return FALSE;
3913}
3914
3915/// Return the denominator of the input number
3916/// NOTE: the input number is normalized as a side effect
3917static BOOLEAN jjDENOMINATOR(leftv res, leftv v)
3918{
3919  number n = reinterpret_cast<number>(v->Data());
3920  res->data = reinterpret_cast<void*>(n_GetDenom(n, currRing));
3921  return FALSE;
3922}
3923
3924/// Return the numerator of the input number
3925/// NOTE: the input number is normalized as a side effect
3926static BOOLEAN jjNUMERATOR(leftv res, leftv v)
3927{
3928  number n = reinterpret_cast<number>(v->Data());
3929  res->data = reinterpret_cast<void*>(n_GetNumerator(n, currRing));
3930  return FALSE;
3931}
3932
3933static BOOLEAN jjDET(leftv res, leftv v)
3934{
3935  matrix m=(matrix)v->Data();
3936  poly p;
3937  if (sm_CheckDet((ideal)m,m->cols(),TRUE, currRing))
3938  {
3939    ideal I=id_Matrix2Module(mp_Copy(m, currRing),currRing);
3940    p=sm_CallDet(I, currRing);
3941    idDelete(&I);
3942  }
3943  else
3944    p=singclap_det(m,currRing);
3945  res ->data = (char *)p;
3946  return FALSE;
3947}
3948static BOOLEAN jjDET_BI(leftv res, leftv v)
3949{
3950  bigintmat * m=(bigintmat*)v->Data();
3951  int i,j;
3952  i=m->rows();j=m->cols();
3953  if(i==j)
3954    res->data = (char *)(long)singclap_det_bi(m,coeffs_BIGINT);
3955  else
3956  {
3957    Werror("det of %d x %d bigintmat",i,j);
3958    return TRUE;
3959  }
3960  return FALSE;
3961}
3962static BOOLEAN jjDET_I(leftv res, leftv v)
3963{
3964  intvec * m=(intvec*)v->Data();
3965  int i,j;
3966  i=m->rows();j=m->cols();
3967  if(i==j)
3968    res->data = (char *)(long)singclap_det_i(m,currRing);
3969  else
3970  {
3971    Werror("det of %d x %d intmat",i,j);
3972    return TRUE;
3973  }
3974  return FALSE;
3975}
3976static BOOLEAN jjDET_S(leftv res, leftv v)
3977{
3978  ideal I=(ideal)v->Data();
3979  poly p;
3980  if (IDELEMS(I)<1) return TRUE;
3981  if (sm_CheckDet(I,IDELEMS(I),FALSE, currRing))
3982  {
3983    matrix m=id_Module2Matrix(id_Copy(I,currRing),currRing);
3984    p=singclap_det(m,currRing);
3985    idDelete((ideal *)&m);
3986  }
3987  else
3988    p=sm_CallDet(I, currRing);
3989  res->data = (char *)p;
3990  return FALSE;
3991}
3992static BOOLEAN jjDIM(leftv res, leftv v)
3993{
3994  assumeStdFlag(v);
3995#ifdef HAVE_RINGS
3996  if (rField_is_Ring(currRing))
3997  {
3998    //ring origR = currRing;
3999    //ring tempR = rCopy(origR);
4000    //coeffs new_cf=nInitChar(n_Q,NULL);
4001    //nKillChar(tempR->cf);
4002    //tempR->cf=new_cf;
4003    //rComplete(tempR);
4004    ideal vid = (ideal)v->Data();
4005    int i = idPosConstant(vid);
4006    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
4007    { /* ideal v contains unit; dim = -1 */
4008      res->data = (char *)-1;
4009      return FALSE;
4010    }
4011    //rChangeCurrRing(tempR);
4012    //ideal vv = idrCopyR(vid, origR, currRing);
4013    ideal vv = id_Head(vid,currRing);
4014    /* drop degree zero generator from vv (if any) */
4015    if (i != -1) pDelete(&vv->m[i]);
4016    long d = (long)scDimInt(vv, currRing->qideal);
4017    if (rField_is_Ring_Z(currRing) && (i == -1)) d++;
4018    res->data = (char *)d;
4019    idDelete(&vv);
4020    //rChangeCurrRing(origR);
4021    //rDelete(tempR);
4022    return FALSE;
4023  }
4024#endif
4025  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currRing->qideal);
4026  return FALSE;
4027}
4028static BOOLEAN jjDUMP(leftv, leftv v)
4029{
4030  si_link l = (si_link)v->Data();
4031  if (slDump(l))
4032  {
4033    const char *s;
4034    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4035    else                            s=sNoName;
4036    Werror("cannot dump to `%s`",s);
4037    return TRUE;
4038  }
4039  else
4040    return FALSE;
4041}
4042static BOOLEAN jjE(leftv res, leftv v)
4043{
4044  res->data = (char *)pOne();
4045  int co=(int)(long)v->Data();
4046  if (co>0)
4047  {
4048    pSetComp((poly)res->data,co);
4049    pSetm((poly)res->data);
4050  }
4051  else WerrorS("argument of gen must be positive");
4052  return (co<=0);
4053}
4054static BOOLEAN jjEXECUTE(leftv, leftv v)
4055{
4056  char * d = (char *)v->Data();
4057  char * s = (char *)omAlloc(strlen(d) + 13);
4058  strcpy( s, (char *)d);
4059  strcat( s, "\n;RETURN();\n");
4060  newBuffer(s,BT_execute);
4061  return yyparse();
4062}
4063static BOOLEAN jjFACSTD(leftv res, leftv v)
4064{
4065  lists L=(lists)omAllocBin(slists_bin);
4066  if (currRing->cf->convSingNFactoryN!=NULL) /* conversion to factory*/
4067  {
4068    ideal_list p,h;
4069    h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
4070    if (h==NULL)
4071    {
4072      L->Init(1);
4073      L->m[0].data=(char *)idInit(1);
4074      L->m[0].rtyp=IDEAL_CMD;
4075    }
4076    else
4077    {
4078      p=h;
4079      int l=0;
4080      while (p!=NULL) { p=p->next;l++; }
4081      L->Init(l);
4082      l=0;
4083      while(h!=NULL)
4084      {
4085        L->m[l].data=(char *)h->d;
4086        L->m[l].rtyp=IDEAL_CMD;
4087        p=h->next;
4088        omFreeSize(h,sizeof(*h));
4089        h=p;
4090        l++;
4091      }
4092    }
4093  }
4094  else
4095  {
4096    WarnS("no factorization implemented");
4097    L->Init(1);
4098    iiExprArith1(&(L->m[0]),v,STD_CMD);
4099  }
4100  res->data=(void *)L;
4101  return FALSE;
4102}
4103static BOOLEAN jjFAC_P(leftv res, leftv u)
4104{
4105  intvec *v=NULL;
4106  singclap_factorize_retry=0;
4107  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0,currRing);
4108  if (f==NULL) return TRUE;
4109  ivTest(v);
4110  lists l=(lists)omAllocBin(slists_bin);
4111  l->Init(2);
4112  l->m[0].rtyp=IDEAL_CMD;
4113  l->m[0].data=(void *)f;
4114  l->m[1].rtyp=INTVEC_CMD;
4115  l->m[1].data=(void *)v;
4116  res->data=(void *)l;
4117  return FALSE;
4118}
4119static BOOLEAN jjGETDUMP(leftv, leftv v)
4120{
4121  si_link l = (si_link)v->Data();
4122  if (slGetDump(l))
4123  {
4124    const char *s;
4125    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4126    else                            s=sNoName;
4127    Werror("cannot get dump from `%s`",s);
4128    return TRUE;
4129  }
4130  else
4131    return FALSE;
4132}
4133static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
4134{
4135  assumeStdFlag(v);
4136  ideal I=(ideal)v->Data();
4137  res->data=(void *)iiHighCorner(I,0);
4138  return FALSE;
4139}
4140static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
4141{
4142  assumeStdFlag(v);
4143  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4144  BOOLEAN delete_w=FALSE;
4145  ideal I=(ideal)v->Data();
4146  int i;
4147  poly p=NULL,po=NULL;
4148  int rk=id_RankFreeModule(I,currRing);
4149  if (w==NULL)
4150  {
4151    w = new intvec(rk);
4152    delete_w=TRUE;
4153  }
4154  for(i=rk;i>0;i--)
4155  {
4156    p=iiHighCorner(I,i);
4157    if (p==NULL)
4158    {
4159      WerrorS("module must be zero-dimensional");
4160      if (delete_w) delete w;
4161      return TRUE;
4162    }
4163    if (po==NULL)
4164    {
4165      po=p;
4166    }
4167    else
4168    {
4169      // now po!=NULL, p!=NULL
4170      int d=(currRing->pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - currRing->pFDeg(p,currRing)+(*w)[i-1]);
4171      if (d==0)
4172        d=pLmCmp(po,p);
4173      if (d > 0)
4174      {
4175        pDelete(&p);
4176      }
4177      else // (d < 0)
4178      {
4179        pDelete(&po); po=p;
4180      }
4181    }
4182  }
4183  if (delete_w) delete w;
4184  res->data=(void *)po;
4185  return FALSE;
4186}
4187static BOOLEAN jjHILBERT(leftv, leftv v)
4188{
4189#ifdef HAVE_RINGS
4190  if (rField_is_Ring_Z(currRing))
4191  {
4192    ring origR = currRing;
4193    ring tempR = rCopy(origR);
4194    coeffs new_cf=nInitChar(n_Q,NULL);
4195    nKillChar(tempR->cf);
4196    tempR->cf=new_cf;
4197    rComplete(tempR);
4198    ideal vid = (ideal)v->Data();
4199    rChangeCurrRing(tempR);
4200    ideal vv = idrCopyR(vid, origR, currRing);
4201    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
4202    vvAsLeftv.rtyp = IDEAL_CMD;
4203    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
4204    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
4205    assumeStdFlag(&vvAsLeftv);
4206    Print("// NOTE: computation of Hilbert series etc. is being\n");
4207    Print("//       performed for generic fibre, that is, over Q\n");
4208    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
4209    //scHilbertPoly(vv,currRing->qideal);
4210    hLookSeries(vv,module_w,currRing->qideal);
4211    idDelete(&vv);
4212    rChangeCurrRing(origR);
4213    rDelete(tempR);
4214    return FALSE;
4215  }
4216#endif
4217  assumeStdFlag(v);
4218  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4219  //scHilbertPoly((ideal)v->Data(),currRing->qideal);
4220  hLookSeries((ideal)v->Data(),module_w,currRing->qideal);
4221  return FALSE;
4222}
4223static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
4224{
4225#ifdef HAVE_RINGS
4226  if (rField_is_Ring_Z(currRing))
4227  {
4228    Print("// NOTE: computation of Hilbert series etc. is being\n");
4229    Print("//       performed for generic fibre, that is, over Q\n");
4230  }
4231#endif
4232  res->data=(void *)hSecondSeries((intvec *)v->Data());
4233  return FALSE;
4234}
4235static BOOLEAN jjHOMOG1(leftv res, leftv v)
4236{
4237  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4238  ideal v_id=(ideal)v->Data();
4239  if (w==NULL)
4240  {
4241    res->data=(void *)(long)idHomModule(v_id,currRing->qideal,&w);
4242    if (res->data!=NULL)
4243    {
4244      if (v->rtyp==IDHDL)
4245      {
4246        char *s_isHomog=omStrDup("isHomog");
4247        if (v->e==NULL)
4248          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
4249        else
4250          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
4251      }
4252      else if (w!=NULL) delete w;
4253    } // if res->data==NULL then w==NULL
4254  }
4255  else
4256  {
4257    res->data=(void *)(long)idTestHomModule(v_id,currRing->qideal,w);
4258    if((res->data==NULL) && (v->rtyp==IDHDL))
4259    {
4260      if (v->e==NULL)
4261        atKill((idhdl)(v->data),"isHomog");
4262      else
4263        atKill((idhdl)(v->LData()),"isHomog");
4264    }
4265  }
4266  return FALSE;
4267}
4268static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
4269{
4270  res->data = (char *)idMaxIdeal((int)(long)v->Data());
4271  setFlag(res,FLAG_STD);
4272  return FALSE;
4273}
4274static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
4275{
4276  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
4277  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
4278  if (IDELEMS((ideal)mat)==0)
4279  {
4280    idDelete((ideal *)&mat);
4281    mat=(matrix)idInit(1,1);
4282  }
4283  else
4284  {
4285    MATROWS(mat)=1;
4286    mat->rank=1;
4287    idTest((ideal)mat);
4288  }
4289  res->data=(char *)mat;
4290  return FALSE;
4291}
4292static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4293{
4294  map m=(map)v->CopyD(MAP_CMD);
4295  omFree((ADDRESS)m->preimage);
4296  m->preimage=NULL;
4297  ideal I=(ideal)m;
4298  I->rank=1;
4299  res->data=(char *)I;
4300  return FALSE;
4301}
4302static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4303{
4304  if (currRing!=NULL)
4305  {
4306    ring q=(ring)v->Data();
4307    if (rSamePolyRep(currRing, q))
4308    {
4309      if (q->qideal==NULL)
4310        res->data=(char *)idInit(1,1);
4311      else
4312        res->data=(char *)idCopy(q->qideal);
4313      return FALSE;
4314    }
4315  }
4316  WerrorS("can only get ideal from identical qring");
4317  return TRUE;
4318}
4319static BOOLEAN jjIm2Iv(leftv res, leftv v)
4320{
4321  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4322  iv->makeVector();
4323  res->data = iv;
4324  return FALSE;
4325}
4326static BOOLEAN jjIMPART(leftv res, leftv v)
4327{
4328  res->data = (char *)n_ImPart((number)v->Data(),currRing->cf);
4329  return FALSE;
4330}
4331static BOOLEAN jjINDEPSET(leftv res, leftv v)
4332{
4333  assumeStdFlag(v);
4334  res->data=(void *)scIndIntvec((ideal)(v->Data()),currRing->qideal);
4335  return FALSE;
4336}
4337static BOOLEAN jjINTERRED(leftv res, leftv v)
4338{
4339  ideal result=kInterRed((ideal)(v->Data()), currRing->qideal);
4340  #ifdef HAVE_RINGS
4341  if(rField_is_Ring(currRing))
4342    Warn("interred: this command is experimental over the integers");
4343  #endif
4344  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4345  res->data = result;
4346  return FALSE;
4347}
4348static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4349{
4350  res->data = (char *)(long)pVar((poly)v->Data());
4351  return FALSE;
4352}
4353static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4354{
4355  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing->names,
4356                                                            currRing->N)+1);
4357  return FALSE;
4358}
4359static BOOLEAN jjIS_RINGVAR0(leftv res, leftv)
4360{
4361  res->data = (char *)0;
4362  return FALSE;
4363}
4364static BOOLEAN jjJACOB_P(leftv res, leftv v)
4365{
4366  ideal i=idInit(currRing->N,1);
4367  int k;
4368  poly p=(poly)(v->Data());
4369  for (k=currRing->N;k>0;k--)
4370  {
4371    i->m[k-1]=pDiff(p,k);
4372  }
4373  res->data = (char *)i;
4374  return FALSE;
4375}
4376static BOOLEAN jjDIFF_COEF(leftv res, leftv u, leftv v)
4377{
4378  if (!nCoeff_is_transExt(currRing->cf))
4379  {
4380    WerrorS("differentiation not defined in the coefficient ring");
4381    return TRUE;
4382  }
4383  number n = (number) u->Data();
4384  number k = (number) v->Data();
4385  res->data = ntDiff(n,k,currRing->cf);
4386  return FALSE;
4387}
4388/*2
4389 * compute Jacobi matrix of a module/matrix
4390 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(currRing->N))  ),
4391 * where Mt := transpose(M)
4392 * Note that this is consistent with the current conventions for jacob in Singular,
4393 * whereas M2 computes its transposed.
4394 */
4395static BOOLEAN jjJACOB_M(leftv res, leftv a)
4396{
4397  ideal id = (ideal)a->Data();
4398  id = idTransp(id);
4399  int W = IDELEMS(id);
4400
4401  ideal result = idInit(W * currRing->N, id->rank);
4402  poly *p = result->m;
4403
4404  for( int v = 1; v <= currRing->N; v++ )
4405  {
4406    poly* q = id->m;
4407    for( int i = 0; i < W; i++, p++, q++ )
4408      *p = pDiff( *q, v );
4409  }
4410  idDelete(&id);
4411
4412  res->data = (char *)result;
4413  return FALSE;
4414}
4415
4416
4417static BOOLEAN jjKBASE(leftv res, leftv v)
4418{
4419  assumeStdFlag(v);
4420  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currRing->qideal);
4421  return FALSE;
4422}
4423static BOOLEAN jjL2R(leftv res, leftv v)
4424{
4425  res->data=(char *)syConvList((lists)v->Data(),FALSE);
4426  if (res->data != NULL)
4427    return FALSE;
4428  else
4429    return TRUE;
4430}
4431static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4432{
4433  poly p=(poly)v->Data();
4434  if (p==NULL)
4435  {
4436    res->data=(char *)nInit(0);
4437  }
4438  else
4439  {
4440    res->data=(char *)nCopy(pGetCoeff(p));
4441  }
4442  return FALSE;
4443}
4444static BOOLEAN jjLEADEXP(leftv res, leftv v)
4445{
4446  poly p=(poly)v->Data();
4447  int s=currRing->N;
4448  if (v->Typ()==VECTOR_CMD) s++;
4449  intvec *iv=new intvec(s);
4450  if (p!=NULL)
4451  {
4452    for(int i = currRing->N;i;i--)
4453    {
4454      (*iv)[i-1]=pGetExp(p,i);
4455    }
4456    if (s!=currRing->N)
4457      (*iv)[currRing->N]=pGetComp(p);
4458  }
4459  res->data=(char *)iv;
4460  return FALSE;
4461}
4462static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4463{
4464  poly p=(poly)v->Data();
4465  if (p == NULL)
4466  {
4467    res->data = (char*) NULL;
4468  }
4469  else
4470  {
4471    poly lm = pLmInit(p);
4472    pSetCoeff(lm, nInit(1));
4473    res->data = (char*) lm;
4474  }
4475  return FALSE;
4476}
4477static BOOLEAN jjLOAD1(leftv /*res*/, leftv v)
4478{
4479  return jjLOAD((char*)v->Data(),FALSE);
4480}
4481static BOOLEAN jjLISTRING(leftv res, leftv v)
4482{
4483  ring r=rCompose((lists)v->Data());
4484  if (r==NULL) return TRUE;
4485  if (r->qideal!=NULL) res->rtyp=QRING_CMD;
4486  res->data=(char *)r;
4487  return FALSE;
4488}
4489static BOOLEAN jjPFAC1(leftv res, leftv v)
4490{
4491  /* call method jjPFAC2 with second argument = 0 (meaning that no
4492     valid bound for the prime factors has been given) */
4493  sleftv tmp;
4494  memset(&tmp, 0, sizeof(tmp));
4495  tmp.rtyp = INT_CMD;
4496  return jjPFAC2(res, v, &tmp);
4497}
4498static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4499{
4500  /* computes the LU-decomposition of a matrix M;
4501     i.e., M = P * L * U, where
4502        - P is a row permutation matrix,
4503        - L is in lower triangular form,
4504        - U is in upper row echelon form
4505     Then, we also have P * M = L * U.
4506     A list [P, L, U] is returned. */
4507  matrix mat = (const matrix)v->Data();
4508  if (!idIsConstant((ideal)mat))
4509  {
4510    WerrorS("matrix must be constant");
4511    return TRUE;
4512  }
4513  matrix pMat;
4514  matrix lMat;
4515  matrix uMat;
4516
4517  luDecomp(mat, pMat, lMat, uMat);
4518
4519  lists ll = (lists)omAllocBin(slists_bin);
4520  ll->Init(3);
4521  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4522  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4523  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4524  res->data=(char*)ll;
4525
4526  return FALSE;
4527}
4528static BOOLEAN jjMEMORY(leftv res, leftv v)
4529{
4530  omUpdateInfo();
4531  switch(((int)(long)v->Data()))
4532  {
4533  case 0:
4534    res->data=(char *)n_Init(om_Info.UsedBytes,coeffs_BIGINT);
4535    break;
4536  case 1:
4537    res->data = (char *)n_Init(om_Info.CurrentBytesSystem,coeffs_BIGINT);
4538    break;
4539  case 2:
4540    res->data = (char *)n_Init(om_Info.MaxBytesSystem,coeffs_BIGINT);
4541    break;
4542  default:
4543    omPrintStats(stdout);
4544    omPrintInfo(stdout);
4545    omPrintBinStats(stdout);
4546    res->data = (char *)0;
4547    res->rtyp = NONE;
4548  }
4549  return FALSE;
4550  res->data = (char *)0;
4551  return FALSE;
4552}
4553//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4554//{
4555//  return jjMONITOR2(res,v,NULL);
4556//}
4557static BOOLEAN jjMSTD(leftv res, leftv v)
4558{
4559  int t=v->Typ();
4560  ideal r,m;
4561  r=kMin_std((ideal)v->Data(),currRing->qideal,testHomog,NULL,m);
4562  lists l=(lists)omAllocBin(slists_bin);
4563  l->Init(2);
4564  l->m[0].rtyp=t;
4565  l->m[0].data=(char *)r;
4566  setFlag(&(l->m[0]),FLAG_STD);
4567  l->m[1].rtyp=t;
4568  l->m[1].data=(char *)m;
4569  res->data=(char *)l;
4570  return FALSE;
4571}
4572static BOOLEAN jjMULT(leftv res, leftv v)
4573{
4574  assumeStdFlag(v);
4575  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currRing->qideal);
4576  return FALSE;
4577}
4578static BOOLEAN jjMINRES_R(leftv res, leftv v)
4579{
4580  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4581
4582  syStrategy tmp=(syStrategy)v->Data();
4583  tmp = syMinimize(tmp); // enrich itself!
4584
4585  res->data=(char *)tmp;
4586
4587  if (weights!=NULL)
4588    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4589
4590  return FALSE;
4591}
4592static BOOLEAN jjN2BI(leftv res, leftv v)
4593{
4594  number n,i; i=(number)v->Data();
4595  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4596  if (nMap!=NULL)
4597    n=nMap(i,currRing->cf,coeffs_BIGINT);
4598  else goto err;
4599  res->data=(void *)n;
4600  return FALSE;
4601err:
4602  WerrorS("cannot convert to bigint"); return TRUE;
4603}
4604static BOOLEAN jjNAMEOF(leftv res, leftv v)
4605{
4606  res->data = (char *)v->name;
4607  if (res->data==NULL) res->data=omStrDup("");
4608  v->name=NULL;
4609  return FALSE;
4610}
4611static BOOLEAN jjNAMES(leftv res, leftv v)
4612{
4613  res->data=ipNameList(((ring)v->Data())->idroot);
4614  return FALSE;
4615}
4616static BOOLEAN jjNAMES_I(leftv res, leftv v)
4617{
4618  res->data=ipNameListLev((IDROOT),(int)(long)v->Data());
4619  return FALSE;
4620}
4621static BOOLEAN jjNOT(leftv res, leftv v)
4622{
4623  res->data=(char*)(long)((long)v->Data()==0 ? 1 : 0);
4624  return FALSE;
4625}
4626static BOOLEAN jjNVARS(leftv res, leftv v)
4627{
4628  res->data = (char *)(long)(((ring)(v->Data()))->N);
4629  return FALSE;
4630}
4631static BOOLEAN jjOpenClose(leftv, leftv v)
4632{
4633  si_link l=(si_link)v->Data();
4634  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4635  else                return slClose(l);
4636}
4637static BOOLEAN jjORD(leftv res, leftv v)
4638{
4639  poly p=(poly)v->Data();
4640  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4641  return FALSE;
4642}
4643static BOOLEAN jjPAR1(leftv res, leftv v)
4644{
4645  int i=(int)(long)v->Data();
4646  int p=0;
4647  p=rPar(currRing);
4648  if ((0<i) && (i<=p))
4649  {
4650    res->data=(char *)n_Param(i,currRing);
4651  }
4652  else
4653  {
4654    Werror("par number %d out of range 1..%d",i,p);
4655    return TRUE;
4656  }
4657  return FALSE;
4658}
4659static BOOLEAN jjPARDEG(leftv res, leftv v)
4660{
4661  number nn=(number)v->Data();
4662  res->data = (char *)(long)n_ParDeg(nn, currRing);
4663  return FALSE;
4664}
4665static BOOLEAN jjPARSTR1(leftv res, leftv v)
4666{
4667  if (currRing==NULL)
4668  {
4669    WerrorS("no ring active");
4670    return TRUE;
4671  }
4672  int i=(int)(long)v->Data();
4673  int p=0;
4674  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4675    res->data=omStrDup(rParameter(currRing)[i-1]);
4676  else
4677  {
4678    Werror("par number %d out of range 1..%d",i,p);
4679    return TRUE;
4680  }
4681  return FALSE;
4682}
4683static BOOLEAN jjP2BI(leftv res, leftv v)
4684{
4685  poly p=(poly)v->Data();
4686  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4687  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4688  {
4689    WerrorS("poly must be constant");
4690    return TRUE;
4691  }
4692  number i=pGetCoeff(p);
4693  number n;
4694  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4695  if (nMap!=NULL)
4696    n=nMap(i,currRing->cf,coeffs_BIGINT);
4697  else goto err;
4698  res->data=(void *)n;
4699  return FALSE;
4700err:
4701  WerrorS("cannot convert to bigint"); return TRUE;
4702}
4703static BOOLEAN jjP2I(leftv res, leftv v)
4704{
4705  poly p=(poly)v->Data();
4706  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4707  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4708  {
4709    WerrorS("poly must be constant");
4710    return TRUE;
4711  }
4712  res->data = (char *)(long)n_Int(pGetCoeff(p),currRing->cf);
4713  return FALSE;
4714}
4715static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4716{
4717  map mapping=(map)v->Data();
4718  syMake(res,omStrDup(mapping->preimage));
4719  return FALSE;
4720}
4721static BOOLEAN jjPRIME(leftv res, leftv v)
4722{
4723  int i = IsPrime((int)(long)(v->Data()));
4724  res->data = (char *)(long)(i > 1 ? i : 2);
4725  return FALSE;
4726}
4727static BOOLEAN jjPRUNE(leftv res, leftv v)
4728{
4729  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4730  ideal v_id=(ideal)v->Data();
4731  if (w!=NULL)
4732  {
4733    if (!idTestHomModule(v_id,currRing->qideal,w))
4734    {
4735      WarnS("wrong weights");
4736      w=NULL;
4737      // and continue at the non-homog case below
4738    }
4739    else
4740    {
4741      w=ivCopy(w);
4742      intvec **ww=&w;
4743      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4744      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4745      return FALSE;
4746    }
4747  }
4748  res->data = (char *)idMinEmbedding(v_id);
4749  return FALSE;
4750}
4751static BOOLEAN jjP2N(leftv res, leftv v)
4752{
4753  number n;
4754  poly p;
4755  if (((p=(poly)v->Data())!=NULL)
4756  && (pIsConstant(p)))
4757  {
4758    n=nCopy(pGetCoeff(p));
4759  }
4760  else
4761  {
4762    n=nInit(0);
4763  }
4764  res->data = (char *)n;
4765  return FALSE;
4766}
4767static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4768{
4769  char *s= (char *)v->Data();
4770  int i = 1;
4771  for(i=0; i<sArithBase.nCmdUsed; i++)
4772  {
4773    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4774    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4775    {
4776      res->data = (char *)1;
4777      return FALSE;
4778    }
4779  }
4780  //res->data = (char *)0;
4781  return FALSE;
4782}
4783static BOOLEAN jjRANK1(leftv res, leftv v)
4784{
4785  matrix m =(matrix)v->Data();
4786  int rank = luRank(m, 0);
4787  res->data =(char *)(long)rank;
4788  return FALSE;
4789}
4790static BOOLEAN jjREAD(leftv res, leftv v)
4791{
4792  return jjREAD2(res,v,NULL);
4793}
4794static BOOLEAN jjREGULARITY(leftv res, leftv v)
4795{
4796  res->data = (char *)(long)iiRegularity((lists)v->Data());
4797  return FALSE;
4798}
4799static BOOLEAN jjREPART(leftv res, leftv v)
4800{
4801  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4802  return FALSE;
4803}
4804static BOOLEAN jjRINGLIST(leftv res, leftv v)
4805{
4806  ring r=(ring)v->Data();
4807  if (r!=NULL)
4808    res->data = (char *)rDecompose((ring)v->Data());
4809  return (r==NULL)||(res->data==NULL);
4810}
4811static BOOLEAN jjROWS(leftv res, leftv v)
4812{
4813  ideal i = (ideal)v->Data();
4814  res->data = (char *)i->rank;
4815  return FALSE;
4816}
4817static BOOLEAN jjROWS_BIM(leftv res, leftv v)
4818{
4819  res->data = (char *)(long)((bigintmat*)(v->Data()))->rows();
4820  return FALSE;
4821}
4822static BOOLEAN jjROWS_IV(leftv res, leftv v)
4823{
4824  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4825  return FALSE;
4826}
4827static BOOLEAN jjRPAR(leftv res, leftv v)
4828{
4829  res->data = (char *)(long)rPar(((ring)v->Data()));
4830  return FALSE;
4831}
4832static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4833{
4834#ifdef HAVE_PLURAL
4835  const bool bIsSCA = rIsSCA(currRing);
4836#else
4837  const bool bIsSCA = false;
4838#endif
4839
4840  if ((currRing->qideal!=NULL) && !bIsSCA)
4841  {
4842    WerrorS("qring not supported by slimgb at the moment");
4843    return TRUE;
4844  }
4845  if (rHasLocalOrMixedOrdering_currRing())
4846  {
4847    WerrorS("ordering must be global for slimgb");
4848    return TRUE;
4849  }
4850  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4851  // tHomog hom=testHomog;
4852  ideal u_id=(ideal)u->Data();
4853  if (w!=NULL)
4854  {
4855    if (!idTestHomModule(u_id,currRing->qideal,w))
4856    {
4857      WarnS("wrong weights");
4858      w=NULL;
4859    }
4860    else
4861    {
4862      w=ivCopy(w);
4863      // hom=isHomog;
4864    }
4865  }
4866
4867  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
4868  res->data=(char *)t_rep_gb(currRing,
4869    u_id,u_id->rank);
4870  //res->data=(char *)t_rep_gb(currRing, u_id);
4871
4872  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4873  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4874  return FALSE;
4875}
4876static BOOLEAN jjSBA(leftv res, leftv v)
4877{
4878  ideal result;
4879  ideal v_id=(ideal)v->Data();
4880  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4881  tHomog hom=testHomog;
4882  if (w!=NULL)
4883  {
4884    if (!idTestHomModule(v_id,currRing->qideal,w))
4885    {
4886      WarnS("wrong weights");
4887      w=NULL;
4888    }
4889    else
4890    {
4891      hom=isHomog;
4892      w=ivCopy(w);
4893    }
4894  }
4895  result=kSba(v_id,currRing->qideal,hom,&w,1,0);
4896  idSkipZeroes(result);
4897  res->data = (char *)result;
4898  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4899  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4900  return FALSE;
4901}
4902static BOOLEAN jjSBA_1(leftv res, leftv v, leftv u)
4903{
4904  ideal result;
4905  ideal v_id=(ideal)v->Data();
4906  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4907  tHomog hom=testHomog;
4908  if (w!=NULL)
4909  {
4910    if (!idTestHomModule(v_id,currRing->qideal,w))
4911    {
4912      WarnS("wrong weights");
4913      w=NULL;
4914    }
4915    else
4916    {
4917      hom=isHomog;
4918      w=ivCopy(w);
4919    }
4920  }
4921  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),0);
4922  idSkipZeroes(result);
4923  res->data = (char *)result;
4924  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4925  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4926  return FALSE;
4927}
4928static BOOLEAN jjSBA_2(leftv res, leftv v, leftv u, leftv t)
4929{
4930  ideal result;
4931  ideal v_id=(ideal)v->Data();
4932  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4933  tHomog hom=testHomog;
4934  if (w!=NULL)
4935  {
4936    if (!idTestHomModule(v_id,currRing->qideal,w))
4937    {
4938      WarnS("wrong weights");
4939      w=NULL;
4940    }
4941    else
4942    {
4943      hom=isHomog;
4944      w=ivCopy(w);
4945    }
4946  }
4947  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),(int)(long)t->Data());
4948  idSkipZeroes(result);
4949  res->data = (char *)result;
4950  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4951  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4952  return FALSE;
4953}
4954static BOOLEAN jjSTD(leftv res, leftv v)
4955{
4956  ideal result;
4957  ideal v_id=(ideal)v->Data();
4958  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4959  tHomog hom=testHomog;
4960  if (w!=NULL)
4961  {
4962    if (!idTestHomModule(v_id,currRing->qideal,w))
4963    {
4964      WarnS("wrong weights");
4965      w=NULL;
4966    }
4967    else
4968    {
4969      hom=isHomog;
4970      w=ivCopy(w);
4971    }
4972  }
4973  result=kStd(v_id,currRing->qideal,hom,&w);
4974  idSkipZeroes(result);
4975  res->data = (char *)result;
4976  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4977  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4978  return FALSE;
4979}
4980static BOOLEAN jjSort_Id(leftv res, leftv v)
4981{
4982  res->data = (char *)idSort((ideal)v->Data());
4983  return FALSE;
4984}
4985static BOOLEAN jjSQR_FREE(leftv res, leftv u)
4986{
4987  singclap_factorize_retry=0;
4988  intvec *v=NULL;
4989  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
4990  if (f==NULL) return TRUE;
4991  ivTest(v);
4992  lists l=(lists)omAllocBin(slists_bin);
4993  l->Init(2);
4994  l->m[0].rtyp=IDEAL_CMD;
4995  l->m[0].data=(void *)f;
4996  l->m[1].rtyp=INTVEC_CMD;
4997  l->m[1].data=(void *)v;
4998  res->data=(void *)l;
4999  return FALSE;
5000}
5001#if 1
5002static BOOLEAN jjSYZYGY(leftv res, leftv v)
5003{
5004  intvec *w=NULL;
5005  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
5006  if (w!=NULL) delete w;
5007  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
5008  return FALSE;
5009}
5010#else
5011// activate, if idSyz handle module weights correctly !
5012static BOOLEAN jjSYZYGY(leftv res, leftv v)
5013{
5014  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5015  ideal v_id=(ideal)v->Data();
5016  tHomog hom=testHomog;
5017  int add_row_shift=0;
5018  if (w!=NULL)
5019  {
5020    w=ivCopy(w);
5021    add_row_shift=w->min_in();
5022    (*w)-=add_row_shift;
5023    if (idTestHomModule(v_id,currRing->qideal,w))
5024      hom=isHomog;
5025    else
5026    {
5027      //WarnS("wrong weights");
5028      delete w; w=NULL;
5029      hom=testHomog;
5030    }
5031  }
5032  res->data = (char *)idSyzygies(v_id,hom,&w);
5033  if (w!=NULL)
5034  {
5035    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5036  }
5037  return FALSE;
5038}
5039#endif
5040static BOOLEAN jjTRACE_IV(leftv res, leftv v)
5041{
5042  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
5043  return FALSE;
5044}
5045static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
5046{
5047  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
5048  return FALSE;
5049}
5050static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
5051{
5052  res->data = (char *)ivTranp((intvec*)(v->Data()));
5053  return FALSE;
5054}
5055#ifdef HAVE_PLURAL
5056static BOOLEAN jjOPPOSITE(leftv res, leftv a)
5057{
5058  ring    r = (ring)a->Data();
5059  //if (rIsPluralRing(r))
5060  if (r->OrdSgn==1)
5061  {
5062    res->data = rOpposite(r);
5063  }
5064  else
5065  {
5066    WarnS("opposite only for global orderings");
5067    res->data = rCopy(r);
5068  }
5069  return FALSE;
5070}
5071static BOOLEAN jjENVELOPE(leftv res, leftv a)
5072{
5073  ring    r = (ring)a->Data();
5074  if (rIsPluralRing(r))
5075  {
5076    //    ideal   i;
5077//     if (a->rtyp == QRING_CMD)
5078//     {
5079//       i = r->qideal;
5080//       r->qideal = NULL;
5081//     }
5082    ring s = rEnvelope(r);
5083//     if (a->rtyp == QRING_CMD)
5084//     {
5085//       ideal is  = idOppose(r,i); /* twostd? */
5086//       is        = idAdd(is,i);
5087//       s->qideal = i;
5088//     }
5089    res->data = s;
5090  }
5091  else  res->data = rCopy(r);
5092  return FALSE;
5093}
5094static BOOLEAN jjTWOSTD(leftv res, leftv a)
5095{
5096  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
5097  else  res->data=(ideal)a->CopyD();
5098  setFlag(res,FLAG_STD);
5099  setFlag(res,FLAG_TWOSTD);
5100  return FALSE;
5101}
5102#endif
5103
5104static BOOLEAN jjTYPEOF(leftv res, leftv v)
5105{
5106  int t=(int)(long)v->data;
5107  switch (t)
5108  {
5109    case CRING_CMD:
5110    case INT_CMD:
5111    case POLY_CMD:
5112    case VECTOR_CMD:
5113    case STRING_CMD:
5114    case INTVEC_CMD:
5115    case IDEAL_CMD:
5116    case MATRIX_CMD:
5117    case MODUL_CMD:
5118    case MAP_CMD:
5119    case PROC_CMD:
5120    case RING_CMD:
5121    case QRING_CMD:
5122    case INTMAT_CMD:
5123    case BIGINTMAT_CMD:
5124    case NUMBER_CMD:
5125    case BIGINT_CMD:
5126    case LIST_CMD:
5127    case PACKAGE_CMD:
5128    case LINK_CMD:
5129    case RESOLUTION_CMD:
5130         res->data=omStrDup(Tok2Cmdname(t)); break;
5131    case DEF_CMD:
5132    case NONE:           res->data=omStrDup("none"); break;
5133    default:
5134    {
5135      if (t>MAX_TOK)
5136        res->data=omStrDup(getBlackboxName(t));
5137      else
5138        res->data=omStrDup("?unknown type?");
5139      break;
5140    }
5141  }
5142  return FALSE;
5143}
5144static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5145{
5146  res->data=(char *)(long)pIsUnivariate((poly)v->Data());
5147  return FALSE;
5148}
5149static BOOLEAN jjVAR1(leftv res, leftv v)
5150{
5151  int i=(int)(long)v->Data();
5152  if ((0<i) && (i<=currRing->N))
5153  {
5154    poly p=pOne();
5155    pSetExp(p,i,1);
5156    pSetm(p);
5157    res->data=(char *)p;
5158  }
5159  else
5160  {
5161    Werror("var number %d out of range 1..%d",i,currRing->N);
5162    return TRUE;
5163  }
5164  return FALSE;
5165}
5166static BOOLEAN jjVARSTR1(leftv res, leftv v)
5167{
5168  if (currRing==NULL)
5169  {
5170    WerrorS("no ring active");
5171    return TRUE;
5172  }
5173  int i=(int)(long)v->Data();
5174  if ((0<i) && (i<=currRing->N))
5175    res->data=omStrDup(currRing->names[i-1]);
5176  else
5177  {
5178    Werror("var number %d out of range 1..%d",i,currRing->N);
5179    return TRUE;
5180  }
5181  return FALSE;
5182}
5183static BOOLEAN jjVDIM(leftv res, leftv v)
5184{
5185  assumeStdFlag(v);
5186  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currRing->qideal);
5187  return FALSE;
5188}
5189BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5190{
5191// input: u: a list with links of type
5192//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5193// returns: -1:  the read state of all links is eof
5194//          i>0: (at least) u[i] is ready
5195  lists Lforks = (lists)u->Data();
5196  int i = slStatusSsiL(Lforks, -1);
5197  if(i == -2) /* error */
5198  {
5199    return TRUE;
5200  }
5201  res->data = (void*)(long)i;
5202  return FALSE;
5203}
5204BOOLEAN jjWAITALL1(leftv res, leftv u)
5205{
5206// input: u: a list with links of type
5207//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5208// returns: -1: the read state of all links is eof
5209//           1: all links are ready
5210//              (caution: at least one is ready, but some maybe dead)
5211  lists Lforks = (lists)u->CopyD();
5212  int i;
5213  int j = -1;
5214  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5215  {
5216    i = slStatusSsiL(Lforks, -1);
5217    if(i == -2) /* error */
5218    {
5219      return TRUE;
5220    }
5221    if(i == -1)
5222    {
5223      break;
5224    }
5225    j = 1;
5226    Lforks->m[i-1].CleanUp();
5227    Lforks->m[i-1].rtyp=DEF_CMD;
5228    Lforks->m[i-1].data=NULL;
5229  }
5230  res->data = (void*)(long)j;
5231  Lforks->Clean();
5232  return FALSE;
5233}
5234
5235BOOLEAN jjLOAD(const char *s, BOOLEAN autoexport)
5236{
5237  char libnamebuf[256];
5238  lib_types LT = type_of_LIB(s, libnamebuf);
5239
5240#ifdef HAVE_DYNAMIC_LOADING
5241  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5242#endif /* HAVE_DYNAMIC_LOADING */
5243  switch(LT)
5244  {
5245      default:
5246      case LT_NONE:
5247        Werror("%s: unknown type", s);
5248        break;
5249      case LT_NOTFOUND:
5250        Werror("cannot open %s", s);
5251        break;
5252
5253      case LT_SINGULAR:
5254      {
5255        char *plib = iiConvName(s);
5256        idhdl pl = IDROOT->get(plib,0);
5257        if (pl==NULL)
5258        {
5259          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5260          IDPACKAGE(pl)->language = LANG_SINGULAR;
5261          IDPACKAGE(pl)->libname=omStrDup(plib);
5262        }
5263        else if (IDTYP(pl)!=PACKAGE_CMD)
5264        {
5265          Werror("can not create package `%s`",plib);
5266          omFree(plib);
5267          return TRUE;
5268        }
5269        package savepack=currPack;
5270        currPack=IDPACKAGE(pl);
5271        IDPACKAGE(pl)->loaded=TRUE;
5272        char libnamebuf[256];
5273        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5274        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5275        currPack=savepack;
5276        IDPACKAGE(pl)->loaded=(!bo);
5277        return bo;
5278      }
5279      case LT_BUILTIN:
5280        SModulFunc_t iiGetBuiltinModInit(const char*);
5281        return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5282      case LT_MACH_O:
5283      case LT_ELF:
5284      case LT_HPUX:
5285#ifdef HAVE_DYNAMIC_LOADING
5286        return load_modules(s, libnamebuf, autoexport);
5287#else /* HAVE_DYNAMIC_LOADING */
5288        WerrorS("Dynamic modules are not supported by this version of Singular");
5289        break;
5290#endif /* HAVE_DYNAMIC_LOADING */
5291  }
5292  return TRUE;
5293}
5294
5295static BOOLEAN jjstrlen(leftv res, leftv v)
5296{
5297  res->data = (char *)strlen((char *)v->Data());
5298  return FALSE;
5299}
5300static BOOLEAN jjpLength(leftv res, leftv v)
5301{
5302  res->data = (char *)(long)pLength((poly)v->Data());
5303  return FALSE;
5304}
5305static BOOLEAN jjidElem(leftv res, leftv v)
5306{
5307  res->data = (char *)(long)idElem((ideal)v->Data());
5308  return FALSE;
5309}
5310static BOOLEAN jjidFreeModule(leftv res, leftv v)
5311{
5312  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5313  return FALSE;
5314}
5315static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5316{
5317  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5318  return FALSE;
5319}
5320static BOOLEAN jjrCharStr(leftv res, leftv v)
5321{
5322#ifdef SINGULAR_4_1
5323  iiReWrite("charstr");
5324#endif
5325  res->data = rCharStr((ring)v->Data());
5326  return FALSE;
5327}
5328static BOOLEAN jjpHead(leftv res, leftv v)
5329{
5330  res->data = (char *)pHead((poly)v->Data());
5331  return FALSE;
5332}
5333static BOOLEAN jjidHead(leftv res, leftv v)
5334{
5335  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5336  setFlag(res,FLAG_STD);
5337  return FALSE;
5338}
5339static BOOLEAN jjidMinBase(leftv res, leftv v)
5340{
5341  res->data = (char *)idMinBase((ideal)v->Data());
5342  return FALSE;
5343}
5344static BOOLEAN jjsyMinBase(leftv res, leftv v)
5345{
5346  res->data = (char *)syMinBase((ideal)v->Data());
5347  return FALSE;
5348}
5349static BOOLEAN jjpMaxComp(leftv res, leftv v)
5350{
5351  res->data = (char *)pMaxComp((poly)v->Data());
5352  return FALSE;
5353}
5354static BOOLEAN jjmpTrace(leftv res, leftv v)
5355{
5356  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5357  return FALSE;
5358}
5359static BOOLEAN jjmpTransp(leftv res, leftv v)
5360{
5361  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5362  return FALSE;
5363}
5364static BOOLEAN jjrOrdStr(leftv res, leftv v)
5365{
5366#ifdef SINGULAR_4_1
5367  iiReWrite("ordstr");
5368#endif
5369  res->data = rOrdStr((ring)v->Data());
5370  return FALSE;
5371}
5372static BOOLEAN jjrVarStr(leftv res, leftv v)
5373{
5374#ifdef SINGULAR_4_1
5375  iiReWrite("varstr");
5376#endif
5377  res->data = rVarStr((ring)v->Data());
5378  return FALSE;
5379}
5380static BOOLEAN jjrParStr(leftv res, leftv v)
5381{
5382#ifdef SINGULAR_4_1
5383  iiReWrite("varstr");
5384#endif
5385  res->data = rParStr((ring)v->Data());
5386  return FALSE;
5387}
5388static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5389{
5390  res->data=(char *)(long)sySize((syStrategy)v->Data());
5391  return FALSE;
5392}
5393static BOOLEAN jjDIM_R(leftv res, leftv v)
5394{
5395  res->data = (char *)(long)syDim((syStrategy)v->Data());
5396  return FALSE;
5397}
5398static BOOLEAN jjidTransp(leftv res, leftv v)
5399{
5400  res->data = (char *)idTransp((ideal)v->Data());
5401  return FALSE;
5402}
5403static BOOLEAN jjnInt(leftv res, leftv u)
5404{
5405  number n=(number)u->CopyD(); // n_Int may call n_Normalize
5406  res->data=(char *)(long)n_Int(n,currRing->cf);
5407  n_Delete(&n,currRing->cf);
5408  return FALSE;
5409}
5410static BOOLEAN jjnlInt(leftv res, leftv u)
5411{
5412  number n=(number)u->Data();
5413  res->data=(char *)(long)n_Int(n,coeffs_BIGINT );
5414  return FALSE;
5415}
5416/*=================== operations with 3 args.: static proc =================*/
5417/* must be ordered: first operations for chars (infix ops),
5418 * then alphabetically */
5419static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5420{
5421  char *s= (char *)u->Data();
5422  int   r = (int)(long)v->Data();
5423  int   c = (int)(long)w->Data();
5424  int l = strlen(s);
5425
5426  if ( (r<1) || (r>l) || (c<0) )
5427  {
5428    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5429    return TRUE;
5430  }
5431  res->data = (char *)omAlloc((long)(c+1));
5432  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5433  return FALSE;
5434}
5435static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5436{
5437  intvec *iv = (intvec *)u->Data();
5438  int   r = (int)(long)v->Data();
5439  int   c = (int)(long)w->Data();
5440  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5441  {
5442    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5443           r,c,u->Fullname(),iv->rows(),iv->cols());
5444    return TRUE;
5445  }
5446  res->data=u->data; u->data=NULL;
5447  res->rtyp=u->rtyp; u->rtyp=0;
5448  res->name=u->name; u->name=NULL;
5449  Subexpr e=jjMakeSub(v);
5450          e->next=jjMakeSub(w);
5451  if (u->e==NULL) res->e=e;
5452  else
5453  {
5454    Subexpr h=u->e;
5455    while (h->next!=NULL) h=h->next;
5456    h->next=e;
5457    res->e=u->e;
5458    u->e=NULL;
5459  }
5460  return FALSE;
5461}
5462static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5463{
5464  bigintmat *bim = (bigintmat *)u->Data();
5465  int   r = (int)(long)v->Data();
5466  int   c = (int)(long)w->Data();
5467  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5468  {
5469    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5470           r,c,u->Fullname(),bim->rows(),bim->cols());
5471    return TRUE;
5472  }
5473  res->data=u->data; u->data=NULL;
5474  res->rtyp=u->rtyp; u->rtyp=0;
5475  res->name=u->name; u->name=NULL;
5476  Subexpr e=jjMakeSub(v);
5477          e->next=jjMakeSub(w);
5478  if (u->e==NULL)
5479    res->e=e;
5480  else
5481  {
5482    Subexpr h=u->e;
5483    while (h->next!=NULL) h=h->next;
5484    h->next=e;
5485    res->e=u->e;
5486    u->e=NULL;
5487  }
5488  return FALSE;
5489}
5490static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5491{
5492  matrix m= (matrix)u->Data();
5493  int   r = (int)(long)v->Data();
5494  int   c = (int)(long)w->Data();
5495  //Print("gen. elem %d, %d\n",r,c);
5496  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5497  {
5498    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5499      MATROWS(m),MATCOLS(m));
5500    return TRUE;
5501  }
5502  res->data=u->data; u->data=NULL;
5503  res->rtyp=u->rtyp; u->rtyp=0;
5504  res->name=u->name; u->name=NULL;
5505  Subexpr e=jjMakeSub(v);
5506          e->next=jjMakeSub(w);
5507  if (u->e==NULL)
5508    res->e=e;
5509  else
5510  {
5511    Subexpr h=u->e;
5512    while (h->next!=NULL) h=h->next;
5513    h->next=e;
5514    res->e=u->e;
5515    u->e=NULL;
5516  }
5517  return FALSE;
5518}
5519static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5520{
5521  sleftv t;
5522  sleftv ut;
5523  leftv p=NULL;
5524  intvec *iv=(intvec *)w->Data();
5525  int l;
5526  BOOLEAN nok;
5527
5528  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5529  {
5530    WerrorS("cannot build expression lists from unnamed objects");
5531    return TRUE;
5532  }
5533  memcpy(&ut,u,sizeof(ut));
5534  memset(&t,0,sizeof(t));
5535  t.rtyp=INT_CMD;
5536  for (l=0;l< iv->length(); l++)
5537  {
5538    t.data=(char *)(long)((*iv)[l]);
5539    if (p==NULL)
5540    {
5541      p=res;
5542    }
5543    else
5544    {
5545      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5546      p=p->next;
5547    }
5548    memcpy(u,&ut,sizeof(ut));
5549    if (u->Typ() == MATRIX_CMD)
5550      nok=jjBRACK_Ma(p,u,v,&t);
5551    else if (u->Typ() == BIGINTMAT_CMD)
5552      nok=jjBRACK_Bim(p,u,v,&t);
5553    else /* INTMAT_CMD */
5554      nok=jjBRACK_Im(p,u,v,&t);
5555    if (nok)
5556    {
5557      while (res->next!=NULL)
5558      {
5559        p=res->next->next;
5560        omFreeBin((ADDRESS)res->next, sleftv_bin);
5561        // res->e aufraeumen !!!!
5562        res->next=p;
5563      }
5564      return TRUE;
5565    }
5566  }
5567  return FALSE;
5568}
5569static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5570{
5571  sleftv t;
5572  sleftv ut;
5573  leftv p=NULL;
5574  intvec *iv=(intvec *)v->Data();
5575  int l;
5576  BOOLEAN nok;
5577
5578  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5579  {
5580    WerrorS("cannot build expression lists from unnamed objects");
5581    return TRUE;
5582  }
5583  memcpy(&ut,u,sizeof(ut));
5584  memset(&t,0,sizeof(t));
5585  t.rtyp=INT_CMD;
5586  for (l=0;l< iv->length(); l++)
5587  {
5588    t.data=(char *)(long)((*iv)[l]);
5589    if (p==NULL)
5590    {
5591      p=res;
5592    }
5593    else
5594    {
5595      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5596      p=p->next;
5597    }
5598    memcpy(u,&ut,sizeof(ut));
5599    if (u->Typ() == MATRIX_CMD)
5600      nok=jjBRACK_Ma(p,u,&t,w);
5601    else if (u->Typ() == BIGINTMAT_CMD)
5602      nok=jjBRACK_Bim(p,u,&t,w);
5603    else /* INTMAT_CMD */
5604      nok=jjBRACK_Im(p,u,&t,w);
5605    if (nok)
5606    {
5607      while (res->next!=NULL)
5608      {
5609        p=res->next->next;
5610        omFreeBin((ADDRESS)res->next, sleftv_bin);
5611        // res->e aufraeumen !!
5612        res->next=p;
5613      }
5614      return TRUE;
5615    }
5616  }
5617  return FALSE;
5618}
5619static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5620{
5621  sleftv t1,t2,ut;
5622  leftv p=NULL;
5623  intvec *vv=(intvec *)v->Data();
5624  intvec *wv=(intvec *)w->Data();
5625  int vl;
5626  int wl;
5627  BOOLEAN nok;
5628
5629  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5630  {
5631    WerrorS("cannot build expression lists from unnamed objects");
5632    return TRUE;
5633  }
5634  memcpy(&ut,u,sizeof(ut));
5635  memset(&t1,0,sizeof(sleftv));
5636  memset(&t2,0,sizeof(sleftv));
5637  t1.rtyp=INT_CMD;
5638  t2.rtyp=INT_CMD;
5639  for (vl=0;vl< vv->length(); vl++)
5640  {
5641    t1.data=(char *)(long)((*vv)[vl]);
5642    for (wl=0;wl< wv->length(); wl++)
5643    {
5644      t2.data=(char *)(long)((*wv)[wl]);
5645      if (p==NULL)
5646      {
5647        p=res;
5648      }
5649      else
5650      {
5651        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5652        p=p->next;
5653      }
5654      memcpy(u,&ut,sizeof(ut));
5655      if (u->Typ() == MATRIX_CMD)
5656        nok=jjBRACK_Ma(p,u,&t1,&t2);
5657      else if (u->Typ() == BIGINTMAT_CMD)
5658        nok=jjBRACK_Bim(p,u,&t1,&t2);
5659      else /* INTMAT_CMD */
5660        nok=jjBRACK_Im(p,u,&t1,&t2);
5661      if (nok)
5662      {
5663        res->CleanUp();
5664        return TRUE;
5665      }
5666    }
5667  }
5668  return FALSE;
5669}
5670static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5671{
5672  v->next=(leftv)omAllocBin(sleftv_bin);
5673  memcpy(v->next,w,sizeof(sleftv));
5674  memset(w,0,sizeof(sleftv));
5675  return jjPROC(res,u,v);
5676}
5677static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5678{
5679  intvec *iv;
5680  ideal m;
5681  lists l=(lists)omAllocBin(slists_bin);
5682  int k=(int)(long)w->Data();
5683  if (k>=0)
5684  {
5685    sm_CallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv, currRing);
5686    l->Init(2);
5687    l->m[0].rtyp=MODUL_CMD;
5688    l->m[1].rtyp=INTVEC_CMD;
5689    l->m[0].data=(void *)m;
5690    l->m[1].data=(void *)iv;
5691  }
5692  else
5693  {
5694    m=sm_CallSolv((ideal)u->Data(), currRing);
5695    l->Init(1);
5696    l->m[0].rtyp=IDEAL_CMD;
5697    l->m[0].data=(void *)m;
5698  }
5699  res->data = (char *)l;
5700  return FALSE;
5701}
5702static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5703{
5704  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5705  {
5706    WerrorS("3rd argument must be a name of a matrix");
5707    return TRUE;
5708  }
5709  ideal i=(ideal)u->Data();
5710  int rank=(int)i->rank;
5711  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5712  if (r) return TRUE;
5713  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5714  return FALSE;
5715}
5716static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5717{
5718  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5719           (ideal)(v->Data()),(poly)(w->Data()));
5720  return FALSE;
5721}
5722static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5723{
5724  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5725  {
5726    WerrorS("3rd argument must be a name of a matrix");
5727    return TRUE;
5728  }
5729  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5730  poly p=(poly)u->CopyD(POLY_CMD);
5731  ideal i=idInit(1,1);
5732  i->m[0]=p;
5733  sleftv t;
5734  memset(&t,0,sizeof(t));
5735  t.data=(char *)i;
5736  t.rtyp=IDEAL_CMD;
5737  int rank=1;
5738  if (u->Typ()==VECTOR_CMD)
5739  {
5740    i->rank=rank=pMaxComp(p);
5741    t.rtyp=MODUL_CMD;
5742  }
5743  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5744  t.CleanUp();
5745  if (r) return TRUE;
5746  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5747  return FALSE;
5748}
5749static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5750{
5751  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5752    (intvec *)w->Data());
5753  //setFlag(res,FLAG_STD);
5754  return FALSE;
5755}
5756static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5757{
5758  /*4
5759  * look for the substring what in the string where
5760  * starting at position n
5761  * return the position of the first char of what in where
5762  * or 0
5763  */
5764  int n=(int)(long)w->Data();
5765  char *where=(char *)u->Data();
5766  char *what=(char *)v->Data();
5767  char *found;
5768  if ((1>n)||(n>(int)strlen(where)))
5769  {
5770    Werror("start position %d out of range",n);
5771    return TRUE;
5772  }
5773  found = strchr(where+n-1,*what);
5774  if (*(what+1)!='\0')
5775  {
5776    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
5777    {
5778      found=strchr(found+1,*what);
5779    }
5780  }
5781  if (found != NULL)
5782  {
5783    res->data=(char *)((found-where)+1);
5784  }
5785  return FALSE;
5786}
5787static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
5788{
5789  if ((int)(long)w-&