source: git/Singular/iparith.cc @ c92097b

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