source: git/Singular/iparith.cc @ 380c4c

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