source: git/Singular/iparith.cc @ c78bded

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