source: git/Singular/iparith.cc @ 98adcd

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