source: git/Singular/iparith.cc @ ec89bb4

spielwiese
Last change on this file since ec89bb4 was ec89bb4, checked in by Hans Schoenemann <hannes@…>, 10 years ago
chg: nNeg -> nInpNeg, also n_InpNeg, cfInpNeg
  • Property mode set to 100644
File size: 219.5 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#include <misc/sirandom.h>
29
30#include <polys/prCopy.h>
31#include <polys/matpol.h>
32#include <polys/monomials/maps.h>
33#include <polys/coeffrings.h>
34#include <polys/sparsmat.h>
35#include <Singular/mod_lib.h>
36#include <polys/weight.h>
37#include <polys/ext_fields/transext.h>
38#  include <polys/clapsing.h>
39
40#include <kernel/GBEngine/stairc.h>
41#include <kernel/polys.h>
42#include <Singular/fevoices.h>
43#include <kernel/ideals.h>
44#include <kernel/GBEngine/kstd1.h>
45#include <kernel/oswrapper/timer.h>
46#include <kernel/preimage.h>
47#include <kernel/GBEngine/units.h>
48#include <kernel/spectrum/GMPrat.h>
49#include <kernel/GBEngine/tgb.h>
50#include <kernel/groebner_walk/walkProc.h>
51#include <kernel/linear_algebra/linearAlgebra.h>
52#include <kernel/GBEngine/syz.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_Div((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(currRing->qideal==NULL)
1984    res->data = (char *)((long)scDimInt((ideal)(v->Data()),(ideal)w->Data()));
1985  else
1986  {
1987    ideal q=idSimpleAdd(currRing->qideal,(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,currRing->qideal);
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,currRing->qideal);
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,currRing->qideal,&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                    currRing->qideal);
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()),currRing->qideal, 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,currRing->qideal,w_v))
2649       || (!idTestHomModule(v_id,currRing->qideal,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(),currRing->qideal,(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,currRing->qideal,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 (currRing->qideal!=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,currRing->qideal,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,currRing->qideal,&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((currRing->qideal!=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((currRing->qideal!=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((currRing->qideal!=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 (currRing->qideal!=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,currRing->qideal,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((currRing->qideal!=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((currRing->qideal!=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((currRing->qideal!=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,currRing->qideal,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,currRing->qideal,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,currRing->qideal,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,currRing->qideal,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_InpNeg(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=nInpNeg(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,currRing->qideal);
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,currRing->qideal);
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, currRing->qideal);
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()),currRing->qideal);
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,currRing->qideal);
4183    hLookSeries(vv,module_w,currRing->qideal);
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(),currRing->qideal);
4193  hLookSeries((ideal)v->Data(),module_w,currRing->qideal);
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,currRing->qideal,&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,currRing->qideal,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()),currRing->qideal);
4308  return FALSE;
4309}
4310static BOOLEAN jjINTERRED(leftv res, leftv v)
4311{
4312  ideal result=kInterRed((ideal)(v->Data()), currRing->qideal);
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()),currRing->qideal);
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(),currRing->qideal,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()),currRing->qideal);
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,currRing->qideal,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 ((currRing->qideal!=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,currRing->qideal,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,currRing->qideal,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,currRing->qideal,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,currRing->qideal,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,currRing->qideal,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,currRing->qideal,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,currRing->qideal,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,currRing->qideal,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,currRing->qideal,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,currRing->qideal,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(),currRing->qideal);
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