source: git/Singular/iparith.cc @ 737a68

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