source: git/Singular/iparith.cc @ 9febd16

fieker-DuValspielwiese
Last change on this file since 9febd16 was 9febd16, checked in by Hans Schoenemann <hannes@…>, 10 years ago
fix: int(27/2-1/2) corrupts memory
  • Property mode set to 100644
File size: 218.4 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4
5/*
6* ABSTRACT: table driven kernel interface, used by interpreter
7*/
8
9#ifdef HAVE_CONFIG_H
10#include "singularconfig.h"
11#endif /* HAVE_CONFIG_H */
12
13#include <omalloc/omalloc.h>
14
15#include <coeffs/bigintmat.h>
16#include <coeffs/coeffs.h>
17#include <coeffs/numbers.h>
18
19#ifdef HAVE_RINGS
20#include <coeffs/rmodulon.h>
21#include <coeffs/rmodulo2m.h>
22#include <coeffs/rintegers.h>
23#endif
24
25#include <misc/options.h>
26#include <misc/intvec.h>
27
28#include <polys/prCopy.h>
29#include <polys/matpol.h>
30#include <polys/monomials/maps.h>
31#include <polys/coeffrings.h>
32#include <polys/sparsmat.h>
33#include <Singular/mod_lib.h>
34#include <polys/weight.h>
35#include <polys/ext_fields/transext.h>
36
37#include <kernel/stairc.h>
38#include <kernel/mod2.h>
39#include <kernel/polys.h>
40#include <kernel/febase.h>
41#include <kernel/ideals.h>
42#include <kernel/kstd1.h>
43#include <kernel/timer.h>
44#include <kernel/preimage.h>
45#include <kernel/units.h>
46#include <kernel/GMPrat.h>
47#include <kernel/tgb.h>
48#include <kernel/walkProc.h>
49#include <kernel/linearAlgebra.h>
50#include <kernel/syz.h>
51#include <kernel/timer.h>
52
53
54#include <Singular/tok.h>
55#include <Singular/ipid.h>
56#include <Singular/sdb.h>
57#include <Singular/subexpr.h>
58#include <Singular/lists.h>
59#include <Singular/maps_ip.h>
60
61#include <Singular/ipconv.h>
62#include <Singular/ipprint.h>
63#include <Singular/attrib.h>
64#include <Singular/links/silink.h>
65#include <Singular/janet.h>
66#include <Singular/MinorInterface.h>
67#include <Singular/misc_ip.h>
68#include <Singular/linearAlgebra_ip.h>
69
70#  include <factory/factory.h>
71#  include <polys/clapsing.h>
72#  include <kernel/kstdfac.h>
73#  include <kernel/fglm.h>
74#  include <Singular/fglm.h>
75
76#include <Singular/interpolation.h>
77
78#include <Singular/blackbox.h>
79#include <Singular/newstruct.h>
80#include <Singular/ipshell.h>
81//#include <kernel/mpr_inout.h>
82
83#include <Singular/si_signals.h>
84
85
86#include <stdlib.h>
87#include <string.h>
88#include <ctype.h>
89#include <stdio.h>
90#include <time.h>
91#include <unistd.h>
92
93
94lists rDecompose(const ring r);
95ring rCompose(const lists  L, const BOOLEAN check_comp=TRUE);
96
97
98// defaults for all commands: NO_PLURAL | NO_RING | ALLOW_ZERODIVISOR
99
100#ifdef HAVE_PLURAL
101  #include <kernel/ratgring.h>
102  #include <kernel/nc.h>
103  #include <polys/nc/nc.h>
104  #include <polys/nc/sca.h>
105  #define ALLOW_PLURAL     1
106  #define NO_PLURAL        0
107  #define COMM_PLURAL      2
108  #define  PLURAL_MASK 3
109#else /* HAVE_PLURAL */
110  #define ALLOW_PLURAL     0
111  #define NO_PLURAL        0
112  #define COMM_PLURAL      0
113  #define  PLURAL_MASK     0
114#endif /* HAVE_PLURAL */
115
116#ifdef HAVE_RINGS
117  #define RING_MASK        4
118  #define ZERODIVISOR_MASK 8
119#else
120  #define RING_MASK        0
121  #define ZERODIVISOR_MASK 0
122#endif
123#define ALLOW_RING       4
124#define NO_RING          0
125#define NO_ZERODIVISOR   8
126#define ALLOW_ZERODIVISOR  0
127
128// bit 4 for warning, if used at toplevel
129#define WARN_RING        16
130
131static BOOLEAN check_valid(const int p, const int op);
132
133/*=============== types =====================*/
134struct sValCmdTab
135{
136  short cmd;
137  short start;
138};
139
140typedef sValCmdTab jjValCmdTab[];
141
142struct _scmdnames
143{
144  char *name;
145  short alias;
146  short tokval;
147  short toktype;
148};
149typedef struct _scmdnames cmdnames;
150
151
152typedef char * (*Proc1)(char *);
153struct sValCmd1
154{
155  proc1 p;
156  short cmd;
157  short res;
158  short arg;
159  short valid_for;
160};
161
162typedef BOOLEAN (*proc2)(leftv,leftv,leftv);
163struct sValCmd2
164{
165  proc2 p;
166  short cmd;
167  short res;
168  short arg1;
169  short arg2;
170  short valid_for;
171};
172
173typedef BOOLEAN (*proc3)(leftv,leftv,leftv,leftv);
174struct sValCmd3
175{
176  proc3 p;
177  short cmd;
178  short res;
179  short arg1;
180  short arg2;
181  short arg3;
182  short valid_for;
183};
184struct sValCmdM
185{
186  proc1 p;
187  short cmd;
188  short res;
189  short number_of_args; /* -1: any, -2: any >0, .. */
190  short valid_for;
191};
192
193typedef struct
194{
195  cmdnames *sCmds;             /**< array of existing commands */
196  struct sValCmd1 *psValCmd1;
197  struct sValCmd2 *psValCmd2;
198  struct sValCmd3 *psValCmd3;
199  struct sValCmdM *psValCmdM;
200  int nCmdUsed;      /**< number of commands used */
201  int nCmdAllocated; /**< number of commands-slots allocated */
202  int nLastIdentifier; /**< valid indentifieres are slot 1..nLastIdentifier */
203} SArithBase;
204
205/*---------------------------------------------------------------------*
206 * File scope Variables (Variables share by several functions in
207 *                       the same file )
208 *
209 *---------------------------------------------------------------------*/
210static SArithBase sArithBase;  /**< Base entry for arithmetic */
211
212/*---------------------------------------------------------------------*
213 * Extern Functions declarations
214 *
215 *---------------------------------------------------------------------*/
216static int _gentable_sort_cmds(const void *a, const void *b);
217extern int iiArithRemoveCmd(char *szName);
218extern int iiArithAddCmd(const char *szName, short nAlias, short nTokval,
219                         short nToktype, short nPos=-1);
220
221/*============= proc =======================*/
222static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op);
223static Subexpr jjMakeSub(leftv e);
224
225/*============= vars ======================*/
226extern int cmdtok;
227extern BOOLEAN expected_parms;
228
229#define ii_div_by_0 "div. by 0"
230
231int iiOp; /* the current operation*/
232
233/*=================== simple helpers =================*/
234poly pHeadProc(poly p)
235{
236  return pHead(p);
237}
238
239int iiTokType(int op)
240{
241  for (int i=0;i<sArithBase.nCmdUsed;i++)
242  {
243    if (sArithBase.sCmds[i].tokval==op)
244      return sArithBase.sCmds[i].toktype;
245  }
246  return 0;
247}
248
249/*=================== operations with 2 args.: static proc =================*/
250/* must be ordered: first operations for chars (infix ops),
251 * then alphabetically */
252
253static BOOLEAN jjOP_BIM_I(leftv res, leftv u, leftv v)
254{
255  bigintmat* aa= (bigintmat *)u->Data();
256  int bb = (int)(long)(v->Data());
257  if (errorreported) return TRUE;
258  bigintmat *cc=NULL;
259  switch (iiOp)
260  {
261    case '+': cc=bimAdd(aa,bb); break;
262    case '-': cc=bimSub(aa,bb); break;
263    case '*': cc=bimMult(aa,bb); break;
264  }
265  res->data=(char *)cc;
266  return cc==NULL;
267}
268static BOOLEAN jjOP_I_BIM(leftv res, leftv u, leftv v)
269{
270  return jjOP_BIM_I(res, v, u);
271}
272static BOOLEAN jjOP_BIM_BI(leftv res, leftv u, leftv v)
273{
274  bigintmat* aa= (bigintmat *)u->Data();
275  number bb = (number)(v->Data());
276  if (errorreported) return TRUE;
277  bigintmat *cc=NULL;
278  switch (iiOp)
279  {
280    case '*': cc=bimMult(aa,bb,coeffs_BIGINT); break;
281  }
282  res->data=(char *)cc;
283  return cc==NULL;
284}
285static BOOLEAN jjOP_BI_BIM(leftv res, leftv u, leftv v)
286{
287  return jjOP_BIM_BI(res, v, u);
288}
289static BOOLEAN jjOP_IV_I(leftv res, leftv u, leftv v)
290{
291  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
292  int bb = (int)(long)(v->Data());
293  if (errorreported) return TRUE;
294  switch (iiOp)
295  {
296    case '+': (*aa) += bb; break;
297    case '-': (*aa) -= bb; break;
298    case '*': (*aa) *= bb; break;
299    case '/':
300    case INTDIV_CMD: (*aa) /= bb; break;
301    case '%': (*aa) %= bb; break;
302  }
303  res->data=(char *)aa;
304  return FALSE;
305}
306static BOOLEAN jjOP_I_IV(leftv res, leftv u, leftv v)
307{
308  return jjOP_IV_I(res,v,u);
309}
310static BOOLEAN jjOP_IM_I(leftv res, leftv u, leftv v)
311{
312  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
313  int bb = (int)(long)(v->Data());
314  int i=si_min(aa->rows(),aa->cols());
315  switch (iiOp)
316  {
317    case '+': for (;i>0;i--) IMATELEM(*aa,i,i) += bb;
318              break;
319    case '-': for (;i>0;i--) IMATELEM(*aa,i,i) -= bb;
320              break;
321  }
322  res->data=(char *)aa;
323  return FALSE;
324}
325static BOOLEAN jjOP_I_IM(leftv res, leftv u, leftv v)
326{
327  return jjOP_IM_I(res,v,u);
328}
329static BOOLEAN jjCOLON(leftv res, leftv u, leftv v)
330{
331  int l=(int)(long)v->Data();
332  if (l>0)
333  {
334    int d=(int)(long)u->Data();
335    intvec *vv=new intvec(l);
336    int i;
337    for(i=l-1;i>=0;i--) { (*vv)[i]=d; }
338    res->data=(char *)vv;
339  }
340  return (l<=0);
341}
342static BOOLEAN jjDOTDOT(leftv res, leftv u, leftv v)
343{
344  res->data=(char *)new intvec((int)(long)u->Data(),(int)(long)v->Data());
345  return FALSE;
346}
347static void jjEQUAL_REST(leftv res,leftv u,leftv v);
348static BOOLEAN jjCOMPARE_IV(leftv res, leftv u, leftv v)
349{
350  intvec*    a = (intvec * )(u->Data());
351  intvec*    b = (intvec * )(v->Data());
352  int r=a->compare(b);
353  switch  (iiOp)
354  {
355    case '<':
356      res->data  = (char *) (r<0);
357      break;
358    case '>':
359      res->data  = (char *) (r>0);
360      break;
361    case LE:
362      res->data  = (char *) (r<=0);
363      break;
364    case GE:
365      res->data  = (char *) (r>=0);
366      break;
367    case EQUAL_EQUAL:
368    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
369      res->data  = (char *) (r==0);
370      break;
371  }
372  jjEQUAL_REST(res,u,v);
373  if(r==-2) { WerrorS("size incompatible"); return TRUE; }
374  return FALSE;
375}
376static BOOLEAN jjCOMPARE_BIM(leftv res, leftv u, leftv v)
377{
378  bigintmat*    a = (bigintmat * )(u->Data());
379  bigintmat*    b = (bigintmat * )(v->Data());
380  int r=a->compare(b);
381  switch  (iiOp)
382  {
383    case '<':
384      res->data  = (char *) (r<0);
385      break;
386    case '>':
387      res->data  = (char *) (r>0);
388      break;
389    case LE:
390      res->data  = (char *) (r<=0);
391      break;
392    case GE:
393      res->data  = (char *) (r>=0);
394      break;
395    case EQUAL_EQUAL:
396    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
397      res->data  = (char *) (r==0);
398      break;
399  }
400  jjEQUAL_REST(res,u,v);
401  if(r==-2) { WerrorS("size incompatible"); return TRUE; }
402  return FALSE;
403}
404static BOOLEAN jjCOMPARE_IV_I(leftv res, leftv u, leftv v)
405{
406  intvec* a = (intvec * )(u->Data());
407  int     b = (int)(long)(v->Data());
408  int r=a->compare(b);
409  switch  (iiOp)
410  {
411    case '<':
412      res->data  = (char *) (r<0);
413      break;
414    case '>':
415      res->data  = (char *) (r>0);
416      break;
417    case LE:
418      res->data  = (char *) (r<=0);
419      break;
420    case GE:
421      res->data  = (char *) (r>=0);
422      break;
423    case EQUAL_EQUAL:
424    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
425      res->data  = (char *) (r==0);
426      break;
427  }
428  jjEQUAL_REST(res,u,v);
429  return FALSE;
430}
431static BOOLEAN jjCOMPARE_P(leftv res, leftv u, leftv v)
432{
433  poly p=(poly)u->Data();
434  poly q=(poly)v->Data();
435  int r=pCmp(p,q);
436  if (r==0)
437  {
438    number h=nSub(pGetCoeff(p),pGetCoeff(q));
439    /* compare lead coeffs */
440    r = -1+nIsZero(h)+2*nGreaterZero(h); /* -1: <, 0:==, 1: > */
441    nDelete(&h);
442  }
443  else if (p==NULL)
444  {
445    if (q==NULL)
446    {
447      /* compare 0, 0 */
448      r=0;
449    }
450    else if(pIsConstant(q))
451    {
452      /* compare 0, const */
453      r = 1-2*nGreaterZero(pGetCoeff(q)); /* -1: <, 1: > */
454    }
455  }
456  else if (q==NULL)
457  {
458    if (pIsConstant(p))
459    {
460      /* compare const, 0 */
461      r = -1+2*nGreaterZero(pGetCoeff(p)); /* -1: <, 1: > */
462    }
463  }
464  switch  (iiOp)
465  {
466    case '<':
467      res->data  = (char *) (r < 0);
468      break;
469    case '>':
470      res->data  = (char *) (r > 0);
471      break;
472    case LE:
473      res->data  = (char *) (r <= 0);
474      break;
475    case GE:
476      res->data  = (char *) (r >= 0);
477      break;
478    //case EQUAL_EQUAL:
479    //case NOTEQUAL: /* negation handled by jjEQUAL_REST */
480    //  res->data  = (char *) (r == 0);
481    //  break;
482  }
483  jjEQUAL_REST(res,u,v);
484  return FALSE;
485}
486static BOOLEAN jjCOMPARE_S(leftv res, leftv u, leftv v)
487{
488  char*    a = (char * )(u->Data());
489  char*    b = (char * )(v->Data());
490  int result = strcmp(a,b);
491  switch  (iiOp)
492  {
493    case '<':
494      res->data  = (char *) (result  < 0);
495      break;
496    case '>':
497      res->data  = (char *) (result  > 0);
498      break;
499    case LE:
500      res->data  = (char *) (result  <= 0);
501      break;
502    case GE:
503      res->data  = (char *) (result  >= 0);
504      break;
505    case EQUAL_EQUAL:
506    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
507      res->data  = (char *) (result  == 0);
508      break;
509  }
510  jjEQUAL_REST(res,u,v);
511  return FALSE;
512}
513static BOOLEAN jjOP_REST(leftv res, leftv u, leftv v)
514{
515  if (u->Next()!=NULL)
516  {
517    u=u->next;
518    res->next = (leftv)omAllocBin(sleftv_bin);
519    return iiExprArith2(res->next,u,iiOp,v);
520  }
521  else if (v->Next()!=NULL)
522  {
523    v=v->next;
524    res->next = (leftv)omAllocBin(sleftv_bin);
525    return iiExprArith2(res->next,u,iiOp,v);
526  }
527  return FALSE;
528}
529static BOOLEAN jjPOWER_I(leftv res, leftv u, leftv v)
530{
531  int b=(int)(long)u->Data();
532  int e=(int)(long)v->Data();
533  int rc = 1;
534  BOOLEAN overflow=FALSE;
535  if (e >= 0)
536  {
537    if (b==0)
538    {
539      rc=(e==0);
540    }
541    else if ((e==0)||(b==1))
542    {
543      rc= 1;
544    }
545    else if (b== -1)
546    {
547      if (e&1) rc= -1;
548      else     rc= 1;
549    }
550    else
551    {
552      int oldrc;
553      while ((e--)!=0)
554      {
555        oldrc=rc;
556        rc *= b;
557        if (!overflow)
558        {
559          if(rc/b!=oldrc) overflow=TRUE;
560        }
561      }
562      if (overflow)
563        WarnS("int overflow(^), result may be wrong");
564    }
565    res->data = (char *)((long)rc);
566    if (u!=NULL) return jjOP_REST(res,u,v);
567    return FALSE;
568  }
569  else
570  {
571    WerrorS("exponent must be non-negative");
572    return TRUE;
573  }
574}
575static BOOLEAN jjPOWER_BI(leftv res, leftv u, leftv v)
576{
577  int e=(int)(long)v->Data();
578  number n=(number)u->Data();
579  if (e>=0)
580  {
581    n_Power(n,e,(number*)&res->data,coeffs_BIGINT);
582  }
583  else
584  {
585    WerrorS("exponent must be non-negative");
586    return TRUE;
587  }
588  if (u!=NULL) return jjOP_REST(res,u,v);
589  return FALSE;
590}
591static BOOLEAN jjPOWER_N(leftv res, leftv u, leftv v)
592{
593  int e=(int)(long)v->Data();
594  number n=(number)u->Data();
595  int d=0;
596  if (e<0)
597  {
598    n=nInvers(n);
599    e=-e;
600    d=1;
601  }
602  number r;
603  nPower(n,e,(number*)&r);
604  res->data=(char*)r;
605  if (d) nDelete(&n);
606  if (u!=NULL) return jjOP_REST(res,u,v);
607  return FALSE;
608}
609static BOOLEAN jjPOWER_P(leftv res, leftv u, leftv v)
610{
611  int v_i=(int)(long)v->Data();
612  if (v_i<0)
613  {
614    WerrorS("exponent must be non-negative");
615    return TRUE;
616  }
617  poly u_p=(poly)u->CopyD(POLY_CMD);
618  if ((u_p!=NULL)
619  && ((v_i!=0) &&
620      ((long)pTotaldegree(u_p) > (signed long)currRing->bitmask / (signed long)v_i)))
621  {
622    Werror("OVERFLOW in power(d=%ld, e=%d, max=%ld)",
623                                    pTotaldegree(u_p),v_i,currRing->bitmask);
624    pDelete(&u_p);
625    return TRUE;
626  }
627  res->data = (char *)pPower(u_p,v_i);
628  if (u!=NULL) return jjOP_REST(res,u,v);
629  return errorreported; /* pPower may set errorreported via Werror */
630}
631static BOOLEAN jjPOWER_ID(leftv res, leftv u, leftv v)
632{
633  res->data = (char *)id_Power((ideal)(u->Data()),(int)(long)(v->Data()), currRing);
634  if (u!=NULL) return jjOP_REST(res,u,v);
635  return FALSE;
636}
637static BOOLEAN jjPLUSMINUS_Gen(leftv res, leftv u, leftv v)
638{
639  u=u->next;
640  v=v->next;
641  if (u==NULL)
642  {
643    if (v==NULL) return FALSE;      /* u==NULL, v==NULL */
644    if (iiOp=='-')                  /* u==NULL, v<>NULL, iiOp=='-'*/
645    {
646      do
647      {
648        if (res->next==NULL)
649          res->next = (leftv)omAlloc0Bin(sleftv_bin);
650        leftv tmp_v=v->next;
651        v->next=NULL;
652        BOOLEAN b=iiExprArith1(res->next,v,'-');
653        v->next=tmp_v;
654        if (b)
655          return TRUE;
656        v=tmp_v;
657        res=res->next;
658      } while (v!=NULL);
659      return FALSE;
660    }
661    loop                            /* u==NULL, v<>NULL, iiOp=='+' */
662    {
663      res->next = (leftv)omAlloc0Bin(sleftv_bin);
664      res=res->next;
665      res->data = v->CopyD();
666      res->rtyp = v->Typ();
667      v=v->next;
668      if (v==NULL) return FALSE;
669    }
670  }
671  if (v!=NULL)                     /* u<>NULL, v<>NULL */
672  {
673    do
674    {
675      res->next = (leftv)omAlloc0Bin(sleftv_bin);
676      leftv tmp_u=u->next; u->next=NULL;
677      leftv tmp_v=v->next; v->next=NULL;
678      BOOLEAN b=iiExprArith2(res->next,u,iiOp,v);
679      u->next=tmp_u;
680      v->next=tmp_v;
681      if (b)
682        return TRUE;
683      u=tmp_u;
684      v=tmp_v;
685      res=res->next;
686    } while ((u!=NULL) && (v!=NULL));
687    return FALSE;
688  }
689  loop                             /* u<>NULL, v==NULL */
690  {
691    res->next = (leftv)omAlloc0Bin(sleftv_bin);
692    res=res->next;
693    res->data = u->CopyD();
694    res->rtyp = u->Typ();
695    u=u->next;
696    if (u==NULL) return FALSE;
697  }
698}
699static BOOLEAN jjCOLCOL(leftv res, leftv u, leftv v)
700{
701  idhdl packhdl;
702  switch(u->Typ())
703  {
704      case 0:
705      {
706        int name_err=0;
707        if(isupper(u->name[0]))
708        {
709          const char *c=u->name+1;
710          while((*c!='\0')&&(islower(*c)||(isdigit(*c)))) c++;
711          if (*c!='\0')
712            name_err=1;
713          else
714          {
715            Print("%s of type 'ANY'. Trying load.\n", u->name);
716            if(iiTryLoadLib(u, u->name))
717            {
718              Werror("'%s' no such package", u->name);
719              return TRUE;
720            }
721            syMake(u,u->name,NULL);
722          }
723        }
724        else name_err=1;
725        if(name_err)
726        { Werror("'%s' is an invalid package name",u->name);return TRUE;}
727        // and now, after the loading: use next case !!! no break !!!
728      }
729      case PACKAGE_CMD:
730        packhdl = (idhdl)u->data;
731        if((!IDPACKAGE(packhdl)->loaded)
732        && (IDPACKAGE(packhdl)->language > LANG_TOP))
733        {
734          Werror("'%s' not loaded", u->name);
735          return TRUE;
736        }
737        if(v->rtyp == IDHDL)
738        {
739          v->name = omStrDup(v->name);
740        }
741        v->req_packhdl=IDPACKAGE(packhdl);
742        syMake(v, v->name, packhdl);
743        memcpy(res, v, sizeof(sleftv));
744        memset(v, 0, sizeof(sleftv));
745        break;
746      case DEF_CMD:
747        break;
748      default:
749        WerrorS("<package>::<id> expected");
750        return TRUE;
751  }
752  return FALSE;
753}
754static BOOLEAN jjPLUS_I(leftv res, leftv u, leftv v)
755{
756  unsigned int a=(unsigned int)(unsigned long)u->Data();
757  unsigned int b=(unsigned int)(unsigned long)v->Data();
758  unsigned int c=a+b;
759  res->data = (char *)((long)c);
760  if (((Sy_bit(31)&a)==(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
761  {
762    WarnS("int overflow(+), result may be wrong");
763  }
764  return jjPLUSMINUS_Gen(res,u,v);
765}
766static BOOLEAN jjPLUS_BI(leftv res, leftv u, leftv v)
767{
768  res->data = (char *)(n_Add((number)u->Data(), (number)v->Data(),coeffs_BIGINT));
769  return jjPLUSMINUS_Gen(res,u,v);
770}
771static BOOLEAN jjPLUS_N(leftv res, leftv u, leftv v)
772{
773  res->data = (char *)(nAdd((number)u->Data(), (number)v->Data()));
774  return jjPLUSMINUS_Gen(res,u,v);
775}
776static BOOLEAN jjPLUS_P(leftv res, leftv u, leftv v)
777{
778  res->data = (char *)(pAdd((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
779  return jjPLUSMINUS_Gen(res,u,v);
780}
781static BOOLEAN jjPLUS_IV(leftv res, leftv u, leftv v)
782{
783  res->data = (char *)ivAdd((intvec*)(u->Data()), (intvec*)(v->Data()));
784  if (res->data==NULL)
785  {
786     WerrorS("intmat size not compatible");
787     return TRUE;
788  }
789  return jjPLUSMINUS_Gen(res,u,v);
790}
791static BOOLEAN jjPLUS_BIM(leftv res, leftv u, leftv v)
792{
793  res->data = (char *)bimAdd((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
794  if (res->data==NULL)
795  {
796    WerrorS("bigintmat size not compatible");
797    return TRUE;
798  }
799  return jjPLUSMINUS_Gen(res,u,v);
800}
801static BOOLEAN jjPLUS_MA(leftv res, leftv u, leftv v)
802{
803  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
804  res->data = (char *)(mp_Add(A , B, currRing));
805  if (res->data==NULL)
806  {
807     Werror("matrix size not compatible(%dx%d, %dx%d)",
808             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
809     return TRUE;
810  }
811  return jjPLUSMINUS_Gen(res,u,v);
812}
813static BOOLEAN jjPLUS_MA_P(leftv res, leftv u, leftv v)
814{
815  matrix m=(matrix)u->Data();
816  matrix p= mp_InitP(m->nrows,m->ncols,(poly)(v->CopyD(POLY_CMD)),currRing);
817  if (iiOp=='+')
818    res->data = (char *)mp_Add(m , p,currRing);
819  else
820    res->data = (char *)mp_Sub(m , p,currRing);
821  idDelete((ideal *)&p);
822  return jjPLUSMINUS_Gen(res,u,v);
823}
824static BOOLEAN jjPLUS_P_MA(leftv res, leftv u, leftv v)
825{
826  return jjPLUS_MA_P(res,v,u);
827}
828static BOOLEAN jjPLUS_S(leftv res, leftv u, leftv v)
829{
830  char*    a = (char * )(u->Data());
831  char*    b = (char * )(v->Data());
832  char*    r = (char * )omAlloc(strlen(a) + strlen(b) + 1);
833  strcpy(r,a);
834  strcat(r,b);
835  res->data=r;
836  return jjPLUSMINUS_Gen(res,u,v);
837}
838static BOOLEAN jjPLUS_ID(leftv res, leftv u, leftv v)
839{
840  res->data = (char *)idAdd((ideal)u->Data(),(ideal)v->Data());
841  return jjPLUSMINUS_Gen(res,u,v);
842}
843static BOOLEAN jjMINUS_I(leftv res, leftv u, leftv v)
844{
845  void *ap=u->Data(); void *bp=v->Data();
846  int aa=(int)(long)ap;
847  int bb=(int)(long)bp;
848  int cc=aa-bb;
849  unsigned int a=(unsigned int)(unsigned long)ap;
850  unsigned int b=(unsigned int)(unsigned long)bp;
851  unsigned int c=a-b;
852  if (((Sy_bit(31)&a)!=(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
853  {
854    WarnS("int overflow(-), result may be wrong");
855  }
856  res->data = (char *)((long)cc);
857  return jjPLUSMINUS_Gen(res,u,v);
858}
859static BOOLEAN jjMINUS_BI(leftv res, leftv u, leftv v)
860{
861  res->data = (char *)(n_Sub((number)u->Data(), (number)v->Data(),coeffs_BIGINT));
862  return jjPLUSMINUS_Gen(res,u,v);
863}
864static BOOLEAN jjMINUS_N(leftv res, leftv u, leftv v)
865{
866  res->data = (char *)(nSub((number)u->Data(), (number)v->Data()));
867  return jjPLUSMINUS_Gen(res,u,v);
868}
869static BOOLEAN jjMINUS_P(leftv res, leftv u, leftv v)
870{
871  res->data = (char *)(pSub((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
872  return jjPLUSMINUS_Gen(res,u,v);
873}
874static BOOLEAN jjMINUS_IV(leftv res, leftv u, leftv v)
875{
876  res->data = (char *)ivSub((intvec*)(u->Data()), (intvec*)(v->Data()));
877  if (res->data==NULL)
878  {
879     WerrorS("intmat size not compatible");
880     return TRUE;
881  }
882  return jjPLUSMINUS_Gen(res,u,v);
883}
884static BOOLEAN jjMINUS_BIM(leftv res, leftv u, leftv v)
885{
886  res->data = (char *)bimSub((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
887  if (res->data==NULL)
888  {
889    WerrorS("bigintmat size not compatible");
890    return TRUE;
891  }
892  return jjPLUSMINUS_Gen(res,u,v);
893}
894static BOOLEAN jjMINUS_MA(leftv res, leftv u, leftv v)
895{
896  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
897  res->data = (char *)(mp_Sub(A , B, currRing));
898  if (res->data==NULL)
899  {
900     Werror("matrix size not compatible(%dx%d, %dx%d)",
901             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
902     return TRUE;
903  }
904  return jjPLUSMINUS_Gen(res,u,v);
905  return FALSE;
906}
907static BOOLEAN jjTIMES_I(leftv res, leftv u, leftv v)
908{
909  int a=(int)(long)u->Data();
910  int b=(int)(long)v->Data();
911  int64 c=(int64)a * (int64)b;
912  if ((c>INT_MAX)||(c<INT_MIN))
913    WarnS("int overflow(*), result may be wrong");
914  res->data = (char *)((long)((int)c));
915  if ((u->Next()!=NULL) || (v->Next()!=NULL))
916    return jjOP_REST(res,u,v);
917  return FALSE;
918}
919static BOOLEAN jjTIMES_BI(leftv res, leftv u, leftv v)
920{
921  res->data = (char *)(n_Mult( (number)u->Data(), (number)v->Data(),coeffs_BIGINT));
922  if ((v->next!=NULL) || (u->next!=NULL))
923    return jjOP_REST(res,u,v);
924  return FALSE;
925}
926static BOOLEAN jjTIMES_N(leftv res, leftv u, leftv v)
927{
928  res->data = (char *)(nMult( (number)u->Data(), (number)v->Data()));
929  number n=(number)res->data;
930  nNormalize(n);
931  res->data=(char *)n;
932  if ((v->next!=NULL) || (u->next!=NULL))
933    return jjOP_REST(res,u,v);
934  return FALSE;
935}
936static BOOLEAN jjTIMES_P(leftv res, leftv u, leftv v)
937{
938  poly a;
939  poly b;
940  if (v->next==NULL)
941  {
942    a=(poly)u->CopyD(POLY_CMD); // works also for VECTOR_CMD
943    if (u->next==NULL)
944    {
945      b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
946      if ((a!=NULL) && (b!=NULL)
947      && ((long)pTotaldegree(a)>si_max((long)rVar(currRing),(long)currRing->bitmask)-(long)pTotaldegree(b)))
948      {
949        Werror("OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
950          pTotaldegree(a),pTotaldegree(b),currRing->bitmask);
951        pDelete(&a);
952        pDelete(&b);
953        return TRUE;
954      }
955      res->data = (char *)(pMult( a, b));
956      pNormalize((poly)res->data);
957      return FALSE;
958    }
959    // u->next exists: copy v
960    b=pCopy((poly)v->Data());
961    if ((a!=NULL) && (b!=NULL)
962    && (pTotaldegree(a)+pTotaldegree(b)>si_max((long)rVar(currRing),(long)currRing->bitmask)))
963    {
964      Werror("OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
965          pTotaldegree(a),pTotaldegree(b),currRing->bitmask);
966      pDelete(&a);
967      pDelete(&b);
968      return TRUE;
969    }
970    res->data = (char *)(pMult( a, b));
971    pNormalize((poly)res->data);
972    return jjOP_REST(res,u,v);
973  }
974  // v->next exists: copy u
975  a=pCopy((poly)u->Data());
976  b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
977  if ((a!=NULL) && (b!=NULL)
978  && ((unsigned long)(pTotaldegree(a)+pTotaldegree(b))>=currRing->bitmask))
979  {
980    pDelete(&a);
981    pDelete(&b);
982    WerrorS("OVERFLOW");
983    return TRUE;
984  }
985  res->data = (char *)(pMult( a, b));
986  pNormalize((poly)res->data);
987  return jjOP_REST(res,u,v);
988}
989static BOOLEAN jjTIMES_ID(leftv res, leftv u, leftv v)
990{
991  res->data = (char *)idMult((ideal)u->Data(),(ideal)v->Data());
992  id_Normalize((ideal)res->data,currRing);
993  if ((v->next!=NULL) || (u->next!=NULL))
994    return jjOP_REST(res,u,v);
995  return FALSE;
996}
997static BOOLEAN jjTIMES_IV(leftv res, leftv u, leftv v)
998{
999  res->data = (char *)ivMult((intvec*)(u->Data()), (intvec*)(v->Data()));
1000  if (res->data==NULL)
1001  {
1002     WerrorS("intmat size not compatible");
1003     return TRUE;
1004  }
1005  if ((v->next!=NULL) || (u->next!=NULL))
1006    return jjOP_REST(res,u,v);
1007  return FALSE;
1008}
1009static BOOLEAN jjTIMES_BIM(leftv res, leftv u, leftv v)
1010{
1011  res->data = (char *)bimMult((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
1012  if (res->data==NULL)
1013  {
1014    WerrorS("bigintmat size not compatible");
1015    return TRUE;
1016  }
1017  if ((v->next!=NULL) || (u->next!=NULL))
1018    return jjOP_REST(res,u,v);
1019  return FALSE;
1020}
1021static BOOLEAN jjTIMES_MA_BI1(leftv res, leftv u, leftv v)
1022{
1023  number n=n_Init_bigint((number)v->Data(),coeffs_BIGINT,currRing->cf);
1024  poly p=pNSet(n);
1025  ideal I= (ideal)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
1026  res->data = (char *)I;
1027  return FALSE;
1028}
1029static BOOLEAN jjTIMES_MA_BI2(leftv res, leftv u, leftv v)
1030{
1031  return jjTIMES_MA_BI1(res,v,u);
1032}
1033static BOOLEAN jjTIMES_MA_P1(leftv res, leftv u, leftv v)
1034{
1035  poly p=(poly)v->CopyD(POLY_CMD);
1036  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
1037  ideal I= (ideal)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
1038  if (r>0) I->rank=r;
1039  id_Normalize(I,currRing);
1040  res->data = (char *)I;
1041  return FALSE;
1042}
1043static BOOLEAN jjTIMES_MA_P2(leftv res, leftv u, leftv v)
1044{
1045  poly p=(poly)u->CopyD(POLY_CMD);
1046  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
1047  ideal I= (ideal)pMultMp(p,(matrix)v->CopyD(MATRIX_CMD),currRing);
1048  if (r>0) I->rank=r;
1049  id_Normalize(I,currRing);
1050  res->data = (char *)I;
1051  return FALSE;
1052}
1053static BOOLEAN jjTIMES_MA_N1(leftv res, leftv u, leftv v)
1054{
1055  number n=(number)v->CopyD(NUMBER_CMD);
1056  poly p=pNSet(n);
1057  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
1058  id_Normalize((ideal)res->data,currRing);
1059  return FALSE;
1060}
1061static BOOLEAN jjTIMES_MA_N2(leftv res, leftv u, leftv v)
1062{
1063  return jjTIMES_MA_N1(res,v,u);
1064}
1065static BOOLEAN jjTIMES_MA_I1(leftv res, leftv u, leftv v)
1066{
1067  res->data = (char *)mp_MultI((matrix)u->CopyD(MATRIX_CMD),(int)(long)v->Data(),currRing);
1068  id_Normalize((ideal)res->data,currRing);
1069  return FALSE;
1070}
1071static BOOLEAN jjTIMES_MA_I2(leftv res, leftv u, leftv v)
1072{
1073  return jjTIMES_MA_I1(res,v,u);
1074}
1075static BOOLEAN jjTIMES_MA(leftv res, leftv u, leftv v)
1076{
1077  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
1078  res->data = (char *)mp_Mult(A,B,currRing);
1079  if (res->data==NULL)
1080  {
1081     Werror("matrix size not compatible(%dx%d, %dx%d)",
1082             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
1083     return TRUE;
1084  }
1085  id_Normalize((ideal)res->data,currRing);
1086  if ((v->next!=NULL) || (u->next!=NULL))
1087    return jjOP_REST(res,u,v);
1088  return FALSE;
1089}
1090static BOOLEAN jjGE_BI(leftv res, leftv u, leftv v)
1091{
1092  number h=n_Sub((number)u->Data(),(number)v->Data(),coeffs_BIGINT);
1093  res->data = (char *) (n_GreaterZero(h,coeffs_BIGINT)||(n_IsZero(h,coeffs_BIGINT)));
1094  n_Delete(&h,coeffs_BIGINT);
1095  return FALSE;
1096}
1097static BOOLEAN jjGE_I(leftv res, leftv u, leftv v)
1098{
1099  res->data = (char *)(long)((int)((long)u->Data()) >= (int)((long)v->Data()));
1100  return FALSE;
1101}
1102static BOOLEAN jjGE_N(leftv res, leftv u, leftv v)
1103{
1104  res->data = (char *)(long) (nGreater((number)u->Data(),(number)v->Data())
1105                       || nEqual((number)u->Data(),(number)v->Data()));
1106  return FALSE;
1107}
1108static BOOLEAN jjGT_BI(leftv res, leftv u, leftv v)
1109{
1110  number h=n_Sub((number)u->Data(),(number)v->Data(),coeffs_BIGINT);
1111  res->data = (char *)(long) (n_GreaterZero(h,coeffs_BIGINT)&&(!n_IsZero(h,coeffs_BIGINT)));
1112  n_Delete(&h,coeffs_BIGINT);
1113  return FALSE;
1114}
1115static BOOLEAN jjGT_I(leftv res, leftv u, leftv v)
1116{
1117  res->data = (char *)(long)((int)((long)u->Data()) > (int)((long)v->Data()));
1118  return FALSE;
1119}
1120static BOOLEAN jjGT_N(leftv res, leftv u, leftv v)
1121{
1122  res->data = (char *)(long)(nGreater((number)u->Data(),(number)v->Data()));
1123  return FALSE;
1124}
1125static BOOLEAN jjLE_BI(leftv res, leftv u, leftv v)
1126{
1127  return jjGE_BI(res,v,u);
1128}
1129static BOOLEAN jjLE_I(leftv res, leftv u, leftv v)
1130{
1131  res->data = (char *)(long)((int)((long)u->Data()) <= (int)((long)v->Data()));
1132  return FALSE;
1133}
1134static BOOLEAN jjLE_N(leftv res, leftv u, leftv v)
1135{
1136  return jjGE_N(res,v,u);
1137}
1138static BOOLEAN jjLT_BI(leftv res, leftv u, leftv v)
1139{
1140  return jjGT_BI(res,v,u);
1141}
1142static BOOLEAN jjLT_I(leftv res, leftv u, leftv v)
1143{
1144  res->data = (char *)(long)((int)((long)u->Data()) < (int)((long)v->Data()));
1145  return FALSE;
1146}
1147static BOOLEAN jjLT_N(leftv res, leftv u, leftv v)
1148{
1149  return jjGT_N(res,v,u);
1150}
1151static BOOLEAN jjDIVMOD_I(leftv res, leftv u, leftv v)
1152{
1153  if (iiOp=='/') Warn("int division with `/`: use `div` instead in line >>%s<<",my_yylinebuf);
1154  int a= (int)(long)u->Data();
1155  int b= (int)(long)v->Data();
1156  if (b==0)
1157  {
1158    WerrorS(ii_div_by_0);
1159    return TRUE;
1160  }
1161  int c=a%b;
1162  int r=0;
1163  switch (iiOp)
1164  {
1165    case '%':
1166        r=c;            break;
1167    case '/':
1168    case INTDIV_CMD:
1169        r=((a-c) /b);   break;
1170  }
1171  res->data=(void *)((long)r);
1172  return FALSE;
1173}
1174static BOOLEAN jjDIV_BI(leftv res, leftv u, leftv v)
1175{
1176  number q=(number)v->Data();
1177  if (n_IsZero(q,coeffs_BIGINT))
1178  {
1179    WerrorS(ii_div_by_0);
1180    return TRUE;
1181  }
1182  q = n_IntDiv((number)u->Data(),q,coeffs_BIGINT);
1183  n_Normalize(q,coeffs_BIGINT);
1184  res->data = (char *)q;
1185  return FALSE;
1186}
1187static BOOLEAN jjDIV_N(leftv res, leftv u, leftv v)
1188{
1189  number q=(number)v->Data();
1190  if (nIsZero(q))
1191  {
1192    WerrorS(ii_div_by_0);
1193    return TRUE;
1194  }
1195  q = nDiv((number)u->Data(),q);
1196  nNormalize(q);
1197  res->data = (char *)q;
1198  return FALSE;
1199}
1200static BOOLEAN jjDIV_P(leftv res, leftv u, leftv v)
1201{
1202  poly q=(poly)v->Data();
1203  if (q==NULL)
1204  {
1205    WerrorS(ii_div_by_0);
1206    return TRUE;
1207  }
1208  poly p=(poly)(u->Data());
1209  if (p==NULL)
1210  {
1211    res->data=NULL;
1212    return FALSE;
1213  }
1214  if ((pNext(q)!=NULL) && (!rField_is_Ring(currRing)))
1215  { /* This means that q != 0 consists of at least two terms.
1216       Moreover, currRing is over a field. */
1217    if(pGetComp(p)==0)
1218    {
1219      res->data=(void*)(singclap_pdivide(p /*(poly)(u->Data())*/ ,
1220                                         q /*(poly)(v->Data())*/ ,currRing));
1221    }
1222    else
1223    {
1224      int comps=pMaxComp(p);
1225      ideal I=idInit(comps,1);
1226      p=pCopy(p);
1227      poly h;
1228      int i;
1229      // conversion to a list of polys:
1230      while (p!=NULL)
1231      {
1232        i=pGetComp(p)-1;
1233        h=pNext(p);
1234        pNext(p)=NULL;
1235        pSetComp(p,0);
1236        I->m[i]=pAdd(I->m[i],p);
1237        p=h;
1238      }
1239      // division and conversion to vector:
1240      h=NULL;
1241      p=NULL;
1242      for(i=comps-1;i>=0;i--)
1243      {
1244        if (I->m[i]!=NULL)
1245        {
1246          h=singclap_pdivide(I->m[i],q,currRing);
1247          pSetCompP(h,i+1);
1248          p=pAdd(p,h);
1249        }
1250      }
1251      idDelete(&I);
1252      res->data=(void *)p;
1253    }
1254  }
1255  else
1256  { /* This means that q != 0 consists of just one term,
1257       or that currRing is over a coefficient ring. */
1258#ifdef HAVE_RINGS
1259    if (!rField_is_Domain(currRing))
1260    {
1261      WerrorS("division only defined over coefficient domains");
1262      return TRUE;
1263    }
1264    if (pNext(q)!=NULL)
1265    {
1266      WerrorS("division over a coefficient domain only implemented for terms");
1267      return TRUE;
1268    }
1269#endif
1270    res->data = (char *)pDivideM(pCopy(p),pHead(q));
1271  }
1272  pNormalize((poly)res->data);
1273  return FALSE;
1274}
1275static BOOLEAN jjDIV_Ma(leftv res, leftv u, leftv v)
1276{
1277  poly q=(poly)v->Data();
1278  if (q==NULL)
1279  {
1280    WerrorS(ii_div_by_0);
1281    return TRUE;
1282  }
1283  matrix m=(matrix)(u->Data());
1284  int r=m->rows();
1285  int c=m->cols();
1286  matrix mm=mpNew(r,c);
1287  int i,j;
1288  for(i=r;i>0;i--)
1289  {
1290    for(j=c;j>0;j--)
1291    {
1292      if (pNext(q)!=NULL)
1293      {
1294        MATELEM(mm,i,j) = singclap_pdivide( MATELEM(m,i,j) ,
1295                                           q /*(poly)(v->Data())*/, currRing );
1296      }
1297      else
1298        MATELEM(mm,i,j) = pDivideM(pCopy(MATELEM(m,i,j)),pHead(q));
1299    }
1300  }
1301  id_Normalize((ideal)mm,currRing);
1302  res->data=(char *)mm;
1303  return FALSE;
1304}
1305static BOOLEAN jjEQUAL_BI(leftv res, leftv u, leftv v)
1306{
1307  res->data = (char *)((long)n_Equal((number)u->Data(),(number)v->Data(),coeffs_BIGINT));
1308  jjEQUAL_REST(res,u,v);
1309  return FALSE;
1310}
1311static BOOLEAN jjEQUAL_I(leftv res, leftv u, leftv v)
1312{
1313  res->data = (char *)((int)((long)u->Data()) == (int)((long)v->Data()));
1314  jjEQUAL_REST(res,u,v);
1315  return FALSE;
1316}
1317static BOOLEAN jjEQUAL_Ma(leftv res, leftv u, leftv v)
1318{
1319  res->data = (char *)((long)mp_Equal((matrix)u->Data(),(matrix)v->Data(),currRing));
1320  jjEQUAL_REST(res,u,v);
1321  return FALSE;
1322}
1323static BOOLEAN jjEQUAL_N(leftv res, leftv u, leftv v)
1324{
1325  res->data = (char *)((long)nEqual((number)u->Data(),(number)v->Data()));
1326  jjEQUAL_REST(res,u,v);
1327  return FALSE;
1328}
1329static BOOLEAN jjEQUAL_P(leftv res, leftv u, leftv v)
1330{
1331  poly p=(poly)u->Data();
1332  poly q=(poly)v->Data();
1333  res->data = (char *) ((long)pEqualPolys(p,q));
1334  jjEQUAL_REST(res,u,v);
1335  return FALSE;
1336}
1337static void jjEQUAL_REST(leftv res,leftv u,leftv v)
1338{
1339  if ((res->data) && (u->next!=NULL) && (v->next!=NULL))
1340  {
1341    int save_iiOp=iiOp;
1342    if (iiOp==NOTEQUAL)
1343      iiExprArith2(res,u->next,EQUAL_EQUAL,v->next);
1344    else
1345      iiExprArith2(res,u->next,iiOp,v->next);
1346    iiOp=save_iiOp;
1347  }
1348  if (iiOp==NOTEQUAL) res->data=(char *)(!(long)res->data);
1349}
1350static BOOLEAN jjAND_I(leftv res, leftv u, leftv v)
1351{
1352  res->data = (char *)((long)u->Data() && (long)v->Data());
1353  return FALSE;
1354}
1355static BOOLEAN jjOR_I(leftv res, leftv u, leftv v)
1356{
1357  res->data = (char *)((long)u->Data() || (long)v->Data());
1358  return FALSE;
1359}
1360static BOOLEAN jjINDEX_I(leftv res, leftv u, leftv v)
1361{
1362  res->rtyp=u->rtyp; u->rtyp=0;
1363  res->data=u->data; u->data=NULL;
1364  res->name=u->name; u->name=NULL;
1365  res->e=u->e;       u->e=NULL;
1366  if (res->e==NULL) res->e=jjMakeSub(v);
1367  else
1368  {
1369    Subexpr sh=res->e;
1370    while (sh->next != NULL) sh=sh->next;
1371    sh->next=jjMakeSub(v);
1372  }
1373  return FALSE;
1374}
1375static BOOLEAN jjINDEX_IV(leftv res, leftv u, leftv v)
1376{
1377  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1378  {
1379    WerrorS("indexed object must have a name");
1380    return TRUE;
1381  }
1382  intvec * iv=(intvec *)v->Data();
1383  leftv p=NULL;
1384  int i;
1385  sleftv t;
1386  memset(&t,0,sizeof(t));
1387  t.rtyp=INT_CMD;
1388  for (i=0;i<iv->length(); i++)
1389  {
1390    t.data=(char *)((long)(*iv)[i]);
1391    if (p==NULL)
1392    {
1393      p=res;
1394    }
1395    else
1396    {
1397      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1398      p=p->next;
1399    }
1400    p->rtyp=IDHDL;
1401    p->data=u->data;
1402    p->name=u->name;
1403    p->flag=u->flag;
1404    p->e=jjMakeSub(&t);
1405  }
1406  u->rtyp=0;
1407  u->data=NULL;
1408  u->name=NULL;
1409  return FALSE;
1410}
1411static BOOLEAN jjINDEX_P(leftv res, leftv u, leftv v)
1412{
1413  poly p=(poly)u->Data();
1414  int i=(int)(long)v->Data();
1415  int j=0;
1416  while (p!=NULL)
1417  {
1418    j++;
1419    if (j==i)
1420    {
1421      res->data=(char *)pHead(p);
1422      return FALSE;
1423    }
1424    pIter(p);
1425  }
1426  return FALSE;
1427}
1428static BOOLEAN jjINDEX_P_IV(leftv res, leftv u, leftv v)
1429{
1430  poly p=(poly)u->Data();
1431  poly r=NULL;
1432  intvec *iv=(intvec *)v->CopyD(INTVEC_CMD);
1433  int i;
1434  int sum=0;
1435  for(i=iv->length()-1;i>=0;i--)
1436    sum+=(*iv)[i];
1437  int j=0;
1438  while ((p!=NULL) && (sum>0))
1439  {
1440    j++;
1441    for(i=iv->length()-1;i>=0;i--)
1442    {
1443      if (j==(*iv)[i])
1444      {
1445        r=pAdd(r,pHead(p));
1446        sum-=j;
1447        (*iv)[i]=0;
1448        break;
1449      }
1450    }
1451    pIter(p);
1452  }
1453  delete iv;
1454  res->data=(char *)r;
1455  return FALSE;
1456}
1457static BOOLEAN jjINDEX_V(leftv res, leftv u, leftv v)
1458{
1459  poly p=(poly)u->CopyD(VECTOR_CMD);
1460  poly r=p; // pointer to the beginning of component i
1461  poly o=NULL;
1462  unsigned i=(unsigned)(long)v->Data();
1463  while (p!=NULL)
1464  {
1465    if (pGetComp(p)!=i)
1466    {
1467      if (r==p) r=pNext(p);
1468      if (o!=NULL)
1469      {
1470        if (pNext(o)!=NULL) pLmDelete(&pNext(o));
1471        p=pNext(o);
1472      }
1473      else
1474        pLmDelete(&p);
1475    }
1476    else
1477    {
1478      pSetComp(p, 0);
1479      p_SetmComp(p, currRing);
1480      o=p;
1481      p=pNext(o);
1482    }
1483  }
1484  res->data=(char *)r;
1485  return FALSE;
1486}
1487static BOOLEAN jjINDEX_V_IV(leftv res, leftv u, leftv v)
1488{
1489  poly p=(poly)u->CopyD(VECTOR_CMD);
1490  if (p!=NULL)
1491  {
1492    poly r=pOne();
1493    poly hp=r;
1494    intvec *iv=(intvec *)v->Data();
1495    int i;
1496    loop
1497    {
1498      for(i=0;i<iv->length();i++)
1499      {
1500        if (((int)pGetComp(p))==(*iv)[i])
1501        {
1502          poly h;
1503          pSplit(p,&h);
1504          pNext(hp)=p;
1505          p=h;
1506          pIter(hp);
1507          break;
1508        }
1509      }
1510      if (p==NULL) break;
1511      if (i==iv->length())
1512      {
1513        pLmDelete(&p);
1514        if (p==NULL) break;
1515      }
1516    }
1517    pLmDelete(&r);
1518    res->data=(char *)r;
1519  }
1520  return FALSE;
1521}
1522static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v);
1523static BOOLEAN jjKLAMMER(leftv res, leftv u, leftv v)
1524{
1525  if(u->name==NULL) return TRUE;
1526  char * nn = (char *)omAlloc(strlen(u->name) + 14);
1527  sprintf(nn,"%s(%d)",u->name,(int)(long)v->Data());
1528  omFree((ADDRESS)u->name);
1529  u->name=NULL;
1530  char *n=omStrDup(nn);
1531  omFree((ADDRESS)nn);
1532  syMake(res,n);
1533  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1534  return FALSE;
1535}
1536static BOOLEAN jjKLAMMER_IV(leftv res, leftv u, leftv v)
1537{
1538  intvec * iv=(intvec *)v->Data();
1539  leftv p=NULL;
1540  int i;
1541  long slen = strlen(u->name) + 14;
1542  char *n = (char*) omAlloc(slen);
1543
1544  for (i=0;i<iv->length(); i++)
1545  {
1546    if (p==NULL)
1547    {
1548      p=res;
1549    }
1550    else
1551    {
1552      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1553      p=p->next;
1554    }
1555    sprintf(n,"%s(%d)",u->name,(*iv)[i]);
1556    syMake(p,omStrDup(n));
1557  }
1558  omFree((ADDRESS)u->name);
1559  u->name = NULL;
1560  omFreeSize(n, slen);
1561  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1562  return FALSE;
1563}
1564static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v)
1565{
1566  leftv tmp=(leftv)omAllocBin(sleftv_bin);
1567  memset(tmp,0,sizeof(sleftv));
1568  BOOLEAN b;
1569  if (v->Typ()==INTVEC_CMD)
1570    b=jjKLAMMER_IV(tmp,u,v);
1571  else
1572    b=jjKLAMMER(tmp,u,v);
1573  if (b)
1574  {
1575    omFreeBin(tmp,sleftv_bin);
1576    return TRUE;
1577  }
1578  leftv h=res;
1579  while (h->next!=NULL) h=h->next;
1580  h->next=tmp;
1581  return FALSE;
1582}
1583BOOLEAN jjPROC(leftv res, leftv u, leftv v)
1584{
1585  void *d;
1586  Subexpr e;
1587  int typ;
1588  BOOLEAN t=FALSE;
1589  idhdl tmp_proc=NULL;
1590  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1591  {
1592    tmp_proc=(idhdl)omAlloc0(sizeof(idrec));
1593    tmp_proc->id="_auto";
1594    tmp_proc->typ=PROC_CMD;
1595    tmp_proc->data.pinf=(procinfo *)u->Data();
1596    tmp_proc->ref=1;
1597    d=u->data; u->data=(void *)tmp_proc;
1598    e=u->e; u->e=NULL;
1599    t=TRUE;
1600    typ=u->rtyp; u->rtyp=IDHDL;
1601  }
1602  BOOLEAN sl;
1603  if (u->req_packhdl==currPack)
1604    sl = iiMake_proc((idhdl)u->data,NULL,v);
1605  else
1606    sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1607  if (t)
1608  {
1609    u->rtyp=typ;
1610    u->data=d;
1611    u->e=e;
1612    omFreeSize(tmp_proc,sizeof(idrec));
1613  }
1614  if (sl) return TRUE;
1615  memcpy(res,&iiRETURNEXPR,sizeof(sleftv));
1616  iiRETURNEXPR.Init();
1617  return FALSE;
1618}
1619static BOOLEAN jjMAP(leftv res, leftv u, leftv v)
1620{
1621  //Print("try to map %s with %s\n",$3.Name(),$1.Name());
1622  leftv sl=NULL;
1623  if ((v->e==NULL)&&(v->name!=NULL))
1624  {
1625    map m=(map)u->Data();
1626    sl=iiMap(m,v->name);
1627  }
1628  else
1629  {
1630    Werror("%s(<name>) expected",u->Name());
1631  }
1632  if (sl==NULL) return TRUE;
1633  memcpy(res,sl,sizeof(sleftv));
1634  omFreeBin((ADDRESS)sl, sleftv_bin);
1635  return FALSE;
1636}
1637static BOOLEAN jjCHINREM_BI(leftv res, leftv u, leftv v)
1638{
1639  intvec *c=(intvec*)u->Data();
1640  intvec* p=(intvec*)v->Data();
1641  int rl=p->length();
1642  number *x=(number *)omAlloc(rl*sizeof(number));
1643  number *q=(number *)omAlloc(rl*sizeof(number));
1644  int i;
1645  for(i=rl-1;i>=0;i--)
1646  {
1647    q[i]=n_Init((*p)[i], coeffs_BIGINT);
1648    x[i]=n_Init((*c)[i], coeffs_BIGINT);
1649  }
1650  number n=n_ChineseRemainderSym(x,q,rl,FALSE,coeffs_BIGINT);
1651  for(i=rl-1;i>=0;i--)
1652  {
1653    n_Delete(&(q[i]),coeffs_BIGINT);
1654    n_Delete(&(x[i]),coeffs_BIGINT);
1655  }
1656  omFree(x); omFree(q);
1657  res->data=(char *)n;
1658  return FALSE;
1659}
1660#if 0
1661static BOOLEAN jjCHINREM_P(leftv res, leftv u, leftv v)
1662{
1663  lists c=(lists)u->CopyD(); // list of poly
1664  intvec* p=(intvec*)v->Data();
1665  int rl=p->length();
1666  poly r=NULL,h, result=NULL;
1667  number *x=(number *)omAlloc(rl*sizeof(number));
1668  number *q=(number *)omAlloc(rl*sizeof(number));
1669  int i;
1670  for(i=rl-1;i>=0;i--)
1671  {
1672    q[i]=nlInit((*p)[i]);
1673  }
1674  loop
1675  {
1676    for(i=rl-1;i>=0;i--)
1677    {
1678      if (c->m[i].Typ()!=POLY_CMD)
1679      {
1680        Werror("poly expected at pos %d",i+1);
1681        for(i=rl-1;i>=0;i--)
1682        {
1683          nlDelete(&(q[i]),currRing);
1684        }
1685        omFree(x); omFree(q); // delete c
1686        return TRUE;
1687      }
1688      h=((poly)c->m[i].Data());
1689      if (r==NULL) r=h;
1690      else if (pLmCmp(r,h)==-1) r=h;
1691    }
1692    if (r==NULL) break;
1693    for(i=rl-1;i>=0;i--)
1694    {
1695      h=((poly)c->m[i].Data());
1696      if (pLmCmp(r,h)==0)
1697      {
1698        x[i]=pGetCoeff(h);
1699        h=pLmFreeAndNext(h);
1700        c->m[i].data=(char*)h;
1701      }
1702      else
1703        x[i]=nlInit(0);
1704    }
1705    number n=n_ChineseRemainder(x,q,rl,currRing->cf);
1706    for(i=rl-1;i>=0;i--)
1707    {
1708      nlDelete(&(x[i]),currRing);
1709    }
1710    h=pHead(r);
1711    pSetCoeff(h,n);
1712    result=pAdd(result,h);
1713  }
1714  for(i=rl-1;i>=0;i--)
1715  {
1716    nlDelete(&(q[i]),currRing);
1717  }
1718  omFree(x); omFree(q);
1719  res->data=(char *)result;
1720  return FALSE;
1721}
1722#endif
1723static BOOLEAN jjCHINREM_ID(leftv res, leftv u, leftv v)
1724{
1725  lists c=(lists)u->CopyD(); // list of ideal or bigint/int
1726  lists pl=NULL;
1727  intvec *p=NULL;
1728  if (v->Typ()==LIST_CMD) pl=(lists)v->Data();
1729  else                    p=(intvec*)v->Data();
1730  int rl=c->nr+1;
1731  ideal result;
1732  ideal *x=(ideal *)omAlloc(rl*sizeof(ideal));
1733  number *xx=NULL;
1734  int i;
1735  int return_type=c->m[0].Typ();
1736  if ((return_type!=IDEAL_CMD)
1737  && (return_type!=MODUL_CMD)
1738  && (return_type!=MATRIX_CMD))
1739  {
1740    if((return_type!=BIGINT_CMD)&&(return_type!=INT_CMD))
1741    {
1742      WerrorS("ideal/module/matrix expected");
1743      omFree(x); // delete c
1744      return TRUE;
1745    }
1746    else
1747      return_type=BIGINT_CMD;
1748  }
1749  if (return_type!=BIGINT_CMD)
1750  {
1751    for(i=rl-1;i>=0;i--)
1752    {
1753      if (c->m[i].Typ()!=return_type)
1754      {
1755        Werror("%s expected at pos %d",Tok2Cmdname(return_type),i+1);
1756        omFree(x); // delete c
1757        return TRUE;
1758      }
1759      x[i]=((ideal)c->m[i].Data());
1760    }
1761  }
1762  else
1763  {
1764    xx=(number *)omAlloc(rl*sizeof(number));
1765    for(i=rl-1;i>=0;i--)
1766    {
1767      if (c->m[i].Typ()==INT_CMD)
1768      {
1769        xx[i]=n_Init(((int)(long)c->m[i].Data()),coeffs_BIGINT);
1770      }
1771      else if (c->m[i].Typ()==BIGINT_CMD)
1772      {
1773        xx[i]=(number)c->m[i].Data();
1774      }
1775      else
1776      {
1777        Werror("bigint expected at pos %d",i+1);
1778        omFree(x); // delete c
1779        omFree(xx); // delete c
1780        return TRUE;
1781      }
1782    }
1783  }
1784  number *q=(number *)omAlloc(rl*sizeof(number));
1785  if (p!=NULL)
1786  {
1787    for(i=rl-1;i>=0;i--)
1788    {
1789      q[i]=n_Init((*p)[i], currRing->cf);
1790    }
1791  }
1792  else
1793  {
1794    for(i=rl-1;i>=0;i--)
1795    {
1796      if (pl->m[i].Typ()==INT_CMD)
1797      {
1798        if (return_type==BIGINT_CMD)
1799          q[i]=n_Init((int)(long)pl->m[i].Data(),coeffs_BIGINT);
1800        else
1801          q[i]=n_Init((int)(long)pl->m[i].Data(),currRing->cf);
1802      }
1803      else if (pl->m[i].Typ()==BIGINT_CMD)
1804      {
1805        if (return_type==BIGINT_CMD)
1806          q[i]=n_Copy((number)(pl->m[i].Data()),coeffs_BIGINT);
1807        else
1808          q[i]=n_Init_bigint((number)(pl->m[i].Data()),coeffs_BIGINT,currRing->cf);
1809      }
1810      else
1811      {
1812        Werror("bigint expected at pos %d",i+1);
1813        if (return_type==BIGINT_CMD)
1814        for(i++;i<rl;i++)
1815        {
1816          n_Delete(&(q[i]),coeffs_BIGINT);
1817        }
1818        else
1819        for(i++;i<rl;i++)
1820        {
1821          n_Delete(&(q[i]),currRing);
1822        }
1823
1824        omFree(x); // delete c
1825        omFree(q); // delete pl
1826        if (xx!=NULL) omFree(xx); // delete c
1827        return TRUE;
1828      }
1829    }
1830  }
1831  if (return_type==BIGINT_CMD)
1832  {
1833    number n=n_ChineseRemainderSym(xx,q,rl,TRUE,coeffs_BIGINT);
1834    res->data=(char *)n;
1835  }
1836  else
1837  {
1838    result=id_ChineseRemainder(x,q,rl,currRing);
1839    // deletes also x
1840    res->data=(char *)result;
1841  }
1842  if (return_type==BIGINT_CMD)
1843  for(i=rl-1;i>=0;i--)
1844  {
1845    n_Delete(&(q[i]),coeffs_BIGINT);
1846  }
1847  else
1848  for(i=rl-1;i>=0;i--)
1849  {
1850    n_Delete(&(q[i]),currRing);
1851  }
1852  omFree(q);
1853  res->rtyp=return_type;
1854  return FALSE;
1855}
1856static BOOLEAN jjCOEF(leftv res, leftv u, leftv v)
1857{
1858  poly p=(poly)v->Data();
1859  if ((p==NULL)||(pNext(p)!=NULL)) return TRUE;
1860  res->data=(char *)mp_CoeffProc((poly)u->Data(),p /*(poly)v->Data()*/,currRing);
1861  return FALSE;
1862}
1863static BOOLEAN jjCOEFFS_Id(leftv res, leftv u, leftv v)
1864{
1865  int i=pVar((poly)v->Data());
1866  if (i==0)
1867  {
1868    WerrorS("ringvar expected");
1869    return TRUE;
1870  }
1871  res->data=(char *)mp_Coeffs((ideal)u->CopyD(),i,currRing);
1872  return FALSE;
1873}
1874static BOOLEAN jjCOEFFS2_KB(leftv res, leftv u, leftv v)
1875{
1876  poly p = pInit();
1877  int i;
1878  for (i=1; i<=currRing->N; i++)
1879  {
1880    pSetExp(p, i, 1);
1881  }
1882  pSetm(p);
1883  res->data = (void*)idCoeffOfKBase((ideal)(u->Data()),
1884                                    (ideal)(v->Data()), p);
1885  pDelete(&p);
1886  return FALSE;
1887}
1888static BOOLEAN jjCONTRACT(leftv res, leftv u, leftv v)
1889{
1890  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data(),FALSE);
1891  return FALSE;
1892}
1893static BOOLEAN jjDEG_M_IV(leftv res, leftv u, leftv v)
1894{
1895  short *iv=iv2array((intvec *)v->Data(),currRing);
1896  ideal I=(ideal)u->Data();
1897  int d=-1;
1898  int i;
1899  for(i=IDELEMS(I);i>=0;i--) d=si_max(d,(int)p_DegW(I->m[i],iv,currRing));
1900  omFreeSize( (ADDRESS)iv, (rVar(currRing)+1)*sizeof(short) );
1901  res->data = (char *)((long)d);
1902  return FALSE;
1903}
1904static BOOLEAN jjDEG_IV(leftv res, leftv u, leftv v)
1905{
1906  poly p=(poly)u->Data();
1907  if (p!=NULL)
1908  {
1909    short *iv=iv2array((intvec *)v->Data(),currRing);
1910    const long d = p_DegW(p,iv,currRing);
1911    omFreeSize( (ADDRESS)iv, (rVar(currRing)+1)*sizeof(short) );
1912    res->data = (char *)(d);
1913  }
1914  else
1915    res->data=(char *)(long)(-1);
1916  return FALSE;
1917}
1918static BOOLEAN jjDIFF_P(leftv res, leftv u, leftv v)
1919{
1920  int i=pVar((poly)v->Data());
1921  if (i==0)
1922  {
1923    WerrorS("ringvar expected");
1924    return TRUE;
1925  }
1926  res->data=(char *)pDiff((poly)(u->Data()),i);
1927  return FALSE;
1928}
1929static BOOLEAN jjDIFF_ID(leftv res, leftv u, leftv v)
1930{
1931  int i=pVar((poly)v->Data());
1932  if (i==0)
1933  {
1934    WerrorS("ringvar expected");
1935    return TRUE;
1936  }
1937  res->data=(char *)idDiff((matrix)(u->Data()),i);
1938  return FALSE;
1939}
1940static BOOLEAN jjDIFF_ID_ID(leftv res, leftv u, leftv v)
1941{
1942  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data());
1943  return FALSE;
1944}
1945static BOOLEAN jjDIM2(leftv res, leftv v, leftv w)
1946{
1947  assumeStdFlag(v);
1948#ifdef HAVE_RINGS
1949  if (rField_is_Ring(currRing))
1950  {
1951    //ring origR = currRing;
1952    //ring tempR = rCopy(origR);
1953    //coeffs new_cf=nInitChar(n_Q,NULL);
1954    //nKillChar(tempR->cf);
1955    //tempR->cf=new_cf;
1956    //rComplete(tempR);
1957    ideal vid = (ideal)v->Data();
1958    int i = idPosConstant(vid);
1959    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
1960    { /* ideal v contains unit; dim = -1 */
1961      res->data = (char *)-1;
1962      return FALSE;
1963    }
1964    //rChangeCurrRing(tempR);
1965    //ideal vv = idrCopyR(vid, origR, currRing);
1966    ideal vv = id_Copy(vid, currRing);
1967    //ideal ww = idrCopyR((ideal)w->Data(), origR, currRing);
1968    ideal ww = id_Copy((ideal)w->Data(), currRing);
1969    /* drop degree zero generator from vv (if any) */
1970    if (i != -1) pDelete(&vv->m[i]);
1971    long d = (long)scDimInt(vv, ww);
1972    if (rField_is_Ring_Z(currRing) && (i == -1)) d++;
1973    res->data = (char *)d;
1974    idDelete(&vv); idDelete(&ww);
1975    //rChangeCurrRing(origR);
1976    //rDelete(tempR);
1977    return FALSE;
1978  }
1979#endif
1980  if(currQuotient==NULL)
1981    res->data = (char *)((long)scDimInt((ideal)(v->Data()),(ideal)w->Data()));
1982  else
1983  {
1984    ideal q=idSimpleAdd(currQuotient,(ideal)w->Data());
1985    res->data = (char *)((long)scDimInt((ideal)(v->Data()),q));
1986    idDelete(&q);
1987  }
1988  return FALSE;
1989}
1990static BOOLEAN jjDIVISION(leftv res, leftv u, leftv v)
1991{
1992  ideal vi=(ideal)v->Data();
1993  int vl= IDELEMS(vi);
1994  ideal ui=(ideal)u->Data();
1995  int ul= IDELEMS(ui);
1996  ideal R; matrix U;
1997  ideal m = idLift(vi,ui,&R, FALSE,hasFlag(v,FLAG_STD),TRUE,&U);
1998  if (m==NULL) return TRUE;
1999  // now make sure that all matices have the corect size:
2000  matrix T = id_Module2formatedMatrix(m,vl,ul,currRing);
2001  int i;
2002  if (MATCOLS(U) != ul)
2003  {
2004    int mul=si_min(ul,MATCOLS(U));
2005    matrix UU=mpNew(ul,ul);
2006    int j;
2007    for(i=mul;i>0;i--)
2008    {
2009      for(j=mul;j>0;j--)
2010      {
2011        MATELEM(UU,i,j)=MATELEM(U,i,j);
2012        MATELEM(U,i,j)=NULL;
2013      }
2014    }
2015    idDelete((ideal *)&U);
2016    U=UU;
2017  }
2018  // make sure that U is a diagonal matrix of units
2019  for(i=ul;i>0;i--)
2020  {
2021    if(MATELEM(U,i,i)==NULL) MATELEM(U,i,i)=pOne();
2022  }
2023  lists L=(lists)omAllocBin(slists_bin);
2024  L->Init(3);
2025  L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)T;
2026  L->m[1].rtyp=u->Typ();     L->m[1].data=(void *)R;
2027  L->m[2].rtyp=MATRIX_CMD;   L->m[2].data=(void *)U;
2028  res->data=(char *)L;
2029  return FALSE;
2030}
2031static BOOLEAN jjELIMIN(leftv res, leftv u, leftv v)
2032{
2033  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data());
2034  //setFlag(res,FLAG_STD);
2035  return FALSE;
2036}
2037static BOOLEAN jjELIMIN_IV(leftv res, leftv u, leftv v)
2038{
2039  poly p=pOne();
2040  intvec *iv=(intvec*)v->Data();
2041  for(int i=iv->length()-1; i>=0; i--)
2042  {
2043    pSetExp(p,(*iv)[i],1);
2044  }
2045  pSetm(p);
2046  res->data=(char *)idElimination((ideal)u->Data(),p);
2047  pLmDelete(&p);
2048  //setFlag(res,FLAG_STD);
2049  return FALSE;
2050}
2051static BOOLEAN jjEXPORTTO(leftv, leftv u, leftv v)
2052{
2053  //Print("exportto %s -> %s\n",v->Name(),u->Name() );
2054  return iiExport(v,0,IDPACKAGE((idhdl)u->data));
2055}
2056static BOOLEAN jjERROR(leftv, leftv u)
2057{
2058  WerrorS((char *)u->Data());
2059  extern int inerror;
2060  inerror=3;
2061  return TRUE;
2062}
2063static BOOLEAN jjEXTGCD_BI(leftv res, leftv u, leftv v)
2064{
2065  number uu=(number)u->Data();number vv=(number)v->Data();
2066  lists L=(lists)omAllocBin(slists_bin);
2067  number a,b;
2068  number p0=n_ExtGcd(uu,vv,&a,&b,coeffs_BIGINT);
2069  L->Init(3);
2070  L->m[0].rtyp=BIGINT_CMD;   L->m[0].data=(void *)p0;
2071  L->m[1].rtyp=BIGINT_CMD;   L->m[1].data=(void *)a;
2072  L->m[2].rtyp=BIGINT_CMD;   L->m[2].data=(void *)b;
2073  res->rtyp=LIST_CMD;
2074  res->data=(char *)L;
2075  return FALSE;
2076}
2077static BOOLEAN jjEXTGCD_I(leftv res, leftv u, leftv v)
2078{
2079  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2080  int p0=ABS(uu),p1=ABS(vv);
2081  int f0 = 1, f1 = 0, g0 = 0, g1 = 1, q, r;
2082
2083  while ( p1!=0 )
2084  {
2085    q=p0 / p1;
2086    r=p0 % p1;
2087    p0 = p1; p1 = r;
2088    r = g0 - g1 * q;
2089    g0 = g1; g1 = r;
2090    r = f0 - f1 * q;
2091    f0 = f1; f1 = r;
2092  }
2093  int a = f0;
2094  int b = g0;
2095  if ( uu /*(int)(long)u->Data()*/ < 0 ) a=-a;
2096  if ( vv /*(int)(long)v->Data()*/ < 0 ) b=-b;
2097  lists L=(lists)omAllocBin(slists_bin);
2098  L->Init(3);
2099  L->m[0].rtyp=INT_CMD;   L->m[0].data=(void *)(long)p0;
2100  L->m[1].rtyp=INT_CMD;   L->m[1].data=(void *)(long)a;
2101  L->m[2].rtyp=INT_CMD;   L->m[2].data=(void *)(long)b;
2102  res->rtyp=LIST_CMD;
2103  res->data=(char *)L;
2104  return FALSE;
2105}
2106static BOOLEAN jjEXTGCD_P(leftv res, leftv u, leftv v)
2107{
2108  poly r,pa,pb;
2109  BOOLEAN ret=singclap_extgcd((poly)u->Data(),(poly)v->Data(),r,pa,pb,currRing);
2110  if (ret) return TRUE;
2111  lists L=(lists)omAllocBin(slists_bin);
2112  L->Init(3);
2113  res->data=(char *)L;
2114  L->m[0].data=(void *)r;
2115  L->m[0].rtyp=POLY_CMD;
2116  L->m[1].data=(void *)pa;
2117  L->m[1].rtyp=POLY_CMD;
2118  L->m[2].data=(void *)pb;
2119  L->m[2].rtyp=POLY_CMD;
2120  return FALSE;
2121}
2122extern int singclap_factorize_retry;
2123static BOOLEAN jjFAC_P2(leftv res, leftv u,leftv dummy)
2124{
2125  intvec *v=NULL;
2126  int sw=(int)(long)dummy->Data();
2127  int fac_sw=sw;
2128  if ((sw<0)||(sw>2)) fac_sw=1;
2129  singclap_factorize_retry=0;
2130  ideal f=singclap_factorize((poly)(u->CopyD()), &v, fac_sw,currRing);
2131  if (f==NULL)
2132    return TRUE;
2133  switch(sw)
2134  {
2135    case 0:
2136    case 2:
2137    {
2138      lists l=(lists)omAllocBin(slists_bin);
2139      l->Init(2);
2140      l->m[0].rtyp=IDEAL_CMD;
2141      l->m[0].data=(void *)f;
2142      l->m[1].rtyp=INTVEC_CMD;
2143      l->m[1].data=(void *)v;
2144      res->data=(void *)l;
2145      res->rtyp=LIST_CMD;
2146      return FALSE;
2147    }
2148    case 1:
2149      res->data=(void *)f;
2150      return FALSE;
2151    case 3:
2152      {
2153        poly p=f->m[0];
2154        int i=IDELEMS(f);
2155        f->m[0]=NULL;
2156        while(i>1)
2157        {
2158          i--;
2159          p=pMult(p,f->m[i]);
2160          f->m[i]=NULL;
2161        }
2162        res->data=(void *)p;
2163        res->rtyp=POLY_CMD;
2164      }
2165      return FALSE;
2166  }
2167  WerrorS("invalid switch");
2168  return TRUE;
2169}
2170static BOOLEAN jjFACSTD2(leftv res, leftv v, leftv w)
2171{
2172  ideal_list p,h;
2173  h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL,(ideal)w->Data());
2174  p=h;
2175  int l=0;
2176  while (p!=NULL) { p=p->next;l++; }
2177  lists L=(lists)omAllocBin(slists_bin);
2178  L->Init(l);
2179  l=0;
2180  while(h!=NULL)
2181  {
2182    L->m[l].data=(char *)h->d;
2183    L->m[l].rtyp=IDEAL_CMD;
2184    p=h->next;
2185    omFreeSize(h,sizeof(*h));
2186    h=p;
2187    l++;
2188  }
2189  res->data=(void *)L;
2190  return FALSE;
2191}
2192static BOOLEAN jjFAREY_BI(leftv res, leftv u, leftv v)
2193{
2194  if (rField_is_Q(currRing))
2195  {
2196    number uu=(number)u->Data();
2197    number vv=(number)v->Data();
2198    res->data=(char *)n_Farey(uu,vv,currRing->cf);
2199    return FALSE;
2200  }
2201  else return TRUE;
2202}
2203static BOOLEAN jjFAREY_ID(leftv res, leftv u, leftv v)
2204{
2205  ideal uu=(ideal)u->Data();
2206  number vv=(number)v->Data();
2207  res->data=(void*)id_Farey(uu,vv,currRing);
2208  res->rtyp=u->Typ();
2209  return FALSE;
2210}
2211static BOOLEAN jjFETCH(leftv res, leftv u, leftv v)
2212{
2213  ring r=(ring)u->Data();
2214  idhdl w;
2215  int op=iiOp;
2216  nMapFunc nMap;
2217
2218  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
2219  {
2220    int *perm=NULL;
2221    int *par_perm=NULL;
2222    int par_perm_size=0;
2223    BOOLEAN bo;
2224    //if (!nSetMap(rInternalChar(r),r->parameter,rPar(r),r->minpoly))
2225    if ((nMap=n_SetMap(r->cf,currRing->cf))==NULL)
2226    {
2227      // Allow imap/fetch to be make an exception only for:
2228      if ( (rField_is_Q_a(r) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2229            (rField_is_Q(currRing) || rField_is_Q_a(currRing) ||
2230             (rField_is_Zp(currRing) || rField_is_Zp_a(currRing))))
2231           ||
2232           (rField_is_Zp_a(r) &&  // Zp(a..) -> Zp(a..) || Zp
2233            (rField_is_Zp(currRing, r->cf->ch) ||
2234             rField_is_Zp_a(currRing, r->cf->ch))) )
2235      {
2236        par_perm_size=rPar(r);
2237      }
2238      else
2239      {
2240        goto err_fetch;
2241      }
2242    }
2243    if ((iiOp!=FETCH_CMD) || (r->N!=currRing->N) || (rPar(r)!=rPar(currRing)))
2244    {
2245      perm=(int *)omAlloc0((r->N+1)*sizeof(int));
2246      if (par_perm_size!=0)
2247        par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2248      op=IMAP_CMD;
2249      if (iiOp==IMAP_CMD)
2250      {
2251        int r_par=0;
2252        char ** r_par_names=NULL;
2253        if (r->cf->extRing!=NULL)
2254        {
2255          r_par=r->cf->extRing->N;
2256          r_par_names=r->cf->extRing->names;
2257        }
2258        int c_par=0;
2259        char ** c_par_names=NULL;
2260        if (currRing->cf->extRing!=NULL)
2261        {
2262          c_par=currRing->cf->extRing->N;
2263          c_par_names=currRing->cf->extRing->names;
2264        }
2265        maFindPerm(r->names,       r->N,       r_par_names, r_par,
2266                   currRing->names,currRing->N,c_par_names, c_par,
2267                   perm,par_perm, currRing->cf->type);
2268      }
2269      else
2270      {
2271        int i;
2272        if (par_perm_size!=0)
2273          for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2274        for(i=si_min(r->N,currRing->N);i>0;i--) perm[i]=i;
2275      }
2276    }
2277    if ((iiOp==FETCH_CMD) &&(BVERBOSE(V_IMAP)))
2278    {
2279      int i;
2280      for(i=0;i<si_min(r->N,currRing->N);i++)
2281      {
2282        Print("// var nr %d: %s -> %s\n",i,r->names[i],currRing->names[i]);
2283      }
2284      for(i=0;i<si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
2285      {
2286        Print("// par nr %d: %s -> %s\n",
2287              i,rParameter(r)[i],rParameter(currRing)[i]);
2288      }
2289    }
2290    sleftv tmpW;
2291    memset(&tmpW,0,sizeof(sleftv));
2292    tmpW.rtyp=IDTYP(w);
2293    tmpW.data=IDDATA(w);
2294    if ((bo=maApplyFetch(op,NULL,res,&tmpW, r,
2295                         perm,par_perm,par_perm_size,nMap)))
2296    {
2297      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
2298    }
2299    if (perm!=NULL)
2300      omFreeSize((ADDRESS)perm,(r->N+1)*sizeof(int));
2301    if (par_perm!=NULL)
2302      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2303    return bo;
2304  }
2305  else
2306  {
2307    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
2308  }
2309  return TRUE;
2310err_fetch:
2311  Werror("no identity map from %s",u->Fullname());
2312  return TRUE;
2313}
2314static BOOLEAN jjFIND2(leftv res, leftv u, leftv v)
2315{
2316  /*4
2317  * look for the substring what in the string where
2318  * return the position of the first char of what in where
2319  * or 0
2320  */
2321  char *where=(char *)u->Data();
2322  char *what=(char *)v->Data();
2323  char *found = strstr(where,what);
2324  if (found != NULL)
2325  {
2326    res->data=(char *)((found-where)+1);
2327  }
2328  /*else res->data=NULL;*/
2329  return FALSE;
2330}
2331static BOOLEAN jjFWALK(leftv res, leftv u, leftv v)
2332{
2333  res->data=(char *)fractalWalkProc(u,v);
2334  setFlag( res, FLAG_STD );
2335  return FALSE;
2336}
2337static BOOLEAN jjGCD_I(leftv res, leftv u, leftv v)
2338{
2339  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2340  int p0=ABS(uu),p1=ABS(vv);
2341  int r;
2342  while ( p1!=0 )
2343  {
2344    r=p0 % p1;
2345    p0 = p1; p1 = r;
2346  }
2347  res->rtyp=INT_CMD;
2348  res->data=(char *)(long)p0;
2349  return FALSE;
2350}
2351static BOOLEAN jjGCD_BI(leftv res, leftv u, leftv v)
2352{
2353  number n1 = (number) u->CopyD();
2354  number n2 = (number) v->CopyD();
2355  CanonicalForm C1, C2;
2356  C1 = coeffs_BIGINT->convSingNFactoryN (n1,TRUE,coeffs_BIGINT);
2357  C2 = coeffs_BIGINT->convSingNFactoryN (n2,TRUE,coeffs_BIGINT);
2358  CanonicalForm G = gcd (C1,C2);
2359  number g = coeffs_BIGINT->convFactoryNSingN (G,coeffs_BIGINT);
2360  res->data = g;
2361  return FALSE;
2362}
2363static BOOLEAN jjGCD_N(leftv res, leftv u, leftv v)
2364{
2365  number a=(number) u->Data();
2366  number b=(number) v->Data();
2367  if (nIsZero(a))
2368  {
2369    if (nIsZero(b)) res->data=(char *)nInit(1);
2370    else            res->data=(char *)nCopy(b);
2371  }
2372  else
2373  {
2374    if (nIsZero(b))  res->data=(char *)nCopy(a);
2375    else res->data=(char *)nGcd(a, b, currRing);
2376  }
2377  return FALSE;
2378}
2379static BOOLEAN jjGCD_P(leftv res, leftv u, leftv v)
2380{
2381  res->data=(void *)singclap_gcd((poly)(u->CopyD(POLY_CMD)),
2382                                 (poly)(v->CopyD(POLY_CMD)),currRing);
2383  return FALSE;
2384}
2385static BOOLEAN jjHILBERT2(leftv res, leftv u, leftv v)
2386{
2387#ifdef HAVE_RINGS
2388  if (rField_is_Ring_Z(currRing))
2389  {
2390    ring origR = currRing;
2391    ring tempR = rCopy(origR);
2392    coeffs new_cf=nInitChar(n_Q,NULL);
2393    nKillChar(tempR->cf);
2394    tempR->cf=new_cf;
2395    rComplete(tempR);
2396    ideal uid = (ideal)u->Data();
2397    rChangeCurrRing(tempR);
2398    ideal uu = idrCopyR(uid, origR, currRing);
2399    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
2400    uuAsLeftv.rtyp = IDEAL_CMD;
2401    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
2402    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
2403    assumeStdFlag(&uuAsLeftv);
2404    Print("// NOTE: computation of Hilbert series etc. is being\n");
2405    Print("//       performed for generic fibre, that is, over Q\n");
2406    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
2407    intvec *iv=hFirstSeries(uu,module_w,currQuotient);
2408    int returnWithTrue = 1;
2409    switch((int)(long)v->Data())
2410    {
2411      case 1:
2412        res->data=(void *)iv;
2413        returnWithTrue = 0;
2414      case 2:
2415        res->data=(void *)hSecondSeries(iv);
2416        delete iv;
2417        returnWithTrue = 0;
2418    }
2419    if (returnWithTrue)
2420    {
2421      WerrorS(feNotImplemented);
2422      delete iv;
2423    }
2424    idDelete(&uu);
2425    rChangeCurrRing(origR);
2426    rDelete(tempR);
2427    if (returnWithTrue) return TRUE; else return FALSE;
2428  }
2429#endif
2430  assumeStdFlag(u);
2431  intvec *module_w=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2432  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient);
2433  switch((int)(long)v->Data())
2434  {
2435    case 1:
2436      res->data=(void *)iv;
2437      return FALSE;
2438    case 2:
2439      res->data=(void *)hSecondSeries(iv);
2440      delete iv;
2441      return FALSE;
2442  }
2443  WerrorS(feNotImplemented);
2444  delete iv;
2445  return TRUE;
2446}
2447static BOOLEAN jjHOMOG_P(leftv res, leftv u, leftv v)
2448{
2449  int i=pVar((poly)v->Data());
2450  if (i==0)
2451  {
2452    WerrorS("ringvar expected");
2453    return TRUE;
2454  }
2455  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2456  int d=pWTotaldegree(p);
2457  pLmDelete(p);
2458  if (d==1)
2459    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
2460  else
2461    WerrorS("variable must have weight 1");
2462  return (d!=1);
2463}
2464static BOOLEAN jjHOMOG_ID(leftv res, leftv u, leftv v)
2465{
2466  int i=pVar((poly)v->Data());
2467  if (i==0)
2468  {
2469    WerrorS("ringvar expected");
2470    return TRUE;
2471  }
2472  pFDegProc deg;
2473  if (currRing->pLexOrder && (currRing->order[0]==ringorder_lp))
2474    deg=p_Totaldegree;
2475   else
2476    deg=currRing->pFDeg;
2477  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2478  int d=deg(p,currRing);
2479  pLmDelete(p);
2480  if (d==1)
2481    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
2482  else
2483    WerrorS("variable must have weight 1");
2484  return (d!=1);
2485}
2486static BOOLEAN jjHOMOG1_W(leftv res, leftv v, leftv u)
2487{
2488  intvec *w=new intvec(rVar(currRing));
2489  intvec *vw=(intvec*)u->Data();
2490  ideal v_id=(ideal)v->Data();
2491  pFDegProc save_FDeg=currRing->pFDeg;
2492  pLDegProc save_LDeg=currRing->pLDeg;
2493  BOOLEAN save_pLexOrder=currRing->pLexOrder;
2494  currRing->pLexOrder=FALSE;
2495  kHomW=vw;
2496  kModW=w;
2497  pSetDegProcs(currRing,kHomModDeg);
2498  res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
2499  currRing->pLexOrder=save_pLexOrder;
2500  kHomW=NULL;
2501  kModW=NULL;
2502  pRestoreDegProcs(currRing,save_FDeg,save_LDeg);
2503  if (w!=NULL) delete w;
2504  return FALSE;
2505}
2506static BOOLEAN jjINDEPSET2(leftv res, leftv u, leftv v)
2507{
2508  assumeStdFlag(u);
2509  res->data=(void *)scIndIndset((ideal)(u->Data()),(int)(long)(v->Data()),
2510                    currQuotient);
2511  return FALSE;
2512}
2513static BOOLEAN jjINTERSECT(leftv res, leftv u, leftv v)
2514{
2515  res->data=(char *)idSect((ideal)u->Data(),(ideal)v->Data());
2516  setFlag(res,FLAG_STD);
2517  return FALSE;
2518}
2519static BOOLEAN jjJanetBasis2(leftv res, leftv u, leftv v)
2520{
2521  return jjStdJanetBasis(res,u,(int)(long)v->Data());
2522}
2523static BOOLEAN jjJET_P(leftv res, leftv u, leftv v)
2524{
2525  res->data = (char *)pJet((poly)u->CopyD(), (int)(long)v->Data());
2526  return FALSE;
2527}
2528static BOOLEAN jjJET_ID(leftv res, leftv u, leftv v)
2529{
2530  res->data = (char *)id_Jet((ideal)u->Data(),(int)(long)v->Data(),currRing);
2531  return FALSE;
2532}
2533static BOOLEAN jjKBASE2(leftv res, leftv u, leftv v)
2534{
2535  assumeStdFlag(u);
2536  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2537  res->data = (char *)scKBase((int)(long)v->Data(),
2538                              (ideal)(u->Data()),currQuotient, w_u);
2539  if (w_u!=NULL)
2540  {
2541    atSet(res,omStrDup("isHomog"),ivCopy(w_u),INTVEC_CMD);
2542  }
2543  return FALSE;
2544}
2545static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w);
2546static BOOLEAN jjKERNEL(leftv res, leftv u, leftv v)
2547{
2548  return jjPREIMAGE(res,u,v,NULL);
2549}
2550static BOOLEAN jjKoszul(leftv res, leftv u, leftv v)
2551{
2552  return mpKoszul(res, u,v,NULL);
2553}
2554static BOOLEAN jjKoszul_Id(leftv res, leftv u, leftv v)
2555{
2556  sleftv h;
2557  memset(&h,0,sizeof(sleftv));
2558  h.rtyp=INT_CMD;
2559  h.data=(void *)(long)IDELEMS((ideal)v->Data());
2560  return mpKoszul(res, u, &h, v);
2561}
2562static BOOLEAN jjLIFT(leftv res, leftv u, leftv v)
2563{
2564  int ul= IDELEMS((ideal)u->Data());
2565  int vl= IDELEMS((ideal)v->Data());
2566  ideal m = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,
2567                   hasFlag(u,FLAG_STD));
2568  if (m==NULL) return TRUE;
2569  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
2570  return FALSE;
2571}
2572static BOOLEAN jjLIFTSTD(leftv res, leftv u, leftv v)
2573{
2574  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
2575  idhdl h=(idhdl)v->data;
2576  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
2577  res->data = (char *)idLiftStd((ideal)u->Data(),
2578                                &(h->data.umatrix),testHomog);
2579  setFlag(res,FLAG_STD); v->flag=0;
2580  return FALSE;
2581}
2582static BOOLEAN jjLOAD2(leftv /*res*/, leftv, leftv v)
2583{
2584  return jjLOAD((char*)v->Data(),TRUE);
2585}
2586static BOOLEAN jjLOAD_E(leftv /*res*/, leftv v, leftv u)
2587{
2588  char * s=(char *)u->Data();
2589  if(strcmp(s, "with")==0)
2590    return jjLOAD((char*)v->Data(), TRUE);
2591  WerrorS("invalid second argument");
2592  WerrorS("load(\"libname\" [,\"with\"]);");
2593  return TRUE;
2594}
2595static BOOLEAN jjMODULO(leftv res, leftv u, leftv v)
2596{
2597  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2598  tHomog hom=testHomog;
2599  if (w_u!=NULL)
2600  {
2601    w_u=ivCopy(w_u);
2602    hom=isHomog;
2603  }
2604  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
2605  if (w_v!=NULL)
2606  {
2607    w_v=ivCopy(w_v);
2608    hom=isHomog;
2609  }
2610  if ((w_u!=NULL) && (w_v==NULL))
2611    w_v=ivCopy(w_u);
2612  if ((w_v!=NULL) && (w_u==NULL))
2613    w_u=ivCopy(w_v);
2614  ideal u_id=(ideal)u->Data();
2615  ideal v_id=(ideal)v->Data();
2616  if (w_u!=NULL)
2617  {
2618     if ((*w_u).compare((w_v))!=0)
2619     {
2620       WarnS("incompatible weights");
2621       delete w_u; w_u=NULL;
2622       hom=testHomog;
2623     }
2624     else
2625     {
2626       if ((!idTestHomModule(u_id,currQuotient,w_v))
2627       || (!idTestHomModule(v_id,currQuotient,w_v)))
2628       {
2629         WarnS("wrong weights");
2630         delete w_u; w_u=NULL;
2631         hom=testHomog;
2632       }
2633     }
2634  }
2635  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u);
2636  if (w_u!=NULL)
2637  {
2638    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
2639  }
2640  delete w_v;
2641  return FALSE;
2642}
2643static BOOLEAN jjMOD_BI(leftv res, leftv u, leftv v)
2644{
2645  number q=(number)v->Data();
2646  if (n_IsZero(q,coeffs_BIGINT))
2647  {
2648    WerrorS(ii_div_by_0);
2649    return TRUE;
2650  }
2651  res->data =(char *) n_IntMod((number)u->Data(),q,coeffs_BIGINT);
2652  return FALSE;
2653}
2654static BOOLEAN jjMOD_N(leftv res, leftv u, leftv v)
2655{
2656  number q=(number)v->Data();
2657  if (nIsZero(q))
2658  {
2659    WerrorS(ii_div_by_0);
2660    return TRUE;
2661  }
2662  res->data =(char *) n_IntMod((number)u->Data(),q,currRing->cf);
2663  return FALSE;
2664}
2665static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v);
2666static BOOLEAN jjMONITOR1(leftv res, leftv v)
2667{
2668  return jjMONITOR2(res,v,NULL);
2669}
2670static BOOLEAN jjMONITOR2(leftv, leftv u,leftv v)
2671{
2672#if 0
2673  char *opt=(char *)v->Data();
2674  int mode=0;
2675  while(*opt!='\0')
2676  {
2677    if (*opt=='i') mode |= SI_PROT_I;
2678    else if (*opt=='o') mode |= SI_PROT_O;
2679    opt++;
2680  }
2681  monitor((char *)(u->Data()),mode);
2682#else
2683  si_link l=(si_link)u->Data();
2684  if (slOpen(l,SI_LINK_WRITE,u)) return TRUE;
2685  if(strcmp(l->m->type,"ASCII")!=0)
2686  {
2687    Werror("ASCII link required, not `%s`",l->m->type);
2688    slClose(l);
2689    return TRUE;
2690  }
2691  SI_LINK_SET_CLOSE_P(l); // febase handles the FILE*
2692  if ( l->name[0]!='\0') // "" is the stop condition
2693  {
2694    const char *opt;
2695    int mode=0;
2696    if (v==NULL) opt=(const char*)"i";
2697    else         opt=(const char *)v->Data();
2698    while(*opt!='\0')
2699    {
2700      if (*opt=='i') mode |= SI_PROT_I;
2701      else if (*opt=='o') mode |= SI_PROT_O;
2702      opt++;
2703    }
2704    monitor((FILE *)l->data,mode);
2705  }
2706  else
2707    monitor(NULL,0);
2708  return FALSE;
2709#endif
2710}
2711static BOOLEAN jjMONOM(leftv res, leftv v)
2712{
2713  intvec *iv=(intvec *)v->Data();
2714  poly p=pOne();
2715  int i,e;
2716  BOOLEAN err=FALSE;
2717  for(i=si_min(currRing->N,iv->length()); i>0; i--)
2718  {
2719    e=(*iv)[i-1];
2720    if (e>=0) pSetExp(p,i,e);
2721    else err=TRUE;
2722  }
2723  if (iv->length()==(currRing->N+1))
2724  {
2725    res->rtyp=VECTOR_CMD;
2726    e=(*iv)[currRing->N];
2727    if (e>=0) pSetComp(p,e);
2728    else err=TRUE;
2729  }
2730  pSetm(p);
2731  res->data=(char*)p;
2732  if(err) { pDelete(&p); WerrorS("no negative exponent allowed"); }
2733  return err;
2734}
2735static BOOLEAN jjNEWSTRUCT2(leftv, leftv u, leftv v)
2736{
2737  // u: the name of the new type
2738  // v: the elements
2739  newstruct_desc d=newstructFromString((const char *)v->Data());
2740  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
2741  return d==NULL;
2742}
2743static BOOLEAN jjPARSTR2(leftv res, leftv u, leftv v)
2744{
2745  idhdl h=(idhdl)u->data;
2746  int i=(int)(long)v->Data();
2747  int p=0;
2748  if ((0<i)
2749  && (rParameter(IDRING(h))!=NULL)
2750  && (i<=(p=rPar(IDRING(h)))))
2751    res->data=omStrDup(rParameter(IDRING(h))[i-1]);
2752  else
2753  {
2754    Werror("par number %d out of range 1..%d",i,p);
2755    return TRUE;
2756  }
2757  return FALSE;
2758}
2759#ifdef HAVE_PLURAL
2760static BOOLEAN jjPlural_num_poly(leftv res, leftv a, leftv b)
2761{
2762  if( currRing->qideal != NULL )
2763  {
2764    WerrorS("basering must NOT be a qring!");
2765    return TRUE;
2766  }
2767
2768  if (iiOp==NCALGEBRA_CMD)
2769  {
2770    return nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),currRing,false,true,false,currRing);
2771  }
2772  else
2773  {
2774    ring r=rCopy(currRing);
2775    BOOLEAN result=nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),r,false,true,false,currRing);
2776    res->data=r;
2777    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2778    return result;
2779  }
2780}
2781static BOOLEAN jjPlural_num_mat(leftv res, leftv a, leftv b)
2782{
2783  if( currRing->qideal != NULL )
2784  {
2785    WerrorS("basering must NOT be a qring!");
2786    return TRUE;
2787  }
2788
2789  if (iiOp==NCALGEBRA_CMD)
2790  {
2791    return nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,currRing,false,true,false,currRing);
2792  }
2793  else
2794  {
2795    ring r=rCopy(currRing);
2796    BOOLEAN result=nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,r,false,true,false,currRing);
2797    res->data=r;
2798    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2799    return result;
2800  }
2801}
2802static BOOLEAN jjPlural_mat_poly(leftv res, leftv a, leftv b)
2803{
2804  if( currRing->qideal != NULL )
2805  {
2806    WerrorS("basering must NOT be a qring!");
2807    return TRUE;
2808  }
2809
2810  if (iiOp==NCALGEBRA_CMD)
2811  {
2812    return nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),currRing,false,true,false,currRing);
2813  }
2814  else
2815  {
2816    ring r=rCopy(currRing);
2817    BOOLEAN result=nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),r,false,true,false,currRing);
2818    res->data=r;
2819    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2820    return result;
2821  }
2822}
2823static BOOLEAN jjPlural_mat_mat(leftv res, leftv a, leftv b)
2824{
2825  if( currRing->qideal != NULL )
2826  {
2827    WerrorS("basering must NOT be a qring!");
2828    return TRUE;
2829  }
2830
2831  if (iiOp==NCALGEBRA_CMD)
2832  {
2833    return nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,currRing,false,true,false,currRing);
2834  }
2835  else
2836  {
2837    ring r=rCopy(currRing);
2838    BOOLEAN result=nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,r,false,true,false,currRing);
2839    res->data=r;
2840    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2841    return result;
2842  }
2843}
2844static BOOLEAN jjBRACKET(leftv res, leftv a, leftv b)
2845{
2846  res->data=NULL;
2847
2848  if (rIsPluralRing(currRing))
2849  {
2850    const poly q = (poly)b->Data();
2851
2852    if( q != NULL )
2853    {
2854      if( (poly)a->Data() != NULL )
2855      {
2856        poly p = (poly)a->CopyD(POLY_CMD); // p = copy!
2857        res->data = nc_p_Bracket_qq(p,q, currRing); // p will be destroyed!
2858      }
2859    }
2860  }
2861  return FALSE;
2862}
2863static BOOLEAN jjOPPOSE(leftv res, leftv a, leftv b)
2864{
2865  /* number, poly, vector, ideal, module, matrix */
2866  ring  r = (ring)a->Data();
2867  if (r == currRing)
2868  {
2869    res->data = b->Data();
2870    res->rtyp = b->rtyp;
2871    return FALSE;
2872  }
2873  if (!rIsLikeOpposite(currRing, r))
2874  {
2875    Werror("%s is not an opposite ring to current ring",a->Fullname());
2876    return TRUE;
2877  }
2878  idhdl w;
2879  if( ((w=r->idroot->get(b->Name(),myynest))!=NULL) && (b->e==NULL))
2880  {
2881    int argtype = IDTYP(w);
2882    switch (argtype)
2883    {
2884    case NUMBER_CMD:
2885      {
2886        /* since basefields are equal, we can apply nCopy */
2887        res->data = nCopy((number)IDDATA(w));
2888        res->rtyp = argtype;
2889        break;
2890      }
2891    case POLY_CMD:
2892    case VECTOR_CMD:
2893      {
2894        poly    q = (poly)IDDATA(w);
2895        res->data = pOppose(r,q,currRing);
2896        res->rtyp = argtype;
2897        break;
2898      }
2899    case IDEAL_CMD:
2900    case MODUL_CMD:
2901      {
2902        ideal   Q = (ideal)IDDATA(w);
2903        res->data = idOppose(r,Q,currRing);
2904        res->rtyp = argtype;
2905        break;
2906      }
2907    case MATRIX_CMD:
2908      {
2909        ring save = currRing;
2910        rChangeCurrRing(r);
2911        matrix  m = (matrix)IDDATA(w);
2912        ideal   Q = id_Matrix2Module(mp_Copy(m, currRing),currRing);
2913        rChangeCurrRing(save);
2914        ideal   S = idOppose(r,Q,currRing);
2915        id_Delete(&Q, r);
2916        res->data = id_Module2Matrix(S,currRing);
2917        res->rtyp = argtype;
2918        break;
2919      }
2920    default:
2921      {
2922        WerrorS("unsupported type in oppose");
2923        return TRUE;
2924      }
2925    }
2926  }
2927  else
2928  {
2929    Werror("identifier %s not found in %s",b->Fullname(),a->Fullname());
2930    return TRUE;
2931  }
2932  return FALSE;
2933}
2934#endif /* HAVE_PLURAL */
2935
2936static BOOLEAN jjQUOT(leftv res, leftv u, leftv v)
2937{
2938  res->data = (char *)idQuot((ideal)u->Data(),(ideal)v->Data(),
2939    hasFlag(u,FLAG_STD),u->Typ()==v->Typ());
2940  id_DelMultiples((ideal)(res->data),currRing);
2941  return FALSE;
2942}
2943static BOOLEAN jjRANDOM(leftv res, leftv u, leftv v)
2944{
2945  int i=(int)(long)u->Data();
2946  int j=(int)(long)v->Data();
2947  res->data =(char *)(long)((i > j) ? i : (siRand() % (j-i+1)) + i);
2948  return FALSE;
2949}
2950static BOOLEAN jjRANK2(leftv res, leftv u, leftv v)
2951{
2952  matrix m =(matrix)u->Data();
2953  int isRowEchelon = (int)(long)v->Data();
2954  if (isRowEchelon != 1) isRowEchelon = 0;
2955  int rank = luRank(m, isRowEchelon);
2956  res->data =(char *)(long)rank;
2957  return FALSE;
2958}
2959static BOOLEAN jjREAD2(leftv res, leftv u, leftv v)
2960{
2961  si_link l=(si_link)u->Data();
2962  leftv r=slRead(l,v);
2963  if (r==NULL)
2964  {
2965    const char *s;
2966    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
2967    else                            s=sNoName;
2968    Werror("cannot read from `%s`",s);
2969    return TRUE;
2970  }
2971  memcpy(res,r,sizeof(sleftv));
2972  omFreeBin((ADDRESS)r, sleftv_bin);
2973  return FALSE;
2974}
2975static BOOLEAN jjREDUCE_P(leftv res, leftv u, leftv v)
2976{
2977  assumeStdFlag(v);
2978  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data());
2979  return FALSE;
2980}
2981static BOOLEAN jjREDUCE_ID(leftv res, leftv u, leftv v)
2982{
2983  assumeStdFlag(v);
2984  ideal ui=(ideal)u->Data();
2985  ideal vi=(ideal)v->Data();
2986  res->data = (char *)kNF(vi,currQuotient,ui);
2987  return FALSE;
2988}
2989#if 0
2990static BOOLEAN jjRES(leftv res, leftv u, leftv v)
2991{
2992  int maxl=(int)(long)v->Data();
2993  if (maxl<0)
2994  {
2995    WerrorS("length for res must not be negative");
2996    return TRUE;
2997  }
2998  int l=0;
2999  //resolvente r;
3000  syStrategy r;
3001  intvec *weights=NULL;
3002  int wmaxl=maxl;
3003  ideal u_id=(ideal)u->Data();
3004
3005  maxl--;
3006  if (/*(*/ maxl==-1 /*)*/) /*&& (iiOp!=MRES_CMD)*/
3007  {
3008    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3009    if (currQuotient!=NULL)
3010    {
3011      Warn(
3012      "full resolution in a qring may be infinite, setting max length to %d",
3013      maxl+1);
3014    }
3015  }
3016  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3017  if (weights!=NULL)
3018  {
3019    if (!idTestHomModule(u_id,currQuotient,weights))
3020    {
3021      WarnS("wrong weights given:");weights->show();PrintLn();
3022      weights=NULL;
3023    }
3024  }
3025  intvec *ww=NULL;
3026  int add_row_shift=0;
3027  if (weights!=NULL)
3028  {
3029     ww=ivCopy(weights);
3030     add_row_shift = ww->min_in();
3031     (*ww) -= add_row_shift;
3032  }
3033  else
3034    idHomModule(u_id,currQuotient,&ww);
3035  weights=ww;
3036
3037  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3038  {
3039    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3040  }
3041  else if (iiOp==SRES_CMD)
3042  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3043    r=sySchreyer(u_id,maxl+1);
3044  else if (iiOp == LRES_CMD)
3045  {
3046    int dummy;
3047    if((currQuotient!=NULL)||
3048    (!idHomIdeal (u_id,NULL)))
3049    {
3050       WerrorS
3051       ("`lres` not implemented for inhomogeneous input or qring");
3052       return TRUE;
3053    }
3054    r=syLaScala3(u_id,&dummy);
3055  }
3056  else if (iiOp == KRES_CMD)
3057  {
3058    int dummy;
3059    if((currQuotient!=NULL)||
3060    (!idHomIdeal (u_id,NULL)))
3061    {
3062       WerrorS
3063       ("`kres` not implemented for inhomogeneous input or qring");
3064       return TRUE;
3065    }
3066    r=syKosz(u_id,&dummy);
3067  }
3068  else
3069  {
3070    int dummy;
3071    if((currQuotient!=NULL)||
3072    (!idHomIdeal (u_id,NULL)))
3073    {
3074       WerrorS
3075       ("`hres` not implemented for inhomogeneous input or qring");
3076       return TRUE;
3077    }
3078    r=syHilb(u_id,&dummy);
3079  }
3080  if (r==NULL) return TRUE;
3081  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3082  r->list_length=wmaxl;
3083  res->data=(void *)r;
3084  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3085  {
3086    intvec *w=ivCopy(r->weights[0]);
3087    if (weights!=NULL) (*w) += add_row_shift;
3088    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3089    w=NULL;
3090  }
3091  else
3092  {
3093//#if 0
3094// need to set weights for ALL components (sres)
3095    if (weights!=NULL)
3096    {
3097      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3098      r->weights = (intvec**)omAlloc0Bin(char_ptr_bin);
3099      (r->weights)[0] = ivCopy(weights);
3100    }
3101//#endif
3102  }
3103  if (ww!=NULL) { delete ww; ww=NULL; }
3104  return FALSE;
3105}
3106#else
3107static BOOLEAN jjRES(leftv res, leftv u, leftv v)
3108{
3109  int maxl=(int)(long)v->Data();
3110  if (maxl<0)
3111  {
3112    WerrorS("length for res must not be negative");
3113    return TRUE;
3114  }
3115  syStrategy r;
3116  intvec *weights=NULL;
3117  int wmaxl=maxl;
3118  ideal u_id=(ideal)u->Data();
3119
3120  maxl--;
3121  if (/*(*/ maxl==-1 /*)*/) /*&& (iiOp!=MRES_CMD)*/
3122  {
3123    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3124    if (currQuotient!=NULL)
3125    {
3126      Warn(
3127      "full resolution in a qring may be infinite, setting max length to %d",
3128      maxl+1);
3129    }
3130  }
3131  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3132  if (weights!=NULL)
3133  {
3134    if (!idTestHomModule(u_id,currQuotient,weights))
3135    {
3136      WarnS("wrong weights given:");weights->show();PrintLn();
3137      weights=NULL;
3138    }
3139  }
3140  intvec *ww=NULL;
3141  int add_row_shift=0;
3142  if (weights!=NULL)
3143  {
3144     ww=ivCopy(weights);
3145     add_row_shift = ww->min_in();
3146     (*ww) -= add_row_shift;
3147  }
3148  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3149  {
3150    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3151  }
3152  else if (iiOp==SRES_CMD)
3153  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3154    r=sySchreyer(u_id,maxl+1);
3155  else if (iiOp == LRES_CMD)
3156  {
3157    int dummy;
3158    if((currQuotient!=NULL)||
3159    (!idHomIdeal (u_id,NULL)))
3160    {
3161       WerrorS
3162       ("`lres` not implemented for inhomogeneous input or qring");
3163       return TRUE;
3164    }
3165    if(currRing->N == 1)
3166      WarnS("the current implementation of `lres` may not work in the case of a single variable");
3167    r=syLaScala3(u_id,&dummy);
3168  }
3169  else if (iiOp == KRES_CMD)
3170  {
3171    int dummy;
3172    if((currQuotient!=NULL)||
3173    (!idHomIdeal (u_id,NULL)))
3174    {
3175       WerrorS
3176       ("`kres` not implemented for inhomogeneous input or qring");
3177       return TRUE;
3178    }
3179    r=syKosz(u_id,&dummy);
3180  }
3181  else
3182  {
3183    int dummy;
3184    if((currQuotient!=NULL)||
3185    (!idHomIdeal (u_id,NULL)))
3186    {
3187       WerrorS
3188       ("`hres` not implemented for inhomogeneous input or qring");
3189       return TRUE;
3190    }
3191    ideal u_id_copy=idCopy(u_id);
3192    idSkipZeroes(u_id_copy);
3193    r=syHilb(u_id_copy,&dummy);
3194    idDelete(&u_id_copy);
3195  }
3196  if (r==NULL) return TRUE;
3197  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3198  r->list_length=wmaxl;
3199  res->data=(void *)r;
3200  if ((weights!=NULL) && (ww!=NULL)) { delete ww; ww=NULL; }
3201  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3202  {
3203    ww=ivCopy(r->weights[0]);
3204    if (weights!=NULL) (*ww) += add_row_shift;
3205    atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
3206  }
3207  else
3208  {
3209    if (weights!=NULL)
3210    {
3211      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3212    }
3213  }
3214
3215  // test the La Scala case' output
3216  assume( ((iiOp == LRES_CMD) || (iiOp == HRES_CMD)) == (r->syRing != NULL) );
3217  assume( (r->syRing != NULL) == (r->resPairs != NULL) );
3218
3219  if(iiOp != HRES_CMD)
3220    assume( (r->minres != NULL) || (r->fullres != NULL) ); // is wrong for HRES_CMD...
3221  else
3222    assume( (r->orderedRes != NULL) || (r->res != NULL) ); // analog for hres...
3223
3224  return FALSE;
3225}
3226#endif
3227static BOOLEAN jjPFAC2(leftv res, leftv u, leftv v)
3228{
3229  number n1; int i;
3230
3231  if ((u->Typ() == BIGINT_CMD) ||
3232     ((u->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3233  {
3234    n1 = (number)u->CopyD();
3235  }
3236  else if (u->Typ() == INT_CMD)
3237  {
3238    i = (int)(long)u->Data();
3239    n1 = n_Init(i, coeffs_BIGINT);
3240  }
3241  else
3242  {
3243    return TRUE;
3244  }
3245
3246  i = (int)(long)v->Data();
3247
3248  lists l = primeFactorisation(n1, i);
3249  n_Delete(&n1, coeffs_BIGINT);
3250  res->data = (char*)l;
3251  return FALSE;
3252}
3253static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
3254{
3255  ring r;
3256  int i=rSum((ring)u->Data(),(ring)v->Data(),r);
3257  res->data = (char *)r;
3258  return (i==-1);
3259}
3260#define SIMPL_LMDIV 32
3261#define SIMPL_LMEQ  16
3262#define SIMPL_MULT 8
3263#define SIMPL_EQU  4
3264#define SIMPL_NULL 2
3265#define SIMPL_NORM 1
3266static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
3267{
3268  int sw = (int)(long)v->Data();
3269  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
3270  ideal id = (ideal)u->CopyD(IDEAL_CMD);
3271  if (sw & SIMPL_LMDIV)
3272  {
3273    id_DelDiv(id,currRing);
3274  }
3275  if (sw & SIMPL_LMEQ)
3276  {
3277    id_DelLmEquals(id,currRing);
3278  }
3279  if (sw & SIMPL_MULT)
3280  {
3281    id_DelMultiples(id,currRing);
3282  }
3283  else if(sw & SIMPL_EQU)
3284  {
3285    id_DelEquals(id,currRing);
3286  }
3287  if (sw & SIMPL_NULL)
3288  {
3289    idSkipZeroes(id);
3290  }
3291  if (sw & SIMPL_NORM)
3292  {
3293    id_Norm(id,currRing);
3294  }
3295  res->data = (char * )id;
3296  return FALSE;
3297}
3298extern int singclap_factorize_retry;
3299static BOOLEAN jjSQR_FREE2(leftv res, leftv u, leftv dummy)
3300{
3301  intvec *v=NULL;
3302  int sw=(int)(long)dummy->Data();
3303  int fac_sw=sw;
3304  if (sw<0) fac_sw=1;
3305  singclap_factorize_retry=0;
3306  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, fac_sw, currRing);
3307  if (f==NULL)
3308    return TRUE;
3309  switch(sw)
3310  {
3311    case 0:
3312    case 2:
3313    {
3314      lists l=(lists)omAllocBin(slists_bin);
3315      l->Init(2);
3316      l->m[0].rtyp=IDEAL_CMD;
3317      l->m[0].data=(void *)f;
3318      l->m[1].rtyp=INTVEC_CMD;
3319      l->m[1].data=(void *)v;
3320      res->data=(void *)l;
3321      res->rtyp=LIST_CMD;
3322      return FALSE;
3323    }
3324    case 1:
3325      res->data=(void *)f;
3326      return FALSE;
3327    case 3:
3328      {
3329        poly p=f->m[0];
3330        int i=IDELEMS(f);
3331        f->m[0]=NULL;
3332        while(i>1)
3333        {
3334          i--;
3335          p=pMult(p,f->m[i]);
3336          f->m[i]=NULL;
3337        }
3338        res->data=(void *)p;
3339        res->rtyp=POLY_CMD;
3340      }
3341      return FALSE;
3342  }
3343  WerrorS("invalid switch");
3344  return FALSE;
3345}
3346static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
3347{
3348  res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
3349  return FALSE;
3350}
3351static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
3352{
3353  res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
3354  //return (res->data== (void*)(long)-2);
3355  return FALSE;
3356}
3357static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
3358{
3359  int sw = (int)(long)v->Data();
3360  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3361  poly p = (poly)u->CopyD(POLY_CMD);
3362  if (sw & SIMPL_NORM)
3363  {
3364    pNorm(p);
3365  }
3366  res->data = (char * )p;
3367  return FALSE;
3368}
3369static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
3370{
3371  ideal result;
3372  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3373  tHomog hom=testHomog;
3374  ideal u_id=(ideal)(u->Data());
3375  if (w!=NULL)
3376  {
3377    if (!idTestHomModule(u_id,currQuotient,w))
3378    {
3379      WarnS("wrong weights:");w->show();PrintLn();
3380      w=NULL;
3381    }
3382    else
3383    {
3384      w=ivCopy(w);
3385      hom=isHomog;
3386    }
3387  }
3388  result=kStd(u_id,currQuotient,hom,&w,(intvec *)v->Data());
3389  idSkipZeroes(result);
3390  res->data = (char *)result;
3391  setFlag(res,FLAG_STD);
3392  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3393  return FALSE;
3394}
3395static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v);
3396static void jjSTD_1_ID(leftv res, ideal i0, int t0, ideal p0, attr a)
3397/* destroys i0, p0 */
3398/* result (with attributes) in res */
3399/* i0: SB*/
3400/* t0: type of p0*/
3401/* p0 new elements*/
3402/* a attributes of i0*/
3403{
3404  int tp;
3405  if (t0==IDEAL_CMD) tp=POLY_CMD;
3406  else               tp=VECTOR_CMD;
3407  for (int i=IDELEMS(p0)-1; i>=0; i--)
3408  {
3409    poly p=p0->m[i];
3410    p0->m[i]=NULL;
3411    if (p!=NULL)
3412    {
3413      sleftv u0,v0;
3414      memset(&u0,0,sizeof(sleftv));
3415      memset(&v0,0,sizeof(sleftv));
3416      v0.rtyp=tp;
3417      v0.data=(void*)p;
3418      u0.rtyp=t0;
3419      u0.data=i0;
3420      u0.attribute=a;
3421      setFlag(&u0,FLAG_STD);
3422      jjSTD_1(res,&u0,&v0);
3423      i0=(ideal)res->data;
3424      res->data=NULL;
3425      a=res->attribute;
3426      res->attribute=NULL;
3427      u0.CleanUp();
3428      v0.CleanUp();
3429      res->CleanUp();
3430    }
3431  }
3432  idDelete(&p0);
3433  res->attribute=a;
3434  res->data=(void *)i0;
3435  res->rtyp=t0;
3436}
3437static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
3438{
3439  ideal result;
3440  assumeStdFlag(u);
3441  ideal i1=(ideal)(u->Data());
3442  ideal i0;
3443  int r=v->Typ();
3444  if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
3445  {
3446    i0=idInit(1,i1->rank); // TODO: rank is wrong (if v is a vector!)
3447    i0->m[0]=(poly)v->Data();
3448    int ii0=idElem(i0); /* size of i0 */
3449    i1=idSimpleAdd(i1,i0); //
3450    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3451    idDelete(&i0);
3452    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3453    tHomog hom=testHomog;
3454
3455    if (w!=NULL)
3456    {
3457      if (!idTestHomModule(i1,currQuotient,w))
3458      {
3459        // no warnung: this is legal, if i in std(i,p)
3460        // is homogeneous, but p not
3461        w=NULL;
3462      }
3463      else
3464      {
3465        w=ivCopy(w);
3466        hom=isHomog;
3467      }
3468    }
3469    BITSET save1;
3470    SI_SAVE_OPT1(save1);
3471    si_opt_1|=Sy_bit(OPT_SB_1);
3472    /* ii0 appears to be the position of the first element of il that
3473       does not belong to the old SB ideal */
3474    result=kStd(i1,currQuotient,hom,&w,NULL,0,ii0);
3475    SI_RESTORE_OPT1(save1);
3476    idDelete(&i1);
3477    idSkipZeroes(result);
3478    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3479    res->data = (char *)result;
3480  }
3481  else /*IDEAL/MODULE*/
3482  {
3483    attr *aa=u->Attribute();
3484    attr a=NULL;
3485    if (aa!=NULL) a=(*aa)->Copy();
3486    jjSTD_1_ID(res,(ideal)u->CopyD(),r,(ideal)v->CopyD(),a);
3487  }
3488  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
3489  return FALSE;
3490}
3491static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3492{
3493  idhdl h=(idhdl)u->data;
3494  int i=(int)(long)v->Data();
3495  if ((0<i) && (i<=IDRING(h)->N))
3496    res->data=omStrDup(IDRING(h)->names[i-1]);
3497  else
3498  {
3499    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3500    return TRUE;
3501  }
3502  return FALSE;
3503}
3504static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3505{
3506// input: u: a list with links of type
3507//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3508//        v: timeout for select in milliseconds
3509//           or 0 for polling
3510// returns: ERROR (via Werror): timeout negative
3511//           -1: the read state of all links is eof
3512//            0: timeout (or polling): none ready
3513//           i>0: (at least) L[i] is ready
3514  lists Lforks = (lists)u->Data();
3515  int t = (int)(long)v->Data();
3516  if(t < 0)
3517  {
3518    WerrorS("negative timeout"); return TRUE;
3519  }
3520  int i = slStatusSsiL(Lforks, t*1000);
3521  if(i == -2) /* error */
3522  {
3523    return TRUE;
3524  }
3525  res->data = (void*)(long)i;
3526  return FALSE;
3527}
3528static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3529{
3530// input: u: a list with links of type
3531//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3532//        v: timeout for select in milliseconds
3533//           or 0 for polling
3534// returns: ERROR (via Werror): timeout negative
3535//           -1: the read state of all links is eof
3536//           0: timeout (or polling): none ready
3537//           1: all links are ready
3538//              (caution: at least one is ready, but some maybe dead)
3539  lists Lforks = (lists)u->CopyD();
3540  int timeout = 1000*(int)(long)v->Data();
3541  if(timeout < 0)
3542  {
3543    WerrorS("negative timeout"); return TRUE;
3544  }
3545  int t = getRTimer()/TIMER_RESOLUTION;  // in seconds
3546  int i;
3547  int ret = -1;
3548  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
3549  {
3550    i = slStatusSsiL(Lforks, timeout);
3551    if(i > 0) /* Lforks[i] is ready */
3552    {
3553      ret = 1;
3554      Lforks->m[i-1].CleanUp();
3555      Lforks->m[i-1].rtyp=DEF_CMD;
3556      Lforks->m[i-1].data=NULL;
3557      timeout = si_max(0,timeout - 1000*(getRTimer()/TIMER_RESOLUTION - t));
3558    }
3559    else /* terminate the for loop */
3560    {
3561      if(i == -2) /* error */
3562      {
3563        return TRUE;
3564      }
3565      if(i == 0) /* timeout */
3566      {
3567        ret = 0;
3568      }
3569      break;
3570    }
3571  }
3572  Lforks->Clean();
3573  res->data = (void*)(long)ret;
3574  return FALSE;
3575}
3576static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3577{
3578  res->data = (char *)mp_Wedge((matrix)u->Data(),(int)(long)v->Data(),currRing);
3579  return FALSE;
3580}
3581#define jjWRONG2 (proc2)jjWRONG
3582#define jjWRONG3 (proc3)jjWRONG
3583static BOOLEAN jjWRONG(leftv, leftv)
3584{
3585  return TRUE;
3586}
3587
3588/*=================== operations with 1 arg.: static proc =================*/
3589/* must be ordered: first operations for chars (infix ops),
3590 * then alphabetically */
3591
3592static BOOLEAN jjDUMMY(leftv res, leftv u)
3593{
3594  res->data = (char *)u->CopyD();
3595  return FALSE;
3596}
3597static BOOLEAN jjNULL(leftv, leftv)
3598{
3599  return FALSE;
3600}
3601//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3602//{
3603//  res->data = (char *)((int)(long)u->Data()+1);
3604//  return FALSE;
3605//}
3606//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3607//{
3608//  res->data = (char *)((int)(long)u->Data()-1);
3609//  return FALSE;
3610//}
3611static BOOLEAN jjPLUSPLUS(leftv, leftv u)
3612{
3613  if (IDTYP((idhdl)u->data)==INT_CMD)
3614  {
3615    int i=IDINT((idhdl)u->data);
3616    if (iiOp==PLUSPLUS) i++;
3617    else                i--;
3618    IDDATA((idhdl)u->data)=(char *)(long)i;
3619    return FALSE;
3620  }
3621  return TRUE;
3622}
3623static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3624{
3625  number n=(number)u->CopyD(BIGINT_CMD);
3626  n=n_Neg(n,coeffs_BIGINT);
3627  res->data = (char *)n;
3628  return FALSE;
3629}
3630static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3631{
3632  res->data = (char *)(-(long)u->Data());
3633  return FALSE;
3634}
3635static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3636{
3637  number n=(number)u->CopyD(NUMBER_CMD);
3638  n=nNeg(n);
3639  res->data = (char *)n;
3640  return FALSE;
3641}
3642static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3643{
3644  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3645  return FALSE;
3646}
3647static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3648{
3649  poly m1=pISet(-1);
3650  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),m1,currRing);
3651  return FALSE;
3652}
3653static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3654{
3655  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3656  (*iv)*=(-1);
3657  res->data = (char *)iv;
3658  return FALSE;
3659}
3660static BOOLEAN jjUMINUS_BIM(leftv res, leftv u)
3661{
3662  bigintmat *bim=(bigintmat *)u->CopyD(BIGINTMAT_CMD);
3663  (*bim)*=(-1);
3664  res->data = (char *)bim;
3665  return FALSE;
3666}
3667static BOOLEAN jjPROC1(leftv res, leftv u)
3668{
3669  return jjPROC(res,u,NULL);
3670}
3671static BOOLEAN jjBAREISS(leftv res, leftv v)
3672{
3673  //matrix m=(matrix)v->Data();
3674  //lists l=mpBareiss(m,FALSE);
3675  intvec *iv;
3676  ideal m;
3677  sm_CallBareiss((ideal)v->Data(),0,0,m,&iv, currRing);
3678  lists l=(lists)omAllocBin(slists_bin);
3679  l->Init(2);
3680  l->m[0].rtyp=MODUL_CMD;
3681  l->m[1].rtyp=INTVEC_CMD;
3682  l->m[0].data=(void *)m;
3683  l->m[1].data=(void *)iv;
3684  res->data = (char *)l;
3685  return FALSE;
3686}
3687//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3688//{
3689//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3690//  ivTriangMat(m);
3691//  res->data = (char *)m;
3692//  return FALSE;
3693//}
3694static BOOLEAN jjBI2N(leftv res, leftv u)
3695{
3696  BOOLEAN bo=FALSE;
3697  number n=(number)u->CopyD();
3698  nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
3699  if (nMap!=NULL)
3700    res->data=nMap(n,coeffs_BIGINT,currRing->cf);
3701  else
3702  {
3703    WerrorS("cannot convert bigint to this field");
3704    bo=TRUE;
3705  }
3706  n_Delete(&n,coeffs_BIGINT);
3707  return bo;
3708}
3709static BOOLEAN jjBI2P(leftv res, leftv u)
3710{
3711  sleftv tmp;
3712  BOOLEAN bo=jjBI2N(&tmp,u);
3713  if (!bo)
3714  {
3715    number n=(number) tmp.data;
3716    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3717    else
3718    {
3719      res->data=(void *)pNSet(n);
3720    }
3721  }
3722  return bo;
3723}
3724static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3725{
3726  return iiExprArithM(res,u,iiOp);
3727}
3728static BOOLEAN jjCHAR(leftv res, leftv v)
3729{
3730  res->data = (char *)(long)rChar((ring)v->Data());
3731  return FALSE;
3732}
3733static BOOLEAN jjCOLS(leftv res, leftv v)
3734{
3735  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3736  return FALSE;
3737}
3738static BOOLEAN jjCOLS_BIM(leftv res, leftv v)
3739{
3740  res->data = (char *)(long)((bigintmat*)(v->Data()))->cols();
3741  return FALSE;
3742}
3743static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3744{
3745  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3746  return FALSE;
3747}
3748static BOOLEAN jjCONTENT(leftv res, leftv v)
3749{
3750  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3751  poly p=(poly)v->CopyD(POLY_CMD);
3752  if (p!=NULL) p_Cleardenom(p, currRing);
3753  res->data = (char *)p;
3754  return FALSE;
3755}
3756static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3757{
3758  res->data = (char *)(long)n_Size((number)v->Data(),coeffs_BIGINT);
3759  return FALSE;
3760}
3761static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3762{
3763  res->data = (char *)(long)nSize((number)v->Data());
3764  return FALSE;
3765}
3766static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3767{
3768  lists l=(lists)v->Data();
3769  res->data = (char *)(long)(lSize(l)+1);
3770  return FALSE;
3771}
3772static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3773{
3774  matrix m=(matrix)v->Data();
3775  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3776  return FALSE;
3777}
3778static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3779{
3780  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3781  return FALSE;
3782}
3783static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3784{
3785  ring r=(ring)v->Data();
3786  int elems=-1;
3787  if (rField_is_Zp(r)||rField_is_GF(r)) elems=r->cf->ch;
3788  else if (rField_is_Zp_a(r) && (r->cf->type==n_algExt))
3789  {
3790    extern int ipower ( int b, int n ); /* factory/cf_util */
3791    elems=ipower(r->cf->ch,r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3792  }
3793  res->data = (char *)(long)elems;
3794  return FALSE;
3795}
3796static BOOLEAN jjDEG(leftv res, leftv v)
3797{
3798  int dummy;
3799  poly p=(poly)v->Data();
3800  if (p!=NULL) res->data = (char *)currRing->pLDeg(p,&dummy,currRing);
3801  else res->data=(char *)-1;
3802  return FALSE;
3803}
3804static BOOLEAN jjDEG_M(leftv res, leftv u)
3805{
3806  ideal I=(ideal)u->Data();
3807  int d=-1;
3808  int dummy;
3809  int i;
3810  for(i=IDELEMS(I)-1;i>=0;i--)
3811    if (I->m[i]!=NULL) d=si_max(d,(int)currRing->pLDeg(I->m[i],&dummy,currRing));
3812  res->data = (char *)(long)d;
3813  return FALSE;
3814}
3815static BOOLEAN jjDEGREE(leftv res, leftv v)
3816{
3817  SPrintStart();
3818#ifdef HAVE_RINGS
3819  if (rField_is_Ring_Z(currRing))
3820  {
3821    ring origR = currRing;
3822    ring tempR = rCopy(origR);
3823    coeffs new_cf=nInitChar(n_Q,NULL);
3824    nKillChar(tempR->cf);
3825    tempR->cf=new_cf;
3826    rComplete(tempR);
3827    ideal vid = (ideal)v->Data();
3828    rChangeCurrRing(tempR);
3829    ideal vv = idrCopyR(vid, origR, currRing);
3830    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
3831    vvAsLeftv.rtyp = IDEAL_CMD;
3832    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
3833    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
3834    assumeStdFlag(&vvAsLeftv);
3835    Print("// NOTE: computation of degree is being performed for\n");
3836    Print("//       generic fibre, that is, over Q\n");
3837    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
3838    scDegree(vv,module_w,currQuotient);
3839    idDelete(&vv);
3840    rChangeCurrRing(origR);
3841    rDelete(tempR);
3842  }
3843#endif
3844  assumeStdFlag(v);
3845  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3846  scDegree((ideal)v->Data(),module_w,currQuotient);
3847  char *s=SPrintEnd();
3848  int l=strlen(s)-1;
3849  s[l]='\0';
3850  res->data=(void*)s;
3851  return FALSE;
3852}
3853static BOOLEAN jjDEFINED(leftv res, leftv v)
3854{
3855  if ((v->rtyp==IDHDL)
3856  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3857  {
3858    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3859  }
3860  else if (v->rtyp!=0) res->data=(void *)(-1);
3861  return FALSE;
3862}
3863
3864/// Return the denominator of the input number
3865/// NOTE: the input number is normalized as a side effect
3866static BOOLEAN jjDENOMINATOR(leftv res, leftv v)
3867{
3868  number n = reinterpret_cast<number>(v->Data());
3869  res->data = reinterpret_cast<void*>(n_GetDenom(n, currRing));
3870  return FALSE;
3871}
3872
3873/// Return the numerator of the input number
3874/// NOTE: the input number is normalized as a side effect
3875static BOOLEAN jjNUMERATOR(leftv res, leftv v)
3876{
3877  number n = reinterpret_cast<number>(v->Data());
3878  res->data = reinterpret_cast<void*>(n_GetNumerator(n, currRing));
3879  return FALSE;
3880}
3881
3882static BOOLEAN jjDET(leftv res, leftv v)
3883{
3884  matrix m=(matrix)v->Data();
3885  poly p;
3886  if (sm_CheckDet((ideal)m,m->cols(),TRUE, currRing))
3887  {
3888    ideal I=id_Matrix2Module(mp_Copy(m, currRing),currRing);
3889    p=sm_CallDet(I, currRing);
3890    idDelete(&I);
3891  }
3892  else
3893    p=singclap_det(m,currRing);
3894  res ->data = (char *)p;
3895  return FALSE;
3896}
3897static BOOLEAN jjDET_BI(leftv res, leftv v)
3898{
3899  bigintmat * m=(bigintmat*)v->Data();
3900  int i,j;
3901  i=m->rows();j=m->cols();
3902  if(i==j)
3903    res->data = (char *)(long)singclap_det_bi(m,coeffs_BIGINT);
3904  else
3905  {
3906    Werror("det of %d x %d bigintmat",i,j);
3907    return TRUE;
3908  }
3909  return FALSE;
3910}
3911static BOOLEAN jjDET_I(leftv res, leftv v)
3912{
3913  intvec * m=(intvec*)v->Data();
3914  int i,j;
3915  i=m->rows();j=m->cols();
3916  if(i==j)
3917    res->data = (char *)(long)singclap_det_i(m,currRing);
3918  else
3919  {
3920    Werror("det of %d x %d intmat",i,j);
3921    return TRUE;
3922  }
3923  return FALSE;
3924}
3925static BOOLEAN jjDET_S(leftv res, leftv v)
3926{
3927  ideal I=(ideal)v->Data();
3928  poly p;
3929  if (IDELEMS(I)<1) return TRUE;
3930  if (sm_CheckDet(I,IDELEMS(I),FALSE, currRing))
3931  {
3932    matrix m=id_Module2Matrix(id_Copy(I,currRing),currRing);
3933    p=singclap_det(m,currRing);
3934    idDelete((ideal *)&m);
3935  }
3936  else
3937    p=sm_CallDet(I, currRing);
3938  res->data = (char *)p;
3939  return FALSE;
3940}
3941static BOOLEAN jjDIM(leftv res, leftv v)
3942{
3943  assumeStdFlag(v);
3944#ifdef HAVE_RINGS
3945  if (rField_is_Ring(currRing))
3946  {
3947    //ring origR = currRing;
3948    //ring tempR = rCopy(origR);
3949    //coeffs new_cf=nInitChar(n_Q,NULL);
3950    //nKillChar(tempR->cf);
3951    //tempR->cf=new_cf;
3952    //rComplete(tempR);
3953    ideal vid = (ideal)v->Data();
3954    int i = idPosConstant(vid);
3955    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
3956    { /* ideal v contains unit; dim = -1 */
3957      res->data = (char *)-1;
3958      return FALSE;
3959    }
3960    //rChangeCurrRing(tempR);
3961    //ideal vv = idrCopyR(vid, origR, currRing);
3962    ideal vv = id_Head(vid,currRing);
3963    /* drop degree zero generator from vv (if any) */
3964    if (i != -1) pDelete(&vv->m[i]);
3965    long d = (long)scDimInt(vv, currQuotient);
3966    if (rField_is_Ring_Z(currRing) && (i == -1)) d++;
3967    res->data = (char *)d;
3968    idDelete(&vv);
3969    //rChangeCurrRing(origR);
3970    //rDelete(tempR);
3971    return FALSE;
3972  }
3973#endif
3974  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currQuotient);
3975  return FALSE;
3976}
3977static BOOLEAN jjDUMP(leftv, leftv v)
3978{
3979  si_link l = (si_link)v->Data();
3980  if (slDump(l))
3981  {
3982    const char *s;
3983    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3984    else                            s=sNoName;
3985    Werror("cannot dump to `%s`",s);
3986    return TRUE;
3987  }
3988  else
3989    return FALSE;
3990}
3991static BOOLEAN jjE(leftv res, leftv v)
3992{
3993  res->data = (char *)pOne();
3994  int co=(int)(long)v->Data();
3995  if (co>0)
3996  {
3997    pSetComp((poly)res->data,co);
3998    pSetm((poly)res->data);
3999  }
4000  else WerrorS("argument of gen must be positive");
4001  return (co<=0);
4002}
4003static BOOLEAN jjEXECUTE(leftv, leftv v)
4004{
4005  char * d = (char *)v->Data();
4006  char * s = (char *)omAlloc(strlen(d) + 13);
4007  strcpy( s, (char *)d);
4008  strcat( s, "\n;RETURN();\n");
4009  newBuffer(s,BT_execute);
4010  return yyparse();
4011}
4012static BOOLEAN jjFACSTD(leftv res, leftv v)
4013{
4014  lists L=(lists)omAllocBin(slists_bin);
4015  if (currRing->cf->convSingNFactoryN!=NULL) /* conversion to factory*/
4016  {
4017    ideal_list p,h;
4018    h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
4019    if (h==NULL)
4020    {
4021      L->Init(1);
4022      L->m[0].data=(char *)idInit(1);
4023      L->m[0].rtyp=IDEAL_CMD;
4024    }
4025    else
4026    {
4027      p=h;
4028      int l=0;
4029      while (p!=NULL) { p=p->next;l++; }
4030      L->Init(l);
4031      l=0;
4032      while(h!=NULL)
4033      {
4034        L->m[l].data=(char *)h->d;
4035        L->m[l].rtyp=IDEAL_CMD;
4036        p=h->next;
4037        omFreeSize(h,sizeof(*h));
4038        h=p;
4039        l++;
4040      }
4041    }
4042  }
4043  else
4044  {
4045    WarnS("no factorization implemented");
4046    L->Init(1);
4047    iiExprArith1(&(L->m[0]),v,STD_CMD);
4048  }
4049  res->data=(void *)L;
4050  return FALSE;
4051}
4052static BOOLEAN jjFAC_P(leftv res, leftv u)
4053{
4054  intvec *v=NULL;
4055  singclap_factorize_retry=0;
4056  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0,currRing);
4057  if (f==NULL) return TRUE;
4058  ivTest(v);
4059  lists l=(lists)omAllocBin(slists_bin);
4060  l->Init(2);
4061  l->m[0].rtyp=IDEAL_CMD;
4062  l->m[0].data=(void *)f;
4063  l->m[1].rtyp=INTVEC_CMD;
4064  l->m[1].data=(void *)v;
4065  res->data=(void *)l;
4066  return FALSE;
4067}
4068static BOOLEAN jjGETDUMP(leftv, leftv v)
4069{
4070  si_link l = (si_link)v->Data();
4071  if (slGetDump(l))
4072  {
4073    const char *s;
4074    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4075    else                            s=sNoName;
4076    Werror("cannot get dump from `%s`",s);
4077    return TRUE;
4078  }
4079  else
4080    return FALSE;
4081}
4082static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
4083{
4084  assumeStdFlag(v);
4085  ideal I=(ideal)v->Data();
4086  res->data=(void *)iiHighCorner(I,0);
4087  return FALSE;
4088}
4089static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
4090{
4091  assumeStdFlag(v);
4092  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4093  BOOLEAN delete_w=FALSE;
4094  ideal I=(ideal)v->Data();
4095  int i;
4096  poly p=NULL,po=NULL;
4097  int rk=id_RankFreeModule(I,currRing);
4098  if (w==NULL)
4099  {
4100    w = new intvec(rk);
4101    delete_w=TRUE;
4102  }
4103  for(i=rk;i>0;i--)
4104  {
4105    p=iiHighCorner(I,i);
4106    if (p==NULL)
4107    {
4108      WerrorS("module must be zero-dimensional");
4109      if (delete_w) delete w;
4110      return TRUE;
4111    }
4112    if (po==NULL)
4113    {
4114      po=p;
4115    }
4116    else
4117    {
4118      // now po!=NULL, p!=NULL
4119      int d=(currRing->pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - currRing->pFDeg(p,currRing)+(*w)[i-1]);
4120      if (d==0)
4121        d=pLmCmp(po,p);
4122      if (d > 0)
4123      {
4124        pDelete(&p);
4125      }
4126      else // (d < 0)
4127      {
4128        pDelete(&po); po=p;
4129      }
4130    }
4131  }
4132  if (delete_w) delete w;
4133  res->data=(void *)po;
4134  return FALSE;
4135}
4136static BOOLEAN jjHILBERT(leftv, leftv v)
4137{
4138#ifdef HAVE_RINGS
4139  if (rField_is_Ring_Z(currRing))
4140  {
4141    ring origR = currRing;
4142    ring tempR = rCopy(origR);
4143    coeffs new_cf=nInitChar(n_Q,NULL);
4144    nKillChar(tempR->cf);
4145    tempR->cf=new_cf;
4146    rComplete(tempR);
4147    ideal vid = (ideal)v->Data();
4148    rChangeCurrRing(tempR);
4149    ideal vv = idrCopyR(vid, origR, currRing);
4150    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
4151    vvAsLeftv.rtyp = IDEAL_CMD;
4152    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
4153    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
4154    assumeStdFlag(&vvAsLeftv);
4155    Print("// NOTE: computation of Hilbert series etc. is being\n");
4156    Print("//       performed for generic fibre, that is, over Q\n");
4157    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
4158    //scHilbertPoly(vv,currQuotient);
4159    hLookSeries(vv,module_w,currQuotient);
4160    idDelete(&vv);
4161    rChangeCurrRing(origR);
4162    rDelete(tempR);
4163    return FALSE;
4164  }
4165#endif
4166  assumeStdFlag(v);
4167  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4168  //scHilbertPoly((ideal)v->Data(),currQuotient);
4169  hLookSeries((ideal)v->Data(),module_w,currQuotient);
4170  return FALSE;
4171}
4172static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
4173{
4174#ifdef HAVE_RINGS
4175  if (rField_is_Ring_Z(currRing))
4176  {
4177    Print("// NOTE: computation of Hilbert series etc. is being\n");
4178    Print("//       performed for generic fibre, that is, over Q\n");
4179  }
4180#endif
4181  res->data=(void *)hSecondSeries((intvec *)v->Data());
4182  return FALSE;
4183}
4184static BOOLEAN jjHOMOG1(leftv res, leftv v)
4185{
4186  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4187  ideal v_id=(ideal)v->Data();
4188  if (w==NULL)
4189  {
4190    res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
4191    if (res->data!=NULL)
4192    {
4193      if (v->rtyp==IDHDL)
4194      {
4195        char *s_isHomog=omStrDup("isHomog");
4196        if (v->e==NULL)
4197          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
4198        else
4199          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
4200      }
4201      else if (w!=NULL) delete w;
4202    } // if res->data==NULL then w==NULL
4203  }
4204  else
4205  {
4206    res->data=(void *)(long)idTestHomModule(v_id,currQuotient,w);
4207    if((res->data==NULL) && (v->rtyp==IDHDL))
4208    {
4209      if (v->e==NULL)
4210        atKill((idhdl)(v->data),"isHomog");
4211      else
4212        atKill((idhdl)(v->LData()),"isHomog");
4213    }
4214  }
4215  return FALSE;
4216}
4217static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
4218{
4219  res->data = (char *)idMaxIdeal((int)(long)v->Data());
4220  setFlag(res,FLAG_STD);
4221  return FALSE;
4222}
4223static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
4224{
4225  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
4226  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
4227  if (IDELEMS((ideal)mat)==0)
4228  {
4229    idDelete((ideal *)&mat);
4230    mat=(matrix)idInit(1,1);
4231  }
4232  else
4233  {
4234    MATROWS(mat)=1;
4235    mat->rank=1;
4236    idTest((ideal)mat);
4237  }
4238  res->data=(char *)mat;
4239  return FALSE;
4240}
4241static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4242{
4243  map m=(map)v->CopyD(MAP_CMD);
4244  omFree((ADDRESS)m->preimage);
4245  m->preimage=NULL;
4246  ideal I=(ideal)m;
4247  I->rank=1;
4248  res->data=(char *)I;
4249  return FALSE;
4250}
4251static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4252{
4253  if (currRing!=NULL)
4254  {
4255    ring q=(ring)v->Data();
4256    if (rSamePolyRep(currRing, q))
4257    {
4258      if (q->qideal==NULL)
4259        res->data=(char *)idInit(1,1);
4260      else
4261        res->data=(char *)idCopy(q->qideal);
4262      return FALSE;
4263    }
4264  }
4265  WerrorS("can only get ideal from identical qring");
4266  return TRUE;
4267}
4268static BOOLEAN jjIm2Iv(leftv res, leftv v)
4269{
4270  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4271  iv->makeVector();
4272  res->data = iv;
4273  return FALSE;
4274}
4275static BOOLEAN jjIMPART(leftv res, leftv v)
4276{
4277  res->data = (char *)n_ImPart((number)v->Data(),currRing->cf);
4278  return FALSE;
4279}
4280static BOOLEAN jjINDEPSET(leftv res, leftv v)
4281{
4282  assumeStdFlag(v);
4283  res->data=(void *)scIndIntvec((ideal)(v->Data()),currQuotient);
4284  return FALSE;
4285}
4286static BOOLEAN jjINTERRED(leftv res, leftv v)
4287{
4288  ideal result=kInterRed((ideal)(v->Data()), currQuotient);
4289  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4290  res->data = result;
4291  return FALSE;
4292}
4293static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4294{
4295  res->data = (char *)(long)pVar((poly)v->Data());
4296  return FALSE;
4297}
4298static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4299{
4300  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing->names,
4301                                                            currRing->N)+1);
4302  return FALSE;
4303}
4304static BOOLEAN jjIS_RINGVAR0(leftv res, leftv)
4305{
4306  res->data = (char *)0;
4307  return FALSE;
4308}
4309static BOOLEAN jjJACOB_P(leftv res, leftv v)
4310{
4311  ideal i=idInit(currRing->N,1);
4312  int k;
4313  poly p=(poly)(v->Data());
4314  for (k=currRing->N;k>0;k--)
4315  {
4316    i->m[k-1]=pDiff(p,k);
4317  }
4318  res->data = (char *)i;
4319  return FALSE;
4320}
4321static BOOLEAN jjDIFF_COEF(leftv res, leftv u, leftv v)
4322{
4323  if (!nCoeff_is_transExt(currRing->cf))
4324  {
4325    WerrorS("differentiation not defined in the coefficient ring");
4326    return TRUE;
4327  }
4328  number n = (number) u->Data();
4329  number k = (number) v->Data();
4330  res->data = ntDiff(n,k,currRing->cf);
4331  return FALSE;
4332}
4333/*2
4334 * compute Jacobi matrix of a module/matrix
4335 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(currRing->N))  ),
4336 * where Mt := transpose(M)
4337 * Note that this is consistent with the current conventions for jacob in Singular,
4338 * whereas M2 computes its transposed.
4339 */
4340static BOOLEAN jjJACOB_M(leftv res, leftv a)
4341{
4342  ideal id = (ideal)a->Data();
4343  id = idTransp(id);
4344  int W = IDELEMS(id);
4345
4346  ideal result = idInit(W * currRing->N, id->rank);
4347  poly *p = result->m;
4348
4349  for( int v = 1; v <= currRing->N; v++ )
4350  {
4351    poly* q = id->m;
4352    for( int i = 0; i < W; i++, p++, q++ )
4353      *p = pDiff( *q, v );
4354  }
4355  idDelete(&id);
4356
4357  res->data = (char *)result;
4358  return FALSE;
4359}
4360
4361
4362static BOOLEAN jjKBASE(leftv res, leftv v)
4363{
4364  assumeStdFlag(v);
4365  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currQuotient);
4366  return FALSE;
4367}
4368#ifdef MDEBUG
4369static BOOLEAN jjpHead(leftv res, leftv v)
4370{
4371  res->data=(char *)pHead((poly)v->Data());
4372  return FALSE;
4373}
4374#endif
4375static BOOLEAN jjL2R(leftv res, leftv v)
4376{
4377  res->data=(char *)syConvList((lists)v->Data(),FALSE);
4378  if (res->data != NULL)
4379    return FALSE;
4380  else
4381    return TRUE;
4382}
4383static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4384{
4385  poly p=(poly)v->Data();
4386  if (p==NULL)
4387  {
4388    res->data=(char *)nInit(0);
4389  }
4390  else
4391  {
4392    res->data=(char *)nCopy(pGetCoeff(p));
4393  }
4394  return FALSE;
4395}
4396static BOOLEAN jjLEADEXP(leftv res, leftv v)
4397{
4398  poly p=(poly)v->Data();
4399  int s=currRing->N;
4400  if (v->Typ()==VECTOR_CMD) s++;
4401  intvec *iv=new intvec(s);
4402  if (p!=NULL)
4403  {
4404    for(int i = currRing->N;i;i--)
4405    {
4406      (*iv)[i-1]=pGetExp(p,i);
4407    }
4408    if (s!=currRing->N)
4409      (*iv)[currRing->N]=pGetComp(p);
4410  }
4411  res->data=(char *)iv;
4412  return FALSE;
4413}
4414static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4415{
4416  poly p=(poly)v->Data();
4417  if (p == NULL)
4418  {
4419    res->data = (char*) NULL;
4420  }
4421  else
4422  {
4423    poly lm = pLmInit(p);
4424    pSetCoeff(lm, nInit(1));
4425    res->data = (char*) lm;
4426  }
4427  return FALSE;
4428}
4429static BOOLEAN jjLOAD1(leftv /*res*/, leftv v)
4430{
4431  return jjLOAD((char*)v->Data(),FALSE);
4432}
4433static BOOLEAN jjLISTRING(leftv res, leftv v)
4434{
4435  ring r=rCompose((lists)v->Data());
4436  if (r==NULL) return TRUE;
4437  if (r->qideal!=NULL) res->rtyp=QRING_CMD;
4438  res->data=(char *)r;
4439  return FALSE;
4440}
4441#if SIZEOF_LONG == 8
4442static number jjLONG2N(long d)
4443{
4444  int i=(int)d;
4445  if ((long)i == d)
4446  {
4447    return n_Init(i, coeffs_BIGINT);
4448  }
4449  else
4450  {
4451     struct snumber_dummy
4452     {
4453      mpz_t z;
4454      mpz_t n;
4455      #if defined(LDEBUG)
4456      int debug;
4457      #endif
4458      BOOLEAN s;
4459    };
4460    typedef struct snumber_dummy  *number_dummy;
4461
4462    number_dummy z=(number_dummy)omAlloc(sizeof(snumber_dummy));
4463    #if defined(LDEBUG)
4464    z->debug=123456;
4465    #endif
4466    z->s=3;
4467    mpz_init_set_si(z->z,d);
4468    return (number)z;
4469  }
4470}
4471#else
4472#define jjLONG2N(D) n_Init((int)D, coeffs_BIGINT)
4473#endif
4474static BOOLEAN jjPFAC1(leftv res, leftv v)
4475{
4476  /* call method jjPFAC2 with second argument = 0 (meaning that no
4477     valid bound for the prime factors has been given) */
4478  sleftv tmp;
4479  memset(&tmp, 0, sizeof(tmp));
4480  tmp.rtyp = INT_CMD;
4481  return jjPFAC2(res, v, &tmp);
4482}
4483static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4484{
4485  /* computes the LU-decomposition of a matrix M;
4486     i.e., M = P * L * U, where
4487        - P is a row permutation matrix,
4488        - L is in lower triangular form,
4489        - U is in upper row echelon form
4490     Then, we also have P * M = L * U.
4491     A list [P, L, U] is returned. */
4492  matrix mat = (const matrix)v->Data();
4493  if (!idIsConstant((ideal)mat))
4494  {
4495    WerrorS("matrix must be constant");
4496    return TRUE;
4497  }
4498  matrix pMat;
4499  matrix lMat;
4500  matrix uMat;
4501
4502  luDecomp(mat, pMat, lMat, uMat);
4503
4504  lists ll = (lists)omAllocBin(slists_bin);
4505  ll->Init(3);
4506  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4507  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4508  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4509  res->data=(char*)ll;
4510
4511  return FALSE;
4512}
4513static BOOLEAN jjMEMORY(leftv res, leftv v)
4514{
4515  omUpdateInfo();
4516  switch(((int)(long)v->Data()))
4517  {
4518  case 0:
4519    res->data=(char *)jjLONG2N(om_Info.UsedBytes);
4520    break;
4521  case 1:
4522    res->data = (char *)jjLONG2N(om_Info.CurrentBytesSystem);
4523    break;
4524  case 2:
4525    res->data = (char *)jjLONG2N(om_Info.MaxBytesSystem);
4526    break;
4527  default:
4528    omPrintStats(stdout);
4529    omPrintInfo(stdout);
4530    omPrintBinStats(stdout);
4531    res->data = (char *)0;
4532    res->rtyp = NONE;
4533  }
4534  return FALSE;
4535  res->data = (char *)0;
4536  return FALSE;
4537}
4538//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4539//{
4540//  return jjMONITOR2(res,v,NULL);
4541//}
4542static BOOLEAN jjMSTD(leftv res, leftv v)
4543{
4544  int t=v->Typ();
4545  ideal r,m;
4546  r=kMin_std((ideal)v->Data(),currQuotient,testHomog,NULL,m);
4547  lists l=(lists)omAllocBin(slists_bin);
4548  l->Init(2);
4549  l->m[0].rtyp=t;
4550  l->m[0].data=(char *)r;
4551  setFlag(&(l->m[0]),FLAG_STD);
4552  l->m[1].rtyp=t;
4553  l->m[1].data=(char *)m;
4554  res->data=(char *)l;
4555  return FALSE;
4556}
4557static BOOLEAN jjMULT(leftv res, leftv v)
4558{
4559  assumeStdFlag(v);
4560  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currQuotient);
4561  return FALSE;
4562}
4563static BOOLEAN jjMINRES_R(leftv res, leftv v)
4564{
4565  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4566
4567  syStrategy tmp=(syStrategy)v->Data();
4568  tmp = syMinimize(tmp); // enrich itself!
4569
4570  res->data=(char *)tmp;
4571
4572  if (weights!=NULL)
4573    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4574
4575  return FALSE;
4576}
4577static BOOLEAN jjN2BI(leftv res, leftv v)
4578{
4579  number n,i; i=(number)v->Data();
4580  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4581  if (nMap!=NULL)
4582    n=nMap(i,currRing->cf,coeffs_BIGINT);
4583  else goto err;
4584  res->data=(void *)n;
4585  return FALSE;
4586err:
4587  WerrorS("cannot convert to bigint"); return TRUE;
4588}
4589static BOOLEAN jjNAMEOF(leftv res, leftv v)
4590{
4591  res->data = (char *)v->name;
4592  if (res->data==NULL) res->data=omStrDup("");
4593  v->name=NULL;
4594  return FALSE;
4595}
4596static BOOLEAN jjNAMES(leftv res, leftv v)
4597{
4598  res->data=ipNameList(((ring)v->Data())->idroot);
4599  return FALSE;
4600}
4601static BOOLEAN jjNAMES_I(leftv res, leftv v)
4602{
4603  res->data=ipNameListLev((IDROOT),(int)(long)v->Data());
4604  return FALSE;
4605}
4606static BOOLEAN jjNOT(leftv res, leftv v)
4607{
4608  res->data=(char*)(long)((long)v->Data()==0 ? 1 : 0);
4609  return FALSE;
4610}
4611static BOOLEAN jjNVARS(leftv res, leftv v)
4612{
4613  res->data = (char *)(long)(((ring)(v->Data()))->N);
4614  return FALSE;
4615}
4616static BOOLEAN jjOpenClose(leftv, leftv v)
4617{
4618  si_link l=(si_link)v->Data();
4619  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4620  else                return slClose(l);
4621}
4622static BOOLEAN jjORD(leftv res, leftv v)
4623{
4624  poly p=(poly)v->Data();
4625  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4626  return FALSE;
4627}
4628static BOOLEAN jjPAR1(leftv res, leftv v)
4629{
4630  int i=(int)(long)v->Data();
4631  int p=0;
4632  p=rPar(currRing);
4633  if ((0<i) && (i<=p))
4634  {
4635    res->data=(char *)n_Param(i,currRing);
4636  }
4637  else
4638  {
4639    Werror("par number %d out of range 1..%d",i,p);
4640    return TRUE;
4641  }
4642  return FALSE;
4643}
4644static BOOLEAN jjPARDEG(leftv res, leftv v)
4645{
4646  number nn=(number)v->Data();
4647  res->data = (char *)(long)n_ParDeg(nn, currRing);
4648  return FALSE;
4649}
4650static BOOLEAN jjPARSTR1(leftv res, leftv v)
4651{
4652  if (currRing==NULL)
4653  {
4654    WerrorS("no ring active");
4655    return TRUE;
4656  }
4657  int i=(int)(long)v->Data();
4658  int p=0;
4659  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4660    res->data=omStrDup(rParameter(currRing)[i-1]);
4661  else
4662  {
4663    Werror("par number %d out of range 1..%d",i,p);
4664    return TRUE;
4665  }
4666  return FALSE;
4667}
4668static BOOLEAN jjP2BI(leftv res, leftv v)
4669{
4670  poly p=(poly)v->Data();
4671  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4672  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4673  {
4674    WerrorS("poly must be constant");
4675    return TRUE;
4676  }
4677  number i=pGetCoeff(p);
4678  number n;
4679  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4680  if (nMap!=NULL)
4681    n=nMap(i,currRing->cf,coeffs_BIGINT);
4682  else goto err;
4683  res->data=(void *)n;
4684  return FALSE;
4685err:
4686  WerrorS("cannot convert to bigint"); return TRUE;
4687}
4688static BOOLEAN jjP2I(leftv res, leftv v)
4689{
4690  poly p=(poly)v->Data();
4691  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4692  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4693  {
4694    WerrorS("poly must be constant");
4695    return TRUE;
4696  }
4697  res->data = (char *)(long)n_Int(pGetCoeff(p),currRing->cf);
4698  return FALSE;
4699}
4700static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4701{
4702  map mapping=(map)v->Data();
4703  syMake(res,omStrDup(mapping->preimage));
4704  return FALSE;
4705}
4706static BOOLEAN jjPRIME(leftv res, leftv v)
4707{
4708  int i = IsPrime((int)(long)(v->Data()));
4709  res->data = (char *)(long)(i > 1 ? i : 2);
4710  return FALSE;
4711}
4712static BOOLEAN jjPRUNE(leftv res, leftv v)
4713{
4714  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4715  ideal v_id=(ideal)v->Data();
4716  if (w!=NULL)
4717  {
4718    if (!idTestHomModule(v_id,currQuotient,w))
4719    {
4720      WarnS("wrong weights");
4721      w=NULL;
4722      // and continue at the non-homog case below
4723    }
4724    else
4725    {
4726      w=ivCopy(w);
4727      intvec **ww=&w;
4728      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4729      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4730      return FALSE;
4731    }
4732  }
4733  res->data = (char *)idMinEmbedding(v_id);
4734  return FALSE;
4735}
4736static BOOLEAN jjP2N(leftv res, leftv v)
4737{
4738  number n;
4739  poly p;
4740  if (((p=(poly)v->Data())!=NULL)
4741  && (pIsConstant(p)))
4742  {
4743    n=nCopy(pGetCoeff(p));
4744  }
4745  else
4746  {
4747    n=nInit(0);
4748  }
4749  res->data = (char *)n;
4750  return FALSE;
4751}
4752static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4753{
4754  char *s= (char *)v->Data();
4755  int i = 1;
4756  for(i=0; i<sArithBase.nCmdUsed; i++)
4757  {
4758    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4759    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4760    {
4761      res->data = (char *)1;
4762      return FALSE;
4763    }
4764  }
4765  //res->data = (char *)0;
4766  return FALSE;
4767}
4768static BOOLEAN jjRANK1(leftv res, leftv v)
4769{
4770  matrix m =(matrix)v->Data();
4771  int rank = luRank(m, 0);
4772  res->data =(char *)(long)rank;
4773  return FALSE;
4774}
4775static BOOLEAN jjREAD(leftv res, leftv v)
4776{
4777  return jjREAD2(res,v,NULL);
4778}
4779static BOOLEAN jjREGULARITY(leftv res, leftv v)
4780{
4781  res->data = (char *)(long)iiRegularity((lists)v->Data());
4782  return FALSE;
4783}
4784static BOOLEAN jjREPART(leftv res, leftv v)
4785{
4786  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4787  return FALSE;
4788}
4789static BOOLEAN jjRINGLIST(leftv res, leftv v)
4790{
4791  ring r=(ring)v->Data();
4792  if (r!=NULL)
4793    res->data = (char *)rDecompose((ring)v->Data());
4794  return (r==NULL)||(res->data==NULL);
4795}
4796static BOOLEAN jjROWS(leftv res, leftv v)
4797{
4798  ideal i = (ideal)v->Data();
4799  res->data = (char *)i->rank;
4800  return FALSE;
4801}
4802static BOOLEAN jjROWS_BIM(leftv res, leftv v)
4803{
4804  res->data = (char *)(long)((bigintmat*)(v->Data()))->rows();
4805  return FALSE;
4806}
4807static BOOLEAN jjROWS_IV(leftv res, leftv v)
4808{
4809  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4810  return FALSE;
4811}
4812static BOOLEAN jjRPAR(leftv res, leftv v)
4813{
4814  res->data = (char *)(long)rPar(((ring)v->Data()));
4815  return FALSE;
4816}
4817static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4818{
4819#ifdef HAVE_PLURAL
4820  const bool bIsSCA = rIsSCA(currRing);
4821#else
4822  const bool bIsSCA = false;
4823#endif
4824
4825  if ((currQuotient!=NULL) && !bIsSCA)
4826  {
4827    WerrorS("qring not supported by slimgb at the moment");
4828    return TRUE;
4829  }
4830  if (rHasLocalOrMixedOrdering_currRing())
4831  {
4832    WerrorS("ordering must be global for slimgb");
4833    return TRUE;
4834  }
4835  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4836  // tHomog hom=testHomog;
4837  ideal u_id=(ideal)u->Data();
4838  if (w!=NULL)
4839  {
4840    if (!idTestHomModule(u_id,currQuotient,w))
4841    {
4842      WarnS("wrong weights");
4843      w=NULL;
4844    }
4845    else
4846    {
4847      w=ivCopy(w);
4848      // hom=isHomog;
4849    }
4850  }
4851
4852  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
4853  res->data=(char *)t_rep_gb(currRing,
4854    u_id,u_id->rank);
4855  //res->data=(char *)t_rep_gb(currRing, u_id);
4856
4857  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4858  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4859  return FALSE;
4860}
4861static BOOLEAN jjSBA(leftv res, leftv v)
4862{
4863  ideal result;
4864  ideal v_id=(ideal)v->Data();
4865  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4866  tHomog hom=testHomog;
4867  if (w!=NULL)
4868  {
4869    if (!idTestHomModule(v_id,currQuotient,w))
4870    {
4871      WarnS("wrong weights");
4872      w=NULL;
4873    }
4874    else
4875    {
4876      hom=isHomog;
4877      w=ivCopy(w);
4878    }
4879  }
4880  result=kSba(v_id,currQuotient,hom,&w,1,0);
4881  idSkipZeroes(result);
4882  res->data = (char *)result;
4883  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4884  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4885  return FALSE;
4886}
4887static BOOLEAN jjSBA_1(leftv res, leftv v, leftv u)
4888{
4889  ideal result;
4890  ideal v_id=(ideal)v->Data();
4891  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4892  tHomog hom=testHomog;
4893  if (w!=NULL)
4894  {
4895    if (!idTestHomModule(v_id,currQuotient,w))
4896    {
4897      WarnS("wrong weights");
4898      w=NULL;
4899    }
4900    else
4901    {
4902      hom=isHomog;
4903      w=ivCopy(w);
4904    }
4905  }
4906  result=kSba(v_id,currQuotient,hom,&w,(int)(long)u->Data(),0);
4907  idSkipZeroes(result);
4908  res->data = (char *)result;
4909  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4910  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4911  return FALSE;
4912}
4913static BOOLEAN jjSBA_2(leftv res, leftv v, leftv u, leftv t)
4914{
4915  ideal result;
4916  ideal v_id=(ideal)v->Data();
4917  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4918  tHomog hom=testHomog;
4919  if (w!=NULL)
4920  {
4921    if (!idTestHomModule(v_id,currQuotient,w))
4922    {
4923      WarnS("wrong weights");
4924      w=NULL;
4925    }
4926    else
4927    {
4928      hom=isHomog;
4929      w=ivCopy(w);
4930    }
4931  }
4932  result=kSba(v_id,currQuotient,hom,&w,(int)(long)u->Data(),(int)(long)t->Data());
4933  idSkipZeroes(result);
4934  res->data = (char *)result;
4935  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4936  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4937  return FALSE;
4938}
4939static BOOLEAN jjSTD(leftv res, leftv v)
4940{
4941  ideal result;
4942  ideal v_id=(ideal)v->Data();
4943  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4944  tHomog hom=testHomog;
4945  if (w!=NULL)
4946  {
4947    if (!idTestHomModule(v_id,currQuotient,w))
4948    {
4949      WarnS("wrong weights");
4950      w=NULL;
4951    }
4952    else
4953    {
4954      hom=isHomog;
4955      w=ivCopy(w);
4956    }
4957  }
4958  result=kStd(v_id,currQuotient,hom,&w);
4959  idSkipZeroes(result);
4960  res->data = (char *)result;
4961  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4962  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4963  return FALSE;
4964}
4965static BOOLEAN jjSort_Id(leftv res, leftv v)
4966{
4967  res->data = (char *)idSort((ideal)v->Data());
4968  return FALSE;
4969}
4970static BOOLEAN jjSQR_FREE(leftv res, leftv u)
4971{
4972  singclap_factorize_retry=0;
4973  intvec *v=NULL;
4974  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
4975  if (f==NULL) return TRUE;
4976  ivTest(v);
4977  lists l=(lists)omAllocBin(slists_bin);
4978  l->Init(2);
4979  l->m[0].rtyp=IDEAL_CMD;
4980  l->m[0].data=(void *)f;
4981  l->m[1].rtyp=INTVEC_CMD;
4982  l->m[1].data=(void *)v;
4983  res->data=(void *)l;
4984  return FALSE;
4985}
4986#if 1
4987static BOOLEAN jjSYZYGY(leftv res, leftv v)
4988{
4989  intvec *w=NULL;
4990  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
4991  if (w!=NULL) delete w;
4992  return FALSE;
4993}
4994#else
4995// activate, if idSyz handle module weights correctly !
4996static BOOLEAN jjSYZYGY(leftv res, leftv v)
4997{
4998  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4999  ideal v_id=(ideal)v->Data();
5000  tHomog hom=testHomog;
5001  int add_row_shift=0;
5002  if (w!=NULL)
5003  {
5004    w=ivCopy(w);
5005    add_row_shift=w->min_in();
5006    (*w)-=add_row_shift;
5007    if (idTestHomModule(v_id,currQuotient,w))
5008      hom=isHomog;
5009    else
5010    {
5011      //WarnS("wrong weights");
5012      delete w; w=NULL;
5013      hom=testHomog;
5014    }
5015  }
5016  res->data = (char *)idSyzygies(v_id,hom,&w);
5017  if (w!=NULL)
5018  {
5019    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5020  }
5021  return FALSE;
5022}
5023#endif
5024static BOOLEAN jjTRACE_IV(leftv res, leftv v)
5025{
5026  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
5027  return FALSE;
5028}
5029static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
5030{
5031  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
5032  return FALSE;
5033}
5034static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
5035{
5036  res->data = (char *)ivTranp((intvec*)(v->Data()));
5037  return FALSE;
5038}
5039#ifdef HAVE_PLURAL
5040static BOOLEAN jjOPPOSITE(leftv res, leftv a)
5041{
5042  ring    r = (ring)a->Data();
5043  //if (rIsPluralRing(r))
5044  if (r->OrdSgn==1)
5045  {
5046    res->data = rOpposite(r);
5047  }
5048  else
5049  {
5050    WarnS("opposite only for global orderings");
5051    res->data = rCopy(r);
5052  }
5053  return FALSE;
5054}
5055static BOOLEAN jjENVELOPE(leftv res, leftv a)
5056{
5057  ring    r = (ring)a->Data();
5058  if (rIsPluralRing(r))
5059  {
5060    //    ideal   i;
5061//     if (a->rtyp == QRING_CMD)
5062//     {
5063//       i = r->qideal;
5064//       r->qideal = NULL;
5065//     }
5066    ring s = rEnvelope(r);
5067//     if (a->rtyp == QRING_CMD)
5068//     {
5069//       ideal is  = idOppose(r,i); /* twostd? */
5070//       is        = idAdd(is,i);
5071//       s->qideal = i;
5072//     }
5073    res->data = s;
5074  }
5075  else  res->data = rCopy(r);
5076  return FALSE;
5077}
5078static BOOLEAN jjTWOSTD(leftv res, leftv a)
5079{
5080  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
5081  else  res->data=(ideal)a->CopyD();
5082  setFlag(res,FLAG_STD);
5083  setFlag(res,FLAG_TWOSTD);
5084  return FALSE;
5085}
5086#endif
5087
5088static BOOLEAN jjTYPEOF(leftv res, leftv v)
5089{
5090  int t=(int)(long)v->data;
5091  switch (t)
5092  {
5093    case INT_CMD:        res->data=omStrDup("int"); break;
5094    case POLY_CMD:       res->data=omStrDup("poly"); break;
5095    case VECTOR_CMD:     res->data=omStrDup("vector"); break;
5096    case STRING_CMD:     res->data=omStrDup("string"); break;
5097    case INTVEC_CMD:     res->data=omStrDup("intvec"); break;
5098    case IDEAL_CMD:      res->data=omStrDup("ideal"); break;
5099    case MATRIX_CMD:     res->data=omStrDup("matrix"); break;
5100    case MODUL_CMD:      res->data=omStrDup("module"); break;
5101    case MAP_CMD:        res->data=omStrDup("map"); break;
5102    case PROC_CMD:       res->data=omStrDup("proc"); break;
5103    case RING_CMD:       res->data=omStrDup("ring"); break;
5104    case QRING_CMD:      res->data=omStrDup("qring"); break;
5105    case INTMAT_CMD:     res->data=omStrDup("intmat"); break;
5106    case BIGINTMAT_CMD:  res->data=omStrDup("bigintmat"); break;
5107    case NUMBER_CMD:     res->data=omStrDup("number"); break;
5108    case BIGINT_CMD:     res->data=omStrDup("bigint"); break;
5109    case LIST_CMD:       res->data=omStrDup("list"); break;
5110    case PACKAGE_CMD:    res->data=omStrDup("package"); break;
5111    case LINK_CMD:       res->data=omStrDup("link"); break;
5112    case RESOLUTION_CMD: res->data=omStrDup("resolution");break;
5113    case DEF_CMD:
5114    case NONE:           res->data=omStrDup("none"); break;
5115    default:
5116    {
5117      if (t>MAX_TOK)
5118        res->data=omStrDup(getBlackboxName(t));
5119      else
5120        res->data=omStrDup("?unknown type?");
5121      break;
5122    }
5123  }
5124  return FALSE;
5125}
5126static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5127{
5128  res->data=(char *)(long)pIsUnivariate((poly)v->Data());
5129  return FALSE;
5130}
5131static BOOLEAN jjVAR1(leftv res, leftv v)
5132{
5133  int i=(int)(long)v->Data();
5134  if ((0<i) && (i<=currRing->N))
5135  {
5136    poly p=pOne();
5137    pSetExp(p,i,1);
5138    pSetm(p);
5139    res->data=(char *)p;
5140  }
5141  else
5142  {
5143    Werror("var number %d out of range 1..%d",i,currRing->N);
5144    return TRUE;
5145  }
5146  return FALSE;
5147}
5148static BOOLEAN jjVARSTR1(leftv res, leftv v)
5149{
5150  if (currRing==NULL)
5151  {
5152    WerrorS("no ring active");
5153    return TRUE;
5154  }
5155  int i=(int)(long)v->Data();
5156  if ((0<i) && (i<=currRing->N))
5157    res->data=omStrDup(currRing->names[i-1]);
5158  else
5159  {
5160    Werror("var number %d out of range 1..%d",i,currRing->N);
5161    return TRUE;
5162  }
5163  return FALSE;
5164}
5165static BOOLEAN jjVDIM(leftv res, leftv v)
5166{
5167  assumeStdFlag(v);
5168  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currQuotient);
5169  return FALSE;
5170}
5171BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5172{
5173// input: u: a list with links of type
5174//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5175// returns: -1:  the read state of all links is eof
5176//          i>0: (at least) u[i] is ready
5177  lists Lforks = (lists)u->Data();
5178  int i = slStatusSsiL(Lforks, -1);
5179  if(i == -2) /* error */
5180  {
5181    return TRUE;
5182  }
5183  res->data = (void*)(long)i;
5184  return FALSE;
5185}
5186BOOLEAN jjWAITALL1(leftv res, leftv u)
5187{
5188// input: u: a list with links of type
5189//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5190// returns: -1: the read state of all links is eof
5191//           1: all links are ready
5192//              (caution: at least one is ready, but some maybe dead)
5193  lists Lforks = (lists)u->CopyD();
5194  int i;
5195  int j = -1;
5196  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5197  {
5198    i = slStatusSsiL(Lforks, -1);
5199    if(i == -2) /* error */
5200    {
5201      return TRUE;
5202    }
5203    if(i == -1)
5204    {
5205      break;
5206    }
5207    j = 1;
5208    Lforks->m[i-1].CleanUp();
5209    Lforks->m[i-1].rtyp=DEF_CMD;
5210    Lforks->m[i-1].data=NULL;
5211  }
5212  res->data = (void*)(long)j;
5213  Lforks->Clean();
5214  return FALSE;
5215}
5216
5217BOOLEAN jjLOAD(const char *s, BOOLEAN autoexport)
5218{
5219  char libnamebuf[256];
5220  lib_types LT = type_of_LIB(s, libnamebuf);
5221
5222#ifdef HAVE_DYNAMIC_LOADING
5223  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5224#endif /* HAVE_DYNAMIC_LOADING */
5225  switch(LT)
5226  {
5227      default:
5228      case LT_NONE:
5229        Werror("%s: unknown type", s);
5230        break;
5231      case LT_NOTFOUND:
5232        Werror("cannot open %s", s);
5233        break;
5234
5235      case LT_SINGULAR:
5236      {
5237        char *plib = iiConvName(s);
5238        idhdl pl = IDROOT->get(plib,0);
5239        if (pl==NULL)
5240        {
5241          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5242          IDPACKAGE(pl)->language = LANG_SINGULAR;
5243          IDPACKAGE(pl)->libname=omStrDup(plib);
5244        }
5245        else if (IDTYP(pl)!=PACKAGE_CMD)
5246        {
5247          Werror("can not create package `%s`",plib);
5248          omFree(plib);
5249          return TRUE;
5250        }
5251        package savepack=currPack;
5252        currPack=IDPACKAGE(pl);
5253        IDPACKAGE(pl)->loaded=TRUE;
5254        char libnamebuf[256];
5255        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5256        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5257        currPack=savepack;
5258        IDPACKAGE(pl)->loaded=(!bo);
5259        return bo;
5260      }
5261      case LT_BUILTIN:
5262        SModulFunc_t iiGetBuiltinModInit(const char*);
5263        return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5264      case LT_MACH_O:
5265      case LT_ELF:
5266      case LT_HPUX:
5267#ifdef HAVE_DYNAMIC_LOADING
5268        return load_modules(s, libnamebuf, autoexport);
5269#else /* HAVE_DYNAMIC_LOADING */
5270        WerrorS("Dynamic modules are not supported by this version of Singular");
5271        break;
5272#endif /* HAVE_DYNAMIC_LOADING */
5273  }
5274  return TRUE;
5275}
5276
5277#ifdef INIT_BUG
5278#define XS(A) -((short)A)
5279#define jjstrlen       (proc1)1
5280#define jjpLength      (proc1)2
5281#define jjidElem       (proc1)3
5282#define jjmpDetBareiss (proc1)4
5283#define jjidFreeModule (proc1)5
5284#define jjidVec2Ideal  (proc1)6
5285#define jjrCharStr     (proc1)7
5286#ifndef MDEBUG
5287#define jjpHead        (proc1)8
5288#endif
5289#define jjidMinBase    (proc1)11
5290#define jjsyMinBase    (proc1)12
5291#define jjpMaxComp     (proc1)13
5292#define jjmpTrace      (proc1)14
5293#define jjmpTransp     (proc1)15
5294#define jjrOrdStr      (proc1)16
5295#define jjrVarStr      (proc1)18
5296#define jjrParStr      (proc1)19
5297#define jjCOUNT_RES    (proc1)22
5298#define jjDIM_R        (proc1)23
5299#define jjidTransp     (proc1)24
5300
5301extern struct sValCmd1 dArith1[];
5302void jjInitTab1()
5303{
5304  int i=0;
5305  for (;dArith1[i].cmd!=0;i++)
5306  {
5307    if (dArith1[i].res<0)
5308    {
5309      switch ((int)dArith1[i].p)
5310      {
5311        case (int)jjstrlen:       dArith1[i].p=(proc1)strlen; break;
5312        case (int)jjpLength:      dArith1[i].p=(proc1)pLength; break;
5313        case (int)jjidElem:       dArith1[i].p=(proc1)idElem; break;
5314        case (int)jjidVec2Ideal:  dArith1[i].p=(proc1)idVec2Ideal; break;
5315        case (int)jjmpDetBareiss: dArith1[i].p=(proc1)mpDetBareiss; break;
5316        case (int)jjidFreeModule: dArith1[i].p=(proc1)idFreeModule; break;
5317        case (int)jjrCharStr:     dArith1[i].p=(proc1)rCharStr; break;
5318#ifndef MDEBUG
5319        case (int)jjpHead:        dArith1[i].p=(proc1)pHeadProc; break;
5320#endif
5321        case (int)jjidMinBase:    dArith1[i].p=(proc1)idMinBase; break;
5322        case (int)jjsyMinBase:    dArith1[i].p=(proc1)syMinBase; break;
5323        case (int)jjpMaxComp:     dArith1[i].p=(proc1)pMaxCompProc; break;
5324        case (int)jjmpTrace:      dArith1[i].p=(proc1)mpTrace; break;
5325        case (int)jjmpTransp:     dArith1[i].p=(proc1)mpTransp; break;
5326        case (int)jjrOrdStr:      dArith1[i].p=(proc1)rOrdStr; break;
5327        case (int)jjrVarStr:      dArith1[i].p=(proc1)rVarStr; break;
5328        case (int)jjrParStr:      dArith1[i].p=(proc1)rParStr; break;
5329        case (int)jjCOUNT_RES:    dArith1[i].p=(proc1)sySize; break;
5330        case (int)jjDIM_R:        dArith1[i].p=(proc1)syDim; break;
5331        case (int)jjidTransp:     dArith1[i].p=(proc1)idTransp; break;
5332        default: Werror("missing proc1-definition for %d",(int)(long)dArith1[i].p);
5333      }
5334    }
5335  }
5336}
5337#else
5338#if defined(PROC_BUG)
5339#define XS(A) A
5340static BOOLEAN jjstrlen(leftv res, leftv v)
5341{
5342  res->data = (char *)strlen((char *)v->Data());
5343  return FALSE;
5344}
5345static BOOLEAN jjpLength(leftv res, leftv v)
5346{
5347  res->data = (char *)(long)pLength((poly)v->Data());
5348  return FALSE;
5349}
5350static BOOLEAN jjidElem(leftv res, leftv v)
5351{
5352  res->data = (char *)(long)idElem((ideal)v->Data());
5353  return FALSE;
5354}
5355static BOOLEAN jjmpDetBareiss(leftv res, leftv v)
5356{
5357  res->data = (char *)mp_DetBareiss((matrix)v->Data(),currRing);
5358  return FALSE;
5359}
5360static BOOLEAN jjidFreeModule(leftv res, leftv v)
5361{
5362  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5363  return FALSE;
5364}
5365static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5366{
5367  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5368  return FALSE;
5369}
5370static BOOLEAN jjrCharStr(leftv res, leftv v)
5371{
5372  res->data = rCharStr((ring)v->Data());
5373  return FALSE;
5374}
5375#ifndef MDEBUG
5376static BOOLEAN jjpHead(leftv res, leftv v)
5377{
5378  res->data = (char *)pHead((poly)v->Data());
5379  return FALSE;
5380}
5381#endif
5382static BOOLEAN jjidHead(leftv res, leftv v)
5383{
5384  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5385  return FALSE;
5386}
5387static BOOLEAN jjidMinBase(leftv res, leftv v)
5388{
5389  res->data = (char *)idMinBase((ideal)v->Data());
5390  return FALSE;
5391}
5392static BOOLEAN jjsyMinBase(leftv res, leftv v)
5393{
5394  res->data = (char *)syMinBase((ideal)v->Data());
5395  return FALSE;
5396}
5397static BOOLEAN jjpMaxComp(leftv res, leftv v)
5398{
5399  res->data = (char *)pMaxComp((poly)v->Data());
5400  return FALSE;
5401}
5402static BOOLEAN jjmpTrace(leftv res, leftv v)
5403{
5404  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5405  return FALSE;
5406}
5407static BOOLEAN jjmpTransp(leftv res, leftv v)
5408{
5409  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5410  return FALSE;
5411}
5412static BOOLEAN jjrOrdStr(leftv res, leftv v)
5413{
5414  res->data = rOrdStr((ring)v->Data());
5415  return FALSE;
5416}
5417static BOOLEAN jjrVarStr(leftv res, leftv v)
5418{
5419  res->data = rVarStr((ring)v->Data());
5420  return FALSE;
5421}
5422static BOOLEAN jjrParStr(leftv res, leftv v)
5423{
5424  res->data = rParStr((ring)v->Data());
5425  return FALSE;
5426}
5427static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5428{
5429  res->data=(char *)(long)sySize((syStrategy)v->Data());
5430  return FALSE;
5431}
5432static BOOLEAN jjDIM_R(leftv res, leftv v)
5433{
5434  res->data = (char *)(long)syDim((syStrategy)v->Data());
5435  return FALSE;
5436}
5437static BOOLEAN jjidTransp(leftv res, leftv v)
5438{
5439  res->data = (char *)idTransp((ideal)v->Data());
5440  return FALSE;
5441}
5442#else
5443#define XS(A)          -((short)A)
5444#define jjstrlen       (proc1)strlen
5445#define jjpLength      (proc1)pLength
5446#define jjidElem       (proc1)idElem
5447#define jjmpDetBareiss (proc1)mpDetBareiss
5448#define jjidFreeModule (proc1)idFreeModule
5449#define jjidVec2Ideal  (proc1)idVec2Ideal
5450#define jjrCharStr     (proc1)rCharStr
5451#ifndef MDEBUG
5452#define jjpHead        (proc1)pHeadProc
5453#endif
5454#define jjidHead       (proc1)idHead
5455#define jjidMinBase    (proc1)idMinBase
5456#define jjsyMinBase    (proc1)syMinBase
5457#define jjpMaxComp     (proc1)pMaxCompProc
5458#define jjrOrdStr      (proc1)rOrdStr
5459#define jjrVarStr      (proc1)rVarStr
5460#define jjrParStr      (proc1)rParStr
5461#define jjCOUNT_RES    (proc1)sySize
5462#define jjDIM_R        (proc1)syDim
5463#define jjidTransp     (proc1)idTransp
5464#endif
5465#endif
5466static BOOLEAN jjnInt(leftv res, leftv u)
5467{
5468  number n=(number)u->CopyD(); // n_Int may call n_Normalize
5469  res->data=(char *)(long)n_Int(n,currRing->cf);
5470  n_Delete(&n,currRing->cf);
5471  return FALSE;
5472}
5473static BOOLEAN jjnlInt(leftv res, leftv u)
5474{
5475  number n=(number)u->Data();
5476  res->data=(char *)(long)n_Int(n,coeffs_BIGINT );
5477  return FALSE;
5478}
5479/*=================== operations with 3 args.: static proc =================*/
5480/* must be ordered: first operations for chars (infix ops),
5481 * then alphabetically */
5482static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5483{
5484  char *s= (char *)u->Data();
5485  int   r = (int)(long)v->Data();
5486  int   c = (int)(long)w->Data();
5487  int l = strlen(s);
5488
5489  if ( (r<1) || (r>l) || (c<0) )
5490  {
5491    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5492    return TRUE;
5493  }
5494  res->data = (char *)omAlloc((long)(c+1));
5495  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5496  return FALSE;
5497}
5498static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5499{
5500  intvec *iv = (intvec *)u->Data();
5501  int   r = (int)(long)v->Data();
5502  int   c = (int)(long)w->Data();
5503  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5504  {
5505    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5506           r,c,u->Fullname(),iv->rows(),iv->cols());
5507    return TRUE;
5508  }
5509  res->data=u->data; u->data=NULL;
5510  res->rtyp=u->rtyp; u->rtyp=0;
5511  res->name=u->name; u->name=NULL;
5512  Subexpr e=jjMakeSub(v);
5513          e->next=jjMakeSub(w);
5514  if (u->e==NULL) res->e=e;
5515  else
5516  {
5517    Subexpr h=u->e;
5518    while (h->next!=NULL) h=h->next;
5519    h->next=e;
5520    res->e=u->e;
5521    u->e=NULL;
5522  }
5523  return FALSE;
5524}
5525static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5526{
5527  bigintmat *bim = (bigintmat *)u->Data();
5528  int   r = (int)(long)v->Data();
5529  int   c = (int)(long)w->Data();
5530  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5531  {
5532    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5533           r,c,u->Fullname(),bim->rows(),bim->cols());
5534    return TRUE;
5535  }
5536  res->data=u->data; u->data=NULL;
5537  res->rtyp=u->rtyp; u->rtyp=0;
5538  res->name=u->name; u->name=NULL;
5539  Subexpr e=jjMakeSub(v);
5540          e->next=jjMakeSub(w);
5541  if (u->e==NULL)
5542    res->e=e;
5543  else
5544  {
5545    Subexpr h=u->e;
5546    while (h->next!=NULL) h=h->next;
5547    h->next=e;
5548    res->e=u->e;
5549    u->e=NULL;
5550  }
5551  return FALSE;
5552}
5553static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5554{
5555  matrix m= (matrix)u->Data();
5556  int   r = (int)(long)v->Data();
5557  int   c = (int)(long)w->Data();
5558  //Print("gen. elem %d, %d\n",r,c);
5559  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5560  {
5561    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5562      MATROWS(m),MATCOLS(m));
5563    return TRUE;
5564  }
5565  res->data=u->data; u->data=NULL;
5566  res->rtyp=u->rtyp; u->rtyp=0;
5567  res->name=u->name; u->name=NULL;
5568  Subexpr e=jjMakeSub(v);
5569          e->next=jjMakeSub(w);
5570  if (u->e==NULL)
5571    res->e=e;
5572  else
5573  {
5574    Subexpr h=u->e;
5575    while (h->next!=NULL) h=h->next;
5576    h->next=e;
5577    res->e=u->e;
5578    u->e=NULL;
5579  }
5580  return FALSE;
5581}
5582static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5583{
5584  sleftv t;
5585  sleftv ut;
5586  leftv p=NULL;
5587  intvec *iv=(intvec *)w->Data();
5588  int l;
5589  BOOLEAN nok;
5590
5591  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5592  {
5593    WerrorS("cannot build expression lists from unnamed objects");
5594    return TRUE;
5595  }
5596  memcpy(&ut,u,sizeof(ut));
5597  memset(&t,0,sizeof(t));
5598  t.rtyp=INT_CMD;
5599  for (l=0;l< iv->length(); l++)
5600  {
5601    t.data=(char *)(long)((*iv)[l]);
5602    if (p==NULL)
5603    {
5604      p=res;
5605    }
5606    else
5607    {
5608      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5609      p=p->next;
5610    }
5611    memcpy(u,&ut,sizeof(ut));
5612    if (u->Typ() == MATRIX_CMD)
5613      nok=jjBRACK_Ma(p,u,v,&t);
5614    else if (u->Typ() == BIGINTMAT_CMD)
5615      nok=jjBRACK_Bim(p,u,v,&t);
5616    else /* INTMAT_CMD */
5617      nok=jjBRACK_Im(p,u,v,&t);
5618    if (nok)
5619    {
5620      while (res->next!=NULL)
5621      {
5622        p=res->next->next;
5623        omFreeBin((ADDRESS)res->next, sleftv_bin);
5624        // res->e aufraeumen !!!!
5625        res->next=p;
5626      }
5627      return TRUE;
5628    }
5629  }
5630  return FALSE;
5631}
5632static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5633{
5634  sleftv t;
5635  sleftv ut;
5636  leftv p=NULL;
5637  intvec *iv=(intvec *)v->Data();
5638  int l;
5639  BOOLEAN nok;
5640
5641  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5642  {
5643    WerrorS("cannot build expression lists from unnamed objects");
5644    return TRUE;
5645  }
5646  memcpy(&ut,u,sizeof(ut));
5647  memset(&t,0,sizeof(t));
5648  t.rtyp=INT_CMD;
5649  for (l=0;l< iv->length(); l++)
5650  {
5651    t.data=(char *)(long)((*iv)[l]);
5652    if (p==NULL)
5653    {
5654      p=res;
5655    }
5656    else
5657    {
5658      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5659      p=p->next;
5660    }
5661    memcpy(u,&ut,sizeof(ut));
5662    if (u->Typ() == MATRIX_CMD)
5663      nok=jjBRACK_Ma(p,u,&t,w);
5664    else if (u->Typ() == BIGINTMAT_CMD)
5665      nok=jjBRACK_Bim(p,u,&t,w);
5666    else /* INTMAT_CMD */
5667      nok=jjBRACK_Im(p,u,&t,w);
5668    if (nok)
5669    {
5670      while (res->next!=NULL)
5671      {
5672        p=res->next->next;
5673        omFreeBin((ADDRESS)res->next, sleftv_bin);
5674        // res->e aufraeumen !!
5675        res->next=p;
5676      }
5677      return TRUE;
5678    }
5679  }
5680  return FALSE;
5681}
5682static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5683{
5684  sleftv t1,t2,ut;
5685  leftv p=NULL;
5686  intvec *vv=(intvec *)v->Data();
5687  intvec *wv=(intvec *)w->Data();
5688  int vl;
5689  int wl;
5690  BOOLEAN nok;
5691
5692  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5693  {
5694    WerrorS("cannot build expression lists from unnamed objects");
5695    return TRUE;
5696  }
5697  memcpy(&ut,u,sizeof(ut));
5698  memset(&t1,0,sizeof(sleftv));
5699  memset(&t2,0,sizeof(sleftv));
5700  t1.rtyp=INT_CMD;
5701  t2.rtyp=INT_CMD;
5702  for (vl=0;vl< vv->length(); vl++)
5703  {
5704    t1.data=(char *)(long)((*vv)[vl]);
5705    for (wl=0;wl< wv->length(); wl++)
5706    {
5707      t2.data=(char *)(long)((*wv)[wl]);
5708      if (p==NULL)
5709      {
5710        p=res;
5711      }
5712      else
5713      {
5714        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5715        p=p->next;
5716      }
5717      memcpy(u,&ut,sizeof(ut));
5718      if (u->Typ() == MATRIX_CMD)
5719        nok=jjBRACK_Ma(p,u,&t1,&t2);
5720      else if (u->Typ() == BIGINTMAT_CMD)
5721        nok=jjBRACK_Bim(p,u,&t1,&t2);
5722      else /* INTMAT_CMD */
5723        nok=jjBRACK_Im(p,u,&t1,&t2);
5724      if (nok)
5725      {
5726        res->CleanUp();
5727        return TRUE;
5728      }
5729    }
5730  }
5731  return FALSE;
5732}
5733static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5734{
5735  v->next=(leftv)omAllocBin(sleftv_bin);
5736  memcpy(v->next,w,sizeof(sleftv));
5737  memset(w,0,sizeof(sleftv));
5738  return jjPROC(res,u,v);
5739}
5740static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5741{
5742  intvec *iv;
5743  ideal m;
5744  lists l=(lists)omAllocBin(slists_bin);
5745  int k=(int)(long)w->Data();
5746  if (k>=0)
5747  {
5748    sm_CallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv, currRing);
5749    l->Init(2);
5750    l->m[0].rtyp=MODUL_CMD;
5751    l->m[1].rtyp=INTVEC_CMD;
5752    l->m[0].data=(void *)m;
5753    l->m[1].data=(void *)iv;
5754  }
5755  else
5756  {
5757    m=sm_CallSolv((ideal)u->Data(), currRing);
5758    l->Init(1);
5759    l->m[0].rtyp=IDEAL_CMD;
5760    l->m[0].data=(void *)m;
5761  }
5762  res->data = (char *)l;
5763  return FALSE;
5764}
5765static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5766{
5767  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5768  {
5769    WerrorS("3rd argument must be a name of a matrix");
5770    return TRUE;
5771  }
5772  ideal i=(ideal)u->Data();
5773  int rank=(int)i->rank;
5774  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5775  if (r) return TRUE;
5776  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5777  return FALSE;
5778}
5779static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5780{
5781  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5782           (ideal)(v->Data()),(poly)(w->Data()));
5783  return FALSE;
5784}
5785static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5786{
5787  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5788  {
5789    WerrorS("3rd argument must be a name of a matrix");
5790    return TRUE;
5791  }
5792  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5793  poly p=(poly)u->CopyD(POLY_CMD);
5794  ideal i=idInit(1,1);
5795  i->m[0]=p;
5796  sleftv t;
5797  memset(&t,0,sizeof(t));
5798  t.data=(char *)i;
5799  t.rtyp=IDEAL_CMD;
5800  int rank=1;
5801  if (u->Typ()==VECTOR_CMD)
5802  {
5803    i->rank=rank=pMaxComp(p);
5804    t.rtyp=MODUL_CMD;
5805  }
5806  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5807  t.CleanUp();
5808  if (r) return TRUE;
5809  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5810  return FALSE;
5811}
5812static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5813{
5814  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5815    (intvec *)w->Data());
5816  //setFlag(res,FLAG_STD);
5817  return FALSE;
5818}
5819static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5820{
5821  /*4
5822  * look for the substring what in the string where
5823  * starting at position n
5824  * return the position of the first char of what in where
5825  * or 0
5826  */
5827  int n=(int)(long)w->Data();
5828  char *where=(char *)u->Data();
5829  char *what=(char *)v->Data();
5830  char *found;
5831  if ((1>n)||(n>(int)strlen(where)))
5832  {
5833    Werror("start position %d out of range",n);
5834    return TRUE;
5835  }
5836  found = strchr(where+n-1,*what);
5837  if (*(what+1)!='\0')
5838  {
5839    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
5840    {
5841      found=strchr(found+1,*what);
5842    }
5843  }
5844  if (found != NULL)
5845  {
5846    res->data=(char *)((found-where)+1);
5847  }
5848  return FALSE;
5849}
5850static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
5851{
5852  if ((int)(long)w->Data()==0)
5853    res->data=(char *)walkProc(u,v);
5854  else
5855    res->data=(char *)fractalWalkProc(u,v);
5856  setFlag( res, FLAG_STD );
5857  return FALSE;
5858}
5859static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
5860{
5861  intvec *wdegree=(intvec*)w->Data();
5862  if (wdegree->length()!=currRing->N)
5863  {
5864    Werror("weight vector must have size %d, not %d",
5865           currRing->N,wdegree->length());
5866    return TRUE;
5867  }
5868#ifdef HAVE_RINGS
5869  if (rField_is_Ring_Z(currRing))
5870  {
5871    ring origR = currRing;
5872    ring tempR = rCopy(origR);
5873    coeffs new_cf=nInitChar(n_Q,NULL);
5874    nKillChar(tempR->cf);
5875    tempR->cf=new_cf;
5876    rComplete(tempR);
5877    ideal uid = (ideal)u->Data();
5878    rChangeCurrRing(tempR);
5879    ideal uu = idrCopyR(uid, origR, currRing);
5880    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
5881    uuAsLeftv.rtyp = IDEAL_CMD;
5882    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
5883    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
5884    assumeStdFlag(&uuAsLeftv);
5885    Print("// NOTE: computation of Hilbert series etc. is being\n");
5886    Print("//       performed for generic fibre, that is, over Q\n");
5887    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
5888    intvec *iv=hFirstSeries(uu,module_w,currQuotient,wdegree);
5889    int returnWithTrue = 1;
5890    switch((int)(long)v->Data())
5891    {
5892      case 1:
5893        res->data=(void *)iv;
5894        returnWithTrue = 0;
5895      case 2:
5896        res->data=(void *)hSecondSeries(iv);
5897        delete iv;
5898        returnWithTrue = 0;
5899    }
5900    if (returnWithTrue)
5901    {
5902      WerrorS(feNotImplemented);
5903      delete iv;
5904    }
5905    idDelete(&uu);
5906    rChangeCurrRing(origR);
5907    rDelete(tempR);
5908    if (returnWithTrue) return TRUE; else return FALSE;
5909  }
5910#endif
5911  assumeStdFlag(u);
5912  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
5913  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient,wdegree);
5914  switch((int)(long)v->Data())
5915  {
5916    case 1:
5917      res->data=(void *)iv;
5918      return FALSE;
5919    case 2:
5920      res->data=(void *)hSecondSeries(iv);
5921      delete iv;
5922      return FALSE;
5923  }
5924  WerrorS(feNotImplemented);
5925  delete iv;
5926  return TRUE;
5927}
5928static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv /*w*/)
5929{
5930  PrintS("TODO\n");
5931  int i=pVar((poly)v->Data());
5932  if (i==0)
5933  {
5934    WerrorS("ringvar expected");
5935    return TRUE;
5936  }
5937  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5938  int d=pWTotaldegree(p);
5939  pLmDelete(p);
5940  if (d==1)
5941    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
5942  else
5943    WerrorS("variable must have weight 1");
5944  return (d!=1);
5945}
5946static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv /*w*/)
5947{
5948  PrintS("TODO\n");
5949  int i=pVar((poly)v->Data());
5950  if (i==0)
5951  {
5952    WerrorS("ringvar expected");
5953    return TRUE;
5954  }
5955  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5956  int d=pWTotaldegree(p);
5957  pLmDelete(p);
5958  if (d==1)
5959    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
5960  else
5961    WerrorS("variable must have weight 1");
5962  return (d!=1);
5963}
5964static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
5965{
5966  intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
5967  intvec* arg = (intvec*) u->Data();
5968  int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
5969
5970  for (i=0; i<n; i++)
5971  {
5972    (*im)[i] = (*arg)[i];
5973  }
5974
5975  res->data = (char *)im;
5976  return FALSE;
5977}
5978static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
5979{
5980  short *iw=iv2array((intvec *)w->Data(),currRing);
5981  res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
5982  omFreeSize( (ADDRESS)iw, (rVar(currRing)+1)*sizeof(short) );
5983  return FALSE;
5984}
5985static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
5986{
5987  if (!pIsUnit((poly)v->Data()))
5988  {
5989    WerrorS("2nd argument must be a unit");
5990    return TRUE;
5991  }
5992  res->data = (char *)p_Series((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD(),NULL,currRing);
5993  return FALSE;
5994}
5995static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
5996{
5997  res->data = (char *)id_JetW((ideal)u->Data(),(int)(long)v->Data(),
5998                             (intvec *)w->Data(),currRing);
5999  return FALSE;
6000}
6001static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
6002{
6003  if (!mp_IsDiagUnit((matrix)v->Data(), currRing))
6004  {
6005    WerrorS("2nd argument must be a diagonal matrix of units");
6006    return TRUE;
6007  }
6008  res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
6009                               (matrix)v->CopyD());
6010  return FALSE;
6011}
6012static BOOLEAN currRingIsOverIntegralDomain ()
6013{
6014  /* true for fields and Z, false otherwise */
6015  if (rField_is_Ring_PtoM(currRing)) return FALSE;
6016  if (rField_is_Ring_2toM(currRing)) return FALSE;
6017  if (rField_is_Ring_ModN(currRing)) return FALSE;
6018  return TRUE;
6019}
6020static BOOLEAN jjMINOR_M(leftv res, leftv v)
6021{
6022  /* Here's the use pattern for the minor command:
6023        minor ( matrix_expression m, int_expression minorSize,
6024                optional ideal_expression IasSB, optional int_expression k,
6025                optional string_expression algorithm,
6026                optional int_expression cachedMinors,
6027                optional int_expression cachedMonomials )
6028     This method here assumes that there are at least two arguments.
6029     - If IasSB is present, it must be a std basis. All minors will be
6030       reduced w.r.t. IasSB.
6031     - If k is absent, all non-zero minors will be computed.
6032       If k is present and k > 0, the first k non-zero minors will be
6033       computed.
6034       If k is present and k < 0, the first |k| minors (some of which
6035       may be zero) will be computed.
6036       If k is present and k = 0, an error is reported.
6037     - If algorithm is absent, all the following arguments must be absent too.
6038       In this case, a heuristic picks the best-suited algorithm (among
6039       Bareiss, Laplace, and Laplace with caching).
6040       If algorithm is present, it must be one of "Bareiss", "bareiss",
6041       "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
6042       "cache" two more arguments may be given, determining how many entries
6043       the cache may have at most, and how many cached monomials there are at
6044       most. (Cached monomials are counted over all cached polynomials.)
6045       If these two additional arguments are not provided, 200 and 100000
6046       will be used as defaults.
6047  */
6048  matrix m;
6049  leftv u=v->next;
6050  v->next=NULL;
6051  int v_typ=v->Typ();
6052  if (v_typ==MATRIX_CMD)
6053  {
6054     m = (const matrix)v->Data();
6055  }
6056  else
6057  {
6058    if (v_typ==0)
6059    {
6060      Werror("`%s` is undefined",v->Fullname());
6061      return TRUE;
6062    }
6063    // try to convert to MATRIX:
6064    int ii=iiTestConvert(v_typ,MATRIX_CMD);
6065    BOOLEAN bo;
6066    sleftv tmp;
6067    if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
6068    else bo=TRUE;
6069    if (bo)
6070    {
6071      Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
6072      return TRUE;
6073    }
6074    m=(matrix)tmp.data;
6075  }
6076  const int mk = (const int)(long)u->Data();
6077  bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
6078  bool noCacheMinors = true; bool noCacheMonomials = true;
6079  ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
6080
6081  /* here come the different cases of correct argument sets */
6082  if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
6083  {
6084    IasSB = (ideal)u->next->Data();
6085    noIdeal = false;
6086    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6087    {
6088      k = (int)(long)u->next->next->Data();
6089      noK = false;
6090      assume(k != 0);
6091      if ((u->next->next->next != NULL) &&
6092          (u->next->next->next->Typ() == STRING_CMD))
6093      {
6094        algorithm = (char*)u->next->next->next->Data();
6095        noAlgorithm = false;
6096        if ((u->next->next->next->next != NULL) &&
6097            (u->next->next->next->next->Typ() == INT_CMD))
6098        {
6099          cacheMinors = (int)(long)u->next->next->next->next->Data();
6100          noCacheMinors = false;
6101          if ((u->next->next->next->next->next != NULL) &&
6102              (u->next->next->next->next->next->Typ() == INT_CMD))
6103          {
6104            cacheMonomials =
6105               (int)(long)u->next->next->next->next->next->Data();
6106            noCacheMonomials = false;
6107          }
6108        }
6109      }
6110    }
6111  }
6112  else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
6113  {
6114    k = (int)(long)u->next->Data();
6115    noK = false;
6116    assume(k != 0);
6117    if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
6118    {
6119      algorithm = (char*)u->next->next->Data();
6120      noAlgorithm = false;
6121      if ((u->next->next->next != NULL) &&
6122          (u->next->next->next->Typ() == INT_CMD))
6123      {
6124        cacheMinors = (int)(long)u->next->next->next->Data();
6125        noCacheMinors = false;
6126        if ((u->next->next->next->next != NULL) &&
6127            (u->next->next->next->next->Typ() == INT_CMD))
6128        {
6129          cacheMonomials = (int)(long)u->next->next->next->next->Data();
6130          noCacheMonomials = false;
6131        }
6132      }
6133    }
6134  }
6135  else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
6136  {
6137    algorithm = (char*)u->next->Data();
6138    noAlgorithm = false;
6139    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6140    {
6141      cacheMinors = (int)(long)u->next->next->Data();
6142      noCacheMinors = false;
6143      if ((u->next->next->next != NULL) &&
6144          (u->next->next->next->Typ() == INT_CMD))
6145      {
6146        cacheMonomials = (int)(long)u->next->next->next->Data();
6147        noCacheMonomials = false;
6148      }
6149    }
6150  }
6151
6152  /* upper case conversion for the algorithm if present */
6153  if (!noAlgorithm)
6154  {
6155    if (strcmp(algorithm, "bareiss") == 0)
6156      algorithm = (char*)"Bareiss";
6157    if (strcmp(algorithm, "laplace") == 0)
6158      algorithm = (char*)"Laplace";
6159    if (strcmp(algorithm, "cache") == 0)
6160      algorithm = (char*)"Cache";
6161  }
6162
6163  v->next=u;
6164  /* here come some tests */
6165  if (!noIdeal)
6166  {
6167    assumeStdFlag(u->next);
6168  }
6169  if ((!noK) && (k == 0))
6170  {
6171    WerrorS("Provided number of minors to be computed is zero.");
6172    return TRUE;
6173  }
6174  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") != 0)
6175      && (strcmp(algorithm, "Laplace") != 0)
6176      && (strcmp(algorithm, "Cache") != 0))
6177  {
6178    WerrorS("Expected as algorithm one of 'B/bareiss', 'L/laplace', or 'C/cache'.");
6179    return TRUE;
6180  }
6181  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") == 0)
6182      && (!currRingIsOverIntegralDomain()))
6183  {
6184    Werror("Bareiss algorithm not defined over coefficient rings %s",
6185           "with zero divisors.");
6186    return TRUE;
6187  }
6188  if ((mk < 1) || (mk > m->rows()) || (mk > m->cols()))
6189  {
6190    Werror("invalid size of minors: %d (matrix is (%d x %d))", mk,
6191           m->rows(), m->cols());
6192    return TRUE;
6193  }
6194  if ((!noAlgorithm) && (strcmp(algorithm, "Cache") == 0)
6195      && (noCacheMinors || noCacheMonomials))
6196  {
6197    cacheMinors = 200;
6198    cacheMonomials = 100000;
6199  }
6200
6201  /* here come the actual procedure calls */
6202  if (noAlgorithm)
6203    res->data = getMinorIdealHeuristic(m, mk, (noK ? 0 : k),
6204                                       (noIdeal ? 0 : IasSB), false);
6205  else if (strcmp(algorithm, "Cache") == 0)
6206    res->data = getMinorIdealCache(m, mk, (noK ? 0 : k),
6207                                   (noIdeal ? 0 : IasSB), 3, cacheMinors,
6208                                   cacheMonomials, false);
6209  else
6210    res->data = getMinorIdeal(m, mk, (noK ? 0 : k), algorithm,
6211                              (noIdeal ? 0 : IasSB), false);
6212  if (v_typ!=MATRIX_CMD) idDelete((ideal *)&m);
6213  res->rtyp = IDEAL_CMD;
6214  return FALSE;
6215}
6216static BOOLEAN jjNEWSTRUCT3(leftv, leftv u, leftv v, leftv w)
6217{
6218  // u: the name of the new type
6219  // v: the parent type
6220  // w: the elements
6221  newstruct_desc d=newstructChildFromString((const char *)v->Data(),
6222                                            (const char *)w->Data());
6223  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
6224  return (d==NULL);
6225}
6226static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w)
6227{
6228  // handles preimage(r,phi,i) and kernel(r,phi)
6229  idhdl h;
6230  ring rr;
6231  map mapping;
6232  BOOLEAN kernel_cmd= (iiOp==KERNEL_CMD);
6233
6234  if ((v->name==NULL) || (!kernel_cmd && (w->name==NULL)))
6235  {
6236    WerrorS("2nd/3rd arguments must have names");
6237    return TRUE;
6238  }
6239  rr=(ring)u->Data();
6240  const char *ring_name=u->Name();
6241  if ((h=rr->idroot->get(v->name,myynest))!=NULL)
6242  {
6243    if (h->typ==MAP_CMD)
6244    {
6245      mapping=IDMAP(h);
6246      idhdl preim_ring=IDROOT->get(mapping->preimage,myynest);
6247      if ((preim_ring==NULL)
6248      || (IDRING(preim_ring)!=currRing))
6249      {
6250        Werror("preimage ring `%s` is not the basering",mapping->preimage);
6251        return TRUE;
6252      }
6253    }
6254    else if (h->typ==IDEAL_CMD)
6255    {
6256      mapping=IDMAP(h);
6257    }
6258    else
6259    {
6260      Werror("`%s` is no map nor ideal",IDID(h));
6261      return TRUE;
6262    }
6263  }
6264  else
6265  {
6266    Werror("`%s` is not defined in `%s`",v->name,ring_name);
6267    return TRUE;
6268  }
6269  ideal image;
6270  if (kernel_cmd) image=idInit(1,1);
6271  else
6272  {
6273    if ((h=rr->idroot->get(w->name,myynest))!=NULL)
6274    {
6275      if (h->typ==IDEAL_CMD)
6276      {
6277        image=IDIDEAL(h);
6278      }
6279      else
6280      {
6281        Werror("`%s` is no ideal",IDID(h));
6282        return TRUE;
6283      }
6284    }
6285    else
6286    {
6287      Werror("`%s` is not defined in `%s`",w->name,ring_name);
6288      return TRUE;
6289    }
6290  }
6291  if (((currRing->qideal!=NULL) && (rHasLocalOrMixedOrdering_currRing()))
6292  || ((rr->qideal!=NULL) && (rHasLocalOrMixedOrdering(rr))))
6293  {
6294    WarnS("preimage in local qring may be wrong: use Ring::preimageLoc instead");
6295  }
6296  res->data=(char *)maGetPreimage(rr,mapping,image,currRing);
6297  if (kernel_cmd) idDelete(&image);
6298  return (res->data==NULL/* is of type ideal, should not be NULL*/);
6299}
6300static BOOLEAN jjRANDOM_Im(leftv res, leftv u, leftv v, leftv w)
6301{
6302  int di, k;
6303  int i=(int)(long)u->Data();
6304  int r=(int)(long)v->Data();
6305  int c=(int)(long)w->Data();
6306  if ((r<=0) || (c<=0)) return TRUE;
6307  intvec *iv = new intvec(r, c, 0);
6308  if (iv->rows()==0)
6309  {
6310    delete iv;
6311    return TRUE;
6312  }
6313  if (i!=0)
6314  {
6315    if (i<0) i = -i;
6316    di = 2 * i + 1;
6317    for (k=0; k<iv->length(); k++)
6318    {
6319      (*iv)[k] = ((siRand() % di) - i);
6320    }
6321  }
6322  res->data = (char *)iv;
6323  return FALSE;
6324}
6325static BOOLEAN jjSUBST_Test(leftv v,leftv w,
6326  int &ringvar, poly &monomexpr)
6327{
6328  monomexpr=(poly)w->Data();
6329  poly p=(poly)v->Data();
6330#if 0
6331  if (pLength(monomexpr)>1)
6332  {
6333    Werror("`%s` substitutes a ringvar only by a term",
6334      Tok2Cmdname(SUBST_CMD));
6335    return TRUE;
6336  }
6337#endif
6338  if ((ringvar=pVar(p))==0)
6339  {
6340    if ((p!=NULL) && (currRing->cf->extRing!=NULL))
6341    {
6342      number n = pGetCoeff(p);
6343      ringvar= -n_IsParam(n, currRing);
6344    }
6345    if(ringvar==0)
6346    {
6347      WerrorS("ringvar/par expected");
6348      return TRUE;
6349    }
6350  }
6351  return FALSE;
6352}
6353static BOOLEAN jjSUBST_P(leftv res, leftv u, leftv v,leftv w)
6354{
6355  int ringvar;
6356  poly monomexpr;
6357  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6358  if (nok) return TRUE;
6359  poly p=(poly)u->Data();
6360  if (ringvar>0)
6361  {
6362    if ((monomexpr!=NULL) && (p!=NULL) && (pTotaldegree(p)!=0) &&
6363    ((unsigned long)pTotaldegree(monomexpr) > (currRing->bitmask / (unsigned long)pTotaldegree(p))))
6364    {
6365      Warn("possible OVERFLOW in subst, max exponent is %ld, subtituting deg %d by deg %d",currRing->bitmask, pTotaldegree(monomexpr), pTotaldegree(p));
6366      //return TRUE;
6367    }
6368    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6369      res->data = pSubst((poly)u->CopyD(res->rtyp),ringvar,monomexpr);
6370    else
6371      res->data= pSubstPoly(p,ringvar,monomexpr);
6372  }
6373  else
6374  {
6375    res->data=pSubstPar(p,-ringvar,monomexpr);
6376  }
6377  return FALSE;
6378}
6379static BOOLEAN jjSUBST_Id(leftv res, leftv u, leftv v,leftv w)
6380{
6381  int ringvar;
6382  poly monomexpr;
6383  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6384  if (nok) return TRUE;
6385  if (ringvar>0)
6386  {
6387    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6388      res->data = id_Subst((ideal)u->CopyD(res->rtyp), ringvar, monomexpr, currRing);
6389    else
6390      res->data = idSubstPoly((ideal)u->Data(),ringvar,monomexpr);
6391  }
6392  else
6393  {
6394    res->data = idSubstPar((ideal)u->Data(),-ringvar,monomexpr);
6395  }
6396  return FALSE;
6397}
6398// we do not want to have jjSUBST_Id_X inlined:
6399static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w,
6400                            int input_type);
6401static BOOLEAN jjSUBST_Id_I(leftv res, leftv u, leftv v,leftv w)
6402{
6403  return jjSUBST_Id_X(res,u,v,w,INT_CMD);
6404}
6405static BOOLEAN jjSUBST_Id_N(leftv res, leftv u, leftv v,leftv w)
6406{
6407  return jjSUBST_Id_X(res,u,v,w,NUMBER_CMD);
6408}
6409static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w, int input_type)
6410{
6411  sleftv tmp;
6412  memset(&tmp,0,sizeof(tmp));
6413  // do not check the result, conversion from int/number to poly works always
6414  iiConvert(input_type,POLY_CMD,iiTestConvert(input_type,POLY_CMD),w,&tmp);
6415  BOOLEAN b=jjSUBST_Id(res,u,v,&tmp);
6416  tmp.CleanUp();
6417  return b;
6418}
6419static BOOLEAN jjMATRIX_Id(leftv res, leftv u, leftv v,leftv w)
6420{
6421  int mi=(int)(long)v->Data();
6422  int ni=(int)(long)w->Data();
6423  if ((mi<1)||(ni<1))
6424  {
6425    Werror("converting ideal to matrix: dimensions must be positive(%dx%d)",mi,ni);
6426    return TRUE;
6427  }
6428  matrix m=mpNew(mi,ni);
6429  ideal I=(ideal)u->CopyD(IDEAL_CMD);
6430  int i=si_min(IDELEMS(I),mi*ni);
6431  //for(i=i-1;i>=0;i--)
6432  //{
6433  //  m->m[i]=I->m[i];
6434  //  I->m[i]=NULL;
6435  //}
6436  memcpy(m->m,I->m,i*sizeof(poly));
6437  memset(I->m,0,i*sizeof(poly));
6438  id_Delete(&I,currRing);
6439  res->data = (char *)m;
6440  return FALSE;
6441}
6442static BOOLEAN jjMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6443{
6444  int mi=(int)(long)v->Data();
6445  int ni=(int)(long)w->Data();
6446  if ((mi<1)||(ni<1))
6447  {
6448    Werror("converting module to matrix: dimensions must be positive(%dx%d)",mi,ni);
6449    return TRUE;
6450  }
6451  res->data = (char *)id_Module2formatedMatrix((ideal)u->CopyD(MODUL_CMD),
6452           mi,ni,currRing);
6453  return FALSE;
6454}
6455static BOOLEAN jjMATRIX_Ma(leftv res, leftv u, leftv v,leftv w)
6456{
6457  int mi=(int)(long)v->Data();
6458  int ni=(int)(long)w->Data();
6459  if ((mi<1)||(ni<1))
6460  {
6461     Werror("converting matrix to matrix: dimensions must be positive(%dx%d)",mi,ni);
6462    return TRUE;
6463  }
6464  matrix m=mpNew(mi,ni);
6465  matrix I=(matrix)u->CopyD(MATRIX_CMD);
6466  int r=si_min(MATROWS(I),mi);
6467  int c=si_min(MATCOLS(I),ni);
6468  int i,j;
6469  for(i=r;i>0;i--)
6470  {
6471    for(j=c;j>0;j--)
6472    {
6473      MATELEM(m,i,j)=MATELEM(I,i,j);
6474      MATELEM(I,i,j)=NULL;
6475    }
6476  }
6477  id_Delete((ideal *)&I,currRing);
6478  res->data = (char *)m;
6479  return FALSE;
6480}
6481static BOOLEAN jjLIFT3(leftv res, leftv u, leftv v, leftv w)
6482{
6483  if (w->rtyp!=IDHDL) return TRUE;
6484  int ul= IDELEMS((ideal)u->Data());
6485  int vl= IDELEMS((ideal)v->Data());
6486  ideal m
6487    = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
6488             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))));
6489  if (m==NULL) return TRUE;
6490  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
6491  return FALSE;
6492}
6493static BOOLEAN jjLIFTSTD3(leftv res, leftv u, leftv v, leftv w)
6494{
6495  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
6496  if ((w->rtyp!=IDHDL)||(w->e!=NULL)) return TRUE;
6497  idhdl hv=(idhdl)v->data;
6498  idhdl hw=(idhdl)w->data;
6499  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
6500  res->data = (char *)idLiftStd((ideal)u->Data(),
6501                                &(hv->data.umatrix),testHomog,
6502                                &(hw->data.uideal));
6503  setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
6504  return FALSE;
6505}
6506static BOOLEAN jjREDUCE3_CP(leftv res, leftv u, leftv v, leftv w)
6507{
6508  assumeStdFlag(v);
6509  if (!idIsZeroDim((ideal)v->Data()))
6510  {
6511    Werror("`%s` must be 0-dimensional",v->Name());
6512    return TRUE;
6513  }
6514  res->data = (char *)redNF((ideal)v->CopyD(),(poly)u->CopyD(),
6515    (poly)w->CopyD());
6516  return FALSE;
6517}
6518static BOOLEAN jjREDUCE3_CID(leftv res, leftv u, leftv v, leftv w)
6519{
6520  assumeStdFlag(v);
6521  if (!idIsZeroDim((ideal)v->Data()))
6522  {
6523    Werror("`%s` must be 0-dimensional",v->Name());
6524    return TRUE;
6525  }
6526  res->data = (char *)redNF((ideal)v->CopyD(),(ideal)u->CopyD(),
6527    (matrix)w->CopyD());
6528  return FALSE;
6529}
6530static BOOLEAN jjREDUCE3_P(leftv res, leftv u, leftv v, leftv w)
6531{
6532  assumeStdFlag(v);
6533  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data(),
6534    0,(int)(long)w->Data());
6535  return FALSE;
6536}
6537static BOOLEAN jjREDUCE3_ID(leftv res, leftv u, leftv v, leftv w)
6538{
6539  assumeStdFlag(v);
6540  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(ideal)u->Data(),
6541    0,(int)(long)w->Data());
6542  return FALSE;
6543}
6544#ifdef OLD_RES
6545static BOOLEAN jjRES3(leftv res, leftv u, leftv v, leftv w)
6546{
6547  int maxl=(int)v->Data();
6548  ideal u_id=(ideal)u->Data();
6549  int l=0;
6550  resolvente r;
6551  intvec **weights=NULL;
6552  int wmaxl=maxl;
6553  maxl--;
6554  if ((maxl==-1) && (iiOp!=MRES_CMD))
6555    maxl = currRing->N-1;
6556  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
6557  {
6558    intvec * iv=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
6559    if (iv!=NULL)
6560    {
6561      l=1;
6562      if (!idTestHomModule(u_id,currQuotient,iv))
6563      {
6564        WarnS("wrong weights");
6565        iv=NULL;
6566      }
6567      else
6568      {
6569        weights = (intvec**)omAlloc0Bin(char_ptr_bin);
6570        weights[0] = ivCopy(iv);
6571      }
6572    }
6573    r=syResolvente(u_id,maxl,&l, &weights, iiOp==MRES_CMD);
6574  }
6575  else
6576    r=sySchreyerResolvente((ideal)u->Data(),maxl+1,&l);
6577  if (r==NULL) return TRUE;
6578  int t3=u->Typ();
6579  iiMakeResolv(r,l,wmaxl,w->name,t3,weights);
6580  return FALSE;
6581}
6582#endif
6583static BOOLEAN jjRING3(leftv res, leftv u, leftv v, leftv w)
6584{
6585  res->data=(void *)rInit(u,v,w);
6586  return (res->data==NULL);
6587}
6588static BOOLEAN jjSTATUS3(leftv res, leftv u, leftv v, leftv w)
6589{
6590  int yes;
6591  jjSTATUS2(res, u, v);
6592  yes = (strcmp((char *) res->data, (char *) w->Data()) == 0);
6593  omFree((ADDRESS) res->data);
6594  res->data = (void *)(long)yes;
6595  return FALSE;
6596}
6597static BOOLEAN jjSTD_HILB_W(leftv res, leftv u, leftv v, leftv w)
6598{
6599  intvec *vw=(intvec *)w->Data(); // weights of vars
6600  if (vw->length()!=currRing->N)
6601  {
6602    Werror("%d weights for %d variables",vw->length(),currRing->N);
6603    return TRUE;
6604  }
6605  ideal result;
6606  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6607  tHomog hom=testHomog;
6608  ideal u_id=(ideal)(u->Data());
6609  if (ww!=NULL)
6610  {
6611    if (!idTestHomModule(u_id,currQuotient,ww))
6612    {
6613      WarnS("wrong weights");
6614      ww=NULL;
6615    }
6616    else
6617    {
6618      ww=ivCopy(ww);
6619      hom=isHomog;
6620    }
6621  }
6622  result=kStd(u_id,
6623              currQuotient,
6624              hom,
6625              &ww,                  // module weights
6626              (intvec *)v->Data(),  // hilbert series
6627              0,0,                  // syzComp, newIdeal
6628              vw);                  // weights of vars
6629  idSkipZeroes(result);
6630  res->data = (char *)result;
6631  setFlag(res,FLAG_STD);
6632  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
6633  return FALSE;
6634}
6635
6636/*=================== operations with many arg.: static proc =================*/
6637/* must be ordered: first operations for chars (infix ops),
6638 * then alphabetically */
6639static BOOLEAN jjBREAK0(leftv, leftv)
6640{
6641#ifdef HAVE_SDB
6642  sdb_show_bp();
6643#endif
6644  return FALSE;
6645}
6646static BOOLEAN jjBREAK1(leftv, leftv v)
6647{
6648#ifdef HAVE_SDB
6649  if(v->Typ()==PROC_CMD)
6650  {
6651    int lineno=0;
6652    if((v->next!=NULL) && (v->next->Typ()==INT_CMD))
6653    {
6654      lineno=(int)(long)v->next->Data();
6655    }
6656    return sdb_set_breakpoint(v->Name(),lineno);
6657  }
6658  return TRUE;
6659#else
6660 return FALSE;
6661#endif
6662}
6663static BOOLEAN jjCALL1ARG(leftv res, leftv v)
6664{
6665  return iiExprArith1(res,v,iiOp);
6666}
6667static BOOLEAN jjCALL2ARG(leftv res, leftv u)
6668{
6669  leftv v=u->next;
6670  u->next=NULL;
6671  BOOLEAN b=iiExprArith2(res,u,iiOp,v, (iiOp > 255));
6672  u->next=v;
6673  return b;
6674}
6675static BOOLEAN jjCALL3ARG(leftv res, leftv u)
6676{
6677  leftv v = u->next;
6678  leftv w = v->next;
6679  u->next = NULL;
6680  v->next = NULL;
6681  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
6682  u->next = v;
6683  v->next = w;
6684  return b;
6685}
6686
6687static BOOLEAN jjCOEF_M(leftv, leftv v)
6688{
6689  if((v->Typ() != VECTOR_CMD)
6690  || (v->next->Typ() != POLY_CMD)
6691  || (v->next->next->Typ() != MATRIX_CMD)
6692  || (v->next->next->next->Typ() != MATRIX_CMD))
6693     return TRUE;
6694  if (v->next->next->rtyp!=IDHDL) return TRUE;
6695  idhdl c=(idhdl)v->next->next->data;
6696  if (v->next->next->next->rtyp!=IDHDL) return TRUE;
6697  idhdl m=(idhdl)v->next->next->next->data;
6698  idDelete((ideal *)&(c->data.uideal));
6699  idDelete((ideal *)&(m->data.uideal));
6700  mp_Coef2((poly)v->Data(),(poly)v->next->Data(),
6701    (matrix *)&(c->data.umatrix),(matrix *)&(m->data.umatrix),currRing);
6702  return FALSE;
6703}
6704
6705static BOOLEAN jjDIVISION4(leftv res, leftv v)
6706{ // may have 3 or 4 arguments
6707  leftv v1=v;
6708  leftv v2=v1->next;
6709  leftv v3=v2->next;
6710  leftv v4=v3->next;
6711  assumeStdFlag(v2);
6712
6713  int i1=iiTestConvert(v1->Typ(),MODUL_CMD);
6714  int i2=iiTestConvert(v2->Typ(),MODUL_CMD);
6715
6716  if((i1==0)||(i2==0)
6717  ||(v3->Typ()!=INT_CMD)||((v4!=NULL)&&(v4->Typ()!=INTVEC_CMD)))
6718  {
6719    WarnS("<module>,<module>,<int>[,<intvec>] expected!");
6720    return TRUE;
6721  }
6722
6723  sleftv w1,w2;
6724  iiConvert(v1->Typ(),MODUL_CMD,i1,v1,&w1);
6725  iiConvert(v2->Typ(),MODUL_CMD,i2,v2,&w2);
6726  ideal P=(ideal)w1.Data();
6727  ideal Q=(ideal)w2.Data();
6728
6729  int n=(int)(long)v3->Data();
6730  short *w=NULL;
6731  if(v4!=NULL)
6732  {
6733    w = iv2array((intvec *)v4->Data(),currRing);
6734    short * w0 = w + 1;
6735    int i = currRing->N;
6736    while( (i > 0) && ((*w0) > 0) )
6737    {
6738      w0++;
6739      i--;
6740    }
6741    if(i>0)
6742      WarnS("not all weights are positive!");
6743  }
6744
6745  matrix T;
6746  ideal R;
6747  idLiftW(P,Q,n,T,R,w);
6748
6749  w1.CleanUp();
6750  w2.CleanUp();
6751  if(w!=NULL)
6752    omFreeSize( (ADDRESS)w, (rVar(currRing)+1)*sizeof(short) );
6753
6754  lists L=(lists) omAllocBin(slists_bin);
6755  L->Init(2);
6756  L->m[1].rtyp=v1->Typ();
6757  if(v1->Typ()==POLY_CMD||v1->Typ()==VECTOR_CMD)
6758  {
6759    if(v1->Typ()==POLY_CMD)
6760      p_Shift(&R->m[0],-1,currRing);
6761    L->m[1].data=(void *)R->m[0];
6762    R->m[0]=NULL;
6763    idDelete(&R);
6764  }
6765  else if(v1->Typ()==IDEAL_CMD||v1->Typ()==MATRIX_CMD)
6766    L->m[1].data=(void *)id_Module2Matrix(R,currRing);
6767  else
6768  {
6769    L->m[1].rtyp=MODUL_CMD;
6770    L->m[1].data=(void *)R;
6771  }
6772  L->m[0].rtyp=MATRIX_CMD;
6773  L->m[0].data=(char *)T;
6774
6775  res->data=L;
6776  res->rtyp=LIST_CMD;
6777
6778  return FALSE;
6779}
6780
6781//static BOOLEAN jjEXPORTTO_M(leftv res, leftv u)
6782//{
6783//  int l=u->listLength();
6784//  if (l<2) return TRUE;
6785//  BOOLEAN b;
6786//  leftv v=u->next;
6787//  leftv zz=v;
6788//  leftv z=zz;
6789//  u->next=NULL;
6790//  do
6791//  {
6792//    leftv z=z->next;
6793//    b=iiExprArith2(res,u,iiOp,z, (iiOp > 255));
6794//    if (b) break;
6795//  } while (z!=NULL);
6796//  u->next=zz;
6797//  return b;
6798//}
6799static BOOLEAN jjIDEAL_PL(leftv res, leftv v)
6800{
6801  int s=1;
6802  leftv h=v;
6803  if (h!=NULL) s=exprlist_length(h);
6804  ideal id=idInit(s,1);
6805  int rank=1;
6806  int i=0;
6807  poly p;
6808  while (h!=NULL)
6809  {
6810    switch(h->Typ())
6811    {
6812      case POLY_CMD:
6813      {
6814        p=(poly)h->CopyD(POLY_CMD);
6815        break;
6816      }
6817      case INT_CMD:
6818      {
6819        number n=nInit((int)(long)h->Data());
6820        if (!nIsZero(n))
6821        {
6822          p=pNSet(n);
6823        }
6824        else
6825        {
6826          p=NULL;
6827          nDelete(&n);
6828        }
6829        break;
6830      }
6831      case BIGINT_CMD:
6832      {
6833        number b=(number)h->Data();
6834        number n=n_Init_bigint(b,coeffs_BIGINT,currRing->cf);
6835        if (!nIsZero(n))
6836        {
6837          p=pNSet(n);
6838        }
6839        else
6840        {
6841          p=NULL;
6842          nDelete(&n);
6843        }
6844        break;
6845      }
6846      case NUMBER_CMD:
6847      {
6848        number n=(number)h->CopyD(NUMBER_CMD);
6849        if (!nIsZero(n))
6850        {
6851          p=pNSet(n);
6852        }
6853        else
6854        {
6855          p=NULL;
6856          nDelete(&n);
6857        }
6858        break;
6859      }
6860      case VECTOR_CMD:
6861      {
6862        p=(poly)h->CopyD(VECTOR_CMD);
6863        if (iiOp!=MODUL_CMD)
6864        {
6865          idDelete(&id);
6866          pDelete(&p);
6867          return TRUE;
6868        }
6869        rank=si_max(rank,(int)pMaxComp(p));
6870        break;
6871      }
6872      default:
6873      {
6874        idDelete(&id);
6875        return TRUE;
6876      }
6877    }
6878    if ((iiOp==MODUL_CMD)&&(p!=NULL)&&(pGetComp(p)==0))
6879    {
6880      pSetCompP(p,1);
6881    }
6882    id->m[i]=p;
6883    i++;
6884    h=h->next;
6885  }
6886  id->rank=rank;
6887  res->data=(char *)id;
6888  return FALSE;
6889}
6890static BOOLEAN jjINTERSECT_PL(leftv res, leftv v)
6891{
6892  leftv h=v;
6893  int l=v->listLength();
6894  resolvente r=(resolvente)omAlloc0(l*sizeof(ideal));
6895  BOOLEAN *copied=(BOOLEAN *)omAlloc0(l*sizeof(BOOLEAN));
6896  int t=0;
6897  // try to convert to IDEAL_CMD
6898  while (h!=NULL)
6899  {
6900    if (iiTestConvert(h->Typ(),IDEAL_CMD)!=0)
6901    {
6902      t=IDEAL_CMD;
6903    }
6904    else break;
6905    h=h->next;
6906  }
6907  // if failure, try MODUL_CMD
6908  if (t==0)
6909  {
6910    h=v;
6911    while (h!=NULL)
6912    {
6913      if (iiTestConvert(h->Typ(),MODUL_CMD)!=0)
6914      {
6915        t=MODUL_CMD;
6916      }
6917      else break;
6918      h=h->next;
6919    }
6920  }
6921  // check for success  in converting
6922  if (t==0)
6923  {
6924    WerrorS("cannot convert to ideal or module");
6925    return TRUE;
6926  }
6927  // call idMultSect
6928  h=v;
6929  int i=0;
6930  sleftv tmp;
6931  while (h!=NULL)
6932  {
6933    if (h->Typ()==t)
6934    {
6935      r[i]=(ideal)h->Data(); /*no copy*/
6936      h=h->next;
6937    }
6938    else if(iiConvert(h->Typ(),t,iiTestConvert(h->Typ(),t),h,&tmp))
6939    {
6940      omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
6941      omFreeSize((ADDRESS)r,l*sizeof(ideal));
6942      Werror("cannot convert arg. %d to %s",i+1,Tok2Cmdname(t));
6943      return TRUE;
6944    }
6945    else
6946    {
6947      r[i]=(ideal)tmp.Data(); /*now it's a copy*/
6948      copied[i]=TRUE;
6949      h=tmp.next;
6950    }
6951    i++;
6952  }
6953  res->rtyp=t;
6954  res->data=(char *)idMultSect(r,i);
6955  while(i>0)
6956  {
6957    i--;
6958    if (copied[i]) idDelete(&(r[i]));
6959  }
6960  omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
6961  omFreeSize((ADDRESS)r,l*sizeof(ideal));
6962  return FALSE;
6963}
6964static BOOLEAN jjLU_INVERSE(leftv res, leftv v)
6965{
6966  /* computation of the inverse of a quadratic matrix A
6967     using the L-U-decomposition of A;
6968     There are two valid parametrisations:
6969     1) exactly one argument which is just the matrix A,
6970     2) exactly three arguments P, L, U which already
6971        realise the L-U-decomposition of A, that is,
6972        P * A = L * U, and P, L, and U satisfy the
6973        properties decribed in method 'jjLU_DECOMP';
6974        see there;
6975     If A is invertible, the list [1, A^(-1)] is returned,
6976     otherwise the list [0] is returned. Thus, the user may
6977     inspect the first entry of the returned list to see
6978     whether A is invertible. */
6979  matrix iMat; int invertible;
6980  if (v->next == NULL)
6981  {
6982    if (v->Typ() != MATRIX_CMD)
6983    {
6984      Werror("expected either one or three matrices");
6985      return TRUE;
6986    }
6987    else
6988    {
6989      matrix aMat = (matrix)v->Data();
6990      int rr = aMat->rows();
6991      int cc = aMat->cols();
6992      if (rr != cc)
6993      {
6994        Werror("given matrix (%d x %d) is not quadratic, hence not invertible", rr, cc);
6995        return TRUE;
6996      }
6997      if (!idIsConstant((ideal)aMat))
6998      {
6999        WerrorS("matrix must be constant");
7000        return TRUE;
7001      }
7002      invertible = luInverse(aMat, iMat);
7003    }
7004  }
7005  else if ((v->Typ() == MATRIX_CMD) &&
7006           (v->next->Typ() == MATRIX_CMD) &&
7007           (v->next->next != NULL) &&
7008           (v->next->next->Typ() == MATRIX_CMD) &&
7009           (v->next->next->next == NULL))
7010  {
7011     matrix pMat = (matrix)v->Data();
7012     matrix lMat = (matrix)v->next->Data();
7013     matrix uMat = (matrix)v->next->next->Data();
7014     int rr = uMat->rows();
7015     int cc = uMat->cols();
7016     if (rr != cc)
7017     {
7018       Werror("third matrix (%d x %d) is not quadratic, hence not invertible",
7019              rr, cc);
7020       return TRUE;
7021     }
7022      if (!idIsConstant((ideal)pMat)
7023      || (!idIsConstant((ideal)lMat))
7024      || (!idIsConstant((ideal)uMat))
7025      )
7026      {
7027        WerrorS("matricesx must be constant");
7028        return TRUE;
7029      }
7030     invertible = luInverseFromLUDecomp(pMat, lMat, uMat, iMat);
7031  }
7032  else
7033  {
7034    Werror("expected either one or three matrices");
7035    return TRUE;
7036  }
7037
7038  /* build the return structure; a list with either one or two entries */
7039  lists ll = (lists)omAllocBin(slists_bin);
7040  if (invertible)
7041  {
7042    ll->Init(2);
7043    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)invertible;
7044    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)iMat;
7045  }
7046  else
7047  {
7048    ll->Init(1);
7049    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)invertible;
7050  }
7051
7052  res->data=(char*)ll;
7053  return FALSE;
7054}
7055static BOOLEAN jjLU_SOLVE(leftv res, leftv v)
7056{
7057  /* for solving a linear equation system A * x = b, via the
7058     given LU-decomposition of the matrix A;
7059     There is one valid parametrisation:
7060     1) exactly four arguments P, L, U, b;
7061        P, L, and U realise the L-U-decomposition of A, that is,
7062        P * A = L * U, and P, L, and U satisfy the
7063        properties decribed in method 'jjLU_DECOMP';
7064        see there;
7065        b is the right-hand side vector of the equation system;
7066     The method will return a list of either 1 entry or three entries:
7067     1) [0] if there is no solution to the system;
7068     2) [1, x, H] if there is at least one solution;
7069        x is any solution of the given linear system,
7070        H is the matrix with column vectors spanning the homogeneous
7071        solution space.
7072     The method produces an error if matrix and vector sizes do not fit. */
7073  if ((v == NULL) || (v->Typ() != MATRIX_CMD) ||
7074      (v->next == NULL) || (v->next->Typ() != MATRIX_CMD) ||
7075      (v->next->next == NULL) || (v->next->next->Typ() != MATRIX_CMD) ||
7076      (v->next->next->next == NULL) ||
7077      (v->next->next->next->Typ() != MATRIX_CMD) ||
7078      (v->next->next->next->next != NULL))
7079  {
7080    WerrorS("expected exactly three matrices and one vector as input");
7081    return TRUE;
7082  }
7083  matrix pMat = (matrix)v->Data();
7084  matrix lMat = (matrix)v->next->Data();
7085  matrix uMat = (matrix)v->next->next->Data();
7086  matrix bVec = (matrix)v->next->next->next->Data();
7087  matrix xVec; int solvable; matrix homogSolSpace;
7088  if (pMat->rows() != pMat->cols())
7089  {
7090    Werror("first matrix (%d x %d) is not quadratic",
7091           pMat->rows(), pMat->cols());
7092    return TRUE;
7093  }
7094  if (lMat->rows() != lMat->cols())
7095  {
7096    Werror("second matrix (%d x %d) is not quadratic",
7097           lMat->rows(), lMat->cols());
7098    return TRUE;
7099  }
7100  if (lMat->rows() != uMat->rows())
7101  {
7102    Werror("second matrix (%d x %d) and third matrix (%d x %d) do not fit",
7103           lMat->rows(), lMat->cols(), uMat->rows(), uMat->cols());
7104    return TRUE;
7105  }
7106  if (uMat->rows() != bVec->rows())
7107  {
7108    Werror("third matrix (%d x %d) and vector (%d x 1) do not fit",
7109           uMat->rows(), uMat->cols(), bVec->rows());
7110    return TRUE;
7111  }
7112  if (!idIsConstant((ideal)pMat)
7113  ||(!idIsConstant((ideal)lMat))
7114  ||(!idIsConstant((ideal)uMat))
7115  )
7116  {
7117    WerrorS("matrices must be constant");
7118    return TRUE;
7119  }
7120  solvable = luSolveViaLUDecomp(pMat, lMat, uMat, bVec, xVec, homogSolSpace);
7121
7122  /* build the return structure; a list with either one or three entries */
7123  lists ll = (lists)omAllocBin(slists_bin);
7124  if (solvable)
7125  {
7126    ll->Init(3);
7127    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
7128    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
7129    ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
7130  }
7131  else
7132  {
7133    ll->Init(1);
7134    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
7135  }
7136
7137  res->data=(char*)ll;
7138  return FALSE;
7139}
7140static BOOLEAN jjINTVEC_PL(leftv res, leftv v)
7141{
7142  int i=0;
7143  leftv h=v;
7144  if (h!=NULL) i=exprlist_length(h);
7145  intvec *iv=new intvec(i);
7146  i=0;
7147  while (h!=NULL)
7148  {
7149    if(h->Typ()==INT_CMD)
7150    {
7151      (*iv)[i]=(int)(long)h->Data();
7152    }
7153    else
7154    {
7155      delete iv;
7156      return TRUE;
7157    }
7158    i++;
7159    h=h->next;
7160  }
7161  res->data=(char *)iv;
7162  return FALSE;
7163}
7164static BOOLEAN jjJET4(leftv res, leftv u)
7165{
7166  leftv u1=u;
7167  leftv u2=u1->next;
7168  leftv u3=u2->next;
7169  leftv u4=u3->next;
7170  if((u2->Typ()==POLY_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
7171  &&((u1->Typ()==POLY_CMD)||(u1->Typ()==VECTOR_CMD)))
7172  {
7173    if(!pIsUnit((poly)u2->Data()))
7174    {
7175      WerrorS("2nd argument must be a unit");
7176      return TRUE;
7177    }
7178    res->rtyp=u1->Typ();
7179    res->data=(char*)pSeries((int)(long)u3->Data(),pCopy((poly)u1->Data()),
7180                             pCopy((poly)u2->Data()),(intvec*)u4->Data());
7181    return FALSE;
7182  }
7183  else
7184  if((u2->Typ()==MATRIX_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
7185  &&((u1->Typ()==IDEAL_CMD)||(u1->Typ()==MODUL_CMD)))
7186  {
7187    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7188    {
7189      WerrorS("2nd argument must be a diagonal matrix of units");
7190      return TRUE;
7191    }
7192    res->rtyp=u1->Typ();
7193    res->data=(char*)idSeries(
7194                              (int)(long)u3->Data(),
7195                              idCopy((ideal)u1->Data()),
7196                              mp_Copy((matrix)u2->Data(), currRing),
7197                              (intvec*)u4->Data()
7198                             );
7199    return FALSE;
7200  }
7201  else
7202  {
7203    Werror("%s(`poly`,`poly`,`int`,`intvec`) exppected",
7204           Tok2Cmdname(iiOp));
7205    return TRUE;
7206  }
7207}
7208static BOOLEAN jjKLAMMER_PL(leftv res, leftv u)
7209{
7210  if ((yyInRingConstruction)
7211  && ((strcmp(u->Name(),"real")==0) || (strcmp(u->Name(),"complex")==0)))
7212  {
7213    memcpy(res,u,sizeof(sleftv));
7214    memset(u,0,sizeof(sleftv));
7215    return FALSE;
7216  }
7217  leftv v=u->next;
7218  BOOLEAN b;
7219  if(v==NULL)
7220    b=iiExprArith1(res,u,iiOp);
7221  else
7222  {
7223    u->next=NULL;
7224    b=iiExprArith2(res,u,iiOp,v);
7225    u->next=v;
7226  }
7227  return b;
7228}
7229BOOLEAN jjLIST_PL(leftv res, leftv v)
7230{
7231  int sl=0;
7232  if (v!=NULL) sl = v->listLength();
7233  lists L;
7234  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7235  {
7236    int add_row_shift = 0;
7237    intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7238    if (weights!=NULL)  add_row_shift=weights->min_in();
7239    L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7240  }
7241  else
7242  {
7243    L=(lists)omAllocBin(slists_bin);
7244    leftv h=NULL;
7245    int i;
7246    int rt;
7247
7248    L->Init(sl);
7249    for (i=0;i<sl;i++)
7250    {
7251      if (h!=NULL)
7252      { /* e.g. not in the first step:
7253         * h is the pointer to the old sleftv,
7254         * v is the pointer to the next sleftv
7255         * (in this moment) */
7256         h->next=v;
7257      }
7258      h=v;
7259      v=v->next;
7260      h->next=NULL;
7261      rt=h->Typ();
7262      if (rt==0)
7263      {
7264        L->Clean();
7265        Werror("`%s` is undefined",h->Fullname());
7266        return TRUE;
7267      }
7268      if ((rt==RING_CMD)||(rt==QRING_CMD))
7269      {
7270        L->m[i].rtyp=rt;  L->m[i].data=h->Data();
7271        ((ring)L->m[i].data)->ref++;
7272      }
7273      else
7274        L->m[i].Copy(h);
7275    }
7276  }
7277  res->data=(char *)L;
7278  return FALSE;
7279}
7280static BOOLEAN jjNAMES0(leftv res, leftv)
7281{
7282  res->data=(void *)ipNameList(IDROOT);
7283  return FALSE;
7284}
7285static BOOLEAN jjOPTION_PL(leftv res, leftv v)
7286{
7287  if(v==NULL)
7288  {
7289    res->data=(char *)showOption();
7290    return FALSE;
7291  }
7292  res->rtyp=NONE;
7293  return setOption(res,v);
7294}
7295static BOOLEAN jjREDUCE4(leftv res, leftv u)
7296{
7297  leftv u1=u;
7298  leftv u2=u1->next;
7299  leftv u3=u2->next;
7300  leftv u4=u3->next;
7301  if((u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD))
7302  {
7303    int save_d=Kstd1_deg;
7304    Kstd1_deg=(int)(long)u3->Data();
7305    kModW=(intvec *)u4->Data();
7306    BITSET save2;
7307    SI_SAVE_OPT2(save2);
7308    si_opt_2|=Sy_bit(V_DEG_STOP);
7309    u2->next=NULL;
7310    BOOLEAN r=jjCALL2ARG(res,u);
7311    kModW=NULL;
7312    Kstd1_deg=save_d;
7313    SI_RESTORE_OPT2(save2);
7314    u->next->next=u3;
7315    return r;
7316  }
7317  else
7318  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7319     (u4->Typ()==INT_CMD))
7320  {
7321    assumeStdFlag(u3);
7322    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7323    {
7324      WerrorS("2nd argument must be a diagonal matrix of units");
7325      return TRUE;
7326    }
7327    res->rtyp=IDEAL_CMD;
7328    res->data=(char*)redNF(
7329                           idCopy((ideal)u3->Data()),
7330                           idCopy((ideal)u1->Data()),
7331                           mp_Copy((matrix)u2->Data(), currRing),
7332                           (int)(long)u4->Data()
7333                          );
7334    return FALSE;
7335  }
7336  else
7337  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7338     (u4->Typ()==INT_CMD))
7339  {
7340    assumeStdFlag(u3);
7341    if(!pIsUnit((poly)u2->Data()))
7342    {
7343      WerrorS("2nd argument must be a unit");
7344      return TRUE;
7345    }
7346    res->rtyp=POLY_CMD;
7347    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7348                           pCopy((poly)u2->Data()),(int)(long)u4->Data());
7349    return FALSE;
7350  }
7351  else
7352  {
7353    Werror("%s(`poly`,`ideal`,`int`,`intvec`) expected",Tok2Cmdname(iiOp));
7354    return TRUE;
7355  }
7356}
7357static BOOLEAN jjREDUCE5(leftv res, leftv u)
7358{
7359  leftv u1=u;
7360  leftv u2=u1->next;
7361  leftv u3=u2->next;
7362  leftv u4=u3->next;
7363  leftv u5=u4->next;
7364  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7365     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7366  {
7367    assumeStdFlag(u3);
7368    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7369    {
7370      WerrorS("2nd argument must be a diagonal matrix of units");
7371      return TRUE;
7372    }
7373    res->rtyp=IDEAL_CMD;
7374    res->data=(char*)redNF(
7375                           idCopy((ideal)u3->Data()),
7376                           idCopy((ideal)u1->Data()),
7377                           mp_Copy((matrix)u2->Data(),currRing),
7378                           (int)(long)u4->Data(),
7379                           (intvec*)u5->Data()
7380                          );
7381    return FALSE;
7382  }
7383  else
7384  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7385     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7386  {
7387    assumeStdFlag(u3);
7388    if(!pIsUnit((poly)u2->Data()))
7389    {
7390      WerrorS("2nd argument must be a unit");
7391      return TRUE;
7392    }
7393    res->rtyp=POLY_CMD;
7394    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7395                           pCopy((poly)u2->Data()),
7396                           (int)(long)u4->Data(),(intvec*)u5->Data());
7397    return FALSE;
7398  }
7399  else
7400  {
7401    Werror("%s(`ideal`,`ideal`,`matrix`,`int`,`intvec`) exppected",
7402           Tok2Cmdname(iiOp));
7403    return TRUE;
7404  }
7405}
7406static BOOLEAN jjRESERVED0(leftv, leftv)
7407{
7408  int i=1;
7409  int nCount = (sArithBase.nCmdUsed-1)/3;
7410  if((3*nCount)<sArithBase.nCmdUsed) nCount++;
7411  //Print("CMDS: %d/%d\n", sArithBase.nCmdUsed,
7412  //      sArithBase.nCmdAllocated);
7413  for(i=0; i<nCount; i++)
7414  {
7415    Print("%-20s",sArithBase.sCmds[i+1].name);
7416    if(i+1+nCount<sArithBase.nCmdUsed)
7417      Print("%-20s",sArithBase.sCmds[i+1+nCount].name);
7418    if(i+1+2*nCount<sArithBase.nCmdUsed)
7419      Print("%-20s",sArithBase.sCmds[i+1+2*nCount].name);
7420    //if ((i%3)==1) PrintLn();
7421    PrintLn();
7422  }
7423  PrintLn();
7424  printBlackboxTypes();
7425  return FALSE;
7426}
7427static BOOLEAN jjSTRING_PL(leftv res, leftv v)
7428{
7429  if (v == NULL)
7430  {
7431    res->data = omStrDup("");
7432    return FALSE;
7433  }
7434  int n = v->listLength();
7435  if (n == 1)
7436  {
7437    res->data = v->String();
7438    return FALSE;
7439  }
7440
7441  char** slist = (char**) omAlloc(n*sizeof(char*));
7442  int i, j;
7443
7444  for (i=0, j=0; i<n; i++, v = v ->next)
7445  {
7446    slist[i] = v->String();
7447    assume(slist[i] != NULL);
7448    j+=strlen(slist[i]);
7449  }
7450  char* s = (char*) omAlloc((j+1)*sizeof(char));
7451  *s='\0';
7452  for (i=0;i<n;i++)
7453  {
7454    strcat(s, slist[i]);
7455    omFree(slist[i]);
7456  }
7457  omFreeSize(slist, n*sizeof(char*));
7458  res->data = s;
7459  return FALSE;
7460}
7461static BOOLEAN jjTEST(leftv, leftv v)
7462{
7463  do
7464  {
7465    if (v->Typ()!=INT_CMD)
7466      return TRUE;
7467    test_cmd((int)(long)v->Data());
7468    v=v->next;
7469  }
7470  while (v!=NULL);
7471  return FALSE;
7472}
7473
7474#if defined(__alpha) && !defined(linux)
7475extern "C"
7476{
7477  void usleep(unsigned long usec);
7478};
7479#endif
7480static BOOLEAN jjFactModD_M(leftv res, leftv v)
7481{
7482  /* compute two factors of h(x,y) modulo x^(d+1) in K[[x]][y],
7483     see a detailed documentation in /kernel/linearAlgebra.h
7484
7485     valid argument lists:
7486     - (poly h, int d),
7487     - (poly h, int d, poly f0, poly g0),       optional: factors of h(0,y),
7488     - (poly h, int d, int xIndex, int yIndex), optional: indices of vars x & y
7489                                                          in list of ring vars,
7490     - (poly h, int d, poly f0, poly g0, int xIndex, int yIndec),
7491                                                optional: all 4 optional args
7492     (The defaults are xIndex = 1, yIndex = 2, f0 and g0 polynomials as found
7493      by singclap_factorize and h(0, y)
7494      has exactly two distinct monic factors [possibly with exponent > 1].)
7495     result:
7496     - list with the two factors f and g such that
7497       h(x,y) = f(x,y)*g(x,y) mod x^(d+1)   */
7498
7499  poly h      = NULL;
7500  int  d      =    1;
7501  poly f0     = NULL;
7502  poly g0     = NULL;
7503  int  xIndex =    1;   /* default index if none provided */
7504  int  yIndex =    2;   /* default index if none provided */
7505
7506  leftv u = v; int factorsGiven = 0;
7507  if ((u == NULL) || (u->Typ() != POLY_CMD))
7508  {
7509    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7510    return TRUE;
7511  }
7512  else h = (poly)u->Data();
7513  u = u->next;
7514  if ((u == NULL) || (u->Typ() != INT_CMD))
7515  {
7516    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7517    return TRUE;
7518  }
7519  else d = (int)(long)u->Data();
7520  u = u->next;
7521  if ((u != NULL) && (u->Typ() == POLY_CMD))
7522  {
7523    if ((u->next == NULL) || (u->next->Typ() != POLY_CMD))
7524    {
7525      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7526      return TRUE;
7527    }
7528    else
7529    {
7530      f0 = (poly)u->Data();
7531      g0 = (poly)u->next->Data();
7532      factorsGiven = 1;
7533      u = u->next->next;
7534    }
7535  }
7536  if ((u != NULL) && (u->Typ() == INT_CMD))
7537  {
7538    if ((u->next == NULL) || (u->next->Typ() != INT_CMD))
7539    {
7540      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7541      return TRUE;
7542    }
7543    else
7544    {
7545      xIndex = (int)(long)u->Data();
7546      yIndex = (int)(long)u->next->Data();
7547      u = u->next->next;
7548    }
7549  }
7550  if (u != NULL)
7551  {
7552    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7553    return TRUE;
7554  }
7555
7556  /* checks for provided arguments */
7557  if (pIsConstant(h) || (factorsGiven && (pIsConstant(f0) || pIsConstant(g0))))
7558  {
7559    WerrorS("expected non-constant polynomial argument(s)");
7560    return TRUE;
7561  }
7562  int n = rVar(currRing);
7563  if ((xIndex < 1) || (n < xIndex))
7564  {
7565    Werror("index for variable x (%d) out of range [1..%d]", xIndex, n);
7566    return TRUE;
7567  }
7568  if ((yIndex < 1) || (n < yIndex))
7569  {
7570    Werror("index for variable y (%d) out of range [1..%d]", yIndex, n);
7571    return TRUE;
7572  }
7573  if (xIndex == yIndex)
7574  {
7575    WerrorS("expected distinct indices for variables x and y");
7576    return TRUE;
7577  }
7578
7579  /* computation of f0 and g0 if missing */
7580  if (factorsGiven == 0)
7581  {
7582    poly h0 = pSubst(pCopy(h), xIndex, NULL);
7583    intvec* v = NULL;
7584    ideal i = singclap_factorize(h0, &v, 0,currRing);
7585
7586    ivTest(v);
7587
7588    if (i == NULL) return TRUE;
7589
7590    idTest(i);
7591
7592    if ((v->rows() != 3) || ((*v)[0] =! 1) || (!nIsOne(pGetCoeff(i->m[0]))))
7593    {
7594      WerrorS("expected h(0,y) to have exactly two distinct monic factors");
7595      return TRUE;
7596    }
7597    f0 = pPower(pCopy(i->m[1]), (*v)[1]);
7598    g0 = pPower(pCopy(i->m[2]), (*v)[2]);
7599    idDelete(&i);
7600  }
7601
7602  poly f; poly g;
7603  henselFactors(xIndex, yIndex, h, f0, g0, d, f, g);
7604  lists L = (lists)omAllocBin(slists_bin);
7605  L->Init(2);
7606  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
7607  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
7608  res->rtyp = LIST_CMD;
7609  res->data = (char*)L;
7610  return FALSE;
7611}
7612static BOOLEAN jjSTATUS_M(leftv res, leftv v)
7613{
7614  if ((v->Typ() != LINK_CMD) ||
7615      (v->next->Typ() != STRING_CMD) ||
7616      (v->next->next->Typ() != STRING_CMD) ||
7617      (v->next->next->next->Typ() != INT_CMD))
7618    return TRUE;
7619  jjSTATUS3(res, v, v->next, v->next->next);
7620#if defined(HAVE_USLEEP)
7621  if (((long) res->data) == 0L)
7622  {
7623    int i_s = (int)(long) v->next->next->next->Data();
7624    if (i_s > 0)
7625    {
7626      usleep((int)(long) v->next->next->next->Data());
7627      jjSTATUS3(res, v, v->next, v->next->next);
7628    }
7629  }
7630#elif defined(HAVE_SLEEP)
7631  if (((int) res->data) == 0)
7632  {
7633    int i_s = (int) v->next->next->next->Data();
7634    if (i_s > 0)
7635    {
7636      si_sleep((is - 1)/1000000 + 1);
7637      jjSTATUS3(res, v, v->next, v->next->next);
7638    }
7639  }
7640#endif
7641  return FALSE;
7642}
7643static BOOLEAN jjSUBST_M(leftv res, leftv u)
7644{
7645  leftv v = u->next; // number of args > 0
7646  if (v==NULL) return TRUE;
7647  leftv w = v->next;
7648  if (w==NULL) return TRUE;
7649  leftv rest = w->next;;
7650
7651  u->next = NULL;
7652  v->next = NULL;
7653  w->next = NULL;
7654  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
7655  if ((rest!=NULL) && (!b))
7656  {
7657    sleftv tmp_res;
7658    leftv tmp_next=res->next;
7659    res->next=rest;
7660    memset(&tmp_res,0,sizeof(tmp_res));
7661    b = iiExprArithM(&tmp_res,res,iiOp);
7662    memcpy(res,&tmp_res,sizeof(tmp_res));
7663    res->next=tmp_next;
7664  }
7665  u->next = v;
7666  v->next = w;
7667  // rest was w->next, but is already cleaned
7668  return b;
7669}
7670static BOOLEAN jjQRDS(leftv res, leftv INPUT)
7671{
7672  if ((INPUT->Typ() != MATRIX_CMD) ||
7673      (INPUT->next->Typ() != NUMBER_CMD) ||
7674      (INPUT->next->next->Typ() != NUMBER_CMD) ||
7675      (INPUT->next->next->next->Typ() != NUMBER_CMD))
7676  {
7677    WerrorS("expected (matrix, number, number, number) as arguments");
7678    return TRUE;
7679  }
7680  leftv u = INPUT; leftv v = u->next; leftv w = v->next; leftv x = w->next;
7681  res->data = (char *)qrDoubleShift((matrix)(u->Data()),
7682                                    (number)(v->Data()),
7683                                    (number)(w->Data()),
7684                                    (number)(x->Data()));
7685  return FALSE;
7686}
7687static BOOLEAN jjSTD_HILB_WP(leftv res, leftv INPUT)
7688{ ideal result;
7689  leftv u = INPUT;    /* an ideal, weighted homogeneous and standard */
7690  leftv v = u->next;  /* one additional polynomial or ideal */
7691  leftv h = v->next;  /* Hilbert vector */
7692  leftv w = h->next;  /* weight vector */
7693  assumeStdFlag(u);
7694  ideal i1=(ideal)(u->Data());
7695  ideal i0;
7696  if (((u->Typ()!=IDEAL_CMD)&&(u->Typ()!=MODUL_CMD))
7697  || (h->Typ()!=INTVEC_CMD)
7698  || (w->Typ()!=INTVEC_CMD))
7699  {
7700    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7701    return TRUE;
7702  }
7703  intvec *vw=(intvec *)w->Data(); // weights of vars
7704  /* merging std_hilb_w and std_1 */
7705  if (vw->length()!=currRing->N)
7706  {
7707    Werror("%d weights for %d variables",vw->length(),currRing->N);
7708    return TRUE;
7709  }
7710  int r=v->Typ();
7711  BOOLEAN cleanup_i0=FALSE;
7712  if ((r==POLY_CMD) ||(r==VECTOR_CMD))
7713  {
7714    i0=idInit(1,i1->rank);
7715    i0->m[0]=(poly)v->Data();
7716    cleanup_i0=TRUE;
7717  }
7718  else if (r==IDEAL_CMD)/* IDEAL */
7719  {
7720    i0=(ideal)v->Data();
7721  }
7722  else
7723  {
7724    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7725    return TRUE;
7726  }
7727  int ii0=idElem(i0);
7728  i1 = idSimpleAdd(i1,i0);
7729  if (cleanup_i0)
7730  {
7731    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
7732    idDelete(&i0);
7733  }
7734  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
7735  tHomog hom=testHomog;
7736  /* u_id from jjSTD_W is now i1 as in jjSTD_1 */
7737  if (ww!=NULL)
7738  {
7739    if (!idTestHomModule(i1,currQuotient,ww))
7740    {
7741      WarnS("wrong weights");
7742      ww=NULL;
7743    }
7744    else
7745    {
7746      ww=ivCopy(ww);
7747      hom=isHomog;
7748    }
7749  }
7750  BITSET save1;
7751  SI_SAVE_OPT1(save1);
7752  si_opt_1|=Sy_bit(OPT_SB_1);
7753  result=kStd(i1,
7754              currQuotient,
7755              hom,
7756              &ww,                  // module weights
7757              (intvec *)h->Data(),  // hilbert series
7758              0,                    // syzComp, whatever it is...
7759              IDELEMS(i1)-ii0,      // new ideal
7760              vw);                  // weights of vars
7761  SI_RESTORE_OPT1(save1);
7762  idDelete(&i1);
7763  idSkipZeroes(result);
7764  res->data = (char *)result;
7765  if (!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
7766  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
7767  return FALSE;
7768}
7769
7770
7771static Subexpr jjMakeSub(leftv e)
7772{
7773  assume( e->Typ()==INT_CMD );
7774  Subexpr r=(Subexpr)omAlloc0Bin(sSubexpr_bin);
7775  r->start =(int)(long)e->Data();
7776  return r;
7777}
7778#define D(A)    (A)
7779#define NULL_VAL NULL
7780#define IPARITH
7781#include "table.h"
7782
7783#include "iparith.inc"
7784
7785/*=================== operations with 2 args. ============================*/
7786/* must be ordered: first operations for chars (infix ops),
7787 * then alphabetically */
7788
7789BOOLEAN iiExprArith2(leftv res, leftv a, int op, leftv b, BOOLEAN proccall)
7790{
7791  memset(res,0,sizeof(sleftv));
7792  BOOLEAN call_failed=FALSE;
7793
7794  if (!errorreported)
7795  {
7796#ifdef SIQ
7797    if (siq>0)
7798    {
7799      //Print("siq:%d\n",siq);
7800      command d=(command)omAlloc0Bin(sip_command_bin);
7801      memcpy(&d->arg1,a,sizeof(sleftv));
7802      //a->Init();
7803      memcpy(&d->arg2,b,sizeof(sleftv));
7804      //b->Init();
7805      d->argc=2;
7806      d->op=op;
7807      res->data=(char *)d;
7808      res->rtyp=COMMAND;
7809      return FALSE;
7810    }
7811#endif
7812    int at=a->Typ();
7813    int bt=b->Typ();
7814    if (at>MAX_TOK)
7815    {
7816      blackbox *bb=getBlackboxStuff(at);
7817      if (bb!=NULL) return bb->blackbox_Op2(op,res,a,b);
7818      else          return TRUE;
7819    }
7820    else if ((bt>MAX_TOK)&&(op!='('))
7821    {
7822      blackbox *bb=getBlackboxStuff(bt);
7823      if (bb!=NULL) return bb->blackbox_Op2(op,res,a,b);
7824      else          return TRUE;
7825    }
7826    int i=iiTabIndex(dArithTab2,JJTAB2LEN,op);
7827    int index=i;
7828
7829    iiOp=op;
7830    while (dArith2[i].cmd==op)
7831    {
7832      if ((at==dArith2[i].arg1)
7833      && (bt==dArith2[i].arg2))
7834      {
7835        res->rtyp=dArith2[i].res;
7836        if (currRing!=NULL)
7837        {
7838          if (check_valid(dArith2[i].valid_for,op)) break;
7839        }
7840        if (traceit&TRACE_CALL)
7841          Print("call %s(%s,%s)\n",iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt));
7842        if ((call_failed=dArith2[i].p(res,a,b)))
7843        {
7844          break;// leave loop, goto error handling
7845        }
7846        a->CleanUp();
7847        b->CleanUp();
7848        //Print("op: %d,result typ:%d\n",op,res->rtyp);
7849        return FALSE;
7850      }
7851      i++;
7852    }
7853    // implicite type conversion ----------------------------------------------
7854    if (dArith2[i].cmd!=op)
7855    {
7856      int ai,bi;
7857      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7858      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
7859      BOOLEAN failed=FALSE;
7860      i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7861      //Print("op: %c, type: %s %s\n",op,Tok2Cmdname(at),Tok2Cmdname(bt));
7862      while (dArith2[i].cmd==op)
7863      {
7864        //Print("test %s %s\n",Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
7865        if ((ai=iiTestConvert(at,dArith2[i].arg1))!=0)
7866        {
7867          if ((bi=iiTestConvert(bt,dArith2[i].arg2))!=0)
7868          {
7869            res->rtyp=dArith2[i].res;
7870            if (currRing!=NULL)
7871            {
7872              if (check_valid(dArith2[i].valid_for,op)) break;
7873            }
7874            if (traceit&TRACE_CALL)
7875              Print("call %s(%s,%s)\n",iiTwoOps(op),
7876              Tok2Cmdname(an->rtyp),Tok2Cmdname(bn->rtyp));
7877            failed= ((iiConvert(at,dArith2[i].arg1,ai,a,an))
7878            || (iiConvert(bt,dArith2[i].arg2,bi,b,bn))
7879            || (call_failed=dArith2[i].p(res,an,bn)));
7880            // everything done, clean up temp. variables
7881            if (failed)
7882            {
7883              // leave loop, goto error handling
7884              break;
7885            }
7886            else
7887            {
7888              // everything ok, clean up and return
7889              an->CleanUp();
7890              bn->CleanUp();
7891              omFreeBin((ADDRESS)an, sleftv_bin);
7892              omFreeBin((ADDRESS)bn, sleftv_bin);
7893              a->CleanUp();
7894              b->CleanUp();
7895              return FALSE;
7896            }
7897          }
7898        }
7899        i++;
7900      }
7901      an->CleanUp();
7902      bn->CleanUp();
7903      omFreeBin((ADDRESS)an, sleftv_bin);
7904      omFreeBin((ADDRESS)bn, sleftv_bin);
7905    }
7906    // error handling ---------------------------------------------------
7907    const char *s=NULL;
7908    if (!errorreported)
7909    {
7910      if ((at==0) && (a->Fullname()!=sNoName))
7911      {
7912        s=a->Fullname();
7913      }
7914      else if ((bt==0) && (b->Fullname()!=sNoName))
7915      {
7916        s=b->Fullname();
7917      }
7918      if (s!=NULL)
7919        Werror("`%s` is not defined",s);
7920      else
7921      {
7922        i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7923        s = iiTwoOps(op);
7924        if (proccall)
7925        {
7926          Werror("%s(`%s`,`%s`) failed"
7927                ,s,Tok2Cmdname(at),Tok2Cmdname(bt));
7928        }
7929        else
7930        {
7931          Werror("`%s` %s `%s` failed"
7932                ,Tok2Cmdname(at),s,Tok2Cmdname(bt));
7933        }
7934        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
7935        {
7936          while (dArith2[i].cmd==op)
7937          {
7938            if(((at==dArith2[i].arg1)||(bt==dArith2[i].arg2))
7939            && (dArith2[i].res!=0)
7940            && (dArith2[i].p!=jjWRONG2))
7941            {
7942              if (proccall)
7943                Werror("expected %s(`%s`,`%s`)"
7944                  ,s,Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
7945              else
7946                Werror("expected `%s` %s `%s`"
7947                  ,Tok2Cmdname(dArith2[i].arg1),s,Tok2Cmdname(dArith2[i].arg2));
7948            }
7949            i++;
7950          }
7951        }
7952      }
7953    }
7954    res->rtyp = UNKNOWN;
7955  }
7956  a->CleanUp();
7957  b->CleanUp();
7958  return TRUE;
7959}
7960
7961/*==================== operations with 1 arg. ===============================*/
7962/* must be ordered: first operations for chars (infix ops),
7963 * then alphabetically */
7964
7965BOOLEAN iiExprArith1(leftv res, leftv a, int op)
7966{
7967  memset(res,0,sizeof(sleftv));
7968  BOOLEAN call_failed=FALSE;
7969
7970  if (!errorreported)
7971  {
7972#ifdef SIQ
7973    if (siq>0)
7974    {
7975      //Print("siq:%d\n",siq);
7976      command d=(command)omAlloc0Bin(sip_command_bin);
7977      memcpy(&d->arg1,a,sizeof(sleftv));
7978      //a->Init();
7979      d->op=op;
7980      d->argc=1;
7981      res->data=(char *)d;
7982      res->rtyp=COMMAND;
7983      return FALSE;
7984    }
7985#endif
7986    int at=a->Typ();
7987    if (at>MAX_TOK)
7988    {
7989      blackbox *bb=getBlackboxStuff(at);
7990      if (bb!=NULL) return bb->blackbox_Op1(op,res,a);
7991      else          return TRUE;
7992    }
7993
7994    BOOLEAN failed=FALSE;
7995    iiOp=op;
7996    int i=iiTabIndex(dArithTab1,JJTAB1LEN,op);
7997    int ti = i;
7998    while (dArith1[i].cmd==op)
7999    {
8000      if (at==dArith1[i].arg)
8001      {
8002        int r=res->rtyp=dArith1[i].res;
8003        if (currRing!=NULL)
8004        {
8005          if (check_valid(dArith1[i].valid_for,op)) break;
8006        }
8007        if (traceit&TRACE_CALL)
8008          Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
8009        if (r<0)
8010        {
8011          res->rtyp=-r;
8012          #ifdef PROC_BUG
8013          dArith1[i].p(res,a);
8014          #else
8015          res->data=(char *)((Proc1)dArith1[i].p)((char *)a->Data());
8016          #endif
8017        }
8018        else if ((call_failed=dArith1[i].p(res,a)))
8019        {
8020          break;// leave loop, goto error handling
8021        }
8022        if (a->Next()!=NULL)
8023        {
8024          res->next=(leftv)omAllocBin(sleftv_bin);
8025          failed=iiExprArith1(res->next,a->next,op);
8026        }
8027        a->CleanUp();
8028        return failed;
8029      }
8030      i++;
8031    }
8032    // implicite type conversion --------------------------------------------
8033    if (dArith1[i].cmd!=op)
8034    {
8035      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8036      i=ti;
8037      //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
8038      while (dArith1[i].cmd==op)
8039      {
8040        int ai;
8041        //Print("test %s\n",Tok2Cmdname(dArith1[i].arg));
8042        if ((ai=iiTestConvert(at,dArith1[i].arg))!=0)
8043        {
8044          int r=res->rtyp=dArith1[i].res;
8045          if (currRing!=NULL)
8046          {
8047            if (check_valid(dArith1[i].valid_for,op)) break;
8048          }
8049          if (r<0)
8050          {
8051            res->rtyp=-r;
8052            failed= iiConvert(at,dArith1[i].arg,ai,a,an);
8053            if (!failed)
8054            {
8055              #ifdef PROC_BUG
8056              dArith1[i].p(res,a);
8057              #else
8058              res->data=(char *)((Proc1)dArith1[i].p)((char *)an->Data());
8059              #endif
8060            }
8061          }
8062          else
8063          {
8064            failed= ((iiConvert(at,dArith1[i].arg,ai,a,an))
8065            || (call_failed=dArith1[i].p(res,an)));
8066          }
8067          // everything done, clean up temp. variables
8068          if (failed)
8069          {
8070            // leave loop, goto error handling
8071            break;
8072          }
8073          else
8074          {
8075            if (traceit&TRACE_CALL)
8076              Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(an->rtyp));
8077            if (an->Next() != NULL)
8078            {
8079              res->next = (leftv)omAllocBin(sleftv_bin);
8080              failed=iiExprArith1(res->next,an->next,op);
8081            }
8082            // everything ok, clean up and return
8083            an->CleanUp();
8084            omFreeBin((ADDRESS)an, sleftv_bin);
8085            a->CleanUp();
8086            return failed;
8087          }
8088        }
8089        i++;
8090      }
8091      an->CleanUp();
8092      omFreeBin((ADDRESS)an, sleftv_bin);
8093    }
8094    // error handling
8095    if (!errorreported)
8096    {
8097      if ((at==0) && (a->Fullname()!=sNoName))
8098      {
8099        Werror("`%s` is not defined",a->Fullname());
8100      }
8101      else
8102      {
8103        i=ti;
8104        const char *s = iiTwoOps(op);
8105        Werror("%s(`%s`) failed"
8106                ,s,Tok2Cmdname(at));
8107        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8108        {
8109          while (dArith1[i].cmd==op)
8110          {
8111            if ((dArith1[i].res!=0)
8112            && (dArith1[i].p!=jjWRONG))
8113              Werror("expected %s(`%s`)"
8114                ,s,Tok2Cmdname(dArith1[i].arg));
8115            i++;
8116          }
8117        }
8118      }
8119    }
8120    res->rtyp = UNKNOWN;
8121  }
8122  a->CleanUp();
8123  return TRUE;
8124}
8125
8126/*=================== operations with 3 args. ============================*/
8127/* must be ordered: first operations for chars (infix ops),
8128 * then alphabetically */
8129
8130BOOLEAN iiExprArith3(leftv res, int op, leftv a, leftv b, leftv c)
8131{
8132  memset(res,0,sizeof(sleftv));
8133  BOOLEAN call_failed=FALSE;
8134
8135  if (!errorreported)
8136  {
8137#ifdef SIQ
8138    if (siq>0)
8139    {
8140      //Print("siq:%d\n",siq);
8141      command d=(command)omAlloc0Bin(sip_command_bin);
8142      memcpy(&d->arg1,a,sizeof(sleftv));
8143      //a->Init();
8144      memcpy(&d->arg2,b,sizeof(sleftv));
8145      //b->Init();
8146      memcpy(&d->arg3,c,sizeof(sleftv));
8147      //c->Init();
8148      d->op=op;
8149      d->argc=3;
8150      res->data=(char *)d;
8151      res->rtyp=COMMAND;
8152      return FALSE;
8153    }
8154#endif
8155    int at=a->Typ();
8156    if (at>MAX_TOK)
8157    {
8158      blackbox *bb=getBlackboxStuff(at);
8159      if (bb!=NULL) return bb->blackbox_Op3(op,res,a,b,c);
8160      else          return TRUE;
8161    }
8162    int bt=b->Typ();
8163    int ct=c->Typ();
8164
8165    iiOp=op;
8166    int i=0;
8167    while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8168    while (dArith3[i].cmd==op)
8169    {
8170      if ((at==dArith3[i].arg1)
8171      && (bt==dArith3[i].arg2)
8172      && (ct==dArith3[i].arg3))
8173      {
8174        res->rtyp=dArith3[i].res;
8175        if (currRing!=NULL)
8176        {
8177          if (check_valid(dArith3[i].valid_for,op)) break;
8178        }
8179        if (traceit&TRACE_CALL)
8180          Print("call %s(%s,%s,%s)\n",
8181            iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8182        if ((call_failed=dArith3[i].p(res,a,b,c)))
8183        {
8184          break;// leave loop, goto error handling
8185        }
8186        a->CleanUp();
8187        b->CleanUp();
8188        c->CleanUp();
8189        return FALSE;
8190      }
8191      i++;
8192    }
8193    // implicite type conversion ----------------------------------------------
8194    if (dArith3[i].cmd!=op)
8195    {
8196      int ai,bi,ci;
8197      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8198      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
8199      leftv cn = (leftv)omAlloc0Bin(sleftv_bin);
8200      BOOLEAN failed=FALSE;
8201      i=0;
8202      while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8203      while (dArith3[i].cmd==op)
8204      {
8205        if ((ai=iiTestConvert(at,dArith3[i].arg1))!=0)
8206        {
8207          if ((bi=iiTestConvert(bt,dArith3[i].arg2))!=0)
8208          {
8209            if ((ci=iiTestConvert(ct,dArith3[i].arg3))!=0)
8210            {
8211              res->rtyp=dArith3[i].res;
8212              if (currRing!=NULL)
8213              {
8214                if (check_valid(dArith3[i].valid_for,op)) break;
8215              }
8216              if (traceit&TRACE_CALL)
8217                Print("call %s(%s,%s,%s)\n",
8218                  iiTwoOps(op),Tok2Cmdname(an->rtyp),
8219                  Tok2Cmdname(bn->rtyp),Tok2Cmdname(cn->rtyp));
8220              failed= ((iiConvert(at,dArith3[i].arg1,ai,a,an))
8221                || (iiConvert(bt,dArith3[i].arg2,bi,b,bn))
8222                || (iiConvert(ct,dArith3[i].arg3,ci,c,cn))
8223                || (call_failed=dArith3[i].p(res,an,bn,cn)));
8224              // everything done, clean up temp. variables
8225              if (failed)
8226              {
8227                // leave loop, goto error handling
8228                break;
8229              }
8230              else
8231              {
8232                // everything ok, clean up and return
8233                an->CleanUp();
8234                bn->CleanUp();
8235                cn->CleanUp();
8236                omFreeBin((ADDRESS)an, sleftv_bin);
8237                omFreeBin((ADDRESS)bn, sleftv_bin);
8238                omFreeBin((ADDRESS)cn, sleftv_bin);
8239                a->CleanUp();
8240                b->CleanUp();
8241                c->CleanUp();
8242        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8243                return FALSE;
8244              }
8245            }
8246          }
8247        }
8248        i++;
8249      }
8250      an->CleanUp();
8251      bn->CleanUp();
8252      cn->CleanUp();
8253      omFreeBin((ADDRESS)an, sleftv_bin);
8254      omFreeBin((ADDRESS)bn, sleftv_bin);
8255      omFreeBin((ADDRESS)cn, sleftv_bin);
8256    }
8257    // error handling ---------------------------------------------------
8258    if (!errorreported)
8259    {
8260      const char *s=NULL;
8261      if ((at==0) && (a->Fullname()!=sNoName))
8262      {
8263        s=a->Fullname();
8264      }
8265      else if ((bt==0) && (b->Fullname()!=sNoName))
8266      {
8267        s=b->Fullname();
8268      }
8269      else if ((ct==0) && (c->Fullname()!=sNoName))
8270      {
8271        s=c->Fullname();
8272      }
8273      if (s!=NULL)
8274        Werror("`%s` is not defined",s);
8275      else
8276      {
8277        i=0;
8278        while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8279        const char *s = iiTwoOps(op);
8280        Werror("%s(`%s`,`%s`,`%s`) failed"
8281                ,s,Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8282        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8283        {
8284          while (dArith3[i].cmd==op)
8285          {
8286            if(((at==dArith3[i].arg1)
8287            ||(bt==dArith3[i].arg2)
8288            ||(ct==dArith3[i].arg3))
8289            && (dArith3[i].res!=0))
8290            {
8291              Werror("expected %s(`%s`,`%s`,`%s`)"
8292                  ,s,Tok2Cmdname(dArith3[i].arg1)
8293                  ,Tok2Cmdname(dArith3[i].arg2)
8294                  ,Tok2Cmdname(dArith3[i].arg3));
8295            }
8296            i++;
8297          }
8298        }
8299      }
8300    }
8301    res->rtyp = UNKNOWN;
8302  }
8303  a->CleanUp();
8304  b->CleanUp();
8305  c->CleanUp();
8306        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8307  return TRUE;
8308}
8309/*==================== operations with many arg. ===============================*/
8310/* must be ordered: first operations for chars (infix ops),
8311 * then alphabetically */
8312
8313BOOLEAN jjANY2LIST(leftv res, leftv v, int cnt)
8314{
8315  // cnt = 0: all
8316  // cnt = 1: only first one
8317  leftv next;
8318  BOOLEAN failed = TRUE;
8319  if(v==NULL) return failed;
8320  res->rtyp = LIST_CMD;
8321  if(cnt) v->next = NULL;
8322  next = v->next;             // saving next-pointer
8323  failed = jjLIST_PL(res, v);
8324  v->next = next;             // writeback next-pointer
8325  return failed;
8326}
8327
8328BOOLEAN iiExprArithM(leftv res, leftv a, int op)
8329{
8330  memset(res,0,sizeof(sleftv));
8331
8332  if (!errorreported)
8333  {
8334#ifdef SIQ
8335    if (siq>0)
8336    {
8337      //Print("siq:%d\n",siq);
8338      command d=(command)omAlloc0Bin(sip_command_bin);
8339      d->op=op;
8340      res->data=(char *)d;
8341      if (a!=NULL)
8342      {
8343        d->argc=a->listLength();
8344        // else : d->argc=0;
8345        memcpy(&d->arg1,a,sizeof(sleftv));
8346        switch(d->argc)
8347        {
8348          case 3:
8349            memcpy(&d->arg3,a->next->next,sizeof(sleftv));
8350            a->next->next->Init();
8351            /* no break */
8352          case 2:
8353            memcpy(&d->arg2,a->next,sizeof(sleftv));
8354            a->next->Init();
8355            a->next->next=d->arg2.next;
8356            d->arg2.next=NULL;
8357            /* no break */
8358          case 1:
8359            a->Init();
8360            a->next=d->arg1.next;
8361            d->arg1.next=NULL;
8362        }
8363        if (d->argc>3) a->next=NULL;
8364        a->name=NULL;
8365        a->rtyp=0;
8366        a->data=NULL;
8367        a->e=NULL;
8368        a->attribute=NULL;
8369        a->CleanUp();
8370      }
8371      res->rtyp=COMMAND;
8372      return FALSE;
8373    }
8374#endif
8375    if ((a!=NULL) && (a->Typ()>MAX_TOK))
8376    {
8377      blackbox *bb=getBlackboxStuff(a->Typ());
8378      if (bb!=NULL) return bb->blackbox_OpM(op,res,a);
8379      else          return TRUE;
8380    }
8381    BOOLEAN failed=FALSE;
8382    int args=0;
8383    if (a!=NULL) args=a->listLength();
8384
8385    iiOp=op;
8386    int i=0;
8387    while ((dArithM[i].cmd!=op)&&(dArithM[i].cmd!=0)) i++;
8388    while (dArithM[i].cmd==op)
8389    {
8390      if ((args==dArithM[i].number_of_args)
8391      || (dArithM[i].number_of_args==-1)
8392      || ((dArithM[i].number_of_args==-2)&&(args>0)))
8393      {
8394        res->rtyp=dArithM[i].res;
8395        if (currRing!=NULL)
8396        {
8397          if (check_valid(dArithM[i].valid_for,op)) break;
8398        }
8399        if (traceit&TRACE_CALL)
8400          Print("call %s(... (%d args))\n", iiTwoOps(op),args);
8401        if (dArithM[i].p(res,a))
8402        {
8403          break;// leave loop, goto error handling
8404        }
8405        if (a!=NULL) a->CleanUp();
8406        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8407        return failed;
8408      }
8409      i++;
8410    }
8411    // error handling
8412    if (!errorreported)
8413    {
8414      if ((args>0) && (a->rtyp==0) && (a->Name()!=sNoName))
8415      {
8416        Werror("`%s` is not defined",a->Fullname());
8417      }
8418      else
8419      {
8420        const char *s = iiTwoOps(op);
8421        Werror("%s(...) failed",s);
8422      }
8423    }
8424    res->rtyp = UNKNOWN;
8425  }
8426  if (a!=NULL) a->CleanUp();
8427        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8428  return TRUE;
8429}
8430
8431/*=================== general utilities ============================*/
8432int IsCmd(const char *n, int & tok)
8433{
8434  int i;
8435  int an=1;
8436  int en=sArithBase.nLastIdentifier;
8437
8438  loop
8439  //for(an=0; an<sArithBase.nCmdUsed; )
8440  {
8441    if(an>=en-1)
8442    {
8443      if (strcmp(n, sArithBase.sCmds[an].name) == 0)
8444      {
8445        i=an;
8446        break;
8447      }
8448      else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
8449      {
8450        i=en;
8451        break;
8452      }
8453      else
8454      {
8455        // -- blackbox extensions:
8456        // return 0;
8457        return blackboxIsCmd(n,tok);
8458      }
8459    }
8460    i=(an+en)/2;
8461    if (*n < *(sArithBase.sCmds[i].name))
8462    {
8463      en=i-1;
8464    }
8465    else if (*n > *(sArithBase.sCmds[i].name))
8466    {
8467      an=i+1;
8468    }
8469    else
8470    {
8471      int v=strcmp(n,sArithBase.sCmds[i].name);
8472      if(v<0)
8473      {
8474        en=i-1;
8475      }
8476      else if(v>0)
8477      {
8478        an=i+1;
8479      }
8480      else /*v==0*/
8481      {
8482        break;
8483      }
8484    }
8485  }
8486  lastreserved=sArithBase.sCmds[i].name;
8487  tok=sArithBase.sCmds[i].tokval;
8488  if(sArithBase.sCmds[i].alias==2)
8489  {
8490    Warn("outdated identifier `%s` used - please change your code",
8491    sArithBase.sCmds[i].name);
8492    sArithBase.sCmds[i].alias=1;
8493  }
8494  if (currRingHdl==NULL)
8495  {
8496    #ifdef SIQ
8497    if (siq<=0)
8498    {
8499    #endif
8500      if ((tok>=BEGIN_RING) && (tok<=END_RING))
8501      {
8502        WerrorS("no ring active");
8503        return 0;
8504      }
8505    #ifdef SIQ
8506    }
8507    #endif
8508  }
8509  if (!expected_parms)
8510  {
8511    switch (tok)
8512    {
8513      case IDEAL_CMD:
8514      case INT_CMD:
8515      case INTVEC_CMD:
8516      case MAP_CMD:
8517      case MATRIX_CMD:
8518      case MODUL_CMD:
8519      case POLY_CMD:
8520      case PROC_CMD:
8521      case RING_CMD:
8522      case STRING_CMD:
8523        cmdtok = tok;
8524        break;
8525    }
8526  }
8527  return sArithBase.sCmds[i].toktype;
8528}
8529static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op)
8530{
8531  // user defined types are not in the pre-computed table:
8532  if (op>MAX_TOK) return 0;
8533
8534  int a=0;
8535  int e=len;
8536  int p=len/2;
8537  do
8538  {
8539     if (op==dArithTab[p].cmd) return dArithTab[p].start;
8540     if (op<dArithTab[p].cmd) e=p-1;
8541     else   a = p+1;
8542     p=a+(e-a)/2;
8543  }
8544  while ( a <= e);
8545
8546  // catch missing a cmd:
8547  assume(0);
8548  return 0;
8549}
8550
8551const char * Tok2Cmdname(int tok)
8552{
8553  int i = 0;
8554  if (tok <= 0)
8555  {
8556    return sArithBase.sCmds[0].name;
8557  }
8558  if (tok==ANY_TYPE) return "any_type";
8559  if (tok==COMMAND) return "command";
8560  if (tok==NONE) return "nothing";
8561  //if (tok==IFBREAK) return "if_break";
8562  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
8563  //if (tok==ORDER_VECTOR) return "ordering";
8564  //if (tok==REF_VAR) return "ref";
8565  //if (tok==OBJECT) return "object";
8566  //if (tok==PRINT_EXPR) return "print_expr";
8567  if (tok==IDHDL) return "identifier";
8568  if (tok>MAX_TOK) return getBlackboxName(tok);
8569  for(i=0; i<sArithBase.nCmdUsed; i++)
8570    //while (sArithBase.sCmds[i].tokval!=0)
8571  {
8572    if ((sArithBase.sCmds[i].tokval == tok)&&
8573        (sArithBase.sCmds[i].alias==0))
8574    {
8575      return sArithBase.sCmds[i].name;
8576    }
8577  }
8578  return sArithBase.sCmds[0].name;
8579}
8580
8581
8582/*---------------------------------------------------------------------*/
8583/**
8584 * @brief compares to entry of cmdsname-list
8585
8586 @param[in] a
8587 @param[in] b
8588
8589 @return <ReturnValue>
8590**/
8591/*---------------------------------------------------------------------*/
8592static int _gentable_sort_cmds( const void *a, const void *b )
8593{
8594  cmdnames *pCmdL = (cmdnames*)a;
8595  cmdnames *pCmdR = (cmdnames*)b;
8596
8597  if(a==NULL || b==NULL)             return 0;
8598
8599  /* empty entries goes to the end of the list for later reuse */
8600  if(pCmdL->name==NULL) return 1;
8601  if(pCmdR->name==NULL) return -1;
8602
8603  /* $INVALID$ must come first */
8604  if(strcmp(pCmdL->name, "$INVALID$")==0) return -1;
8605  if(strcmp(pCmdR->name, "$INVALID$")==0) return  1;
8606
8607  /* tokval=-1 are reserved names at the end */
8608  if (pCmdL->tokval==-1)
8609  {
8610    if (pCmdR->tokval==-1)
8611       return strcmp(pCmdL->name, pCmdR->name);
8612    /* pCmdL->tokval==-1, pCmdL goes at the end */
8613    return 1;
8614  }
8615  /* pCmdR->tokval==-1, pCmdR goes at the end */
8616  if(pCmdR->tokval==-1) return -1;
8617
8618  return strcmp(pCmdL->name, pCmdR->name);
8619}
8620
8621/*---------------------------------------------------------------------*/
8622/**
8623 * @brief initialisation of arithmetic structured data
8624
8625 @retval 0 on success
8626
8627**/
8628/*---------------------------------------------------------------------*/
8629int iiInitArithmetic()
8630{
8631  //printf("iiInitArithmetic()\n");
8632  memset(&sArithBase, 0, sizeof(sArithBase));
8633  iiInitCmdName();
8634  /* fix last-identifier */
8635#if 0
8636  /* we expect that gentable allready did every thing */
8637  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8638      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--) {
8639    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8640  }
8641#endif
8642  //Print("L=%d\n", sArithBase.nLastIdentifier);
8643
8644  //iiArithAddCmd(szName, nAlias, nTokval, nToktype);
8645  //iiArithAddCmd("mygcd", 1, GCD_CMD, CMD_2);
8646
8647  //iiArithAddCmd("Top", 0,-1,0);
8648
8649
8650  //for(i=0; i<sArithBase.nCmdUsed; i++) {
8651  //  printf("CMD[%03d] %s, %d, %d, %d\n", i,
8652  //         sArithBase.sCmds[i].name,
8653  //         sArithBase.sCmds[i].alias,
8654  //         sArithBase.sCmds[i].tokval,
8655  //         sArithBase.sCmds[i].toktype);
8656  //}
8657  //iiArithRemoveCmd("Top");
8658  //iiArithAddCmd("mygcd", 2, GCD_CMD, CMD_2);
8659  //iiArithRemoveCmd("mygcd");
8660  //iiArithAddCmd("kkk", 1, 1234, CMD_1);
8661  return 0;
8662}
8663
8664int iiArithFindCmd(const char *szName)
8665{
8666  int an=0;
8667  int i = 0,v = 0;
8668  int en=sArithBase.nLastIdentifier;
8669
8670  loop
8671  //for(an=0; an<sArithBase.nCmdUsed; )
8672  {
8673    if(an>=en-1)
8674    {
8675      if (strcmp(szName, sArithBase.sCmds[an].name) == 0)
8676      {
8677        //Print("RET-an=%d %s\n", an, sArithBase.sCmds[an].name);
8678        return an;
8679      }
8680      else if (strcmp(szName, sArithBase.sCmds[en].name) == 0)
8681      {
8682        //Print("RET-en=%d %s\n", en, sArithBase.sCmds[en].name);
8683        return en;
8684      }
8685      else
8686      {
8687        //Print("RET- 1\n");
8688        return -1;
8689      }
8690    }
8691    i=(an+en)/2;
8692    if (*szName < *(sArithBase.sCmds[i].name))
8693    {
8694      en=i-1;
8695    }
8696    else if (*szName > *(sArithBase.sCmds[i].name))
8697    {
8698      an=i+1;
8699    }
8700    else
8701    {
8702      v=strcmp(szName,sArithBase.sCmds[i].name);
8703      if(v<0)
8704      {
8705        en=i-1;
8706      }
8707      else if(v>0)
8708      {
8709        an=i+1;
8710      }
8711      else /*v==0*/
8712      {
8713        //Print("RET-i=%d %s\n", i, sArithBase.sCmds[i].name);
8714        return i;
8715      }
8716    }
8717  }
8718  //if(i>=0 && i<sArithBase.nCmdUsed)
8719  //  return i;
8720  //Print("RET-2\n");
8721  return -2;
8722}
8723
8724char *iiArithGetCmd( int nPos )
8725{
8726  if(nPos<0) return NULL;
8727  if(nPos<sArithBase.nCmdUsed)
8728    return sArithBase.sCmds[nPos].name;
8729  return NULL;
8730}
8731
8732int iiArithRemoveCmd(const char *szName)
8733{
8734  int nIndex;
8735  if(szName==NULL) return -1;
8736
8737  nIndex = iiArithFindCmd(szName);
8738  if(nIndex<0 || nIndex>=sArithBase.nCmdUsed)
8739  {
8740    Print("'%s' not found (%d)\n", szName, nIndex);
8741    return -1;
8742  }
8743  omFree(sArithBase.sCmds[nIndex].name);
8744  sArithBase.sCmds[nIndex].name=NULL;
8745  qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
8746        (&_gentable_sort_cmds));
8747  sArithBase.nCmdUsed--;
8748
8749  /* fix last-identifier */
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  return 0;
8757}
8758
8759int iiArithAddCmd(
8760  const char *szName,
8761  short nAlias,
8762  short nTokval,
8763  short nToktype,
8764  short nPos
8765  )
8766{
8767  //printf("AddCmd(%s, %d, %d, %d, %d)\n", szName, nAlias,
8768  //       nTokval, nToktype, nPos);
8769  if(nPos>=0)
8770  {
8771    // no checks: we rely on a correct generated code in iparith.inc
8772    assume(nPos < sArithBase.nCmdAllocated);
8773    assume(szName!=NULL);
8774    sArithBase.sCmds[nPos].name    = omStrDup(szName);
8775    sArithBase.sCmds[nPos].alias   = nAlias;
8776    sArithBase.sCmds[nPos].tokval  = nTokval;
8777    sArithBase.sCmds[nPos].toktype = nToktype;
8778    sArithBase.nCmdUsed++;
8779    //if(nTokval>0) sArithBase.nLastIdentifier++;
8780  }
8781  else
8782  {
8783    if(szName==NULL) return -1;
8784    int nIndex = iiArithFindCmd(szName);
8785    if(nIndex>=0)
8786    {
8787      Print("'%s' already exists at %d\n", szName, nIndex);
8788      return -1;
8789    }
8790
8791    if(sArithBase.nCmdUsed>=sArithBase.nCmdAllocated)
8792    {
8793      /* needs to create new slots */
8794      unsigned long nSize = (sArithBase.nCmdAllocated+1)*sizeof(cmdnames);
8795      sArithBase.sCmds = (cmdnames *)omRealloc(sArithBase.sCmds, nSize);
8796      if(sArithBase.sCmds==NULL) return -1;
8797      sArithBase.nCmdAllocated++;
8798    }
8799    /* still free slots available */
8800    sArithBase.sCmds[sArithBase.nCmdUsed].name    = omStrDup(szName);
8801    sArithBase.sCmds[sArithBase.nCmdUsed].alias   = nAlias;
8802    sArithBase.sCmds[sArithBase.nCmdUsed].tokval  = nTokval;
8803    sArithBase.sCmds[sArithBase.nCmdUsed].toktype = nToktype;
8804    sArithBase.nCmdUsed++;
8805
8806    qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
8807          (&_gentable_sort_cmds));
8808    for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8809        sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
8810    {
8811      if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8812    }
8813    //Print("L=%d\n", sArithBase.nLastIdentifier);
8814  }
8815  return 0;
8816}
8817
8818static BOOLEAN check_valid(const int p, const int op)
8819{
8820  #ifdef HAVE_PLURAL
8821  if (rIsPluralRing(currRing))
8822  {
8823    if ((p & PLURAL_MASK)==0 /*NO_PLURAL*/)
8824    {
8825      WerrorS("not implemented for non-commutative rings");
8826      return TRUE;
8827    }
8828    else if ((p & PLURAL_MASK)==2 /*, COMM_PLURAL */)
8829    {
8830      Warn("assume commutative subalgebra for cmd `%s`",Tok2Cmdname(op));
8831      return FALSE;
8832    }
8833    /* else, ALLOW_PLURAL */
8834  }
8835  #endif
8836  #ifdef HAVE_RINGS
8837  if (rField_is_Ring(currRing))
8838  {
8839    if ((p & RING_MASK)==0 /*NO_RING*/)
8840    {
8841      WerrorS("not implemented for rings with rings as coeffients");
8842      return TRUE;
8843    }
8844    /* else ALLOW_RING */
8845    else if (((p & ZERODIVISOR_MASK)==NO_ZERODIVISOR)
8846    &&(!rField_is_Domain(currRing)))
8847    {
8848      WerrorS("domain required as coeffients");
8849      return TRUE;
8850    }
8851    /* else ALLOW_ZERODIVISOR */
8852    else if(((p & WARN_RING)==WARN_RING)&&(myynest==0))
8853    {
8854      WarnS("considering the image in Q[...]");
8855    }
8856  }
8857  #endif
8858  return FALSE;
8859}
Note: See TracBrowser for help on using the repository browser.