source: git/Singular/iparith.cc @ dc4782

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