source: git/Singular/iparith.cc @ c987db

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