source: git/Singular/iparith.cc @ ecf019

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