source: git/Singular/iparith.cc @ 65b813

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