source: git/Singular/iparith.cc @ b9502a

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