source: git/Singular/iparith.cc @ 1d579f6

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