source: git/Singular/iparith.cc @ 72a01e

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