source: git/Singular/iparith.cc @ b38bc9

spielwiese
Last change on this file since b38bc9 was 98e5882, checked in by Hans Schoenemann <hannes@…>, 10 years ago
fix: gcc optimizer bug: need local number variable
  • Property mode set to 100644
File size: 218.2 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 jjNVARS(leftv res, leftv v)
4607{
4608  res->data = (char *)(long)(((ring)(v->Data()))->N);
4609  return FALSE;
4610}
4611static BOOLEAN jjOpenClose(leftv, leftv v)
4612{
4613  si_link l=(si_link)v->Data();
4614  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4615  else                return slClose(l);
4616}
4617static BOOLEAN jjORD(leftv res, leftv v)
4618{
4619  poly p=(poly)v->Data();
4620  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4621  return FALSE;
4622}
4623static BOOLEAN jjPAR1(leftv res, leftv v)
4624{
4625  int i=(int)(long)v->Data();
4626  int p=0;
4627  p=rPar(currRing);
4628  if ((0<i) && (i<=p))
4629  {
4630    res->data=(char *)n_Param(i,currRing);
4631  }
4632  else
4633  {
4634    Werror("par number %d out of range 1..%d",i,p);
4635    return TRUE;
4636  }
4637  return FALSE;
4638}
4639static BOOLEAN jjPARDEG(leftv res, leftv v)
4640{
4641  number nn=(number)v->Data();
4642  res->data = (char *)(long)n_ParDeg(nn, currRing);
4643  return FALSE;
4644}
4645static BOOLEAN jjPARSTR1(leftv res, leftv v)
4646{
4647  if (currRing==NULL)
4648  {
4649    WerrorS("no ring active");
4650    return TRUE;
4651  }
4652  int i=(int)(long)v->Data();
4653  int p=0;
4654  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4655    res->data=omStrDup(rParameter(currRing)[i-1]);
4656  else
4657  {
4658    Werror("par number %d out of range 1..%d",i,p);
4659    return TRUE;
4660  }
4661  return FALSE;
4662}
4663static BOOLEAN jjP2BI(leftv res, leftv v)
4664{
4665  poly p=(poly)v->Data();
4666  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4667  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4668  {
4669    WerrorS("poly must be constant");
4670    return TRUE;
4671  }
4672  number i=pGetCoeff(p);
4673  number n;
4674  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4675  if (nMap!=NULL)
4676    n=nMap(i,currRing->cf,coeffs_BIGINT);
4677  else goto err;
4678  res->data=(void *)n;
4679  return FALSE;
4680err:
4681  WerrorS("cannot convert to bigint"); return TRUE;
4682}
4683static BOOLEAN jjP2I(leftv res, leftv v)
4684{
4685  poly p=(poly)v->Data();
4686  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4687  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4688  {
4689    WerrorS("poly must be constant");
4690    return TRUE;
4691  }
4692  res->data = (char *)(long)n_Int(pGetCoeff(p),currRing->cf);
4693  return FALSE;
4694}
4695static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4696{
4697  map mapping=(map)v->Data();
4698  syMake(res,omStrDup(mapping->preimage));
4699  return FALSE;
4700}
4701static BOOLEAN jjPRIME(leftv res, leftv v)
4702{
4703  int i = IsPrime((int)(long)(v->Data()));
4704  res->data = (char *)(long)(i > 1 ? i : 2);
4705  return FALSE;
4706}
4707static BOOLEAN jjPRUNE(leftv res, leftv v)
4708{
4709  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4710  ideal v_id=(ideal)v->Data();
4711  if (w!=NULL)
4712  {
4713    if (!idTestHomModule(v_id,currQuotient,w))
4714    {
4715      WarnS("wrong weights");
4716      w=NULL;
4717      // and continue at the non-homog case below
4718    }
4719    else
4720    {
4721      w=ivCopy(w);
4722      intvec **ww=&w;
4723      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4724      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4725      return FALSE;
4726    }
4727  }
4728  res->data = (char *)idMinEmbedding(v_id);
4729  return FALSE;
4730}
4731static BOOLEAN jjP2N(leftv res, leftv v)
4732{
4733  number n;
4734  poly p;
4735  if (((p=(poly)v->Data())!=NULL)
4736  && (pIsConstant(p)))
4737  {
4738    n=nCopy(pGetCoeff(p));
4739  }
4740  else
4741  {
4742    n=nInit(0);
4743  }
4744  res->data = (char *)n;
4745  return FALSE;
4746}
4747static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4748{
4749  char *s= (char *)v->Data();
4750  int i = 1;
4751  for(i=0; i<sArithBase.nCmdUsed; i++)
4752  {
4753    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4754    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4755    {
4756      res->data = (char *)1;
4757      return FALSE;
4758    }
4759  }
4760  //res->data = (char *)0;
4761  return FALSE;
4762}
4763static BOOLEAN jjRANK1(leftv res, leftv v)
4764{
4765  matrix m =(matrix)v->Data();
4766  int rank = luRank(m, 0);
4767  res->data =(char *)(long)rank;
4768  return FALSE;
4769}
4770static BOOLEAN jjREAD(leftv res, leftv v)
4771{
4772  return jjREAD2(res,v,NULL);
4773}
4774static BOOLEAN jjREGULARITY(leftv res, leftv v)
4775{
4776  res->data = (char *)(long)iiRegularity((lists)v->Data());
4777  return FALSE;
4778}
4779static BOOLEAN jjREPART(leftv res, leftv v)
4780{
4781  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4782  return FALSE;
4783}
4784static BOOLEAN jjRINGLIST(leftv res, leftv v)
4785{
4786  ring r=(ring)v->Data();
4787  if (r!=NULL)
4788    res->data = (char *)rDecompose((ring)v->Data());
4789  return (r==NULL)||(res->data==NULL);
4790}
4791static BOOLEAN jjROWS(leftv res, leftv v)
4792{
4793  ideal i = (ideal)v->Data();
4794  res->data = (char *)i->rank;
4795  return FALSE;
4796}
4797static BOOLEAN jjROWS_BIM(leftv res, leftv v)
4798{
4799  res->data = (char *)(long)((bigintmat*)(v->Data()))->rows();
4800  return FALSE;
4801}
4802static BOOLEAN jjROWS_IV(leftv res, leftv v)
4803{
4804  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4805  return FALSE;
4806}
4807static BOOLEAN jjRPAR(leftv res, leftv v)
4808{
4809  res->data = (char *)(long)rPar(((ring)v->Data()));
4810  return FALSE;
4811}
4812static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4813{
4814#ifdef HAVE_PLURAL
4815  const bool bIsSCA = rIsSCA(currRing);
4816#else
4817  const bool bIsSCA = false;
4818#endif
4819
4820  if ((currQuotient!=NULL) && !bIsSCA)
4821  {
4822    WerrorS("qring not supported by slimgb at the moment");
4823    return TRUE;
4824  }
4825  if (rHasLocalOrMixedOrdering_currRing())
4826  {
4827    WerrorS("ordering must be global for slimgb");
4828    return TRUE;
4829  }
4830  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4831  // tHomog hom=testHomog;
4832  ideal u_id=(ideal)u->Data();
4833  if (w!=NULL)
4834  {
4835    if (!idTestHomModule(u_id,currQuotient,w))
4836    {
4837      WarnS("wrong weights");
4838      w=NULL;
4839    }
4840    else
4841    {
4842      w=ivCopy(w);
4843      // hom=isHomog;
4844    }
4845  }
4846
4847  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
4848  res->data=(char *)t_rep_gb(currRing,
4849    u_id,u_id->rank);
4850  //res->data=(char *)t_rep_gb(currRing, u_id);
4851
4852  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4853  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4854  return FALSE;
4855}
4856static BOOLEAN jjSBA(leftv res, leftv v)
4857{
4858  ideal result;
4859  ideal v_id=(ideal)v->Data();
4860  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4861  tHomog hom=testHomog;
4862  if (w!=NULL)
4863  {
4864    if (!idTestHomModule(v_id,currQuotient,w))
4865    {
4866      WarnS("wrong weights");
4867      w=NULL;
4868    }
4869    else
4870    {
4871      hom=isHomog;
4872      w=ivCopy(w);
4873    }
4874  }
4875  result=kSba(v_id,currQuotient,hom,&w,1,0);
4876  idSkipZeroes(result);
4877  res->data = (char *)result;
4878  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4879  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4880  return FALSE;
4881}
4882static BOOLEAN jjSBA_1(leftv res, leftv v, leftv u)
4883{
4884  ideal result;
4885  ideal v_id=(ideal)v->Data();
4886  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4887  tHomog hom=testHomog;
4888  if (w!=NULL)
4889  {
4890    if (!idTestHomModule(v_id,currQuotient,w))
4891    {
4892      WarnS("wrong weights");
4893      w=NULL;
4894    }
4895    else
4896    {
4897      hom=isHomog;
4898      w=ivCopy(w);
4899    }
4900  }
4901  result=kSba(v_id,currQuotient,hom,&w,(int)(long)u->Data(),0);
4902  idSkipZeroes(result);
4903  res->data = (char *)result;
4904  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4905  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4906  return FALSE;
4907}
4908static BOOLEAN jjSBA_2(leftv res, leftv v, leftv u, leftv t)
4909{
4910  ideal result;
4911  ideal v_id=(ideal)v->Data();
4912  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4913  tHomog hom=testHomog;
4914  if (w!=NULL)
4915  {
4916    if (!idTestHomModule(v_id,currQuotient,w))
4917    {
4918      WarnS("wrong weights");
4919      w=NULL;
4920    }
4921    else
4922    {
4923      hom=isHomog;
4924      w=ivCopy(w);
4925    }
4926  }
4927  result=kSba(v_id,currQuotient,hom,&w,(int)(long)u->Data(),(int)(long)t->Data());
4928  idSkipZeroes(result);
4929  res->data = (char *)result;
4930  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4931  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4932  return FALSE;
4933}
4934static BOOLEAN jjSTD(leftv res, leftv v)
4935{
4936  ideal result;
4937  ideal v_id=(ideal)v->Data();
4938  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4939  tHomog hom=testHomog;
4940  if (w!=NULL)
4941  {
4942    if (!idTestHomModule(v_id,currQuotient,w))
4943    {
4944      WarnS("wrong weights");
4945      w=NULL;
4946    }
4947    else
4948    {
4949      hom=isHomog;
4950      w=ivCopy(w);
4951    }
4952  }
4953  result=kStd(v_id,currQuotient,hom,&w);
4954  idSkipZeroes(result);
4955  res->data = (char *)result;
4956  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4957  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4958  return FALSE;
4959}
4960static BOOLEAN jjSort_Id(leftv res, leftv v)
4961{
4962  res->data = (char *)idSort((ideal)v->Data());
4963  return FALSE;
4964}
4965static BOOLEAN jjSQR_FREE(leftv res, leftv u)
4966{
4967  singclap_factorize_retry=0;
4968  intvec *v=NULL;
4969  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
4970  if (f==NULL) return TRUE;
4971  ivTest(v);
4972  lists l=(lists)omAllocBin(slists_bin);
4973  l->Init(2);
4974  l->m[0].rtyp=IDEAL_CMD;
4975  l->m[0].data=(void *)f;
4976  l->m[1].rtyp=INTVEC_CMD;
4977  l->m[1].data=(void *)v;
4978  res->data=(void *)l;
4979  return FALSE;
4980}
4981#if 1
4982static BOOLEAN jjSYZYGY(leftv res, leftv v)
4983{
4984  intvec *w=NULL;
4985  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
4986  if (w!=NULL) delete w;
4987  return FALSE;
4988}
4989#else
4990// activate, if idSyz handle module weights correctly !
4991static BOOLEAN jjSYZYGY(leftv res, leftv v)
4992{
4993  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4994  ideal v_id=(ideal)v->Data();
4995  tHomog hom=testHomog;
4996  int add_row_shift=0;
4997  if (w!=NULL)
4998  {
4999    w=ivCopy(w);
5000    add_row_shift=w->min_in();
5001    (*w)-=add_row_shift;
5002    if (idTestHomModule(v_id,currQuotient,w))
5003      hom=isHomog;
5004    else
5005    {
5006      //WarnS("wrong weights");
5007      delete w; w=NULL;
5008      hom=testHomog;
5009    }
5010  }
5011  res->data = (char *)idSyzygies(v_id,hom,&w);
5012  if (w!=NULL)
5013  {
5014    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5015  }
5016  return FALSE;
5017}
5018#endif
5019static BOOLEAN jjTRACE_IV(leftv res, leftv v)
5020{
5021  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
5022  return FALSE;
5023}
5024static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
5025{
5026  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
5027  return FALSE;
5028}
5029static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
5030{
5031  res->data = (char *)ivTranp((intvec*)(v->Data()));
5032  return FALSE;
5033}
5034#ifdef HAVE_PLURAL
5035static BOOLEAN jjOPPOSITE(leftv res, leftv a)
5036{
5037  ring    r = (ring)a->Data();
5038  //if (rIsPluralRing(r))
5039  if (r->OrdSgn==1)
5040  {
5041    res->data = rOpposite(r);
5042  }
5043  else
5044  {
5045    WarnS("opposite only for global orderings");
5046    res->data = rCopy(r);
5047  }
5048  return FALSE;
5049}
5050static BOOLEAN jjENVELOPE(leftv res, leftv a)
5051{
5052  ring    r = (ring)a->Data();
5053  if (rIsPluralRing(r))
5054  {
5055    //    ideal   i;
5056//     if (a->rtyp == QRING_CMD)
5057//     {
5058//       i = r->qideal;
5059//       r->qideal = NULL;
5060//     }
5061    ring s = rEnvelope(r);
5062//     if (a->rtyp == QRING_CMD)
5063//     {
5064//       ideal is  = idOppose(r,i); /* twostd? */
5065//       is        = idAdd(is,i);
5066//       s->qideal = i;
5067//     }
5068    res->data = s;
5069  }
5070  else  res->data = rCopy(r);
5071  return FALSE;
5072}
5073static BOOLEAN jjTWOSTD(leftv res, leftv a)
5074{
5075  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
5076  else  res->data=(ideal)a->CopyD();
5077  setFlag(res,FLAG_STD);
5078  setFlag(res,FLAG_TWOSTD);
5079  return FALSE;
5080}
5081#endif
5082
5083static BOOLEAN jjTYPEOF(leftv res, leftv v)
5084{
5085  int t=(int)(long)v->data;
5086  switch (t)
5087  {
5088    case INT_CMD:        res->data=omStrDup("int"); break;
5089    case POLY_CMD:       res->data=omStrDup("poly"); break;
5090    case VECTOR_CMD:     res->data=omStrDup("vector"); break;
5091    case STRING_CMD:     res->data=omStrDup("string"); break;
5092    case INTVEC_CMD:     res->data=omStrDup("intvec"); break;
5093    case IDEAL_CMD:      res->data=omStrDup("ideal"); break;
5094    case MATRIX_CMD:     res->data=omStrDup("matrix"); break;
5095    case MODUL_CMD:      res->data=omStrDup("module"); break;
5096    case MAP_CMD:        res->data=omStrDup("map"); break;
5097    case PROC_CMD:       res->data=omStrDup("proc"); break;
5098    case RING_CMD:       res->data=omStrDup("ring"); break;
5099    case QRING_CMD:      res->data=omStrDup("qring"); break;
5100    case INTMAT_CMD:     res->data=omStrDup("intmat"); break;
5101    case BIGINTMAT_CMD:  res->data=omStrDup("bigintmat"); break;
5102    case NUMBER_CMD:     res->data=omStrDup("number"); break;
5103    case BIGINT_CMD:     res->data=omStrDup("bigint"); break;
5104    case LIST_CMD:       res->data=omStrDup("list"); break;
5105    case PACKAGE_CMD:    res->data=omStrDup("package"); break;
5106    case LINK_CMD:       res->data=omStrDup("link"); break;
5107    case RESOLUTION_CMD: res->data=omStrDup("resolution");break;
5108    case DEF_CMD:
5109    case NONE:           res->data=omStrDup("none"); break;
5110    default:
5111    {
5112      if (t>MAX_TOK)
5113        res->data=omStrDup(getBlackboxName(t));
5114      else
5115        res->data=omStrDup("?unknown type?");
5116      break;
5117    }
5118  }
5119  return FALSE;
5120}
5121static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5122{
5123  res->data=(char *)(long)pIsUnivariate((poly)v->Data());
5124  return FALSE;
5125}
5126static BOOLEAN jjVAR1(leftv res, leftv v)
5127{
5128  int i=(int)(long)v->Data();
5129  if ((0<i) && (i<=currRing->N))
5130  {
5131    poly p=pOne();
5132    pSetExp(p,i,1);
5133    pSetm(p);
5134    res->data=(char *)p;
5135  }
5136  else
5137  {
5138    Werror("var number %d out of range 1..%d",i,currRing->N);
5139    return TRUE;
5140  }
5141  return FALSE;
5142}
5143static BOOLEAN jjVARSTR1(leftv res, leftv v)
5144{
5145  if (currRing==NULL)
5146  {
5147    WerrorS("no ring active");
5148    return TRUE;
5149  }
5150  int i=(int)(long)v->Data();
5151  if ((0<i) && (i<=currRing->N))
5152    res->data=omStrDup(currRing->names[i-1]);
5153  else
5154  {
5155    Werror("var number %d out of range 1..%d",i,currRing->N);
5156    return TRUE;
5157  }
5158  return FALSE;
5159}
5160static BOOLEAN jjVDIM(leftv res, leftv v)
5161{
5162  assumeStdFlag(v);
5163  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currQuotient);
5164  return FALSE;
5165}
5166BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5167{
5168// input: u: a list with links of type
5169//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5170// returns: -1:  the read state of all links is eof
5171//          i>0: (at least) u[i] is ready
5172  lists Lforks = (lists)u->Data();
5173  int i = slStatusSsiL(Lforks, -1);
5174  if(i == -2) /* error */
5175  {
5176    return TRUE;
5177  }
5178  res->data = (void*)(long)i;
5179  return FALSE;
5180}
5181BOOLEAN jjWAITALL1(leftv res, leftv u)
5182{
5183// input: u: a list with links of type
5184//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5185// returns: -1: the read state of all links is eof
5186//           1: all links are ready
5187//              (caution: at least one is ready, but some maybe dead)
5188  lists Lforks = (lists)u->CopyD();
5189  int i;
5190  int j = -1;
5191  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5192  {
5193    i = slStatusSsiL(Lforks, -1);
5194    if(i == -2) /* error */
5195    {
5196      return TRUE;
5197    }
5198    if(i == -1)
5199    {
5200      break;
5201    }
5202    j = 1;
5203    Lforks->m[i-1].CleanUp();
5204    Lforks->m[i-1].rtyp=DEF_CMD;
5205    Lforks->m[i-1].data=NULL;
5206  }
5207  res->data = (void*)(long)j;
5208  Lforks->Clean();
5209  return FALSE;
5210}
5211
5212BOOLEAN jjLOAD(const char *s, BOOLEAN autoexport)
5213{
5214  char libnamebuf[256];
5215  lib_types LT = type_of_LIB(s, libnamebuf);
5216
5217#ifdef HAVE_DYNAMIC_LOADING
5218  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5219#endif /* HAVE_DYNAMIC_LOADING */
5220  switch(LT)
5221  {
5222      default:
5223      case LT_NONE:
5224        Werror("%s: unknown type", s);
5225        break;
5226      case LT_NOTFOUND:
5227        Werror("cannot open %s", s);
5228        break;
5229
5230      case LT_SINGULAR:
5231      {
5232        char *plib = iiConvName(s);
5233        idhdl pl = IDROOT->get(plib,0);
5234        if (pl==NULL)
5235        {
5236          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5237          IDPACKAGE(pl)->language = LANG_SINGULAR;
5238          IDPACKAGE(pl)->libname=omStrDup(plib);
5239        }
5240        else if (IDTYP(pl)!=PACKAGE_CMD)
5241        {
5242          Werror("can not create package `%s`",plib);
5243          omFree(plib);
5244          return TRUE;
5245        }
5246        package savepack=currPack;
5247        currPack=IDPACKAGE(pl);
5248        IDPACKAGE(pl)->loaded=TRUE;
5249        char libnamebuf[256];
5250        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5251        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5252        currPack=savepack;
5253        IDPACKAGE(pl)->loaded=(!bo);
5254        return bo;
5255      }
5256      case LT_BUILTIN:
5257        SModulFunc_t iiGetBuiltinModInit(const char*);
5258        return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5259      case LT_MACH_O:
5260      case LT_ELF:
5261      case LT_HPUX:
5262#ifdef HAVE_DYNAMIC_LOADING
5263        return load_modules(s, libnamebuf, autoexport);
5264#else /* HAVE_DYNAMIC_LOADING */
5265        WerrorS("Dynamic modules are not supported by this version of Singular");
5266        break;
5267#endif /* HAVE_DYNAMIC_LOADING */
5268  }
5269  return TRUE;
5270}
5271
5272#ifdef INIT_BUG
5273#define XS(A) -((short)A)
5274#define jjstrlen       (proc1)1
5275#define jjpLength      (proc1)2
5276#define jjidElem       (proc1)3
5277#define jjmpDetBareiss (proc1)4
5278#define jjidFreeModule (proc1)5
5279#define jjidVec2Ideal  (proc1)6
5280#define jjrCharStr     (proc1)7
5281#ifndef MDEBUG
5282#define jjpHead        (proc1)8
5283#endif
5284#define jjidMinBase    (proc1)11
5285#define jjsyMinBase    (proc1)12
5286#define jjpMaxComp     (proc1)13
5287#define jjmpTrace      (proc1)14
5288#define jjmpTransp     (proc1)15
5289#define jjrOrdStr      (proc1)16
5290#define jjrVarStr      (proc1)18
5291#define jjrParStr      (proc1)19
5292#define jjCOUNT_RES    (proc1)22
5293#define jjDIM_R        (proc1)23
5294#define jjidTransp     (proc1)24
5295
5296extern struct sValCmd1 dArith1[];
5297void jjInitTab1()
5298{
5299  int i=0;
5300  for (;dArith1[i].cmd!=0;i++)
5301  {
5302    if (dArith1[i].res<0)
5303    {
5304      switch ((int)dArith1[i].p)
5305      {
5306        case (int)jjstrlen:       dArith1[i].p=(proc1)strlen; break;
5307        case (int)jjpLength:      dArith1[i].p=(proc1)pLength; break;
5308        case (int)jjidElem:       dArith1[i].p=(proc1)idElem; break;
5309        case (int)jjidVec2Ideal:  dArith1[i].p=(proc1)idVec2Ideal; break;
5310        case (int)jjmpDetBareiss: dArith1[i].p=(proc1)mpDetBareiss; break;
5311        case (int)jjidFreeModule: dArith1[i].p=(proc1)idFreeModule; break;
5312        case (int)jjrCharStr:     dArith1[i].p=(proc1)rCharStr; break;
5313#ifndef MDEBUG
5314        case (int)jjpHead:        dArith1[i].p=(proc1)pHeadProc; break;
5315#endif
5316        case (int)jjidMinBase:    dArith1[i].p=(proc1)idMinBase; break;
5317        case (int)jjsyMinBase:    dArith1[i].p=(proc1)syMinBase; break;
5318        case (int)jjpMaxComp:     dArith1[i].p=(proc1)pMaxCompProc; break;
5319        case (int)jjmpTrace:      dArith1[i].p=(proc1)mpTrace; break;
5320        case (int)jjmpTransp:     dArith1[i].p=(proc1)mpTransp; break;
5321        case (int)jjrOrdStr:      dArith1[i].p=(proc1)rOrdStr; break;
5322        case (int)jjrVarStr:      dArith1[i].p=(proc1)rVarStr; break;
5323        case (int)jjrParStr:      dArith1[i].p=(proc1)rParStr; break;
5324        case (int)jjCOUNT_RES:    dArith1[i].p=(proc1)sySize; break;
5325        case (int)jjDIM_R:        dArith1[i].p=(proc1)syDim; break;
5326        case (int)jjidTransp:     dArith1[i].p=(proc1)idTransp; break;
5327        default: Werror("missing proc1-definition for %d",(int)(long)dArith1[i].p);
5328      }
5329    }
5330  }
5331}
5332#else
5333#if defined(PROC_BUG)
5334#define XS(A) A
5335static BOOLEAN jjstrlen(leftv res, leftv v)
5336{
5337  res->data = (char *)strlen((char *)v->Data());
5338  return FALSE;
5339}
5340static BOOLEAN jjpLength(leftv res, leftv v)
5341{
5342  res->data = (char *)(long)pLength((poly)v->Data());
5343  return FALSE;
5344}
5345static BOOLEAN jjidElem(leftv res, leftv v)
5346{
5347  res->data = (char *)(long)idElem((ideal)v->Data());
5348  return FALSE;
5349}
5350static BOOLEAN jjmpDetBareiss(leftv res, leftv v)
5351{
5352  res->data = (char *)mp_DetBareiss((matrix)v->Data(),currRing);
5353  return FALSE;
5354}
5355static BOOLEAN jjidFreeModule(leftv res, leftv v)
5356{
5357  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5358  return FALSE;
5359}
5360static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5361{
5362  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5363  return FALSE;
5364}
5365static BOOLEAN jjrCharStr(leftv res, leftv v)
5366{
5367  res->data = rCharStr((ring)v->Data());
5368  return FALSE;
5369}
5370#ifndef MDEBUG
5371static BOOLEAN jjpHead(leftv res, leftv v)
5372{
5373  res->data = (char *)pHead((poly)v->Data());
5374  return FALSE;
5375}
5376#endif
5377static BOOLEAN jjidHead(leftv res, leftv v)
5378{
5379  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5380  return FALSE;
5381}
5382static BOOLEAN jjidMinBase(leftv res, leftv v)
5383{
5384  res->data = (char *)idMinBase((ideal)v->Data());
5385  return FALSE;
5386}
5387static BOOLEAN jjsyMinBase(leftv res, leftv v)
5388{
5389  res->data = (char *)syMinBase((ideal)v->Data());
5390  return FALSE;
5391}
5392static BOOLEAN jjpMaxComp(leftv res, leftv v)
5393{
5394  res->data = (char *)pMaxComp((poly)v->Data());
5395  return FALSE;
5396}
5397static BOOLEAN jjmpTrace(leftv res, leftv v)
5398{
5399  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5400  return FALSE;
5401}
5402static BOOLEAN jjmpTransp(leftv res, leftv v)
5403{
5404  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5405  return FALSE;
5406}
5407static BOOLEAN jjrOrdStr(leftv res, leftv v)
5408{
5409  res->data = rOrdStr((ring)v->Data());
5410  return FALSE;
5411}
5412static BOOLEAN jjrVarStr(leftv res, leftv v)
5413{
5414  res->data = rVarStr((ring)v->Data());
5415  return FALSE;
5416}
5417static BOOLEAN jjrParStr(leftv res, leftv v)
5418{
5419  res->data = rParStr((ring)v->Data());
5420  return FALSE;
5421}
5422static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5423{
5424  res->data=(char *)(long)sySize((syStrategy)v->Data());
5425  return FALSE;
5426}
5427static BOOLEAN jjDIM_R(leftv res, leftv v)
5428{
5429  res->data = (char *)(long)syDim((syStrategy)v->Data());
5430  return FALSE;
5431}
5432static BOOLEAN jjidTransp(leftv res, leftv v)
5433{
5434  res->data = (char *)idTransp((ideal)v->Data());
5435  return FALSE;
5436}
5437#else
5438#define XS(A)          -((short)A)
5439#define jjstrlen       (proc1)strlen
5440#define jjpLength      (proc1)pLength
5441#define jjidElem       (proc1)idElem
5442#define jjmpDetBareiss (proc1)mpDetBareiss
5443#define jjidFreeModule (proc1)idFreeModule
5444#define jjidVec2Ideal  (proc1)idVec2Ideal
5445#define jjrCharStr     (proc1)rCharStr
5446#ifndef MDEBUG
5447#define jjpHead        (proc1)pHeadProc
5448#endif
5449#define jjidHead       (proc1)idHead
5450#define jjidMinBase    (proc1)idMinBase
5451#define jjsyMinBase    (proc1)syMinBase
5452#define jjpMaxComp     (proc1)pMaxCompProc
5453#define jjrOrdStr      (proc1)rOrdStr
5454#define jjrVarStr      (proc1)rVarStr
5455#define jjrParStr      (proc1)rParStr
5456#define jjCOUNT_RES    (proc1)sySize
5457#define jjDIM_R        (proc1)syDim
5458#define jjidTransp     (proc1)idTransp
5459#endif
5460#endif
5461static BOOLEAN jjnInt(leftv res, leftv u)
5462{
5463  number n=(number)u->Data();
5464  res->data=(char *)(long)n_Int(n,currRing->cf);
5465  return FALSE;
5466}
5467static BOOLEAN jjnlInt(leftv res, leftv u)
5468{
5469  number n=(number)u->Data();
5470  res->data=(char *)(long)n_Int(n,coeffs_BIGINT );
5471  return FALSE;
5472}
5473/*=================== operations with 3 args.: static proc =================*/
5474/* must be ordered: first operations for chars (infix ops),
5475 * then alphabetically */
5476static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5477{
5478  char *s= (char *)u->Data();
5479  int   r = (int)(long)v->Data();
5480  int   c = (int)(long)w->Data();
5481  int l = strlen(s);
5482
5483  if ( (r<1) || (r>l) || (c<0) )
5484  {
5485    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5486    return TRUE;
5487  }
5488  res->data = (char *)omAlloc((long)(c+1));
5489  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5490  return FALSE;
5491}
5492static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5493{
5494  intvec *iv = (intvec *)u->Data();
5495  int   r = (int)(long)v->Data();
5496  int   c = (int)(long)w->Data();
5497  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5498  {
5499    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5500           r,c,u->Fullname(),iv->rows(),iv->cols());
5501    return TRUE;
5502  }
5503  res->data=u->data; u->data=NULL;
5504  res->rtyp=u->rtyp; u->rtyp=0;
5505  res->name=u->name; u->name=NULL;
5506  Subexpr e=jjMakeSub(v);
5507          e->next=jjMakeSub(w);
5508  if (u->e==NULL) res->e=e;
5509  else
5510  {
5511    Subexpr h=u->e;
5512    while (h->next!=NULL) h=h->next;
5513    h->next=e;
5514    res->e=u->e;
5515    u->e=NULL;
5516  }
5517  return FALSE;
5518}
5519static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5520{
5521  bigintmat *bim = (bigintmat *)u->Data();
5522  int   r = (int)(long)v->Data();
5523  int   c = (int)(long)w->Data();
5524  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5525  {
5526    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5527           r,c,u->Fullname(),bim->rows(),bim->cols());
5528    return TRUE;
5529  }
5530  res->data=u->data; u->data=NULL;
5531  res->rtyp=u->rtyp; u->rtyp=0;
5532  res->name=u->name; u->name=NULL;
5533  Subexpr e=jjMakeSub(v);
5534          e->next=jjMakeSub(w);
5535  if (u->e==NULL)
5536    res->e=e;
5537  else
5538  {
5539    Subexpr h=u->e;
5540    while (h->next!=NULL) h=h->next;
5541    h->next=e;
5542    res->e=u->e;
5543    u->e=NULL;
5544  }
5545  return FALSE;
5546}
5547static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5548{
5549  matrix m= (matrix)u->Data();
5550  int   r = (int)(long)v->Data();
5551  int   c = (int)(long)w->Data();
5552  //Print("gen. elem %d, %d\n",r,c);
5553  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5554  {
5555    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5556      MATROWS(m),MATCOLS(m));
5557    return TRUE;
5558  }
5559  res->data=u->data; u->data=NULL;
5560  res->rtyp=u->rtyp; u->rtyp=0;
5561  res->name=u->name; u->name=NULL;
5562  Subexpr e=jjMakeSub(v);
5563          e->next=jjMakeSub(w);
5564  if (u->e==NULL)
5565    res->e=e;
5566  else
5567  {
5568    Subexpr h=u->e;
5569    while (h->next!=NULL) h=h->next;
5570    h->next=e;
5571    res->e=u->e;
5572    u->e=NULL;
5573  }
5574  return FALSE;
5575}
5576static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5577{
5578  sleftv t;
5579  sleftv ut;
5580  leftv p=NULL;
5581  intvec *iv=(intvec *)w->Data();
5582  int l;
5583  BOOLEAN nok;
5584
5585  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5586  {
5587    WerrorS("cannot build expression lists from unnamed objects");
5588    return TRUE;
5589  }
5590  memcpy(&ut,u,sizeof(ut));
5591  memset(&t,0,sizeof(t));
5592  t.rtyp=INT_CMD;
5593  for (l=0;l< iv->length(); l++)
5594  {
5595    t.data=(char *)(long)((*iv)[l]);
5596    if (p==NULL)
5597    {
5598      p=res;
5599    }
5600    else
5601    {
5602      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5603      p=p->next;
5604    }
5605    memcpy(u,&ut,sizeof(ut));
5606    if (u->Typ() == MATRIX_CMD)
5607      nok=jjBRACK_Ma(p,u,v,&t);
5608    else if (u->Typ() == BIGINTMAT_CMD)
5609      nok=jjBRACK_Bim(p,u,v,&t);
5610    else /* INTMAT_CMD */
5611      nok=jjBRACK_Im(p,u,v,&t);
5612    if (nok)
5613    {
5614      while (res->next!=NULL)
5615      {
5616        p=res->next->next;
5617        omFreeBin((ADDRESS)res->next, sleftv_bin);
5618        // res->e aufraeumen !!!!
5619        res->next=p;
5620      }
5621      return TRUE;
5622    }
5623  }
5624  return FALSE;
5625}
5626static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5627{
5628  sleftv t;
5629  sleftv ut;
5630  leftv p=NULL;
5631  intvec *iv=(intvec *)v->Data();
5632  int l;
5633  BOOLEAN nok;
5634
5635  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5636  {
5637    WerrorS("cannot build expression lists from unnamed objects");
5638    return TRUE;
5639  }
5640  memcpy(&ut,u,sizeof(ut));
5641  memset(&t,0,sizeof(t));
5642  t.rtyp=INT_CMD;
5643  for (l=0;l< iv->length(); l++)
5644  {
5645    t.data=(char *)(long)((*iv)[l]);
5646    if (p==NULL)
5647    {
5648      p=res;
5649    }
5650    else
5651    {
5652      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5653      p=p->next;
5654    }
5655    memcpy(u,&ut,sizeof(ut));
5656    if (u->Typ() == MATRIX_CMD)
5657      nok=jjBRACK_Ma(p,u,&t,w);
5658    else if (u->Typ() == BIGINTMAT_CMD)
5659      nok=jjBRACK_Bim(p,u,&t,w);
5660    else /* INTMAT_CMD */
5661      nok=jjBRACK_Im(p,u,&t,w);
5662    if (nok)
5663    {
5664      while (res->next!=NULL)
5665      {
5666        p=res->next->next;
5667        omFreeBin((ADDRESS)res->next, sleftv_bin);
5668        // res->e aufraeumen !!
5669        res->next=p;
5670      }
5671      return TRUE;
5672    }
5673  }
5674  return FALSE;
5675}
5676static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5677{
5678  sleftv t1,t2,ut;
5679  leftv p=NULL;
5680  intvec *vv=(intvec *)v->Data();
5681  intvec *wv=(intvec *)w->Data();
5682  int vl;
5683  int wl;
5684  BOOLEAN nok;
5685
5686  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5687  {
5688    WerrorS("cannot build expression lists from unnamed objects");
5689    return TRUE;
5690  }
5691  memcpy(&ut,u,sizeof(ut));
5692  memset(&t1,0,sizeof(sleftv));
5693  memset(&t2,0,sizeof(sleftv));
5694  t1.rtyp=INT_CMD;
5695  t2.rtyp=INT_CMD;
5696  for (vl=0;vl< vv->length(); vl++)
5697  {
5698    t1.data=(char *)(long)((*vv)[vl]);
5699    for (wl=0;wl< wv->length(); wl++)
5700    {
5701      t2.data=(char *)(long)((*wv)[wl]);
5702      if (p==NULL)
5703      {
5704        p=res;
5705      }
5706      else
5707      {
5708        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5709        p=p->next;
5710      }
5711      memcpy(u,&ut,sizeof(ut));
5712      if (u->Typ() == MATRIX_CMD)
5713        nok=jjBRACK_Ma(p,u,&t1,&t2);
5714      else if (u->Typ() == BIGINTMAT_CMD)
5715        nok=jjBRACK_Bim(p,u,&t1,&t2);
5716      else /* INTMAT_CMD */
5717        nok=jjBRACK_Im(p,u,&t1,&t2);
5718      if (nok)
5719      {
5720        res->CleanUp();
5721        return TRUE;
5722      }
5723    }
5724  }
5725  return FALSE;
5726}
5727static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5728{
5729  v->next=(leftv)omAllocBin(sleftv_bin);
5730  memcpy(v->next,w,sizeof(sleftv));
5731  memset(w,0,sizeof(sleftv));
5732  return jjPROC(res,u,v);
5733}
5734static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5735{
5736  intvec *iv;
5737  ideal m;
5738  lists l=(lists)omAllocBin(slists_bin);
5739  int k=(int)(long)w->Data();
5740  if (k>=0)
5741  {
5742    sm_CallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv, currRing);
5743    l->Init(2);
5744    l->m[0].rtyp=MODUL_CMD;
5745    l->m[1].rtyp=INTVEC_CMD;
5746    l->m[0].data=(void *)m;
5747    l->m[1].data=(void *)iv;
5748  }
5749  else
5750  {
5751    m=sm_CallSolv((ideal)u->Data(), currRing);
5752    l->Init(1);
5753    l->m[0].rtyp=IDEAL_CMD;
5754    l->m[0].data=(void *)m;
5755  }
5756  res->data = (char *)l;
5757  return FALSE;
5758}
5759static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5760{
5761  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5762  {
5763    WerrorS("3rd argument must be a name of a matrix");
5764    return TRUE;
5765  }
5766  ideal i=(ideal)u->Data();
5767  int rank=(int)i->rank;
5768  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5769  if (r) return TRUE;
5770  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5771  return FALSE;
5772}
5773static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5774{
5775  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5776           (ideal)(v->Data()),(poly)(w->Data()));
5777  return FALSE;
5778}
5779static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5780{
5781  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5782  {
5783    WerrorS("3rd argument must be a name of a matrix");
5784    return TRUE;
5785  }
5786  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5787  poly p=(poly)u->CopyD(POLY_CMD);
5788  ideal i=idInit(1,1);
5789  i->m[0]=p;
5790  sleftv t;
5791  memset(&t,0,sizeof(t));
5792  t.data=(char *)i;
5793  t.rtyp=IDEAL_CMD;
5794  int rank=1;
5795  if (u->Typ()==VECTOR_CMD)
5796  {
5797    i->rank=rank=pMaxComp(p);
5798    t.rtyp=MODUL_CMD;
5799  }
5800  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5801  t.CleanUp();
5802  if (r) return TRUE;
5803  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5804  return FALSE;
5805}
5806static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5807{
5808  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5809    (intvec *)w->Data());
5810  //setFlag(res,FLAG_STD);
5811  return FALSE;
5812}
5813static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5814{
5815  /*4
5816  * look for the substring what in the string where
5817  * starting at position n
5818  * return the position of the first char of what in where
5819  * or 0
5820  */
5821  int n=(int)(long)w->Data();
5822  char *where=(char *)u->Data();
5823  char *what=(char *)v->Data();
5824  char *found;
5825  if ((1>n)||(n>(int)strlen(where)))
5826  {
5827    Werror("start position %d out of range",n);
5828    return TRUE;
5829  }
5830  found = strchr(where+n-1,*what);
5831  if (*(what+1)!='\0')
5832  {
5833    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
5834    {
5835      found=strchr(found+1,*what);
5836    }
5837  }
5838  if (found != NULL)
5839  {
5840    res->data=(char *)((found-where)+1);
5841  }
5842  return FALSE;
5843}
5844static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
5845{
5846  if ((int)(long)w->Data()==0)
5847    res->data=(char *)walkProc(u,v);
5848  else
5849    res->data=(char *)fractalWalkProc(u,v);
5850  setFlag( res, FLAG_STD );
5851  return FALSE;
5852}
5853static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
5854{
5855  intvec *wdegree=(intvec*)w->Data();
5856  if (wdegree->length()!=currRing->N)
5857  {
5858    Werror("weight vector must have size %d, not %d",
5859           currRing->N,wdegree->length());
5860    return TRUE;
5861  }
5862#ifdef HAVE_RINGS
5863  if (rField_is_Ring_Z(currRing))
5864  {
5865    ring origR = currRing;
5866    ring tempR = rCopy(origR);
5867    coeffs new_cf=nInitChar(n_Q,NULL);
5868    nKillChar(tempR->cf);
5869    tempR->cf=new_cf;
5870    rComplete(tempR);
5871    ideal uid = (ideal)u->Data();
5872    rChangeCurrRing(tempR);
5873    ideal uu = idrCopyR(uid, origR, currRing);
5874    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
5875    uuAsLeftv.rtyp = IDEAL_CMD;
5876    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
5877    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
5878    assumeStdFlag(&uuAsLeftv);
5879    Print("// NOTE: computation of Hilbert series etc. is being\n");
5880    Print("//       performed for generic fibre, that is, over Q\n");
5881    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
5882    intvec *iv=hFirstSeries(uu,module_w,currQuotient,wdegree);
5883    int returnWithTrue = 1;
5884    switch((int)(long)v->Data())
5885    {
5886      case 1:
5887        res->data=(void *)iv;
5888        returnWithTrue = 0;
5889      case 2:
5890        res->data=(void *)hSecondSeries(iv);
5891        delete iv;
5892        returnWithTrue = 0;
5893    }
5894    if (returnWithTrue)
5895    {
5896      WerrorS(feNotImplemented);
5897      delete iv;
5898    }
5899    idDelete(&uu);
5900    rChangeCurrRing(origR);
5901    rDelete(tempR);
5902    if (returnWithTrue) return TRUE; else return FALSE;
5903  }
5904#endif
5905  assumeStdFlag(u);
5906  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
5907  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient,wdegree);
5908  switch((int)(long)v->Data())
5909  {
5910    case 1:
5911      res->data=(void *)iv;
5912      return FALSE;
5913    case 2:
5914      res->data=(void *)hSecondSeries(iv);
5915      delete iv;
5916      return FALSE;
5917  }
5918  WerrorS(feNotImplemented);
5919  delete iv;
5920  return TRUE;
5921}
5922static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv /*w*/)
5923{
5924  PrintS("TODO\n");
5925  int i=pVar((poly)v->Data());
5926  if (i==0)
5927  {
5928    WerrorS("ringvar expected");
5929    return TRUE;
5930  }
5931  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5932  int d=pWTotaldegree(p);
5933  pLmDelete(p);
5934  if (d==1)
5935    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
5936  else
5937    WerrorS("variable must have weight 1");
5938  return (d!=1);
5939}
5940static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv /*w*/)
5941{
5942  PrintS("TODO\n");
5943  int i=pVar((poly)v->Data());
5944  if (i==0)
5945  {
5946    WerrorS("ringvar expected");
5947    return TRUE;
5948  }
5949  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5950  int d=pWTotaldegree(p);
5951  pLmDelete(p);
5952  if (d==1)
5953    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
5954  else
5955    WerrorS("variable must have weight 1");
5956  return (d!=1);
5957}
5958static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
5959{
5960  intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
5961  intvec* arg = (intvec*) u->Data();
5962  int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
5963
5964  for (i=0; i<n; i++)
5965  {
5966    (*im)[i] = (*arg)[i];
5967  }
5968
5969  res->data = (char *)im;
5970  return FALSE;
5971}
5972static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
5973{
5974  short *iw=iv2array((intvec *)w->Data(),currRing);
5975  res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
5976  omFreeSize( (ADDRESS)iw, (rVar(currRing)+1)*sizeof(short) );
5977  return FALSE;
5978}
5979static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
5980{
5981  if (!pIsUnit((poly)v->Data()))
5982  {
5983    WerrorS("2nd argument must be a unit");
5984    return TRUE;
5985  }
5986  res->data = (char *)p_Series((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD(),NULL,currRing);
5987  return FALSE;
5988}
5989static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
5990{
5991  res->data = (char *)id_JetW((ideal)u->Data(),(int)(long)v->Data(),
5992                             (intvec *)w->Data(),currRing);
5993  return FALSE;
5994}
5995static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
5996{
5997  if (!mp_IsDiagUnit((matrix)v->Data(), currRing))
5998  {
5999    WerrorS("2nd argument must be a diagonal matrix of units");
6000    return TRUE;
6001  }
6002  res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
6003                               (matrix)v->CopyD());
6004  return FALSE;
6005}
6006static BOOLEAN currRingIsOverIntegralDomain ()
6007{
6008  /* true for fields and Z, false otherwise */
6009  if (rField_is_Ring_PtoM(currRing)) return FALSE;
6010  if (rField_is_Ring_2toM(currRing)) return FALSE;
6011  if (rField_is_Ring_ModN(currRing)) return FALSE;
6012  return TRUE;
6013}
6014static BOOLEAN jjMINOR_M(leftv res, leftv v)
6015{
6016  /* Here's the use pattern for the minor command:
6017        minor ( matrix_expression m, int_expression minorSize,
6018                optional ideal_expression IasSB, optional int_expression k,
6019                optional string_expression algorithm,
6020                optional int_expression cachedMinors,
6021                optional int_expression cachedMonomials )
6022     This method here assumes that there are at least two arguments.
6023     - If IasSB is present, it must be a std basis. All minors will be
6024       reduced w.r.t. IasSB.
6025     - If k is absent, all non-zero minors will be computed.
6026       If k is present and k > 0, the first k non-zero minors will be
6027       computed.
6028       If k is present and k < 0, the first |k| minors (some of which
6029       may be zero) will be computed.
6030       If k is present and k = 0, an error is reported.
6031     - If algorithm is absent, all the following arguments must be absent too.
6032       In this case, a heuristic picks the best-suited algorithm (among
6033       Bareiss, Laplace, and Laplace with caching).
6034       If algorithm is present, it must be one of "Bareiss", "bareiss",
6035       "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
6036       "cache" two more arguments may be given, determining how many entries
6037       the cache may have at most, and how many cached monomials there are at
6038       most. (Cached monomials are counted over all cached polynomials.)
6039       If these two additional arguments are not provided, 200 and 100000
6040       will be used as defaults.
6041  */
6042  matrix m;
6043  leftv u=v->next;
6044  v->next=NULL;
6045  int v_typ=v->Typ();
6046  if (v_typ==MATRIX_CMD)
6047  {
6048     m = (const matrix)v->Data();
6049  }
6050  else
6051  {
6052    if (v_typ==0)
6053    {
6054      Werror("`%s` is undefined",v->Fullname());
6055      return TRUE;
6056    }
6057    // try to convert to MATRIX:
6058    int ii=iiTestConvert(v_typ,MATRIX_CMD);
6059    BOOLEAN bo;
6060    sleftv tmp;
6061    if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
6062    else bo=TRUE;
6063    if (bo)
6064    {
6065      Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
6066      return TRUE;
6067    }
6068    m=(matrix)tmp.data;
6069  }
6070  const int mk = (const int)(long)u->Data();
6071  bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
6072  bool noCacheMinors = true; bool noCacheMonomials = true;
6073  ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
6074
6075  /* here come the different cases of correct argument sets */
6076  if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
6077  {
6078    IasSB = (ideal)u->next->Data();
6079    noIdeal = false;
6080    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6081    {
6082      k = (int)(long)u->next->next->Data();
6083      noK = false;
6084      assume(k != 0);
6085      if ((u->next->next->next != NULL) &&
6086          (u->next->next->next->Typ() == STRING_CMD))
6087      {
6088        algorithm = (char*)u->next->next->next->Data();
6089        noAlgorithm = false;
6090        if ((u->next->next->next->next != NULL) &&
6091            (u->next->next->next->next->Typ() == INT_CMD))
6092        {
6093          cacheMinors = (int)(long)u->next->next->next->next->Data();
6094          noCacheMinors = false;
6095          if ((u->next->next->next->next->next != NULL) &&
6096              (u->next->next->next->next->next->Typ() == INT_CMD))
6097          {
6098            cacheMonomials =
6099               (int)(long)u->next->next->next->next->next->Data();
6100            noCacheMonomials = false;
6101          }
6102        }
6103      }
6104    }
6105  }
6106  else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
6107  {
6108    k = (int)(long)u->next->Data();
6109    noK = false;
6110    assume(k != 0);
6111    if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
6112    {
6113      algorithm = (char*)u->next->next->Data();
6114      noAlgorithm = false;
6115      if ((u->next->next->next != NULL) &&
6116          (u->next->next->next->Typ() == INT_CMD))
6117      {
6118        cacheMinors = (int)(long)u->next->next->next->Data();
6119        noCacheMinors = false;
6120        if ((u->next->next->next->next != NULL) &&
6121            (u->next->next->next->next->Typ() == INT_CMD))
6122        {
6123          cacheMonomials = (int)(long)u->next->next->next->next->Data();
6124          noCacheMonomials = false;
6125        }
6126      }
6127    }
6128  }
6129  else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
6130  {
6131    algorithm = (char*)u->next->Data();
6132    noAlgorithm = false;
6133    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6134    {
6135      cacheMinors = (int)(long)u->next->next->Data();
6136      noCacheMinors = false;
6137      if ((u->next->next->next != NULL) &&
6138          (u->next->next->next->Typ() == INT_CMD))
6139      {
6140        cacheMonomials = (int)(long)u->next->next->next->Data();
6141        noCacheMonomials = false;
6142      }
6143    }
6144  }
6145
6146  /* upper case conversion for the algorithm if present */
6147  if (!noAlgorithm)
6148  {
6149    if (strcmp(algorithm, "bareiss") == 0)
6150      algorithm = (char*)"Bareiss";
6151    if (strcmp(algorithm, "laplace") == 0)
6152      algorithm = (char*)"Laplace";
6153    if (strcmp(algorithm, "cache") == 0)
6154      algorithm = (char*)"Cache";
6155  }
6156
6157  v->next=u;
6158  /* here come some tests */
6159  if (!noIdeal)
6160  {
6161    assumeStdFlag(u->next);
6162  }
6163  if ((!noK) && (k == 0))
6164  {
6165    WerrorS("Provided number of minors to be computed is zero.");
6166    return TRUE;
6167  }
6168  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") != 0)
6169      && (strcmp(algorithm, "Laplace") != 0)
6170      && (strcmp(algorithm, "Cache") != 0))
6171  {
6172    WerrorS("Expected as algorithm one of 'B/bareiss', 'L/laplace', or 'C/cache'.");
6173    return TRUE;
6174  }
6175  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") == 0)
6176      && (!currRingIsOverIntegralDomain()))
6177  {
6178    Werror("Bareiss algorithm not defined over coefficient rings %s",
6179           "with zero divisors.");
6180    return TRUE;
6181  }
6182  if ((mk < 1) || (mk > m->rows()) || (mk > m->cols()))
6183  {
6184    Werror("invalid size of minors: %d (matrix is (%d x %d))", mk,
6185           m->rows(), m->cols());
6186    return TRUE;
6187  }
6188  if ((!noAlgorithm) && (strcmp(algorithm, "Cache") == 0)
6189      && (noCacheMinors || noCacheMonomials))
6190  {
6191    cacheMinors = 200;
6192    cacheMonomials = 100000;
6193  }
6194
6195  /* here come the actual procedure calls */
6196  if (noAlgorithm)
6197    res->data = getMinorIdealHeuristic(m, mk, (noK ? 0 : k),
6198                                       (noIdeal ? 0 : IasSB), false);
6199  else if (strcmp(algorithm, "Cache") == 0)
6200    res->data = getMinorIdealCache(m, mk, (noK ? 0 : k),
6201                                   (noIdeal ? 0 : IasSB), 3, cacheMinors,
6202                                   cacheMonomials, false);
6203  else
6204    res->data = getMinorIdeal(m, mk, (noK ? 0 : k), algorithm,
6205                              (noIdeal ? 0 : IasSB), false);
6206  if (v_typ!=MATRIX_CMD) idDelete((ideal *)&m);
6207  res->rtyp = IDEAL_CMD;
6208  return FALSE;
6209}
6210static BOOLEAN jjNEWSTRUCT3(leftv, leftv u, leftv v, leftv w)
6211{
6212  // u: the name of the new type
6213  // v: the parent type
6214  // w: the elements
6215  newstruct_desc d=newstructChildFromString((const char *)v->Data(),
6216                                            (const char *)w->Data());
6217  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
6218  return (d==NULL);
6219}
6220static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w)
6221{
6222  // handles preimage(r,phi,i) and kernel(r,phi)
6223  idhdl h;
6224  ring rr;
6225  map mapping;
6226  BOOLEAN kernel_cmd= (iiOp==KERNEL_CMD);
6227
6228  if ((v->name==NULL) || (!kernel_cmd && (w->name==NULL)))
6229  {
6230    WerrorS("2nd/3rd arguments must have names");
6231    return TRUE;
6232  }
6233  rr=(ring)u->Data();
6234  const char *ring_name=u->Name();
6235  if ((h=rr->idroot->get(v->name,myynest))!=NULL)
6236  {
6237    if (h->typ==MAP_CMD)
6238    {
6239      mapping=IDMAP(h);
6240      idhdl preim_ring=IDROOT->get(mapping->preimage,myynest);
6241      if ((preim_ring==NULL)
6242      || (IDRING(preim_ring)!=currRing))
6243      {
6244        Werror("preimage ring `%s` is not the basering",mapping->preimage);
6245        return TRUE;
6246      }
6247    }
6248    else if (h->typ==IDEAL_CMD)
6249    {
6250      mapping=IDMAP(h);
6251    }
6252    else
6253    {
6254      Werror("`%s` is no map nor ideal",IDID(h));
6255      return TRUE;
6256    }
6257  }
6258  else
6259  {
6260    Werror("`%s` is not defined in `%s`",v->name,ring_name);
6261    return TRUE;
6262  }
6263  ideal image;
6264  if (kernel_cmd) image=idInit(1,1);
6265  else
6266  {
6267    if ((h=rr->idroot->get(w->name,myynest))!=NULL)
6268    {
6269      if (h->typ==IDEAL_CMD)
6270      {
6271        image=IDIDEAL(h);
6272      }
6273      else
6274      {
6275        Werror("`%s` is no ideal",IDID(h));
6276        return TRUE;
6277      }
6278    }
6279    else
6280    {
6281      Werror("`%s` is not defined in `%s`",w->name,ring_name);
6282      return TRUE;
6283    }
6284  }
6285  if (((currRing->qideal!=NULL) && (rHasLocalOrMixedOrdering_currRing()))
6286  || ((rr->qideal!=NULL) && (rHasLocalOrMixedOrdering(rr))))
6287  {
6288    WarnS("preimage in local qring may be wrong: use Ring::preimageLoc instead");
6289  }
6290  res->data=(char *)maGetPreimage(rr,mapping,image,currRing);
6291  if (kernel_cmd) idDelete(&image);
6292  return (res->data==NULL/* is of type ideal, should not be NULL*/);
6293}
6294static BOOLEAN jjRANDOM_Im(leftv res, leftv u, leftv v, leftv w)
6295{
6296  int di, k;
6297  int i=(int)(long)u->Data();
6298  int r=(int)(long)v->Data();
6299  int c=(int)(long)w->Data();
6300  if ((r<=0) || (c<=0)) return TRUE;
6301  intvec *iv = new intvec(r, c, 0);
6302  if (iv->rows()==0)
6303  {
6304    delete iv;
6305    return TRUE;
6306  }
6307  if (i!=0)
6308  {
6309    if (i<0) i = -i;
6310    di = 2 * i + 1;
6311    for (k=0; k<iv->length(); k++)
6312    {
6313      (*iv)[k] = ((siRand() % di) - i);
6314    }
6315  }
6316  res->data = (char *)iv;
6317  return FALSE;
6318}
6319static BOOLEAN jjSUBST_Test(leftv v,leftv w,
6320  int &ringvar, poly &monomexpr)
6321{
6322  monomexpr=(poly)w->Data();
6323  poly p=(poly)v->Data();
6324#if 0
6325  if (pLength(monomexpr)>1)
6326  {
6327    Werror("`%s` substitutes a ringvar only by a term",
6328      Tok2Cmdname(SUBST_CMD));
6329    return TRUE;
6330  }
6331#endif
6332  if ((ringvar=pVar(p))==0)
6333  {
6334    if ((p!=NULL) && (currRing->cf->extRing!=NULL))
6335    {
6336      number n = pGetCoeff(p);
6337      ringvar= -n_IsParam(n, currRing);
6338    }
6339    if(ringvar==0)
6340    {
6341      WerrorS("ringvar/par expected");
6342      return TRUE;
6343    }
6344  }
6345  return FALSE;
6346}
6347static BOOLEAN jjSUBST_P(leftv res, leftv u, leftv v,leftv w)
6348{
6349  int ringvar;
6350  poly monomexpr;
6351  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6352  if (nok) return TRUE;
6353  poly p=(poly)u->Data();
6354  if (ringvar>0)
6355  {
6356    if ((monomexpr!=NULL) && (p!=NULL) && (pTotaldegree(p)!=0) &&
6357    ((unsigned long)pTotaldegree(monomexpr) > (currRing->bitmask / (unsigned long)pTotaldegree(p))))
6358    {
6359      Warn("possible OVERFLOW in subst, max exponent is %ld, subtituting deg %d by deg %d",currRing->bitmask, pTotaldegree(monomexpr), pTotaldegree(p));
6360      //return TRUE;
6361    }
6362    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6363      res->data = pSubst((poly)u->CopyD(res->rtyp),ringvar,monomexpr);
6364    else
6365      res->data= pSubstPoly(p,ringvar,monomexpr);
6366  }
6367  else
6368  {
6369    res->data=pSubstPar(p,-ringvar,monomexpr);
6370  }
6371  return FALSE;
6372}
6373static BOOLEAN jjSUBST_Id(leftv res, leftv u, leftv v,leftv w)
6374{
6375  int ringvar;
6376  poly monomexpr;
6377  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6378  if (nok) return TRUE;
6379  if (ringvar>0)
6380  {
6381    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6382      res->data = id_Subst((ideal)u->CopyD(res->rtyp), ringvar, monomexpr, currRing);
6383    else
6384      res->data = idSubstPoly((ideal)u->Data(),ringvar,monomexpr);
6385  }
6386  else
6387  {
6388    res->data = idSubstPar((ideal)u->Data(),-ringvar,monomexpr);
6389  }
6390  return FALSE;
6391}
6392// we do not want to have jjSUBST_Id_X inlined:
6393static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w,
6394                            int input_type);
6395static BOOLEAN jjSUBST_Id_I(leftv res, leftv u, leftv v,leftv w)
6396{
6397  return jjSUBST_Id_X(res,u,v,w,INT_CMD);
6398}
6399static BOOLEAN jjSUBST_Id_N(leftv res, leftv u, leftv v,leftv w)
6400{
6401  return jjSUBST_Id_X(res,u,v,w,NUMBER_CMD);
6402}
6403static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w, int input_type)
6404{
6405  sleftv tmp;
6406  memset(&tmp,0,sizeof(tmp));
6407  // do not check the result, conversion from int/number to poly works always
6408  iiConvert(input_type,POLY_CMD,iiTestConvert(input_type,POLY_CMD),w,&tmp);
6409  BOOLEAN b=jjSUBST_Id(res,u,v,&tmp);
6410  tmp.CleanUp();
6411  return b;
6412}
6413static BOOLEAN jjMATRIX_Id(leftv res, leftv u, leftv v,leftv w)
6414{
6415  int mi=(int)(long)v->Data();
6416  int ni=(int)(long)w->Data();
6417  if ((mi<1)||(ni<1))
6418  {
6419    Werror("converting ideal to matrix: dimensions must be positive(%dx%d)",mi,ni);
6420    return TRUE;
6421  }
6422  matrix m=mpNew(mi,ni);
6423  ideal I=(ideal)u->CopyD(IDEAL_CMD);
6424  int i=si_min(IDELEMS(I),mi*ni);
6425  //for(i=i-1;i>=0;i--)
6426  //{
6427  //  m->m[i]=I->m[i];
6428  //  I->m[i]=NULL;
6429  //}
6430  memcpy(m->m,I->m,i*sizeof(poly));
6431  memset(I->m,0,i*sizeof(poly));
6432  id_Delete(&I,currRing);
6433  res->data = (char *)m;
6434  return FALSE;
6435}
6436static BOOLEAN jjMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6437{
6438  int mi=(int)(long)v->Data();
6439  int ni=(int)(long)w->Data();
6440  if ((mi<1)||(ni<1))
6441  {
6442    Werror("converting module to matrix: dimensions must be positive(%dx%d)",mi,ni);
6443    return TRUE;
6444  }
6445  res->data = (char *)id_Module2formatedMatrix((ideal)u->CopyD(MODUL_CMD),
6446           mi,ni,currRing);
6447  return FALSE;
6448}
6449static BOOLEAN jjMATRIX_Ma(leftv res, leftv u, leftv v,leftv w)
6450{
6451  int mi=(int)(long)v->Data();
6452  int ni=(int)(long)w->Data();
6453  if ((mi<1)||(ni<1))
6454  {
6455     Werror("converting matrix to matrix: dimensions must be positive(%dx%d)",mi,ni);
6456    return TRUE;
6457  }
6458  matrix m=mpNew(mi,ni);
6459  matrix I=(matrix)u->CopyD(MATRIX_CMD);
6460  int r=si_min(MATROWS(I),mi);
6461  int c=si_min(MATCOLS(I),ni);
6462  int i,j;
6463  for(i=r;i>0;i--)
6464  {
6465    for(j=c;j>0;j--)
6466    {
6467      MATELEM(m,i,j)=MATELEM(I,i,j);
6468      MATELEM(I,i,j)=NULL;
6469    }
6470  }
6471  id_Delete((ideal *)&I,currRing);
6472  res->data = (char *)m;
6473  return FALSE;
6474}
6475static BOOLEAN jjLIFT3(leftv res, leftv u, leftv v, leftv w)
6476{
6477  if (w->rtyp!=IDHDL) return TRUE;
6478  int ul= IDELEMS((ideal)u->Data());
6479  int vl= IDELEMS((ideal)v->Data());
6480  ideal m
6481    = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
6482             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))));
6483  if (m==NULL) return TRUE;
6484  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
6485  return FALSE;
6486}
6487static BOOLEAN jjLIFTSTD3(leftv res, leftv u, leftv v, leftv w)
6488{
6489  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
6490  if ((w->rtyp!=IDHDL)||(w->e!=NULL)) return TRUE;
6491  idhdl hv=(idhdl)v->data;
6492  idhdl hw=(idhdl)w->data;
6493  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
6494  res->data = (char *)idLiftStd((ideal)u->Data(),
6495                                &(hv->data.umatrix),testHomog,
6496                                &(hw->data.uideal));
6497  setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
6498  return FALSE;
6499}
6500static BOOLEAN jjREDUCE3_CP(leftv res, leftv u, leftv v, leftv w)
6501{
6502  assumeStdFlag(v);
6503  if (!idIsZeroDim((ideal)v->Data()))
6504  {
6505    Werror("`%s` must be 0-dimensional",v->Name());
6506    return TRUE;
6507  }
6508  res->data = (char *)redNF((ideal)v->CopyD(),(poly)u->CopyD(),
6509    (poly)w->CopyD());
6510  return FALSE;
6511}
6512static BOOLEAN jjREDUCE3_CID(leftv res, leftv u, leftv v, leftv w)
6513{
6514  assumeStdFlag(v);
6515  if (!idIsZeroDim((ideal)v->Data()))
6516  {
6517    Werror("`%s` must be 0-dimensional",v->Name());
6518    return TRUE;
6519  }
6520  res->data = (char *)redNF((ideal)v->CopyD(),(ideal)u->CopyD(),
6521    (matrix)w->CopyD());
6522  return FALSE;
6523}
6524static BOOLEAN jjREDUCE3_P(leftv res, leftv u, leftv v, leftv w)
6525{
6526  assumeStdFlag(v);
6527  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data(),
6528    0,(int)(long)w->Data());
6529  return FALSE;
6530}
6531static BOOLEAN jjREDUCE3_ID(leftv res, leftv u, leftv v, leftv w)
6532{
6533  assumeStdFlag(v);
6534  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(ideal)u->Data(),
6535    0,(int)(long)w->Data());
6536  return FALSE;
6537}
6538#ifdef OLD_RES
6539static BOOLEAN jjRES3(leftv res, leftv u, leftv v, leftv w)
6540{
6541  int maxl=(int)v->Data();
6542  ideal u_id=(ideal)u->Data();
6543  int l=0;
6544  resolvente r;
6545  intvec **weights=NULL;
6546  int wmaxl=maxl;
6547  maxl--;
6548  if ((maxl==-1) && (iiOp!=MRES_CMD))
6549    maxl = currRing->N-1;
6550  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
6551  {
6552    intvec * iv=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
6553    if (iv!=NULL)
6554    {
6555      l=1;
6556      if (!idTestHomModule(u_id,currQuotient,iv))
6557      {
6558        WarnS("wrong weights");
6559        iv=NULL;
6560      }
6561      else
6562      {
6563        weights = (intvec**)omAlloc0Bin(char_ptr_bin);
6564        weights[0] = ivCopy(iv);
6565      }
6566    }
6567    r=syResolvente(u_id,maxl,&l, &weights, iiOp==MRES_CMD);
6568  }
6569  else
6570    r=sySchreyerResolvente((ideal)u->Data(),maxl+1,&l);
6571  if (r==NULL) return TRUE;
6572  int t3=u->Typ();
6573  iiMakeResolv(r,l,wmaxl,w->name,t3,weights);
6574  return FALSE;
6575}
6576#endif
6577static BOOLEAN jjRING3(leftv res, leftv u, leftv v, leftv w)
6578{
6579  res->data=(void *)rInit(u,v,w);
6580  return (res->data==NULL);
6581}
6582static BOOLEAN jjSTATUS3(leftv res, leftv u, leftv v, leftv w)
6583{
6584  int yes;
6585  jjSTATUS2(res, u, v);
6586  yes = (strcmp((char *) res->data, (char *) w->Data()) == 0);
6587  omFree((ADDRESS) res->data);
6588  res->data = (void *)(long)yes;
6589  return FALSE;
6590}
6591static BOOLEAN jjSTD_HILB_W(leftv res, leftv u, leftv v, leftv w)
6592{
6593  intvec *vw=(intvec *)w->Data(); // weights of vars
6594  if (vw->length()!=currRing->N)
6595  {
6596    Werror("%d weights for %d variables",vw->length(),currRing->N);
6597    return TRUE;
6598  }
6599  ideal result;
6600  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6601  tHomog hom=testHomog;
6602  ideal u_id=(ideal)(u->Data());
6603  if (ww!=NULL)
6604  {
6605    if (!idTestHomModule(u_id,currQuotient,ww))
6606    {
6607      WarnS("wrong weights");
6608      ww=NULL;
6609    }
6610    else
6611    {
6612      ww=ivCopy(ww);
6613      hom=isHomog;
6614    }
6615  }
6616  result=kStd(u_id,
6617              currQuotient,
6618              hom,
6619              &ww,                  // module weights
6620              (intvec *)v->Data(),  // hilbert series
6621              0,0,                  // syzComp, newIdeal
6622              vw);                  // weights of vars
6623  idSkipZeroes(result);
6624  res->data = (char *)result;
6625  setFlag(res,FLAG_STD);
6626  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
6627  return FALSE;
6628}
6629
6630/*=================== operations with many arg.: static proc =================*/
6631/* must be ordered: first operations for chars (infix ops),
6632 * then alphabetically */
6633static BOOLEAN jjBREAK0(leftv, leftv)
6634{
6635#ifdef HAVE_SDB
6636  sdb_show_bp();
6637#endif
6638  return FALSE;
6639}
6640static BOOLEAN jjBREAK1(leftv, leftv v)
6641{
6642#ifdef HAVE_SDB
6643  if(v->Typ()==PROC_CMD)
6644  {
6645    int lineno=0;
6646    if((v->next!=NULL) && (v->next->Typ()==INT_CMD))
6647    {
6648      lineno=(int)(long)v->next->Data();
6649    }
6650    return sdb_set_breakpoint(v->Name(),lineno);
6651  }
6652  return TRUE;
6653#else
6654 return FALSE;
6655#endif
6656}
6657static BOOLEAN jjCALL1ARG(leftv res, leftv v)
6658{
6659  return iiExprArith1(res,v,iiOp);
6660}
6661static BOOLEAN jjCALL2ARG(leftv res, leftv u)
6662{
6663  leftv v=u->next;
6664  u->next=NULL;
6665  BOOLEAN b=iiExprArith2(res,u,iiOp,v, (iiOp > 255));
6666  u->next=v;
6667  return b;
6668}
6669static BOOLEAN jjCALL3ARG(leftv res, leftv u)
6670{
6671  leftv v = u->next;
6672  leftv w = v->next;
6673  u->next = NULL;
6674  v->next = NULL;
6675  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
6676  u->next = v;
6677  v->next = w;
6678  return b;
6679}
6680
6681static BOOLEAN jjCOEF_M(leftv, leftv v)
6682{
6683  if((v->Typ() != VECTOR_CMD)
6684  || (v->next->Typ() != POLY_CMD)
6685  || (v->next->next->Typ() != MATRIX_CMD)
6686  || (v->next->next->next->Typ() != MATRIX_CMD))
6687     return TRUE;
6688  if (v->next->next->rtyp!=IDHDL) return TRUE;
6689  idhdl c=(idhdl)v->next->next->data;
6690  if (v->next->next->next->rtyp!=IDHDL) return TRUE;
6691  idhdl m=(idhdl)v->next->next->next->data;
6692  idDelete((ideal *)&(c->data.uideal));
6693  idDelete((ideal *)&(m->data.uideal));
6694  mp_Coef2((poly)v->Data(),(poly)v->next->Data(),
6695    (matrix *)&(c->data.umatrix),(matrix *)&(m->data.umatrix),currRing);
6696  return FALSE;
6697}
6698
6699static BOOLEAN jjDIVISION4(leftv res, leftv v)
6700{ // may have 3 or 4 arguments
6701  leftv v1=v;
6702  leftv v2=v1->next;
6703  leftv v3=v2->next;
6704  leftv v4=v3->next;
6705  assumeStdFlag(v2);
6706
6707  int i1=iiTestConvert(v1->Typ(),MODUL_CMD);
6708  int i2=iiTestConvert(v2->Typ(),MODUL_CMD);
6709
6710  if((i1==0)||(i2==0)
6711  ||(v3->Typ()!=INT_CMD)||((v4!=NULL)&&(v4->Typ()!=INTVEC_CMD)))
6712  {
6713    WarnS("<module>,<module>,<int>[,<intvec>] expected!");
6714    return TRUE;
6715  }
6716
6717  sleftv w1,w2;
6718  iiConvert(v1->Typ(),MODUL_CMD,i1,v1,&w1);
6719  iiConvert(v2->Typ(),MODUL_CMD,i2,v2,&w2);
6720  ideal P=(ideal)w1.Data();
6721  ideal Q=(ideal)w2.Data();
6722
6723  int n=(int)(long)v3->Data();
6724  short *w=NULL;
6725  if(v4!=NULL)
6726  {
6727    w = iv2array((intvec *)v4->Data(),currRing);
6728    short * w0 = w + 1;
6729    int i = currRing->N;
6730    while( (i > 0) && ((*w0) > 0) )
6731    {
6732      w0++;
6733      i--;
6734    }
6735    if(i>0)
6736      WarnS("not all weights are positive!");
6737  }
6738
6739  matrix T;
6740  ideal R;
6741  idLiftW(P,Q,n,T,R,w);
6742
6743  w1.CleanUp();
6744  w2.CleanUp();
6745  if(w!=NULL)
6746    omFreeSize( (ADDRESS)w, (rVar(currRing)+1)*sizeof(short) );
6747
6748  lists L=(lists) omAllocBin(slists_bin);
6749  L->Init(2);
6750  L->m[1].rtyp=v1->Typ();
6751  if(v1->Typ()==POLY_CMD||v1->Typ()==VECTOR_CMD)
6752  {
6753    if(v1->Typ()==POLY_CMD)
6754      p_Shift(&R->m[0],-1,currRing);
6755    L->m[1].data=(void *)R->m[0];
6756    R->m[0]=NULL;
6757    idDelete(&R);
6758  }
6759  else if(v1->Typ()==IDEAL_CMD||v1->Typ()==MATRIX_CMD)
6760    L->m[1].data=(void *)id_Module2Matrix(R,currRing);
6761  else
6762  {
6763    L->m[1].rtyp=MODUL_CMD;
6764    L->m[1].data=(void *)R;
6765  }
6766  L->m[0].rtyp=MATRIX_CMD;
6767  L->m[0].data=(char *)T;
6768
6769  res->data=L;
6770  res->rtyp=LIST_CMD;
6771
6772  return FALSE;
6773}
6774
6775//static BOOLEAN jjEXPORTTO_M(leftv res, leftv u)
6776//{
6777//  int l=u->listLength();
6778//  if (l<2) return TRUE;
6779//  BOOLEAN b;
6780//  leftv v=u->next;
6781//  leftv zz=v;
6782//  leftv z=zz;
6783//  u->next=NULL;
6784//  do
6785//  {
6786//    leftv z=z->next;
6787//    b=iiExprArith2(res,u,iiOp,z, (iiOp > 255));
6788//    if (b) break;
6789//  } while (z!=NULL);
6790//  u->next=zz;
6791//  return b;
6792//}
6793static BOOLEAN jjIDEAL_PL(leftv res, leftv v)
6794{
6795  int s=1;
6796  leftv h=v;
6797  if (h!=NULL) s=exprlist_length(h);
6798  ideal id=idInit(s,1);
6799  int rank=1;
6800  int i=0;
6801  poly p;
6802  while (h!=NULL)
6803  {
6804    switch(h->Typ())
6805    {
6806      case POLY_CMD:
6807      {
6808        p=(poly)h->CopyD(POLY_CMD);
6809        break;
6810      }
6811      case INT_CMD:
6812      {
6813        number n=nInit((int)(long)h->Data());
6814        if (!nIsZero(n))
6815        {
6816          p=pNSet(n);
6817        }
6818        else
6819        {
6820          p=NULL;
6821          nDelete(&n);
6822        }
6823        break;
6824      }
6825      case BIGINT_CMD:
6826      {
6827        number b=(number)h->Data();
6828        number n=n_Init_bigint(b,coeffs_BIGINT,currRing->cf);
6829        if (!nIsZero(n))
6830        {
6831          p=pNSet(n);
6832        }
6833        else
6834        {
6835          p=NULL;
6836          nDelete(&n);
6837        }
6838        break;
6839      }
6840      case NUMBER_CMD:
6841      {
6842        number n=(number)h->CopyD(NUMBER_CMD);
6843        if (!nIsZero(n))
6844        {
6845          p=pNSet(n);
6846        }
6847        else
6848        {
6849          p=NULL;
6850          nDelete(&n);
6851        }
6852        break;
6853      }
6854      case VECTOR_CMD:
6855      {
6856        p=(poly)h->CopyD(VECTOR_CMD);
6857        if (iiOp!=MODUL_CMD)
6858        {
6859          idDelete(&id);
6860          pDelete(&p);
6861          return TRUE;
6862        }
6863        rank=si_max(rank,(int)pMaxComp(p));
6864        break;
6865      }
6866      default:
6867      {
6868        idDelete(&id);
6869        return TRUE;
6870      }
6871    }
6872    if ((iiOp==MODUL_CMD)&&(p!=NULL)&&(pGetComp(p)==0))
6873    {
6874      pSetCompP(p,1);
6875    }
6876    id->m[i]=p;
6877    i++;
6878    h=h->next;
6879  }
6880  id->rank=rank;
6881  res->data=(char *)id;
6882  return FALSE;
6883}
6884static BOOLEAN jjINTERSECT_PL(leftv res, leftv v)
6885{
6886  leftv h=v;
6887  int l=v->listLength();
6888  resolvente r=(resolvente)omAlloc0(l*sizeof(ideal));
6889  BOOLEAN *copied=(BOOLEAN *)omAlloc0(l*sizeof(BOOLEAN));
6890  int t=0;
6891  // try to convert to IDEAL_CMD
6892  while (h!=NULL)
6893  {
6894    if (iiTestConvert(h->Typ(),IDEAL_CMD)!=0)
6895    {
6896      t=IDEAL_CMD;
6897    }
6898    else break;
6899    h=h->next;
6900  }
6901  // if failure, try MODUL_CMD
6902  if (t==0)
6903  {
6904    h=v;
6905    while (h!=NULL)
6906    {
6907      if (iiTestConvert(h->Typ(),MODUL_CMD)!=0)
6908      {
6909        t=MODUL_CMD;
6910      }
6911      else break;
6912      h=h->next;
6913    }
6914  }
6915  // check for success  in converting
6916  if (t==0)
6917  {
6918    WerrorS("cannot convert to ideal or module");
6919    return TRUE;
6920  }
6921  // call idMultSect
6922  h=v;
6923  int i=0;
6924  sleftv tmp;
6925  while (h!=NULL)
6926  {
6927    if (h->Typ()==t)
6928    {
6929      r[i]=(ideal)h->Data(); /*no copy*/
6930      h=h->next;
6931    }
6932    else if(iiConvert(h->Typ(),t,iiTestConvert(h->Typ(),t),h,&tmp))
6933    {
6934      omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
6935      omFreeSize((ADDRESS)r,l*sizeof(ideal));
6936      Werror("cannot convert arg. %d to %s",i+1,Tok2Cmdname(t));
6937      return TRUE;
6938    }
6939    else
6940    {
6941      r[i]=(ideal)tmp.Data(); /*now it's a copy*/
6942      copied[i]=TRUE;
6943      h=tmp.next;
6944    }
6945    i++;
6946  }
6947  res->rtyp=t;
6948  res->data=(char *)idMultSect(r,i);
6949  while(i>0)
6950  {
6951    i--;
6952    if (copied[i]) idDelete(&(r[i]));
6953  }
6954  omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
6955  omFreeSize((ADDRESS)r,l*sizeof(ideal));
6956  return FALSE;
6957}
6958static BOOLEAN jjLU_INVERSE(leftv res, leftv v)
6959{
6960  /* computation of the inverse of a quadratic matrix A
6961     using the L-U-decomposition of A;
6962     There are two valid parametrisations:
6963     1) exactly one argument which is just the matrix A,
6964     2) exactly three arguments P, L, U which already
6965        realise the L-U-decomposition of A, that is,
6966        P * A = L * U, and P, L, and U satisfy the
6967        properties decribed in method 'jjLU_DECOMP';
6968        see there;
6969     If A is invertible, the list [1, A^(-1)] is returned,
6970     otherwise the list [0] is returned. Thus, the user may
6971     inspect the first entry of the returned list to see
6972     whether A is invertible. */
6973  matrix iMat; int invertible;
6974  if (v->next == NULL)
6975  {
6976    if (v->Typ() != MATRIX_CMD)
6977    {
6978      Werror("expected either one or three matrices");
6979      return TRUE;
6980    }
6981    else
6982    {
6983      matrix aMat = (matrix)v->Data();
6984      int rr = aMat->rows();
6985      int cc = aMat->cols();
6986      if (rr != cc)
6987      {
6988        Werror("given matrix (%d x %d) is not quadratic, hence not invertible", rr, cc);
6989        return TRUE;
6990      }
6991      if (!idIsConstant((ideal)aMat))
6992      {
6993        WerrorS("matrix must be constant");
6994        return TRUE;
6995      }
6996      invertible = luInverse(aMat, iMat);
6997    }
6998  }
6999  else if ((v->Typ() == MATRIX_CMD) &&
7000           (v->next->Typ() == MATRIX_CMD) &&
7001           (v->next->next != NULL) &&
7002           (v->next->next->Typ() == MATRIX_CMD) &&
7003           (v->next->next->next == NULL))
7004  {
7005     matrix pMat = (matrix)v->Data();
7006     matrix lMat = (matrix)v->next->Data();
7007     matrix uMat = (matrix)v->next->next->Data();
7008     int rr = uMat->rows();
7009     int cc = uMat->cols();
7010     if (rr != cc)
7011     {
7012       Werror("third matrix (%d x %d) is not quadratic, hence not invertible",
7013              rr, cc);
7014       return TRUE;
7015     }
7016      if (!idIsConstant((ideal)pMat)
7017      || (!idIsConstant((ideal)lMat))
7018      || (!idIsConstant((ideal)uMat))
7019      )
7020      {
7021        WerrorS("matricesx must be constant");
7022        return TRUE;
7023      }
7024     invertible = luInverseFromLUDecomp(pMat, lMat, uMat, iMat);
7025  }
7026  else
7027  {
7028    Werror("expected either one or three matrices");
7029    return TRUE;
7030  }
7031
7032  /* build the return structure; a list with either one or two entries */
7033  lists ll = (lists)omAllocBin(slists_bin);
7034  if (invertible)
7035  {
7036    ll->Init(2);
7037    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)invertible;
7038    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)iMat;
7039  }
7040  else
7041  {
7042    ll->Init(1);
7043    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)invertible;
7044  }
7045
7046  res->data=(char*)ll;
7047  return FALSE;
7048}
7049static BOOLEAN jjLU_SOLVE(leftv res, leftv v)
7050{
7051  /* for solving a linear equation system A * x = b, via the
7052     given LU-decomposition of the matrix A;
7053     There is one valid parametrisation:
7054     1) exactly four arguments P, L, U, b;
7055        P, L, and U realise the L-U-decomposition of A, that is,
7056        P * A = L * U, and P, L, and U satisfy the
7057        properties decribed in method 'jjLU_DECOMP';
7058        see there;
7059        b is the right-hand side vector of the equation system;
7060     The method will return a list of either 1 entry or three entries:
7061     1) [0] if there is no solution to the system;
7062     2) [1, x, H] if there is at least one solution;
7063        x is any solution of the given linear system,
7064        H is the matrix with column vectors spanning the homogeneous
7065        solution space.
7066     The method produces an error if matrix and vector sizes do not fit. */
7067  if ((v == NULL) || (v->Typ() != MATRIX_CMD) ||
7068      (v->next == NULL) || (v->next->Typ() != MATRIX_CMD) ||
7069      (v->next->next == NULL) || (v->next->next->Typ() != MATRIX_CMD) ||
7070      (v->next->next->next == NULL) ||
7071      (v->next->next->next->Typ() != MATRIX_CMD) ||
7072      (v->next->next->next->next != NULL))
7073  {
7074    WerrorS("expected exactly three matrices and one vector as input");
7075    return TRUE;
7076  }
7077  matrix pMat = (matrix)v->Data();
7078  matrix lMat = (matrix)v->next->Data();
7079  matrix uMat = (matrix)v->next->next->Data();
7080  matrix bVec = (matrix)v->next->next->next->Data();
7081  matrix xVec; int solvable; matrix homogSolSpace;
7082  if (pMat->rows() != pMat->cols())
7083  {
7084    Werror("first matrix (%d x %d) is not quadratic",
7085           pMat->rows(), pMat->cols());
7086    return TRUE;
7087  }
7088  if (lMat->rows() != lMat->cols())
7089  {
7090    Werror("second matrix (%d x %d) is not quadratic",
7091           lMat->rows(), lMat->cols());
7092    return TRUE;
7093  }
7094  if (lMat->rows() != uMat->rows())
7095  {
7096    Werror("second matrix (%d x %d) and third matrix (%d x %d) do not fit",
7097           lMat->rows(), lMat->cols(), uMat->rows(), uMat->cols());
7098    return TRUE;
7099  }
7100  if (uMat->rows() != bVec->rows())
7101  {
7102    Werror("third matrix (%d x %d) and vector (%d x 1) do not fit",
7103           uMat->rows(), uMat->cols(), bVec->rows());
7104    return TRUE;
7105  }
7106  if (!idIsConstant((ideal)pMat)
7107  ||(!idIsConstant((ideal)lMat))
7108  ||(!idIsConstant((ideal)uMat))
7109  )
7110  {
7111    WerrorS("matrices must be constant");
7112    return TRUE;
7113  }
7114  solvable = luSolveViaLUDecomp(pMat, lMat, uMat, bVec, xVec, homogSolSpace);
7115
7116  /* build the return structure; a list with either one or three entries */
7117  lists ll = (lists)omAllocBin(slists_bin);
7118  if (solvable)
7119  {
7120    ll->Init(3);
7121    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
7122    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
7123    ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
7124  }
7125  else
7126  {
7127    ll->Init(1);
7128    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
7129  }
7130
7131  res->data=(char*)ll;
7132  return FALSE;
7133}
7134static BOOLEAN jjINTVEC_PL(leftv res, leftv v)
7135{
7136  int i=0;
7137  leftv h=v;
7138  if (h!=NULL) i=exprlist_length(h);
7139  intvec *iv=new intvec(i);
7140  i=0;
7141  while (h!=NULL)
7142  {
7143    if(h->Typ()==INT_CMD)
7144    {
7145      (*iv)[i]=(int)(long)h->Data();
7146    }
7147    else
7148    {
7149      delete iv;
7150      return TRUE;
7151    }
7152    i++;
7153    h=h->next;
7154  }
7155  res->data=(char *)iv;
7156  return FALSE;
7157}
7158static BOOLEAN jjJET4(leftv res, leftv u)
7159{
7160  leftv u1=u;
7161  leftv u2=u1->next;
7162  leftv u3=u2->next;
7163  leftv u4=u3->next;
7164  if((u2->Typ()==POLY_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
7165  &&((u1->Typ()==POLY_CMD)||(u1->Typ()==VECTOR_CMD)))
7166  {
7167    if(!pIsUnit((poly)u2->Data()))
7168    {
7169      WerrorS("2nd argument must be a unit");
7170      return TRUE;
7171    }
7172    res->rtyp=u1->Typ();
7173    res->data=(char*)pSeries((int)(long)u3->Data(),pCopy((poly)u1->Data()),
7174                             pCopy((poly)u2->Data()),(intvec*)u4->Data());
7175    return FALSE;
7176  }
7177  else
7178  if((u2->Typ()==MATRIX_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
7179  &&((u1->Typ()==IDEAL_CMD)||(u1->Typ()==MODUL_CMD)))
7180  {
7181    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7182    {
7183      WerrorS("2nd argument must be a diagonal matrix of units");
7184      return TRUE;
7185    }
7186    res->rtyp=u1->Typ();
7187    res->data=(char*)idSeries(
7188                              (int)(long)u3->Data(),
7189                              idCopy((ideal)u1->Data()),
7190                              mp_Copy((matrix)u2->Data(), currRing),
7191                              (intvec*)u4->Data()
7192                             );
7193    return FALSE;
7194  }
7195  else
7196  {
7197    Werror("%s(`poly`,`poly`,`int`,`intvec`) exppected",
7198           Tok2Cmdname(iiOp));
7199    return TRUE;
7200  }
7201}
7202static BOOLEAN jjKLAMMER_PL(leftv res, leftv u)
7203{
7204  if ((yyInRingConstruction)
7205  && ((strcmp(u->Name(),"real")==0) || (strcmp(u->Name(),"complex")==0)))
7206  {
7207    memcpy(res,u,sizeof(sleftv));
7208    memset(u,0,sizeof(sleftv));
7209    return FALSE;
7210  }
7211  leftv v=u->next;
7212  BOOLEAN b;
7213  if(v==NULL)
7214    b=iiExprArith1(res,u,iiOp);
7215  else
7216  {
7217    u->next=NULL;
7218    b=iiExprArith2(res,u,iiOp,v);
7219    u->next=v;
7220  }
7221  return b;
7222}
7223BOOLEAN jjLIST_PL(leftv res, leftv v)
7224{
7225  int sl=0;
7226  if (v!=NULL) sl = v->listLength();
7227  lists L;
7228  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7229  {
7230    int add_row_shift = 0;
7231    intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7232    if (weights!=NULL)  add_row_shift=weights->min_in();
7233    L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7234  }
7235  else
7236  {
7237    L=(lists)omAllocBin(slists_bin);
7238    leftv h=NULL;
7239    int i;
7240    int rt;
7241
7242    L->Init(sl);
7243    for (i=0;i<sl;i++)
7244    {
7245      if (h!=NULL)
7246      { /* e.g. not in the first step:
7247         * h is the pointer to the old sleftv,
7248         * v is the pointer to the next sleftv
7249         * (in this moment) */
7250         h->next=v;
7251      }
7252      h=v;
7253      v=v->next;
7254      h->next=NULL;
7255      rt=h->Typ();
7256      if (rt==0)
7257      {
7258        L->Clean();
7259        Werror("`%s` is undefined",h->Fullname());
7260        return TRUE;
7261      }
7262      if ((rt==RING_CMD)||(rt==QRING_CMD))
7263      {
7264        L->m[i].rtyp=rt;  L->m[i].data=h->Data();
7265        ((ring)L->m[i].data)->ref++;
7266      }
7267      else
7268        L->m[i].Copy(h);
7269    }
7270  }
7271  res->data=(char *)L;
7272  return FALSE;
7273}
7274static BOOLEAN jjNAMES0(leftv res, leftv)
7275{
7276  res->data=(void *)ipNameList(IDROOT);
7277  return FALSE;
7278}
7279static BOOLEAN jjOPTION_PL(leftv res, leftv v)
7280{
7281  if(v==NULL)
7282  {
7283    res->data=(char *)showOption();
7284    return FALSE;
7285  }
7286  res->rtyp=NONE;
7287  return setOption(res,v);
7288}
7289static BOOLEAN jjREDUCE4(leftv res, leftv u)
7290{
7291  leftv u1=u;
7292  leftv u2=u1->next;
7293  leftv u3=u2->next;
7294  leftv u4=u3->next;
7295  if((u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD))
7296  {
7297    int save_d=Kstd1_deg;
7298    Kstd1_deg=(int)(long)u3->Data();
7299    kModW=(intvec *)u4->Data();
7300    BITSET save2;
7301    SI_SAVE_OPT2(save2);
7302    si_opt_2|=Sy_bit(V_DEG_STOP);
7303    u2->next=NULL;
7304    BOOLEAN r=jjCALL2ARG(res,u);
7305    kModW=NULL;
7306    Kstd1_deg=save_d;
7307    SI_RESTORE_OPT2(save2);
7308    u->next->next=u3;
7309    return r;
7310  }
7311  else
7312  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7313     (u4->Typ()==INT_CMD))
7314  {
7315    assumeStdFlag(u3);
7316    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7317    {
7318      WerrorS("2nd argument must be a diagonal matrix of units");
7319      return TRUE;
7320    }
7321    res->rtyp=IDEAL_CMD;
7322    res->data=(char*)redNF(
7323                           idCopy((ideal)u3->Data()),
7324                           idCopy((ideal)u1->Data()),
7325                           mp_Copy((matrix)u2->Data(), currRing),
7326                           (int)(long)u4->Data()
7327                          );
7328    return FALSE;
7329  }
7330  else
7331  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7332     (u4->Typ()==INT_CMD))
7333  {
7334    assumeStdFlag(u3);
7335    if(!pIsUnit((poly)u2->Data()))
7336    {
7337      WerrorS("2nd argument must be a unit");
7338      return TRUE;
7339    }
7340    res->rtyp=POLY_CMD;
7341    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7342                           pCopy((poly)u2->Data()),(int)(long)u4->Data());
7343    return FALSE;
7344  }
7345  else
7346  {
7347    Werror("%s(`poly`,`ideal`,`int`,`intvec`) expected",Tok2Cmdname(iiOp));
7348    return TRUE;
7349  }
7350}
7351static BOOLEAN jjREDUCE5(leftv res, leftv u)
7352{
7353  leftv u1=u;
7354  leftv u2=u1->next;
7355  leftv u3=u2->next;
7356  leftv u4=u3->next;
7357  leftv u5=u4->next;
7358  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7359     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7360  {
7361    assumeStdFlag(u3);
7362    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7363    {
7364      WerrorS("2nd argument must be a diagonal matrix of units");
7365      return TRUE;
7366    }
7367    res->rtyp=IDEAL_CMD;
7368    res->data=(char*)redNF(
7369                           idCopy((ideal)u3->Data()),
7370                           idCopy((ideal)u1->Data()),
7371                           mp_Copy((matrix)u2->Data(),currRing),
7372                           (int)(long)u4->Data(),
7373                           (intvec*)u5->Data()
7374                          );
7375    return FALSE;
7376  }
7377  else
7378  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7379     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7380  {
7381    assumeStdFlag(u3);
7382    if(!pIsUnit((poly)u2->Data()))
7383    {
7384      WerrorS("2nd argument must be a unit");
7385      return TRUE;
7386    }
7387    res->rtyp=POLY_CMD;
7388    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7389                           pCopy((poly)u2->Data()),
7390                           (int)(long)u4->Data(),(intvec*)u5->Data());
7391    return FALSE;
7392  }
7393  else
7394  {
7395    Werror("%s(`ideal`,`ideal`,`matrix`,`int`,`intvec`) exppected",
7396           Tok2Cmdname(iiOp));
7397    return TRUE;
7398  }
7399}
7400static BOOLEAN jjRESERVED0(leftv, leftv)
7401{
7402  int i=1;
7403  int nCount = (sArithBase.nCmdUsed-1)/3;
7404  if((3*nCount)<sArithBase.nCmdUsed) nCount++;
7405  //Print("CMDS: %d/%d\n", sArithBase.nCmdUsed,
7406  //      sArithBase.nCmdAllocated);
7407  for(i=0; i<nCount; i++)
7408  {
7409    Print("%-20s",sArithBase.sCmds[i+1].name);
7410    if(i+1+nCount<sArithBase.nCmdUsed)
7411      Print("%-20s",sArithBase.sCmds[i+1+nCount].name);
7412    if(i+1+2*nCount<sArithBase.nCmdUsed)
7413      Print("%-20s",sArithBase.sCmds[i+1+2*nCount].name);
7414    //if ((i%3)==1) PrintLn();
7415    PrintLn();
7416  }
7417  PrintLn();
7418  printBlackboxTypes();
7419  return FALSE;
7420}
7421static BOOLEAN jjSTRING_PL(leftv res, leftv v)
7422{
7423  if (v == NULL)
7424  {
7425    res->data = omStrDup("");
7426    return FALSE;
7427  }
7428  int n = v->listLength();
7429  if (n == 1)
7430  {
7431    res->data = v->String();
7432    return FALSE;
7433  }
7434
7435  char** slist = (char**) omAlloc(n*sizeof(char*));
7436  int i, j;
7437
7438  for (i=0, j=0; i<n; i++, v = v ->next)
7439  {
7440    slist[i] = v->String();
7441    assume(slist[i] != NULL);
7442    j+=strlen(slist[i]);
7443  }
7444  char* s = (char*) omAlloc((j+1)*sizeof(char));
7445  *s='\0';
7446  for (i=0;i<n;i++)
7447  {
7448    strcat(s, slist[i]);
7449    omFree(slist[i]);
7450  }
7451  omFreeSize(slist, n*sizeof(char*));
7452  res->data = s;
7453  return FALSE;
7454}
7455static BOOLEAN jjTEST(leftv, leftv v)
7456{
7457  do
7458  {
7459    if (v->Typ()!=INT_CMD)
7460      return TRUE;
7461    test_cmd((int)(long)v->Data());
7462    v=v->next;
7463  }
7464  while (v!=NULL);
7465  return FALSE;
7466}
7467
7468#if defined(__alpha) && !defined(linux)
7469extern "C"
7470{
7471  void usleep(unsigned long usec);
7472};
7473#endif
7474static BOOLEAN jjFactModD_M(leftv res, leftv v)
7475{
7476  /* compute two factors of h(x,y) modulo x^(d+1) in K[[x]][y],
7477     see a detailed documentation in /kernel/linearAlgebra.h
7478
7479     valid argument lists:
7480     - (poly h, int d),
7481     - (poly h, int d, poly f0, poly g0),       optional: factors of h(0,y),
7482     - (poly h, int d, int xIndex, int yIndex), optional: indices of vars x & y
7483                                                          in list of ring vars,
7484     - (poly h, int d, poly f0, poly g0, int xIndex, int yIndec),
7485                                                optional: all 4 optional args
7486     (The defaults are xIndex = 1, yIndex = 2, f0 and g0 polynomials as found
7487      by singclap_factorize and h(0, y)
7488      has exactly two distinct monic factors [possibly with exponent > 1].)
7489     result:
7490     - list with the two factors f and g such that
7491       h(x,y) = f(x,y)*g(x,y) mod x^(d+1)   */
7492
7493  poly h      = NULL;
7494  int  d      =    1;
7495  poly f0     = NULL;
7496  poly g0     = NULL;
7497  int  xIndex =    1;   /* default index if none provided */
7498  int  yIndex =    2;   /* default index if none provided */
7499
7500  leftv u = v; int factorsGiven = 0;
7501  if ((u == NULL) || (u->Typ() != POLY_CMD))
7502  {
7503    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7504    return TRUE;
7505  }
7506  else h = (poly)u->Data();
7507  u = u->next;
7508  if ((u == NULL) || (u->Typ() != INT_CMD))
7509  {
7510    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7511    return TRUE;
7512  }
7513  else d = (int)(long)u->Data();
7514  u = u->next;
7515  if ((u != NULL) && (u->Typ() == POLY_CMD))
7516  {
7517    if ((u->next == NULL) || (u->next->Typ() != POLY_CMD))
7518    {
7519      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7520      return TRUE;
7521    }
7522    else
7523    {
7524      f0 = (poly)u->Data();
7525      g0 = (poly)u->next->Data();
7526      factorsGiven = 1;
7527      u = u->next->next;
7528    }
7529  }
7530  if ((u != NULL) && (u->Typ() == INT_CMD))
7531  {
7532    if ((u->next == NULL) || (u->next->Typ() != INT_CMD))
7533    {
7534      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7535      return TRUE;
7536    }
7537    else
7538    {
7539      xIndex = (int)(long)u->Data();
7540      yIndex = (int)(long)u->next->Data();
7541      u = u->next->next;
7542    }
7543  }
7544  if (u != NULL)
7545  {
7546    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7547    return TRUE;
7548  }
7549
7550  /* checks for provided arguments */
7551  if (pIsConstant(h) || (factorsGiven && (pIsConstant(f0) || pIsConstant(g0))))
7552  {
7553    WerrorS("expected non-constant polynomial argument(s)");
7554    return TRUE;
7555  }
7556  int n = rVar(currRing);
7557  if ((xIndex < 1) || (n < xIndex))
7558  {
7559    Werror("index for variable x (%d) out of range [1..%d]", xIndex, n);
7560    return TRUE;
7561  }
7562  if ((yIndex < 1) || (n < yIndex))
7563  {
7564    Werror("index for variable y (%d) out of range [1..%d]", yIndex, n);
7565    return TRUE;
7566  }
7567  if (xIndex == yIndex)
7568  {
7569    WerrorS("expected distinct indices for variables x and y");
7570    return TRUE;
7571  }
7572
7573  /* computation of f0 and g0 if missing */
7574  if (factorsGiven == 0)
7575  {
7576    poly h0 = pSubst(pCopy(h), xIndex, NULL);
7577    intvec* v = NULL;
7578    ideal i = singclap_factorize(h0, &v, 0,currRing);
7579
7580    ivTest(v);
7581
7582    if (i == NULL) return TRUE;
7583
7584    idTest(i);
7585
7586    if ((v->rows() != 3) || ((*v)[0] =! 1) || (!nIsOne(pGetCoeff(i->m[0]))))
7587    {
7588      WerrorS("expected h(0,y) to have exactly two distinct monic factors");
7589      return TRUE;
7590    }
7591    f0 = pPower(pCopy(i->m[1]), (*v)[1]);
7592    g0 = pPower(pCopy(i->m[2]), (*v)[2]);
7593    idDelete(&i);
7594  }
7595
7596  poly f; poly g;
7597  henselFactors(xIndex, yIndex, h, f0, g0, d, f, g);
7598  lists L = (lists)omAllocBin(slists_bin);
7599  L->Init(2);
7600  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
7601  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
7602  res->rtyp = LIST_CMD;
7603  res->data = (char*)L;
7604  return FALSE;
7605}
7606static BOOLEAN jjSTATUS_M(leftv res, leftv v)
7607{
7608  if ((v->Typ() != LINK_CMD) ||
7609      (v->next->Typ() != STRING_CMD) ||
7610      (v->next->next->Typ() != STRING_CMD) ||
7611      (v->next->next->next->Typ() != INT_CMD))
7612    return TRUE;
7613  jjSTATUS3(res, v, v->next, v->next->next);
7614#if defined(HAVE_USLEEP)
7615  if (((long) res->data) == 0L)
7616  {
7617    int i_s = (int)(long) v->next->next->next->Data();
7618    if (i_s > 0)
7619    {
7620      usleep((int)(long) v->next->next->next->Data());
7621      jjSTATUS3(res, v, v->next, v->next->next);
7622    }
7623  }
7624#elif defined(HAVE_SLEEP)
7625  if (((int) res->data) == 0)
7626  {
7627    int i_s = (int) v->next->next->next->Data();
7628    if (i_s > 0)
7629    {
7630      si_sleep((is - 1)/1000000 + 1);
7631      jjSTATUS3(res, v, v->next, v->next->next);
7632    }
7633  }
7634#endif
7635  return FALSE;
7636}
7637static BOOLEAN jjSUBST_M(leftv res, leftv u)
7638{
7639  leftv v = u->next; // number of args > 0
7640  if (v==NULL) return TRUE;
7641  leftv w = v->next;
7642  if (w==NULL) return TRUE;
7643  leftv rest = w->next;;
7644
7645  u->next = NULL;
7646  v->next = NULL;
7647  w->next = NULL;
7648  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
7649  if ((rest!=NULL) && (!b))
7650  {
7651    sleftv tmp_res;
7652    leftv tmp_next=res->next;
7653    res->next=rest;
7654    memset(&tmp_res,0,sizeof(tmp_res));
7655    b = iiExprArithM(&tmp_res,res,iiOp);
7656    memcpy(res,&tmp_res,sizeof(tmp_res));
7657    res->next=tmp_next;
7658  }
7659  u->next = v;
7660  v->next = w;
7661  // rest was w->next, but is already cleaned
7662  return b;
7663}
7664static BOOLEAN jjQRDS(leftv res, leftv INPUT)
7665{
7666  if ((INPUT->Typ() != MATRIX_CMD) ||
7667      (INPUT->next->Typ() != NUMBER_CMD) ||
7668      (INPUT->next->next->Typ() != NUMBER_CMD) ||
7669      (INPUT->next->next->next->Typ() != NUMBER_CMD))
7670  {
7671    WerrorS("expected (matrix, number, number, number) as arguments");
7672    return TRUE;
7673  }
7674  leftv u = INPUT; leftv v = u->next; leftv w = v->next; leftv x = w->next;
7675  res->data = (char *)qrDoubleShift((matrix)(u->Data()),
7676                                    (number)(v->Data()),
7677                                    (number)(w->Data()),
7678                                    (number)(x->Data()));
7679  return FALSE;
7680}
7681static BOOLEAN jjSTD_HILB_WP(leftv res, leftv INPUT)
7682{ ideal result;
7683  leftv u = INPUT;    /* an ideal, weighted homogeneous and standard */
7684  leftv v = u->next;  /* one additional polynomial or ideal */
7685  leftv h = v->next;  /* Hilbert vector */
7686  leftv w = h->next;  /* weight vector */
7687  assumeStdFlag(u);
7688  ideal i1=(ideal)(u->Data());
7689  ideal i0;
7690  if (((u->Typ()!=IDEAL_CMD)&&(u->Typ()!=MODUL_CMD))
7691  || (h->Typ()!=INTVEC_CMD)
7692  || (w->Typ()!=INTVEC_CMD))
7693  {
7694    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7695    return TRUE;
7696  }
7697  intvec *vw=(intvec *)w->Data(); // weights of vars
7698  /* merging std_hilb_w and std_1 */
7699  if (vw->length()!=currRing->N)
7700  {
7701    Werror("%d weights for %d variables",vw->length(),currRing->N);
7702    return TRUE;
7703  }
7704  int r=v->Typ();
7705  BOOLEAN cleanup_i0=FALSE;
7706  if ((r==POLY_CMD) ||(r==VECTOR_CMD))
7707  {
7708    i0=idInit(1,i1->rank);
7709    i0->m[0]=(poly)v->Data();
7710    cleanup_i0=TRUE;
7711  }
7712  else if (r==IDEAL_CMD)/* IDEAL */
7713  {
7714    i0=(ideal)v->Data();
7715  }
7716  else
7717  {
7718    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7719    return TRUE;
7720  }
7721  int ii0=idElem(i0);
7722  i1 = idSimpleAdd(i1,i0);
7723  if (cleanup_i0)
7724  {
7725    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
7726    idDelete(&i0);
7727  }
7728  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
7729  tHomog hom=testHomog;
7730  /* u_id from jjSTD_W is now i1 as in jjSTD_1 */
7731  if (ww!=NULL)
7732  {
7733    if (!idTestHomModule(i1,currQuotient,ww))
7734    {
7735      WarnS("wrong weights");
7736      ww=NULL;
7737    }
7738    else
7739    {
7740      ww=ivCopy(ww);
7741      hom=isHomog;
7742    }
7743  }
7744  BITSET save1;
7745  SI_SAVE_OPT1(save1);
7746  si_opt_1|=Sy_bit(OPT_SB_1);
7747  result=kStd(i1,
7748              currQuotient,
7749              hom,
7750              &ww,                  // module weights
7751              (intvec *)h->Data(),  // hilbert series
7752              0,                    // syzComp, whatever it is...
7753              IDELEMS(i1)-ii0,      // new ideal
7754              vw);                  // weights of vars
7755  SI_RESTORE_OPT1(save1);
7756  idDelete(&i1);
7757  idSkipZeroes(result);
7758  res->data = (char *)result;
7759  if (!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
7760  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
7761  return FALSE;
7762}
7763
7764
7765static Subexpr jjMakeSub(leftv e)
7766{
7767  assume( e->Typ()==INT_CMD );
7768  Subexpr r=(Subexpr)omAlloc0Bin(sSubexpr_bin);
7769  r->start =(int)(long)e->Data();
7770  return r;
7771}
7772#define D(A)    (A)
7773#define NULL_VAL NULL
7774#define IPARITH
7775#include "table.h"
7776
7777#include "iparith.inc"
7778
7779/*=================== operations with 2 args. ============================*/
7780/* must be ordered: first operations for chars (infix ops),
7781 * then alphabetically */
7782
7783BOOLEAN iiExprArith2(leftv res, leftv a, int op, leftv b, BOOLEAN proccall)
7784{
7785  memset(res,0,sizeof(sleftv));
7786  BOOLEAN call_failed=FALSE;
7787
7788  if (!errorreported)
7789  {
7790#ifdef SIQ
7791    if (siq>0)
7792    {
7793      //Print("siq:%d\n",siq);
7794      command d=(command)omAlloc0Bin(sip_command_bin);
7795      memcpy(&d->arg1,a,sizeof(sleftv));
7796      //a->Init();
7797      memcpy(&d->arg2,b,sizeof(sleftv));
7798      //b->Init();
7799      d->argc=2;
7800      d->op=op;
7801      res->data=(char *)d;
7802      res->rtyp=COMMAND;
7803      return FALSE;
7804    }
7805#endif
7806    int at=a->Typ();
7807    int bt=b->Typ();
7808    if (at>MAX_TOK)
7809    {
7810      blackbox *bb=getBlackboxStuff(at);
7811      if (bb!=NULL) return bb->blackbox_Op2(op,res,a,b);
7812      else          return TRUE;
7813    }
7814    else if ((bt>MAX_TOK)&&(op!='('))
7815    {
7816      blackbox *bb=getBlackboxStuff(bt);
7817      if (bb!=NULL) return bb->blackbox_Op2(op,res,a,b);
7818      else          return TRUE;
7819    }
7820    int i=iiTabIndex(dArithTab2,JJTAB2LEN,op);
7821    int index=i;
7822
7823    iiOp=op;
7824    while (dArith2[i].cmd==op)
7825    {
7826      if ((at==dArith2[i].arg1)
7827      && (bt==dArith2[i].arg2))
7828      {
7829        res->rtyp=dArith2[i].res;
7830        if (currRing!=NULL)
7831        {
7832          if (check_valid(dArith2[i].valid_for,op)) break;
7833        }
7834        if (traceit&TRACE_CALL)
7835          Print("call %s(%s,%s)\n",iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt));
7836        if ((call_failed=dArith2[i].p(res,a,b)))
7837        {
7838          break;// leave loop, goto error handling
7839        }
7840        a->CleanUp();
7841        b->CleanUp();
7842        //Print("op: %d,result typ:%d\n",op,res->rtyp);
7843        return FALSE;
7844      }
7845      i++;
7846    }
7847    // implicite type conversion ----------------------------------------------
7848    if (dArith2[i].cmd!=op)
7849    {
7850      int ai,bi;
7851      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7852      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
7853      BOOLEAN failed=FALSE;
7854      i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7855      //Print("op: %c, type: %s %s\n",op,Tok2Cmdname(at),Tok2Cmdname(bt));
7856      while (dArith2[i].cmd==op)
7857      {
7858        //Print("test %s %s\n",Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
7859        if ((ai=iiTestConvert(at,dArith2[i].arg1))!=0)
7860        {
7861          if ((bi=iiTestConvert(bt,dArith2[i].arg2))!=0)
7862          {
7863            res->rtyp=dArith2[i].res;
7864            if (currRing!=NULL)
7865            {
7866              if (check_valid(dArith2[i].valid_for,op)) break;
7867            }
7868            if (traceit&TRACE_CALL)
7869              Print("call %s(%s,%s)\n",iiTwoOps(op),
7870              Tok2Cmdname(an->rtyp),Tok2Cmdname(bn->rtyp));
7871            failed= ((iiConvert(at,dArith2[i].arg1,ai,a,an))
7872            || (iiConvert(bt,dArith2[i].arg2,bi,b,bn))
7873            || (call_failed=dArith2[i].p(res,an,bn)));
7874            // everything done, clean up temp. variables
7875            if (failed)
7876            {
7877              // leave loop, goto error handling
7878              break;
7879            }
7880            else
7881            {
7882              // everything ok, clean up and return
7883              an->CleanUp();
7884              bn->CleanUp();
7885              omFreeBin((ADDRESS)an, sleftv_bin);
7886              omFreeBin((ADDRESS)bn, sleftv_bin);
7887              a->CleanUp();
7888              b->CleanUp();
7889              return FALSE;
7890            }
7891          }
7892        }
7893        i++;
7894      }
7895      an->CleanUp();
7896      bn->CleanUp();
7897      omFreeBin((ADDRESS)an, sleftv_bin);
7898      omFreeBin((ADDRESS)bn, sleftv_bin);
7899    }
7900    // error handling ---------------------------------------------------
7901    const char *s=NULL;
7902    if (!errorreported)
7903    {
7904      if ((at==0) && (a->Fullname()!=sNoName))
7905      {
7906        s=a->Fullname();
7907      }
7908      else if ((bt==0) && (b->Fullname()!=sNoName))
7909      {
7910        s=b->Fullname();
7911      }
7912      if (s!=NULL)
7913        Werror("`%s` is not defined",s);
7914      else
7915      {
7916        i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7917        s = iiTwoOps(op);
7918        if (proccall)
7919        {
7920          Werror("%s(`%s`,`%s`) failed"
7921                ,s,Tok2Cmdname(at),Tok2Cmdname(bt));
7922        }
7923        else
7924        {
7925          Werror("`%s` %s `%s` failed"
7926                ,Tok2Cmdname(at),s,Tok2Cmdname(bt));
7927        }
7928        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
7929        {
7930          while (dArith2[i].cmd==op)
7931          {
7932            if(((at==dArith2[i].arg1)||(bt==dArith2[i].arg2))
7933            && (dArith2[i].res!=0)
7934            && (dArith2[i].p!=jjWRONG2))
7935            {
7936              if (proccall)
7937                Werror("expected %s(`%s`,`%s`)"
7938                  ,s,Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
7939              else
7940                Werror("expected `%s` %s `%s`"
7941                  ,Tok2Cmdname(dArith2[i].arg1),s,Tok2Cmdname(dArith2[i].arg2));
7942            }
7943            i++;
7944          }
7945        }
7946      }
7947    }
7948    res->rtyp = UNKNOWN;
7949  }
7950  a->CleanUp();
7951  b->CleanUp();
7952  return TRUE;
7953}
7954
7955/*==================== operations with 1 arg. ===============================*/
7956/* must be ordered: first operations for chars (infix ops),
7957 * then alphabetically */
7958
7959BOOLEAN iiExprArith1(leftv res, leftv a, int op)
7960{
7961  memset(res,0,sizeof(sleftv));
7962  BOOLEAN call_failed=FALSE;
7963
7964  if (!errorreported)
7965  {
7966#ifdef SIQ
7967    if (siq>0)
7968    {
7969      //Print("siq:%d\n",siq);
7970      command d=(command)omAlloc0Bin(sip_command_bin);
7971      memcpy(&d->arg1,a,sizeof(sleftv));
7972      //a->Init();
7973      d->op=op;
7974      d->argc=1;
7975      res->data=(char *)d;
7976      res->rtyp=COMMAND;
7977      return FALSE;
7978    }
7979#endif
7980    int at=a->Typ();
7981    if (at>MAX_TOK)
7982    {
7983      blackbox *bb=getBlackboxStuff(at);
7984      if (bb!=NULL) return bb->blackbox_Op1(op,res,a);
7985      else          return TRUE;
7986    }
7987
7988    BOOLEAN failed=FALSE;
7989    iiOp=op;
7990    int i=iiTabIndex(dArithTab1,JJTAB1LEN,op);
7991    int ti = i;
7992    while (dArith1[i].cmd==op)
7993    {
7994      if (at==dArith1[i].arg)
7995      {
7996        int r=res->rtyp=dArith1[i].res;
7997        if (currRing!=NULL)
7998        {
7999          if (check_valid(dArith1[i].valid_for,op)) break;
8000        }
8001        if (traceit&TRACE_CALL)
8002          Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
8003        if (r<0)
8004        {
8005          res->rtyp=-r;
8006          #ifdef PROC_BUG
8007          dArith1[i].p(res,a);
8008          #else
8009          res->data=(char *)((Proc1)dArith1[i].p)((char *)a->Data());
8010          #endif
8011        }
8012        else if ((call_failed=dArith1[i].p(res,a)))
8013        {
8014          break;// leave loop, goto error handling
8015        }
8016        if (a->Next()!=NULL)
8017        {
8018          res->next=(leftv)omAllocBin(sleftv_bin);
8019          failed=iiExprArith1(res->next,a->next,op);
8020        }
8021        a->CleanUp();
8022        return failed;
8023      }
8024      i++;
8025    }
8026    // implicite type conversion --------------------------------------------
8027    if (dArith1[i].cmd!=op)
8028    {
8029      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8030      i=ti;
8031      //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
8032      while (dArith1[i].cmd==op)
8033      {
8034        int ai;
8035        //Print("test %s\n",Tok2Cmdname(dArith1[i].arg));
8036        if ((ai=iiTestConvert(at,dArith1[i].arg))!=0)
8037        {
8038          int r=res->rtyp=dArith1[i].res;
8039          if (currRing!=NULL)
8040          {
8041            if (check_valid(dArith1[i].valid_for,op)) break;
8042          }
8043          if (r<0)
8044          {
8045            res->rtyp=-r;
8046            failed= iiConvert(at,dArith1[i].arg,ai,a,an);
8047            if (!failed)
8048            {
8049              #ifdef PROC_BUG
8050              dArith1[i].p(res,a);
8051              #else
8052              res->data=(char *)((Proc1)dArith1[i].p)((char *)an->Data());
8053              #endif
8054            }
8055          }
8056          else
8057          {
8058            failed= ((iiConvert(at,dArith1[i].arg,ai,a,an))
8059            || (call_failed=dArith1[i].p(res,an)));
8060          }
8061          // everything done, clean up temp. variables
8062          if (failed)
8063          {
8064            // leave loop, goto error handling
8065            break;
8066          }
8067          else
8068          {
8069            if (traceit&TRACE_CALL)
8070              Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(an->rtyp));
8071            if (an->Next() != NULL)
8072            {
8073              res->next = (leftv)omAllocBin(sleftv_bin);
8074              failed=iiExprArith1(res->next,an->next,op);
8075            }
8076            // everything ok, clean up and return
8077            an->CleanUp();
8078            omFreeBin((ADDRESS)an, sleftv_bin);
8079            a->CleanUp();
8080            return failed;
8081          }
8082        }
8083        i++;
8084      }
8085      an->CleanUp();
8086      omFreeBin((ADDRESS)an, sleftv_bin);
8087    }
8088    // error handling
8089    if (!errorreported)
8090    {
8091      if ((at==0) && (a->Fullname()!=sNoName))
8092      {
8093        Werror("`%s` is not defined",a->Fullname());
8094      }
8095      else
8096      {
8097        i=ti;
8098        const char *s = iiTwoOps(op);
8099        Werror("%s(`%s`) failed"
8100                ,s,Tok2Cmdname(at));
8101        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8102        {
8103          while (dArith1[i].cmd==op)
8104          {
8105            if ((dArith1[i].res!=0)
8106            && (dArith1[i].p!=jjWRONG))
8107              Werror("expected %s(`%s`)"
8108                ,s,Tok2Cmdname(dArith1[i].arg));
8109            i++;
8110          }
8111        }
8112      }
8113    }
8114    res->rtyp = UNKNOWN;
8115  }
8116  a->CleanUp();
8117  return TRUE;
8118}
8119
8120/*=================== operations with 3 args. ============================*/
8121/* must be ordered: first operations for chars (infix ops),
8122 * then alphabetically */
8123
8124BOOLEAN iiExprArith3(leftv res, int op, leftv a, leftv b, leftv c)
8125{
8126  memset(res,0,sizeof(sleftv));
8127  BOOLEAN call_failed=FALSE;
8128
8129  if (!errorreported)
8130  {
8131#ifdef SIQ
8132    if (siq>0)
8133    {
8134      //Print("siq:%d\n",siq);
8135      command d=(command)omAlloc0Bin(sip_command_bin);
8136      memcpy(&d->arg1,a,sizeof(sleftv));
8137      //a->Init();
8138      memcpy(&d->arg2,b,sizeof(sleftv));
8139      //b->Init();
8140      memcpy(&d->arg3,c,sizeof(sleftv));
8141      //c->Init();
8142      d->op=op;
8143      d->argc=3;
8144      res->data=(char *)d;
8145      res->rtyp=COMMAND;
8146      return FALSE;
8147    }
8148#endif
8149    int at=a->Typ();
8150    if (at>MAX_TOK)
8151    {
8152      blackbox *bb=getBlackboxStuff(at);
8153      if (bb!=NULL) return bb->blackbox_Op3(op,res,a,b,c);
8154      else          return TRUE;
8155    }
8156    int bt=b->Typ();
8157    int ct=c->Typ();
8158
8159    iiOp=op;
8160    int i=0;
8161    while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8162    while (dArith3[i].cmd==op)
8163    {
8164      if ((at==dArith3[i].arg1)
8165      && (bt==dArith3[i].arg2)
8166      && (ct==dArith3[i].arg3))
8167      {
8168        res->rtyp=dArith3[i].res;
8169        if (currRing!=NULL)
8170        {
8171          if (check_valid(dArith3[i].valid_for,op)) break;
8172        }
8173        if (traceit&TRACE_CALL)
8174          Print("call %s(%s,%s,%s)\n",
8175            iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8176        if ((call_failed=dArith3[i].p(res,a,b,c)))
8177        {
8178          break;// leave loop, goto error handling
8179        }
8180        a->CleanUp();
8181        b->CleanUp();
8182        c->CleanUp();
8183        return FALSE;
8184      }
8185      i++;
8186    }
8187    // implicite type conversion ----------------------------------------------
8188    if (dArith3[i].cmd!=op)
8189    {
8190      int ai,bi,ci;
8191      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8192      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
8193      leftv cn = (leftv)omAlloc0Bin(sleftv_bin);
8194      BOOLEAN failed=FALSE;
8195      i=0;
8196      while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8197      while (dArith3[i].cmd==op)
8198      {
8199        if ((ai=iiTestConvert(at,dArith3[i].arg1))!=0)
8200        {
8201          if ((bi=iiTestConvert(bt,dArith3[i].arg2))!=0)
8202          {
8203            if ((ci=iiTestConvert(ct,dArith3[i].arg3))!=0)
8204            {
8205              res->rtyp=dArith3[i].res;
8206              if (currRing!=NULL)
8207              {
8208                if (check_valid(dArith3[i].valid_for,op)) break;
8209              }
8210              if (traceit&TRACE_CALL)
8211                Print("call %s(%s,%s,%s)\n",
8212                  iiTwoOps(op),Tok2Cmdname(an->rtyp),
8213                  Tok2Cmdname(bn->rtyp),Tok2Cmdname(cn->rtyp));
8214              failed= ((iiConvert(at,dArith3[i].arg1,ai,a,an))
8215                || (iiConvert(bt,dArith3[i].arg2,bi,b,bn))
8216                || (iiConvert(ct,dArith3[i].arg3,ci,c,cn))
8217                || (call_failed=dArith3[i].p(res,an,bn,cn)));
8218              // everything done, clean up temp. variables
8219              if (failed)
8220              {
8221                // leave loop, goto error handling
8222                break;
8223              }
8224              else
8225              {
8226                // everything ok, clean up and return
8227                an->CleanUp();
8228                bn->CleanUp();
8229                cn->CleanUp();
8230                omFreeBin((ADDRESS)an, sleftv_bin);
8231                omFreeBin((ADDRESS)bn, sleftv_bin);
8232                omFreeBin((ADDRESS)cn, sleftv_bin);
8233                a->CleanUp();
8234                b->CleanUp();
8235                c->CleanUp();
8236        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8237                return FALSE;
8238              }
8239            }
8240          }
8241        }
8242        i++;
8243      }
8244      an->CleanUp();
8245      bn->CleanUp();
8246      cn->CleanUp();
8247      omFreeBin((ADDRESS)an, sleftv_bin);
8248      omFreeBin((ADDRESS)bn, sleftv_bin);
8249      omFreeBin((ADDRESS)cn, sleftv_bin);
8250    }
8251    // error handling ---------------------------------------------------
8252    if (!errorreported)
8253    {
8254      const char *s=NULL;
8255      if ((at==0) && (a->Fullname()!=sNoName))
8256      {
8257        s=a->Fullname();
8258      }
8259      else if ((bt==0) && (b->Fullname()!=sNoName))
8260      {
8261        s=b->Fullname();
8262      }
8263      else if ((ct==0) && (c->Fullname()!=sNoName))
8264      {
8265        s=c->Fullname();
8266      }
8267      if (s!=NULL)
8268        Werror("`%s` is not defined",s);
8269      else
8270      {
8271        i=0;
8272        while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8273        const char *s = iiTwoOps(op);
8274        Werror("%s(`%s`,`%s`,`%s`) failed"
8275                ,s,Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8276        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8277        {
8278          while (dArith3[i].cmd==op)
8279          {
8280            if(((at==dArith3[i].arg1)
8281            ||(bt==dArith3[i].arg2)
8282            ||(ct==dArith3[i].arg3))
8283            && (dArith3[i].res!=0))
8284            {
8285              Werror("expected %s(`%s`,`%s`,`%s`)"
8286                  ,s,Tok2Cmdname(dArith3[i].arg1)
8287                  ,Tok2Cmdname(dArith3[i].arg2)
8288                  ,Tok2Cmdname(dArith3[i].arg3));
8289            }
8290            i++;
8291          }
8292        }
8293      }
8294    }
8295    res->rtyp = UNKNOWN;
8296  }
8297  a->CleanUp();
8298  b->CleanUp();
8299  c->CleanUp();
8300        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8301  return TRUE;
8302}
8303/*==================== operations with many arg. ===============================*/
8304/* must be ordered: first operations for chars (infix ops),
8305 * then alphabetically */
8306
8307BOOLEAN jjANY2LIST(leftv res, leftv v, int cnt)
8308{
8309  // cnt = 0: all
8310  // cnt = 1: only first one
8311  leftv next;
8312  BOOLEAN failed = TRUE;
8313  if(v==NULL) return failed;
8314  res->rtyp = LIST_CMD;
8315  if(cnt) v->next = NULL;
8316  next = v->next;             // saving next-pointer
8317  failed = jjLIST_PL(res, v);
8318  v->next = next;             // writeback next-pointer
8319  return failed;
8320}
8321
8322BOOLEAN iiExprArithM(leftv res, leftv a, int op)
8323{
8324  memset(res,0,sizeof(sleftv));
8325
8326  if (!errorreported)
8327  {
8328#ifdef SIQ
8329    if (siq>0)
8330    {
8331      //Print("siq:%d\n",siq);
8332      command d=(command)omAlloc0Bin(sip_command_bin);
8333      d->op=op;
8334      res->data=(char *)d;
8335      if (a!=NULL)
8336      {
8337        d->argc=a->listLength();
8338        // else : d->argc=0;
8339        memcpy(&d->arg1,a,sizeof(sleftv));
8340        switch(d->argc)
8341        {
8342          case 3:
8343            memcpy(&d->arg3,a->next->next,sizeof(sleftv));
8344            a->next->next->Init();
8345            /* no break */
8346          case 2:
8347            memcpy(&d->arg2,a->next,sizeof(sleftv));
8348            a->next->Init();
8349            a->next->next=d->arg2.next;
8350            d->arg2.next=NULL;
8351            /* no break */
8352          case 1:
8353            a->Init();
8354            a->next=d->arg1.next;
8355            d->arg1.next=NULL;
8356        }
8357        if (d->argc>3) a->next=NULL;
8358        a->name=NULL;
8359        a->rtyp=0;
8360        a->data=NULL;
8361        a->e=NULL;
8362        a->attribute=NULL;
8363        a->CleanUp();
8364      }
8365      res->rtyp=COMMAND;
8366      return FALSE;
8367    }
8368#endif
8369    if ((a!=NULL) && (a->Typ()>MAX_TOK))
8370    {
8371      blackbox *bb=getBlackboxStuff(a->Typ());
8372      if (bb!=NULL) return bb->blackbox_OpM(op,res,a);
8373      else          return TRUE;
8374    }
8375    BOOLEAN failed=FALSE;
8376    int args=0;
8377    if (a!=NULL) args=a->listLength();
8378
8379    iiOp=op;
8380    int i=0;
8381    while ((dArithM[i].cmd!=op)&&(dArithM[i].cmd!=0)) i++;
8382    while (dArithM[i].cmd==op)
8383    {
8384      if ((args==dArithM[i].number_of_args)
8385      || (dArithM[i].number_of_args==-1)
8386      || ((dArithM[i].number_of_args==-2)&&(args>0)))
8387      {
8388        res->rtyp=dArithM[i].res;
8389        if (currRing!=NULL)
8390        {
8391          if (check_valid(dArithM[i].valid_for,op)) break;
8392        }
8393        if (traceit&TRACE_CALL)
8394          Print("call %s(... (%d args))\n", iiTwoOps(op),args);
8395        if (dArithM[i].p(res,a))
8396        {
8397          break;// leave loop, goto error handling
8398        }
8399        if (a!=NULL) a->CleanUp();
8400        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8401        return failed;
8402      }
8403      i++;
8404    }
8405    // error handling
8406    if (!errorreported)
8407    {
8408      if ((args>0) && (a->rtyp==0) && (a->Name()!=sNoName))
8409      {
8410        Werror("`%s` is not defined",a->Fullname());
8411      }
8412      else
8413      {
8414        const char *s = iiTwoOps(op);
8415        Werror("%s(...) failed",s);
8416      }
8417    }
8418    res->rtyp = UNKNOWN;
8419  }
8420  if (a!=NULL) a->CleanUp();
8421        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8422  return TRUE;
8423}
8424
8425/*=================== general utilities ============================*/
8426int IsCmd(const char *n, int & tok)
8427{
8428  int i;
8429  int an=1;
8430  int en=sArithBase.nLastIdentifier;
8431
8432  loop
8433  //for(an=0; an<sArithBase.nCmdUsed; )
8434  {
8435    if(an>=en-1)
8436    {
8437      if (strcmp(n, sArithBase.sCmds[an].name) == 0)
8438      {
8439        i=an;
8440        break;
8441      }
8442      else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
8443      {
8444        i=en;
8445        break;
8446      }
8447      else
8448      {
8449        // -- blackbox extensions:
8450        // return 0;
8451        return blackboxIsCmd(n,tok);
8452      }
8453    }
8454    i=(an+en)/2;
8455    if (*n < *(sArithBase.sCmds[i].name))
8456    {
8457      en=i-1;
8458    }
8459    else if (*n > *(sArithBase.sCmds[i].name))
8460    {
8461      an=i+1;
8462    }
8463    else
8464    {
8465      int v=strcmp(n,sArithBase.sCmds[i].name);
8466      if(v<0)
8467      {
8468        en=i-1;
8469      }
8470      else if(v>0)
8471      {
8472        an=i+1;
8473      }
8474      else /*v==0*/
8475      {
8476        break;
8477      }
8478    }
8479  }
8480  lastreserved=sArithBase.sCmds[i].name;
8481  tok=sArithBase.sCmds[i].tokval;
8482  if(sArithBase.sCmds[i].alias==2)
8483  {
8484    Warn("outdated identifier `%s` used - please change your code",
8485    sArithBase.sCmds[i].name);
8486    sArithBase.sCmds[i].alias=1;
8487  }
8488  if (currRingHdl==NULL)
8489  {
8490    #ifdef SIQ
8491    if (siq<=0)
8492    {
8493    #endif
8494      if ((tok>=BEGIN_RING) && (tok<=END_RING))
8495      {
8496        WerrorS("no ring active");
8497        return 0;
8498      }
8499    #ifdef SIQ
8500    }
8501    #endif
8502  }
8503  if (!expected_parms)
8504  {
8505    switch (tok)
8506    {
8507      case IDEAL_CMD:
8508      case INT_CMD:
8509      case INTVEC_CMD:
8510      case MAP_CMD:
8511      case MATRIX_CMD:
8512      case MODUL_CMD:
8513      case POLY_CMD:
8514      case PROC_CMD:
8515      case RING_CMD:
8516      case STRING_CMD:
8517        cmdtok = tok;
8518        break;
8519    }
8520  }
8521  return sArithBase.sCmds[i].toktype;
8522}
8523static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op)
8524{
8525  // user defined types are not in the pre-computed table:
8526  if (op>MAX_TOK) return 0;
8527
8528  int a=0;
8529  int e=len;
8530  int p=len/2;
8531  do
8532  {
8533     if (op==dArithTab[p].cmd) return dArithTab[p].start;
8534     if (op<dArithTab[p].cmd) e=p-1;
8535     else   a = p+1;
8536     p=a+(e-a)/2;
8537  }
8538  while ( a <= e);
8539
8540  // catch missing a cmd:
8541  assume(0);
8542  return 0;
8543}
8544
8545const char * Tok2Cmdname(int tok)
8546{
8547  int i = 0;
8548  if (tok <= 0)
8549  {
8550    return sArithBase.sCmds[0].name;
8551  }
8552  if (tok==ANY_TYPE) return "any_type";
8553  if (tok==COMMAND) return "command";
8554  if (tok==NONE) return "nothing";
8555  //if (tok==IFBREAK) return "if_break";
8556  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
8557  //if (tok==ORDER_VECTOR) return "ordering";
8558  //if (tok==REF_VAR) return "ref";
8559  //if (tok==OBJECT) return "object";
8560  //if (tok==PRINT_EXPR) return "print_expr";
8561  if (tok==IDHDL) return "identifier";
8562  if (tok>MAX_TOK) return getBlackboxName(tok);
8563  for(i=0; i<sArithBase.nCmdUsed; i++)
8564    //while (sArithBase.sCmds[i].tokval!=0)
8565  {
8566    if ((sArithBase.sCmds[i].tokval == tok)&&
8567        (sArithBase.sCmds[i].alias==0))
8568    {
8569      return sArithBase.sCmds[i].name;
8570    }
8571  }
8572  return sArithBase.sCmds[0].name;
8573}
8574
8575
8576/*---------------------------------------------------------------------*/
8577/**
8578 * @brief compares to entry of cmdsname-list
8579
8580 @param[in] a
8581 @param[in] b
8582
8583 @return <ReturnValue>
8584**/
8585/*---------------------------------------------------------------------*/
8586static int _gentable_sort_cmds( const void *a, const void *b )
8587{
8588  cmdnames *pCmdL = (cmdnames*)a;
8589  cmdnames *pCmdR = (cmdnames*)b;
8590
8591  if(a==NULL || b==NULL)             return 0;
8592
8593  /* empty entries goes to the end of the list for later reuse */
8594  if(pCmdL->name==NULL) return 1;
8595  if(pCmdR->name==NULL) return -1;
8596
8597  /* $INVALID$ must come first */
8598  if(strcmp(pCmdL->name, "$INVALID$")==0) return -1;
8599  if(strcmp(pCmdR->name, "$INVALID$")==0) return  1;
8600
8601  /* tokval=-1 are reserved names at the end */
8602  if (pCmdL->tokval==-1)
8603  {
8604    if (pCmdR->tokval==-1)
8605       return strcmp(pCmdL->name, pCmdR->name);
8606    /* pCmdL->tokval==-1, pCmdL goes at the end */
8607    return 1;
8608  }
8609  /* pCmdR->tokval==-1, pCmdR goes at the end */
8610  if(pCmdR->tokval==-1) return -1;
8611
8612  return strcmp(pCmdL->name, pCmdR->name);
8613}
8614
8615/*---------------------------------------------------------------------*/
8616/**
8617 * @brief initialisation of arithmetic structured data
8618
8619 @retval 0 on success
8620
8621**/
8622/*---------------------------------------------------------------------*/
8623int iiInitArithmetic()
8624{
8625  //printf("iiInitArithmetic()\n");
8626  memset(&sArithBase, 0, sizeof(sArithBase));
8627  iiInitCmdName();
8628  /* fix last-identifier */
8629#if 0
8630  /* we expect that gentable allready did every thing */
8631  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8632      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--) {
8633    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8634  }
8635#endif
8636  //Print("L=%d\n", sArithBase.nLastIdentifier);
8637
8638  //iiArithAddCmd(szName, nAlias, nTokval, nToktype);
8639  //iiArithAddCmd("mygcd", 1, GCD_CMD, CMD_2);
8640
8641  //iiArithAddCmd("Top", 0,-1,0);
8642
8643
8644  //for(i=0; i<sArithBase.nCmdUsed; i++) {
8645  //  printf("CMD[%03d] %s, %d, %d, %d\n", i,
8646  //         sArithBase.sCmds[i].name,
8647  //         sArithBase.sCmds[i].alias,
8648  //         sArithBase.sCmds[i].tokval,
8649  //         sArithBase.sCmds[i].toktype);
8650  //}
8651  //iiArithRemoveCmd("Top");
8652  //iiArithAddCmd("mygcd", 2, GCD_CMD, CMD_2);
8653  //iiArithRemoveCmd("mygcd");
8654  //iiArithAddCmd("kkk", 1, 1234, CMD_1);
8655  return 0;
8656}
8657
8658int iiArithFindCmd(const char *szName)
8659{
8660  int an=0;
8661  int i = 0,v = 0;
8662  int en=sArithBase.nLastIdentifier;
8663
8664  loop
8665  //for(an=0; an<sArithBase.nCmdUsed; )
8666  {
8667    if(an>=en-1)
8668    {
8669      if (strcmp(szName, sArithBase.sCmds[an].name) == 0)
8670      {
8671        //Print("RET-an=%d %s\n", an, sArithBase.sCmds[an].name);
8672        return an;
8673      }
8674      else if (strcmp(szName, sArithBase.sCmds[en].name) == 0)
8675      {
8676        //Print("RET-en=%d %s\n", en, sArithBase.sCmds[en].name);
8677        return en;
8678      }
8679      else
8680      {
8681        //Print("RET- 1\n");
8682        return -1;
8683      }
8684    }
8685    i=(an+en)/2;
8686    if (*szName < *(sArithBase.sCmds[i].name))
8687    {
8688      en=i-1;
8689    }
8690    else if (*szName > *(sArithBase.sCmds[i].name))
8691    {
8692      an=i+1;
8693    }
8694    else
8695    {
8696      v=strcmp(szName,sArithBase.sCmds[i].name);
8697      if(v<0)
8698      {
8699        en=i-1;
8700      }
8701      else if(v>0)
8702      {
8703        an=i+1;
8704      }
8705      else /*v==0*/
8706      {
8707        //Print("RET-i=%d %s\n", i, sArithBase.sCmds[i].name);
8708        return i;
8709      }
8710    }
8711  }
8712  //if(i>=0 && i<sArithBase.nCmdUsed)
8713  //  return i;
8714  //Print("RET-2\n");
8715  return -2;
8716}
8717
8718char *iiArithGetCmd( int nPos )
8719{
8720  if(nPos<0) return NULL;
8721  if(nPos<sArithBase.nCmdUsed)
8722    return sArithBase.sCmds[nPos].name;
8723  return NULL;
8724}
8725
8726int iiArithRemoveCmd(const char *szName)
8727{
8728  int nIndex;
8729  if(szName==NULL) return -1;
8730
8731  nIndex = iiArithFindCmd(szName);
8732  if(nIndex<0 || nIndex>=sArithBase.nCmdUsed)
8733  {
8734    Print("'%s' not found (%d)\n", szName, nIndex);
8735    return -1;
8736  }
8737  omFree(sArithBase.sCmds[nIndex].name);
8738  sArithBase.sCmds[nIndex].name=NULL;
8739  qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
8740        (&_gentable_sort_cmds));
8741  sArithBase.nCmdUsed--;
8742
8743  /* fix last-identifier */
8744  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8745      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
8746  {
8747    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8748  }
8749  //Print("L=%d\n", sArithBase.nLastIdentifier);
8750  return 0;
8751}
8752
8753int iiArithAddCmd(
8754  const char *szName,
8755  short nAlias,
8756  short nTokval,
8757  short nToktype,
8758  short nPos
8759  )
8760{
8761  //printf("AddCmd(%s, %d, %d, %d, %d)\n", szName, nAlias,
8762  //       nTokval, nToktype, nPos);
8763  if(nPos>=0)
8764  {
8765    // no checks: we rely on a correct generated code in iparith.inc
8766    assume(nPos < sArithBase.nCmdAllocated);
8767    assume(szName!=NULL);
8768    sArithBase.sCmds[nPos].name    = omStrDup(szName);
8769    sArithBase.sCmds[nPos].alias   = nAlias;
8770    sArithBase.sCmds[nPos].tokval  = nTokval;
8771    sArithBase.sCmds[nPos].toktype = nToktype;
8772    sArithBase.nCmdUsed++;
8773    //if(nTokval>0) sArithBase.nLastIdentifier++;
8774  }
8775  else
8776  {
8777    if(szName==NULL) return -1;
8778    int nIndex = iiArithFindCmd(szName);
8779    if(nIndex>=0)
8780    {
8781      Print("'%s' already exists at %d\n", szName, nIndex);
8782      return -1;
8783    }
8784
8785    if(sArithBase.nCmdUsed>=sArithBase.nCmdAllocated)
8786    {
8787      /* needs to create new slots */
8788      unsigned long nSize = (sArithBase.nCmdAllocated+1)*sizeof(cmdnames);
8789      sArithBase.sCmds = (cmdnames *)omRealloc(sArithBase.sCmds, nSize);
8790      if(sArithBase.sCmds==NULL) return -1;
8791      sArithBase.nCmdAllocated++;
8792    }
8793    /* still free slots available */
8794    sArithBase.sCmds[sArithBase.nCmdUsed].name    = omStrDup(szName);
8795    sArithBase.sCmds[sArithBase.nCmdUsed].alias   = nAlias;
8796    sArithBase.sCmds[sArithBase.nCmdUsed].tokval  = nTokval;
8797    sArithBase.sCmds[sArithBase.nCmdUsed].toktype = nToktype;
8798    sArithBase.nCmdUsed++;
8799
8800    qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
8801          (&_gentable_sort_cmds));
8802    for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8803        sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
8804    {
8805      if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8806    }
8807    //Print("L=%d\n", sArithBase.nLastIdentifier);
8808  }
8809  return 0;
8810}
8811
8812static BOOLEAN check_valid(const int p, const int op)
8813{
8814  #ifdef HAVE_PLURAL
8815  if (rIsPluralRing(currRing))
8816  {
8817    if ((p & PLURAL_MASK)==0 /*NO_PLURAL*/)
8818    {
8819      WerrorS("not implemented for non-commutative rings");
8820      return TRUE;
8821    }
8822    else if ((p & PLURAL_MASK)==2 /*, COMM_PLURAL */)
8823    {
8824      Warn("assume commutative subalgebra for cmd `%s`",Tok2Cmdname(op));
8825      return FALSE;
8826    }
8827    /* else, ALLOW_PLURAL */
8828  }
8829  #endif
8830  #ifdef HAVE_RINGS
8831  if (rField_is_Ring(currRing))
8832  {
8833    if ((p & RING_MASK)==0 /*NO_RING*/)
8834    {
8835      WerrorS("not implemented for rings with rings as coeffients");
8836      return TRUE;
8837    }
8838    /* else ALLOW_RING */
8839    else if (((p & ZERODIVISOR_MASK)==NO_ZERODIVISOR)
8840    &&(!rField_is_Domain(currRing)))
8841    {
8842      WerrorS("domain required as coeffients");
8843      return TRUE;
8844    }
8845    /* else ALLOW_ZERODIVISOR */
8846    else if(((p & WARN_RING)==WARN_RING)&&(myynest==0))
8847    {
8848      WarnS("considering the image in Q[...]");
8849    }
8850  }
8851  #endif
8852  return FALSE;
8853}
Note: See TracBrowser for help on using the repository browser.