source: git/Singular/iparith.cc @ 4c4340

spielwiese
Last change on this file since 4c4340 was d5add65, checked in by Hans Schoenemann <hannes@…>, 12 years ago
add: names(int level) added Conflicts: Singular/iparith.cc Singular/ipid.cc Singular/ipid.h
  • Property mode set to 100644
File size: 216.7 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; number n2; number temp; int i;
3155
3156  if ((u->Typ() == BIGINT_CMD) ||
3157     ((u->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3158  {
3159    temp = (number)u->Data();
3160    n1 = n_Copy(temp,coeffs_BIGINT);
3161  }
3162  else if (u->Typ() == INT_CMD)
3163  {
3164    i = (int)(long)u->Data();
3165    n1 = n_Init(i, coeffs_BIGINT);
3166  }
3167  else
3168  {
3169    WerrorS("wrong type: expected int, bigint, or number as 1st argument");
3170    return TRUE;
3171  }
3172
3173  if ((v->Typ() == BIGINT_CMD) ||
3174     ((v->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3175  {
3176    temp = (number)v->Data();
3177    n2 = n_Copy(temp,coeffs_BIGINT);
3178  }
3179  else if (v->Typ() == INT_CMD)
3180  {
3181    i = (int)(long)v->Data();
3182    n2 = n_Init(i, coeffs_BIGINT);
3183  }
3184  else
3185  {
3186    WerrorS("wrong type: expected int, bigint, or number as 2nd argument");
3187    return TRUE;
3188  }
3189
3190  lists l = primeFactorisation(n1, n2);
3191  n_Delete(&n1, coeffs_BIGINT); n_Delete(&n2, coeffs_BIGINT);
3192  res->data = (char*)l;
3193  return FALSE;
3194}
3195static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
3196{
3197  ring r;
3198  int i=rSum((ring)u->Data(),(ring)v->Data(),r);
3199  res->data = (char *)r;
3200  return (i==-1);
3201}
3202#define SIMPL_LMDIV 32
3203#define SIMPL_LMEQ  16
3204#define SIMPL_MULT 8
3205#define SIMPL_EQU  4
3206#define SIMPL_NULL 2
3207#define SIMPL_NORM 1
3208static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
3209{
3210  int sw = (int)(long)v->Data();
3211  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
3212  ideal id = (ideal)u->CopyD(IDEAL_CMD);
3213  if (sw & SIMPL_LMDIV)
3214  {
3215    id_DelDiv(id,currRing);
3216  }
3217  if (sw & SIMPL_LMEQ)
3218  {
3219    id_DelLmEquals(id,currRing);
3220  }
3221  if (sw & SIMPL_MULT)
3222  {
3223    id_DelMultiples(id,currRing);
3224  }
3225  else if(sw & SIMPL_EQU)
3226  {
3227    id_DelEquals(id,currRing);
3228  }
3229  if (sw & SIMPL_NULL)
3230  {
3231    idSkipZeroes(id);
3232  }
3233  if (sw & SIMPL_NORM)
3234  {
3235    id_Norm(id,currRing);
3236  }
3237  res->data = (char * )id;
3238  return FALSE;
3239}
3240#ifdef HAVE_FACTORY
3241extern int singclap_factorize_retry;
3242static BOOLEAN jjSQR_FREE2(leftv res, leftv u, leftv dummy)
3243{
3244  intvec *v=NULL;
3245  int sw=(int)(long)dummy->Data();
3246  int fac_sw=sw;
3247  if (sw<0) fac_sw=1;
3248  singclap_factorize_retry=0;
3249  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, fac_sw, currRing);
3250  if (f==NULL)
3251    return TRUE;
3252  switch(sw)
3253  {
3254    case 0:
3255    case 2:
3256    {
3257      lists l=(lists)omAllocBin(slists_bin);
3258      l->Init(2);
3259      l->m[0].rtyp=IDEAL_CMD;
3260      l->m[0].data=(void *)f;
3261      l->m[1].rtyp=INTVEC_CMD;
3262      l->m[1].data=(void *)v;
3263      res->data=(void *)l;
3264      res->rtyp=LIST_CMD;
3265      return FALSE;
3266    }
3267    case 1:
3268      res->data=(void *)f;
3269      return FALSE;
3270    case 3:
3271      {
3272        poly p=f->m[0];
3273        int i=IDELEMS(f);
3274        f->m[0]=NULL;
3275        while(i>1)
3276        {
3277          i--;
3278          p=pMult(p,f->m[i]);
3279          f->m[i]=NULL;
3280        }
3281        res->data=(void *)p;
3282        res->rtyp=POLY_CMD;
3283      }
3284      return FALSE;
3285  }
3286  WerrorS("invalid switch");
3287  return FALSE;
3288}
3289#endif
3290static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
3291{
3292  res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
3293  return FALSE;
3294}
3295static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
3296{
3297  res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
3298  //return (res->data== (void*)(long)-2);
3299  return FALSE;
3300}
3301static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
3302{
3303  int sw = (int)(long)v->Data();
3304  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3305  poly p = (poly)u->CopyD(POLY_CMD);
3306  if (sw & SIMPL_NORM)
3307  {
3308    pNorm(p);
3309  }
3310  res->data = (char * )p;
3311  return FALSE;
3312}
3313static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
3314{
3315  ideal result;
3316  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3317  tHomog hom=testHomog;
3318  ideal u_id=(ideal)(u->Data());
3319  if (w!=NULL)
3320  {
3321    if (!idTestHomModule(u_id,currQuotient,w))
3322    {
3323      WarnS("wrong weights:");w->show();PrintLn();
3324      w=NULL;
3325    }
3326    else
3327    {
3328      w=ivCopy(w);
3329      hom=isHomog;
3330    }
3331  }
3332  result=kStd(u_id,currQuotient,hom,&w,(intvec *)v->Data());
3333  idSkipZeroes(result);
3334  res->data = (char *)result;
3335  setFlag(res,FLAG_STD);
3336  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3337  return FALSE;
3338}
3339static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v);
3340static void jjSTD_1_ID(leftv res, ideal i0, int t0, ideal p0, attr a)
3341/* destroys i0, p0 */
3342/* result (with attributes) in res */
3343/* i0: SB*/
3344/* t0: type of p0*/
3345/* p0 new elements*/
3346/* a attributes of i0*/
3347{
3348  int tp;
3349  if (t0==IDEAL_CMD) tp=POLY_CMD;
3350  else               tp=VECTOR_CMD;
3351  for (int i=IDELEMS(p0)-1; i>=0; i--)
3352  {
3353    poly p=p0->m[i];
3354    p0->m[i]=NULL;
3355    if (p!=NULL)
3356    {
3357      sleftv u0,v0;
3358      memset(&u0,0,sizeof(sleftv));
3359      memset(&v0,0,sizeof(sleftv));
3360      v0.rtyp=tp;
3361      v0.data=(void*)p;
3362      u0.rtyp=t0;
3363      u0.data=i0;
3364      u0.attribute=a;
3365      setFlag(&u0,FLAG_STD);
3366      jjSTD_1(res,&u0,&v0);
3367      i0=(ideal)res->data;
3368      res->data=NULL;
3369      a=res->attribute;
3370      res->attribute=NULL;
3371      u0.CleanUp();
3372      v0.CleanUp();
3373      res->CleanUp();
3374    }
3375  }
3376  idDelete(&p0);
3377  res->attribute=a;
3378  res->data=(void *)i0;
3379  res->rtyp=t0;
3380}
3381static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
3382{
3383  ideal result;
3384  assumeStdFlag(u);
3385  ideal i1=(ideal)(u->Data());
3386  ideal i0;
3387  int r=v->Typ();
3388  if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
3389  {
3390    i0=idInit(1,i1->rank); // TODO: rank is wrong (if v is a vector!)
3391    i0->m[0]=(poly)v->Data();
3392    int ii0=idElem(i0); /* size of i0 */
3393    i1=idSimpleAdd(i1,i0); //
3394    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3395    idDelete(&i0);
3396    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3397    tHomog hom=testHomog;
3398
3399    if (w!=NULL)
3400    {
3401      if (!idTestHomModule(i1,currQuotient,w))
3402      {
3403        // no warnung: this is legal, if i in std(i,p)
3404        // is homogeneous, but p not
3405        w=NULL;
3406      }
3407      else
3408      {
3409        w=ivCopy(w);
3410        hom=isHomog;
3411      }
3412    }
3413    BITSET save1;
3414    SI_SAVE_OPT1(save1);
3415    si_opt_1|=Sy_bit(OPT_SB_1);
3416    /* ii0 appears to be the position of the first element of il that
3417       does not belong to the old SB ideal */
3418    result=kStd(i1,currQuotient,hom,&w,NULL,0,ii0);
3419    SI_RESTORE_OPT1(save1);
3420    idDelete(&i1);
3421    idSkipZeroes(result);
3422    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3423    res->data = (char *)result;
3424  }
3425  else /*IDEAL/MODULE*/
3426  {
3427    attr *aa=u->Attribute();
3428    attr a=NULL;
3429    if (aa!=NULL) a=(*aa)->Copy();
3430    jjSTD_1_ID(res,(ideal)u->CopyD(),r,(ideal)v->CopyD(),a);
3431  }
3432  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
3433  return FALSE;
3434}
3435static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3436{
3437  idhdl h=(idhdl)u->data;
3438  int i=(int)(long)v->Data();
3439  if ((0<i) && (i<=IDRING(h)->N))
3440    res->data=omStrDup(IDRING(h)->names[i-1]);
3441  else
3442  {
3443    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3444    return TRUE;
3445  }
3446  return FALSE;
3447}
3448static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3449{
3450// input: u: a list with links of type
3451//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3452//        v: timeout for select in milliseconds
3453//           or 0 for polling
3454// returns: ERROR (via Werror): timeout negative
3455//           -1: the read state of all links is eof
3456//            0: timeout (or polling): none ready
3457//           i>0: (at least) L[i] is ready
3458  lists Lforks = (lists)u->Data();
3459  int t = (int)(long)v->Data();
3460  if(t < 0)
3461  {
3462    WerrorS("negative timeout"); return TRUE;
3463  }
3464  int i = slStatusSsiL(Lforks, t*1000);
3465  if(i == -2) /* error */
3466  {
3467    return TRUE;
3468  }
3469  res->data = (void*)(long)i;
3470  return FALSE;
3471}
3472static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3473{
3474// input: u: a list with links of type
3475//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3476//        v: timeout for select in milliseconds
3477//           or 0 for polling
3478// returns: ERROR (via Werror): timeout negative
3479//           -1: the read state of all links is eof
3480//           0: timeout (or polling): none ready
3481//           1: all links are ready
3482//              (caution: at least one is ready, but some maybe dead)
3483  lists Lforks = (lists)u->CopyD();
3484  int timeout = 1000*(int)(long)v->Data();
3485  if(timeout < 0)
3486  {
3487    WerrorS("negative timeout"); return TRUE;
3488  }
3489  int t = getRTimer()/TIMER_RESOLUTION;  // in seconds
3490  int i;
3491  int ret = -1;
3492  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
3493  {
3494    i = slStatusSsiL(Lforks, timeout);
3495    if(i > 0) /* Lforks[i] is ready */
3496    {
3497      ret = 1;
3498      Lforks->m[i-1].CleanUp();
3499      Lforks->m[i-1].rtyp=DEF_CMD;
3500      Lforks->m[i-1].data=NULL;
3501      timeout = si_max(0,timeout - 1000*(getRTimer()/TIMER_RESOLUTION - t));
3502    }
3503    else /* terminate the for loop */
3504    {
3505      if(i == -2) /* error */
3506      {
3507        return TRUE;
3508      }
3509      if(i == 0) /* timeout */
3510      {
3511        ret = 0;
3512      }
3513      break;
3514    }
3515  }
3516  Lforks->Clean();
3517  res->data = (void*)(long)ret;
3518  return FALSE;
3519}
3520static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3521{
3522  res->data = (char *)mp_Wedge((matrix)u->Data(),(int)(long)v->Data(),currRing);
3523  return FALSE;
3524}
3525#define jjWRONG2 (proc2)jjWRONG
3526#define jjWRONG3 (proc3)jjWRONG
3527static BOOLEAN jjWRONG(leftv, leftv)
3528{
3529  return TRUE;
3530}
3531
3532/*=================== operations with 1 arg.: static proc =================*/
3533/* must be ordered: first operations for chars (infix ops),
3534 * then alphabetically */
3535
3536static BOOLEAN jjDUMMY(leftv res, leftv u)
3537{
3538  res->data = (char *)u->CopyD();
3539  return FALSE;
3540}
3541static BOOLEAN jjNULL(leftv, leftv)
3542{
3543  return FALSE;
3544}
3545//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3546//{
3547//  res->data = (char *)((int)(long)u->Data()+1);
3548//  return FALSE;
3549//}
3550//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3551//{
3552//  res->data = (char *)((int)(long)u->Data()-1);
3553//  return FALSE;
3554//}
3555static BOOLEAN jjPLUSPLUS(leftv, leftv u)
3556{
3557  if (IDTYP((idhdl)u->data)==INT_CMD)
3558  {
3559    int i=IDINT((idhdl)u->data);
3560    if (iiOp==PLUSPLUS) i++;
3561    else                i--;
3562    IDDATA((idhdl)u->data)=(char *)(long)i;
3563    return FALSE;
3564  }
3565  return TRUE;
3566}
3567static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3568{
3569  number n=(number)u->CopyD(BIGINT_CMD);
3570  n=n_Neg(n,coeffs_BIGINT);
3571  res->data = (char *)n;
3572  return FALSE;
3573}
3574static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3575{
3576  res->data = (char *)(-(long)u->Data());
3577  return FALSE;
3578}
3579static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3580{
3581  number n=(number)u->CopyD(NUMBER_CMD);
3582  n=nNeg(n);
3583  res->data = (char *)n;
3584  return FALSE;
3585}
3586static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3587{
3588  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3589  return FALSE;
3590}
3591static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3592{
3593  poly m1=pISet(-1);
3594  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),m1,currRing);
3595  return FALSE;
3596}
3597static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3598{
3599  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3600  (*iv)*=(-1);
3601  res->data = (char *)iv;
3602  return FALSE;
3603}
3604static BOOLEAN jjUMINUS_BIM(leftv res, leftv u)
3605{
3606  bigintmat *bim=(bigintmat *)u->CopyD(BIGINTMAT_CMD);
3607  (*bim)*=(-1);
3608  res->data = (char *)bim;
3609  return FALSE;
3610}
3611static BOOLEAN jjPROC1(leftv res, leftv u)
3612{
3613  return jjPROC(res,u,NULL);
3614}
3615static BOOLEAN jjBAREISS(leftv res, leftv v)
3616{
3617  //matrix m=(matrix)v->Data();
3618  //lists l=mpBareiss(m,FALSE);
3619  intvec *iv;
3620  ideal m;
3621  sm_CallBareiss((ideal)v->Data(),0,0,m,&iv, currRing);
3622  lists l=(lists)omAllocBin(slists_bin);
3623  l->Init(2);
3624  l->m[0].rtyp=MODUL_CMD;
3625  l->m[1].rtyp=INTVEC_CMD;
3626  l->m[0].data=(void *)m;
3627  l->m[1].data=(void *)iv;
3628  res->data = (char *)l;
3629  return FALSE;
3630}
3631//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3632//{
3633//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3634//  ivTriangMat(m);
3635//  res->data = (char *)m;
3636//  return FALSE;
3637//}
3638static BOOLEAN jjBI2N(leftv res, leftv u)
3639{
3640  BOOLEAN bo=FALSE;
3641  number n=(number)u->CopyD();
3642  nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
3643  if (nMap!=NULL)
3644    res->data=nMap(n,coeffs_BIGINT,currRing->cf);
3645  else
3646  {
3647    WerrorS("cannot convert bigint to this field");
3648    bo=TRUE;
3649  }
3650  n_Delete(&n,coeffs_BIGINT);
3651  return bo;
3652}
3653static BOOLEAN jjBI2P(leftv res, leftv u)
3654{
3655  sleftv tmp;
3656  BOOLEAN bo=jjBI2N(&tmp,u);
3657  if (!bo)
3658  {
3659    number n=(number) tmp.data;
3660    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3661    else
3662    {
3663      res->data=(void *)pNSet(n);
3664    }
3665  }
3666  return bo;
3667}
3668static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3669{
3670  return iiExprArithM(res,u,iiOp);
3671}
3672static BOOLEAN jjCHAR(leftv res, leftv v)
3673{
3674  res->data = (char *)(long)rChar((ring)v->Data());
3675  return FALSE;
3676}
3677static BOOLEAN jjCOLS(leftv res, leftv v)
3678{
3679  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3680  return FALSE;
3681}
3682static BOOLEAN jjCOLS_BIM(leftv res, leftv v)
3683{
3684  res->data = (char *)(long)((bigintmat*)(v->Data()))->cols();
3685  return FALSE;
3686}
3687static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3688{
3689  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3690  return FALSE;
3691}
3692static BOOLEAN jjCONTENT(leftv res, leftv v)
3693{
3694  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3695  poly p=(poly)v->CopyD(POLY_CMD);
3696  if (p!=NULL) p_Cleardenom(p, currRing);
3697  res->data = (char *)p;
3698  return FALSE;
3699}
3700static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3701{
3702  res->data = (char *)(long)n_Size((number)v->Data(),coeffs_BIGINT);
3703  return FALSE;
3704}
3705static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3706{
3707  res->data = (char *)(long)nSize((number)v->Data());
3708  return FALSE;
3709}
3710static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3711{
3712  lists l=(lists)v->Data();
3713  res->data = (char *)(long)(lSize(l)+1);
3714  return FALSE;
3715}
3716static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3717{
3718  matrix m=(matrix)v->Data();
3719  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3720  return FALSE;
3721}
3722static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3723{
3724  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3725  return FALSE;
3726}
3727static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3728{
3729  ring r=(ring)v->Data();
3730  int elems=-1;
3731  if (rField_is_Zp(r)||rField_is_GF(r)) elems=r->cf->ch;
3732  else if (rField_is_Zp_a(r) && (r->cf->type==n_algExt))
3733  {
3734#ifdef HAVE_FACTORY
3735    extern int ipower ( int b, int n ); /* factory/cf_util */
3736    elems=ipower(r->cf->ch,r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3737#else
3738    elems=(int)pow((double) r->cf->ch,(double)r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3739#endif
3740  }
3741  res->data = (char *)(long)elems;
3742  return FALSE;
3743}
3744static BOOLEAN jjDEG(leftv res, leftv v)
3745{
3746  int dummy;
3747  poly p=(poly)v->Data();
3748  if (p!=NULL) res->data = (char *)currRing->pLDeg(p,&dummy,currRing);
3749  else res->data=(char *)-1;
3750  return FALSE;
3751}
3752static BOOLEAN jjDEG_M(leftv res, leftv u)
3753{
3754  ideal I=(ideal)u->Data();
3755  int d=-1;
3756  int dummy;
3757  int i;
3758  for(i=IDELEMS(I)-1;i>=0;i--)
3759    if (I->m[i]!=NULL) d=si_max(d,(int)currRing->pLDeg(I->m[i],&dummy,currRing));
3760  res->data = (char *)(long)d;
3761  return FALSE;
3762}
3763static BOOLEAN jjDEGREE(leftv res, leftv v)
3764{
3765  SPrintStart();
3766#ifdef HAVE_RINGS
3767  if (rField_is_Ring_Z(currRing))
3768  {
3769    ring origR = currRing;
3770    ring tempR = rCopy(origR);
3771    coeffs new_cf=nInitChar(n_Q,NULL);
3772    nKillChar(tempR->cf);
3773    tempR->cf=new_cf;
3774    rComplete(tempR);
3775    ideal vid = (ideal)v->Data();
3776    rChangeCurrRing(tempR);
3777    ideal vv = idrCopyR(vid, origR, currRing);
3778    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
3779    vvAsLeftv.rtyp = IDEAL_CMD;
3780    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
3781    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
3782    assumeStdFlag(&vvAsLeftv);
3783    Print("// NOTE: computation of degree is being performed for\n");
3784    Print("//       generic fibre, that is, over Q\n");
3785    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
3786    scDegree(vv,module_w,currQuotient);
3787    idDelete(&vv);
3788    rChangeCurrRing(origR);
3789    rDelete(tempR);
3790  }
3791#endif
3792  assumeStdFlag(v);
3793  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3794  scDegree((ideal)v->Data(),module_w,currQuotient);
3795  char *s=SPrintEnd();
3796  int l=strlen(s)-1;
3797  s[l]='\0';
3798  res->data=(void*)s;
3799  return FALSE;
3800}
3801static BOOLEAN jjDEFINED(leftv res, leftv v)
3802{
3803  if ((v->rtyp==IDHDL)
3804  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3805  {
3806    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3807  }
3808  else if (v->rtyp!=0) res->data=(void *)(-1);
3809  return FALSE;
3810}
3811
3812/// Return the denominator of the input number
3813/// NOTE: the input number is normalized as a side effect
3814static BOOLEAN jjDENOMINATOR(leftv res, leftv v)
3815{
3816  number n = reinterpret_cast<number>(v->Data());
3817  res->data = reinterpret_cast<void*>(n_GetDenom(n, currRing));
3818  return FALSE;
3819}
3820
3821/// Return the numerator of the input number
3822/// NOTE: the input number is normalized as a side effect
3823static BOOLEAN jjNUMERATOR(leftv res, leftv v)
3824{
3825  number n = reinterpret_cast<number>(v->Data());
3826  res->data = reinterpret_cast<void*>(n_GetNumerator(n, currRing));
3827  return FALSE;
3828}
3829
3830
3831
3832
3833#ifdef HAVE_FACTORY
3834static BOOLEAN jjDET(leftv res, leftv v)
3835{
3836  matrix m=(matrix)v->Data();
3837  poly p;
3838  if (sm_CheckDet((ideal)m,m->cols(),TRUE, currRing))
3839  {
3840    ideal I=id_Matrix2Module(mp_Copy(m, currRing),currRing);
3841    p=sm_CallDet(I, currRing);
3842    idDelete(&I);
3843  }
3844  else
3845    p=singclap_det(m,currRing);
3846  res ->data = (char *)p;
3847  return FALSE;
3848}
3849static BOOLEAN jjDET_BI(leftv res, leftv v)
3850{
3851  bigintmat * m=(bigintmat*)v->Data();
3852  int i,j;
3853  i=m->rows();j=m->cols();
3854  if(i==j)
3855    res->data = (char *)(long)singclap_det_bi(m,coeffs_BIGINT);
3856  else
3857  {
3858    Werror("det of %d x %d bigintmat",i,j);
3859    return TRUE;
3860  }
3861  return FALSE;
3862}
3863static BOOLEAN jjDET_I(leftv res, leftv v)
3864{
3865  intvec * m=(intvec*)v->Data();
3866  int i,j;
3867  i=m->rows();j=m->cols();
3868  if(i==j)
3869    res->data = (char *)(long)singclap_det_i(m,currRing);
3870  else
3871  {
3872    Werror("det of %d x %d intmat",i,j);
3873    return TRUE;
3874  }
3875  return FALSE;
3876}
3877static BOOLEAN jjDET_S(leftv res, leftv v)
3878{
3879  ideal I=(ideal)v->Data();
3880  poly p;
3881  if (IDELEMS(I)<1) return TRUE;
3882  if (sm_CheckDet(I,IDELEMS(I),FALSE, currRing))
3883  {
3884    matrix m=id_Module2Matrix(id_Copy(I,currRing),currRing);
3885    p=singclap_det(m,currRing);
3886    idDelete((ideal *)&m);
3887  }
3888  else
3889    p=sm_CallDet(I, currRing);
3890  res->data = (char *)p;
3891  return FALSE;
3892}
3893#endif
3894static BOOLEAN jjDIM(leftv res, leftv v)
3895{
3896  assumeStdFlag(v);
3897#ifdef HAVE_RINGS
3898  if (rField_is_Ring(currRing))
3899  {
3900    //ring origR = currRing;
3901    //ring tempR = rCopy(origR);
3902    //coeffs new_cf=nInitChar(n_Q,NULL);
3903    //nKillChar(tempR->cf);
3904    //tempR->cf=new_cf;
3905    //rComplete(tempR);
3906    ideal vid = (ideal)v->Data();
3907    int i = idPosConstant(vid);
3908    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
3909    { /* ideal v contains unit; dim = -1 */
3910      res->data = (char *)-1;
3911      return FALSE;
3912    }
3913    //rChangeCurrRing(tempR);
3914    //ideal vv = idrCopyR(vid, origR, currRing);
3915    ideal vv = id_Head(vid,currRing);
3916    /* drop degree zero generator from vv (if any) */
3917    if (i != -1) pDelete(&vv->m[i]);
3918    long d = (long)scDimInt(vv, currQuotient);
3919    if (rField_is_Ring_Z(currRing) && (i == -1)) d++;
3920    res->data = (char *)d;
3921    idDelete(&vv);
3922    //rChangeCurrRing(origR);
3923    //rDelete(tempR);
3924    return FALSE;
3925  }
3926#endif
3927  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currQuotient);
3928  return FALSE;
3929}
3930static BOOLEAN jjDUMP(leftv, leftv v)
3931{
3932  si_link l = (si_link)v->Data();
3933  if (slDump(l))
3934  {
3935    const char *s;
3936    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3937    else                            s=sNoName;
3938    Werror("cannot dump to `%s`",s);
3939    return TRUE;
3940  }
3941  else
3942    return FALSE;
3943}
3944static BOOLEAN jjE(leftv res, leftv v)
3945{
3946  res->data = (char *)pOne();
3947  int co=(int)(long)v->Data();
3948  if (co>0)
3949  {
3950    pSetComp((poly)res->data,co);
3951    pSetm((poly)res->data);
3952  }
3953  else WerrorS("argument of gen must be positive");
3954  return (co<=0);
3955}
3956static BOOLEAN jjEXECUTE(leftv, leftv v)
3957{
3958  char * d = (char *)v->Data();
3959  char * s = (char *)omAlloc(strlen(d) + 13);
3960  strcpy( s, (char *)d);
3961  strcat( s, "\n;RETURN();\n");
3962  newBuffer(s,BT_execute);
3963  return yyparse();
3964}
3965#ifdef HAVE_FACTORY
3966static BOOLEAN jjFACSTD(leftv res, leftv v)
3967{
3968  lists L=(lists)omAllocBin(slists_bin);
3969  if (rField_is_Zp(currRing)
3970  || rField_is_Q(currRing)
3971  || rField_is_Zp_a(currRing)
3972  || rField_is_Q_a(currRing))
3973  {
3974    ideal_list p,h;
3975    h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
3976    if (h==NULL)
3977    {
3978      L->Init(1);
3979      L->m[0].data=(char *)idInit(1);
3980      L->m[0].rtyp=IDEAL_CMD;
3981    }
3982    else
3983    {
3984      p=h;
3985      int l=0;
3986      while (p!=NULL) { p=p->next;l++; }
3987      L->Init(l);
3988      l=0;
3989      while(h!=NULL)
3990      {
3991        L->m[l].data=(char *)h->d;
3992        L->m[l].rtyp=IDEAL_CMD;
3993        p=h->next;
3994        omFreeSize(h,sizeof(*h));
3995        h=p;
3996        l++;
3997      }
3998    }
3999  }
4000  else
4001  {
4002    WarnS("no factorization implemented");
4003    L->Init(1);
4004    iiExprArith1(&(L->m[0]),v,STD_CMD);
4005  }
4006  res->data=(void *)L;
4007  return FALSE;
4008}
4009static BOOLEAN jjFAC_P(leftv res, leftv u)
4010{
4011  intvec *v=NULL;
4012  singclap_factorize_retry=0;
4013  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0,currRing);
4014  if (f==NULL) return TRUE;
4015  ivTest(v);
4016  lists l=(lists)omAllocBin(slists_bin);
4017  l->Init(2);
4018  l->m[0].rtyp=IDEAL_CMD;
4019  l->m[0].data=(void *)f;
4020  l->m[1].rtyp=INTVEC_CMD;
4021  l->m[1].data=(void *)v;
4022  res->data=(void *)l;
4023  return FALSE;
4024}
4025#endif
4026static BOOLEAN jjGETDUMP(leftv, leftv v)
4027{
4028  si_link l = (si_link)v->Data();
4029  if (slGetDump(l))
4030  {
4031    const char *s;
4032    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4033    else                            s=sNoName;
4034    Werror("cannot get dump from `%s`",s);
4035    return TRUE;
4036  }
4037  else
4038    return FALSE;
4039}
4040static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
4041{
4042  assumeStdFlag(v);
4043  ideal I=(ideal)v->Data();
4044  res->data=(void *)iiHighCorner(I,0);
4045  return FALSE;
4046}
4047static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
4048{
4049  assumeStdFlag(v);
4050  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4051  BOOLEAN delete_w=FALSE;
4052  ideal I=(ideal)v->Data();
4053  int i;
4054  poly p=NULL,po=NULL;
4055  int rk=id_RankFreeModule(I,currRing);
4056  if (w==NULL)
4057  {
4058    w = new intvec(rk);
4059    delete_w=TRUE;
4060  }
4061  for(i=rk;i>0;i--)
4062  {
4063    p=iiHighCorner(I,i);
4064    if (p==NULL)
4065    {
4066      WerrorS("module must be zero-dimensional");
4067      if (delete_w) delete w;
4068      return TRUE;
4069    }
4070    if (po==NULL)
4071    {
4072      po=p;
4073    }
4074    else
4075    {
4076      // now po!=NULL, p!=NULL
4077      int d=(currRing->pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - currRing->pFDeg(p,currRing)+(*w)[i-1]);
4078      if (d==0)
4079        d=pLmCmp(po,p);
4080      if (d > 0)
4081      {
4082        pDelete(&p);
4083      }
4084      else // (d < 0)
4085      {
4086        pDelete(&po); po=p;
4087      }
4088    }
4089  }
4090  if (delete_w) delete w;
4091  res->data=(void *)po;
4092  return FALSE;
4093}
4094static BOOLEAN jjHILBERT(leftv, leftv v)
4095{
4096#ifdef HAVE_RINGS
4097  if (rField_is_Ring_Z(currRing))
4098  {
4099    ring origR = currRing;
4100    ring tempR = rCopy(origR);
4101    coeffs new_cf=nInitChar(n_Q,NULL);
4102    nKillChar(tempR->cf);
4103    tempR->cf=new_cf;
4104    rComplete(tempR);
4105    ideal vid = (ideal)v->Data();
4106    rChangeCurrRing(tempR);
4107    ideal vv = idrCopyR(vid, origR, currRing);
4108    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
4109    vvAsLeftv.rtyp = IDEAL_CMD;
4110    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
4111    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
4112    assumeStdFlag(&vvAsLeftv);
4113    Print("// NOTE: computation of Hilbert series etc. is being\n");
4114    Print("//       performed for generic fibre, that is, over Q\n");
4115    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
4116    //scHilbertPoly(vv,currQuotient);
4117    hLookSeries(vv,module_w,currQuotient);
4118    idDelete(&vv);
4119    rChangeCurrRing(origR);
4120    rDelete(tempR);
4121    return FALSE;
4122  }
4123#endif
4124  assumeStdFlag(v);
4125  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4126  //scHilbertPoly((ideal)v->Data(),currQuotient);
4127  hLookSeries((ideal)v->Data(),module_w,currQuotient);
4128  return FALSE;
4129}
4130static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
4131{
4132#ifdef HAVE_RINGS
4133  if (rField_is_Ring_Z(currRing))
4134  {
4135    Print("// NOTE: computation of Hilbert series etc. is being\n");
4136    Print("//       performed for generic fibre, that is, over Q\n");
4137  }
4138#endif
4139  res->data=(void *)hSecondSeries((intvec *)v->Data());
4140  return FALSE;
4141}
4142static BOOLEAN jjHOMOG1(leftv res, leftv v)
4143{
4144  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4145  ideal v_id=(ideal)v->Data();
4146  if (w==NULL)
4147  {
4148    res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
4149    if (res->data!=NULL)
4150    {
4151      if (v->rtyp==IDHDL)
4152      {
4153        char *s_isHomog=omStrDup("isHomog");
4154        if (v->e==NULL)
4155          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
4156        else
4157          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
4158      }
4159      else if (w!=NULL) delete w;
4160    } // if res->data==NULL then w==NULL
4161  }
4162  else
4163  {
4164    res->data=(void *)(long)idTestHomModule(v_id,currQuotient,w);
4165    if((res->data==NULL) && (v->rtyp==IDHDL))
4166    {
4167      if (v->e==NULL)
4168        atKill((idhdl)(v->data),"isHomog");
4169      else
4170        atKill((idhdl)(v->LData()),"isHomog");
4171    }
4172  }
4173  return FALSE;
4174}
4175static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
4176{
4177  res->data = (char *)idMaxIdeal((int)(long)v->Data());
4178  setFlag(res,FLAG_STD);
4179  return FALSE;
4180}
4181static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
4182{
4183  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
4184  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
4185  if (IDELEMS((ideal)mat)==0)
4186  {
4187    idDelete((ideal *)&mat);
4188    mat=(matrix)idInit(1,1);
4189  }
4190  else
4191  {
4192    MATROWS(mat)=1;
4193    mat->rank=1;
4194    idTest((ideal)mat);
4195  }
4196  res->data=(char *)mat;
4197  return FALSE;
4198}
4199static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4200{
4201  map m=(map)v->CopyD(MAP_CMD);
4202  omFree((ADDRESS)m->preimage);
4203  m->preimage=NULL;
4204  ideal I=(ideal)m;
4205  I->rank=1;
4206  res->data=(char *)I;
4207  return FALSE;
4208}
4209static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4210{
4211  if (currRing!=NULL)
4212  {
4213    ring q=(ring)v->Data();
4214    if (rSamePolyRep(currRing, q))
4215    {
4216      if (q->qideal==NULL)
4217        res->data=(char *)idInit(1,1);
4218      else
4219        res->data=(char *)idCopy(q->qideal);
4220      return FALSE;
4221    }
4222  }
4223  WerrorS("can only get ideal from identical qring");
4224  return TRUE;
4225}
4226static BOOLEAN jjIm2Iv(leftv res, leftv v)
4227{
4228  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4229  iv->makeVector();
4230  res->data = iv;
4231  return FALSE;
4232}
4233static BOOLEAN jjIMPART(leftv res, leftv v)
4234{
4235  res->data = (char *)n_ImPart((number)v->Data(),currRing->cf);
4236  return FALSE;
4237}
4238static BOOLEAN jjINDEPSET(leftv res, leftv v)
4239{
4240  assumeStdFlag(v);
4241  res->data=(void *)scIndIntvec((ideal)(v->Data()),currQuotient);
4242  return FALSE;
4243}
4244static BOOLEAN jjINTERRED(leftv res, leftv v)
4245{
4246  ideal result=kInterRed((ideal)(v->Data()), currQuotient);
4247  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4248  res->data = result;
4249  return FALSE;
4250}
4251static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4252{
4253  res->data = (char *)(long)pVar((poly)v->Data());
4254  return FALSE;
4255}
4256static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4257{
4258  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing)+1);
4259  return FALSE;
4260}
4261static BOOLEAN jjIS_RINGVAR0(leftv res, leftv)
4262{
4263  res->data = (char *)0;
4264  return FALSE;
4265}
4266static BOOLEAN jjJACOB_P(leftv res, leftv v)
4267{
4268  ideal i=idInit(currRing->N,1);
4269  int k;
4270  poly p=(poly)(v->Data());
4271  for (k=currRing->N;k>0;k--)
4272  {
4273    i->m[k-1]=pDiff(p,k);
4274  }
4275  res->data = (char *)i;
4276  return FALSE;
4277}
4278/*2
4279 * compute Jacobi matrix of a module/matrix
4280 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(currRing->N))  ),
4281 * where Mt := transpose(M)
4282 * Note that this is consistent with the current conventions for jacob in Singular,
4283 * whereas M2 computes its transposed.
4284 */
4285static BOOLEAN jjJACOB_M(leftv res, leftv a)
4286{
4287  ideal id = (ideal)a->Data();
4288  id = idTransp(id);
4289  int W = IDELEMS(id);
4290
4291  ideal result = idInit(W * currRing->N, id->rank);
4292  poly *p = result->m;
4293
4294  for( int v = 1; v <= currRing->N; v++ )
4295  {
4296    poly* q = id->m;
4297    for( int i = 0; i < W; i++, p++, q++ )
4298      *p = pDiff( *q, v );
4299  }
4300  idDelete(&id);
4301
4302  res->data = (char *)result;
4303  return FALSE;
4304}
4305
4306
4307static BOOLEAN jjKBASE(leftv res, leftv v)
4308{
4309  assumeStdFlag(v);
4310  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currQuotient);
4311  return FALSE;
4312}
4313#ifdef MDEBUG
4314static BOOLEAN jjpHead(leftv res, leftv v)
4315{
4316  res->data=(char *)pHead((poly)v->Data());
4317  return FALSE;
4318}
4319#endif
4320static BOOLEAN jjL2R(leftv res, leftv v)
4321{
4322  res->data=(char *)syConvList((lists)v->Data(),FALSE);
4323  if (res->data != NULL)
4324    return FALSE;
4325  else
4326    return TRUE;
4327}
4328static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4329{
4330  poly p=(poly)v->Data();
4331  if (p==NULL)
4332  {
4333    res->data=(char *)nInit(0);
4334  }
4335  else
4336  {
4337    res->data=(char *)nCopy(pGetCoeff(p));
4338  }
4339  return FALSE;
4340}
4341static BOOLEAN jjLEADEXP(leftv res, leftv v)
4342{
4343  poly p=(poly)v->Data();
4344  int s=currRing->N;
4345  if (v->Typ()==VECTOR_CMD) s++;
4346  intvec *iv=new intvec(s);
4347  if (p!=NULL)
4348  {
4349    for(int i = currRing->N;i;i--)
4350    {
4351      (*iv)[i-1]=pGetExp(p,i);
4352    }
4353    if (s!=currRing->N)
4354      (*iv)[currRing->N]=pGetComp(p);
4355  }
4356  res->data=(char *)iv;
4357  return FALSE;
4358}
4359static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4360{
4361  poly p=(poly)v->Data();
4362  if (p == NULL)
4363  {
4364    res->data = (char*) NULL;
4365  }
4366  else
4367  {
4368    poly lm = pLmInit(p);
4369    pSetCoeff(lm, nInit(1));
4370    res->data = (char*) lm;
4371  }
4372  return FALSE;
4373}
4374static BOOLEAN jjLOAD1(leftv res, leftv v)
4375{
4376  return jjLOAD((char*)v->Data(),FALSE);
4377}
4378static BOOLEAN jjLISTRING(leftv res, leftv v)
4379{
4380  ring r=rCompose((lists)v->Data());
4381  if (r==NULL) return TRUE;
4382  if (r->qideal!=NULL) res->rtyp=QRING_CMD;
4383  res->data=(char *)r;
4384  return FALSE;
4385}
4386#if SIZEOF_LONG == 8
4387static number jjLONG2N(long d)
4388{
4389  int i=(int)d;
4390  if ((long)i == d)
4391  {
4392    return n_Init(i, coeffs_BIGINT);
4393  }
4394  else
4395  {
4396     struct snumber_dummy
4397     {
4398      mpz_t z;
4399      mpz_t n;
4400      #if defined(LDEBUG)
4401      int debug;
4402      #endif
4403      BOOLEAN s;
4404    };
4405    typedef struct snumber_dummy  *number_dummy;
4406
4407    number_dummy z=(number_dummy)omAlloc(sizeof(snumber_dummy));
4408    #if defined(LDEBUG)
4409    z->debug=123456;
4410    #endif
4411    z->s=3;
4412    mpz_init_set_si(z->z,d);
4413    return (number)z;
4414  }
4415}
4416#else
4417#define jjLONG2N(D) n_Init((int)D, coeffs_BIGINT)
4418#endif
4419static BOOLEAN jjPFAC1(leftv res, leftv v)
4420{
4421  /* call method jjPFAC2 with second argument = 0 (meaning that no
4422     valid bound for the prime factors has been given) */
4423  sleftv tmp;
4424  memset(&tmp, 0, sizeof(tmp));
4425  tmp.rtyp = INT_CMD;
4426  return jjPFAC2(res, v, &tmp);
4427}
4428static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4429{
4430  /* computes the LU-decomposition of a matrix M;
4431     i.e., M = P * L * U, where
4432        - P is a row permutation matrix,
4433        - L is in lower triangular form,
4434        - U is in upper row echelon form
4435     Then, we also have P * M = L * U.
4436     A list [P, L, U] is returned. */
4437  matrix mat = (const matrix)v->Data();
4438  if (!idIsConstant((ideal)mat))
4439  {
4440    WerrorS("matrix must be constant");
4441    return TRUE;
4442  }
4443  matrix pMat;
4444  matrix lMat;
4445  matrix uMat;
4446
4447  luDecomp(mat, pMat, lMat, uMat);
4448
4449  lists ll = (lists)omAllocBin(slists_bin);
4450  ll->Init(3);
4451  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4452  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4453  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4454  res->data=(char*)ll;
4455
4456  return FALSE;
4457}
4458static BOOLEAN jjMEMORY(leftv res, leftv v)
4459{
4460  omUpdateInfo();
4461  switch(((int)(long)v->Data()))
4462  {
4463  case 0:
4464    res->data=(char *)jjLONG2N(om_Info.UsedBytes);
4465    break;
4466  case 1:
4467    res->data = (char *)jjLONG2N(om_Info.CurrentBytesSystem);
4468    break;
4469  case 2:
4470    res->data = (char *)jjLONG2N(om_Info.MaxBytesSystem);
4471    break;
4472  default:
4473    omPrintStats(stdout);
4474    omPrintInfo(stdout);
4475    omPrintBinStats(stdout);
4476    res->data = (char *)0;
4477    res->rtyp = NONE;
4478  }
4479  return FALSE;
4480  res->data = (char *)0;
4481  return FALSE;
4482}
4483//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4484//{
4485//  return jjMONITOR2(res,v,NULL);
4486//}
4487static BOOLEAN jjMSTD(leftv res, leftv v)
4488{
4489  int t=v->Typ();
4490  ideal r,m;
4491  r=kMin_std((ideal)v->Data(),currQuotient,testHomog,NULL,m);
4492  lists l=(lists)omAllocBin(slists_bin);
4493  l->Init(2);
4494  l->m[0].rtyp=t;
4495  l->m[0].data=(char *)r;
4496  setFlag(&(l->m[0]),FLAG_STD);
4497  l->m[1].rtyp=t;
4498  l->m[1].data=(char *)m;
4499  res->data=(char *)l;
4500  return FALSE;
4501}
4502static BOOLEAN jjMULT(leftv res, leftv v)
4503{
4504  assumeStdFlag(v);
4505  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currQuotient);
4506  return FALSE;
4507}
4508static BOOLEAN jjMINRES_R(leftv res, leftv v)
4509{
4510  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4511
4512  syStrategy tmp=(syStrategy)v->Data();
4513  tmp = syMinimize(tmp); // enrich itself!
4514
4515  res->data=(char *)tmp;
4516
4517  if (weights!=NULL)
4518    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4519
4520  return FALSE;
4521}
4522static BOOLEAN jjN2BI(leftv res, leftv v)
4523{
4524  number n,i; i=(number)v->Data();
4525  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4526  if (nMap!=NULL)
4527    n=nMap(i,currRing->cf,coeffs_BIGINT);
4528  else goto err;
4529  res->data=(void *)n;
4530  return FALSE;
4531err:
4532  WerrorS("cannot convert to bigint"); return TRUE;
4533}
4534static BOOLEAN jjNAMEOF(leftv res, leftv v)
4535{
4536  res->data = (char *)v->name;
4537  if (res->data==NULL) res->data=omStrDup("");
4538  v->name=NULL;
4539  return FALSE;
4540}
4541static BOOLEAN jjNAMES(leftv res, leftv v)
4542{
4543  res->data=ipNameList(((ring)v->Data())->idroot);
4544  return FALSE;
4545}
4546static BOOLEAN jjNAMES_I(leftv res, leftv v)
4547{
4548  res->data=ipNameListLev((IDROOT),(int)(long)v->Data());
4549  return FALSE;
4550}
4551static BOOLEAN jjNVARS(leftv res, leftv v)
4552{
4553  res->data = (char *)(long)(((ring)(v->Data()))->N);
4554  return FALSE;
4555}
4556static BOOLEAN jjOpenClose(leftv, leftv v)
4557{
4558  si_link l=(si_link)v->Data();
4559  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4560  else                return slClose(l);
4561}
4562static BOOLEAN jjORD(leftv res, leftv v)
4563{
4564  poly p=(poly)v->Data();
4565  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4566  return FALSE;
4567}
4568static BOOLEAN jjPAR1(leftv res, leftv v)
4569{
4570  int i=(int)(long)v->Data();
4571  int p=0;
4572  p=rPar(currRing);
4573  if ((0<i) && (i<=p))
4574  {
4575    res->data=(char *)n_Param(i,currRing);
4576  }
4577  else
4578  {
4579    Werror("par number %d out of range 1..%d",i,p);
4580    return TRUE;
4581  }
4582  return FALSE;
4583}
4584static BOOLEAN jjPARDEG(leftv res, leftv v)
4585{
4586  number nn=(number)v->Data();
4587  res->data = (char *)(long)n_ParDeg(nn, currRing);
4588  return FALSE;
4589}
4590static BOOLEAN jjPARSTR1(leftv res, leftv v)
4591{
4592  if (currRing==NULL)
4593  {
4594    WerrorS("no ring active");
4595    return TRUE;
4596  }
4597  int i=(int)(long)v->Data();
4598  int p=0;
4599  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4600    res->data=omStrDup(rParameter(currRing)[i-1]);
4601  else
4602  {
4603    Werror("par number %d out of range 1..%d",i,p);
4604    return TRUE;
4605  }
4606  return FALSE;
4607}
4608static BOOLEAN jjP2BI(leftv res, leftv v)
4609{
4610  poly p=(poly)v->Data();
4611  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4612  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4613  {
4614    WerrorS("poly must be constant");
4615    return TRUE;
4616  }
4617  number i=pGetCoeff(p);
4618  number n;
4619  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4620  if (nMap!=NULL)
4621    n=nMap(i,currRing->cf,coeffs_BIGINT);
4622  else goto err;
4623  res->data=(void *)n;
4624  return FALSE;
4625err:
4626  WerrorS("cannot convert to bigint"); return TRUE;
4627}
4628static BOOLEAN jjP2I(leftv res, leftv v)
4629{
4630  poly p=(poly)v->Data();
4631  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4632  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4633  {
4634    WerrorS("poly must be constant");
4635    return TRUE;
4636  }
4637  res->data = (char *)(long)n_Int(pGetCoeff(p),currRing->cf);
4638  return FALSE;
4639}
4640static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4641{
4642  map mapping=(map)v->Data();
4643  syMake(res,omStrDup(mapping->preimage));
4644  return FALSE;
4645}
4646static BOOLEAN jjPRIME(leftv res, leftv v)
4647{
4648  int i = IsPrime((int)(long)(v->Data()));
4649  res->data = (char *)(long)(i > 1 ? i : 2);
4650  return FALSE;
4651}
4652static BOOLEAN jjPRUNE(leftv res, leftv v)
4653{
4654  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4655  ideal v_id=(ideal)v->Data();
4656  if (w!=NULL)
4657  {
4658    if (!idTestHomModule(v_id,currQuotient,w))
4659    {
4660      WarnS("wrong weights");
4661      w=NULL;
4662      // and continue at the non-homog case below
4663    }
4664    else
4665    {
4666      w=ivCopy(w);
4667      intvec **ww=&w;
4668      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4669      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4670      return FALSE;
4671    }
4672  }
4673  res->data = (char *)idMinEmbedding(v_id);
4674  return FALSE;
4675}
4676static BOOLEAN jjP2N(leftv res, leftv v)
4677{
4678  number n;
4679  poly p;
4680  if (((p=(poly)v->Data())!=NULL)
4681  && (pIsConstant(p)))
4682  {
4683    n=nCopy(pGetCoeff(p));
4684  }
4685  else
4686  {
4687    n=nInit(0);
4688  }
4689  res->data = (char *)n;
4690  return FALSE;
4691}
4692static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4693{
4694  char *s= (char *)v->Data();
4695  int i = 1;
4696  for(i=0; i<sArithBase.nCmdUsed; i++)
4697  {
4698    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4699    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4700    {
4701      res->data = (char *)1;
4702      return FALSE;
4703    }
4704  }
4705  //res->data = (char *)0;
4706  return FALSE;
4707}
4708static BOOLEAN jjRANK1(leftv res, leftv v)
4709{
4710  matrix m =(matrix)v->Data();
4711  int rank = luRank(m, 0);
4712  res->data =(char *)(long)rank;
4713  return FALSE;
4714}
4715static BOOLEAN jjREAD(leftv res, leftv v)
4716{
4717  return jjREAD2(res,v,NULL);
4718}
4719static BOOLEAN jjREGULARITY(leftv res, leftv v)
4720{
4721  res->data = (char *)(long)iiRegularity((lists)v->Data());
4722  return FALSE;
4723}
4724static BOOLEAN jjREPART(leftv res, leftv v)
4725{
4726  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4727  return FALSE;
4728}
4729static BOOLEAN jjRINGLIST(leftv res, leftv v)
4730{
4731  ring r=(ring)v->Data();
4732  if (r!=NULL)
4733    res->data = (char *)rDecompose((ring)v->Data());
4734  return (r==NULL)||(res->data==NULL);
4735}
4736static BOOLEAN jjROWS(leftv res, leftv v)
4737{
4738  ideal i = (ideal)v->Data();
4739  res->data = (char *)i->rank;
4740  return FALSE;
4741}
4742static BOOLEAN jjROWS_BIM(leftv res, leftv v)
4743{
4744  res->data = (char *)(long)((bigintmat*)(v->Data()))->rows();
4745  return FALSE;
4746}
4747static BOOLEAN jjROWS_IV(leftv res, leftv v)
4748{
4749  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4750  return FALSE;
4751}
4752static BOOLEAN jjRPAR(leftv res, leftv v)
4753{
4754  res->data = (char *)(long)rPar(((ring)v->Data()));
4755  return FALSE;
4756}
4757static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4758{
4759#ifdef HAVE_PLURAL
4760  const bool bIsSCA = rIsSCA(currRing);
4761#else
4762  const bool bIsSCA = false;
4763#endif
4764
4765  if ((currQuotient!=NULL) && !bIsSCA)
4766  {
4767    WerrorS("qring not supported by slimgb at the moment");
4768    return TRUE;
4769  }
4770  if (rHasLocalOrMixedOrdering_currRing())
4771  {
4772    WerrorS("ordering must be global for slimgb");
4773    return TRUE;
4774  }
4775  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4776  tHomog hom=testHomog;
4777  ideal u_id=(ideal)u->Data();
4778  if (w!=NULL)
4779  {
4780    if (!idTestHomModule(u_id,currQuotient,w))
4781    {
4782      WarnS("wrong weights");
4783      w=NULL;
4784    }
4785    else
4786    {
4787      w=ivCopy(w);
4788      hom=isHomog;
4789    }
4790  }
4791
4792  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
4793  res->data=(char *)t_rep_gb(currRing,
4794    u_id,u_id->rank);
4795  //res->data=(char *)t_rep_gb(currRing, u_id);
4796
4797  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4798  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4799  return FALSE;
4800}
4801static BOOLEAN jjSBA(leftv res, leftv v)
4802{
4803  ideal result;
4804  ideal v_id=(ideal)v->Data();
4805  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4806  tHomog hom=testHomog;
4807  if (w!=NULL)
4808  {
4809    if (!idTestHomModule(v_id,currQuotient,w))
4810    {
4811      WarnS("wrong weights");
4812      w=NULL;
4813    }
4814    else
4815    {
4816      hom=isHomog;
4817      w=ivCopy(w);
4818    }
4819  }
4820  result=kSba(v_id,currQuotient,hom,&w,1,0);
4821  idSkipZeroes(result);
4822  res->data = (char *)result;
4823  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4824  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4825  return FALSE;
4826}
4827static BOOLEAN jjSBA_1(leftv res, leftv v, leftv u)
4828{
4829  ideal result;
4830  ideal v_id=(ideal)v->Data();
4831  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4832  tHomog hom=testHomog;
4833  if (w!=NULL)
4834  {
4835    if (!idTestHomModule(v_id,currQuotient,w))
4836    {
4837      WarnS("wrong weights");
4838      w=NULL;
4839    }
4840    else
4841    {
4842      hom=isHomog;
4843      w=ivCopy(w);
4844    }
4845  }
4846  result=kSba(v_id,currQuotient,hom,&w,(int)(long)u->Data(),0);
4847  idSkipZeroes(result);
4848  res->data = (char *)result;
4849  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4850  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4851  return FALSE;
4852}
4853static BOOLEAN jjSBA_2(leftv res, leftv v, leftv u, leftv t)
4854{
4855  ideal result;
4856  ideal v_id=(ideal)v->Data();
4857  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4858  tHomog hom=testHomog;
4859  if (w!=NULL)
4860  {
4861    if (!idTestHomModule(v_id,currQuotient,w))
4862    {
4863      WarnS("wrong weights");
4864      w=NULL;
4865    }
4866    else
4867    {
4868      hom=isHomog;
4869      w=ivCopy(w);
4870    }
4871  }
4872  result=kSba(v_id,currQuotient,hom,&w,(int)(long)u->Data(),(int)(long)t->Data());
4873  idSkipZeroes(result);
4874  res->data = (char *)result;
4875  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4876  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4877  return FALSE;
4878}
4879static BOOLEAN jjSTD(leftv res, leftv v)
4880{
4881  ideal result;
4882  ideal v_id=(ideal)v->Data();
4883  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4884  tHomog hom=testHomog;
4885  if (w!=NULL)
4886  {
4887    if (!idTestHomModule(v_id,currQuotient,w))
4888    {
4889      WarnS("wrong weights");
4890      w=NULL;
4891    }
4892    else
4893    {
4894      hom=isHomog;
4895      w=ivCopy(w);
4896    }
4897  }
4898  result=kStd(v_id,currQuotient,hom,&w);
4899  idSkipZeroes(result);
4900  res->data = (char *)result;
4901  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4902  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4903  return FALSE;
4904}
4905static BOOLEAN jjSort_Id(leftv res, leftv v)
4906{
4907  res->data = (char *)idSort((ideal)v->Data());
4908  return FALSE;
4909}
4910#ifdef HAVE_FACTORY
4911static BOOLEAN jjSQR_FREE(leftv res, leftv u)
4912{
4913  singclap_factorize_retry=0;
4914  intvec *v=NULL;
4915  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
4916  if (f==NULL) return TRUE;
4917  ivTest(v);
4918  lists l=(lists)omAllocBin(slists_bin);
4919  l->Init(2);
4920  l->m[0].rtyp=IDEAL_CMD;
4921  l->m[0].data=(void *)f;
4922  l->m[1].rtyp=INTVEC_CMD;
4923  l->m[1].data=(void *)v;
4924  res->data=(void *)l;
4925  return FALSE;
4926}
4927#endif
4928#if 1
4929static BOOLEAN jjSYZYGY(leftv res, leftv v)
4930{
4931  intvec *w=NULL;
4932  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
4933  if (w!=NULL) delete w;
4934  return FALSE;
4935}
4936#else
4937// activate, if idSyz handle module weights correctly !
4938static BOOLEAN jjSYZYGY(leftv res, leftv v)
4939{
4940  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4941  ideal v_id=(ideal)v->Data();
4942  tHomog hom=testHomog;
4943  int add_row_shift=0;
4944  if (w!=NULL)
4945  {
4946    w=ivCopy(w);
4947    add_row_shift=w->min_in();
4948    (*w)-=add_row_shift;
4949    if (idTestHomModule(v_id,currQuotient,w))
4950      hom=isHomog;
4951    else
4952    {
4953      //WarnS("wrong weights");
4954      delete w; w=NULL;
4955      hom=testHomog;
4956    }
4957  }
4958  res->data = (char *)idSyzygies(v_id,hom,&w);
4959  if (w!=NULL)
4960  {
4961    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4962  }
4963  return FALSE;
4964}
4965#endif
4966static BOOLEAN jjTRACE_IV(leftv res, leftv v)
4967{
4968  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
4969  return FALSE;
4970}
4971static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
4972{
4973  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
4974  return FALSE;
4975}
4976static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
4977{
4978  res->data = (char *)ivTranp((intvec*)(v->Data()));
4979  return FALSE;
4980}
4981#ifdef HAVE_PLURAL
4982static BOOLEAN jjOPPOSITE(leftv res, leftv a)
4983{
4984  ring    r = (ring)a->Data();
4985  //if (rIsPluralRing(r))
4986  if (r->OrdSgn==1)
4987  {
4988    res->data = rOpposite(r);
4989  }
4990  else
4991  {
4992    WarnS("opposite only for global orderings");
4993    res->data = rCopy(r);
4994  }
4995  return FALSE;
4996}
4997static BOOLEAN jjENVELOPE(leftv res, leftv a)
4998{
4999  ring    r = (ring)a->Data();
5000  if (rIsPluralRing(r))
5001  {
5002    //    ideal   i;
5003//     if (a->rtyp == QRING_CMD)
5004//     {
5005//       i = r->qideal;
5006//       r->qideal = NULL;
5007//     }
5008    ring s = rEnvelope(r);
5009//     if (a->rtyp == QRING_CMD)
5010//     {
5011//       ideal is  = idOppose(r,i); /* twostd? */
5012//       is        = idAdd(is,i);
5013//       s->qideal = i;
5014//     }
5015    res->data = s;
5016  }
5017  else  res->data = rCopy(r);
5018  return FALSE;
5019}
5020static BOOLEAN jjTWOSTD(leftv res, leftv a)
5021{
5022  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
5023  else  res->data=(ideal)a->CopyD();
5024  setFlag(res,FLAG_STD);
5025  setFlag(res,FLAG_TWOSTD);
5026  return FALSE;
5027}
5028#endif
5029
5030static BOOLEAN jjTYPEOF(leftv res, leftv v)
5031{
5032  int t=(int)(long)v->data;
5033  switch (t)
5034  {
5035    case INT_CMD:        res->data=omStrDup("int"); break;
5036    case POLY_CMD:       res->data=omStrDup("poly"); break;
5037    case VECTOR_CMD:     res->data=omStrDup("vector"); break;
5038    case STRING_CMD:     res->data=omStrDup("string"); break;
5039    case INTVEC_CMD:     res->data=omStrDup("intvec"); break;
5040    case IDEAL_CMD:      res->data=omStrDup("ideal"); break;
5041    case MATRIX_CMD:     res->data=omStrDup("matrix"); break;
5042    case MODUL_CMD:      res->data=omStrDup("module"); break;
5043    case MAP_CMD:        res->data=omStrDup("map"); break;
5044    case PROC_CMD:       res->data=omStrDup("proc"); break;
5045    case RING_CMD:       res->data=omStrDup("ring"); break;
5046    case QRING_CMD:      res->data=omStrDup("qring"); break;
5047    case INTMAT_CMD:     res->data=omStrDup("intmat"); break;
5048    case NUMBER_CMD:     res->data=omStrDup("number"); break;
5049    case BIGINT_CMD:     res->data=omStrDup("bigint"); break;
5050    case LIST_CMD:       res->data=omStrDup("list"); break;
5051    case PACKAGE_CMD:    res->data=omStrDup("package"); break;
5052    case LINK_CMD:       res->data=omStrDup("link"); break;
5053    case RESOLUTION_CMD: res->data=omStrDup("resolution");break;
5054    case DEF_CMD:
5055    case NONE:           res->data=omStrDup("none"); break;
5056    default:
5057    {
5058      if (t>MAX_TOK)
5059        res->data=omStrDup(getBlackboxName(t));
5060      else
5061        res->data=omStrDup("?unknown type?");
5062      break;
5063    }
5064  }
5065  return FALSE;
5066}
5067static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5068{
5069  res->data=(char *)pIsUnivariate((poly)v->Data());
5070  return FALSE;
5071}
5072static BOOLEAN jjVAR1(leftv res, leftv v)
5073{
5074  int i=(int)(long)v->Data();
5075  if ((0<i) && (i<=currRing->N))
5076  {
5077    poly p=pOne();
5078    pSetExp(p,i,1);
5079    pSetm(p);
5080    res->data=(char *)p;
5081  }
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 jjVARSTR1(leftv res, leftv v)
5090{
5091  if (currRing==NULL)
5092  {
5093    WerrorS("no ring active");
5094    return TRUE;
5095  }
5096  int i=(int)(long)v->Data();
5097  if ((0<i) && (i<=currRing->N))
5098    res->data=omStrDup(currRing->names[i-1]);
5099  else
5100  {
5101    Werror("var number %d out of range 1..%d",i,currRing->N);
5102    return TRUE;
5103  }
5104  return FALSE;
5105}
5106static BOOLEAN jjVDIM(leftv res, leftv v)
5107{
5108  assumeStdFlag(v);
5109  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currQuotient);
5110  return FALSE;
5111}
5112BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5113{
5114// input: u: a list with links of type
5115//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5116// returns: -1:  the read state of all links is eof
5117//          i>0: (at least) u[i] is ready
5118  lists Lforks = (lists)u->Data();
5119  int i = slStatusSsiL(Lforks, -1);
5120  if(i == -2) /* error */
5121  {
5122    return TRUE;
5123  }
5124  res->data = (void*)(long)i;
5125  return FALSE;
5126}
5127BOOLEAN jjWAITALL1(leftv res, leftv u)
5128{
5129// input: u: a list with links of type
5130//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5131// returns: -1: the read state of all links is eof
5132//           1: all links are ready
5133//              (caution: at least one is ready, but some maybe dead)
5134  lists Lforks = (lists)u->CopyD();
5135  int i;
5136  int j = -1;
5137  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5138  {
5139    i = slStatusSsiL(Lforks, -1);
5140    if(i == -2) /* error */
5141    {
5142      return TRUE;
5143    }
5144    if(i == -1)
5145    {
5146      break;
5147    }
5148    j = 1;
5149    Lforks->m[i-1].CleanUp();
5150    Lforks->m[i-1].rtyp=DEF_CMD;
5151    Lforks->m[i-1].data=NULL;
5152  }
5153  res->data = (void*)(long)j;
5154  Lforks->Clean();
5155  return FALSE;
5156}
5157
5158BOOLEAN jjLOAD(char *s, BOOLEAN autoexport)
5159{
5160  char libnamebuf[256];
5161  lib_types LT = type_of_LIB(s, libnamebuf);
5162
5163#ifdef HAVE_DYNAMIC_LOADING
5164  extern BOOLEAN load_modules(char *newlib, char *fullpath, BOOLEAN autoexport);
5165#endif /* HAVE_DYNAMIC_LOADING */
5166  switch(LT)
5167  {
5168      default:
5169      case LT_NONE:
5170        Werror("%s: unknown type", s);
5171        break;
5172      case LT_NOTFOUND:
5173        Werror("cannot open %s", s);
5174        break;
5175
5176      case LT_SINGULAR:
5177      {
5178        char *plib = iiConvName(s);
5179        idhdl pl = IDROOT->get(plib,0);
5180        if (pl==NULL)
5181        {
5182          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5183          IDPACKAGE(pl)->language = LANG_SINGULAR;
5184          IDPACKAGE(pl)->libname=omStrDup(plib);
5185        }
5186        else if (IDTYP(pl)!=PACKAGE_CMD)
5187        {
5188          Werror("can not create package `%s`",plib);
5189          omFree(plib);
5190          return TRUE;
5191        }
5192        package savepack=currPack;
5193        currPack=IDPACKAGE(pl);
5194        IDPACKAGE(pl)->loaded=TRUE;
5195        char libnamebuf[256];
5196        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5197        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5198        currPack=savepack;
5199        IDPACKAGE(pl)->loaded=(!bo);
5200        return bo;
5201      }
5202      case LT_BUILTIN:
5203        SModulFunc_t iiGetBuiltinModInit(char*);
5204        return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5205      case LT_MACH_O:
5206      case LT_ELF:
5207      case LT_HPUX:
5208#ifdef HAVE_DYNAMIC_LOADING
5209        return load_modules(s, libnamebuf, autoexport);
5210#else /* HAVE_DYNAMIC_LOADING */
5211        WerrorS("Dynamic modules are not supported by this version of Singular");
5212        break;
5213#endif /* HAVE_DYNAMIC_LOADING */
5214  }
5215  return TRUE;
5216}
5217
5218#ifdef INIT_BUG
5219#define XS(A) -((short)A)
5220#define jjstrlen       (proc1)1
5221#define jjpLength      (proc1)2
5222#define jjidElem       (proc1)3
5223#define jjmpDetBareiss (proc1)4
5224#define jjidFreeModule (proc1)5
5225#define jjidVec2Ideal  (proc1)6
5226#define jjrCharStr     (proc1)7
5227#ifndef MDEBUG
5228#define jjpHead        (proc1)8
5229#endif
5230#define jjidMinBase    (proc1)11
5231#define jjsyMinBase    (proc1)12
5232#define jjpMaxComp     (proc1)13
5233#define jjmpTrace      (proc1)14
5234#define jjmpTransp     (proc1)15
5235#define jjrOrdStr      (proc1)16
5236#define jjrVarStr      (proc1)18
5237#define jjrParStr      (proc1)19
5238#define jjCOUNT_RES    (proc1)22
5239#define jjDIM_R        (proc1)23
5240#define jjidTransp     (proc1)24
5241
5242extern struct sValCmd1 dArith1[];
5243void jjInitTab1()
5244{
5245  int i=0;
5246  for (;dArith1[i].cmd!=0;i++)
5247  {
5248    if (dArith1[i].res<0)
5249    {
5250      switch ((int)dArith1[i].p)
5251      {
5252        case (int)jjstrlen:       dArith1[i].p=(proc1)strlen; break;
5253        case (int)jjpLength:      dArith1[i].p=(proc1)pLength; break;
5254        case (int)jjidElem:       dArith1[i].p=(proc1)idElem; break;
5255        case (int)jjidVec2Ideal:  dArith1[i].p=(proc1)idVec2Ideal; break;
5256#ifndef HAVE_FACTORY
5257        case (int)jjmpDetBareiss: dArith1[i].p=(proc1)mpDetBareiss; break;
5258#endif
5259        case (int)jjidFreeModule: dArith1[i].p=(proc1)idFreeModule; break;
5260        case (int)jjrCharStr:     dArith1[i].p=(proc1)rCharStr; break;
5261#ifndef MDEBUG
5262        case (int)jjpHead:        dArith1[i].p=(proc1)pHeadProc; break;
5263#endif
5264        case (int)jjidMinBase:    dArith1[i].p=(proc1)idMinBase; break;
5265        case (int)jjsyMinBase:    dArith1[i].p=(proc1)syMinBase; break;
5266        case (int)jjpMaxComp:     dArith1[i].p=(proc1)pMaxCompProc; break;
5267        case (int)jjmpTrace:      dArith1[i].p=(proc1)mpTrace; break;
5268        case (int)jjmpTransp:     dArith1[i].p=(proc1)mpTransp; break;
5269        case (int)jjrOrdStr:      dArith1[i].p=(proc1)rOrdStr; break;
5270        case (int)jjrVarStr:      dArith1[i].p=(proc1)rVarStr; break;
5271        case (int)jjrParStr:      dArith1[i].p=(proc1)rParStr; break;
5272        case (int)jjCOUNT_RES:    dArith1[i].p=(proc1)sySize; break;
5273        case (int)jjDIM_R:        dArith1[i].p=(proc1)syDim; break;
5274        case (int)jjidTransp:     dArith1[i].p=(proc1)idTransp; break;
5275        default: Werror("missing proc1-definition for %d",(int)(long)dArith1[i].p);
5276      }
5277    }
5278  }
5279}
5280#else
5281#if defined(PROC_BUG)
5282#define XS(A) A
5283static BOOLEAN jjstrlen(leftv res, leftv v)
5284{
5285  res->data = (char *)strlen((char *)v->Data());
5286  return FALSE;
5287}
5288static BOOLEAN jjpLength(leftv res, leftv v)
5289{
5290  res->data = (char *)pLength((poly)v->Data());
5291  return FALSE;
5292}
5293static BOOLEAN jjidElem(leftv res, leftv v)
5294{
5295  res->data = (char *)idElem((ideal)v->Data());
5296  return FALSE;
5297}
5298static BOOLEAN jjmpDetBareiss(leftv res, leftv v)
5299{
5300  res->data = (char *)mp_DetBareiss((matrix)v->Data(),currRing);
5301  return FALSE;
5302}
5303static BOOLEAN jjidFreeModule(leftv res, leftv v)
5304{
5305  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5306  return FALSE;
5307}
5308static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5309{
5310  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5311  return FALSE;
5312}
5313static BOOLEAN jjrCharStr(leftv res, leftv v)
5314{
5315  res->data = rCharStr((ring)v->Data());
5316  return FALSE;
5317}
5318#ifndef MDEBUG
5319static BOOLEAN jjpHead(leftv res, leftv v)
5320{
5321  res->data = (char *)pHead((poly)v->Data());
5322  return FALSE;
5323}
5324#endif
5325static BOOLEAN jjidHead(leftv res, leftv v)
5326{
5327  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5328  return FALSE;
5329}
5330static BOOLEAN jjidMinBase(leftv res, leftv v)
5331{
5332  res->data = (char *)idMinBase((ideal)v->Data());
5333  return FALSE;
5334}
5335static BOOLEAN jjsyMinBase(leftv res, leftv v)
5336{
5337  res->data = (char *)syMinBase((ideal)v->Data());
5338  return FALSE;
5339}
5340static BOOLEAN jjpMaxComp(leftv res, leftv v)
5341{
5342  res->data = (char *)pMaxComp((poly)v->Data());
5343  return FALSE;
5344}
5345static BOOLEAN jjmpTrace(leftv res, leftv v)
5346{
5347  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5348  return FALSE;
5349}
5350static BOOLEAN jjmpTransp(leftv res, leftv v)
5351{
5352  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5353  return FALSE;
5354}
5355static BOOLEAN jjrOrdStr(leftv res, leftv v)
5356{
5357  res->data = rOrdStr((ring)v->Data());
5358  return FALSE;
5359}
5360static BOOLEAN jjrVarStr(leftv res, leftv v)
5361{
5362  res->data = rVarStr((ring)v->Data());
5363  return FALSE;
5364}
5365static BOOLEAN jjrParStr(leftv res, leftv v)
5366{
5367  res->data = rParStr((ring)v->Data());
5368  return FALSE;
5369}
5370static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5371{
5372  res->data=(char *)sySize((syStrategy)v->Data());
5373  return FALSE;
5374}
5375static BOOLEAN jjDIM_R(leftv res, leftv v)
5376{
5377  res->data = (char *)syDim((syStrategy)v->Data());
5378  return FALSE;
5379}
5380static BOOLEAN jjidTransp(leftv res, leftv v)
5381{
5382  res->data = (char *)idTransp((ideal)v->Data());
5383  return FALSE;
5384}
5385#else
5386#define XS(A)          -((short)A)
5387#define jjstrlen       (proc1)strlen
5388#define jjpLength      (proc1)pLength
5389#define jjidElem       (proc1)idElem
5390#define jjmpDetBareiss (proc1)mpDetBareiss
5391#define jjidFreeModule (proc1)idFreeModule
5392#define jjidVec2Ideal  (proc1)idVec2Ideal
5393#define jjrCharStr     (proc1)rCharStr
5394#ifndef MDEBUG
5395#define jjpHead        (proc1)pHeadProc
5396#endif
5397#define jjidHead       (proc1)idHead
5398#define jjidMinBase    (proc1)idMinBase
5399#define jjsyMinBase    (proc1)syMinBase
5400#define jjpMaxComp     (proc1)pMaxCompProc
5401#define jjrOrdStr      (proc1)rOrdStr
5402#define jjrVarStr      (proc1)rVarStr
5403#define jjrParStr      (proc1)rParStr
5404#define jjCOUNT_RES    (proc1)sySize
5405#define jjDIM_R        (proc1)syDim
5406#define jjidTransp     (proc1)idTransp
5407#endif
5408#endif
5409static BOOLEAN jjnInt(leftv res, leftv u)
5410{
5411  number n=(number)u->Data();
5412  res->data=(char *)(long)n_Int(n,currRing->cf);
5413  return FALSE;
5414}
5415static BOOLEAN jjnlInt(leftv res, leftv u)
5416{
5417  number n=(number)u->Data();
5418  res->data=(char *)(long)n_Int(n,coeffs_BIGINT );
5419  return FALSE;
5420}
5421/*=================== operations with 3 args.: static proc =================*/
5422/* must be ordered: first operations for chars (infix ops),
5423 * then alphabetically */
5424static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5425{
5426  char *s= (char *)u->Data();
5427  int   r = (int)(long)v->Data();
5428  int   c = (int)(long)w->Data();
5429  int l = strlen(s);
5430
5431  if ( (r<1) || (r>l) || (c<0) )
5432  {
5433    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5434    return TRUE;
5435  }
5436  res->data = (char *)omAlloc((long)(c+1));
5437  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5438  return FALSE;
5439}
5440static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5441{
5442  intvec *iv = (intvec *)u->Data();
5443  int   r = (int)(long)v->Data();
5444  int   c = (int)(long)w->Data();
5445  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5446  {
5447    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5448           r,c,u->Fullname(),iv->rows(),iv->cols());
5449    return TRUE;
5450  }
5451  res->data=u->data; u->data=NULL;
5452  res->rtyp=u->rtyp; u->rtyp=0;
5453  res->name=u->name; u->name=NULL;
5454  Subexpr e=jjMakeSub(v);
5455          e->next=jjMakeSub(w);
5456  if (u->e==NULL) res->e=e;
5457  else
5458  {
5459    Subexpr h=u->e;
5460    while (h->next!=NULL) h=h->next;
5461    h->next=e;
5462    res->e=u->e;
5463    u->e=NULL;
5464  }
5465  return FALSE;
5466}
5467static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5468{
5469  bigintmat *bim = (bigintmat *)u->Data();
5470  int   r = (int)(long)v->Data();
5471  int   c = (int)(long)w->Data();
5472  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5473  {
5474    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5475           r,c,u->Fullname(),bim->rows(),bim->cols());
5476    return TRUE;
5477  }
5478  res->data=u->data; u->data=NULL;
5479  res->rtyp=u->rtyp; u->rtyp=0;
5480  res->name=u->name; u->name=NULL;
5481  Subexpr e=jjMakeSub(v);
5482          e->next=jjMakeSub(w);
5483  if (u->e==NULL)
5484    res->e=e;
5485  else
5486  {
5487    Subexpr h=u->e;
5488    while (h->next!=NULL) h=h->next;
5489    h->next=e;
5490    res->e=u->e;
5491    u->e=NULL;
5492  }
5493  return FALSE;
5494}
5495static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5496{
5497  matrix m= (matrix)u->Data();
5498  int   r = (int)(long)v->Data();
5499  int   c = (int)(long)w->Data();
5500  //Print("gen. elem %d, %d\n",r,c);
5501  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5502  {
5503    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5504      MATROWS(m),MATCOLS(m));
5505    return TRUE;
5506  }
5507  res->data=u->data; u->data=NULL;
5508  res->rtyp=u->rtyp; u->rtyp=0;
5509  res->name=u->name; u->name=NULL;
5510  Subexpr e=jjMakeSub(v);
5511          e->next=jjMakeSub(w);
5512  if (u->e==NULL)
5513    res->e=e;
5514  else
5515  {
5516    Subexpr h=u->e;
5517    while (h->next!=NULL) h=h->next;
5518    h->next=e;
5519    res->e=u->e;
5520    u->e=NULL;
5521  }
5522  return FALSE;
5523}
5524static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5525{
5526  sleftv t;
5527  sleftv ut;
5528  leftv p=NULL;
5529  intvec *iv=(intvec *)w->Data();
5530  int l;
5531  BOOLEAN nok;
5532
5533  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5534  {
5535    WerrorS("cannot build expression lists from unnamed objects");
5536    return TRUE;
5537  }
5538  memcpy(&ut,u,sizeof(ut));
5539  memset(&t,0,sizeof(t));
5540  t.rtyp=INT_CMD;
5541  for (l=0;l< iv->length(); l++)
5542  {
5543    t.data=(char *)(long)((*iv)[l]);
5544    if (p==NULL)
5545    {
5546      p=res;
5547    }
5548    else
5549    {
5550      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5551      p=p->next;
5552    }
5553    memcpy(u,&ut,sizeof(ut));
5554    if (u->Typ() == MATRIX_CMD)
5555      nok=jjBRACK_Ma(p,u,v,&t);
5556    else /* INTMAT_CMD */
5557      nok=jjBRACK_Im(p,u,v,&t);
5558    if (nok)
5559    {
5560      while (res->next!=NULL)
5561      {
5562        p=res->next->next;
5563        omFreeBin((ADDRESS)res->next, sleftv_bin);
5564        // res->e aufraeumen !!!!
5565        res->next=p;
5566      }
5567      return TRUE;
5568    }
5569  }
5570  return FALSE;
5571}
5572static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5573{
5574  sleftv t;
5575  sleftv ut;
5576  leftv p=NULL;
5577  intvec *iv=(intvec *)v->Data();
5578  int l;
5579  BOOLEAN nok;
5580
5581  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5582  {
5583    WerrorS("cannot build expression lists from unnamed objects");
5584    return TRUE;
5585  }
5586  memcpy(&ut,u,sizeof(ut));
5587  memset(&t,0,sizeof(t));
5588  t.rtyp=INT_CMD;
5589  for (l=0;l< iv->length(); l++)
5590  {
5591    t.data=(char *)(long)((*iv)[l]);
5592    if (p==NULL)
5593    {
5594      p=res;
5595    }
5596    else
5597    {
5598      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5599      p=p->next;
5600    }
5601    memcpy(u,&ut,sizeof(ut));
5602    if (u->Typ() == MATRIX_CMD)
5603      nok=jjBRACK_Ma(p,u,&t,w);
5604    else /* INTMAT_CMD */
5605      nok=jjBRACK_Im(p,u,&t,w);
5606    if (nok)
5607    {
5608      while (res->next!=NULL)
5609      {
5610        p=res->next->next;
5611        omFreeBin((ADDRESS)res->next, sleftv_bin);
5612        // res->e aufraeumen !!
5613        res->next=p;
5614      }
5615      return TRUE;
5616    }
5617  }
5618  return FALSE;
5619}
5620static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5621{
5622  sleftv t1,t2,ut;
5623  leftv p=NULL;
5624  intvec *vv=(intvec *)v->Data();
5625  intvec *wv=(intvec *)w->Data();
5626  int vl;
5627  int wl;
5628  BOOLEAN nok;
5629
5630  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5631  {
5632    WerrorS("cannot build expression lists from unnamed objects");
5633    return TRUE;
5634  }
5635  memcpy(&ut,u,sizeof(ut));
5636  memset(&t1,0,sizeof(sleftv));
5637  memset(&t2,0,sizeof(sleftv));
5638  t1.rtyp=INT_CMD;
5639  t2.rtyp=INT_CMD;
5640  for (vl=0;vl< vv->length(); vl++)
5641  {
5642    t1.data=(char *)(long)((*vv)[vl]);
5643    for (wl=0;wl< wv->length(); wl++)
5644    {
5645      t2.data=(char *)(long)((*wv)[wl]);
5646      if (p==NULL)
5647      {
5648        p=res;
5649      }
5650      else
5651      {
5652        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5653        p=p->next;
5654      }
5655      memcpy(u,&ut,sizeof(ut));
5656      if (u->Typ() == MATRIX_CMD)
5657        nok=jjBRACK_Ma(p,u,&t1,&t2);
5658      else /* INTMAT_CMD */
5659        nok=jjBRACK_Im(p,u,&t1,&t2);
5660      if (nok)
5661      {
5662        res->CleanUp();
5663        return TRUE;
5664      }
5665    }
5666  }
5667  return FALSE;
5668}
5669static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5670{
5671  v->next=(leftv)omAllocBin(sleftv_bin);
5672  memcpy(v->next,w,sizeof(sleftv));
5673  memset(w,0,sizeof(sleftv));
5674  return jjPROC(res,u,v);
5675}
5676static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5677{
5678  intvec *iv;
5679  ideal m;
5680  lists l=(lists)omAllocBin(slists_bin);
5681  int k=(int)(long)w->Data();
5682  if (k>=0)
5683  {
5684    sm_CallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv, currRing);
5685    l->Init(2);
5686    l->m[0].rtyp=MODUL_CMD;
5687    l->m[1].rtyp=INTVEC_CMD;
5688    l->m[0].data=(void *)m;
5689    l->m[1].data=(void *)iv;
5690  }
5691  else
5692  {
5693    m=sm_CallSolv((ideal)u->Data(), currRing);
5694    l->Init(1);
5695    l->m[0].rtyp=IDEAL_CMD;
5696    l->m[0].data=(void *)m;
5697  }
5698  res->data = (char *)l;
5699  return FALSE;
5700}
5701static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5702{
5703  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5704  {
5705    WerrorS("3rd argument must be a name of a matrix");
5706    return TRUE;
5707  }
5708  ideal i=(ideal)u->Data();
5709  int rank=(int)i->rank;
5710  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5711  if (r) return TRUE;
5712  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5713  return FALSE;
5714}
5715static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5716{
5717  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5718           (ideal)(v->Data()),(poly)(w->Data()));
5719  return FALSE;
5720}
5721static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5722{
5723  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5724  {
5725    WerrorS("3rd argument must be a name of a matrix");
5726    return TRUE;
5727  }
5728  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5729  poly p=(poly)u->CopyD(POLY_CMD);
5730  ideal i=idInit(1,1);
5731  i->m[0]=p;
5732  sleftv t;
5733  memset(&t,0,sizeof(t));
5734  t.data=(char *)i;
5735  t.rtyp=IDEAL_CMD;
5736  int rank=1;
5737  if (u->Typ()==VECTOR_CMD)
5738  {
5739    i->rank=rank=pMaxComp(p);
5740    t.rtyp=MODUL_CMD;
5741  }
5742  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5743  t.CleanUp();
5744  if (r) return TRUE;
5745  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5746  return FALSE;
5747}
5748static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5749{
5750  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5751    (intvec *)w->Data());
5752  //setFlag(res,FLAG_STD);
5753  return FALSE;
5754}
5755static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5756{
5757  /*4
5758  * look for the substring what in the string where
5759  * starting at position n
5760  * return the position of the first char of what in where
5761  * or 0
5762  */
5763  int n=(int)(long)w->Data();
5764  char *where=(char *)u->Data();
5765  char *what=(char *)v->Data();
5766  char *found;
5767  if ((1>n)||(n>(int)strlen(where)))
5768  {
5769    Werror("start position %d out of range",n);
5770    return TRUE;
5771  }
5772  found = strchr(where+n-1,*what);
5773  if (*(what+1)!='\0')
5774  {
5775    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
5776    {
5777      found=strchr(found+1,*what);
5778    }
5779  }
5780  if (found != NULL)
5781  {
5782    res->data=(char *)((found-where)+1);
5783  }
5784  return FALSE;
5785}
5786static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
5787{
5788  if ((int)(long)w->Data()==0)
5789    res->data=(char *)walkProc(u,v);
5790  else
5791    res->data=(char *)fractalWalkProc(u,v);
5792  setFlag( res, FLAG_STD );
5793  return FALSE;
5794}
5795static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
5796{
5797  intvec *wdegree=(intvec*)w->Data();
5798  if (wdegree->length()!=currRing->N)
5799  {
5800    Werror("weight vector must have size %d, not %d",
5801           currRing->N,wdegree->length());
5802    return TRUE;
5803  }
5804#ifdef HAVE_RINGS
5805  if (rField_is_Ring_Z(currRing))
5806  {
5807    ring origR = currRing;
5808    ring tempR = rCopy(origR);
5809    coeffs new_cf=nInitChar(n_Q,NULL);
5810    nKillChar(tempR->cf);
5811    tempR->cf=new_cf;
5812    rComplete(tempR);
5813    ideal uid = (ideal)u->Data();
5814    rChangeCurrRing(tempR);
5815    ideal uu = idrCopyR(uid, origR, currRing);
5816    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
5817    uuAsLeftv.rtyp = IDEAL_CMD;
5818    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
5819    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
5820    assumeStdFlag(&uuAsLeftv);
5821    Print("// NOTE: computation of Hilbert series etc. is being\n");
5822    Print("//       performed for generic fibre, that is, over Q\n");
5823    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
5824    intvec *iv=hFirstSeries(uu,module_w,currQuotient,wdegree);
5825    int returnWithTrue = 1;
5826    switch((int)(long)v->Data())
5827    {
5828      case 1:
5829        res->data=(void *)iv;
5830        returnWithTrue = 0;
5831      case 2:
5832        res->data=(void *)hSecondSeries(iv);
5833        delete iv;
5834        returnWithTrue = 0;
5835    }
5836    if (returnWithTrue)
5837    {
5838      WerrorS(feNotImplemented);
5839      delete iv;
5840    }
5841    idDelete(&uu);
5842    rChangeCurrRing(origR);
5843    rDelete(tempR);
5844    if (returnWithTrue) return TRUE; else return FALSE;
5845  }
5846#endif
5847  assumeStdFlag(u);
5848  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
5849  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient,wdegree);
5850  switch((int)(long)v->Data())
5851  {
5852    case 1:
5853      res->data=(void *)iv;
5854      return FALSE;
5855    case 2:
5856      res->data=(void *)hSecondSeries(iv);
5857      delete iv;
5858      return FALSE;
5859  }
5860  WerrorS(feNotImplemented);
5861  delete iv;
5862  return TRUE;
5863}
5864static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv w)
5865{
5866  PrintS("TODO\n");
5867  int i=pVar((poly)v->Data());
5868  if (i==0)
5869  {
5870    WerrorS("ringvar expected");
5871    return TRUE;
5872  }
5873  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5874  int d=pWTotaldegree(p);
5875  pLmDelete(p);
5876  if (d==1)
5877    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
5878  else
5879    WerrorS("variable must have weight 1");
5880  return (d!=1);
5881}
5882static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv w)
5883{
5884  PrintS("TODO\n");
5885  int i=pVar((poly)v->Data());
5886  if (i==0)
5887  {
5888    WerrorS("ringvar expected");
5889    return TRUE;
5890  }
5891  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5892  int d=pWTotaldegree(p);
5893  pLmDelete(p);
5894  if (d==1)
5895    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
5896  else
5897    WerrorS("variable must have weight 1");
5898  return (d!=1);
5899}
5900static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
5901{
5902  intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
5903  intvec* arg = (intvec*) u->Data();
5904  int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
5905
5906  for (i=0; i<n; i++)
5907  {
5908    (*im)[i] = (*arg)[i];
5909  }
5910
5911  res->data = (char *)im;
5912  return FALSE;
5913}
5914static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
5915{
5916  short *iw=iv2array((intvec *)w->Data(),currRing);
5917  res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
5918  omFreeSize((ADDRESS)iw,(currRing->N+1)*sizeof(short));
5919  return FALSE;
5920}
5921static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
5922{
5923  if (!pIsUnit((poly)v->Data()))
5924  {
5925    WerrorS("2nd argument must be a unit");
5926    return TRUE;
5927  }
5928  res->data = (char *)p_Series((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD(),NULL,currRing);
5929  return FALSE;
5930}
5931static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
5932{
5933  res->data = (char *)id_JetW((ideal)u->Data(),(int)(long)v->Data(),
5934                             (intvec *)w->Data(),currRing);
5935  return FALSE;
5936}
5937static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
5938{
5939  if (!mp_IsDiagUnit((matrix)v->Data(), currRing))
5940  {
5941    WerrorS("2nd argument must be a diagonal matrix of units");
5942    return TRUE;
5943  }
5944  res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
5945                               (matrix)v->CopyD());
5946  return FALSE;
5947}
5948static BOOLEAN currRingIsOverIntegralDomain ()
5949{
5950  /* true for fields and Z, false otherwise */
5951  if (rField_is_Ring_PtoM(currRing)) return FALSE;
5952  if (rField_is_Ring_2toM(currRing)) return FALSE;
5953  if (rField_is_Ring_ModN(currRing)) return FALSE;
5954  return TRUE;
5955}
5956static BOOLEAN jjMINOR_M(leftv res, leftv v)
5957{
5958  /* Here's the use pattern for the minor command:
5959        minor ( matrix_expression m, int_expression minorSize,
5960                optional ideal_expression IasSB, optional int_expression k,
5961                optional string_expression algorithm,
5962                optional int_expression cachedMinors,
5963                optional int_expression cachedMonomials )
5964     This method here assumes that there are at least two arguments.
5965     - If IasSB is present, it must be a std basis. All minors will be
5966       reduced w.r.t. IasSB.
5967     - If k is absent, all non-zero minors will be computed.
5968       If k is present and k > 0, the first k non-zero minors will be
5969       computed.
5970       If k is present and k < 0, the first |k| minors (some of which
5971       may be zero) will be computed.
5972       If k is present and k = 0, an error is reported.
5973     - If algorithm is absent, all the following arguments must be absent too.
5974       In this case, a heuristic picks the best-suited algorithm (among
5975       Bareiss, Laplace, and Laplace with caching).
5976       If algorithm is present, it must be one of "Bareiss", "bareiss",
5977       "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
5978       "cache" two more arguments may be given, determining how many entries
5979       the cache may have at most, and how many cached monomials there are at
5980       most. (Cached monomials are counted over all cached polynomials.)
5981       If these two additional arguments are not provided, 200 and 100000
5982       will be used as defaults.
5983  */
5984  matrix m;
5985  leftv u=v->next;
5986  v->next=NULL;
5987  int v_typ=v->Typ();
5988  if (v_typ==MATRIX_CMD)
5989  {
5990     m = (const matrix)v->Data();
5991  }
5992  else
5993  {
5994    if (v_typ==0)
5995    {
5996      Werror("`%s` is undefined",v->Fullname());
5997      return TRUE;
5998    }
5999    // try to convert to MATRIX:
6000    int ii=iiTestConvert(v_typ,MATRIX_CMD);
6001    BOOLEAN bo;
6002    sleftv tmp;
6003    if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
6004    else bo=TRUE;
6005    if (bo)
6006    {
6007      Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
6008      return TRUE;
6009    }
6010    m=(matrix)tmp.data;
6011  }
6012  const int mk = (const int)(long)u->Data();
6013  bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
6014  bool noCacheMinors = true; bool noCacheMonomials = true;
6015  ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
6016
6017  /* here come the different cases of correct argument sets */
6018  if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
6019  {
6020    IasSB = (ideal)u->next->Data();
6021    noIdeal = false;
6022    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6023    {
6024      k = (int)(long)u->next->next->Data();
6025      noK = false;
6026      assume(k != 0);
6027      if ((u->next->next->next != NULL) &&
6028          (u->next->next->next->Typ() == STRING_CMD))
6029      {
6030        algorithm = (char*)u->next->next->next->Data();
6031        noAlgorithm = false;
6032        if ((u->next->next->next->next != NULL) &&
6033            (u->next->next->next->next->Typ() == INT_CMD))
6034        {
6035          cacheMinors = (int)(long)u->next->next->next->next->Data();
6036          noCacheMinors = false;
6037          if ((u->next->next->next->next->next != NULL) &&
6038              (u->next->next->next->next->next->Typ() == INT_CMD))
6039          {
6040            cacheMonomials =
6041               (int)(long)u->next->next->next->next->next->Data();
6042            noCacheMonomials = false;
6043          }
6044        }
6045      }
6046    }
6047  }
6048  else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
6049  {
6050    k = (int)(long)u->next->Data();
6051    noK = false;
6052    assume(k != 0);
6053    if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
6054    {
6055      algorithm = (char*)u->next->next->Data();
6056      noAlgorithm = false;
6057      if ((u->next->next->next != NULL) &&
6058          (u->next->next->next->Typ() == INT_CMD))
6059      {
6060        cacheMinors = (int)(long)u->next->next->next->Data();
6061        noCacheMinors = false;
6062        if ((u->next->next->next->next != NULL) &&
6063            (u->next->next->next->next->Typ() == INT_CMD))
6064        {
6065          cacheMonomials = (int)(long)u->next->next->next->next->Data();
6066          noCacheMonomials = false;
6067        }
6068      }
6069    }
6070  }
6071  else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
6072  {
6073    algorithm = (char*)u->next->Data();
6074    noAlgorithm = false;
6075    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6076    {
6077      cacheMinors = (int)(long)u->next->next->Data();
6078      noCacheMinors = false;
6079      if ((u->next->next->next != NULL) &&
6080          (u->next->next->next->Typ() == INT_CMD))
6081      {
6082        cacheMonomials = (int)(long)u->next->next->next->Data();
6083        noCacheMonomials = false;
6084      }
6085    }
6086  }
6087
6088  /* upper case conversion for the algorithm if present */
6089  if (!noAlgorithm)
6090  {
6091    if (strcmp(algorithm, "bareiss") == 0)
6092      algorithm = (char*)"Bareiss";
6093    if (strcmp(algorithm, "laplace") == 0)
6094      algorithm = (char*)"Laplace";
6095    if (strcmp(algorithm, "cache") == 0)
6096      algorithm = (char*)"Cache";
6097  }
6098
6099  v->next=u;
6100  /* here come some tests */
6101  if (!noIdeal)
6102  {
6103    assumeStdFlag(u->next);
6104  }
6105  if ((!noK) && (k == 0))
6106  {
6107    WerrorS("Provided number of minors to be computed is zero.");
6108    return TRUE;
6109  }
6110  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") != 0)
6111      && (strcmp(algorithm, "Laplace") != 0)
6112      && (strcmp(algorithm, "Cache") != 0))
6113  {
6114    WerrorS("Expected as algorithm one of 'B/bareiss', 'L/laplace', or 'C/cache'.");
6115    return TRUE;
6116  }
6117  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") == 0)
6118      && (!currRingIsOverIntegralDomain()))
6119  {
6120    Werror("Bareiss algorithm not defined over coefficient rings %s",
6121           "with zero divisors.");
6122    return TRUE;
6123  }
6124  if ((mk < 1) || (mk > m->rows()) || (mk > m->cols()))
6125  {
6126    Werror("invalid size of minors: %d (matrix is (%d x %d))", mk,
6127           m->rows(), m->cols());
6128    return TRUE;
6129  }
6130  if ((!noAlgorithm) && (strcmp(algorithm, "Cache") == 0)
6131      && (noCacheMinors || noCacheMonomials))
6132  {
6133    cacheMinors = 200;
6134    cacheMonomials = 100000;
6135  }
6136
6137  /* here come the actual procedure calls */
6138  if (noAlgorithm)
6139    res->data = getMinorIdealHeuristic(m, mk, (noK ? 0 : k),
6140                                       (noIdeal ? 0 : IasSB), false);
6141  else if (strcmp(algorithm, "Cache") == 0)
6142    res->data = getMinorIdealCache(m, mk, (noK ? 0 : k),
6143                                   (noIdeal ? 0 : IasSB), 3, cacheMinors,
6144                                   cacheMonomials, false);
6145  else
6146    res->data = getMinorIdeal(m, mk, (noK ? 0 : k), algorithm,
6147                              (noIdeal ? 0 : IasSB), false);
6148  if (v_typ!=MATRIX_CMD) idDelete((ideal *)&m);
6149  res->rtyp = IDEAL_CMD;
6150  return FALSE;
6151}
6152static BOOLEAN jjNEWSTRUCT3(leftv, leftv u, leftv v, leftv w)
6153{
6154  // u: the name of the new type
6155  // v: the parent type
6156  // w: the elements
6157  newstruct_desc d=newstructChildFromString((const char *)v->Data(),
6158                                            (const char *)w->Data());
6159  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
6160  return (d==NULL);
6161}
6162static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w)
6163{
6164  // handles preimage(r,phi,i) and kernel(r,phi)
6165  idhdl h;
6166  ring rr;
6167  map mapping;
6168  BOOLEAN kernel_cmd= (iiOp==KERNEL_CMD);
6169
6170  if ((v->name==NULL) || (!kernel_cmd && (w->name==NULL)))
6171  {
6172    WerrorS("2nd/3rd arguments must have names");
6173    return TRUE;
6174  }
6175  rr=(ring)u->Data();
6176  const char *ring_name=u->Name();
6177  if ((h=rr->idroot->get(v->name,myynest))!=NULL)
6178  {
6179    if (h->typ==MAP_CMD)
6180    {
6181      mapping=IDMAP(h);
6182      idhdl preim_ring=IDROOT->get(mapping->preimage,myynest);
6183      if ((preim_ring==NULL)
6184      || (IDRING(preim_ring)!=currRing))
6185      {
6186        Werror("preimage ring `%s` is not the basering",mapping->preimage);
6187        return TRUE;
6188      }
6189    }
6190    else if (h->typ==IDEAL_CMD)
6191    {
6192      mapping=IDMAP(h);
6193    }
6194    else
6195    {
6196      Werror("`%s` is no map nor ideal",IDID(h));
6197      return TRUE;
6198    }
6199  }
6200  else
6201  {
6202    Werror("`%s` is not defined in `%s`",v->name,ring_name);
6203    return TRUE;
6204  }
6205  ideal image;
6206  if (kernel_cmd) image=idInit(1,1);
6207  else
6208  {
6209    if ((h=rr->idroot->get(w->name,myynest))!=NULL)
6210    {
6211      if (h->typ==IDEAL_CMD)
6212      {
6213        image=IDIDEAL(h);
6214      }
6215      else
6216      {
6217        Werror("`%s` is no ideal",IDID(h));
6218        return TRUE;
6219      }
6220    }
6221    else
6222    {
6223      Werror("`%s` is not defined in `%s`",w->name,ring_name);
6224      return TRUE;
6225    }
6226  }
6227  if (((currRing->qideal!=NULL) && (rHasLocalOrMixedOrdering_currRing()))
6228  || ((rr->qideal!=NULL) && (rHasLocalOrMixedOrdering(rr))))
6229  {
6230    WarnS("preimage in local qring may be wrong: use Ring::preimageLoc instead");
6231  }
6232  res->data=(char *)maGetPreimage(rr,mapping,image,currRing);
6233  if (kernel_cmd) idDelete(&image);
6234  return (res->data==NULL/* is of type ideal, should not be NULL*/);
6235}
6236static BOOLEAN jjRANDOM_Im(leftv res, leftv u, leftv v, leftv w)
6237{
6238  int di, k;
6239  int i=(int)(long)u->Data();
6240  int r=(int)(long)v->Data();
6241  int c=(int)(long)w->Data();
6242  if ((r<=0) || (c<=0)) return TRUE;
6243  intvec *iv = new intvec(r, c, 0);
6244  if (iv->rows()==0)
6245  {
6246    delete iv;
6247    return TRUE;
6248  }
6249  if (i!=0)
6250  {
6251    if (i<0) i = -i;
6252    di = 2 * i + 1;
6253    for (k=0; k<iv->length(); k++)
6254    {
6255      (*iv)[k] = ((siRand() % di) - i);
6256    }
6257  }
6258  res->data = (char *)iv;
6259  return FALSE;
6260}
6261static BOOLEAN jjSUBST_Test(leftv v,leftv w,
6262  int &ringvar, poly &monomexpr)
6263{
6264  monomexpr=(poly)w->Data();
6265  poly p=(poly)v->Data();
6266#if 0
6267  if (pLength(monomexpr)>1)
6268  {
6269    Werror("`%s` substitutes a ringvar only by a term",
6270      Tok2Cmdname(SUBST_CMD));
6271    return TRUE;
6272  }
6273#endif
6274  if ((ringvar=pVar(p))==0)
6275  {
6276    if ((p!=NULL) && rField_is_Extension(currRing))
6277    {
6278      assume(currRing->cf->extRing!=NULL);
6279      number n = pGetCoeff(p);
6280      ringvar= -n_IsParam(n, currRing);
6281    }
6282    if(ringvar==0)
6283    {
6284      WerrorS("ringvar/par expected");
6285      return TRUE;
6286    }
6287  }
6288  return FALSE;
6289}
6290static BOOLEAN jjSUBST_P(leftv res, leftv u, leftv v,leftv w)
6291{
6292  int ringvar;
6293  poly monomexpr;
6294  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6295  if (nok) return TRUE;
6296  poly p=(poly)u->Data();
6297  if (ringvar>0)
6298  {
6299    if ((monomexpr!=NULL) && (p!=NULL) && (pTotaldegree(p)!=0) &&
6300    ((unsigned long)pTotaldegree(monomexpr) > (currRing->bitmask / (unsigned long)pTotaldegree(p))))
6301    {
6302      Warn("possible OVERFLOW in subst, max exponent is %ld, subtituting deg %d by deg %d",currRing->bitmask, pTotaldegree(monomexpr), pTotaldegree(p));
6303      //return TRUE;
6304    }
6305    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6306      res->data = pSubst((poly)u->CopyD(res->rtyp),ringvar,monomexpr);
6307    else
6308      res->data= pSubstPoly(p,ringvar,monomexpr);
6309  }
6310  else
6311  {
6312    res->data=pSubstPar(p,-ringvar,monomexpr);
6313  }
6314  return FALSE;
6315}
6316static BOOLEAN jjSUBST_Id(leftv res, leftv u, leftv v,leftv w)
6317{
6318  int ringvar;
6319  poly monomexpr;
6320  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6321  if (nok) return TRUE;
6322  if (ringvar>0)
6323  {
6324    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6325      res->data = id_Subst((ideal)u->CopyD(res->rtyp), ringvar, monomexpr, currRing);
6326    else
6327      res->data = idSubstPoly((ideal)u->Data(),ringvar,monomexpr);
6328  }
6329  else
6330  {
6331    res->data = idSubstPar((ideal)u->Data(),-ringvar,monomexpr);
6332  }
6333  return FALSE;
6334}
6335// we do not want to have jjSUBST_Id_X inlined:
6336static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w,
6337                            int input_type);
6338static BOOLEAN jjSUBST_Id_I(leftv res, leftv u, leftv v,leftv w)
6339{
6340  return jjSUBST_Id_X(res,u,v,w,INT_CMD);
6341}
6342static BOOLEAN jjSUBST_Id_N(leftv res, leftv u, leftv v,leftv w)
6343{
6344  return jjSUBST_Id_X(res,u,v,w,NUMBER_CMD);
6345}
6346static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w, int input_type)
6347{
6348  sleftv tmp;
6349  memset(&tmp,0,sizeof(tmp));
6350  // do not check the result, conversion from int/number to poly works always
6351  iiConvert(input_type,POLY_CMD,iiTestConvert(input_type,POLY_CMD),w,&tmp);
6352  BOOLEAN b=jjSUBST_Id(res,u,v,&tmp);
6353  tmp.CleanUp();
6354  return b;
6355}
6356static BOOLEAN jjMATRIX_Id(leftv res, leftv u, leftv v,leftv w)
6357{
6358  int mi=(int)(long)v->Data();
6359  int ni=(int)(long)w->Data();
6360  if ((mi<1)||(ni<1))
6361  {
6362    Werror("converting ideal to matrix: dimensions must be positive(%dx%d)",mi,ni);
6363    return TRUE;
6364  }
6365  matrix m=mpNew(mi,ni);
6366  ideal I=(ideal)u->CopyD(IDEAL_CMD);
6367  int i=si_min(IDELEMS(I),mi*ni);
6368  //for(i=i-1;i>=0;i--)
6369  //{
6370  //  m->m[i]=I->m[i];
6371  //  I->m[i]=NULL;
6372  //}
6373  memcpy(m->m,I->m,i*sizeof(poly));
6374  memset(I->m,0,i*sizeof(poly));
6375  id_Delete(&I,currRing);
6376  res->data = (char *)m;
6377  return FALSE;
6378}
6379static BOOLEAN jjMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6380{
6381  int mi=(int)(long)v->Data();
6382  int ni=(int)(long)w->Data();
6383  if ((mi<1)||(ni<1))
6384  {
6385    Werror("converting module to matrix: dimensions must be positive(%dx%d)",mi,ni);
6386    return TRUE;
6387  }
6388  res->data = (char *)id_Module2formatedMatrix((ideal)u->CopyD(MODUL_CMD),
6389           mi,ni,currRing);
6390  return FALSE;
6391}
6392static BOOLEAN jjMATRIX_Ma(leftv res, leftv u, leftv v,leftv w)
6393{
6394  int mi=(int)(long)v->Data();
6395  int ni=(int)(long)w->Data();
6396  if ((mi<1)||(ni<1))
6397  {
6398     Werror("converting matrix to matrix: dimensions must be positive(%dx%d)",mi,ni);
6399    return TRUE;
6400  }
6401  matrix m=mpNew(mi,ni);
6402  matrix I=(matrix)u->CopyD(MATRIX_CMD);
6403  int r=si_min(MATROWS(I),mi);
6404  int c=si_min(MATCOLS(I),ni);
6405  int i,j;
6406  for(i=r;i>0;i--)
6407  {
6408    for(j=c;j>0;j--)
6409    {
6410      MATELEM(m,i,j)=MATELEM(I,i,j);
6411      MATELEM(I,i,j)=NULL;
6412    }
6413  }
6414  id_Delete((ideal *)&I,currRing);
6415  res->data = (char *)m;
6416  return FALSE;
6417}
6418static BOOLEAN jjLIFT3(leftv res, leftv u, leftv v, leftv w)
6419{
6420  if (w->rtyp!=IDHDL) return TRUE;
6421  int ul= IDELEMS((ideal)u->Data());
6422  int vl= IDELEMS((ideal)v->Data());
6423  ideal m
6424    = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
6425             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))));
6426  if (m==NULL) return TRUE;
6427  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
6428  return FALSE;
6429}
6430static BOOLEAN jjLIFTSTD3(leftv res, leftv u, leftv v, leftv w)
6431{
6432  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
6433  if ((w->rtyp!=IDHDL)||(w->e!=NULL)) return TRUE;
6434  idhdl hv=(idhdl)v->data;
6435  idhdl hw=(idhdl)w->data;
6436  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
6437  res->data = (char *)idLiftStd((ideal)u->Data(),
6438                                &(hv->data.umatrix),testHomog,
6439                                &(hw->data.uideal));
6440  setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
6441  return FALSE;
6442}
6443static BOOLEAN jjREDUCE3_CP(leftv res, leftv u, leftv v, leftv w)
6444{
6445  assumeStdFlag(v);
6446  if (!idIsZeroDim((ideal)v->Data()))
6447  {
6448    Werror("`%s` must be 0-dimensional",v->Name());
6449    return TRUE;
6450  }
6451  res->data = (char *)redNF((ideal)v->CopyD(),(poly)u->CopyD(),
6452    (poly)w->CopyD());
6453  return FALSE;
6454}
6455static BOOLEAN jjREDUCE3_CID(leftv res, leftv u, leftv v, leftv w)
6456{
6457  assumeStdFlag(v);
6458  if (!idIsZeroDim((ideal)v->Data()))
6459  {
6460    Werror("`%s` must be 0-dimensional",v->Name());
6461    return TRUE;
6462  }
6463  res->data = (char *)redNF((ideal)v->CopyD(),(ideal)u->CopyD(),
6464    (matrix)w->CopyD());
6465  return FALSE;
6466}
6467static BOOLEAN jjREDUCE3_P(leftv res, leftv u, leftv v, leftv w)
6468{
6469  assumeStdFlag(v);
6470  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data(),
6471    0,(int)(long)w->Data());
6472  return FALSE;
6473}
6474static BOOLEAN jjREDUCE3_ID(leftv res, leftv u, leftv v, leftv w)
6475{
6476  assumeStdFlag(v);
6477  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(ideal)u->Data(),
6478    0,(int)(long)w->Data());
6479  return FALSE;
6480}
6481#ifdef OLD_RES
6482static BOOLEAN jjRES3(leftv res, leftv u, leftv v, leftv w)
6483{
6484  int maxl=(int)v->Data();
6485  ideal u_id=(ideal)u->Data();
6486  int l=0;
6487  resolvente r;
6488  intvec **weights=NULL;
6489  int wmaxl=maxl;
6490  maxl--;
6491  if ((maxl==-1) && (iiOp!=MRES_CMD))
6492    maxl = currRing->N-1;
6493  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
6494  {
6495    intvec * iv=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
6496    if (iv!=NULL)
6497    {
6498      l=1;
6499      if (!idTestHomModule(u_id,currQuotient,iv))
6500      {
6501        WarnS("wrong weights");
6502        iv=NULL;
6503      }
6504      else
6505      {
6506        weights = (intvec**)omAlloc0Bin(char_ptr_bin);
6507        weights[0] = ivCopy(iv);
6508      }
6509    }
6510    r=syResolvente(u_id,maxl,&l, &weights, iiOp==MRES_CMD);
6511  }
6512  else
6513    r=sySchreyerResolvente((ideal)u->Data(),maxl+1,&l);
6514  if (r==NULL) return TRUE;
6515  int t3=u->Typ();
6516  iiMakeResolv(r,l,wmaxl,w->name,t3,weights);
6517  return FALSE;
6518}
6519#endif
6520static BOOLEAN jjRING3(leftv res, leftv u, leftv v, leftv w)
6521{
6522  res->data=(void *)rInit(u,v,w);
6523  return (res->data==NULL);
6524}
6525static BOOLEAN jjSTATUS3(leftv res, leftv u, leftv v, leftv w)
6526{
6527  int yes;
6528  jjSTATUS2(res, u, v);
6529  yes = (strcmp((char *) res->data, (char *) w->Data()) == 0);
6530  omFree((ADDRESS) res->data);
6531  res->data = (void *)(long)yes;
6532  return FALSE;
6533}
6534static BOOLEAN jjSTD_HILB_W(leftv res, leftv u, leftv v, leftv w)
6535{
6536  intvec *vw=(intvec *)w->Data(); // weights of vars
6537  if (vw->length()!=currRing->N)
6538  {
6539    Werror("%d weights for %d variables",vw->length(),currRing->N);
6540    return TRUE;
6541  }
6542  ideal result;
6543  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6544  tHomog hom=testHomog;
6545  ideal u_id=(ideal)(u->Data());
6546  if (ww!=NULL)
6547  {
6548    if (!idTestHomModule(u_id,currQuotient,ww))
6549    {
6550      WarnS("wrong weights");
6551      ww=NULL;
6552    }
6553    else
6554    {
6555      ww=ivCopy(ww);
6556      hom=isHomog;
6557    }
6558  }
6559  result=kStd(u_id,
6560              currQuotient,
6561              hom,
6562              &ww,                  // module weights
6563              (intvec *)v->Data(),  // hilbert series
6564              0,0,                  // syzComp, newIdeal
6565              vw);                  // weights of vars
6566  idSkipZeroes(result);
6567  res->data = (char *)result;
6568  setFlag(res,FLAG_STD);
6569  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
6570  return FALSE;
6571}
6572
6573/*=================== operations with many arg.: static proc =================*/
6574/* must be ordered: first operations for chars (infix ops),
6575 * then alphabetically */
6576static BOOLEAN jjBREAK0(leftv, leftv)
6577{
6578#ifdef HAVE_SDB
6579  sdb_show_bp();
6580#endif
6581  return FALSE;
6582}
6583static BOOLEAN jjBREAK1(leftv, leftv v)
6584{
6585#ifdef HAVE_SDB
6586  if(v->Typ()==PROC_CMD)
6587  {
6588    int lineno=0;
6589    if((v->next!=NULL) && (v->next->Typ()==INT_CMD))
6590    {
6591      lineno=(int)(long)v->next->Data();
6592    }
6593    return sdb_set_breakpoint(v->Name(),lineno);
6594  }
6595  return TRUE;
6596#else
6597 return FALSE;
6598#endif
6599}
6600static BOOLEAN jjCALL1ARG(leftv res, leftv v)
6601{
6602  return iiExprArith1(res,v,iiOp);
6603}
6604static BOOLEAN jjCALL2ARG(leftv res, leftv u)
6605{
6606  leftv v=u->next;
6607  u->next=NULL;
6608  BOOLEAN b=iiExprArith2(res,u,iiOp,v, (iiOp > 255));
6609  u->next=v;
6610  return b;
6611}
6612static BOOLEAN jjCALL3ARG(leftv res, leftv u)
6613{
6614  leftv v = u->next;
6615  leftv w = v->next;
6616  u->next = NULL;
6617  v->next = NULL;
6618  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
6619  u->next = v;
6620  v->next = w;
6621  return b;
6622}
6623
6624static BOOLEAN jjCOEF_M(leftv, leftv v)
6625{
6626  if((v->Typ() != VECTOR_CMD)
6627  || (v->next->Typ() != POLY_CMD)
6628  || (v->next->next->Typ() != MATRIX_CMD)
6629  || (v->next->next->next->Typ() != MATRIX_CMD))
6630     return TRUE;
6631  if (v->next->next->rtyp!=IDHDL) return TRUE;
6632  idhdl c=(idhdl)v->next->next->data;
6633  if (v->next->next->next->rtyp!=IDHDL) return TRUE;
6634  idhdl m=(idhdl)v->next->next->next->data;
6635  idDelete((ideal *)&(c->data.uideal));
6636  idDelete((ideal *)&(m->data.uideal));
6637  mp_Coef2((poly)v->Data(),(poly)v->next->Data(),
6638    (matrix *)&(c->data.umatrix),(matrix *)&(m->data.umatrix),currRing);
6639  return FALSE;
6640}
6641
6642static BOOLEAN jjDIVISION4(leftv res, leftv v)
6643{ // may have 3 or 4 arguments
6644  leftv v1=v;
6645  leftv v2=v1->next;
6646  leftv v3=v2->next;
6647  leftv v4=v3->next;
6648  assumeStdFlag(v2);
6649
6650  int i1=iiTestConvert(v1->Typ(),MODUL_CMD);
6651  int i2=iiTestConvert(v2->Typ(),MODUL_CMD);
6652
6653  if((i1==0)||(i2==0)
6654  ||(v3->Typ()!=INT_CMD)||((v4!=NULL)&&(v4->Typ()!=INTVEC_CMD)))
6655  {
6656    WarnS("<module>,<module>,<int>[,<intvec>] expected!");
6657    return TRUE;
6658  }
6659
6660  sleftv w1,w2;
6661  iiConvert(v1->Typ(),MODUL_CMD,i1,v1,&w1);
6662  iiConvert(v2->Typ(),MODUL_CMD,i2,v2,&w2);
6663  ideal P=(ideal)w1.Data();
6664  ideal Q=(ideal)w2.Data();
6665
6666  int n=(int)(long)v3->Data();
6667  short *w=NULL;
6668  if(v4!=NULL)
6669  {
6670    w=iv2array((intvec *)v4->Data(),currRing);
6671    short *w0=w+1;
6672    int i=currRing->N;
6673    while(i>0&&*w0>0)
6674    {
6675      w0++;
6676      i--;
6677    }
6678    if(i>0)
6679      WarnS("not all weights are positive!");
6680  }
6681
6682  matrix T;
6683  ideal R;
6684  idLiftW(P,Q,n,T,R,w);
6685
6686  w1.CleanUp();
6687  w2.CleanUp();
6688  if(w!=NULL)
6689    omFree(w);
6690
6691  lists L=(lists) omAllocBin(slists_bin);
6692  L->Init(2);
6693  L->m[1].rtyp=v1->Typ();
6694  if(v1->Typ()==POLY_CMD||v1->Typ()==VECTOR_CMD)
6695  {
6696    if(v1->Typ()==POLY_CMD)
6697      p_Shift(&R->m[0],-1,currRing);
6698    L->m[1].data=(void *)R->m[0];
6699    R->m[0]=NULL;
6700    idDelete(&R);
6701  }
6702  else if(v1->Typ()==IDEAL_CMD||v1->Typ()==MATRIX_CMD)
6703    L->m[1].data=(void *)id_Module2Matrix(R,currRing);
6704  else
6705  {
6706    L->m[1].rtyp=MODUL_CMD;
6707    L->m[1].data=(void *)R;
6708  }
6709  L->m[0].rtyp=MATRIX_CMD;
6710  L->m[0].data=(char *)T;
6711
6712  res->data=L;
6713  res->rtyp=LIST_CMD;
6714
6715  return FALSE;
6716}
6717
6718//static BOOLEAN jjEXPORTTO_M(leftv res, leftv u)
6719//{
6720//  int l=u->listLength();
6721//  if (l<2) return TRUE;
6722//  BOOLEAN b;
6723//  leftv v=u->next;
6724//  leftv zz=v;
6725//  leftv z=zz;
6726//  u->next=NULL;
6727//  do
6728//  {
6729//    leftv z=z->next;
6730//    b=iiExprArith2(res,u,iiOp,z, (iiOp > 255));
6731//    if (b) break;
6732//  } while (z!=NULL);
6733//  u->next=zz;
6734//  return b;
6735//}
6736static BOOLEAN jjIDEAL_PL(leftv res, leftv v)
6737{
6738  int s=1;
6739  leftv h=v;
6740  if (h!=NULL) s=exprlist_length(h);
6741  ideal id=idInit(s,1);
6742  int rank=1;
6743  int i=0;
6744  poly p;
6745  while (h!=NULL)
6746  {
6747    switch(h->Typ())
6748    {
6749      case POLY_CMD:
6750      {
6751        p=(poly)h->CopyD(POLY_CMD);
6752        break;
6753      }
6754      case INT_CMD:
6755      {
6756        number n=nInit((int)(long)h->Data());
6757        if (!nIsZero(n))
6758        {
6759          p=pNSet(n);
6760        }
6761        else
6762        {
6763          p=NULL;
6764          nDelete(&n);
6765        }
6766        break;
6767      }
6768      case BIGINT_CMD:
6769      {
6770        number b=(number)h->Data();
6771        number n=n_Init_bigint(b,coeffs_BIGINT,currRing->cf);
6772        if (!nIsZero(n))
6773        {
6774          p=pNSet(n);
6775        }
6776        else
6777        {
6778          p=NULL;
6779          nDelete(&n);
6780        }
6781        break;
6782      }
6783      case NUMBER_CMD:
6784      {
6785        number n=(number)h->CopyD(NUMBER_CMD);
6786        if (!nIsZero(n))
6787        {
6788          p=pNSet(n);
6789        }
6790        else
6791        {
6792          p=NULL;
6793          nDelete(&n);
6794        }
6795        break;
6796      }
6797      case VECTOR_CMD:
6798      {
6799        p=(poly)h->CopyD(VECTOR_CMD);
6800        if (iiOp!=MODUL_CMD)
6801        {
6802          idDelete(&id);
6803          pDelete(&p);
6804          return TRUE;
6805        }
6806        rank=si_max(rank,(int)pMaxComp(p));
6807        break;
6808      }
6809      default:
6810      {
6811        idDelete(&id);
6812        return TRUE;
6813      }
6814    }
6815    if ((iiOp==MODUL_CMD)&&(p!=NULL)&&(pGetComp(p)==0))
6816    {
6817      pSetCompP(p,1);
6818    }
6819    id->m[i]=p;
6820    i++;
6821    h=h->next;
6822  }
6823  id->rank=rank;
6824  res->data=(char *)id;
6825  return FALSE;
6826}
6827static BOOLEAN jjINTERSECT_PL(leftv res, leftv v)
6828{
6829  leftv h=v;
6830  int l=v->listLength();
6831  resolvente r=(resolvente)omAlloc0(l*sizeof(ideal));
6832  BOOLEAN *copied=(BOOLEAN *)omAlloc0(l*sizeof(BOOLEAN));
6833  int t=0;
6834  // try to convert to IDEAL_CMD
6835  while (h!=NULL)
6836  {
6837    if (iiTestConvert(h->Typ(),IDEAL_CMD)!=0)
6838    {
6839      t=IDEAL_CMD;
6840    }
6841    else break;
6842    h=h->next;
6843  }
6844  // if failure, try MODUL_CMD
6845  if (t==0)
6846  {
6847    h=v;
6848    while (h!=NULL)
6849    {
6850      if (iiTestConvert(h->Typ(),MODUL_CMD)!=0)
6851      {
6852        t=MODUL_CMD;
6853      }
6854      else break;
6855      h=h->next;
6856    }
6857  }
6858  // check for success  in converting
6859  if (t==0)
6860  {
6861    WerrorS("cannot convert to ideal or module");
6862    return TRUE;
6863  }
6864  // call idMultSect
6865  h=v;
6866  int i=0;
6867  sleftv tmp;
6868  while (h!=NULL)
6869  {
6870    if (h->Typ()==t)
6871    {
6872      r[i]=(ideal)h->Data(); /*no copy*/
6873      h=h->next;
6874    }
6875    else if(iiConvert(h->Typ(),t,iiTestConvert(h->Typ(),t),h,&tmp))
6876    {
6877      omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
6878      omFreeSize((ADDRESS)r,l*sizeof(ideal));
6879      Werror("cannot convert arg. %d to %s",i+1,Tok2Cmdname(t));
6880      return TRUE;
6881    }
6882    else
6883    {
6884      r[i]=(ideal)tmp.Data(); /*now it's a copy*/
6885      copied[i]=TRUE;
6886      h=tmp.next;
6887    }
6888    i++;
6889  }
6890  res->rtyp=t;
6891  res->data=(char *)idMultSect(r,i);
6892  while(i>0)
6893  {
6894    i--;
6895    if (copied[i]) idDelete(&(r[i]));
6896  }
6897  omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
6898  omFreeSize((ADDRESS)r,l*sizeof(ideal));
6899  return FALSE;
6900}
6901static BOOLEAN jjLU_INVERSE(leftv res, leftv v)
6902{
6903  /* computation of the inverse of a quadratic matrix A
6904     using the L-U-decomposition of A;
6905     There are two valid parametrisations:
6906     1) exactly one argument which is just the matrix A,
6907     2) exactly three arguments P, L, U which already
6908        realise the L-U-decomposition of A, that is,
6909        P * A = L * U, and P, L, and U satisfy the
6910        properties decribed in method 'jjLU_DECOMP';
6911        see there;
6912     If A is invertible, the list [1, A^(-1)] is returned,
6913     otherwise the list [0] is returned. Thus, the user may
6914     inspect the first entry of the returned list to see
6915     whether A is invertible. */
6916  matrix iMat; int invertible;
6917  if (v->next == NULL)
6918  {
6919    if (v->Typ() != MATRIX_CMD)
6920    {
6921      Werror("expected either one or three matrices");
6922      return TRUE;
6923    }
6924    else
6925    {
6926      matrix aMat = (matrix)v->Data();
6927      int rr = aMat->rows();
6928      int cc = aMat->cols();
6929      if (rr != cc)
6930      {
6931        Werror("given matrix (%d x %d) is not quadratic, hence not invertible", rr, cc);
6932        return TRUE;
6933      }
6934      if (!idIsConstant((ideal)aMat))
6935      {
6936        WerrorS("matrix must be constant");
6937        return TRUE;
6938      }
6939      invertible = luInverse(aMat, iMat);
6940    }
6941  }
6942  else if ((v->Typ() == MATRIX_CMD) &&
6943           (v->next->Typ() == MATRIX_CMD) &&
6944           (v->next->next != NULL) &&
6945           (v->next->next->Typ() == MATRIX_CMD) &&
6946           (v->next->next->next == NULL))
6947  {
6948     matrix pMat = (matrix)v->Data();
6949     matrix lMat = (matrix)v->next->Data();
6950     matrix uMat = (matrix)v->next->next->Data();
6951     int rr = uMat->rows();
6952     int cc = uMat->cols();
6953     if (rr != cc)
6954     {
6955       Werror("third matrix (%d x %d) is not quadratic, hence not invertible",
6956              rr, cc);
6957       return TRUE;
6958     }
6959      if (!idIsConstant((ideal)pMat)
6960      || (!idIsConstant((ideal)lMat))
6961      || (!idIsConstant((ideal)uMat))
6962      )
6963      {
6964        WerrorS("matricesx must be constant");
6965        return TRUE;
6966      }
6967     invertible = luInverseFromLUDecomp(pMat, lMat, uMat, iMat);
6968  }
6969  else
6970  {
6971    Werror("expected either one or three matrices");
6972    return TRUE;
6973  }
6974
6975  /* build the return structure; a list with either one or two entries */
6976  lists ll = (lists)omAllocBin(slists_bin);
6977  if (invertible)
6978  {
6979    ll->Init(2);
6980    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)invertible;
6981    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)iMat;
6982  }
6983  else
6984  {
6985    ll->Init(1);
6986    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)invertible;
6987  }
6988
6989  res->data=(char*)ll;
6990  return FALSE;
6991}
6992static BOOLEAN jjLU_SOLVE(leftv res, leftv v)
6993{
6994  /* for solving a linear equation system A * x = b, via the
6995     given LU-decomposition of the matrix A;
6996     There is one valid parametrisation:
6997     1) exactly four arguments P, L, U, b;
6998        P, L, and U realise the L-U-decomposition of A, that is,
6999        P * A = L * U, and P, L, and U satisfy the
7000        properties decribed in method 'jjLU_DECOMP';
7001        see there;
7002        b is the right-hand side vector of the equation system;
7003     The method will return a list of either 1 entry or three entries:
7004     1) [0] if there is no solution to the system;
7005     2) [1, x, H] if there is at least one solution;
7006        x is any solution of the given linear system,
7007        H is the matrix with column vectors spanning the homogeneous
7008        solution space.
7009     The method produces an error if matrix and vector sizes do not fit. */
7010  if ((v == NULL) || (v->Typ() != MATRIX_CMD) ||
7011      (v->next == NULL) || (v->next->Typ() != MATRIX_CMD) ||
7012      (v->next->next == NULL) || (v->next->next->Typ() != MATRIX_CMD) ||
7013      (v->next->next->next == NULL) ||
7014      (v->next->next->next->Typ() != MATRIX_CMD) ||
7015      (v->next->next->next->next != NULL))
7016  {
7017    WerrorS("expected exactly three matrices and one vector as input");
7018    return TRUE;
7019  }
7020  matrix pMat = (matrix)v->Data();
7021  matrix lMat = (matrix)v->next->Data();
7022  matrix uMat = (matrix)v->next->next->Data();
7023  matrix bVec = (matrix)v->next->next->next->Data();
7024  matrix xVec; int solvable; matrix homogSolSpace;
7025  if (pMat->rows() != pMat->cols())
7026  {
7027    Werror("first matrix (%d x %d) is not quadratic",
7028           pMat->rows(), pMat->cols());
7029    return TRUE;
7030  }
7031  if (lMat->rows() != lMat->cols())
7032  {
7033    Werror("second matrix (%d x %d) is not quadratic",
7034           lMat->rows(), lMat->cols());
7035    return TRUE;
7036  }
7037  if (lMat->rows() != uMat->rows())
7038  {
7039    Werror("second matrix (%d x %d) and third matrix (%d x %d) do not fit",
7040           lMat->rows(), lMat->cols(), uMat->rows(), uMat->cols());
7041    return TRUE;
7042  }
7043  if (uMat->rows() != bVec->rows())
7044  {
7045    Werror("third matrix (%d x %d) and vector (%d x 1) do not fit",
7046           uMat->rows(), uMat->cols(), bVec->rows());
7047    return TRUE;
7048  }
7049  if (!idIsConstant((ideal)pMat)
7050  ||(!idIsConstant((ideal)lMat))
7051  ||(!idIsConstant((ideal)uMat))
7052  )
7053  {
7054    WerrorS("matrices must be constant");
7055    return TRUE;
7056  }
7057  solvable = luSolveViaLUDecomp(pMat, lMat, uMat, bVec, xVec, homogSolSpace);
7058
7059  /* build the return structure; a list with either one or three entries */
7060  lists ll = (lists)omAllocBin(slists_bin);
7061  if (solvable)
7062  {
7063    ll->Init(3);
7064    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)solvable;
7065    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
7066    ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
7067  }
7068  else
7069  {
7070    ll->Init(1);
7071    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)solvable;
7072  }
7073
7074  res->data=(char*)ll;
7075  return FALSE;
7076}
7077static BOOLEAN jjINTVEC_PL(leftv res, leftv v)
7078{
7079  int i=0;
7080  leftv h=v;
7081  if (h!=NULL) i=exprlist_length(h);
7082  intvec *iv=new intvec(i);
7083  i=0;
7084  while (h!=NULL)
7085  {
7086    if(h->Typ()==INT_CMD)
7087    {
7088      (*iv)[i]=(int)(long)h->Data();
7089    }
7090    else
7091    {
7092      delete iv;
7093      return TRUE;
7094    }
7095    i++;
7096    h=h->next;
7097  }
7098  res->data=(char *)iv;
7099  return FALSE;
7100}
7101static BOOLEAN jjJET4(leftv res, leftv u)
7102{
7103  leftv u1=u;
7104  leftv u2=u1->next;
7105  leftv u3=u2->next;
7106  leftv u4=u3->next;
7107  if((u2->Typ()==POLY_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
7108  &&((u1->Typ()==POLY_CMD)||(u1->Typ()==VECTOR_CMD)))
7109  {
7110    if(!pIsUnit((poly)u2->Data()))
7111    {
7112      WerrorS("2nd argument must be a unit");
7113      return TRUE;
7114    }
7115    res->rtyp=u1->Typ();
7116    res->data=(char*)pSeries((int)(long)u3->Data(),pCopy((poly)u1->Data()),
7117                             pCopy((poly)u2->Data()),(intvec*)u4->Data());
7118    return FALSE;
7119  }
7120  else
7121  if((u2->Typ()==MATRIX_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
7122  &&((u1->Typ()==IDEAL_CMD)||(u1->Typ()==MODUL_CMD)))
7123  {
7124    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7125    {
7126      WerrorS("2nd argument must be a diagonal matrix of units");
7127      return TRUE;
7128    }
7129    res->rtyp=u1->Typ();
7130    res->data=(char*)idSeries(
7131                              (int)(long)u3->Data(),
7132                              idCopy((ideal)u1->Data()),
7133                              mp_Copy((matrix)u2->Data(), currRing),
7134                              (intvec*)u4->Data()
7135                             );
7136    return FALSE;
7137  }
7138  else
7139  {
7140    Werror("%s(`poly`,`poly`,`int`,`intvec`) exppected",
7141           Tok2Cmdname(iiOp));
7142    return TRUE;
7143  }
7144}
7145static BOOLEAN jjKLAMMER_PL(leftv res, leftv u)
7146{
7147  if ((yyInRingConstruction)
7148  && ((strcmp(u->Name(),"real")==0) || (strcmp(u->Name(),"complex")==0)))
7149  {
7150    memcpy(res,u,sizeof(sleftv));
7151    memset(u,0,sizeof(sleftv));
7152    return FALSE;
7153  }
7154  leftv v=u->next;
7155  BOOLEAN b;
7156  if(v==NULL)
7157    b=iiExprArith1(res,u,iiOp);
7158  else
7159  {
7160    u->next=NULL;
7161    b=iiExprArith2(res,u,iiOp,v);
7162    u->next=v;
7163  }
7164  return b;
7165}
7166BOOLEAN jjLIST_PL(leftv res, leftv v)
7167{
7168  int sl=0;
7169  if (v!=NULL) sl = v->listLength();
7170  lists L;
7171  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7172  {
7173    int add_row_shift = 0;
7174    intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7175    if (weights!=NULL)  add_row_shift=weights->min_in();
7176    L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7177  }
7178  else
7179  {
7180    L=(lists)omAllocBin(slists_bin);
7181    leftv h=NULL;
7182    int i;
7183    int rt;
7184
7185    L->Init(sl);
7186    for (i=0;i<sl;i++)
7187    {
7188      if (h!=NULL)
7189      { /* e.g. not in the first step:
7190         * h is the pointer to the old sleftv,
7191         * v is the pointer to the next sleftv
7192         * (in this moment) */
7193         h->next=v;
7194      }
7195      h=v;
7196      v=v->next;
7197      h->next=NULL;
7198      rt=h->Typ();
7199      if (rt==0)
7200      {
7201        L->Clean();
7202        Werror("`%s` is undefined",h->Fullname());
7203        return TRUE;
7204      }
7205      if ((rt==RING_CMD)||(rt==QRING_CMD))
7206      {
7207        L->m[i].rtyp=rt;  L->m[i].data=h->Data();
7208        ((ring)L->m[i].data)->ref++;
7209      }
7210      else
7211        L->m[i].Copy(h);
7212    }
7213  }
7214  res->data=(char *)L;
7215  return FALSE;
7216}
7217static BOOLEAN jjNAMES0(leftv res, leftv)
7218{
7219  res->data=(void *)ipNameList(IDROOT);
7220  return FALSE;
7221}
7222static BOOLEAN jjOPTION_PL(leftv res, leftv v)
7223{
7224  if(v==NULL)
7225  {
7226    res->data=(char *)showOption();
7227    return FALSE;
7228  }
7229  res->rtyp=NONE;
7230  return setOption(res,v);
7231}
7232static BOOLEAN jjREDUCE4(leftv res, leftv u)
7233{
7234  leftv u1=u;
7235  leftv u2=u1->next;
7236  leftv u3=u2->next;
7237  leftv u4=u3->next;
7238  if((u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD))
7239  {
7240    int save_d=Kstd1_deg;
7241    Kstd1_deg=(int)(long)u3->Data();
7242    kModW=(intvec *)u4->Data();
7243    BITSET save2;
7244    SI_SAVE_OPT2(save2);
7245    si_opt_2|=Sy_bit(V_DEG_STOP);
7246    u2->next=NULL;
7247    BOOLEAN r=jjCALL2ARG(res,u);
7248    kModW=NULL;
7249    Kstd1_deg=save_d;
7250    SI_RESTORE_OPT2(save2);
7251    u->next->next=u3;
7252    return r;
7253  }
7254  else
7255  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7256     (u4->Typ()==INT_CMD))
7257  {
7258    assumeStdFlag(u3);
7259    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7260    {
7261      WerrorS("2nd argument must be a diagonal matrix of units");
7262      return TRUE;
7263    }
7264    res->rtyp=IDEAL_CMD;
7265    res->data=(char*)redNF(
7266                           idCopy((ideal)u3->Data()),
7267                           idCopy((ideal)u1->Data()),
7268                           mp_Copy((matrix)u2->Data(), currRing),
7269                           (int)(long)u4->Data()
7270                          );
7271    return FALSE;
7272  }
7273  else
7274  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7275     (u4->Typ()==INT_CMD))
7276  {
7277    assumeStdFlag(u3);
7278    if(!pIsUnit((poly)u2->Data()))
7279    {
7280      WerrorS("2nd argument must be a unit");
7281      return TRUE;
7282    }
7283    res->rtyp=POLY_CMD;
7284    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7285                           pCopy((poly)u2->Data()),(int)(long)u4->Data());
7286    return FALSE;
7287  }
7288  else
7289  {
7290    Werror("%s(`poly`,`ideal`,`int`,`intvec`) expected",Tok2Cmdname(iiOp));
7291    return TRUE;
7292  }
7293}
7294static BOOLEAN jjREDUCE5(leftv res, leftv u)
7295{
7296  leftv u1=u;
7297  leftv u2=u1->next;
7298  leftv u3=u2->next;
7299  leftv u4=u3->next;
7300  leftv u5=u4->next;
7301  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7302     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7303  {
7304    assumeStdFlag(u3);
7305    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7306    {
7307      WerrorS("2nd argument must be a diagonal matrix of units");
7308      return TRUE;
7309    }
7310    res->rtyp=IDEAL_CMD;
7311    res->data=(char*)redNF(
7312                           idCopy((ideal)u3->Data()),
7313                           idCopy((ideal)u1->Data()),
7314                           mp_Copy((matrix)u2->Data(),currRing),
7315                           (int)(long)u4->Data(),
7316                           (intvec*)u5->Data()
7317                          );
7318    return FALSE;
7319  }
7320  else
7321  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7322     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7323  {
7324    assumeStdFlag(u3);
7325    if(!pIsUnit((poly)u2->Data()))
7326    {
7327      WerrorS("2nd argument must be a unit");
7328      return TRUE;
7329    }
7330    res->rtyp=POLY_CMD;
7331    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7332                           pCopy((poly)u2->Data()),
7333                           (int)(long)u4->Data(),(intvec*)u5->Data());
7334    return FALSE;
7335  }
7336  else
7337  {
7338    Werror("%s(`ideal`,`ideal`,`matrix`,`int`,`intvec`) exppected",
7339           Tok2Cmdname(iiOp));
7340    return TRUE;
7341  }
7342}
7343static BOOLEAN jjRESERVED0(leftv, leftv)
7344{
7345  int i=1;
7346  int nCount = (sArithBase.nCmdUsed-1)/3;
7347  if((3*nCount)<sArithBase.nCmdUsed) nCount++;
7348  //Print("CMDS: %d/%d\n", sArithBase.nCmdUsed,
7349  //      sArithBase.nCmdAllocated);
7350  for(i=0; i<nCount; i++)
7351  {
7352    Print("%-20s",sArithBase.sCmds[i+1].name);
7353    if(i+1+nCount<sArithBase.nCmdUsed)
7354      Print("%-20s",sArithBase.sCmds[i+1+nCount].name);
7355    if(i+1+2*nCount<sArithBase.nCmdUsed)
7356      Print("%-20s",sArithBase.sCmds[i+1+2*nCount].name);
7357    //if ((i%3)==1) PrintLn();
7358    PrintLn();
7359  }
7360  PrintLn();
7361  printBlackboxTypes();
7362  return FALSE;
7363}
7364static BOOLEAN jjSTRING_PL(leftv res, leftv v)
7365{
7366  if (v == NULL)
7367  {
7368    res->data = omStrDup("");
7369    return FALSE;
7370  }
7371  int n = v->listLength();
7372  if (n == 1)
7373  {
7374    res->data = v->String();
7375    return FALSE;
7376  }
7377
7378  char** slist = (char**) omAlloc(n*sizeof(char*));
7379  int i, j;
7380
7381  for (i=0, j=0; i<n; i++, v = v ->next)
7382  {
7383    slist[i] = v->String();
7384    assume(slist[i] != NULL);
7385    j+=strlen(slist[i]);
7386  }
7387  char* s = (char*) omAlloc((j+1)*sizeof(char));
7388  *s='\0';
7389  for (i=0;i<n;i++)
7390  {
7391    strcat(s, slist[i]);
7392    omFree(slist[i]);
7393  }
7394  omFreeSize(slist, n*sizeof(char*));
7395  res->data = s;
7396  return FALSE;
7397}
7398static BOOLEAN jjTEST(leftv, leftv v)
7399{
7400  do
7401  {
7402    if (v->Typ()!=INT_CMD)
7403      return TRUE;
7404    test_cmd((int)(long)v->Data());
7405    v=v->next;
7406  }
7407  while (v!=NULL);
7408  return FALSE;
7409}
7410
7411#if defined(__alpha) && !defined(linux)
7412extern "C"
7413{
7414  void usleep(unsigned long usec);
7415};
7416#endif
7417static BOOLEAN jjFactModD_M(leftv res, leftv v)
7418{
7419  /* compute two factors of h(x,y) modulo x^(d+1) in K[[x]][y],
7420     see a detailed documentation in /kernel/linearAlgebra.h
7421
7422     valid argument lists:
7423     - (poly h, int d),
7424     - (poly h, int d, poly f0, poly g0),       optional: factors of h(0,y),
7425     - (poly h, int d, int xIndex, int yIndex), optional: indices of vars x & y
7426                                                          in list of ring vars,
7427     - (poly h, int d, poly f0, poly g0, int xIndex, int yIndec),
7428                                                optional: all 4 optional args
7429     (The defaults are xIndex = 1, yIndex = 2, f0 and g0 polynomials as found
7430      by singclap_factorize in the case that HAVE_FACTORY is defined and h(0, y)
7431      has exactly two distinct monic factors [possibly with exponent > 1].)
7432     result:
7433     - list with the two factors f and g such that
7434       h(x,y) = f(x,y)*g(x,y) mod x^(d+1)   */
7435
7436  poly h      = NULL;
7437  int  d      =    1;
7438  poly f0     = NULL;
7439  poly g0     = NULL;
7440  int  xIndex =    1;   /* default index if none provided */
7441  int  yIndex =    2;   /* default index if none provided */
7442
7443  leftv u = v; int factorsGiven = 0;
7444  if ((u == NULL) || (u->Typ() != POLY_CMD))
7445  {
7446    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7447    return TRUE;
7448  }
7449  else h = (poly)u->Data();
7450  u = u->next;
7451  if ((u == NULL) || (u->Typ() != INT_CMD))
7452  {
7453    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7454    return TRUE;
7455  }
7456  else d = (int)(long)u->Data();
7457  u = u->next;
7458  if ((u != NULL) && (u->Typ() == POLY_CMD))
7459  {
7460    if ((u->next == NULL) || (u->next->Typ() != POLY_CMD))
7461    {
7462      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7463      return TRUE;
7464    }
7465    else
7466    {
7467      f0 = (poly)u->Data();
7468      g0 = (poly)u->next->Data();
7469      factorsGiven = 1;
7470      u = u->next->next;
7471    }
7472  }
7473  if ((u != NULL) && (u->Typ() == INT_CMD))
7474  {
7475    if ((u->next == NULL) || (u->next->Typ() != INT_CMD))
7476    {
7477      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7478      return TRUE;
7479    }
7480    else
7481    {
7482      xIndex = (int)(long)u->Data();
7483      yIndex = (int)(long)u->next->Data();
7484      u = u->next->next;
7485    }
7486  }
7487  if (u != NULL)
7488  {
7489    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7490    return TRUE;
7491  }
7492
7493  /* checks for provided arguments */
7494  if (pIsConstant(h) || (factorsGiven && (pIsConstant(f0) || pIsConstant(g0))))
7495  {
7496    WerrorS("expected non-constant polynomial argument(s)");
7497    return TRUE;
7498  }
7499  int n = rVar(currRing);
7500  if ((xIndex < 1) || (n < xIndex))
7501  {
7502    Werror("index for variable x (%d) out of range [1..%d]", xIndex, n);
7503    return TRUE;
7504  }
7505  if ((yIndex < 1) || (n < yIndex))
7506  {
7507    Werror("index for variable y (%d) out of range [1..%d]", yIndex, n);
7508    return TRUE;
7509  }
7510  if (xIndex == yIndex)
7511  {
7512    WerrorS("expected distinct indices for variables x and y");
7513    return TRUE;
7514  }
7515
7516  /* computation of f0 and g0 if missing */
7517  if (factorsGiven == 0)
7518  {
7519#ifdef HAVE_FACTORY
7520    poly h0 = pSubst(pCopy(h), xIndex, NULL);
7521    intvec* v = NULL;
7522    ideal i = singclap_factorize(h0, &v, 0,currRing);
7523
7524    ivTest(v);
7525
7526    if (i == NULL) return TRUE;
7527
7528    idTest(i);
7529
7530    if ((v->rows() != 3) || ((*v)[0] =! 1) || (!nIsOne(pGetCoeff(i->m[0]))))
7531    {
7532      WerrorS("expected h(0,y) to have exactly two distinct monic factors");
7533      return TRUE;
7534    }
7535    f0 = pPower(pCopy(i->m[1]), (*v)[1]);
7536    g0 = pPower(pCopy(i->m[2]), (*v)[2]);
7537    idDelete(&i);
7538#else
7539    WerrorS("cannot factorize h(0,y) due to missing module 'factory'");
7540    return TRUE;
7541#endif
7542  }
7543
7544  poly f; poly g;
7545  henselFactors(xIndex, yIndex, h, f0, g0, d, f, g);
7546  lists L = (lists)omAllocBin(slists_bin);
7547  L->Init(2);
7548  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
7549  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
7550  res->rtyp = LIST_CMD;
7551  res->data = (char*)L;
7552  return FALSE;
7553}
7554static BOOLEAN jjSTATUS_M(leftv res, leftv v)
7555{
7556  if ((v->Typ() != LINK_CMD) ||
7557      (v->next->Typ() != STRING_CMD) ||
7558      (v->next->next->Typ() != STRING_CMD) ||
7559      (v->next->next->next->Typ() != INT_CMD))
7560    return TRUE;
7561  jjSTATUS3(res, v, v->next, v->next->next);
7562#if defined(HAVE_USLEEP)
7563  if (((long) res->data) == 0L)
7564  {
7565    int i_s = (int)(long) v->next->next->next->Data();
7566    if (i_s > 0)
7567    {
7568      usleep((int)(long) v->next->next->next->Data());
7569      jjSTATUS3(res, v, v->next, v->next->next);
7570    }
7571  }
7572#elif defined(HAVE_SLEEP)
7573  if (((int) res->data) == 0)
7574  {
7575    int i_s = (int) v->next->next->next->Data();
7576    if (i_s > 0)
7577    {
7578      sleep((is - 1)/1000000 + 1);
7579      jjSTATUS3(res, v, v->next, v->next->next);
7580    }
7581  }
7582#endif
7583  return FALSE;
7584}
7585static BOOLEAN jjSUBST_M(leftv res, leftv u)
7586{
7587  leftv v = u->next; // number of args > 0
7588  if (v==NULL) return TRUE;
7589  leftv w = v->next;
7590  if (w==NULL) return TRUE;
7591  leftv rest = w->next;;
7592
7593  u->next = NULL;
7594  v->next = NULL;
7595  w->next = NULL;
7596  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
7597  if ((rest!=NULL) && (!b))
7598  {
7599    sleftv tmp_res;
7600    leftv tmp_next=res->next;
7601    res->next=rest;
7602    memset(&tmp_res,0,sizeof(tmp_res));
7603    b = iiExprArithM(&tmp_res,res,iiOp);
7604    memcpy(res,&tmp_res,sizeof(tmp_res));
7605    res->next=tmp_next;
7606  }
7607  u->next = v;
7608  v->next = w;
7609  // rest was w->next, but is already cleaned
7610  return b;
7611}
7612static BOOLEAN jjQRDS(leftv res, leftv INPUT)
7613{
7614  if ((INPUT->Typ() != MATRIX_CMD) ||
7615      (INPUT->next->Typ() != NUMBER_CMD) ||
7616      (INPUT->next->next->Typ() != NUMBER_CMD) ||
7617      (INPUT->next->next->next->Typ() != NUMBER_CMD))
7618  {
7619    WerrorS("expected (matrix, number, number, number) as arguments");
7620    return TRUE;
7621  }
7622  leftv u = INPUT; leftv v = u->next; leftv w = v->next; leftv x = w->next;
7623  res->data = (char *)qrDoubleShift((matrix)(u->Data()),
7624                                    (number)(v->Data()),
7625                                    (number)(w->Data()),
7626                                    (number)(x->Data()));
7627  return FALSE;
7628}
7629static BOOLEAN jjSTD_HILB_WP(leftv res, leftv INPUT)
7630{ ideal result;
7631  leftv u = INPUT;    /* an ideal, weighted homogeneous and standard */
7632  leftv v = u->next;  /* one additional polynomial or ideal */
7633  leftv h = v->next;  /* Hilbert vector */
7634  leftv w = h->next;  /* weight vector */
7635  assumeStdFlag(u);
7636  ideal i1=(ideal)(u->Data());
7637  ideal i0;
7638  if (((u->Typ()!=IDEAL_CMD)&&(u->Typ()!=MODUL_CMD))
7639  || (h->Typ()!=INTVEC_CMD)
7640  || (w->Typ()!=INTVEC_CMD))
7641  {
7642    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7643    return TRUE;
7644  }
7645  intvec *vw=(intvec *)w->Data(); // weights of vars
7646  /* merging std_hilb_w and std_1 */
7647  if (vw->length()!=currRing->N)
7648  {
7649    Werror("%d weights for %d variables",vw->length(),currRing->N);
7650    return TRUE;
7651  }
7652  int r=v->Typ();
7653  BOOLEAN cleanup_i0=FALSE;
7654  if ((r==POLY_CMD) ||(r==VECTOR_CMD))
7655  {
7656    i0=idInit(1,i1->rank);
7657    i0->m[0]=(poly)v->Data();
7658    cleanup_i0=TRUE;
7659  }
7660  else if (r==IDEAL_CMD)/* IDEAL */
7661  {
7662    i0=(ideal)v->Data();
7663  }
7664  else
7665  {
7666    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7667    return TRUE;
7668  }
7669  int ii0=idElem(i0);
7670  i1 = idSimpleAdd(i1,i0);
7671  if (cleanup_i0)
7672  {
7673    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
7674    idDelete(&i0);
7675  }
7676  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
7677  tHomog hom=testHomog;
7678  /* u_id from jjSTD_W is now i1 as in jjSTD_1 */
7679  if (ww!=NULL)
7680  {
7681    if (!idTestHomModule(i1,currQuotient,ww))
7682    {
7683      WarnS("wrong weights");
7684      ww=NULL;
7685    }
7686    else
7687    {
7688      ww=ivCopy(ww);
7689      hom=isHomog;
7690    }
7691  }
7692  BITSET save1;
7693  SI_SAVE_OPT1(save1);
7694  si_opt_1|=Sy_bit(OPT_SB_1);
7695  result=kStd(i1,
7696              currQuotient,
7697              hom,
7698              &ww,                  // module weights
7699              (intvec *)h->Data(),  // hilbert series
7700              0,                    // syzComp, whatever it is...
7701              IDELEMS(i1)-ii0,      // new ideal
7702              vw);                  // weights of vars
7703  SI_RESTORE_OPT1(save1);
7704  idDelete(&i1);
7705  idSkipZeroes(result);
7706  res->data = (char *)result;
7707  if (!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
7708  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
7709  return FALSE;
7710}
7711
7712
7713static Subexpr jjMakeSub(leftv e)
7714{
7715  assume( e->Typ()==INT_CMD );
7716  Subexpr r=(Subexpr)omAlloc0Bin(sSubexpr_bin);
7717  r->start =(int)(long)e->Data();
7718  return r;
7719}
7720#define D(A)    (A)
7721#define NULL_VAL NULL
7722#define IPARITH
7723#include "table.h"
7724
7725#include "iparith.inc"
7726
7727/*=================== operations with 2 args. ============================*/
7728/* must be ordered: first operations for chars (infix ops),
7729 * then alphabetically */
7730
7731BOOLEAN iiExprArith2(leftv res, leftv a, int op, leftv b, BOOLEAN proccall)
7732{
7733  memset(res,0,sizeof(sleftv));
7734  BOOLEAN call_failed=FALSE;
7735
7736  if (!errorreported)
7737  {
7738#ifdef SIQ
7739    if (siq>0)
7740    {
7741      //Print("siq:%d\n",siq);
7742      command d=(command)omAlloc0Bin(sip_command_bin);
7743      memcpy(&d->arg1,a,sizeof(sleftv));
7744      //a->Init();
7745      memcpy(&d->arg2,b,sizeof(sleftv));
7746      //b->Init();
7747      d->argc=2;
7748      d->op=op;
7749      res->data=(char *)d;
7750      res->rtyp=COMMAND;
7751      return FALSE;
7752    }
7753#endif
7754    int at=a->Typ();
7755    int bt=b->Typ();
7756    if (at>MAX_TOK)
7757    {
7758      blackbox *bb=getBlackboxStuff(at);
7759      if (bb!=NULL) return bb->blackbox_Op2(op,res,a,b);
7760      else          return TRUE;
7761    }
7762    else if ((bt>MAX_TOK)&&(op!='('))
7763    {
7764      blackbox *bb=getBlackboxStuff(bt);
7765      if (bb!=NULL) return bb->blackbox_Op2(op,res,a,b);
7766      else          return TRUE;
7767    }
7768    int i=iiTabIndex(dArithTab2,JJTAB2LEN,op);
7769    int index=i;
7770
7771    iiOp=op;
7772    while (dArith2[i].cmd==op)
7773    {
7774      if ((at==dArith2[i].arg1)
7775      && (bt==dArith2[i].arg2))
7776      {
7777        res->rtyp=dArith2[i].res;
7778        if (currRing!=NULL)
7779        {
7780          if (check_valid(dArith2[i].valid_for,op)) break;
7781        }
7782        if (TEST_V_ALLWARN)
7783          Print("call %s(%s,%s)\n",iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt));
7784        if ((call_failed=dArith2[i].p(res,a,b)))
7785        {
7786          break;// leave loop, goto error handling
7787        }
7788        a->CleanUp();
7789        b->CleanUp();
7790        //Print("op: %d,result typ:%d\n",op,res->rtyp);
7791        return FALSE;
7792      }
7793      i++;
7794    }
7795    // implicite type conversion ----------------------------------------------
7796    if (dArith2[i].cmd!=op)
7797    {
7798      int ai,bi;
7799      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7800      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
7801      BOOLEAN failed=FALSE;
7802      i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7803      //Print("op: %c, type: %s %s\n",op,Tok2Cmdname(at),Tok2Cmdname(bt));
7804      while (dArith2[i].cmd==op)
7805      {
7806        //Print("test %s %s\n",Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
7807        if ((ai=iiTestConvert(at,dArith2[i].arg1))!=0)
7808        {
7809          if ((bi=iiTestConvert(bt,dArith2[i].arg2))!=0)
7810          {
7811            res->rtyp=dArith2[i].res;
7812            if (currRing!=NULL)
7813            {
7814              if (check_valid(dArith2[i].valid_for,op)) break;
7815            }
7816            if (TEST_V_ALLWARN)
7817              Print("call %s(%s,%s)\n",iiTwoOps(op),
7818              Tok2Cmdname(an->rtyp),Tok2Cmdname(bn->rtyp));
7819            failed= ((iiConvert(at,dArith2[i].arg1,ai,a,an))
7820            || (iiConvert(bt,dArith2[i].arg2,bi,b,bn))
7821            || (call_failed=dArith2[i].p(res,an,bn)));
7822            // everything done, clean up temp. variables
7823            if (failed)
7824            {
7825              // leave loop, goto error handling
7826              break;
7827            }
7828            else
7829            {
7830              // everything ok, clean up and return
7831              an->CleanUp();
7832              bn->CleanUp();
7833              omFreeBin((ADDRESS)an, sleftv_bin);
7834              omFreeBin((ADDRESS)bn, sleftv_bin);
7835              a->CleanUp();
7836              b->CleanUp();
7837              return FALSE;
7838            }
7839          }
7840        }
7841        i++;
7842      }
7843      an->CleanUp();
7844      bn->CleanUp();
7845      omFreeBin((ADDRESS)an, sleftv_bin);
7846      omFreeBin((ADDRESS)bn, sleftv_bin);
7847    }
7848    // error handling ---------------------------------------------------
7849    const char *s=NULL;
7850    if (!errorreported)
7851    {
7852      if ((at==0) && (a->Fullname()!=sNoName))
7853      {
7854        s=a->Fullname();
7855      }
7856      else if ((bt==0) && (b->Fullname()!=sNoName))
7857      {
7858        s=b->Fullname();
7859      }
7860      if (s!=NULL)
7861        Werror("`%s` is not defined",s);
7862      else
7863      {
7864        i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7865        s = iiTwoOps(op);
7866        if (proccall)
7867        {
7868          Werror("%s(`%s`,`%s`) failed"
7869                ,s,Tok2Cmdname(at),Tok2Cmdname(bt));
7870        }
7871        else
7872        {
7873          Werror("`%s` %s `%s` failed"
7874                ,Tok2Cmdname(at),s,Tok2Cmdname(bt));
7875        }
7876        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
7877        {
7878          while (dArith2[i].cmd==op)
7879          {
7880            if(((at==dArith2[i].arg1)||(bt==dArith2[i].arg2))
7881            && (dArith2[i].res!=0)
7882            && (dArith2[i].p!=jjWRONG2))
7883            {
7884              if (proccall)
7885                Werror("expected %s(`%s`,`%s`)"
7886                  ,s,Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
7887              else
7888                Werror("expected `%s` %s `%s`"
7889                  ,Tok2Cmdname(dArith2[i].arg1),s,Tok2Cmdname(dArith2[i].arg2));
7890            }
7891            i++;
7892          }
7893        }
7894      }
7895    }
7896    res->rtyp = UNKNOWN;
7897  }
7898  a->CleanUp();
7899  b->CleanUp();
7900  return TRUE;
7901}
7902
7903/*==================== operations with 1 arg. ===============================*/
7904/* must be ordered: first operations for chars (infix ops),
7905 * then alphabetically */
7906
7907BOOLEAN iiExprArith1(leftv res, leftv a, int op)
7908{
7909  memset(res,0,sizeof(sleftv));
7910  BOOLEAN call_failed=FALSE;
7911
7912  if (!errorreported)
7913  {
7914#ifdef SIQ
7915    if (siq>0)
7916    {
7917      //Print("siq:%d\n",siq);
7918      command d=(command)omAlloc0Bin(sip_command_bin);
7919      memcpy(&d->arg1,a,sizeof(sleftv));
7920      //a->Init();
7921      d->op=op;
7922      d->argc=1;
7923      res->data=(char *)d;
7924      res->rtyp=COMMAND;
7925      return FALSE;
7926    }
7927#endif
7928    int at=a->Typ();
7929    if (at>MAX_TOK)
7930    {
7931      blackbox *bb=getBlackboxStuff(at);
7932      if (bb!=NULL) return bb->blackbox_Op1(op,res,a);
7933      else          return TRUE;
7934    }
7935
7936    BOOLEAN failed=FALSE;
7937    iiOp=op;
7938    int i=iiTabIndex(dArithTab1,JJTAB1LEN,op);
7939    int ti = i;
7940    while (dArith1[i].cmd==op)
7941    {
7942      if (at==dArith1[i].arg)
7943      {
7944        int r=res->rtyp=dArith1[i].res;
7945        if (currRing!=NULL)
7946        {
7947          if (check_valid(dArith1[i].valid_for,op)) break;
7948        }
7949        if (TEST_V_ALLWARN)
7950          Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
7951        if (r<0)
7952        {
7953          res->rtyp=-r;
7954          #ifdef PROC_BUG
7955          dArith1[i].p(res,a);
7956          #else
7957          res->data=(char *)((Proc1)dArith1[i].p)((char *)a->Data());
7958          #endif
7959        }
7960        else if ((call_failed=dArith1[i].p(res,a)))
7961        {
7962          break;// leave loop, goto error handling
7963        }
7964        if (a->Next()!=NULL)
7965        {
7966          res->next=(leftv)omAllocBin(sleftv_bin);
7967          failed=iiExprArith1(res->next,a->next,op);
7968        }
7969        a->CleanUp();
7970        return failed;
7971      }
7972      i++;
7973    }
7974    // implicite type conversion --------------------------------------------
7975    if (dArith1[i].cmd!=op)
7976    {
7977      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7978      i=ti;
7979      //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
7980      while (dArith1[i].cmd==op)
7981      {
7982        int ai;
7983        //Print("test %s\n",Tok2Cmdname(dArith1[i].arg));
7984        if ((ai=iiTestConvert(at,dArith1[i].arg))!=0)
7985        {
7986          int r=res->rtyp=dArith1[i].res;
7987          if (currRing!=NULL)
7988          {
7989            if (check_valid(dArith1[i].valid_for,op)) break;
7990          }
7991          if (r<0)
7992          {
7993            res->rtyp=-r;
7994            failed= iiConvert(at,dArith1[i].arg,ai,a,an);
7995            if (!failed)
7996            {
7997              #ifdef PROC_BUG
7998              dArith1[i].p(res,a);
7999              #else
8000              res->data=(char *)((Proc1)dArith1[i].p)((char *)an->Data());
8001              #endif
8002            }
8003          }
8004          else
8005          {
8006            failed= ((iiConvert(at,dArith1[i].arg,ai,a,an))
8007            || (call_failed=dArith1[i].p(res,an)));
8008          }
8009          // everything done, clean up temp. variables
8010          if (failed)
8011          {
8012            // leave loop, goto error handling
8013            break;
8014          }
8015          else
8016          {
8017            if (TEST_V_ALLWARN)
8018              Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(an->rtyp));
8019            if (an->Next() != NULL)
8020            {
8021              res->next = (leftv)omAllocBin(sleftv_bin);
8022              failed=iiExprArith1(res->next,an->next,op);
8023            }
8024            // everything ok, clean up and return
8025            an->CleanUp();
8026            omFreeBin((ADDRESS)an, sleftv_bin);
8027            a->CleanUp();
8028            return failed;
8029          }
8030        }
8031        i++;
8032      }
8033      an->CleanUp();
8034      omFreeBin((ADDRESS)an, sleftv_bin);
8035    }
8036    // error handling
8037    if (!errorreported)
8038    {
8039      if ((at==0) && (a->Fullname()!=sNoName))
8040      {
8041        Werror("`%s` is not defined",a->Fullname());
8042      }
8043      else
8044      {
8045        i=ti;
8046        const char *s = iiTwoOps(op);
8047        Werror("%s(`%s`) failed"
8048                ,s,Tok2Cmdname(at));
8049        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8050        {
8051          while (dArith1[i].cmd==op)
8052          {
8053            if ((dArith1[i].res!=0)
8054            && (dArith1[i].p!=jjWRONG))
8055              Werror("expected %s(`%s`)"
8056                ,s,Tok2Cmdname(dArith1[i].arg));
8057            i++;
8058          }
8059        }
8060      }
8061    }
8062    res->rtyp = UNKNOWN;
8063  }
8064  a->CleanUp();
8065  return TRUE;
8066}
8067
8068/*=================== operations with 3 args. ============================*/
8069/* must be ordered: first operations for chars (infix ops),
8070 * then alphabetically */
8071
8072BOOLEAN iiExprArith3(leftv res, int op, leftv a, leftv b, leftv c)
8073{
8074  memset(res,0,sizeof(sleftv));
8075  BOOLEAN call_failed=FALSE;
8076
8077  if (!errorreported)
8078  {
8079#ifdef SIQ
8080    if (siq>0)
8081    {
8082      //Print("siq:%d\n",siq);
8083      command d=(command)omAlloc0Bin(sip_command_bin);
8084      memcpy(&d->arg1,a,sizeof(sleftv));
8085      //a->Init();
8086      memcpy(&d->arg2,b,sizeof(sleftv));
8087      //b->Init();
8088      memcpy(&d->arg3,c,sizeof(sleftv));
8089      //c->Init();
8090      d->op=op;
8091      d->argc=3;
8092      res->data=(char *)d;
8093      res->rtyp=COMMAND;
8094      return FALSE;
8095    }
8096#endif
8097    int at=a->Typ();
8098    if (at>MAX_TOK)
8099    {
8100      blackbox *bb=getBlackboxStuff(at);
8101      if (bb!=NULL) return bb->blackbox_Op3(op,res,a,b,c);
8102      else          return TRUE;
8103    }
8104    int bt=b->Typ();
8105    int ct=c->Typ();
8106
8107    iiOp=op;
8108    int i=0;
8109    while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8110    while (dArith3[i].cmd==op)
8111    {
8112      if ((at==dArith3[i].arg1)
8113      && (bt==dArith3[i].arg2)
8114      && (ct==dArith3[i].arg3))
8115      {
8116        res->rtyp=dArith3[i].res;
8117        if (currRing!=NULL)
8118        {
8119          if (check_valid(dArith3[i].valid_for,op)) break;
8120        }
8121        if (TEST_V_ALLWARN)
8122          Print("call %s(%s,%s,%s)\n",
8123            iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8124        if ((call_failed=dArith3[i].p(res,a,b,c)))
8125        {
8126          break;// leave loop, goto error handling
8127        }
8128        a->CleanUp();
8129        b->CleanUp();
8130        c->CleanUp();
8131        return FALSE;
8132      }
8133      i++;
8134    }
8135    // implicite type conversion ----------------------------------------------
8136    if (dArith3[i].cmd!=op)
8137    {
8138      int ai,bi,ci;
8139      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8140      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
8141      leftv cn = (leftv)omAlloc0Bin(sleftv_bin);
8142      BOOLEAN failed=FALSE;
8143      i=0;
8144      while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8145      while (dArith3[i].cmd==op)
8146      {
8147        if ((ai=iiTestConvert(at,dArith3[i].arg1))!=0)
8148        {
8149          if ((bi=iiTestConvert(bt,dArith3[i].arg2))!=0)
8150          {
8151            if ((ci=iiTestConvert(ct,dArith3[i].arg3))!=0)
8152            {
8153              res->rtyp=dArith3[i].res;
8154              if (currRing!=NULL)
8155              {
8156                if (check_valid(dArith3[i].valid_for,op)) break;
8157              }
8158              if (TEST_V_ALLWARN)
8159                Print("call %s(%s,%s,%s)\n",
8160                  iiTwoOps(op),Tok2Cmdname(an->rtyp),
8161                  Tok2Cmdname(bn->rtyp),Tok2Cmdname(cn->rtyp));
8162              failed= ((iiConvert(at,dArith3[i].arg1,ai,a,an))
8163                || (iiConvert(bt,dArith3[i].arg2,bi,b,bn))
8164                || (iiConvert(ct,dArith3[i].arg3,ci,c,cn))
8165                || (call_failed=dArith3[i].p(res,an,bn,cn)));
8166              // everything done, clean up temp. variables
8167              if (failed)
8168              {
8169                // leave loop, goto error handling
8170                break;
8171              }
8172              else
8173              {
8174                // everything ok, clean up and return
8175                an->CleanUp();
8176                bn->CleanUp();
8177                cn->CleanUp();
8178                omFreeBin((ADDRESS)an, sleftv_bin);
8179                omFreeBin((ADDRESS)bn, sleftv_bin);
8180                omFreeBin((ADDRESS)cn, sleftv_bin);
8181                a->CleanUp();
8182                b->CleanUp();
8183                c->CleanUp();
8184        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8185                return FALSE;
8186              }
8187            }
8188          }
8189        }
8190        i++;
8191      }
8192      an->CleanUp();
8193      bn->CleanUp();
8194      cn->CleanUp();
8195      omFreeBin((ADDRESS)an, sleftv_bin);
8196      omFreeBin((ADDRESS)bn, sleftv_bin);
8197      omFreeBin((ADDRESS)cn, sleftv_bin);
8198    }
8199    // error handling ---------------------------------------------------
8200    if (!errorreported)
8201    {
8202      const char *s=NULL;
8203      if ((at==0) && (a->Fullname()!=sNoName))
8204      {
8205        s=a->Fullname();
8206      }
8207      else if ((bt==0) && (b->Fullname()!=sNoName))
8208      {
8209        s=b->Fullname();
8210      }
8211      else if ((ct==0) && (c->Fullname()!=sNoName))
8212      {
8213        s=c->Fullname();
8214      }
8215      if (s!=NULL)
8216        Werror("`%s` is not defined",s);
8217      else
8218      {
8219        i=0;
8220        while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8221        const char *s = iiTwoOps(op);
8222        Werror("%s(`%s`,`%s`,`%s`) failed"
8223                ,s,Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8224        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8225        {
8226          while (dArith3[i].cmd==op)
8227          {
8228            if(((at==dArith3[i].arg1)
8229            ||(bt==dArith3[i].arg2)
8230            ||(ct==dArith3[i].arg3))
8231            && (dArith3[i].res!=0))
8232            {
8233              Werror("expected %s(`%s`,`%s`,`%s`)"
8234                  ,s,Tok2Cmdname(dArith3[i].arg1)
8235                  ,Tok2Cmdname(dArith3[i].arg2)
8236                  ,Tok2Cmdname(dArith3[i].arg3));
8237            }
8238            i++;
8239          }
8240        }
8241      }
8242    }
8243    res->rtyp = UNKNOWN;
8244  }
8245  a->CleanUp();
8246  b->CleanUp();
8247  c->CleanUp();
8248        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8249  return TRUE;
8250}
8251/*==================== operations with many arg. ===============================*/
8252/* must be ordered: first operations for chars (infix ops),
8253 * then alphabetically */
8254
8255BOOLEAN jjANY2LIST(leftv res, leftv v, int cnt)
8256{
8257  // cnt = 0: all
8258  // cnt = 1: only first one
8259  leftv next;
8260  BOOLEAN failed = TRUE;
8261  if(v==NULL) return failed;
8262  res->rtyp = LIST_CMD;
8263  if(cnt) v->next = NULL;
8264  next = v->next;             // saving next-pointer
8265  failed = jjLIST_PL(res, v);
8266  v->next = next;             // writeback next-pointer
8267  return failed;
8268}
8269
8270BOOLEAN iiExprArithM(leftv res, leftv a, int op)
8271{
8272  memset(res,0,sizeof(sleftv));
8273
8274  if (!errorreported)
8275  {
8276#ifdef SIQ
8277    if (siq>0)
8278    {
8279      //Print("siq:%d\n",siq);
8280      command d=(command)omAlloc0Bin(sip_command_bin);
8281      d->op=op;
8282      res->data=(char *)d;
8283      if (a!=NULL)
8284      {
8285        d->argc=a->listLength();
8286        // else : d->argc=0;
8287        memcpy(&d->arg1,a,sizeof(sleftv));
8288        switch(d->argc)
8289        {
8290          case 3:
8291            memcpy(&d->arg3,a->next->next,sizeof(sleftv));
8292            a->next->next->Init();
8293            /* no break */
8294          case 2:
8295            memcpy(&d->arg2,a->next,sizeof(sleftv));
8296            a->next->Init();
8297            a->next->next=d->arg2.next;
8298            d->arg2.next=NULL;
8299            /* no break */
8300          case 1:
8301            a->Init();
8302            a->next=d->arg1.next;
8303            d->arg1.next=NULL;
8304        }
8305        if (d->argc>3) a->next=NULL;
8306        a->name=NULL;
8307        a->rtyp=0;
8308        a->data=NULL;
8309        a->e=NULL;
8310        a->attribute=NULL;
8311        a->CleanUp();
8312      }
8313      res->rtyp=COMMAND;
8314      return FALSE;
8315    }
8316#endif
8317    if ((a!=NULL) && (a->Typ()>MAX_TOK))
8318    {
8319      blackbox *bb=getBlackboxStuff(a->Typ());
8320      if (bb!=NULL) return bb->blackbox_OpM(op,res,a);
8321      else          return TRUE;
8322    }
8323    BOOLEAN failed=FALSE;
8324    int args=0;
8325    if (a!=NULL) args=a->listLength();
8326
8327    iiOp=op;
8328    int i=0;
8329    while ((dArithM[i].cmd!=op)&&(dArithM[i].cmd!=0)) i++;
8330    while (dArithM[i].cmd==op)
8331    {
8332      if ((args==dArithM[i].number_of_args)
8333      || (dArithM[i].number_of_args==-1)
8334      || ((dArithM[i].number_of_args==-2)&&(args>0)))
8335      {
8336        res->rtyp=dArithM[i].res;
8337        if (currRing!=NULL)
8338        {
8339          if (check_valid(dArithM[i].valid_for,op)) break;
8340        }
8341        if (TEST_V_ALLWARN)
8342          Print("call %s(... (%d args))\n", iiTwoOps(op),args);
8343        if (dArithM[i].p(res,a))
8344        {
8345          break;// leave loop, goto error handling
8346        }
8347        if (a!=NULL) a->CleanUp();
8348        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8349        return failed;
8350      }
8351      i++;
8352    }
8353    // error handling
8354    if (!errorreported)
8355    {
8356      if ((args>0) && (a->rtyp==0) && (a->Name()!=sNoName))
8357      {
8358        Werror("`%s` is not defined",a->Fullname());
8359      }
8360      else
8361      {
8362        const char *s = iiTwoOps(op);
8363        Werror("%s(...) failed",s);
8364      }
8365    }
8366    res->rtyp = UNKNOWN;
8367  }
8368  if (a!=NULL) a->CleanUp();
8369        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8370  return TRUE;
8371}
8372
8373/*=================== general utilities ============================*/
8374int IsCmd(const char *n, int & tok)
8375{
8376  int i;
8377  int an=1;
8378  int en=sArithBase.nLastIdentifier;
8379
8380  loop
8381  //for(an=0; an<sArithBase.nCmdUsed; )
8382  {
8383    if(an>=en-1)
8384    {
8385      if (strcmp(n, sArithBase.sCmds[an].name) == 0)
8386      {
8387        i=an;
8388        break;
8389      }
8390      else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
8391      {
8392        i=en;
8393        break;
8394      }
8395      else
8396      {
8397        // -- blackbox extensions:
8398        // return 0;
8399        return blackboxIsCmd(n,tok);
8400      }
8401    }
8402    i=(an+en)/2;
8403    if (*n < *(sArithBase.sCmds[i].name))
8404    {
8405      en=i-1;
8406    }
8407    else if (*n > *(sArithBase.sCmds[i].name))
8408    {
8409      an=i+1;
8410    }
8411    else
8412    {
8413      int v=strcmp(n,sArithBase.sCmds[i].name);
8414      if(v<0)
8415      {
8416        en=i-1;
8417      }
8418      else if(v>0)
8419      {
8420        an=i+1;
8421      }
8422      else /*v==0*/
8423      {
8424        break;
8425      }
8426    }
8427  }
8428  lastreserved=sArithBase.sCmds[i].name;
8429  tok=sArithBase.sCmds[i].tokval;
8430  if(sArithBase.sCmds[i].alias==2)
8431  {
8432    Warn("outdated identifier `%s` used - please change your code",
8433    sArithBase.sCmds[i].name);
8434    sArithBase.sCmds[i].alias=1;
8435  }
8436  if (currRingHdl==NULL)
8437  {
8438    #ifdef SIQ
8439    if (siq<=0)
8440    {
8441    #endif
8442      if ((tok>=BEGIN_RING) && (tok<=END_RING))
8443      {
8444        WerrorS("no ring active");
8445        return 0;
8446      }
8447    #ifdef SIQ
8448    }
8449    #endif
8450  }
8451  if (!expected_parms)
8452  {
8453    switch (tok)
8454    {
8455      case IDEAL_CMD:
8456      case INT_CMD:
8457      case INTVEC_CMD:
8458      case MAP_CMD:
8459      case MATRIX_CMD:
8460      case MODUL_CMD:
8461      case POLY_CMD:
8462      case PROC_CMD:
8463      case RING_CMD:
8464      case STRING_CMD:
8465        cmdtok = tok;
8466        break;
8467    }
8468  }
8469  return sArithBase.sCmds[i].toktype;
8470}
8471static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op)
8472{
8473  // user defined types are not in the pre-computed table:
8474  if (op>MAX_TOK) return 0;
8475
8476  int a=0;
8477  int e=len;
8478  int p=len/2;
8479  do
8480  {
8481     if (op==dArithTab[p].cmd) return dArithTab[p].start;
8482     if (op<dArithTab[p].cmd) e=p-1;
8483     else   a = p+1;
8484     p=a+(e-a)/2;
8485  }
8486  while ( a <= e);
8487
8488  // catch missing a cmd:
8489  assume(0);
8490  return 0;
8491}
8492
8493const char * Tok2Cmdname(int tok)
8494{
8495  int i = 0;
8496  if (tok <= 0)
8497  {
8498    return sArithBase.sCmds[0].name;
8499  }
8500  if (tok==ANY_TYPE) return "any_type";
8501  if (tok==COMMAND) return "command";
8502  if (tok==NONE) return "nothing";
8503  //if (tok==IFBREAK) return "if_break";
8504  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
8505  //if (tok==ORDER_VECTOR) return "ordering";
8506  //if (tok==REF_VAR) return "ref";
8507  //if (tok==OBJECT) return "object";
8508  //if (tok==PRINT_EXPR) return "print_expr";
8509  if (tok==IDHDL) return "identifier";
8510  if (tok>MAX_TOK) return getBlackboxName(tok);
8511  for(i=0; i<sArithBase.nCmdUsed; i++)
8512    //while (sArithBase.sCmds[i].tokval!=0)
8513  {
8514    if ((sArithBase.sCmds[i].tokval == tok)&&
8515        (sArithBase.sCmds[i].alias==0))
8516    {
8517      return sArithBase.sCmds[i].name;
8518    }
8519  }
8520  return sArithBase.sCmds[0].name;
8521}
8522
8523
8524/*---------------------------------------------------------------------*/
8525/**
8526 * @brief compares to entry of cmdsname-list
8527
8528 @param[in] a
8529 @param[in] b
8530
8531 @return <ReturnValue>
8532**/
8533/*---------------------------------------------------------------------*/
8534static int _gentable_sort_cmds( const void *a, const void *b )
8535{
8536  cmdnames *pCmdL = (cmdnames*)a;
8537  cmdnames *pCmdR = (cmdnames*)b;
8538
8539  if(a==NULL || b==NULL)             return 0;
8540
8541  /* empty entries goes to the end of the list for later reuse */
8542  if(pCmdL->name==NULL) return 1;
8543  if(pCmdR->name==NULL) return -1;
8544
8545  /* $INVALID$ must come first */
8546  if(strcmp(pCmdL->name, "$INVALID$")==0) return -1;
8547  if(strcmp(pCmdR->name, "$INVALID$")==0) return  1;
8548
8549  /* tokval=-1 are reserved names at the end */
8550  if (pCmdL->tokval==-1)
8551  {
8552    if (pCmdR->tokval==-1)
8553       return strcmp(pCmdL->name, pCmdR->name);
8554    /* pCmdL->tokval==-1, pCmdL goes at the end */
8555    return 1;
8556  }
8557  /* pCmdR->tokval==-1, pCmdR goes at the end */
8558  if(pCmdR->tokval==-1) return -1;
8559
8560  return strcmp(pCmdL->name, pCmdR->name);
8561}
8562
8563/*---------------------------------------------------------------------*/
8564/**
8565 * @brief initialisation of arithmetic structured data
8566
8567 @retval 0 on success
8568
8569**/
8570/*---------------------------------------------------------------------*/
8571int iiInitArithmetic()
8572{
8573  //printf("iiInitArithmetic()\n");
8574  memset(&sArithBase, 0, sizeof(sArithBase));
8575  iiInitCmdName();
8576  /* fix last-identifier */
8577#if 0
8578  /* we expect that gentable allready did every thing */
8579  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8580      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--) {
8581    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8582  }
8583#endif
8584  //Print("L=%d\n", sArithBase.nLastIdentifier);
8585
8586  //iiArithAddCmd(szName, nAlias, nTokval, nToktype);
8587  //iiArithAddCmd("mygcd", 1, GCD_CMD, CMD_2);
8588
8589  //iiArithAddCmd("Top", 0,-1,0);
8590
8591
8592  //for(i=0; i<sArithBase.nCmdUsed; i++) {
8593  //  printf("CMD[%03d] %s, %d, %d, %d\n", i,
8594  //         sArithBase.sCmds[i].name,
8595  //         sArithBase.sCmds[i].alias,
8596  //         sArithBase.sCmds[i].tokval,
8597  //         sArithBase.sCmds[i].toktype);
8598  //}
8599  //iiArithRemoveCmd("Top");
8600  //iiArithAddCmd("mygcd", 2, GCD_CMD, CMD_2);
8601  //iiArithRemoveCmd("mygcd");
8602  //iiArithAddCmd("kkk", 1, 1234, CMD_1);
8603  return 0;
8604}
8605
8606int iiArithFindCmd(const char *szName)
8607{
8608  int an=0;
8609  int i = 0,v = 0;
8610  int en=sArithBase.nLastIdentifier;
8611
8612  loop
8613  //for(an=0; an<sArithBase.nCmdUsed; )
8614  {
8615    if(an>=en-1)
8616    {
8617      if (strcmp(szName, sArithBase.sCmds[an].name) == 0)
8618      {
8619        //Print("RET-an=%d %s\n", an, sArithBase.sCmds[an].name);
8620        return an;
8621      }
8622      else if (strcmp(szName, sArithBase.sCmds[en].name) == 0)
8623      {
8624        //Print("RET-en=%d %s\n", en, sArithBase.sCmds[en].name);
8625        return en;
8626      }
8627      else
8628      {
8629        //Print("RET- 1\n");
8630        return -1;
8631      }
8632    }
8633    i=(an+en)/2;
8634    if (*szName < *(sArithBase.sCmds[i].name))
8635    {
8636      en=i-1;
8637    }
8638    else if (*szName > *(sArithBase.sCmds[i].name))
8639    {
8640      an=i+1;
8641    }
8642    else
8643    {
8644      v=strcmp(szName,sArithBase.sCmds[i].name);
8645      if(v<0)
8646      {
8647        en=i-1;
8648      }
8649      else if(v>0)
8650      {
8651        an=i+1;
8652      }
8653      else /*v==0*/
8654      {
8655        //Print("RET-i=%d %s\n", i, sArithBase.sCmds[i].name);
8656        return i;
8657      }
8658    }
8659  }
8660  //if(i>=0 && i<sArithBase.nCmdUsed)
8661  //  return i;
8662  //Print("RET-2\n");
8663  return -2;
8664}
8665
8666char *iiArithGetCmd( int nPos )
8667{
8668  if(nPos<0) return NULL;
8669  if(nPos<sArithBase.nCmdUsed)
8670    return sArithBase.sCmds[nPos].name;
8671  return NULL;
8672}
8673
8674int iiArithRemoveCmd(const char *szName)
8675{
8676  int nIndex;
8677  if(szName==NULL) return -1;
8678
8679  nIndex = iiArithFindCmd(szName);
8680  if(nIndex<0 || nIndex>=sArithBase.nCmdUsed)
8681  {
8682    Print("'%s' not found (%d)\n", szName, nIndex);
8683    return -1;
8684  }
8685  omFree(sArithBase.sCmds[nIndex].name);
8686  sArithBase.sCmds[nIndex].name=NULL;
8687  qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
8688        (&_gentable_sort_cmds));
8689  sArithBase.nCmdUsed--;
8690
8691  /* fix last-identifier */
8692  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8693      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
8694  {
8695    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8696  }
8697  //Print("L=%d\n", sArithBase.nLastIdentifier);
8698  return 0;
8699}
8700
8701int iiArithAddCmd(
8702  const char *szName,
8703  short nAlias,
8704  short nTokval,
8705  short nToktype,
8706  short nPos
8707  )
8708{
8709  //printf("AddCmd(%s, %d, %d, %d, %d)\n", szName, nAlias,
8710  //       nTokval, nToktype, nPos);
8711  if(nPos>=0)
8712  {
8713    // no checks: we rely on a correct generated code in iparith.inc
8714    assume(nPos < sArithBase.nCmdAllocated);
8715    assume(szName!=NULL);
8716    sArithBase.sCmds[nPos].name    = omStrDup(szName);
8717    sArithBase.sCmds[nPos].alias   = nAlias;
8718    sArithBase.sCmds[nPos].tokval  = nTokval;
8719    sArithBase.sCmds[nPos].toktype = nToktype;
8720    sArithBase.nCmdUsed++;
8721    //if(nTokval>0) sArithBase.nLastIdentifier++;
8722  }
8723  else
8724  {
8725    if(szName==NULL) return -1;
8726    int nIndex = iiArithFindCmd(szName);
8727    if(nIndex>=0)
8728    {
8729      Print("'%s' already exists at %d\n", szName, nIndex);
8730      return -1;
8731    }
8732
8733    if(sArithBase.nCmdUsed>=sArithBase.nCmdAllocated)
8734    {
8735      /* needs to create new slots */
8736      unsigned long nSize = (sArithBase.nCmdAllocated+1)*sizeof(cmdnames);
8737      sArithBase.sCmds = (cmdnames *)omRealloc(sArithBase.sCmds, nSize);
8738      if(sArithBase.sCmds==NULL) return -1;
8739      sArithBase.nCmdAllocated++;
8740    }
8741    /* still free slots available */
8742    sArithBase.sCmds[sArithBase.nCmdUsed].name    = omStrDup(szName);
8743    sArithBase.sCmds[sArithBase.nCmdUsed].alias   = nAlias;
8744    sArithBase.sCmds[sArithBase.nCmdUsed].tokval  = nTokval;
8745    sArithBase.sCmds[sArithBase.nCmdUsed].toktype = nToktype;
8746    sArithBase.nCmdUsed++;
8747
8748    qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
8749          (&_gentable_sort_cmds));
8750    for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8751        sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
8752    {
8753      if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8754    }
8755    //Print("L=%d\n", sArithBase.nLastIdentifier);
8756  }
8757  return 0;
8758}
8759
8760static BOOLEAN check_valid(const int p, const int op)
8761{
8762  #ifdef HAVE_PLURAL
8763  if (rIsPluralRing(currRing))
8764  {
8765    if ((p & PLURAL_MASK)==0 /*NO_PLURAL*/)
8766    {
8767      WerrorS("not implemented for non-commutative rings");
8768      return TRUE;
8769    }
8770    else if ((p & PLURAL_MASK)==2 /*, COMM_PLURAL */)
8771    {
8772      Warn("assume commutative subalgebra for cmd `%s`",Tok2Cmdname(op));
8773      return FALSE;
8774    }
8775    /* else, ALLOW_PLURAL */
8776  }
8777  #endif
8778  #ifdef HAVE_RINGS
8779  if (rField_is_Ring(currRing))
8780  {
8781    if ((p & RING_MASK)==0 /*NO_RING*/)
8782    {
8783      WerrorS("not implemented for rings with rings as coeffients");
8784      return TRUE;
8785    }
8786    /* else ALLOW_RING */
8787    else if (((p & ZERODIVISOR_MASK)==NO_ZERODIVISOR)
8788    &&(!rField_is_Domain(currRing)))
8789    {
8790      WerrorS("domain required as coeffients");
8791      return TRUE;
8792    }
8793    /* else ALLOW_ZERODIVISOR */
8794  }
8795  #endif
8796  return FALSE;
8797}
Note: See TracBrowser for help on using the repository browser.