source: git/Singular/iparith.cc @ 73f3ca7

spielwiese
Last change on this file since 73f3ca7 was 73f3ca7, checked in by Hans Schoenemann <hannes@…>, 9 years ago
chg: table interface for iiAddCproc: 1 arg
  • Property mode set to 100644
File size: 217.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/combinatorics/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#ifdef SINGULAR_4_1
74#include <Singular/number2.h>
75#endif
76
77#  include <Singular/fglm.h>
78
79#include <Singular/blackbox.h>
80#include <Singular/newstruct.h>
81#include <Singular/ipshell.h>
82//#include <kernel/mpr_inout.h>
83
84#include <reporter/si_signals.h>
85
86
87#include <stdlib.h>
88#include <string.h>
89#include <ctype.h>
90#include <stdio.h>
91#include <time.h>
92#include <unistd.h>
93#include <vector>
94
95lists rDecompose(const ring r);
96ring rCompose(const lists  L, const BOOLEAN check_comp=TRUE);
97
98
99// defaults for all commands: NO_PLURAL | NO_RING | ALLOW_ZERODIVISOR
100
101#ifdef HAVE_PLURAL
102  #include <kernel/GBEngine/ratgring.h>
103  #include <kernel/GBEngine/nc.h>
104  #include <polys/nc/nc.h>
105  #include <polys/nc/sca.h>
106  #define ALLOW_PLURAL     1
107  #define NO_PLURAL        0
108  #define COMM_PLURAL      2
109  #define  PLURAL_MASK 3
110#else /* HAVE_PLURAL */
111  #define ALLOW_PLURAL     0
112  #define NO_PLURAL        0
113  #define COMM_PLURAL      0
114  #define  PLURAL_MASK     0
115#endif /* HAVE_PLURAL */
116
117#ifdef HAVE_RINGS
118  #define RING_MASK        4
119  #define ZERODIVISOR_MASK 8
120#else
121  #define RING_MASK        0
122  #define ZERODIVISOR_MASK 0
123#endif
124#define ALLOW_RING       4
125#define NO_RING          0
126#define NO_ZERODIVISOR   8
127#define ALLOW_ZERODIVISOR  0
128
129// bit 4 for warning, if used at toplevel
130#define WARN_RING        16
131
132static BOOLEAN check_valid(const int p, const int op);
133
134#ifdef SINGULAR_4_1
135// helper routine to catch all library/test parts which need to be changed
136// shall go away after the transition
137static void iiReWrite(const char *s)
138{
139  Print("please rewrite the use of >>%s<< in >>%s<<\n"
140        "%s is depreciated or changed in Singular 4-1\n",s,my_yylinebuf,s);
141}
142#endif
143
144/*=============== types =====================*/
145struct sValCmdTab
146{
147  short cmd;
148  short start;
149};
150
151typedef sValCmdTab jjValCmdTab[];
152
153struct _scmdnames
154{
155  char *name;
156  short alias;
157  short tokval;
158  short toktype;
159};
160typedef struct _scmdnames cmdnames;
161
162
163typedef char * (*Proc1)(char *);
164struct sValCmd1
165{
166  proc1 p;
167  short cmd;
168  short res;
169  short arg;
170  short valid_for;
171};
172
173typedef BOOLEAN (*proc2)(leftv,leftv,leftv);
174struct sValCmd2
175{
176  proc2 p;
177  short cmd;
178  short res;
179  short arg1;
180  short arg2;
181  short valid_for;
182};
183
184typedef BOOLEAN (*proc3)(leftv,leftv,leftv,leftv);
185struct sValCmd3
186{
187  proc3 p;
188  short cmd;
189  short res;
190  short arg1;
191  short arg2;
192  short arg3;
193  short valid_for;
194};
195struct sValCmdM
196{
197  proc1 p;
198  short cmd;
199  short res;
200  short number_of_args; /* -1: any, -2: any >0, .. */
201  short valid_for;
202};
203
204typedef struct
205{
206  cmdnames *sCmds;             /**< array of existing commands */
207  struct sValCmd1 *psValCmd1;
208  struct sValCmd2 *psValCmd2;
209  struct sValCmd3 *psValCmd3;
210  struct sValCmdM *psValCmdM;
211  int nCmdUsed;      /**< number of commands used */
212  int nCmdAllocated; /**< number of commands-slots allocated */
213  int nLastIdentifier; /**< valid indentifieres are slot 1..nLastIdentifier */
214} SArithBase;
215
216/*---------------------------------------------------------------------*
217 * File scope Variables (Variables share by several functions in
218 *                       the same file )
219 *
220 *---------------------------------------------------------------------*/
221static SArithBase sArithBase;  /**< Base entry for arithmetic */
222
223/*---------------------------------------------------------------------*
224 * Extern Functions declarations
225 *
226 *---------------------------------------------------------------------*/
227static int _gentable_sort_cmds(const void *a, const void *b);
228extern int iiArithRemoveCmd(char *szName);
229extern int iiArithAddCmd(const char *szName, short nAlias, short nTokval,
230                         short nToktype, short nPos=-1);
231
232/*============= proc =======================*/
233static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op);
234static Subexpr jjMakeSub(leftv e);
235
236/*============= vars ======================*/
237extern int cmdtok;
238extern BOOLEAN expected_parms;
239
240#define ii_div_by_0 "div. by 0"
241
242int iiOp; /* the current operation*/
243
244/*=================== simple helpers =================*/
245poly pHeadProc(poly p)
246{
247  return pHead(p);
248}
249
250int iiTokType(int op)
251{
252  for (int i=0;i<sArithBase.nCmdUsed;i++)
253  {
254    if (sArithBase.sCmds[i].tokval==op)
255      return sArithBase.sCmds[i].toktype;
256  }
257  return 0;
258}
259
260/*=================== operations with 2 args.: static proc =================*/
261/* must be ordered: first operations for chars (infix ops),
262 * then alphabetically */
263
264static BOOLEAN jjOP_BIM_I(leftv res, leftv u, leftv v)
265{
266  bigintmat* aa= (bigintmat *)u->Data();
267  int bb = (int)(long)(v->Data());
268  if (errorreported) return TRUE;
269  bigintmat *cc=NULL;
270  switch (iiOp)
271  {
272    case '+': cc=bimAdd(aa,bb); break;
273    case '-': cc=bimSub(aa,bb); break;
274    case '*': cc=bimMult(aa,bb); break;
275  }
276  res->data=(char *)cc;
277  return cc==NULL;
278}
279static BOOLEAN jjOP_I_BIM(leftv res, leftv u, leftv v)
280{
281  return jjOP_BIM_I(res, v, u);
282}
283static BOOLEAN jjOP_BIM_BI(leftv res, leftv u, leftv v)
284{
285  bigintmat* aa= (bigintmat *)u->Data();
286  number bb = (number)(v->Data());
287  if (errorreported) return TRUE;
288  bigintmat *cc=NULL;
289  switch (iiOp)
290  {
291    case '*': cc=bimMult(aa,bb,coeffs_BIGINT); break;
292  }
293  res->data=(char *)cc;
294  return cc==NULL;
295}
296static BOOLEAN jjOP_BI_BIM(leftv res, leftv u, leftv v)
297{
298  return jjOP_BIM_BI(res, v, u);
299}
300static BOOLEAN jjOP_IV_I(leftv res, leftv u, leftv v)
301{
302  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
303  int bb = (int)(long)(v->Data());
304  if (errorreported) return TRUE;
305  switch (iiOp)
306  {
307    case '+': (*aa) += bb; break;
308    case '-': (*aa) -= bb; break;
309    case '*': (*aa) *= bb; break;
310    case '/':
311    case INTDIV_CMD: (*aa) /= bb; break;
312    case '%': (*aa) %= bb; break;
313  }
314  res->data=(char *)aa;
315  return FALSE;
316}
317static BOOLEAN jjOP_I_IV(leftv res, leftv u, leftv v)
318{
319  return jjOP_IV_I(res,v,u);
320}
321static BOOLEAN jjOP_IM_I(leftv res, leftv u, leftv v)
322{
323  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
324  int bb = (int)(long)(v->Data());
325  int i=si_min(aa->rows(),aa->cols());
326  switch (iiOp)
327  {
328    case '+': for (;i>0;i--) IMATELEM(*aa,i,i) += bb;
329              break;
330    case '-': for (;i>0;i--) IMATELEM(*aa,i,i) -= bb;
331              break;
332  }
333  res->data=(char *)aa;
334  return FALSE;
335}
336static BOOLEAN jjOP_I_IM(leftv res, leftv u, leftv v)
337{
338  return jjOP_IM_I(res,v,u);
339}
340static BOOLEAN jjCOLON(leftv res, leftv u, leftv v)
341{
342  int l=(int)(long)v->Data();
343  if (l>0)
344  {
345    int d=(int)(long)u->Data();
346    intvec *vv=new intvec(l);
347    int i;
348    for(i=l-1;i>=0;i--) { (*vv)[i]=d; }
349    res->data=(char *)vv;
350  }
351  return (l<=0);
352}
353static BOOLEAN jjDOTDOT(leftv res, leftv u, leftv v)
354{
355  res->data=(char *)new intvec((int)(long)u->Data(),(int)(long)v->Data());
356  return FALSE;
357}
358static void jjEQUAL_REST(leftv res,leftv u,leftv v);
359static BOOLEAN jjCOMPARE_IV(leftv res, leftv u, leftv v)
360{
361  intvec*    a = (intvec * )(u->Data());
362  intvec*    b = (intvec * )(v->Data());
363  int r=a->compare(b);
364  switch  (iiOp)
365  {
366    case '<':
367      res->data  = (char *) (r<0);
368      break;
369    case '>':
370      res->data  = (char *) (r>0);
371      break;
372    case LE:
373      res->data  = (char *) (r<=0);
374      break;
375    case GE:
376      res->data  = (char *) (r>=0);
377      break;
378    case EQUAL_EQUAL:
379    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
380      res->data  = (char *) (r==0);
381      break;
382  }
383  jjEQUAL_REST(res,u,v);
384  if(r==-2) { WerrorS("size incompatible"); return TRUE; }
385  return FALSE;
386}
387static BOOLEAN jjCOMPARE_BIM(leftv res, leftv u, leftv v)
388{
389  bigintmat*    a = (bigintmat * )(u->Data());
390  bigintmat*    b = (bigintmat * )(v->Data());
391  int r=a->compare(b);
392  switch  (iiOp)
393  {
394    case '<':
395      res->data  = (char *) (r<0);
396      break;
397    case '>':
398      res->data  = (char *) (r>0);
399      break;
400    case LE:
401      res->data  = (char *) (r<=0);
402      break;
403    case GE:
404      res->data  = (char *) (r>=0);
405      break;
406    case EQUAL_EQUAL:
407    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
408      res->data  = (char *) (r==0);
409      break;
410  }
411  jjEQUAL_REST(res,u,v);
412  if(r==-2) { WerrorS("size incompatible"); return TRUE; }
413  return FALSE;
414}
415static BOOLEAN jjCOMPARE_IV_I(leftv res, leftv u, leftv v)
416{
417  intvec* a = (intvec * )(u->Data());
418  int     b = (int)(long)(v->Data());
419  int r=a->compare(b);
420  switch  (iiOp)
421  {
422    case '<':
423      res->data  = (char *) (r<0);
424      break;
425    case '>':
426      res->data  = (char *) (r>0);
427      break;
428    case LE:
429      res->data  = (char *) (r<=0);
430      break;
431    case GE:
432      res->data  = (char *) (r>=0);
433      break;
434    case EQUAL_EQUAL:
435    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
436      res->data  = (char *) (r==0);
437      break;
438  }
439  jjEQUAL_REST(res,u,v);
440  return FALSE;
441}
442static BOOLEAN jjCOMPARE_P(leftv res, leftv u, leftv v)
443{
444  poly p=(poly)u->Data();
445  poly q=(poly)v->Data();
446  int r=pCmp(p,q);
447  if (r==0)
448  {
449    number h=nSub(pGetCoeff(p),pGetCoeff(q));
450    /* compare lead coeffs */
451    r = -1+nIsZero(h)+2*nGreaterZero(h); /* -1: <, 0:==, 1: > */
452    nDelete(&h);
453  }
454  else if (p==NULL)
455  {
456    if (q==NULL)
457    {
458      /* compare 0, 0 */
459      r=0;
460    }
461    else if(pIsConstant(q))
462    {
463      /* compare 0, const */
464      r = 1-2*nGreaterZero(pGetCoeff(q)); /* -1: <, 1: > */
465    }
466  }
467  else if (q==NULL)
468  {
469    if (pIsConstant(p))
470    {
471      /* compare const, 0 */
472      r = -1+2*nGreaterZero(pGetCoeff(p)); /* -1: <, 1: > */
473    }
474  }
475  switch  (iiOp)
476  {
477    case '<':
478      res->data  = (char *) (r < 0);
479      break;
480    case '>':
481      res->data  = (char *) (r > 0);
482      break;
483    case LE:
484      res->data  = (char *) (r <= 0);
485      break;
486    case GE:
487      res->data  = (char *) (r >= 0);
488      break;
489    //case EQUAL_EQUAL:
490    //case NOTEQUAL: /* negation handled by jjEQUAL_REST */
491    //  res->data  = (char *) (r == 0);
492    //  break;
493  }
494  jjEQUAL_REST(res,u,v);
495  return FALSE;
496}
497static BOOLEAN jjCOMPARE_S(leftv res, leftv u, leftv v)
498{
499  char*    a = (char * )(u->Data());
500  char*    b = (char * )(v->Data());
501  int result = strcmp(a,b);
502  switch  (iiOp)
503  {
504    case '<':
505      res->data  = (char *) (result  < 0);
506      break;
507    case '>':
508      res->data  = (char *) (result  > 0);
509      break;
510    case LE:
511      res->data  = (char *) (result  <= 0);
512      break;
513    case GE:
514      res->data  = (char *) (result  >= 0);
515      break;
516    case EQUAL_EQUAL:
517    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
518      res->data  = (char *) (result  == 0);
519      break;
520  }
521  jjEQUAL_REST(res,u,v);
522  return FALSE;
523}
524static BOOLEAN jjOP_REST(leftv res, leftv u, leftv v)
525{
526  if (u->Next()!=NULL)
527  {
528    u=u->next;
529    res->next = (leftv)omAllocBin(sleftv_bin);
530    return iiExprArith2(res->next,u,iiOp,v);
531  }
532  else if (v->Next()!=NULL)
533  {
534    v=v->next;
535    res->next = (leftv)omAllocBin(sleftv_bin);
536    return iiExprArith2(res->next,u,iiOp,v);
537  }
538  return FALSE;
539}
540static BOOLEAN jjPOWER_I(leftv res, leftv u, leftv v)
541{
542  int b=(int)(long)u->Data();
543  int e=(int)(long)v->Data();
544  int rc = 1;
545  BOOLEAN overflow=FALSE;
546  if (e >= 0)
547  {
548    if (b==0)
549    {
550      rc=(e==0);
551    }
552    else if ((e==0)||(b==1))
553    {
554      rc= 1;
555    }
556    else if (b== -1)
557    {
558      if (e&1) rc= -1;
559      else     rc= 1;
560    }
561    else
562    {
563      int oldrc;
564      while ((e--)!=0)
565      {
566        oldrc=rc;
567        rc *= b;
568        if (!overflow)
569        {
570          if(rc/b!=oldrc) overflow=TRUE;
571        }
572      }
573      if (overflow)
574        WarnS("int overflow(^), result may be wrong");
575    }
576    res->data = (char *)((long)rc);
577    if (u!=NULL) return jjOP_REST(res,u,v);
578    return FALSE;
579  }
580  else
581  {
582    WerrorS("exponent must be non-negative");
583    return TRUE;
584  }
585}
586static BOOLEAN jjPOWER_BI(leftv res, leftv u, leftv v)
587{
588  int e=(int)(long)v->Data();
589  number n=(number)u->Data();
590  if (e>=0)
591  {
592    n_Power(n,e,(number*)&res->data,coeffs_BIGINT);
593  }
594  else
595  {
596    WerrorS("exponent must be non-negative");
597    return TRUE;
598  }
599  if (u!=NULL) return jjOP_REST(res,u,v);
600  return FALSE;
601}
602static BOOLEAN jjPOWER_N(leftv res, leftv u, leftv v)
603{
604  int e=(int)(long)v->Data();
605  number n=(number)u->Data();
606  int d=0;
607  if (e<0)
608  {
609    n=nInvers(n);
610    e=-e;
611    d=1;
612  }
613  number r;
614  nPower(n,e,(number*)&r);
615  res->data=(char*)r;
616  if (d) nDelete(&n);
617  if (u!=NULL) return jjOP_REST(res,u,v);
618  return FALSE;
619}
620static BOOLEAN jjPOWER_P(leftv res, leftv u, leftv v)
621{
622  int v_i=(int)(long)v->Data();
623  if (v_i<0)
624  {
625    WerrorS("exponent must be non-negative");
626    return TRUE;
627  }
628  poly u_p=(poly)u->CopyD(POLY_CMD);
629  if ((u_p!=NULL)
630  && ((v_i!=0) &&
631      ((long)pTotaldegree(u_p) > (signed long)currRing->bitmask / (signed long)v_i/2)))
632  {
633    Werror("OVERFLOW in power(d=%ld, e=%d, max=%ld)",
634                                    pTotaldegree(u_p),v_i,currRing->bitmask/2);
635    pDelete(&u_p);
636    return TRUE;
637  }
638  res->data = (char *)pPower(u_p,v_i);
639  if (u!=NULL) return jjOP_REST(res,u,v);
640  return errorreported; /* pPower may set errorreported via Werror */
641}
642static BOOLEAN jjPOWER_ID(leftv res, leftv u, leftv v)
643{
644  res->data = (char *)id_Power((ideal)(u->Data()),(int)(long)(v->Data()), currRing);
645  if (u!=NULL) return jjOP_REST(res,u,v);
646  return FALSE;
647}
648static BOOLEAN jjPLUSMINUS_Gen(leftv res, leftv u, leftv v)
649{
650  u=u->next;
651  v=v->next;
652  if (u==NULL)
653  {
654    if (v==NULL) return FALSE;      /* u==NULL, v==NULL */
655    if (iiOp=='-')                  /* u==NULL, v<>NULL, iiOp=='-'*/
656    {
657      do
658      {
659        if (res->next==NULL)
660          res->next = (leftv)omAlloc0Bin(sleftv_bin);
661        leftv tmp_v=v->next;
662        v->next=NULL;
663        BOOLEAN b=iiExprArith1(res->next,v,'-');
664        v->next=tmp_v;
665        if (b)
666          return TRUE;
667        v=tmp_v;
668        res=res->next;
669      } while (v!=NULL);
670      return FALSE;
671    }
672    loop                            /* u==NULL, v<>NULL, iiOp=='+' */
673    {
674      res->next = (leftv)omAlloc0Bin(sleftv_bin);
675      res=res->next;
676      res->data = v->CopyD();
677      res->rtyp = v->Typ();
678      v=v->next;
679      if (v==NULL) return FALSE;
680    }
681  }
682  if (v!=NULL)                     /* u<>NULL, v<>NULL */
683  {
684    do
685    {
686      res->next = (leftv)omAlloc0Bin(sleftv_bin);
687      leftv tmp_u=u->next; u->next=NULL;
688      leftv tmp_v=v->next; v->next=NULL;
689      BOOLEAN b=iiExprArith2(res->next,u,iiOp,v);
690      u->next=tmp_u;
691      v->next=tmp_v;
692      if (b)
693        return TRUE;
694      u=tmp_u;
695      v=tmp_v;
696      res=res->next;
697    } while ((u!=NULL) && (v!=NULL));
698    return FALSE;
699  }
700  loop                             /* u<>NULL, v==NULL */
701  {
702    res->next = (leftv)omAlloc0Bin(sleftv_bin);
703    res=res->next;
704    res->data = u->CopyD();
705    res->rtyp = u->Typ();
706    u=u->next;
707    if (u==NULL) return FALSE;
708  }
709}
710static BOOLEAN jjCOLCOL(leftv res, leftv u, leftv v)
711{
712  idhdl packhdl;
713  switch(u->Typ())
714  {
715      case 0:
716      {
717        int name_err=0;
718        if(isupper(u->name[0]))
719        {
720          const char *c=u->name+1;
721          while((*c!='\0')&&(islower(*c)||(isdigit(*c)))) c++;
722          if (*c!='\0')
723            name_err=1;
724          else
725          {
726            Print("%s of type 'ANY'. Trying load.\n", u->name);
727            if(iiTryLoadLib(u, u->name))
728            {
729              Werror("'%s' no such package", u->name);
730              return TRUE;
731            }
732            syMake(u,u->name,NULL);
733          }
734        }
735        else name_err=1;
736        if(name_err)
737        { Werror("'%s' is an invalid package name",u->name);return TRUE;}
738        // and now, after the loading: use next case !!! no break !!!
739      }
740      case PACKAGE_CMD:
741        packhdl = (idhdl)u->data;
742        if((!IDPACKAGE(packhdl)->loaded)
743        && (IDPACKAGE(packhdl)->language > LANG_TOP))
744        {
745          Werror("'%s' not loaded", u->name);
746          return TRUE;
747        }
748        if(v->rtyp == IDHDL)
749        {
750          v->name = omStrDup(v->name);
751        }
752        v->req_packhdl=IDPACKAGE(packhdl);
753        syMake(v, v->name, packhdl);
754        memcpy(res, v, sizeof(sleftv));
755        memset(v, 0, sizeof(sleftv));
756        break;
757      case DEF_CMD:
758        break;
759      default:
760        WerrorS("<package>::<id> expected");
761        return TRUE;
762  }
763  return FALSE;
764}
765static BOOLEAN jjPLUS_I(leftv res, leftv u, leftv v)
766{
767  unsigned int a=(unsigned int)(unsigned long)u->Data();
768  unsigned int b=(unsigned int)(unsigned long)v->Data();
769  unsigned int c=a+b;
770  res->data = (char *)((long)c);
771  if (((Sy_bit(31)&a)==(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
772  {
773    WarnS("int overflow(+), result may be wrong");
774  }
775  return jjPLUSMINUS_Gen(res,u,v);
776}
777static BOOLEAN jjPLUS_BI(leftv res, leftv u, leftv v)
778{
779  res->data = (char *)(n_Add((number)u->Data(), (number)v->Data(),coeffs_BIGINT));
780  return jjPLUSMINUS_Gen(res,u,v);
781}
782static BOOLEAN jjPLUS_N(leftv res, leftv u, leftv v)
783{
784  res->data = (char *)(nAdd((number)u->Data(), (number)v->Data()));
785  return jjPLUSMINUS_Gen(res,u,v);
786}
787static BOOLEAN jjPLUS_P(leftv res, leftv u, leftv v)
788{
789  res->data = (char *)(pAdd((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
790  return jjPLUSMINUS_Gen(res,u,v);
791}
792static BOOLEAN jjPLUS_IV(leftv res, leftv u, leftv v)
793{
794  res->data = (char *)ivAdd((intvec*)(u->Data()), (intvec*)(v->Data()));
795  if (res->data==NULL)
796  {
797     WerrorS("intmat size not compatible");
798     return TRUE;
799  }
800  return jjPLUSMINUS_Gen(res,u,v);
801}
802static BOOLEAN jjPLUS_BIM(leftv res, leftv u, leftv v)
803{
804  res->data = (char *)bimAdd((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
805  if (res->data==NULL)
806  {
807    WerrorS("bigintmat/cmatrix not compatible");
808    return TRUE;
809  }
810  return jjPLUSMINUS_Gen(res,u,v);
811}
812static BOOLEAN jjPLUS_MA(leftv res, leftv u, leftv v)
813{
814  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
815  res->data = (char *)(mp_Add(A , B, currRing));
816  if (res->data==NULL)
817  {
818     Werror("matrix size not compatible(%dx%d, %dx%d)",
819             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
820     return TRUE;
821  }
822  return jjPLUSMINUS_Gen(res,u,v);
823}
824static BOOLEAN jjPLUS_MA_P(leftv res, leftv u, leftv v)
825{
826  matrix m=(matrix)u->Data();
827  matrix p= mp_InitP(m->nrows,m->ncols,(poly)(v->CopyD(POLY_CMD)),currRing);
828  if (iiOp=='+')
829    res->data = (char *)mp_Add(m , p,currRing);
830  else
831    res->data = (char *)mp_Sub(m , p,currRing);
832  idDelete((ideal *)&p);
833  return jjPLUSMINUS_Gen(res,u,v);
834}
835static BOOLEAN jjPLUS_P_MA(leftv res, leftv u, leftv v)
836{
837  return jjPLUS_MA_P(res,v,u);
838}
839static BOOLEAN jjPLUS_S(leftv res, leftv u, leftv v)
840{
841  char*    a = (char * )(u->Data());
842  char*    b = (char * )(v->Data());
843  char*    r = (char * )omAlloc(strlen(a) + strlen(b) + 1);
844  strcpy(r,a);
845  strcat(r,b);
846  res->data=r;
847  return jjPLUSMINUS_Gen(res,u,v);
848}
849static BOOLEAN jjPLUS_ID(leftv res, leftv u, leftv v)
850{
851  res->data = (char *)idAdd((ideal)u->Data(),(ideal)v->Data());
852  return jjPLUSMINUS_Gen(res,u,v);
853}
854static BOOLEAN jjMINUS_I(leftv res, leftv u, leftv v)
855{
856  void *ap=u->Data(); void *bp=v->Data();
857  int aa=(int)(long)ap;
858  int bb=(int)(long)bp;
859  int cc=aa-bb;
860  unsigned int a=(unsigned int)(unsigned long)ap;
861  unsigned int b=(unsigned int)(unsigned long)bp;
862  unsigned int c=a-b;
863  if (((Sy_bit(31)&a)!=(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
864  {
865    WarnS("int overflow(-), result may be wrong");
866  }
867  res->data = (char *)((long)cc);
868  return jjPLUSMINUS_Gen(res,u,v);
869}
870static BOOLEAN jjMINUS_BI(leftv res, leftv u, leftv v)
871{
872  res->data = (char *)(n_Sub((number)u->Data(), (number)v->Data(),coeffs_BIGINT));
873  return jjPLUSMINUS_Gen(res,u,v);
874}
875static BOOLEAN jjMINUS_N(leftv res, leftv u, leftv v)
876{
877  res->data = (char *)(nSub((number)u->Data(), (number)v->Data()));
878  return jjPLUSMINUS_Gen(res,u,v);
879}
880static BOOLEAN jjMINUS_P(leftv res, leftv u, leftv v)
881{
882  res->data = (char *)(pSub((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
883  return jjPLUSMINUS_Gen(res,u,v);
884}
885static BOOLEAN jjMINUS_IV(leftv res, leftv u, leftv v)
886{
887  res->data = (char *)ivSub((intvec*)(u->Data()), (intvec*)(v->Data()));
888  if (res->data==NULL)
889  {
890     WerrorS("intmat size not compatible");
891     return TRUE;
892  }
893  return jjPLUSMINUS_Gen(res,u,v);
894}
895static BOOLEAN jjMINUS_BIM(leftv res, leftv u, leftv v)
896{
897  res->data = (char *)bimSub((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
898  if (res->data==NULL)
899  {
900    WerrorS("bigintmat/cmatrix not compatible");
901    return TRUE;
902  }
903  return jjPLUSMINUS_Gen(res,u,v);
904}
905static BOOLEAN jjMINUS_MA(leftv res, leftv u, leftv v)
906{
907  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
908  res->data = (char *)(mp_Sub(A , B, currRing));
909  if (res->data==NULL)
910  {
911     Werror("matrix size not compatible(%dx%d, %dx%d)",
912             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
913     return TRUE;
914  }
915  return jjPLUSMINUS_Gen(res,u,v);
916  return FALSE;
917}
918static BOOLEAN jjTIMES_I(leftv res, leftv u, leftv v)
919{
920  int a=(int)(long)u->Data();
921  int b=(int)(long)v->Data();
922  int64 c=(int64)a * (int64)b;
923  if ((c>INT_MAX)||(c<INT_MIN))
924    WarnS("int overflow(*), result may be wrong");
925  res->data = (char *)((long)((int)c));
926  if ((u->Next()!=NULL) || (v->Next()!=NULL))
927    return jjOP_REST(res,u,v);
928  return FALSE;
929}
930static BOOLEAN jjTIMES_BI(leftv res, leftv u, leftv v)
931{
932  res->data = (char *)(n_Mult( (number)u->Data(), (number)v->Data(),coeffs_BIGINT));
933  if ((v->next!=NULL) || (u->next!=NULL))
934    return jjOP_REST(res,u,v);
935  return FALSE;
936}
937static BOOLEAN jjTIMES_N(leftv res, leftv u, leftv v)
938{
939  res->data = (char *)(nMult( (number)u->Data(), (number)v->Data()));
940  number n=(number)res->data;
941  nNormalize(n);
942  res->data=(char *)n;
943  if ((v->next!=NULL) || (u->next!=NULL))
944    return jjOP_REST(res,u,v);
945  return FALSE;
946}
947static BOOLEAN jjTIMES_P(leftv res, leftv u, leftv v)
948{
949  poly a;
950  poly b;
951  if (v->next==NULL)
952  {
953    a=(poly)u->CopyD(POLY_CMD); // works also for VECTOR_CMD
954    if (u->next==NULL)
955    {
956      b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
957      if ((a!=NULL) && (b!=NULL)
958      && ((long)pTotaldegree(a)>si_max((long)rVar(currRing),(long)currRing->bitmask/2)-(long)pTotaldegree(b)))
959      {
960        Warn("possible OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
961          pTotaldegree(a),pTotaldegree(b),currRing->bitmask/2);
962      }
963      res->data = (char *)(pMult( a, b));
964      pNormalize((poly)res->data);
965      return FALSE;
966    }
967    // u->next exists: copy v
968    b=pCopy((poly)v->Data());
969    if ((a!=NULL) && (b!=NULL)
970    && (pTotaldegree(a)+pTotaldegree(b)>si_max((long)rVar(currRing),(long)currRing->bitmask/2)))
971    {
972      Warn("possible OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
973          pTotaldegree(a),pTotaldegree(b),currRing->bitmask/2);
974    }
975    res->data = (char *)(pMult( a, b));
976    pNormalize((poly)res->data);
977    return jjOP_REST(res,u,v);
978  }
979  // v->next exists: copy u
980  a=pCopy((poly)u->Data());
981  b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
982  if ((a!=NULL) && (b!=NULL)
983  && ((unsigned long)(pTotaldegree(a)+pTotaldegree(b))>=currRing->bitmask/2))
984  {
985    pDelete(&a);
986    pDelete(&b);
987    WerrorS("OVERFLOW");
988    return TRUE;
989  }
990  res->data = (char *)(pMult( a, b));
991  pNormalize((poly)res->data);
992  return jjOP_REST(res,u,v);
993}
994static BOOLEAN jjTIMES_ID(leftv res, leftv u, leftv v)
995{
996  res->data = (char *)idMult((ideal)u->Data(),(ideal)v->Data());
997  id_Normalize((ideal)res->data,currRing);
998  if ((v->next!=NULL) || (u->next!=NULL))
999    return jjOP_REST(res,u,v);
1000  return FALSE;
1001}
1002static BOOLEAN jjTIMES_IV(leftv res, leftv u, leftv v)
1003{
1004  res->data = (char *)ivMult((intvec*)(u->Data()), (intvec*)(v->Data()));
1005  if (res->data==NULL)
1006  {
1007     WerrorS("intmat size not compatible");
1008     return TRUE;
1009  }
1010  if ((v->next!=NULL) || (u->next!=NULL))
1011    return jjOP_REST(res,u,v);
1012  return FALSE;
1013}
1014static BOOLEAN jjTIMES_BIM(leftv res, leftv u, leftv v)
1015{
1016  res->data = (char *)bimMult((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
1017  if (res->data==NULL)
1018  {
1019    WerrorS("bigintmat/cmatrix not compatible");
1020    return TRUE;
1021  }
1022  if ((v->next!=NULL) || (u->next!=NULL))
1023    return jjOP_REST(res,u,v);
1024  return FALSE;
1025}
1026static BOOLEAN jjTIMES_MA_BI1(leftv res, leftv u, leftv v)
1027{
1028  nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
1029  if (nMap==NULL) return TRUE;
1030  number n=nMap((number)v->Data(),coeffs_BIGINT,currRing->cf);
1031  poly p=pNSet(n);
1032  ideal I= (ideal)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
1033  res->data = (char *)I;
1034  return FALSE;
1035}
1036static BOOLEAN jjTIMES_MA_BI2(leftv res, leftv u, leftv v)
1037{
1038  return jjTIMES_MA_BI1(res,v,u);
1039}
1040static BOOLEAN jjTIMES_MA_P1(leftv res, leftv u, leftv v)
1041{
1042  poly p=(poly)v->CopyD(POLY_CMD);
1043  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
1044  ideal I= (ideal)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,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_P2(leftv res, leftv u, leftv v)
1051{
1052  poly p=(poly)u->CopyD(POLY_CMD);
1053  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
1054  ideal I= (ideal)pMultMp(p,(matrix)v->CopyD(MATRIX_CMD),currRing);
1055  if (r>0) I->rank=r;
1056  id_Normalize(I,currRing);
1057  res->data = (char *)I;
1058  return FALSE;
1059}
1060static BOOLEAN jjTIMES_MA_N1(leftv res, leftv u, leftv v)
1061{
1062  number n=(number)v->CopyD(NUMBER_CMD);
1063  poly p=pNSet(n);
1064  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
1065  id_Normalize((ideal)res->data,currRing);
1066  return FALSE;
1067}
1068static BOOLEAN jjTIMES_MA_N2(leftv res, leftv u, leftv v)
1069{
1070  return jjTIMES_MA_N1(res,v,u);
1071}
1072static BOOLEAN jjTIMES_MA_I1(leftv res, leftv u, leftv v)
1073{
1074  res->data = (char *)mp_MultI((matrix)u->CopyD(MATRIX_CMD),(int)(long)v->Data(),currRing);
1075  id_Normalize((ideal)res->data,currRing);
1076  return FALSE;
1077}
1078static BOOLEAN jjTIMES_MA_I2(leftv res, leftv u, leftv v)
1079{
1080  return jjTIMES_MA_I1(res,v,u);
1081}
1082static BOOLEAN jjTIMES_MA(leftv res, leftv u, leftv v)
1083{
1084  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
1085  res->data = (char *)mp_Mult(A,B,currRing);
1086  if (res->data==NULL)
1087  {
1088     Werror("matrix size not compatible(%dx%d, %dx%d)",
1089             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
1090     return TRUE;
1091  }
1092  id_Normalize((ideal)res->data,currRing);
1093  if ((v->next!=NULL) || (u->next!=NULL))
1094    return jjOP_REST(res,u,v);
1095  return FALSE;
1096}
1097static BOOLEAN jjGE_BI(leftv res, leftv u, leftv v)
1098{
1099  number h=n_Sub((number)u->Data(),(number)v->Data(),coeffs_BIGINT);
1100  res->data = (char *) (n_GreaterZero(h,coeffs_BIGINT)||(n_IsZero(h,coeffs_BIGINT)));
1101  n_Delete(&h,coeffs_BIGINT);
1102  return FALSE;
1103}
1104static BOOLEAN jjGE_I(leftv res, leftv u, leftv v)
1105{
1106  res->data = (char *)(long)((int)((long)u->Data()) >= (int)((long)v->Data()));
1107  return FALSE;
1108}
1109static BOOLEAN jjGE_N(leftv res, leftv u, leftv v)
1110{
1111  res->data = (char *)(long) (nGreater((number)u->Data(),(number)v->Data())
1112                       || nEqual((number)u->Data(),(number)v->Data()));
1113  return FALSE;
1114}
1115static BOOLEAN jjGT_BI(leftv res, leftv u, leftv v)
1116{
1117  number h=n_Sub((number)u->Data(),(number)v->Data(),coeffs_BIGINT);
1118  res->data = (char *)(long) (n_GreaterZero(h,coeffs_BIGINT)&&(!n_IsZero(h,coeffs_BIGINT)));
1119  n_Delete(&h,coeffs_BIGINT);
1120  return FALSE;
1121}
1122static BOOLEAN jjGT_I(leftv res, leftv u, leftv v)
1123{
1124  res->data = (char *)(long)((int)((long)u->Data()) > (int)((long)v->Data()));
1125  return FALSE;
1126}
1127static BOOLEAN jjGT_N(leftv res, leftv u, leftv v)
1128{
1129  res->data = (char *)(long)(nGreater((number)u->Data(),(number)v->Data()));
1130  return FALSE;
1131}
1132static BOOLEAN jjLE_BI(leftv res, leftv u, leftv v)
1133{
1134  return jjGE_BI(res,v,u);
1135}
1136static BOOLEAN jjLE_I(leftv res, leftv u, leftv v)
1137{
1138  res->data = (char *)(long)((int)((long)u->Data()) <= (int)((long)v->Data()));
1139  return FALSE;
1140}
1141static BOOLEAN jjLE_N(leftv res, leftv u, leftv v)
1142{
1143  return jjGE_N(res,v,u);
1144}
1145static BOOLEAN jjLT_BI(leftv res, leftv u, leftv v)
1146{
1147  return jjGT_BI(res,v,u);
1148}
1149static BOOLEAN jjLT_I(leftv res, leftv u, leftv v)
1150{
1151  res->data = (char *)(long)((int)((long)u->Data()) < (int)((long)v->Data()));
1152  return FALSE;
1153}
1154static BOOLEAN jjLT_N(leftv res, leftv u, leftv v)
1155{
1156  return jjGT_N(res,v,u);
1157}
1158static BOOLEAN jjDIVMOD_I(leftv res, leftv u, leftv v)
1159{
1160  if (iiOp=='/') Warn("int division with `/`: use `div` instead in line >>%s<<",my_yylinebuf);
1161  int a= (int)(long)u->Data();
1162  int b= (int)(long)v->Data();
1163  if (b==0)
1164  {
1165    WerrorS(ii_div_by_0);
1166    return TRUE;
1167  }
1168  int c=a%b;
1169  int r=0;
1170  switch (iiOp)
1171  {
1172    case '%':
1173        r=c;            break;
1174    case '/':
1175    case INTDIV_CMD:
1176        r=((a-c) /b);   break;
1177  }
1178  res->data=(void *)((long)r);
1179  return FALSE;
1180}
1181static BOOLEAN jjDIV_BI(leftv res, leftv u, leftv v)
1182{
1183  number q=(number)v->Data();
1184  if (n_IsZero(q,coeffs_BIGINT))
1185  {
1186    WerrorS(ii_div_by_0);
1187    return TRUE;
1188  }
1189  q = n_Div((number)u->Data(),q,coeffs_BIGINT);
1190  n_Normalize(q,coeffs_BIGINT);
1191  res->data = (char *)q;
1192  return FALSE;
1193}
1194static BOOLEAN jjDIV_N(leftv res, leftv u, leftv v)
1195{
1196  number q=(number)v->Data();
1197  if (nIsZero(q))
1198  {
1199    WerrorS(ii_div_by_0);
1200    return TRUE;
1201  }
1202  q = nDiv((number)u->Data(),q);
1203  nNormalize(q);
1204  res->data = (char *)q;
1205  return FALSE;
1206}
1207static BOOLEAN jjDIV_P(leftv res, leftv u, leftv v)
1208{
1209  poly q=(poly)v->Data();
1210  if (q==NULL)
1211  {
1212    WerrorS(ii_div_by_0);
1213    return TRUE;
1214  }
1215  poly p=(poly)(u->Data());
1216  if (p==NULL)
1217  {
1218    res->data=NULL;
1219    return FALSE;
1220  }
1221  if ((pNext(q)!=NULL) && (!rField_is_Ring(currRing)))
1222  { /* This means that q != 0 consists of at least two terms.
1223       Moreover, currRing is over a field. */
1224    if(pGetComp(p)==0)
1225    {
1226      res->data=(void*)(singclap_pdivide(p /*(poly)(u->Data())*/ ,
1227                                         q /*(poly)(v->Data())*/ ,currRing));
1228    }
1229    else
1230    {
1231      int comps=pMaxComp(p);
1232      ideal I=idInit(comps,1);
1233      p=pCopy(p);
1234      poly h;
1235      int i;
1236      // conversion to a list of polys:
1237      while (p!=NULL)
1238      {
1239        i=pGetComp(p)-1;
1240        h=pNext(p);
1241        pNext(p)=NULL;
1242        pSetComp(p,0);
1243        I->m[i]=pAdd(I->m[i],p);
1244        p=h;
1245      }
1246      // division and conversion to vector:
1247      h=NULL;
1248      p=NULL;
1249      for(i=comps-1;i>=0;i--)
1250      {
1251        if (I->m[i]!=NULL)
1252        {
1253          h=singclap_pdivide(I->m[i],q,currRing);
1254          pSetCompP(h,i+1);
1255          p=pAdd(p,h);
1256        }
1257      }
1258      idDelete(&I);
1259      res->data=(void *)p;
1260    }
1261  }
1262  else
1263  { /* This means that q != 0 consists of just one term,
1264       or that currRing is over a coefficient ring. */
1265#ifdef HAVE_RINGS
1266    if (!rField_is_Domain(currRing))
1267    {
1268      WerrorS("division only defined over coefficient domains");
1269      return TRUE;
1270    }
1271    if (pNext(q)!=NULL)
1272    {
1273      WerrorS("division over a coefficient domain only implemented for terms");
1274      return TRUE;
1275    }
1276#endif
1277    res->data = (char *)pDivideM(pCopy(p),pHead(q));
1278  }
1279  pNormalize((poly)res->data);
1280  return FALSE;
1281}
1282static BOOLEAN jjDIV_Ma(leftv res, leftv u, leftv v)
1283{
1284  poly q=(poly)v->Data();
1285  if (q==NULL)
1286  {
1287    WerrorS(ii_div_by_0);
1288    return TRUE;
1289  }
1290  matrix m=(matrix)(u->Data());
1291  int r=m->rows();
1292  int c=m->cols();
1293  matrix mm=mpNew(r,c);
1294  int i,j;
1295  for(i=r;i>0;i--)
1296  {
1297    for(j=c;j>0;j--)
1298    {
1299      if (pNext(q)!=NULL)
1300      {
1301        MATELEM(mm,i,j) = singclap_pdivide( MATELEM(m,i,j) ,
1302                                           q /*(poly)(v->Data())*/, currRing );
1303      }
1304      else
1305        MATELEM(mm,i,j) = pDivideM(pCopy(MATELEM(m,i,j)),pHead(q));
1306    }
1307  }
1308  id_Normalize((ideal)mm,currRing);
1309  res->data=(char *)mm;
1310  return FALSE;
1311}
1312static BOOLEAN jjEQUAL_BI(leftv res, leftv u, leftv v)
1313{
1314  res->data = (char *)((long)n_Equal((number)u->Data(),(number)v->Data(),coeffs_BIGINT));
1315  jjEQUAL_REST(res,u,v);
1316  return FALSE;
1317}
1318static BOOLEAN jjEQUAL_I(leftv res, leftv u, leftv v)
1319{
1320  res->data = (char *)((int)((long)u->Data()) == (int)((long)v->Data()));
1321  jjEQUAL_REST(res,u,v);
1322  return FALSE;
1323}
1324static BOOLEAN jjEQUAL_Ma(leftv res, leftv u, leftv v)
1325{
1326  res->data = (char *)((long)mp_Equal((matrix)u->Data(),(matrix)v->Data(),currRing));
1327  jjEQUAL_REST(res,u,v);
1328  return FALSE;
1329}
1330static BOOLEAN jjEQUAL_N(leftv res, leftv u, leftv v)
1331{
1332  res->data = (char *)((long)nEqual((number)u->Data(),(number)v->Data()));
1333  jjEQUAL_REST(res,u,v);
1334  return FALSE;
1335}
1336static BOOLEAN jjEQUAL_P(leftv res, leftv u, leftv v)
1337{
1338  poly p=(poly)u->Data();
1339  poly q=(poly)v->Data();
1340  res->data = (char *) ((long)pEqualPolys(p,q));
1341  jjEQUAL_REST(res,u,v);
1342  return FALSE;
1343}
1344static void jjEQUAL_REST(leftv res,leftv u,leftv v)
1345{
1346  if ((res->data) && (u->next!=NULL) && (v->next!=NULL))
1347  {
1348    int save_iiOp=iiOp;
1349    if (iiOp==NOTEQUAL)
1350      iiExprArith2(res,u->next,EQUAL_EQUAL,v->next);
1351    else
1352      iiExprArith2(res,u->next,iiOp,v->next);
1353    iiOp=save_iiOp;
1354  }
1355  if (iiOp==NOTEQUAL) res->data=(char *)(!(long)res->data);
1356}
1357static BOOLEAN jjAND_I(leftv res, leftv u, leftv v)
1358{
1359  res->data = (char *)((long)u->Data() && (long)v->Data());
1360  return FALSE;
1361}
1362static BOOLEAN jjOR_I(leftv res, leftv u, leftv v)
1363{
1364  res->data = (char *)((long)u->Data() || (long)v->Data());
1365  return FALSE;
1366}
1367static BOOLEAN jjINDEX_I(leftv res, leftv u, leftv v)
1368{
1369  res->rtyp=u->rtyp; u->rtyp=0;
1370  res->data=u->data; u->data=NULL;
1371  res->name=u->name; u->name=NULL;
1372  res->e=u->e;       u->e=NULL;
1373  if (res->e==NULL) res->e=jjMakeSub(v);
1374  else
1375  {
1376    Subexpr sh=res->e;
1377    while (sh->next != NULL) sh=sh->next;
1378    sh->next=jjMakeSub(v);
1379  }
1380  if (u->next!=NULL)
1381  {
1382    leftv rn=(leftv)omAlloc0Bin(sleftv_bin);
1383    BOOLEAN bo=iiExprArith2(rn,u->next,iiOp,v);
1384    res->next=rn;
1385    return bo;
1386  }
1387  return FALSE;
1388}
1389static BOOLEAN jjINDEX_IV(leftv res, leftv u, leftv v)
1390{
1391  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1392  {
1393    WerrorS("indexed object must have a name");
1394    return TRUE;
1395  }
1396  intvec * iv=(intvec *)v->Data();
1397  leftv p=NULL;
1398  int i;
1399  sleftv t;
1400  memset(&t,0,sizeof(t));
1401  t.rtyp=INT_CMD;
1402  for (i=0;i<iv->length(); i++)
1403  {
1404    t.data=(char *)((long)(*iv)[i]);
1405    if (p==NULL)
1406    {
1407      p=res;
1408    }
1409    else
1410    {
1411      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1412      p=p->next;
1413    }
1414    p->rtyp=IDHDL;
1415    p->data=u->data;
1416    p->name=u->name;
1417    p->flag=u->flag;
1418    p->e=jjMakeSub(&t);
1419  }
1420  u->rtyp=0;
1421  u->data=NULL;
1422  u->name=NULL;
1423  return FALSE;
1424}
1425static BOOLEAN jjINDEX_P(leftv res, leftv u, leftv v)
1426{
1427  poly p=(poly)u->Data();
1428  int i=(int)(long)v->Data();
1429  int j=0;
1430  while (p!=NULL)
1431  {
1432    j++;
1433    if (j==i)
1434    {
1435      res->data=(char *)pHead(p);
1436      return FALSE;
1437    }
1438    pIter(p);
1439  }
1440  return FALSE;
1441}
1442static BOOLEAN jjINDEX_P_IV(leftv res, leftv u, leftv v)
1443{
1444  poly p=(poly)u->Data();
1445  poly r=NULL;
1446  intvec *iv=(intvec *)v->CopyD(INTVEC_CMD);
1447  int i;
1448  int sum=0;
1449  for(i=iv->length()-1;i>=0;i--)
1450    sum+=(*iv)[i];
1451  int j=0;
1452  while ((p!=NULL) && (sum>0))
1453  {
1454    j++;
1455    for(i=iv->length()-1;i>=0;i--)
1456    {
1457      if (j==(*iv)[i])
1458      {
1459        r=pAdd(r,pHead(p));
1460        sum-=j;
1461        (*iv)[i]=0;
1462        break;
1463      }
1464    }
1465    pIter(p);
1466  }
1467  delete iv;
1468  res->data=(char *)r;
1469  return FALSE;
1470}
1471static BOOLEAN jjINDEX_V(leftv res, leftv u, leftv v)
1472{
1473  poly p=(poly)u->CopyD(VECTOR_CMD);
1474  poly r=p; // pointer to the beginning of component i
1475  poly o=NULL;
1476  unsigned i=(unsigned)(long)v->Data();
1477  while (p!=NULL)
1478  {
1479    if (pGetComp(p)!=i)
1480    {
1481      if (r==p) r=pNext(p);
1482      if (o!=NULL)
1483      {
1484        if (pNext(o)!=NULL) pLmDelete(&pNext(o));
1485        p=pNext(o);
1486      }
1487      else
1488        pLmDelete(&p);
1489    }
1490    else
1491    {
1492      pSetComp(p, 0);
1493      p_SetmComp(p, currRing);
1494      o=p;
1495      p=pNext(o);
1496    }
1497  }
1498  res->data=(char *)r;
1499  return FALSE;
1500}
1501static BOOLEAN jjINDEX_V_IV(leftv res, leftv u, leftv v)
1502{
1503  poly p=(poly)u->CopyD(VECTOR_CMD);
1504  if (p!=NULL)
1505  {
1506    poly r=pOne();
1507    poly hp=r;
1508    intvec *iv=(intvec *)v->Data();
1509    int i;
1510    loop
1511    {
1512      for(i=0;i<iv->length();i++)
1513      {
1514        if (((int)pGetComp(p))==(*iv)[i])
1515        {
1516          poly h;
1517          pSplit(p,&h);
1518          pNext(hp)=p;
1519          p=h;
1520          pIter(hp);
1521          break;
1522        }
1523      }
1524      if (p==NULL) break;
1525      if (i==iv->length())
1526      {
1527        pLmDelete(&p);
1528        if (p==NULL) break;
1529      }
1530    }
1531    pLmDelete(&r);
1532    res->data=(char *)r;
1533  }
1534  return FALSE;
1535}
1536static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v);
1537static BOOLEAN jjKLAMMER(leftv res, leftv u, leftv v)
1538{
1539  if(u->name==NULL) return TRUE;
1540  char * nn = (char *)omAlloc(strlen(u->name) + 14);
1541  sprintf(nn,"%s(%d)",u->name,(int)(long)v->Data());
1542  omFree((ADDRESS)u->name);
1543  u->name=NULL;
1544  char *n=omStrDup(nn);
1545  omFree((ADDRESS)nn);
1546  syMake(res,n);
1547  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1548  return FALSE;
1549}
1550static BOOLEAN jjKLAMMER_IV(leftv res, leftv u, leftv v)
1551{
1552  intvec * iv=(intvec *)v->Data();
1553  leftv p=NULL;
1554  int i;
1555  long slen = strlen(u->name) + 14;
1556  char *n = (char*) omAlloc(slen);
1557
1558  for (i=0;i<iv->length(); i++)
1559  {
1560    if (p==NULL)
1561    {
1562      p=res;
1563    }
1564    else
1565    {
1566      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1567      p=p->next;
1568    }
1569    sprintf(n,"%s(%d)",u->name,(*iv)[i]);
1570    syMake(p,omStrDup(n));
1571  }
1572  omFree((ADDRESS)u->name);
1573  u->name = NULL;
1574  omFreeSize(n, slen);
1575  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1576  return FALSE;
1577}
1578static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v)
1579{
1580  leftv tmp=(leftv)omAllocBin(sleftv_bin);
1581  memset(tmp,0,sizeof(sleftv));
1582  BOOLEAN b;
1583  if (v->Typ()==INTVEC_CMD)
1584    b=jjKLAMMER_IV(tmp,u,v);
1585  else
1586    b=jjKLAMMER(tmp,u,v);
1587  if (b)
1588  {
1589    omFreeBin(tmp,sleftv_bin);
1590    return TRUE;
1591  }
1592  leftv h=res;
1593  while (h->next!=NULL) h=h->next;
1594  h->next=tmp;
1595  return FALSE;
1596}
1597BOOLEAN jjPROC(leftv res, leftv u, leftv v)
1598{
1599  void *d;
1600  Subexpr e;
1601  int typ;
1602  BOOLEAN t=FALSE;
1603  idhdl tmp_proc=NULL;
1604  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1605  {
1606    tmp_proc=(idhdl)omAlloc0(sizeof(idrec));
1607    tmp_proc->id="_auto";
1608    tmp_proc->typ=PROC_CMD;
1609    tmp_proc->data.pinf=(procinfo *)u->Data();
1610    tmp_proc->ref=1;
1611    d=u->data; u->data=(void *)tmp_proc;
1612    e=u->e; u->e=NULL;
1613    t=TRUE;
1614    typ=u->rtyp; u->rtyp=IDHDL;
1615  }
1616  BOOLEAN sl;
1617  if (u->req_packhdl==currPack)
1618    sl = iiMake_proc((idhdl)u->data,NULL,v);
1619  else
1620    sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1621  if (t)
1622  {
1623    u->rtyp=typ;
1624    u->data=d;
1625    u->e=e;
1626    omFreeSize(tmp_proc,sizeof(idrec));
1627  }
1628  if (sl) return TRUE;
1629  memcpy(res,&iiRETURNEXPR,sizeof(sleftv));
1630  iiRETURNEXPR.Init();
1631  return FALSE;
1632}
1633static BOOLEAN jjMAP(leftv res, leftv u, leftv v)
1634{
1635  //Print("try to map %s with %s\n",$3.Name(),$1.Name());
1636  leftv sl=NULL;
1637  if ((v->e==NULL)&&(v->name!=NULL))
1638  {
1639    map m=(map)u->Data();
1640    sl=iiMap(m,v->name);
1641  }
1642  else
1643  {
1644    Werror("%s(<name>) expected",u->Name());
1645  }
1646  if (sl==NULL) return TRUE;
1647  memcpy(res,sl,sizeof(sleftv));
1648  omFreeBin((ADDRESS)sl, sleftv_bin);
1649  return FALSE;
1650}
1651static BOOLEAN jjCHINREM_BI(leftv res, leftv u, leftv v)
1652{
1653  intvec *c=(intvec*)u->Data();
1654  intvec* p=(intvec*)v->Data();
1655  int rl=p->length();
1656  number *x=(number *)omAlloc(rl*sizeof(number));
1657  number *q=(number *)omAlloc(rl*sizeof(number));
1658  int i;
1659  for(i=rl-1;i>=0;i--)
1660  {
1661    q[i]=n_Init((*p)[i], coeffs_BIGINT);
1662    x[i]=n_Init((*c)[i], coeffs_BIGINT);
1663  }
1664  number n=n_ChineseRemainderSym(x,q,rl,FALSE,coeffs_BIGINT);
1665  for(i=rl-1;i>=0;i--)
1666  {
1667    n_Delete(&(q[i]),coeffs_BIGINT);
1668    n_Delete(&(x[i]),coeffs_BIGINT);
1669  }
1670  omFree(x); omFree(q);
1671  res->data=(char *)n;
1672  return FALSE;
1673}
1674#if 0
1675static BOOLEAN jjCHINREM_P(leftv res, leftv u, leftv v)
1676{
1677  lists c=(lists)u->CopyD(); // list of poly
1678  intvec* p=(intvec*)v->Data();
1679  int rl=p->length();
1680  poly r=NULL,h, result=NULL;
1681  number *x=(number *)omAlloc(rl*sizeof(number));
1682  number *q=(number *)omAlloc(rl*sizeof(number));
1683  int i;
1684  for(i=rl-1;i>=0;i--)
1685  {
1686    q[i]=nlInit((*p)[i]);
1687  }
1688  loop
1689  {
1690    for(i=rl-1;i>=0;i--)
1691    {
1692      if (c->m[i].Typ()!=POLY_CMD)
1693      {
1694        Werror("poly expected at pos %d",i+1);
1695        for(i=rl-1;i>=0;i--)
1696        {
1697          nlDelete(&(q[i]),currRing);
1698        }
1699        omFree(x); omFree(q); // delete c
1700        return TRUE;
1701      }
1702      h=((poly)c->m[i].Data());
1703      if (r==NULL) r=h;
1704      else if (pLmCmp(r,h)==-1) r=h;
1705    }
1706    if (r==NULL) break;
1707    for(i=rl-1;i>=0;i--)
1708    {
1709      h=((poly)c->m[i].Data());
1710      if (pLmCmp(r,h)==0)
1711      {
1712        x[i]=pGetCoeff(h);
1713        h=pLmFreeAndNext(h);
1714        c->m[i].data=(char*)h;
1715      }
1716      else
1717        x[i]=nlInit(0);
1718    }
1719    number n=n_ChineseRemainder(x,q,rl,currRing->cf);
1720    for(i=rl-1;i>=0;i--)
1721    {
1722      nlDelete(&(x[i]),currRing);
1723    }
1724    h=pHead(r);
1725    pSetCoeff(h,n);
1726    result=pAdd(result,h);
1727  }
1728  for(i=rl-1;i>=0;i--)
1729  {
1730    nlDelete(&(q[i]),currRing);
1731  }
1732  omFree(x); omFree(q);
1733  res->data=(char *)result;
1734  return FALSE;
1735}
1736#endif
1737static BOOLEAN jjCHINREM_ID(leftv res, leftv u, leftv v)
1738{
1739  coeffs cf;
1740  lists c=(lists)u->CopyD(); // list of ideal or bigint/int
1741  lists pl=NULL;
1742  intvec *p=NULL;
1743  if (v->Typ()==LIST_CMD) pl=(lists)v->Data();
1744  else                    p=(intvec*)v->Data();
1745  int rl=c->nr+1;
1746  ideal result;
1747  ideal *x=(ideal *)omAlloc(rl*sizeof(ideal));
1748  number *xx=NULL;
1749  int i;
1750  int return_type=c->m[0].Typ();
1751  if ((return_type!=IDEAL_CMD)
1752  && (return_type!=MODUL_CMD)
1753  && (return_type!=MATRIX_CMD)
1754  && (return_type!=POLY_CMD))
1755  {
1756    if((return_type!=BIGINT_CMD)&&(return_type!=INT_CMD))
1757    {
1758      WerrorS("poly/ideal/module/matrix expected");
1759      omFree(x); // delete c
1760      return TRUE;
1761    }
1762    else
1763      return_type=BIGINT_CMD;
1764  }
1765  if (return_type==BIGINT_CMD)
1766    cf=coeffs_BIGINT;
1767  else
1768  {
1769    cf=currRing->cf;
1770    if (nCoeff_is_Extension(cf) && (cf->extRing!=NULL))
1771      cf=cf->extRing->cf;
1772  }
1773  nMapFunc nMap=n_SetMap(coeffs_BIGINT,cf);
1774  if (return_type!=BIGINT_CMD)
1775  {
1776    for(i=rl-1;i>=0;i--)
1777    {
1778      if (c->m[i].Typ()!=return_type)
1779      {
1780        Werror("%s expected at pos %d",Tok2Cmdname(return_type),i+1);
1781        omFree(x); // delete c
1782        return TRUE;
1783      }
1784      if (return_type==POLY_CMD)
1785      {
1786        x[i]=idInit(1,1);
1787        x[i]->m[0]=(poly)c->m[i].CopyD();
1788      }
1789      else
1790      {
1791        x[i]=(ideal)c->m[i].CopyD();
1792      }
1793      //c->m[i].Init();
1794    }
1795  }
1796  else
1797  {
1798    xx=(number *)omAlloc(rl*sizeof(number));
1799    if (nMap==NULL)
1800    {
1801      Werror("not implemented: map bigint -> %s",cf->cfCoeffString(cf));
1802      return TRUE;
1803    }
1804    for(i=rl-1;i>=0;i--)
1805    {
1806      if (c->m[i].Typ()==INT_CMD)
1807      {
1808        xx[i]=n_Init(((int)(long)c->m[i].Data()),cf);
1809      }
1810      else if (c->m[i].Typ()==BIGINT_CMD)
1811      {
1812        xx[i]=nMap((number)c->m[i].Data(),coeffs_BIGINT,cf);
1813      }
1814      else
1815      {
1816        Werror("bigint expected at pos %d",i+1);
1817        omFree(x); // delete c
1818        omFree(xx); // delete c
1819        return TRUE;
1820      }
1821    }
1822  }
1823  number *q=(number *)omAlloc(rl*sizeof(number));
1824  if (p!=NULL)
1825  {
1826    for(i=rl-1;i>=0;i--)
1827    {
1828      q[i]=n_Init((*p)[i], cf);
1829    }
1830  }
1831  else
1832  {
1833    for(i=rl-1;i>=0;i--)
1834    {
1835      if (pl->m[i].Typ()==INT_CMD)
1836      {
1837        q[i]=n_Init((int)(long)pl->m[i].Data(),cf);
1838      }
1839      else if (pl->m[i].Typ()==BIGINT_CMD)
1840      {
1841        q[i]=nMap((number)(pl->m[i].Data()),coeffs_BIGINT,cf);
1842      }
1843      else
1844      {
1845        Werror("bigint expected at pos %d",i+1);
1846        for(i++;i<rl;i++)
1847        {
1848          n_Delete(&(q[i]),cf);
1849        }
1850        omFree(x); // delete c
1851        omFree(q); // delete pl
1852        if (xx!=NULL) omFree(xx); // delete c
1853        return TRUE;
1854      }
1855    }
1856  }
1857  if (return_type==BIGINT_CMD)
1858  {
1859    number n=n_ChineseRemainderSym(xx,q,rl,TRUE,coeffs_BIGINT);
1860    res->data=(char *)n;
1861  }
1862  else
1863  {
1864    result=id_ChineseRemainder(x,q,rl,currRing);
1865    // deletes also x
1866    c->Clean();
1867    if (return_type==POLY_CMD)
1868    {
1869      res->data=(char *)result->m[0];
1870      result->m[0]=NULL;
1871      idDelete(&result);
1872    }
1873    else
1874      res->data=(char *)result;
1875  }
1876  for(i=rl-1;i>=0;i--)
1877  {
1878    n_Delete(&(q[i]),cf);
1879  }
1880  omFree(q);
1881  res->rtyp=return_type;
1882  return FALSE;
1883}
1884static BOOLEAN jjCOEF(leftv res, leftv u, leftv v)
1885{
1886  poly p=(poly)v->Data();
1887  if ((p==NULL)||(pNext(p)!=NULL)) return TRUE;
1888  res->data=(char *)mp_CoeffProc((poly)u->Data(),p /*(poly)v->Data()*/,currRing);
1889  return FALSE;
1890}
1891static BOOLEAN jjCOEFFS_Id(leftv res, leftv u, leftv v)
1892{
1893  int i=pVar((poly)v->Data());
1894  if (i==0)
1895  {
1896    WerrorS("ringvar expected");
1897    return TRUE;
1898  }
1899  res->data=(char *)mp_Coeffs((ideal)u->CopyD(),i,currRing);
1900  return FALSE;
1901}
1902static BOOLEAN jjCOEFFS2_KB(leftv res, leftv u, leftv v)
1903{
1904  poly p = pInit();
1905  int i;
1906  for (i=1; i<=currRing->N; i++)
1907  {
1908    pSetExp(p, i, 1);
1909  }
1910  pSetm(p);
1911  res->data = (void*)idCoeffOfKBase((ideal)(u->Data()),
1912                                    (ideal)(v->Data()), p);
1913  pDelete(&p);
1914  return FALSE;
1915}
1916static BOOLEAN jjCONTRACT(leftv res, leftv u, leftv v)
1917{
1918  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data(),FALSE);
1919  return FALSE;
1920}
1921static BOOLEAN jjDEG_M_IV(leftv res, leftv u, leftv v)
1922{
1923  short *iv=iv2array((intvec *)v->Data(),currRing);
1924  ideal I=(ideal)u->Data();
1925  int d=-1;
1926  int i;
1927  for(i=IDELEMS(I);i>=0;i--) d=si_max(d,(int)p_DegW(I->m[i],iv,currRing));
1928  omFreeSize( (ADDRESS)iv, (rVar(currRing)+1)*sizeof(short) );
1929  res->data = (char *)((long)d);
1930  return FALSE;
1931}
1932static BOOLEAN jjDEG_IV(leftv res, leftv u, leftv v)
1933{
1934  poly p=(poly)u->Data();
1935  if (p!=NULL)
1936  {
1937    short *iv=iv2array((intvec *)v->Data(),currRing);
1938    const long d = p_DegW(p,iv,currRing);
1939    omFreeSize( (ADDRESS)iv, (rVar(currRing)+1)*sizeof(short) );
1940    res->data = (char *)(d);
1941  }
1942  else
1943    res->data=(char *)(long)(-1);
1944  return FALSE;
1945}
1946static BOOLEAN jjDIFF_P(leftv res, leftv u, leftv v)
1947{
1948  int i=pVar((poly)v->Data());
1949  if (i==0)
1950  {
1951    WerrorS("ringvar expected");
1952    return TRUE;
1953  }
1954  res->data=(char *)pDiff((poly)(u->Data()),i);
1955  return FALSE;
1956}
1957static BOOLEAN jjDIFF_ID(leftv res, leftv u, leftv v)
1958{
1959  int i=pVar((poly)v->Data());
1960  if (i==0)
1961  {
1962    WerrorS("ringvar expected");
1963    return TRUE;
1964  }
1965  res->data=(char *)idDiff((matrix)(u->Data()),i);
1966  return FALSE;
1967}
1968static BOOLEAN jjDIFF_ID_ID(leftv res, leftv u, leftv v)
1969{
1970  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data());
1971  return FALSE;
1972}
1973static BOOLEAN jjDIM2(leftv res, leftv v, leftv w)
1974{
1975  assumeStdFlag(v);
1976#ifdef HAVE_RINGS
1977  if (rField_is_Ring(currRing))
1978  {
1979    //ring origR = currRing;
1980    //ring tempR = rCopy(origR);
1981    //coeffs new_cf=nInitChar(n_Q,NULL);
1982    //nKillChar(tempR->cf);
1983    //tempR->cf=new_cf;
1984    //rComplete(tempR);
1985    ideal vid = (ideal)v->Data();
1986    int i = idPosConstant(vid);
1987    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
1988    { /* ideal v contains unit; dim = -1 */
1989      res->data = (char *)-1;
1990      return FALSE;
1991    }
1992    //rChangeCurrRing(tempR);
1993    //ideal vv = idrCopyR(vid, origR, currRing);
1994    ideal vv = id_Copy(vid, currRing);
1995    //ideal ww = idrCopyR((ideal)w->Data(), origR, currRing);
1996    ideal ww = id_Copy((ideal)w->Data(), currRing);
1997    /* drop degree zero generator from vv (if any) */
1998    if (i != -1) pDelete(&vv->m[i]);
1999    long d = (long)scDimInt(vv, ww);
2000    if (rField_is_Ring_Z(currRing) && (i == -1)) d++;
2001    res->data = (char *)d;
2002    idDelete(&vv); idDelete(&ww);
2003    //rChangeCurrRing(origR);
2004    //rDelete(tempR);
2005    return FALSE;
2006  }
2007#endif
2008  if(currRing->qideal==NULL)
2009    res->data = (char *)((long)scDimInt((ideal)(v->Data()),(ideal)w->Data()));
2010  else
2011  {
2012    ideal q=idSimpleAdd(currRing->qideal,(ideal)w->Data());
2013    res->data = (char *)((long)scDimInt((ideal)(v->Data()),q));
2014    idDelete(&q);
2015  }
2016  return FALSE;
2017}
2018static BOOLEAN jjDIVISION(leftv res, leftv u, leftv v)
2019{
2020  ideal vi=(ideal)v->Data();
2021  int vl= IDELEMS(vi);
2022  ideal ui=(ideal)u->Data();
2023  int ul= IDELEMS(ui);
2024  ideal R; matrix U;
2025  ideal m = idLift(vi,ui,&R, FALSE,hasFlag(v,FLAG_STD),TRUE,&U);
2026  if (m==NULL) return TRUE;
2027  // now make sure that all matices have the corect size:
2028  matrix T = id_Module2formatedMatrix(m,vl,ul,currRing);
2029  int i;
2030  if (MATCOLS(U) != ul)
2031  {
2032    int mul=si_min(ul,MATCOLS(U));
2033    matrix UU=mpNew(ul,ul);
2034    int j;
2035    for(i=mul;i>0;i--)
2036    {
2037      for(j=mul;j>0;j--)
2038      {
2039        MATELEM(UU,i,j)=MATELEM(U,i,j);
2040        MATELEM(U,i,j)=NULL;
2041      }
2042    }
2043    idDelete((ideal *)&U);
2044    U=UU;
2045  }
2046  // make sure that U is a diagonal matrix of units
2047  for(i=ul;i>0;i--)
2048  {
2049    if(MATELEM(U,i,i)==NULL) MATELEM(U,i,i)=pOne();
2050  }
2051  lists L=(lists)omAllocBin(slists_bin);
2052  L->Init(3);
2053  L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)T;
2054  L->m[1].rtyp=u->Typ();     L->m[1].data=(void *)R;
2055  L->m[2].rtyp=MATRIX_CMD;   L->m[2].data=(void *)U;
2056  res->data=(char *)L;
2057  return FALSE;
2058}
2059static BOOLEAN jjELIMIN(leftv res, leftv u, leftv v)
2060{
2061  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data());
2062  //setFlag(res,FLAG_STD);
2063  return v->next!=NULL; //do not allow next like in eliminate(I,a(1..4))
2064}
2065static BOOLEAN jjELIMIN_IV(leftv res, leftv u, leftv v)
2066{
2067  poly p=pOne();
2068  intvec *iv=(intvec*)v->Data();
2069  for(int i=iv->length()-1; i>=0; i--)
2070  {
2071    pSetExp(p,(*iv)[i],1);
2072  }
2073  pSetm(p);
2074  res->data=(char *)idElimination((ideal)u->Data(),p);
2075  pLmDelete(&p);
2076  //setFlag(res,FLAG_STD);
2077  return FALSE;
2078}
2079static BOOLEAN jjEXPORTTO(leftv, leftv u, leftv v)
2080{
2081  //Print("exportto %s -> %s\n",v->Name(),u->Name() );
2082  return iiExport(v,0,IDPACKAGE((idhdl)u->data));
2083}
2084static BOOLEAN jjERROR(leftv, leftv u)
2085{
2086  WerrorS((char *)u->Data());
2087  extern int inerror;
2088  inerror=3;
2089  return TRUE;
2090}
2091static BOOLEAN jjEXTGCD_BI(leftv res, leftv u, leftv v)
2092{
2093  number uu=(number)u->Data();number vv=(number)v->Data();
2094  lists L=(lists)omAllocBin(slists_bin);
2095  number a,b;
2096  number p0=n_ExtGcd(uu,vv,&a,&b,coeffs_BIGINT);
2097  L->Init(3);
2098  L->m[0].rtyp=BIGINT_CMD;   L->m[0].data=(void *)p0;
2099  L->m[1].rtyp=BIGINT_CMD;   L->m[1].data=(void *)a;
2100  L->m[2].rtyp=BIGINT_CMD;   L->m[2].data=(void *)b;
2101  res->rtyp=LIST_CMD;
2102  res->data=(char *)L;
2103  return FALSE;
2104}
2105static BOOLEAN jjEXTGCD_I(leftv res, leftv u, leftv v)
2106{
2107  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2108  int p0=ABS(uu),p1=ABS(vv);
2109  int f0 = 1, f1 = 0, g0 = 0, g1 = 1, q, r;
2110
2111  while ( p1!=0 )
2112  {
2113    q=p0 / p1;
2114    r=p0 % p1;
2115    p0 = p1; p1 = r;
2116    r = g0 - g1 * q;
2117    g0 = g1; g1 = r;
2118    r = f0 - f1 * q;
2119    f0 = f1; f1 = r;
2120  }
2121  int a = f0;
2122  int b = g0;
2123  if ( uu /*(int)(long)u->Data()*/ < 0 ) a=-a;
2124  if ( vv /*(int)(long)v->Data()*/ < 0 ) b=-b;
2125  lists L=(lists)omAllocBin(slists_bin);
2126  L->Init(3);
2127  L->m[0].rtyp=INT_CMD;   L->m[0].data=(void *)(long)p0;
2128  L->m[1].rtyp=INT_CMD;   L->m[1].data=(void *)(long)a;
2129  L->m[2].rtyp=INT_CMD;   L->m[2].data=(void *)(long)b;
2130  res->rtyp=LIST_CMD;
2131  res->data=(char *)L;
2132  return FALSE;
2133}
2134static BOOLEAN jjEXTGCD_P(leftv res, leftv u, leftv v)
2135{
2136  poly r,pa,pb;
2137  BOOLEAN ret=singclap_extgcd((poly)u->Data(),(poly)v->Data(),r,pa,pb,currRing);
2138  if (ret) return TRUE;
2139  lists L=(lists)omAllocBin(slists_bin);
2140  L->Init(3);
2141  res->data=(char *)L;
2142  L->m[0].data=(void *)r;
2143  L->m[0].rtyp=POLY_CMD;
2144  L->m[1].data=(void *)pa;
2145  L->m[1].rtyp=POLY_CMD;
2146  L->m[2].data=(void *)pb;
2147  L->m[2].rtyp=POLY_CMD;
2148  return FALSE;
2149}
2150extern int singclap_factorize_retry;
2151static BOOLEAN jjFAC_P2(leftv res, leftv u,leftv dummy)
2152{
2153  intvec *v=NULL;
2154  int sw=(int)(long)dummy->Data();
2155  int fac_sw=sw;
2156  if ((sw<0)||(sw>2)) fac_sw=1;
2157  singclap_factorize_retry=0;
2158  ideal f=singclap_factorize((poly)(u->CopyD()), &v, fac_sw,currRing);
2159  if (f==NULL)
2160    return TRUE;
2161  switch(sw)
2162  {
2163    case 0:
2164    case 2:
2165    {
2166      lists l=(lists)omAllocBin(slists_bin);
2167      l->Init(2);
2168      l->m[0].rtyp=IDEAL_CMD;
2169      l->m[0].data=(void *)f;
2170      l->m[1].rtyp=INTVEC_CMD;
2171      l->m[1].data=(void *)v;
2172      res->data=(void *)l;
2173      res->rtyp=LIST_CMD;
2174      return FALSE;
2175    }
2176    case 1:
2177      res->data=(void *)f;
2178      return FALSE;
2179    case 3:
2180      {
2181        poly p=f->m[0];
2182        int i=IDELEMS(f);
2183        f->m[0]=NULL;
2184        while(i>1)
2185        {
2186          i--;
2187          p=pMult(p,f->m[i]);
2188          f->m[i]=NULL;
2189        }
2190        res->data=(void *)p;
2191        res->rtyp=POLY_CMD;
2192      }
2193      return FALSE;
2194  }
2195  WerrorS("invalid switch");
2196  return TRUE;
2197}
2198static BOOLEAN jjFACSTD2(leftv res, leftv v, leftv w)
2199{
2200  ideal_list p,h;
2201  h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL,(ideal)w->Data());
2202  p=h;
2203  int l=0;
2204  while (p!=NULL) { p=p->next;l++; }
2205  lists L=(lists)omAllocBin(slists_bin);
2206  L->Init(l);
2207  l=0;
2208  while(h!=NULL)
2209  {
2210    L->m[l].data=(char *)h->d;
2211    L->m[l].rtyp=IDEAL_CMD;
2212    p=h->next;
2213    omFreeSize(h,sizeof(*h));
2214    h=p;
2215    l++;
2216  }
2217  res->data=(void *)L;
2218  return FALSE;
2219}
2220static BOOLEAN jjFAREY_BI(leftv res, leftv u, leftv v)
2221{
2222  if (rField_is_Q(currRing))
2223  {
2224    number uu=(number)u->Data();
2225    number vv=(number)v->Data();
2226    res->data=(char *)n_Farey(uu,vv,currRing->cf);
2227    return FALSE;
2228  }
2229  else return TRUE;
2230}
2231static BOOLEAN jjFAREY_ID(leftv res, leftv u, leftv v)
2232{
2233  ideal uu=(ideal)u->Data();
2234  number vv=(number)v->Data();
2235  res->data=(void*)id_Farey(uu,vv,currRing);
2236  res->rtyp=u->Typ();
2237  return FALSE;
2238}
2239static BOOLEAN jjFETCH(leftv res, leftv u, leftv v)
2240{
2241  ring r=(ring)u->Data();
2242  idhdl w;
2243  int op=iiOp;
2244  nMapFunc nMap;
2245
2246  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
2247  {
2248    int *perm=NULL;
2249    int *par_perm=NULL;
2250    int par_perm_size=0;
2251    BOOLEAN bo;
2252    if ((nMap=n_SetMap(r->cf,currRing->cf))==NULL)
2253    {
2254      // Allow imap/fetch to be make an exception only for:
2255      if ( (rField_is_Q_a(r) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2256            (rField_is_Q(currRing) || rField_is_Q_a(currRing) ||
2257             (rField_is_Zp(currRing) || rField_is_Zp_a(currRing))))
2258           ||
2259           (rField_is_Zp_a(r) &&  // Zp(a..) -> Zp(a..) || Zp
2260            (rField_is_Zp(currRing, r->cf->ch) ||
2261             rField_is_Zp_a(currRing, r->cf->ch))) )
2262      {
2263        par_perm_size=rPar(r);
2264      }
2265      else
2266      {
2267        goto err_fetch;
2268      }
2269    }
2270    if ((iiOp!=FETCH_CMD) || (r->N!=currRing->N) || (rPar(r)!=rPar(currRing)))
2271    {
2272      perm=(int *)omAlloc0((r->N+1)*sizeof(int));
2273      if (par_perm_size!=0)
2274        par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2275      op=IMAP_CMD;
2276      if (iiOp==IMAP_CMD)
2277      {
2278        int r_par=0;
2279        char ** r_par_names=NULL;
2280        if (r->cf->extRing!=NULL)
2281        {
2282          r_par=r->cf->extRing->N;
2283          r_par_names=r->cf->extRing->names;
2284        }
2285        int c_par=0;
2286        char ** c_par_names=NULL;
2287        if (currRing->cf->extRing!=NULL)
2288        {
2289          c_par=currRing->cf->extRing->N;
2290          c_par_names=currRing->cf->extRing->names;
2291        }
2292        maFindPerm(r->names,       r->N,       r_par_names, r_par,
2293                   currRing->names,currRing->N,c_par_names, c_par,
2294                   perm,par_perm, currRing->cf->type);
2295      }
2296      else
2297      {
2298        int i;
2299        if (par_perm_size!=0)
2300          for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2301        for(i=si_min(r->N,currRing->N);i>0;i--) perm[i]=i;
2302      }
2303    }
2304    if ((iiOp==FETCH_CMD) &&(BVERBOSE(V_IMAP)))
2305    {
2306      int i;
2307      for(i=0;i<si_min(r->N,currRing->N);i++)
2308      {
2309        Print("// var nr %d: %s -> %s\n",i,r->names[i],currRing->names[i]);
2310      }
2311      for(i=0;i<si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
2312      {
2313        Print("// par nr %d: %s -> %s\n",
2314              i,rParameter(r)[i],rParameter(currRing)[i]);
2315      }
2316    }
2317    sleftv tmpW;
2318    memset(&tmpW,0,sizeof(sleftv));
2319    tmpW.rtyp=IDTYP(w);
2320    tmpW.data=IDDATA(w);
2321    if ((bo=maApplyFetch(op,NULL,res,&tmpW, r,
2322                         perm,par_perm,par_perm_size,nMap)))
2323    {
2324      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
2325    }
2326    if (perm!=NULL)
2327      omFreeSize((ADDRESS)perm,(r->N+1)*sizeof(int));
2328    if (par_perm!=NULL)
2329      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2330    return bo;
2331  }
2332  else
2333  {
2334    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
2335  }
2336  return TRUE;
2337err_fetch:
2338  Werror("no identity map from %s (%s -> %s)",u->Fullname(),
2339    r->cf->cfCoeffString(r->cf),
2340    currRing->cf->cfCoeffString(currRing->cf));
2341  return TRUE;
2342}
2343static BOOLEAN jjFIND2(leftv res, leftv u, leftv v)
2344{
2345  /*4
2346  * look for the substring what in the string where
2347  * return the position of the first char of what in where
2348  * or 0
2349  */
2350  char *where=(char *)u->Data();
2351  char *what=(char *)v->Data();
2352  char *found = strstr(where,what);
2353  if (found != NULL)
2354  {
2355    res->data=(char *)((found-where)+1);
2356  }
2357  /*else res->data=NULL;*/
2358  return FALSE;
2359}
2360static BOOLEAN jjFWALK(leftv res, leftv u, leftv v)
2361{
2362  res->data=(char *)fractalWalkProc(u,v);
2363  setFlag( res, FLAG_STD );
2364  return FALSE;
2365}
2366static BOOLEAN jjGCD_I(leftv res, leftv u, leftv v)
2367{
2368  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2369  int p0=ABS(uu),p1=ABS(vv);
2370  int r;
2371  while ( p1!=0 )
2372  {
2373    r=p0 % p1;
2374    p0 = p1; p1 = r;
2375  }
2376  res->rtyp=INT_CMD;
2377  res->data=(char *)(long)p0;
2378  return FALSE;
2379}
2380static BOOLEAN jjGCD_BI(leftv res, leftv u, leftv v)
2381{
2382  number n1 = (number) u->Data();
2383  number n2 = (number) v->Data();
2384  res->data = n_Gcd(n1,n2,coeffs_BIGINT);
2385  return FALSE;
2386}
2387static BOOLEAN jjGCD_N(leftv res, leftv u, leftv v)
2388{
2389  number a=(number) u->Data();
2390  number b=(number) v->Data();
2391  if (nIsZero(a))
2392  {
2393    if (nIsZero(b)) res->data=(char *)nInit(1);
2394    else            res->data=(char *)nCopy(b);
2395  }
2396  else
2397  {
2398    if (nIsZero(b))  res->data=(char *)nCopy(a);
2399    //else res->data=(char *)n_Gcd(a, b, currRing->cf);
2400    else res->data=(char *)n_SubringGcd(a, b, currRing->cf);
2401  }
2402  return FALSE;
2403}
2404static BOOLEAN jjGCD_P(leftv res, leftv u, leftv v)
2405{
2406  res->data=(void *)singclap_gcd((poly)(u->CopyD(POLY_CMD)),
2407                                 (poly)(v->CopyD(POLY_CMD)),currRing);
2408  return FALSE;
2409}
2410static BOOLEAN jjHILBERT2(leftv res, leftv u, leftv v)
2411{
2412#ifdef HAVE_RINGS
2413  if (rField_is_Ring_Z(currRing))
2414  {
2415    ring origR = currRing;
2416    ring tempR = rCopy(origR);
2417    coeffs new_cf=nInitChar(n_Q,NULL);
2418    nKillChar(tempR->cf);
2419    tempR->cf=new_cf;
2420    rComplete(tempR);
2421    ideal uid = (ideal)u->Data();
2422    rChangeCurrRing(tempR);
2423    ideal uu = idrCopyR(uid, origR, currRing);
2424    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
2425    uuAsLeftv.rtyp = IDEAL_CMD;
2426    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
2427    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
2428    assumeStdFlag(&uuAsLeftv);
2429    Print("// NOTE: computation of Hilbert series etc. is being\n");
2430    Print("//       performed for generic fibre, that is, over Q\n");
2431    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
2432    intvec *iv=hFirstSeries(uu,module_w,currRing->qideal);
2433    int returnWithTrue = 1;
2434    switch((int)(long)v->Data())
2435    {
2436      case 1:
2437        res->data=(void *)iv;
2438        returnWithTrue = 0;
2439      case 2:
2440        res->data=(void *)hSecondSeries(iv);
2441        delete iv;
2442        returnWithTrue = 0;
2443    }
2444    if (returnWithTrue)
2445    {
2446      WerrorS(feNotImplemented);
2447      delete iv;
2448    }
2449    idDelete(&uu);
2450    rChangeCurrRing(origR);
2451    rDelete(tempR);
2452    if (returnWithTrue) return TRUE; else return FALSE;
2453  }
2454#endif
2455  assumeStdFlag(u);
2456  intvec *module_w=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2457  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currRing->qideal);
2458  switch((int)(long)v->Data())
2459  {
2460    case 1:
2461      res->data=(void *)iv;
2462      return FALSE;
2463    case 2:
2464      res->data=(void *)hSecondSeries(iv);
2465      delete iv;
2466      return FALSE;
2467  }
2468  WerrorS(feNotImplemented);
2469  delete iv;
2470  return TRUE;
2471}
2472static BOOLEAN jjHOMOG_P(leftv res, leftv u, leftv v)
2473{
2474  int i=pVar((poly)v->Data());
2475  if (i==0)
2476  {
2477    WerrorS("ringvar expected");
2478    return TRUE;
2479  }
2480  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2481  int d=pWTotaldegree(p);
2482  pLmDelete(p);
2483  if (d==1)
2484    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
2485  else
2486    WerrorS("variable must have weight 1");
2487  return (d!=1);
2488}
2489static BOOLEAN jjHOMOG_ID(leftv res, leftv u, leftv v)
2490{
2491  int i=pVar((poly)v->Data());
2492  if (i==0)
2493  {
2494    WerrorS("ringvar expected");
2495    return TRUE;
2496  }
2497  pFDegProc deg;
2498  if (currRing->pLexOrder && (currRing->order[0]==ringorder_lp))
2499    deg=p_Totaldegree;
2500   else
2501    deg=currRing->pFDeg;
2502  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2503  int d=deg(p,currRing);
2504  pLmDelete(p);
2505  if (d==1)
2506    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
2507  else
2508    WerrorS("variable must have weight 1");
2509  return (d!=1);
2510}
2511static BOOLEAN jjHOMOG1_W(leftv res, leftv v, leftv u)
2512{
2513  intvec *w=new intvec(rVar(currRing));
2514  intvec *vw=(intvec*)u->Data();
2515  ideal v_id=(ideal)v->Data();
2516  pFDegProc save_FDeg=currRing->pFDeg;
2517  pLDegProc save_LDeg=currRing->pLDeg;
2518  BOOLEAN save_pLexOrder=currRing->pLexOrder;
2519  currRing->pLexOrder=FALSE;
2520  kHomW=vw;
2521  kModW=w;
2522  pSetDegProcs(currRing,kHomModDeg);
2523  res->data=(void *)(long)idHomModule(v_id,currRing->qideal,&w);
2524  currRing->pLexOrder=save_pLexOrder;
2525  kHomW=NULL;
2526  kModW=NULL;
2527  pRestoreDegProcs(currRing,save_FDeg,save_LDeg);
2528  if (w!=NULL) delete w;
2529  return FALSE;
2530}
2531static BOOLEAN jjINDEPSET2(leftv res, leftv u, leftv v)
2532{
2533  assumeStdFlag(u);
2534  res->data=(void *)scIndIndset((ideal)(u->Data()),(int)(long)(v->Data()),
2535                    currRing->qideal);
2536  return FALSE;
2537}
2538static BOOLEAN jjINTERSECT(leftv res, leftv u, leftv v)
2539{
2540  res->data=(char *)idSect((ideal)u->Data(),(ideal)v->Data());
2541  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
2542  return FALSE;
2543}
2544static BOOLEAN jjINTERPOLATION (leftv res, leftv l, leftv v)
2545{
2546  const lists L = (lists)l->Data();
2547  const int n = L->nr; assume (n >= 0);
2548  std::vector<ideal> V(n + 1);
2549
2550  for(int i = n; i >= 0; i--) V[i] = (ideal)(L->m[i].Data());
2551
2552  res->data=interpolation(V, (intvec*)v->Data());
2553  setFlag(res,FLAG_STD);
2554  return errorreported;
2555}
2556static BOOLEAN jjJanetBasis2(leftv res, leftv u, leftv v)
2557{
2558  extern BOOLEAN jjStdJanetBasis(leftv res, leftv v,int flag);
2559  return jjStdJanetBasis(res,u,(int)(long)v->Data());
2560}
2561
2562static BOOLEAN jjJanetBasis(leftv res, leftv v)
2563{
2564  extern BOOLEAN jjStdJanetBasis(leftv res, leftv v,int flag);
2565  return jjStdJanetBasis(res,v,0);
2566}
2567static BOOLEAN jjJET_P(leftv res, leftv u, leftv v)
2568{
2569  res->data = (char *)pJet((poly)u->CopyD(), (int)(long)v->Data());
2570  return FALSE;
2571}
2572static BOOLEAN jjJET_ID(leftv res, leftv u, leftv v)
2573{
2574  res->data = (char *)id_Jet((ideal)u->Data(),(int)(long)v->Data(),currRing);
2575  return FALSE;
2576}
2577static BOOLEAN jjKBASE2(leftv res, leftv u, leftv v)
2578{
2579  assumeStdFlag(u);
2580  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2581  res->data = (char *)scKBase((int)(long)v->Data(),
2582                              (ideal)(u->Data()),currRing->qideal, w_u);
2583  if (w_u!=NULL)
2584  {
2585    atSet(res,omStrDup("isHomog"),ivCopy(w_u),INTVEC_CMD);
2586  }
2587  return FALSE;
2588}
2589static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w);
2590static BOOLEAN jjKERNEL(leftv res, leftv u, leftv v)
2591{
2592  return jjPREIMAGE(res,u,v,NULL);
2593}
2594static BOOLEAN jjKoszul(leftv res, leftv u, leftv v)
2595{
2596  return mpKoszul(res, u,v,NULL);
2597}
2598static BOOLEAN jjKoszul_Id(leftv res, leftv u, leftv v)
2599{
2600  sleftv h;
2601  memset(&h,0,sizeof(sleftv));
2602  h.rtyp=INT_CMD;
2603  h.data=(void *)(long)IDELEMS((ideal)v->Data());
2604  return mpKoszul(res, u, &h, v);
2605}
2606static BOOLEAN jjLIFT(leftv res, leftv u, leftv v)
2607{
2608  int ul= IDELEMS((ideal)u->Data());
2609  int vl= IDELEMS((ideal)v->Data());
2610  ideal m = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,
2611                   hasFlag(u,FLAG_STD));
2612  if (m==NULL) return TRUE;
2613  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
2614  return FALSE;
2615}
2616static BOOLEAN jjLIFTSTD(leftv res, leftv u, leftv v)
2617{
2618  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
2619  idhdl h=(idhdl)v->data;
2620  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
2621  res->data = (char *)idLiftStd((ideal)u->Data(),
2622                                &(h->data.umatrix),testHomog);
2623  setFlag(res,FLAG_STD); v->flag=0;
2624  return FALSE;
2625}
2626static BOOLEAN jjLOAD2(leftv /*res*/, leftv, leftv v)
2627{
2628  return jjLOAD((char*)v->Data(),TRUE);
2629}
2630static BOOLEAN jjLOAD_E(leftv /*res*/, leftv v, leftv u)
2631{
2632  char * s=(char *)u->Data();
2633  if(strcmp(s, "with")==0)
2634    return jjLOAD((char*)v->Data(), TRUE);
2635  WerrorS("invalid second argument");
2636  WerrorS("load(\"libname\" [,\"with\"]);");
2637  return TRUE;
2638}
2639static BOOLEAN jjMODULO(leftv res, leftv u, leftv v)
2640{
2641  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2642  tHomog hom=testHomog;
2643  if (w_u!=NULL)
2644  {
2645    w_u=ivCopy(w_u);
2646    hom=isHomog;
2647  }
2648  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
2649  if (w_v!=NULL)
2650  {
2651    w_v=ivCopy(w_v);
2652    hom=isHomog;
2653  }
2654  if ((w_u!=NULL) && (w_v==NULL))
2655    w_v=ivCopy(w_u);
2656  if ((w_v!=NULL) && (w_u==NULL))
2657    w_u=ivCopy(w_v);
2658  ideal u_id=(ideal)u->Data();
2659  ideal v_id=(ideal)v->Data();
2660  if (w_u!=NULL)
2661  {
2662     if ((*w_u).compare((w_v))!=0)
2663     {
2664       WarnS("incompatible weights");
2665       delete w_u; w_u=NULL;
2666       hom=testHomog;
2667     }
2668     else
2669     {
2670       if ((!idTestHomModule(u_id,currRing->qideal,w_v))
2671       || (!idTestHomModule(v_id,currRing->qideal,w_v)))
2672       {
2673         WarnS("wrong weights");
2674         delete w_u; w_u=NULL;
2675         hom=testHomog;
2676       }
2677     }
2678  }
2679  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u);
2680  if (w_u!=NULL)
2681  {
2682    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
2683  }
2684  delete w_v;
2685  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
2686  return FALSE;
2687}
2688static BOOLEAN jjMOD_BI(leftv res, leftv u, leftv v)
2689{
2690  number q=(number)v->Data();
2691  if (n_IsZero(q,coeffs_BIGINT))
2692  {
2693    WerrorS(ii_div_by_0);
2694    return TRUE;
2695  }
2696  res->data =(char *) n_IntMod((number)u->Data(),q,coeffs_BIGINT);
2697  return FALSE;
2698}
2699static BOOLEAN jjMOD_N(leftv res, leftv u, leftv v)
2700{
2701  number q=(number)v->Data();
2702  if (nIsZero(q))
2703  {
2704    WerrorS(ii_div_by_0);
2705    return TRUE;
2706  }
2707  res->data =(char *) n_IntMod((number)u->Data(),q,currRing->cf);
2708  return FALSE;
2709}
2710static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v);
2711static BOOLEAN jjMONITOR1(leftv res, leftv v)
2712{
2713  return jjMONITOR2(res,v,NULL);
2714}
2715static BOOLEAN jjMONITOR2(leftv, leftv u,leftv v)
2716{
2717#if 0
2718  char *opt=(char *)v->Data();
2719  int mode=0;
2720  while(*opt!='\0')
2721  {
2722    if (*opt=='i') mode |= SI_PROT_I;
2723    else if (*opt=='o') mode |= SI_PROT_O;
2724    opt++;
2725  }
2726  monitor((char *)(u->Data()),mode);
2727#else
2728  si_link l=(si_link)u->Data();
2729  if (slOpen(l,SI_LINK_WRITE,u)) return TRUE;
2730  if(strcmp(l->m->type,"ASCII")!=0)
2731  {
2732    Werror("ASCII link required, not `%s`",l->m->type);
2733    slClose(l);
2734    return TRUE;
2735  }
2736  SI_LINK_SET_CLOSE_P(l); // febase handles the FILE*
2737  if ( l->name[0]!='\0') // "" is the stop condition
2738  {
2739    const char *opt;
2740    int mode=0;
2741    if (v==NULL) opt=(const char*)"i";
2742    else         opt=(const char *)v->Data();
2743    while(*opt!='\0')
2744    {
2745      if (*opt=='i') mode |= SI_PROT_I;
2746      else if (*opt=='o') mode |= SI_PROT_O;
2747      opt++;
2748    }
2749    monitor((FILE *)l->data,mode);
2750  }
2751  else
2752    monitor(NULL,0);
2753  return FALSE;
2754#endif
2755}
2756static BOOLEAN jjMONOM(leftv res, leftv v)
2757{
2758  intvec *iv=(intvec *)v->Data();
2759  poly p=pOne();
2760  int i,e;
2761  BOOLEAN err=FALSE;
2762  for(i=si_min(currRing->N,iv->length()); i>0; i--)
2763  {
2764    e=(*iv)[i-1];
2765    if (e>=0) pSetExp(p,i,e);
2766    else err=TRUE;
2767  }
2768  if (iv->length()==(currRing->N+1))
2769  {
2770    res->rtyp=VECTOR_CMD;
2771    e=(*iv)[currRing->N];
2772    if (e>=0) pSetComp(p,e);
2773    else err=TRUE;
2774  }
2775  pSetm(p);
2776  res->data=(char*)p;
2777  if(err) { pDelete(&p); WerrorS("no negative exponent allowed"); }
2778  return err;
2779}
2780static BOOLEAN jjNEWSTRUCT2(leftv, leftv u, leftv v)
2781{
2782  // u: the name of the new type
2783  // v: the elements
2784  newstruct_desc d=newstructFromString((const char *)v->Data());
2785  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
2786  return d==NULL;
2787}
2788static BOOLEAN jjPARSTR2(leftv res, leftv u, leftv v)
2789{
2790  idhdl h=(idhdl)u->data;
2791  int i=(int)(long)v->Data();
2792  int p=0;
2793  if ((0<i)
2794  && (rParameter(IDRING(h))!=NULL)
2795  && (i<=(p=rPar(IDRING(h)))))
2796    res->data=omStrDup(rParameter(IDRING(h))[i-1]);
2797  else
2798  {
2799    Werror("par number %d out of range 1..%d",i,p);
2800    return TRUE;
2801  }
2802  return FALSE;
2803}
2804#ifdef HAVE_PLURAL
2805static BOOLEAN jjPlural_num_poly(leftv res, leftv a, leftv b)
2806{
2807  if( currRing->qideal != NULL )
2808  {
2809    WerrorS("basering must NOT be a qring!");
2810    return TRUE;
2811  }
2812
2813  if (iiOp==NCALGEBRA_CMD)
2814  {
2815    return nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),currRing,false,true,false,currRing);
2816  }
2817  else
2818  {
2819    ring r=rCopy(currRing);
2820    BOOLEAN result=nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),r,false,true,false,currRing);
2821    res->data=r;
2822    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2823    return result;
2824  }
2825}
2826static BOOLEAN jjPlural_num_mat(leftv res, leftv a, leftv b)
2827{
2828  if( currRing->qideal != NULL )
2829  {
2830    WerrorS("basering must NOT be a qring!");
2831    return TRUE;
2832  }
2833
2834  if (iiOp==NCALGEBRA_CMD)
2835  {
2836    return nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,currRing,false,true,false,currRing);
2837  }
2838  else
2839  {
2840    ring r=rCopy(currRing);
2841    BOOLEAN result=nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,r,false,true,false,currRing);
2842    res->data=r;
2843    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2844    return result;
2845  }
2846}
2847static BOOLEAN jjPlural_mat_poly(leftv res, leftv a, leftv b)
2848{
2849  if( currRing->qideal != NULL )
2850  {
2851    WerrorS("basering must NOT be a qring!");
2852    return TRUE;
2853  }
2854
2855  if (iiOp==NCALGEBRA_CMD)
2856  {
2857    return nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),currRing,false,true,false,currRing);
2858  }
2859  else
2860  {
2861    ring r=rCopy(currRing);
2862    BOOLEAN result=nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),r,false,true,false,currRing);
2863    res->data=r;
2864    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2865    return result;
2866  }
2867}
2868static BOOLEAN jjPlural_mat_mat(leftv res, leftv a, leftv b)
2869{
2870  if( currRing->qideal != NULL )
2871  {
2872    WerrorS("basering must NOT be a qring!");
2873    return TRUE;
2874  }
2875
2876  if (iiOp==NCALGEBRA_CMD)
2877  {
2878    return nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,currRing,false,true,false,currRing);
2879  }
2880  else
2881  {
2882    ring r=rCopy(currRing);
2883    BOOLEAN result=nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,r,false,true,false,currRing);
2884    res->data=r;
2885    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2886    return result;
2887  }
2888}
2889static BOOLEAN jjBRACKET(leftv res, leftv a, leftv b)
2890{
2891  res->data=NULL;
2892
2893  if (rIsPluralRing(currRing))
2894  {
2895    const poly q = (poly)b->Data();
2896
2897    if( q != NULL )
2898    {
2899      if( (poly)a->Data() != NULL )
2900      {
2901        poly p = (poly)a->CopyD(POLY_CMD); // p = copy!
2902        res->data = nc_p_Bracket_qq(p,q, currRing); // p will be destroyed!
2903      }
2904    }
2905  }
2906  return FALSE;
2907}
2908static BOOLEAN jjOPPOSE(leftv res, leftv a, leftv b)
2909{
2910  /* number, poly, vector, ideal, module, matrix */
2911  ring  r = (ring)a->Data();
2912  if (r == currRing)
2913  {
2914    res->data = b->Data();
2915    res->rtyp = b->rtyp;
2916    return FALSE;
2917  }
2918  if (!rIsLikeOpposite(currRing, r))
2919  {
2920    Werror("%s is not an opposite ring to current ring",a->Fullname());
2921    return TRUE;
2922  }
2923  idhdl w;
2924  if( ((w=r->idroot->get(b->Name(),myynest))!=NULL) && (b->e==NULL))
2925  {
2926    int argtype = IDTYP(w);
2927    switch (argtype)
2928    {
2929    case NUMBER_CMD:
2930      {
2931        /* since basefields are equal, we can apply nCopy */
2932        res->data = nCopy((number)IDDATA(w));
2933        res->rtyp = argtype;
2934        break;
2935      }
2936    case POLY_CMD:
2937    case VECTOR_CMD:
2938      {
2939        poly    q = (poly)IDDATA(w);
2940        res->data = pOppose(r,q,currRing);
2941        res->rtyp = argtype;
2942        break;
2943      }
2944    case IDEAL_CMD:
2945    case MODUL_CMD:
2946      {
2947        ideal   Q = (ideal)IDDATA(w);
2948        res->data = idOppose(r,Q,currRing);
2949        res->rtyp = argtype;
2950        break;
2951      }
2952    case MATRIX_CMD:
2953      {
2954        ring save = currRing;
2955        rChangeCurrRing(r);
2956        matrix  m = (matrix)IDDATA(w);
2957        ideal   Q = id_Matrix2Module(mp_Copy(m, currRing),currRing);
2958        rChangeCurrRing(save);
2959        ideal   S = idOppose(r,Q,currRing);
2960        id_Delete(&Q, r);
2961        res->data = id_Module2Matrix(S,currRing);
2962        res->rtyp = argtype;
2963        break;
2964      }
2965    default:
2966      {
2967        WerrorS("unsupported type in oppose");
2968        return TRUE;
2969      }
2970    }
2971  }
2972  else
2973  {
2974    Werror("identifier %s not found in %s",b->Fullname(),a->Fullname());
2975    return TRUE;
2976  }
2977  return FALSE;
2978}
2979#endif /* HAVE_PLURAL */
2980
2981static BOOLEAN jjQUOT(leftv res, leftv u, leftv v)
2982{
2983  res->data = (char *)idQuot((ideal)u->Data(),(ideal)v->Data(),
2984    hasFlag(u,FLAG_STD),u->Typ()==v->Typ());
2985  id_DelMultiples((ideal)(res->data),currRing);
2986  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
2987  return FALSE;
2988}
2989static BOOLEAN jjRANDOM(leftv res, leftv u, leftv v)
2990{
2991  int i=(int)(long)u->Data();
2992  int j=(int)(long)v->Data();
2993  if (j-i <0) {WerrorS("invalid range for random"); return TRUE;}
2994  res->data =(char *)(long)((i > j) ? i : (siRand() % (j-i+1)) + i);
2995  return FALSE;
2996}
2997static BOOLEAN jjRANK2(leftv res, leftv u, leftv v)
2998{
2999  matrix m =(matrix)u->Data();
3000  int isRowEchelon = (int)(long)v->Data();
3001  if (isRowEchelon != 1) isRowEchelon = 0;
3002  int rank = luRank(m, isRowEchelon);
3003  res->data =(char *)(long)rank;
3004  return FALSE;
3005}
3006static BOOLEAN jjREAD2(leftv res, leftv u, leftv v)
3007{
3008  si_link l=(si_link)u->Data();
3009  leftv r=slRead(l,v);
3010  if (r==NULL)
3011  {
3012    const char *s;
3013    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3014    else                            s=sNoName;
3015    Werror("cannot read from `%s`",s);
3016    return TRUE;
3017  }
3018  memcpy(res,r,sizeof(sleftv));
3019  omFreeBin((ADDRESS)r, sleftv_bin);
3020  return FALSE;
3021}
3022static BOOLEAN jjREDUCE_P(leftv res, leftv u, leftv v)
3023{
3024  assumeStdFlag(v);
3025  res->data = (char *)kNF((ideal)v->Data(),currRing->qideal,(poly)u->Data());
3026  return FALSE;
3027}
3028static BOOLEAN jjREDUCE_ID(leftv res, leftv u, leftv v)
3029{
3030  assumeStdFlag(v);
3031  ideal ui=(ideal)u->Data();
3032  ideal vi=(ideal)v->Data();
3033  res->data = (char *)kNF(vi,currRing->qideal,ui);
3034  return FALSE;
3035}
3036#if 0
3037static BOOLEAN jjRES(leftv res, leftv u, leftv v)
3038{
3039  int maxl=(int)(long)v->Data();
3040  if (maxl<0)
3041  {
3042    WerrorS("length for res must not be negative");
3043    return TRUE;
3044  }
3045  int l=0;
3046  //resolvente r;
3047  syStrategy r;
3048  intvec *weights=NULL;
3049  int wmaxl=maxl;
3050  ideal u_id=(ideal)u->Data();
3051
3052  maxl--;
3053  if (/*(*/ maxl==-1 /*)*/) /*&& (iiOp!=MRES_CMD)*/
3054  {
3055    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3056    if (currRing->qideal!=NULL)
3057    {
3058      Warn(
3059      "full resolution in a qring may be infinite, setting max length to %d",
3060      maxl+1);
3061    }
3062  }
3063  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3064  if (weights!=NULL)
3065  {
3066    if (!idTestHomModule(u_id,currRing->qideal,weights))
3067    {
3068      WarnS("wrong weights given:");weights->show();PrintLn();
3069      weights=NULL;
3070    }
3071  }
3072  intvec *ww=NULL;
3073  int add_row_shift=0;
3074  if (weights!=NULL)
3075  {
3076     ww=ivCopy(weights);
3077     add_row_shift = ww->min_in();
3078     (*ww) -= add_row_shift;
3079  }
3080  else
3081    idHomModule(u_id,currRing->qideal,&ww);
3082  weights=ww;
3083
3084  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3085  {
3086    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3087  }
3088  else if (iiOp==SRES_CMD)
3089  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3090    r=sySchreyer(u_id,maxl+1);
3091  else if (iiOp == LRES_CMD)
3092  {
3093    int dummy;
3094    if((currRing->qideal!=NULL)||
3095    (!idHomIdeal (u_id,NULL)))
3096    {
3097       WerrorS
3098       ("`lres` not implemented for inhomogeneous input or qring");
3099       return TRUE;
3100    }
3101    r=syLaScala3(u_id,&dummy);
3102  }
3103  else if (iiOp == KRES_CMD)
3104  {
3105    int dummy;
3106    if((currRing->qideal!=NULL)||
3107    (!idHomIdeal (u_id,NULL)))
3108    {
3109       WerrorS
3110       ("`kres` not implemented for inhomogeneous input or qring");
3111       return TRUE;
3112    }
3113    r=syKosz(u_id,&dummy);
3114  }
3115  else
3116  {
3117    int dummy;
3118    if((currRing->qideal!=NULL)||
3119    (!idHomIdeal (u_id,NULL)))
3120    {
3121       WerrorS
3122       ("`hres` not implemented for inhomogeneous input or qring");
3123       return TRUE;
3124    }
3125    r=syHilb(u_id,&dummy);
3126  }
3127  if (r==NULL) return TRUE;
3128  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3129  r->list_length=wmaxl;
3130  res->data=(void *)r;
3131  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3132  {
3133    intvec *w=ivCopy(r->weights[0]);
3134    if (weights!=NULL) (*w) += add_row_shift;
3135    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3136    w=NULL;
3137  }
3138  else
3139  {
3140//#if 0
3141// need to set weights for ALL components (sres)
3142    if (weights!=NULL)
3143    {
3144      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3145      r->weights = (intvec**)omAlloc0Bin(char_ptr_bin);
3146      (r->weights)[0] = ivCopy(weights);
3147    }
3148//#endif
3149  }
3150  if (ww!=NULL) { delete ww; ww=NULL; }
3151  return FALSE;
3152}
3153#else
3154static BOOLEAN jjRES(leftv res, leftv u, leftv v)
3155{
3156  int maxl=(int)(long)v->Data();
3157  if (maxl<0)
3158  {
3159    WerrorS("length for res must not be negative");
3160    return TRUE;
3161  }
3162  syStrategy r;
3163  intvec *weights=NULL;
3164  int wmaxl=maxl;
3165  ideal u_id=(ideal)u->Data();
3166
3167  maxl--;
3168  if (/*(*/ maxl==-1 /*)*/) /*&& (iiOp!=MRES_CMD)*/
3169  {
3170    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3171    if (currRing->qideal!=NULL)
3172    {
3173      Warn(
3174      "full resolution in a qring may be infinite, setting max length to %d",
3175      maxl+1);
3176    }
3177  }
3178  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3179  if (weights!=NULL)
3180  {
3181    if (!idTestHomModule(u_id,currRing->qideal,weights))
3182    {
3183      WarnS("wrong weights given:");weights->show();PrintLn();
3184      weights=NULL;
3185    }
3186  }
3187  intvec *ww=NULL;
3188  int add_row_shift=0;
3189  if (weights!=NULL)
3190  {
3191     ww=ivCopy(weights);
3192     add_row_shift = ww->min_in();
3193     (*ww) -= add_row_shift;
3194  }
3195  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3196  {
3197    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3198  }
3199  else if (iiOp==SRES_CMD)
3200  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3201    r=sySchreyer(u_id,maxl+1);
3202  else if (iiOp == LRES_CMD)
3203  {
3204    int dummy;
3205    if((currRing->qideal!=NULL)||
3206    (!idHomIdeal (u_id,NULL)))
3207    {
3208       WerrorS
3209       ("`lres` not implemented for inhomogeneous input or qring");
3210       return TRUE;
3211    }
3212    if(currRing->N == 1)
3213      WarnS("the current implementation of `lres` may not work in the case of a single variable");
3214    r=syLaScala3(u_id,&dummy);
3215  }
3216  else if (iiOp == KRES_CMD)
3217  {
3218    int dummy;
3219    if((currRing->qideal!=NULL)||
3220    (!idHomIdeal (u_id,NULL)))
3221    {
3222       WerrorS
3223       ("`kres` not implemented for inhomogeneous input or qring");
3224       return TRUE;
3225    }
3226    r=syKosz(u_id,&dummy);
3227  }
3228  else
3229  {
3230    int dummy;
3231    if((currRing->qideal!=NULL)||
3232    (!idHomIdeal (u_id,NULL)))
3233    {
3234       WerrorS
3235       ("`hres` not implemented for inhomogeneous input or qring");
3236       return TRUE;
3237    }
3238    ideal u_id_copy=idCopy(u_id);
3239    idSkipZeroes(u_id_copy);
3240    r=syHilb(u_id_copy,&dummy);
3241    idDelete(&u_id_copy);
3242  }
3243  if (r==NULL) return TRUE;
3244  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3245  r->list_length=wmaxl;
3246  res->data=(void *)r;
3247  if ((weights!=NULL) && (ww!=NULL)) { delete ww; ww=NULL; }
3248  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3249  {
3250    ww=ivCopy(r->weights[0]);
3251    if (weights!=NULL) (*ww) += add_row_shift;
3252    atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
3253  }
3254  else
3255  {
3256    if (weights!=NULL)
3257    {
3258      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3259    }
3260  }
3261
3262  // test the La Scala case' output
3263  assume( ((iiOp == LRES_CMD) || (iiOp == HRES_CMD)) == (r->syRing != NULL) );
3264  assume( (r->syRing != NULL) == (r->resPairs != NULL) );
3265
3266  if(iiOp != HRES_CMD)
3267    assume( (r->minres != NULL) || (r->fullres != NULL) ); // is wrong for HRES_CMD...
3268  else
3269    assume( (r->orderedRes != NULL) || (r->res != NULL) ); // analog for hres...
3270
3271  return FALSE;
3272}
3273#endif
3274static BOOLEAN jjPFAC2(leftv res, leftv u, leftv v)
3275{
3276  number n1; int i;
3277
3278  if ((u->Typ() == BIGINT_CMD) ||
3279     ((u->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3280  {
3281    n1 = (number)u->CopyD();
3282  }
3283  else if (u->Typ() == INT_CMD)
3284  {
3285    i = (int)(long)u->Data();
3286    n1 = n_Init(i, coeffs_BIGINT);
3287  }
3288  else
3289  {
3290    return TRUE;
3291  }
3292
3293  i = (int)(long)v->Data();
3294
3295  lists l = primeFactorisation(n1, i);
3296  n_Delete(&n1, coeffs_BIGINT);
3297  res->data = (char*)l;
3298  return FALSE;
3299}
3300static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
3301{
3302  ring r;
3303  int i=rSum((ring)u->Data(),(ring)v->Data(),r);
3304  res->data = (char *)r;
3305  return (i==-1);
3306}
3307#define SIMPL_LMDIV 32
3308#define SIMPL_LMEQ  16
3309#define SIMPL_MULT 8
3310#define SIMPL_EQU  4
3311#define SIMPL_NULL 2
3312#define SIMPL_NORM 1
3313static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
3314{
3315  int sw = (int)(long)v->Data();
3316  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
3317  ideal id = (ideal)u->CopyD(IDEAL_CMD);
3318  if (sw & SIMPL_LMDIV)
3319  {
3320    id_DelDiv(id,currRing);
3321  }
3322  if (sw & SIMPL_LMEQ)
3323  {
3324    id_DelLmEquals(id,currRing);
3325  }
3326  if (sw & SIMPL_MULT)
3327  {
3328    id_DelMultiples(id,currRing);
3329  }
3330  else if(sw & SIMPL_EQU)
3331  {
3332    id_DelEquals(id,currRing);
3333  }
3334  if (sw & SIMPL_NULL)
3335  {
3336    idSkipZeroes(id);
3337  }
3338  if (sw & SIMPL_NORM)
3339  {
3340    id_Norm(id,currRing);
3341  }
3342  res->data = (char * )id;
3343  return FALSE;
3344}
3345extern int singclap_factorize_retry;
3346static BOOLEAN jjSQR_FREE2(leftv res, leftv u, leftv dummy)
3347{
3348  intvec *v=NULL;
3349  int sw=(int)(long)dummy->Data();
3350  int fac_sw=sw;
3351  if (sw<0) fac_sw=1;
3352  singclap_factorize_retry=0;
3353  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, fac_sw, currRing);
3354  if (f==NULL)
3355    return TRUE;
3356  switch(sw)
3357  {
3358    case 0:
3359    case 2:
3360    {
3361      lists l=(lists)omAllocBin(slists_bin);
3362      l->Init(2);
3363      l->m[0].rtyp=IDEAL_CMD;
3364      l->m[0].data=(void *)f;
3365      l->m[1].rtyp=INTVEC_CMD;
3366      l->m[1].data=(void *)v;
3367      res->data=(void *)l;
3368      res->rtyp=LIST_CMD;
3369      return FALSE;
3370    }
3371    case 1:
3372      res->data=(void *)f;
3373      return FALSE;
3374    case 3:
3375      {
3376        poly p=f->m[0];
3377        int i=IDELEMS(f);
3378        f->m[0]=NULL;
3379        while(i>1)
3380        {
3381          i--;
3382          p=pMult(p,f->m[i]);
3383          f->m[i]=NULL;
3384        }
3385        res->data=(void *)p;
3386        res->rtyp=POLY_CMD;
3387      }
3388      return FALSE;
3389  }
3390  WerrorS("invalid switch");
3391  return FALSE;
3392}
3393static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
3394{
3395  res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
3396  return FALSE;
3397}
3398static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
3399{
3400  res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
3401  //return (res->data== (void*)(long)-2);
3402  return FALSE;
3403}
3404static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
3405{
3406  int sw = (int)(long)v->Data();
3407  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3408  poly p = (poly)u->CopyD(POLY_CMD);
3409  if (sw & SIMPL_NORM)
3410  {
3411    pNorm(p);
3412  }
3413  res->data = (char * )p;
3414  return FALSE;
3415}
3416static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
3417{
3418  ideal result;
3419  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3420  tHomog hom=testHomog;
3421  ideal u_id=(ideal)(u->Data());
3422  if (w!=NULL)
3423  {
3424    if (!idTestHomModule(u_id,currRing->qideal,w))
3425    {
3426      WarnS("wrong weights:");w->show();PrintLn();
3427      w=NULL;
3428    }
3429    else
3430    {
3431      w=ivCopy(w);
3432      hom=isHomog;
3433    }
3434  }
3435  result=kStd(u_id,currRing->qideal,hom,&w,(intvec *)v->Data());
3436  idSkipZeroes(result);
3437  res->data = (char *)result;
3438  setFlag(res,FLAG_STD);
3439  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3440  return FALSE;
3441}
3442static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v);
3443static void jjSTD_1_ID(leftv res, ideal i0, int t0, ideal p0, attr a)
3444/* destroys i0, p0 */
3445/* result (with attributes) in res */
3446/* i0: SB*/
3447/* t0: type of p0*/
3448/* p0 new elements*/
3449/* a attributes of i0*/
3450{
3451  int tp;
3452  if (t0==IDEAL_CMD) tp=POLY_CMD;
3453  else               tp=VECTOR_CMD;
3454  for (int i=IDELEMS(p0)-1; i>=0; i--)
3455  {
3456    poly p=p0->m[i];
3457    p0->m[i]=NULL;
3458    if (p!=NULL)
3459    {
3460      sleftv u0,v0;
3461      memset(&u0,0,sizeof(sleftv));
3462      memset(&v0,0,sizeof(sleftv));
3463      v0.rtyp=tp;
3464      v0.data=(void*)p;
3465      u0.rtyp=t0;
3466      u0.data=i0;
3467      u0.attribute=a;
3468      setFlag(&u0,FLAG_STD);
3469      jjSTD_1(res,&u0,&v0);
3470      i0=(ideal)res->data;
3471      res->data=NULL;
3472      a=res->attribute;
3473      res->attribute=NULL;
3474      u0.CleanUp();
3475      v0.CleanUp();
3476      res->CleanUp();
3477    }
3478  }
3479  idDelete(&p0);
3480  res->attribute=a;
3481  res->data=(void *)i0;
3482  res->rtyp=t0;
3483}
3484static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
3485{
3486  ideal result;
3487  assumeStdFlag(u);
3488  ideal i1=(ideal)(u->Data());
3489  ideal i0;
3490  int r=v->Typ();
3491  if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
3492  {
3493    i0=idInit(1,i1->rank); // TODO: rank is wrong (if v is a vector!)
3494    i0->m[0]=(poly)v->Data();
3495    int ii0=idElem(i0); /* size of i0 */
3496    i1=idSimpleAdd(i1,i0); //
3497    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3498    idDelete(&i0);
3499    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3500    tHomog hom=testHomog;
3501
3502    if (w!=NULL)
3503    {
3504      if (!idTestHomModule(i1,currRing->qideal,w))
3505      {
3506        // no warnung: this is legal, if i in std(i,p)
3507        // is homogeneous, but p not
3508        w=NULL;
3509      }
3510      else
3511      {
3512        w=ivCopy(w);
3513        hom=isHomog;
3514      }
3515    }
3516    BITSET save1;
3517    SI_SAVE_OPT1(save1);
3518    si_opt_1|=Sy_bit(OPT_SB_1);
3519    /* ii0 appears to be the position of the first element of il that
3520       does not belong to the old SB ideal */
3521    result=kStd(i1,currRing->qideal,hom,&w,NULL,0,ii0);
3522    SI_RESTORE_OPT1(save1);
3523    idDelete(&i1);
3524    idSkipZeroes(result);
3525    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3526    res->data = (char *)result;
3527  }
3528  else /*IDEAL/MODULE*/
3529  {
3530    attr *aa=u->Attribute();
3531    attr a=NULL;
3532    if (aa!=NULL) a=(*aa)->Copy();
3533    jjSTD_1_ID(res,(ideal)u->CopyD(),r,(ideal)v->CopyD(),a);
3534  }
3535  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
3536  return FALSE;
3537}
3538static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3539{
3540  idhdl h=(idhdl)u->data;
3541  int i=(int)(long)v->Data();
3542  if ((0<i) && (i<=IDRING(h)->N))
3543    res->data=omStrDup(IDRING(h)->names[i-1]);
3544  else
3545  {
3546    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3547    return TRUE;
3548  }
3549  return FALSE;
3550}
3551static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3552{
3553// input: u: a list with links of type
3554//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3555//        v: timeout for select in milliseconds
3556//           or 0 for polling
3557// returns: ERROR (via Werror): timeout negative
3558//           -1: the read state of all links is eof
3559//            0: timeout (or polling): none ready
3560//           i>0: (at least) L[i] is ready
3561  lists Lforks = (lists)u->Data();
3562  int t = (int)(long)v->Data();
3563  if(t < 0)
3564  {
3565    WerrorS("negative timeout"); return TRUE;
3566  }
3567  int i = slStatusSsiL(Lforks, t*1000);
3568  if(i == -2) /* error */
3569  {
3570    return TRUE;
3571  }
3572  res->data = (void*)(long)i;
3573  return FALSE;
3574}
3575static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3576{
3577// input: u: a list with links of type
3578//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3579//        v: timeout for select in milliseconds
3580//           or 0 for polling
3581// returns: ERROR (via Werror): timeout negative
3582//           -1: the read state of all links is eof
3583//           0: timeout (or polling): none ready
3584//           1: all links are ready
3585//              (caution: at least one is ready, but some maybe dead)
3586  lists Lforks = (lists)u->CopyD();
3587  int timeout = 1000*(int)(long)v->Data();
3588  if(timeout < 0)
3589  {
3590    WerrorS("negative timeout"); return TRUE;
3591  }
3592  int t = getRTimer()/TIMER_RESOLUTION;  // in seconds
3593  int i;
3594  int ret = -1;
3595  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
3596  {
3597    i = slStatusSsiL(Lforks, timeout);
3598    if(i > 0) /* Lforks[i] is ready */
3599    {
3600      ret = 1;
3601      Lforks->m[i-1].CleanUp();
3602      Lforks->m[i-1].rtyp=DEF_CMD;
3603      Lforks->m[i-1].data=NULL;
3604      timeout = si_max(0,timeout - 1000*(getRTimer()/TIMER_RESOLUTION - t));
3605    }
3606    else /* terminate the for loop */
3607    {
3608      if(i == -2) /* error */
3609      {
3610        return TRUE;
3611      }
3612      if(i == 0) /* timeout */
3613      {
3614        ret = 0;
3615      }
3616      break;
3617    }
3618  }
3619  Lforks->Clean();
3620  res->data = (void*)(long)ret;
3621  return FALSE;
3622}
3623static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3624{
3625  res->data = (char *)mp_Wedge((matrix)u->Data(),(int)(long)v->Data(),currRing);
3626  return FALSE;
3627}
3628#define jjWRONG2 (proc2)jjWRONG
3629#define jjWRONG3 (proc3)jjWRONG
3630static BOOLEAN jjWRONG(leftv, leftv)
3631{
3632  return TRUE;
3633}
3634
3635/*=================== operations with 1 arg.: static proc =================*/
3636/* must be ordered: first operations for chars (infix ops),
3637 * then alphabetically */
3638
3639static BOOLEAN jjDUMMY(leftv res, leftv u)
3640{
3641  res->data = (char *)u->CopyD();
3642  return FALSE;
3643}
3644static BOOLEAN jjNULL(leftv, leftv)
3645{
3646  return FALSE;
3647}
3648//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3649//{
3650//  res->data = (char *)((int)(long)u->Data()+1);
3651//  return FALSE;
3652//}
3653//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3654//{
3655//  res->data = (char *)((int)(long)u->Data()-1);
3656//  return FALSE;
3657//}
3658static BOOLEAN jjPLUSPLUS(leftv, leftv u)
3659{
3660  if (IDTYP((idhdl)u->data)==INT_CMD)
3661  {
3662    int i=IDINT((idhdl)u->data);
3663    if (iiOp==PLUSPLUS) i++;
3664    else                i--;
3665    IDDATA((idhdl)u->data)=(char *)(long)i;
3666    return FALSE;
3667  }
3668  return TRUE;
3669}
3670static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3671{
3672  number n=(number)u->CopyD(BIGINT_CMD);
3673  n=n_InpNeg(n,coeffs_BIGINT);
3674  res->data = (char *)n;
3675  return FALSE;
3676}
3677static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3678{
3679  res->data = (char *)(-(long)u->Data());
3680  return FALSE;
3681}
3682static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3683{
3684  number n=(number)u->CopyD(NUMBER_CMD);
3685  n=nInpNeg(n);
3686  res->data = (char *)n;
3687  return FALSE;
3688}
3689static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3690{
3691  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3692  return FALSE;
3693}
3694static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3695{
3696  poly m1=pISet(-1);
3697  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),m1,currRing);
3698  return FALSE;
3699}
3700static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3701{
3702  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3703  (*iv)*=(-1);
3704  res->data = (char *)iv;
3705  return FALSE;
3706}
3707static BOOLEAN jjUMINUS_BIM(leftv res, leftv u)
3708{
3709  bigintmat *bim=(bigintmat *)u->CopyD(BIGINTMAT_CMD);
3710  (*bim)*=(-1);
3711  res->data = (char *)bim;
3712  return FALSE;
3713}
3714static BOOLEAN jjPROC1(leftv res, leftv u)
3715{
3716  return jjPROC(res,u,NULL);
3717}
3718static BOOLEAN jjBAREISS(leftv res, leftv v)
3719{
3720  //matrix m=(matrix)v->Data();
3721  //lists l=mpBareiss(m,FALSE);
3722  intvec *iv;
3723  ideal m;
3724  sm_CallBareiss((ideal)v->Data(),0,0,m,&iv, currRing);
3725  lists l=(lists)omAllocBin(slists_bin);
3726  l->Init(2);
3727  l->m[0].rtyp=MODUL_CMD;
3728  l->m[1].rtyp=INTVEC_CMD;
3729  l->m[0].data=(void *)m;
3730  l->m[1].data=(void *)iv;
3731  res->data = (char *)l;
3732  return FALSE;
3733}
3734//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3735//{
3736//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3737//  ivTriangMat(m);
3738//  res->data = (char *)m;
3739//  return FALSE;
3740//}
3741static BOOLEAN jjBI2N(leftv res, leftv u)
3742{
3743  BOOLEAN bo=FALSE;
3744  number n=(number)u->CopyD();
3745  nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
3746  if (nMap!=NULL)
3747    res->data=nMap(n,coeffs_BIGINT,currRing->cf);
3748  else
3749  {
3750    Werror("cannot convert bigint to cring %s",currRing->cf->cfCoeffString(currRing->cf));
3751    bo=TRUE;
3752  }
3753  n_Delete(&n,coeffs_BIGINT);
3754  return bo;
3755}
3756static BOOLEAN jjBI2P(leftv res, leftv u)
3757{
3758  sleftv tmp;
3759  BOOLEAN bo=jjBI2N(&tmp,u);
3760  if (!bo)
3761  {
3762    number n=(number) tmp.data;
3763    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3764    else
3765    {
3766      res->data=(void *)pNSet(n);
3767    }
3768  }
3769  return bo;
3770}
3771static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3772{
3773  return iiExprArithM(res,u,iiOp);
3774}
3775static BOOLEAN jjCHAR(leftv res, leftv v)
3776{
3777  res->data = (char *)(long)rChar((ring)v->Data());
3778  return FALSE;
3779}
3780static BOOLEAN jjCOLS(leftv res, leftv v)
3781{
3782  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3783  return FALSE;
3784}
3785static BOOLEAN jjCOLS_BIM(leftv res, leftv v)
3786{
3787  res->data = (char *)(long)((bigintmat*)(v->Data()))->cols();
3788  return FALSE;
3789}
3790static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3791{
3792  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3793  return FALSE;
3794}
3795static BOOLEAN jjCONTENT(leftv res, leftv v)
3796{
3797  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3798  poly p=(poly)v->CopyD(POLY_CMD);
3799  if (p!=NULL) p_Cleardenom(p, currRing);
3800  res->data = (char *)p;
3801  return FALSE;
3802}
3803static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3804{
3805  res->data = (char *)(long)n_Size((number)v->Data(),coeffs_BIGINT);
3806  return FALSE;
3807}
3808static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3809{
3810  res->data = (char *)(long)nSize((number)v->Data());
3811  return FALSE;
3812}
3813static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3814{
3815  lists l=(lists)v->Data();
3816  res->data = (char *)(long)(lSize(l)+1);
3817  return FALSE;
3818}
3819static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3820{
3821  matrix m=(matrix)v->Data();
3822  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3823  return FALSE;
3824}
3825static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3826{
3827  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3828  return FALSE;
3829}
3830static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3831{
3832  ring r=(ring)v->Data();
3833  int elems=-1;
3834  if (rField_is_Zp(r)||rField_is_GF(r)) elems=r->cf->ch;
3835  else if (rField_is_Zp_a(r) && (r->cf->type==n_algExt))
3836  {
3837    extern int ipower ( int b, int n ); /* factory/cf_util */
3838    elems=ipower(r->cf->ch,r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3839  }
3840  res->data = (char *)(long)elems;
3841  return FALSE;
3842}
3843static BOOLEAN jjDEG(leftv res, leftv v)
3844{
3845  int dummy;
3846  poly p=(poly)v->Data();
3847  if (p!=NULL) res->data = (char *)currRing->pLDeg(p,&dummy,currRing);
3848  else res->data=(char *)-1;
3849  return FALSE;
3850}
3851static BOOLEAN jjDEG_M(leftv res, leftv u)
3852{
3853  ideal I=(ideal)u->Data();
3854  int d=-1;
3855  int dummy;
3856  int i;
3857  for(i=IDELEMS(I)-1;i>=0;i--)
3858    if (I->m[i]!=NULL) d=si_max(d,(int)currRing->pLDeg(I->m[i],&dummy,currRing));
3859  res->data = (char *)(long)d;
3860  return FALSE;
3861}
3862static BOOLEAN jjDEGREE(leftv res, leftv v)
3863{
3864  SPrintStart();
3865#ifdef HAVE_RINGS
3866  if (rField_is_Ring_Z(currRing))
3867  {
3868    ring origR = currRing;
3869    ring tempR = rCopy(origR);
3870    coeffs new_cf=nInitChar(n_Q,NULL);
3871    nKillChar(tempR->cf);
3872    tempR->cf=new_cf;
3873    rComplete(tempR);
3874    ideal vid = (ideal)v->Data();
3875    rChangeCurrRing(tempR);
3876    ideal vv = idrCopyR(vid, origR, currRing);
3877    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
3878    vvAsLeftv.rtyp = IDEAL_CMD;
3879    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
3880    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
3881    assumeStdFlag(&vvAsLeftv);
3882    Print("// NOTE: computation of degree is being performed for\n");
3883    Print("//       generic fibre, that is, over Q\n");
3884    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
3885    scDegree(vv,module_w,currRing->qideal);
3886    idDelete(&vv);
3887    rChangeCurrRing(origR);
3888    rDelete(tempR);
3889  }
3890#endif
3891  assumeStdFlag(v);
3892  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3893  scDegree((ideal)v->Data(),module_w,currRing->qideal);
3894  char *s=SPrintEnd();
3895  int l=strlen(s)-1;
3896  s[l]='\0';
3897  res->data=(void*)s;
3898  return FALSE;
3899}
3900static BOOLEAN jjDEFINED(leftv res, leftv v)
3901{
3902  if ((v->rtyp==IDHDL)
3903  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3904  {
3905    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3906  }
3907  else if (v->rtyp!=0) res->data=(void *)(-1);
3908  return FALSE;
3909}
3910
3911/// Return the denominator of the input number
3912/// NOTE: the input number is normalized as a side effect
3913static BOOLEAN jjDENOMINATOR(leftv res, leftv v)
3914{
3915  number n = reinterpret_cast<number>(v->Data());
3916  res->data = reinterpret_cast<void*>(n_GetDenom(n, currRing));
3917  return FALSE;
3918}
3919
3920/// Return the numerator of the input number
3921/// NOTE: the input number is normalized as a side effect
3922static BOOLEAN jjNUMERATOR(leftv res, leftv v)
3923{
3924  number n = reinterpret_cast<number>(v->Data());
3925  res->data = reinterpret_cast<void*>(n_GetNumerator(n, currRing));
3926  return FALSE;
3927}
3928
3929static BOOLEAN jjDET(leftv res, leftv v)
3930{
3931  matrix m=(matrix)v->Data();
3932  poly p;
3933  if (sm_CheckDet((ideal)m,m->cols(),TRUE, currRing))
3934  {
3935    ideal I=id_Matrix2Module(mp_Copy(m, currRing),currRing);
3936    p=sm_CallDet(I, currRing);
3937    idDelete(&I);
3938  }
3939  else
3940    p=singclap_det(m,currRing);
3941  res ->data = (char *)p;
3942  return FALSE;
3943}
3944static BOOLEAN jjDET_BI(leftv res, leftv v)
3945{
3946  bigintmat * m=(bigintmat*)v->Data();
3947  int i,j;
3948  i=m->rows();j=m->cols();
3949  if(i==j)
3950    res->data = (char *)(long)singclap_det_bi(m,coeffs_BIGINT);
3951  else
3952  {
3953    Werror("det of %d x %d bigintmat",i,j);
3954    return TRUE;
3955  }
3956  return FALSE;
3957}
3958static BOOLEAN jjDET_I(leftv res, leftv v)
3959{
3960  intvec * m=(intvec*)v->Data();
3961  int i,j;
3962  i=m->rows();j=m->cols();
3963  if(i==j)
3964    res->data = (char *)(long)singclap_det_i(m,currRing);
3965  else
3966  {
3967    Werror("det of %d x %d intmat",i,j);
3968    return TRUE;
3969  }
3970  return FALSE;
3971}
3972static BOOLEAN jjDET_S(leftv res, leftv v)
3973{
3974  ideal I=(ideal)v->Data();
3975  poly p;
3976  if (IDELEMS(I)<1) return TRUE;
3977  if (sm_CheckDet(I,IDELEMS(I),FALSE, currRing))
3978  {
3979    matrix m=id_Module2Matrix(id_Copy(I,currRing),currRing);
3980    p=singclap_det(m,currRing);
3981    idDelete((ideal *)&m);
3982  }
3983  else
3984    p=sm_CallDet(I, currRing);
3985  res->data = (char *)p;
3986  return FALSE;
3987}
3988static BOOLEAN jjDIM(leftv res, leftv v)
3989{
3990  assumeStdFlag(v);
3991#ifdef HAVE_RINGS
3992  if (rField_is_Ring(currRing))
3993  {
3994    //ring origR = currRing;
3995    //ring tempR = rCopy(origR);
3996    //coeffs new_cf=nInitChar(n_Q,NULL);
3997    //nKillChar(tempR->cf);
3998    //tempR->cf=new_cf;
3999    //rComplete(tempR);
4000    ideal vid = (ideal)v->Data();
4001    int i = idPosConstant(vid);
4002    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
4003    { /* ideal v contains unit; dim = -1 */
4004      res->data = (char *)-1;
4005      return FALSE;
4006    }
4007    //rChangeCurrRing(tempR);
4008    //ideal vv = idrCopyR(vid, origR, currRing);
4009    ideal vv = id_Head(vid,currRing);
4010    /* drop degree zero generator from vv (if any) */
4011    if (i != -1) pDelete(&vv->m[i]);
4012    long d = (long)scDimInt(vv, currRing->qideal);
4013    if (rField_is_Ring_Z(currRing) && (i == -1)) d++;
4014    res->data = (char *)d;
4015    idDelete(&vv);
4016    //rChangeCurrRing(origR);
4017    //rDelete(tempR);
4018    return FALSE;
4019  }
4020#endif
4021  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currRing->qideal);
4022  return FALSE;
4023}
4024static BOOLEAN jjDUMP(leftv, leftv v)
4025{
4026  si_link l = (si_link)v->Data();
4027  if (slDump(l))
4028  {
4029    const char *s;
4030    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4031    else                            s=sNoName;
4032    Werror("cannot dump to `%s`",s);
4033    return TRUE;
4034  }
4035  else
4036    return FALSE;
4037}
4038static BOOLEAN jjE(leftv res, leftv v)
4039{
4040  res->data = (char *)pOne();
4041  int co=(int)(long)v->Data();
4042  if (co>0)
4043  {
4044    pSetComp((poly)res->data,co);
4045    pSetm((poly)res->data);
4046  }
4047  else WerrorS("argument of gen must be positive");
4048  return (co<=0);
4049}
4050static BOOLEAN jjEXECUTE(leftv, leftv v)
4051{
4052  char * d = (char *)v->Data();
4053  char * s = (char *)omAlloc(strlen(d) + 13);
4054  strcpy( s, (char *)d);
4055  strcat( s, "\n;RETURN();\n");
4056  newBuffer(s,BT_execute);
4057  return yyparse();
4058}
4059static BOOLEAN jjFACSTD(leftv res, leftv v)
4060{
4061  lists L=(lists)omAllocBin(slists_bin);
4062  if (currRing->cf->convSingNFactoryN!=NULL) /* conversion to factory*/
4063  {
4064    ideal_list p,h;
4065    h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
4066    if (h==NULL)
4067    {
4068      L->Init(1);
4069      L->m[0].data=(char *)idInit(1);
4070      L->m[0].rtyp=IDEAL_CMD;
4071    }
4072    else
4073    {
4074      p=h;
4075      int l=0;
4076      while (p!=NULL) { p=p->next;l++; }
4077      L->Init(l);
4078      l=0;
4079      while(h!=NULL)
4080      {
4081        L->m[l].data=(char *)h->d;
4082        L->m[l].rtyp=IDEAL_CMD;
4083        p=h->next;
4084        omFreeSize(h,sizeof(*h));
4085        h=p;
4086        l++;
4087      }
4088    }
4089  }
4090  else
4091  {
4092    WarnS("no factorization implemented");
4093    L->Init(1);
4094    iiExprArith1(&(L->m[0]),v,STD_CMD);
4095  }
4096  res->data=(void *)L;
4097  return FALSE;
4098}
4099static BOOLEAN jjFAC_P(leftv res, leftv u)
4100{
4101  intvec *v=NULL;
4102  singclap_factorize_retry=0;
4103  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0,currRing);
4104  if (f==NULL) return TRUE;
4105  ivTest(v);
4106  lists l=(lists)omAllocBin(slists_bin);
4107  l->Init(2);
4108  l->m[0].rtyp=IDEAL_CMD;
4109  l->m[0].data=(void *)f;
4110  l->m[1].rtyp=INTVEC_CMD;
4111  l->m[1].data=(void *)v;
4112  res->data=(void *)l;
4113  return FALSE;
4114}
4115static BOOLEAN jjGETDUMP(leftv, leftv v)
4116{
4117  si_link l = (si_link)v->Data();
4118  if (slGetDump(l))
4119  {
4120    const char *s;
4121    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4122    else                            s=sNoName;
4123    Werror("cannot get dump from `%s`",s);
4124    return TRUE;
4125  }
4126  else
4127    return FALSE;
4128}
4129static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
4130{
4131  assumeStdFlag(v);
4132  ideal I=(ideal)v->Data();
4133  res->data=(void *)iiHighCorner(I,0);
4134  return FALSE;
4135}
4136static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
4137{
4138  assumeStdFlag(v);
4139  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4140  BOOLEAN delete_w=FALSE;
4141  ideal I=(ideal)v->Data();
4142  int i;
4143  poly p=NULL,po=NULL;
4144  int rk=id_RankFreeModule(I,currRing);
4145  if (w==NULL)
4146  {
4147    w = new intvec(rk);
4148    delete_w=TRUE;
4149  }
4150  for(i=rk;i>0;i--)
4151  {
4152    p=iiHighCorner(I,i);
4153    if (p==NULL)
4154    {
4155      WerrorS("module must be zero-dimensional");
4156      if (delete_w) delete w;
4157      return TRUE;
4158    }
4159    if (po==NULL)
4160    {
4161      po=p;
4162    }
4163    else
4164    {
4165      // now po!=NULL, p!=NULL
4166      int d=(currRing->pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - currRing->pFDeg(p,currRing)+(*w)[i-1]);
4167      if (d==0)
4168        d=pLmCmp(po,p);
4169      if (d > 0)
4170      {
4171        pDelete(&p);
4172      }
4173      else // (d < 0)
4174      {
4175        pDelete(&po); po=p;
4176      }
4177    }
4178  }
4179  if (delete_w) delete w;
4180  res->data=(void *)po;
4181  return FALSE;
4182}
4183static BOOLEAN jjHILBERT(leftv, leftv v)
4184{
4185#ifdef HAVE_RINGS
4186  if (rField_is_Ring_Z(currRing))
4187  {
4188    ring origR = currRing;
4189    ring tempR = rCopy(origR);
4190    coeffs new_cf=nInitChar(n_Q,NULL);
4191    nKillChar(tempR->cf);
4192    tempR->cf=new_cf;
4193    rComplete(tempR);
4194    ideal vid = (ideal)v->Data();
4195    rChangeCurrRing(tempR);
4196    ideal vv = idrCopyR(vid, origR, currRing);
4197    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
4198    vvAsLeftv.rtyp = IDEAL_CMD;
4199    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
4200    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
4201    assumeStdFlag(&vvAsLeftv);
4202    Print("// NOTE: computation of Hilbert series etc. is being\n");
4203    Print("//       performed for generic fibre, that is, over Q\n");
4204    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
4205    //scHilbertPoly(vv,currRing->qideal);
4206    hLookSeries(vv,module_w,currRing->qideal);
4207    idDelete(&vv);
4208    rChangeCurrRing(origR);
4209    rDelete(tempR);
4210    return FALSE;
4211  }
4212#endif
4213  assumeStdFlag(v);
4214  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4215  //scHilbertPoly((ideal)v->Data(),currRing->qideal);
4216  hLookSeries((ideal)v->Data(),module_w,currRing->qideal);
4217  return FALSE;
4218}
4219static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
4220{
4221#ifdef HAVE_RINGS
4222  if (rField_is_Ring_Z(currRing))
4223  {
4224    Print("// NOTE: computation of Hilbert series etc. is being\n");
4225    Print("//       performed for generic fibre, that is, over Q\n");
4226  }
4227#endif
4228  res->data=(void *)hSecondSeries((intvec *)v->Data());
4229  return FALSE;
4230}
4231static BOOLEAN jjHOMOG1(leftv res, leftv v)
4232{
4233  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4234  ideal v_id=(ideal)v->Data();
4235  if (w==NULL)
4236  {
4237    res->data=(void *)(long)idHomModule(v_id,currRing->qideal,&w);
4238    if (res->data!=NULL)
4239    {
4240      if (v->rtyp==IDHDL)
4241      {
4242        char *s_isHomog=omStrDup("isHomog");
4243        if (v->e==NULL)
4244          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
4245        else
4246          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
4247      }
4248      else if (w!=NULL) delete w;
4249    } // if res->data==NULL then w==NULL
4250  }
4251  else
4252  {
4253    res->data=(void *)(long)idTestHomModule(v_id,currRing->qideal,w);
4254    if((res->data==NULL) && (v->rtyp==IDHDL))
4255    {
4256      if (v->e==NULL)
4257        atKill((idhdl)(v->data),"isHomog");
4258      else
4259        atKill((idhdl)(v->LData()),"isHomog");
4260    }
4261  }
4262  return FALSE;
4263}
4264static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
4265{
4266  res->data = (char *)idMaxIdeal((int)(long)v->Data());
4267  setFlag(res,FLAG_STD);
4268  return FALSE;
4269}
4270static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
4271{
4272  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
4273  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
4274  if (IDELEMS((ideal)mat)==0)
4275  {
4276    idDelete((ideal *)&mat);
4277    mat=(matrix)idInit(1,1);
4278  }
4279  else
4280  {
4281    MATROWS(mat)=1;
4282    mat->rank=1;
4283    idTest((ideal)mat);
4284  }
4285  res->data=(char *)mat;
4286  return FALSE;
4287}
4288static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4289{
4290  map m=(map)v->CopyD(MAP_CMD);
4291  omFree((ADDRESS)m->preimage);
4292  m->preimage=NULL;
4293  ideal I=(ideal)m;
4294  I->rank=1;
4295  res->data=(char *)I;
4296  return FALSE;
4297}
4298static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4299{
4300  if (currRing!=NULL)
4301  {
4302    ring q=(ring)v->Data();
4303    if (rSamePolyRep(currRing, q))
4304    {
4305      if (q->qideal==NULL)
4306        res->data=(char *)idInit(1,1);
4307      else
4308        res->data=(char *)idCopy(q->qideal);
4309      return FALSE;
4310    }
4311  }
4312  WerrorS("can only get ideal from identical qring");
4313  return TRUE;
4314}
4315static BOOLEAN jjIm2Iv(leftv res, leftv v)
4316{
4317  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4318  iv->makeVector();
4319  res->data = iv;
4320  return FALSE;
4321}
4322static BOOLEAN jjIMPART(leftv res, leftv v)
4323{
4324  res->data = (char *)n_ImPart((number)v->Data(),currRing->cf);
4325  return FALSE;
4326}
4327static BOOLEAN jjINDEPSET(leftv res, leftv v)
4328{
4329  assumeStdFlag(v);
4330  res->data=(void *)scIndIntvec((ideal)(v->Data()),currRing->qideal);
4331  return FALSE;
4332}
4333static BOOLEAN jjINTERRED(leftv res, leftv v)
4334{
4335  ideal result=kInterRed((ideal)(v->Data()), currRing->qideal);
4336  #ifdef HAVE_RINGS
4337  if(rField_is_Ring(currRing))
4338    Warn("interred: this command is experimental over the integers");
4339  #endif
4340  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4341  res->data = result;
4342  return FALSE;
4343}
4344static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4345{
4346  res->data = (char *)(long)pVar((poly)v->Data());
4347  return FALSE;
4348}
4349static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4350{
4351  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing->names,
4352                                                            currRing->N)+1);
4353  return FALSE;
4354}
4355static BOOLEAN jjIS_RINGVAR0(leftv res, leftv)
4356{
4357  res->data = (char *)0;
4358  return FALSE;
4359}
4360static BOOLEAN jjJACOB_P(leftv res, leftv v)
4361{
4362  ideal i=idInit(currRing->N,1);
4363  int k;
4364  poly p=(poly)(v->Data());
4365  for (k=currRing->N;k>0;k--)
4366  {
4367    i->m[k-1]=pDiff(p,k);
4368  }
4369  res->data = (char *)i;
4370  return FALSE;
4371}
4372static BOOLEAN jjDIFF_COEF(leftv res, leftv u, leftv v)
4373{
4374  if (!nCoeff_is_transExt(currRing->cf))
4375  {
4376    WerrorS("differentiation not defined in the coefficient ring");
4377    return TRUE;
4378  }
4379  number n = (number) u->Data();
4380  number k = (number) v->Data();
4381  res->data = ntDiff(n,k,currRing->cf);
4382  return FALSE;
4383}
4384/*2
4385 * compute Jacobi matrix of a module/matrix
4386 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(currRing->N))  ),
4387 * where Mt := transpose(M)
4388 * Note that this is consistent with the current conventions for jacob in Singular,
4389 * whereas M2 computes its transposed.
4390 */
4391static BOOLEAN jjJACOB_M(leftv res, leftv a)
4392{
4393  ideal id = (ideal)a->Data();
4394  id = idTransp(id);
4395  int W = IDELEMS(id);
4396
4397  ideal result = idInit(W * currRing->N, id->rank);
4398  poly *p = result->m;
4399
4400  for( int v = 1; v <= currRing->N; v++ )
4401  {
4402    poly* q = id->m;
4403    for( int i = 0; i < W; i++, p++, q++ )
4404      *p = pDiff( *q, v );
4405  }
4406  idDelete(&id);
4407
4408  res->data = (char *)result;
4409  return FALSE;
4410}
4411
4412
4413static BOOLEAN jjKBASE(leftv res, leftv v)
4414{
4415  assumeStdFlag(v);
4416  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currRing->qideal);
4417  return FALSE;
4418}
4419static BOOLEAN jjL2R(leftv res, leftv v)
4420{
4421  res->data=(char *)syConvList((lists)v->Data(),FALSE);
4422  if (res->data != NULL)
4423    return FALSE;
4424  else
4425    return TRUE;
4426}
4427static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4428{
4429  poly p=(poly)v->Data();
4430  if (p==NULL)
4431  {
4432    res->data=(char *)nInit(0);
4433  }
4434  else
4435  {
4436    res->data=(char *)nCopy(pGetCoeff(p));
4437  }
4438  return FALSE;
4439}
4440static BOOLEAN jjLEADEXP(leftv res, leftv v)
4441{
4442  poly p=(poly)v->Data();
4443  int s=currRing->N;
4444  if (v->Typ()==VECTOR_CMD) s++;
4445  intvec *iv=new intvec(s);
4446  if (p!=NULL)
4447  {
4448    for(int i = currRing->N;i;i--)
4449    {
4450      (*iv)[i-1]=pGetExp(p,i);
4451    }
4452    if (s!=currRing->N)
4453      (*iv)[currRing->N]=pGetComp(p);
4454  }
4455  res->data=(char *)iv;
4456  return FALSE;
4457}
4458static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4459{
4460  poly p=(poly)v->Data();
4461  if (p == NULL)
4462  {
4463    res->data = (char*) NULL;
4464  }
4465  else
4466  {
4467    poly lm = pLmInit(p);
4468    pSetCoeff(lm, nInit(1));
4469    res->data = (char*) lm;
4470  }
4471  return FALSE;
4472}
4473static BOOLEAN jjLOAD1(leftv /*res*/, leftv v)
4474{
4475  return jjLOAD((char*)v->Data(),FALSE);
4476}
4477static BOOLEAN jjLISTRING(leftv res, leftv v)
4478{
4479  ring r=rCompose((lists)v->Data());
4480  if (r==NULL) return TRUE;
4481  if (r->qideal!=NULL) res->rtyp=QRING_CMD;
4482  res->data=(char *)r;
4483  return FALSE;
4484}
4485static BOOLEAN jjPFAC1(leftv res, leftv v)
4486{
4487  /* call method jjPFAC2 with second argument = 0 (meaning that no
4488     valid bound for the prime factors has been given) */
4489  sleftv tmp;
4490  memset(&tmp, 0, sizeof(tmp));
4491  tmp.rtyp = INT_CMD;
4492  return jjPFAC2(res, v, &tmp);
4493}
4494static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4495{
4496  /* computes the LU-decomposition of a matrix M;
4497     i.e., M = P * L * U, where
4498        - P is a row permutation matrix,
4499        - L is in lower triangular form,
4500        - U is in upper row echelon form
4501     Then, we also have P * M = L * U.
4502     A list [P, L, U] is returned. */
4503  matrix mat = (const matrix)v->Data();
4504  if (!idIsConstant((ideal)mat))
4505  {
4506    WerrorS("matrix must be constant");
4507    return TRUE;
4508  }
4509  matrix pMat;
4510  matrix lMat;
4511  matrix uMat;
4512
4513  luDecomp(mat, pMat, lMat, uMat);
4514
4515  lists ll = (lists)omAllocBin(slists_bin);
4516  ll->Init(3);
4517  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4518  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4519  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4520  res->data=(char*)ll;
4521
4522  return FALSE;
4523}
4524static BOOLEAN jjMEMORY(leftv res, leftv v)
4525{
4526  omUpdateInfo();
4527  switch(((int)(long)v->Data()))
4528  {
4529  case 0:
4530    res->data=(char *)n_Init(om_Info.UsedBytes,coeffs_BIGINT);
4531    break;
4532  case 1:
4533    res->data = (char *)n_Init(om_Info.CurrentBytesSystem,coeffs_BIGINT);
4534    break;
4535  case 2:
4536    res->data = (char *)n_Init(om_Info.MaxBytesSystem,coeffs_BIGINT);
4537    break;
4538  default:
4539    omPrintStats(stdout);
4540    omPrintInfo(stdout);
4541    omPrintBinStats(stdout);
4542    res->data = (char *)0;
4543    res->rtyp = NONE;
4544  }
4545  return FALSE;
4546  res->data = (char *)0;
4547  return FALSE;
4548}
4549//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4550//{
4551//  return jjMONITOR2(res,v,NULL);
4552//}
4553static BOOLEAN jjMSTD(leftv res, leftv v)
4554{
4555  int t=v->Typ();
4556  ideal r,m;
4557  r=kMin_std((ideal)v->Data(),currRing->qideal,testHomog,NULL,m);
4558  lists l=(lists)omAllocBin(slists_bin);
4559  l->Init(2);
4560  l->m[0].rtyp=t;
4561  l->m[0].data=(char *)r;
4562  setFlag(&(l->m[0]),FLAG_STD);
4563  l->m[1].rtyp=t;
4564  l->m[1].data=(char *)m;
4565  res->data=(char *)l;
4566  return FALSE;
4567}
4568static BOOLEAN jjMULT(leftv res, leftv v)
4569{
4570  assumeStdFlag(v);
4571  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currRing->qideal);
4572  return FALSE;
4573}
4574static BOOLEAN jjMINRES_R(leftv res, leftv v)
4575{
4576  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4577
4578  syStrategy tmp=(syStrategy)v->Data();
4579  tmp = syMinimize(tmp); // enrich itself!
4580
4581  res->data=(char *)tmp;
4582
4583  if (weights!=NULL)
4584    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4585
4586  return FALSE;
4587}
4588static BOOLEAN jjN2BI(leftv res, leftv v)
4589{
4590  number n,i; i=(number)v->Data();
4591  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4592  if (nMap!=NULL)
4593    n=nMap(i,currRing->cf,coeffs_BIGINT);
4594  else goto err;
4595  res->data=(void *)n;
4596  return FALSE;
4597err:
4598  WerrorS("cannot convert to bigint"); return TRUE;
4599}
4600static BOOLEAN jjNAMEOF(leftv res, leftv v)
4601{
4602  res->data = (char *)v->name;
4603  if (res->data==NULL) res->data=omStrDup("");
4604  v->name=NULL;
4605  return FALSE;
4606}
4607static BOOLEAN jjNAMES(leftv res, leftv v)
4608{
4609  res->data=ipNameList(((ring)v->Data())->idroot);
4610  return FALSE;
4611}
4612static BOOLEAN jjNAMES_I(leftv res, leftv v)
4613{
4614  res->data=ipNameListLev((IDROOT),(int)(long)v->Data());
4615  return FALSE;
4616}
4617static BOOLEAN jjNOT(leftv res, leftv v)
4618{
4619  res->data=(char*)(long)((long)v->Data()==0 ? 1 : 0);
4620  return FALSE;
4621}
4622static BOOLEAN jjNVARS(leftv res, leftv v)
4623{
4624  res->data = (char *)(long)(((ring)(v->Data()))->N);
4625  return FALSE;
4626}
4627static BOOLEAN jjOpenClose(leftv, leftv v)
4628{
4629  si_link l=(si_link)v->Data();
4630  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4631  else                return slClose(l);
4632}
4633static BOOLEAN jjORD(leftv res, leftv v)
4634{
4635  poly p=(poly)v->Data();
4636  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4637  return FALSE;
4638}
4639static BOOLEAN jjPAR1(leftv res, leftv v)
4640{
4641  int i=(int)(long)v->Data();
4642  int p=0;
4643  p=rPar(currRing);
4644  if ((0<i) && (i<=p))
4645  {
4646    res->data=(char *)n_Param(i,currRing);
4647  }
4648  else
4649  {
4650    Werror("par number %d out of range 1..%d",i,p);
4651    return TRUE;
4652  }
4653  return FALSE;
4654}
4655static BOOLEAN jjPARDEG(leftv res, leftv v)
4656{
4657  number nn=(number)v->Data();
4658  res->data = (char *)(long)n_ParDeg(nn, currRing);
4659  return FALSE;
4660}
4661static BOOLEAN jjPARSTR1(leftv res, leftv v)
4662{
4663  if (currRing==NULL)
4664  {
4665    WerrorS("no ring active");
4666    return TRUE;
4667  }
4668  int i=(int)(long)v->Data();
4669  int p=0;
4670  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4671    res->data=omStrDup(rParameter(currRing)[i-1]);
4672  else
4673  {
4674    Werror("par number %d out of range 1..%d",i,p);
4675    return TRUE;
4676  }
4677  return FALSE;
4678}
4679static BOOLEAN jjP2BI(leftv res, leftv v)
4680{
4681  poly p=(poly)v->Data();
4682  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4683  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4684  {
4685    WerrorS("poly must be constant");
4686    return TRUE;
4687  }
4688  number i=pGetCoeff(p);
4689  number n;
4690  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4691  if (nMap!=NULL)
4692    n=nMap(i,currRing->cf,coeffs_BIGINT);
4693  else goto err;
4694  res->data=(void *)n;
4695  return FALSE;
4696err:
4697  WerrorS("cannot convert to bigint"); return TRUE;
4698}
4699static BOOLEAN jjP2I(leftv res, leftv v)
4700{
4701  poly p=(poly)v->Data();
4702  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4703  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4704  {
4705    WerrorS("poly must be constant");
4706    return TRUE;
4707  }
4708  res->data = (char *)(long)n_Int(pGetCoeff(p),currRing->cf);
4709  return FALSE;
4710}
4711static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4712{
4713  map mapping=(map)v->Data();
4714  syMake(res,omStrDup(mapping->preimage));
4715  return FALSE;
4716}
4717static BOOLEAN jjPRIME(leftv res, leftv v)
4718{
4719  int i = IsPrime((int)(long)(v->Data()));
4720  res->data = (char *)(long)(i > 1 ? i : 2);
4721  return FALSE;
4722}
4723static BOOLEAN jjPRUNE(leftv res, leftv v)
4724{
4725  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4726  ideal v_id=(ideal)v->Data();
4727  if (w!=NULL)
4728  {
4729    if (!idTestHomModule(v_id,currRing->qideal,w))
4730    {
4731      WarnS("wrong weights");
4732      w=NULL;
4733      // and continue at the non-homog case below
4734    }
4735    else
4736    {
4737      w=ivCopy(w);
4738      intvec **ww=&w;
4739      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4740      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4741      return FALSE;
4742    }
4743  }
4744  res->data = (char *)idMinEmbedding(v_id);
4745  return FALSE;
4746}
4747static BOOLEAN jjP2N(leftv res, leftv v)
4748{
4749  number n;
4750  poly p;
4751  if (((p=(poly)v->Data())!=NULL)
4752  && (pIsConstant(p)))
4753  {
4754    n=nCopy(pGetCoeff(p));
4755  }
4756  else
4757  {
4758    n=nInit(0);
4759  }
4760  res->data = (char *)n;
4761  return FALSE;
4762}
4763static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4764{
4765  char *s= (char *)v->Data();
4766  int i = 1;
4767  for(i=0; i<sArithBase.nCmdUsed; i++)
4768  {
4769    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4770    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4771    {
4772      res->data = (char *)1;
4773      return FALSE;
4774    }
4775  }
4776  //res->data = (char *)0;
4777  return FALSE;
4778}
4779static BOOLEAN jjRANK1(leftv res, leftv v)
4780{
4781  matrix m =(matrix)v->Data();
4782  int rank = luRank(m, 0);
4783  res->data =(char *)(long)rank;
4784  return FALSE;
4785}
4786static BOOLEAN jjREAD(leftv res, leftv v)
4787{
4788  return jjREAD2(res,v,NULL);
4789}
4790static BOOLEAN jjREGULARITY(leftv res, leftv v)
4791{
4792  res->data = (char *)(long)iiRegularity((lists)v->Data());
4793  return FALSE;
4794}
4795static BOOLEAN jjREPART(leftv res, leftv v)
4796{
4797  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4798  return FALSE;
4799}
4800static BOOLEAN jjRINGLIST(leftv res, leftv v)
4801{
4802  ring r=(ring)v->Data();
4803  if (r!=NULL)
4804    res->data = (char *)rDecompose((ring)v->Data());
4805  return (r==NULL)||(res->data==NULL);
4806}
4807static BOOLEAN jjROWS(leftv res, leftv v)
4808{
4809  ideal i = (ideal)v->Data();
4810  res->data = (char *)i->rank;
4811  return FALSE;
4812}
4813static BOOLEAN jjROWS_BIM(leftv res, leftv v)
4814{
4815  res->data = (char *)(long)((bigintmat*)(v->Data()))->rows();
4816  return FALSE;
4817}
4818static BOOLEAN jjROWS_IV(leftv res, leftv v)
4819{
4820  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4821  return FALSE;
4822}
4823static BOOLEAN jjRPAR(leftv res, leftv v)
4824{
4825  res->data = (char *)(long)rPar(((ring)v->Data()));
4826  return FALSE;
4827}
4828static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4829{
4830#ifdef HAVE_PLURAL
4831  const bool bIsSCA = rIsSCA(currRing);
4832#else
4833  const bool bIsSCA = false;
4834#endif
4835
4836  if ((currRing->qideal!=NULL) && !bIsSCA)
4837  {
4838    WerrorS("qring not supported by slimgb at the moment");
4839    return TRUE;
4840  }
4841  if (rHasLocalOrMixedOrdering_currRing())
4842  {
4843    WerrorS("ordering must be global for slimgb");
4844    return TRUE;
4845  }
4846  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4847  // tHomog hom=testHomog;
4848  ideal u_id=(ideal)u->Data();
4849  if (w!=NULL)
4850  {
4851    if (!idTestHomModule(u_id,currRing->qideal,w))
4852    {
4853      WarnS("wrong weights");
4854      w=NULL;
4855    }
4856    else
4857    {
4858      w=ivCopy(w);
4859      // hom=isHomog;
4860    }
4861  }
4862
4863  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
4864  res->data=(char *)t_rep_gb(currRing,
4865    u_id,u_id->rank);
4866  //res->data=(char *)t_rep_gb(currRing, u_id);
4867
4868  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4869  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4870  return FALSE;
4871}
4872static BOOLEAN jjSBA(leftv res, leftv v)
4873{
4874  ideal result;
4875  ideal v_id=(ideal)v->Data();
4876  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4877  tHomog hom=testHomog;
4878  if (w!=NULL)
4879  {
4880    if (!idTestHomModule(v_id,currRing->qideal,w))
4881    {
4882      WarnS("wrong weights");
4883      w=NULL;
4884    }
4885    else
4886    {
4887      hom=isHomog;
4888      w=ivCopy(w);
4889    }
4890  }
4891  result=kSba(v_id,currRing->qideal,hom,&w,1,0);
4892  idSkipZeroes(result);
4893  res->data = (char *)result;
4894  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4895  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4896  return FALSE;
4897}
4898static BOOLEAN jjSBA_1(leftv res, leftv v, leftv u)
4899{
4900  ideal result;
4901  ideal v_id=(ideal)v->Data();
4902  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4903  tHomog hom=testHomog;
4904  if (w!=NULL)
4905  {
4906    if (!idTestHomModule(v_id,currRing->qideal,w))
4907    {
4908      WarnS("wrong weights");
4909      w=NULL;
4910    }
4911    else
4912    {
4913      hom=isHomog;
4914      w=ivCopy(w);
4915    }
4916  }
4917  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),0);
4918  idSkipZeroes(result);
4919  res->data = (char *)result;
4920  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4921  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4922  return FALSE;
4923}
4924static BOOLEAN jjSBA_2(leftv res, leftv v, leftv u, leftv t)
4925{
4926  ideal result;
4927  ideal v_id=(ideal)v->Data();
4928  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4929  tHomog hom=testHomog;
4930  if (w!=NULL)
4931  {
4932    if (!idTestHomModule(v_id,currRing->qideal,w))
4933    {
4934      WarnS("wrong weights");
4935      w=NULL;
4936    }
4937    else
4938    {
4939      hom=isHomog;
4940      w=ivCopy(w);
4941    }
4942  }
4943  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),(int)(long)t->Data());
4944  idSkipZeroes(result);
4945  res->data = (char *)result;
4946  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4947  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4948  return FALSE;
4949}
4950static BOOLEAN jjSTD(leftv res, leftv v)
4951{
4952  ideal result;
4953  ideal v_id=(ideal)v->Data();
4954  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4955  tHomog hom=testHomog;
4956  if (w!=NULL)
4957  {
4958    if (!idTestHomModule(v_id,currRing->qideal,w))
4959    {
4960      WarnS("wrong weights");
4961      w=NULL;
4962    }
4963    else
4964    {
4965      hom=isHomog;
4966      w=ivCopy(w);
4967    }
4968  }
4969  result=kStd(v_id,currRing->qideal,hom,&w);
4970  idSkipZeroes(result);
4971  res->data = (char *)result;
4972  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4973  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4974  return FALSE;
4975}
4976static BOOLEAN jjSort_Id(leftv res, leftv v)
4977{
4978  res->data = (char *)idSort((ideal)v->Data());
4979  return FALSE;
4980}
4981static BOOLEAN jjSQR_FREE(leftv res, leftv u)
4982{
4983  singclap_factorize_retry=0;
4984  intvec *v=NULL;
4985  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
4986  if (f==NULL) return TRUE;
4987  ivTest(v);
4988  lists l=(lists)omAllocBin(slists_bin);
4989  l->Init(2);
4990  l->m[0].rtyp=IDEAL_CMD;
4991  l->m[0].data=(void *)f;
4992  l->m[1].rtyp=INTVEC_CMD;
4993  l->m[1].data=(void *)v;
4994  res->data=(void *)l;
4995  return FALSE;
4996}
4997#if 1
4998static BOOLEAN jjSYZYGY(leftv res, leftv v)
4999{
5000  intvec *w=NULL;
5001  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
5002  if (w!=NULL) delete w;
5003  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
5004  return FALSE;
5005}
5006#else
5007// activate, if idSyz handle module weights correctly !
5008static BOOLEAN jjSYZYGY(leftv res, leftv v)
5009{
5010  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5011  ideal v_id=(ideal)v->Data();
5012  tHomog hom=testHomog;
5013  int add_row_shift=0;
5014  if (w!=NULL)
5015  {
5016    w=ivCopy(w);
5017    add_row_shift=w->min_in();
5018    (*w)-=add_row_shift;
5019    if (idTestHomModule(v_id,currRing->qideal,w))
5020      hom=isHomog;
5021    else
5022    {
5023      //WarnS("wrong weights");
5024      delete w; w=NULL;
5025      hom=testHomog;
5026    }
5027  }
5028  res->data = (char *)idSyzygies(v_id,hom,&w);
5029  if (w!=NULL)
5030  {
5031    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5032  }
5033  return FALSE;
5034}
5035#endif
5036static BOOLEAN jjTRACE_IV(leftv res, leftv v)
5037{
5038  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
5039  return FALSE;
5040}
5041static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
5042{
5043  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
5044  return FALSE;
5045}
5046static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
5047{
5048  res->data = (char *)ivTranp((intvec*)(v->Data()));
5049  return FALSE;
5050}
5051#ifdef HAVE_PLURAL
5052static BOOLEAN jjOPPOSITE(leftv res, leftv a)
5053{
5054  ring    r = (ring)a->Data();
5055  //if (rIsPluralRing(r))
5056  if (r->OrdSgn==1)
5057  {
5058    res->data = rOpposite(r);
5059  }
5060  else
5061  {
5062    WarnS("opposite only for global orderings");
5063    res->data = rCopy(r);
5064  }
5065  return FALSE;
5066}
5067static BOOLEAN jjENVELOPE(leftv res, leftv a)
5068{
5069  ring    r = (ring)a->Data();
5070  if (rIsPluralRing(r))
5071  {
5072    //    ideal   i;
5073//     if (a->rtyp == QRING_CMD)
5074//     {
5075//       i = r->qideal;
5076//       r->qideal = NULL;
5077//     }
5078    ring s = rEnvelope(r);
5079//     if (a->rtyp == QRING_CMD)
5080//     {
5081//       ideal is  = idOppose(r,i); /* twostd? */
5082//       is        = idAdd(is,i);
5083//       s->qideal = i;
5084//     }
5085    res->data = s;
5086  }
5087  else  res->data = rCopy(r);
5088  return FALSE;
5089}
5090static BOOLEAN jjTWOSTD(leftv res, leftv a)
5091{
5092  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
5093  else  res->data=(ideal)a->CopyD();
5094  setFlag(res,FLAG_STD);
5095  setFlag(res,FLAG_TWOSTD);
5096  return FALSE;
5097}
5098#endif
5099
5100static BOOLEAN jjTYPEOF(leftv res, leftv v)
5101{
5102  int t=(int)(long)v->data;
5103  switch (t)
5104  {
5105    case CRING_CMD:
5106    case INT_CMD:
5107    case POLY_CMD:
5108    case VECTOR_CMD:
5109    case STRING_CMD:
5110    case INTVEC_CMD:
5111    case IDEAL_CMD:
5112    case MATRIX_CMD:
5113    case MODUL_CMD:
5114    case MAP_CMD:
5115    case PROC_CMD:
5116    case RING_CMD:
5117    case QRING_CMD:
5118    case INTMAT_CMD:
5119    case BIGINTMAT_CMD:
5120    case NUMBER_CMD:
5121    case BIGINT_CMD:
5122    case LIST_CMD:
5123    case PACKAGE_CMD:
5124    case LINK_CMD:
5125    case RESOLUTION_CMD:
5126         res->data=omStrDup(Tok2Cmdname(t)); break;
5127    case DEF_CMD:
5128    case NONE:           res->data=omStrDup("none"); break;
5129    default:
5130    {
5131      if (t>MAX_TOK)
5132        res->data=omStrDup(getBlackboxName(t));
5133      else
5134        res->data=omStrDup("?unknown type?");
5135      break;
5136    }
5137  }
5138  return FALSE;
5139}
5140static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5141{
5142  res->data=(char *)(long)pIsUnivariate((poly)v->Data());
5143  return FALSE;
5144}
5145static BOOLEAN jjVAR1(leftv res, leftv v)
5146{
5147  int i=(int)(long)v->Data();
5148  if ((0<i) && (i<=currRing->N))
5149  {
5150    poly p=pOne();
5151    pSetExp(p,i,1);
5152    pSetm(p);
5153    res->data=(char *)p;
5154  }
5155  else
5156  {
5157    Werror("var number %d out of range 1..%d",i,currRing->N);
5158    return TRUE;
5159  }
5160  return FALSE;
5161}
5162static BOOLEAN jjVARSTR1(leftv res, leftv v)
5163{
5164  if (currRing==NULL)
5165  {
5166    WerrorS("no ring active");
5167    return TRUE;
5168  }
5169  int i=(int)(long)v->Data();
5170  if ((0<i) && (i<=currRing->N))
5171    res->data=omStrDup(currRing->names[i-1]);
5172  else
5173  {
5174    Werror("var number %d out of range 1..%d",i,currRing->N);
5175    return TRUE;
5176  }
5177  return FALSE;
5178}
5179static BOOLEAN jjVDIM(leftv res, leftv v)
5180{
5181  assumeStdFlag(v);
5182  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currRing->qideal);
5183  return FALSE;
5184}
5185BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5186{
5187// input: u: a list with links of type
5188//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5189// returns: -1:  the read state of all links is eof
5190//          i>0: (at least) u[i] is ready
5191  lists Lforks = (lists)u->Data();
5192  int i = slStatusSsiL(Lforks, -1);
5193  if(i == -2) /* error */
5194  {
5195    return TRUE;
5196  }
5197  res->data = (void*)(long)i;
5198  return FALSE;
5199}
5200BOOLEAN jjWAITALL1(leftv res, leftv u)
5201{
5202// input: u: a list with links of type
5203//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5204// returns: -1: the read state of all links is eof
5205//           1: all links are ready
5206//              (caution: at least one is ready, but some maybe dead)
5207  lists Lforks = (lists)u->CopyD();
5208  int i;
5209  int j = -1;
5210  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5211  {
5212    i = slStatusSsiL(Lforks, -1);
5213    if(i == -2) /* error */
5214    {
5215      return TRUE;
5216    }
5217    if(i == -1)
5218    {
5219      break;
5220    }
5221    j = 1;
5222    Lforks->m[i-1].CleanUp();
5223    Lforks->m[i-1].rtyp=DEF_CMD;
5224    Lforks->m[i-1].data=NULL;
5225  }
5226  res->data = (void*)(long)j;
5227  Lforks->Clean();
5228  return FALSE;
5229}
5230
5231BOOLEAN jjLOAD(const char *s, BOOLEAN autoexport)
5232{
5233  char libnamebuf[256];
5234  lib_types LT = type_of_LIB(s, libnamebuf);
5235
5236#ifdef HAVE_DYNAMIC_LOADING
5237  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5238#endif /* HAVE_DYNAMIC_LOADING */
5239  switch(LT)
5240  {
5241      default:
5242      case LT_NONE:
5243        Werror("%s: unknown type", s);
5244        break;
5245      case LT_NOTFOUND:
5246        Werror("cannot open %s", s);
5247        break;
5248
5249      case LT_SINGULAR:
5250      {
5251        char *plib = iiConvName(s);
5252        idhdl pl = IDROOT->get(plib,0);
5253        if (pl==NULL)
5254        {
5255          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5256          IDPACKAGE(pl)->language = LANG_SINGULAR;
5257          IDPACKAGE(pl)->libname=omStrDup(plib);
5258        }
5259        else if (IDTYP(pl)!=PACKAGE_CMD)
5260        {
5261          Werror("can not create package `%s`",plib);
5262          omFree(plib);
5263          return TRUE;
5264        }
5265        package savepack=currPack;
5266        currPack=IDPACKAGE(pl);
5267        IDPACKAGE(pl)->loaded=TRUE;
5268        char libnamebuf[256];
5269        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5270        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5271        currPack=savepack;
5272        IDPACKAGE(pl)->loaded=(!bo);
5273        return bo;
5274      }
5275      case LT_BUILTIN:
5276        SModulFunc_t iiGetBuiltinModInit(const char*);
5277        return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5278      case LT_MACH_O:
5279      case LT_ELF:
5280      case LT_HPUX:
5281#ifdef HAVE_DYNAMIC_LOADING
5282        return load_modules(s, libnamebuf, autoexport);
5283#else /* HAVE_DYNAMIC_LOADING */
5284        WerrorS("Dynamic modules are not supported by this version of Singular");
5285        break;
5286#endif /* HAVE_DYNAMIC_LOADING */
5287  }
5288  return TRUE;
5289}
5290
5291static BOOLEAN jjstrlen(leftv res, leftv v)
5292{
5293  res->data = (char *)strlen((char *)v->Data());
5294  return FALSE;
5295}
5296static BOOLEAN jjpLength(leftv res, leftv v)
5297{
5298  res->data = (char *)(long)pLength((poly)v->Data());
5299  return FALSE;
5300}
5301static BOOLEAN jjidElem(leftv res, leftv v)
5302{
5303  res->data = (char *)(long)idElem((ideal)v->Data());
5304  return FALSE;
5305}
5306static BOOLEAN jjidFreeModule(leftv res, leftv v)
5307{
5308  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5309  return FALSE;
5310}
5311static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5312{
5313  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5314  return FALSE;
5315}
5316static BOOLEAN jjrCharStr(leftv res, leftv v)
5317{
5318#ifdef SINGULAR_4_1
5319  iiReWrite("charstr");
5320#endif
5321  res->data = rCharStr((ring)v->Data());
5322  return FALSE;
5323}
5324static BOOLEAN jjpHead(leftv res, leftv v)
5325{
5326  res->data = (char *)pHead((poly)v->Data());
5327  return FALSE;
5328}
5329static BOOLEAN jjidHead(leftv res, leftv v)
5330{
5331  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5332  setFlag(res,FLAG_STD);
5333  return FALSE;
5334}
5335static BOOLEAN jjidMinBase(leftv res, leftv v)
5336{
5337  res->data = (char *)idMinBase((ideal)v->Data());
5338  return FALSE;
5339}
5340static BOOLEAN jjsyMinBase(leftv res, leftv v)
5341{
5342  res->data = (char *)syMinBase((ideal)v->Data());
5343  return FALSE;
5344}
5345static BOOLEAN jjpMaxComp(leftv res, leftv v)
5346{
5347  res->data = (char *)pMaxComp((poly)v->Data());
5348  return FALSE;
5349}
5350static BOOLEAN jjmpTrace(leftv res, leftv v)
5351{
5352  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5353  return FALSE;
5354}
5355static BOOLEAN jjmpTransp(leftv res, leftv v)
5356{
5357  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5358  return FALSE;
5359}
5360static BOOLEAN jjrOrdStr(leftv res, leftv v)
5361{
5362#ifdef SINGULAR_4_1
5363  iiReWrite("ordstr");
5364#endif
5365  res->data = rOrdStr((ring)v->Data());
5366  return FALSE;
5367}
5368static BOOLEAN jjrVarStr(leftv res, leftv v)
5369{
5370#ifdef SINGULAR_4_1
5371  iiReWrite("varstr");
5372#endif
5373  res->data = rVarStr((ring)v->Data());
5374  return FALSE;
5375}
5376static BOOLEAN jjrParStr(leftv res, leftv v)
5377{
5378#ifdef SINGULAR_4_1
5379  iiReWrite("varstr");
5380#endif
5381  res->data = rParStr((ring)v->Data());
5382  return FALSE;
5383}
5384static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5385{
5386  res->data=(char *)(long)sySize((syStrategy)v->Data());
5387  return FALSE;
5388}
5389static BOOLEAN jjDIM_R(leftv res, leftv v)
5390{
5391  res->data = (char *)(long)syDim((syStrategy)v->Data());
5392  return FALSE;
5393}
5394static BOOLEAN jjidTransp(leftv res, leftv v)
5395{
5396  res->data = (char *)idTransp((ideal)v->Data());
5397  return FALSE;
5398}
5399static BOOLEAN jjnInt(leftv res, leftv u)
5400{
5401  number n=(number)u->CopyD(); // n_Int may call n_Normalize
5402  res->data=(char *)(long)n_Int(n,currRing->cf);
5403  n_Delete(&n,currRing->cf);
5404  return FALSE;
5405}
5406static BOOLEAN jjnlInt(leftv res, leftv u)
5407{
5408  number n=(number)u->Data();
5409  res->data=(char *)(long)n_Int(n,coeffs_BIGINT );
5410  return FALSE;
5411}
5412/*=================== operations with 3 args.: static proc =================*/
5413/* must be ordered: first operations for chars (infix ops),
5414 * then alphabetically */
5415static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5416{
5417  char *s= (char *)u->Data();
5418  int   r = (int)(long)v->Data();
5419  int   c = (int)(long)w->Data();
5420  int l = strlen(s);
5421
5422  if ( (r<1) || (r>l) || (c<0) )
5423  {
5424    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5425    return TRUE;
5426  }
5427  res->data = (char *)omAlloc((long)(c+1));
5428  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5429  return FALSE;
5430}
5431static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5432{
5433  intvec *iv = (intvec *)u->Data();
5434  int   r = (int)(long)v->Data();
5435  int   c = (int)(long)w->Data();
5436  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5437  {
5438    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5439           r,c,u->Fullname(),iv->rows(),iv->cols());
5440    return TRUE;
5441  }
5442  res->data=u->data; u->data=NULL;
5443  res->rtyp=u->rtyp; u->rtyp=0;
5444  res->name=u->name; u->name=NULL;
5445  Subexpr e=jjMakeSub(v);
5446          e->next=jjMakeSub(w);
5447  if (u->e==NULL) res->e=e;
5448  else
5449  {
5450    Subexpr h=u->e;
5451    while (h->next!=NULL) h=h->next;
5452    h->next=e;
5453    res->e=u->e;
5454    u->e=NULL;
5455  }
5456  return FALSE;
5457}
5458static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5459{
5460  bigintmat *bim = (bigintmat *)u->Data();
5461  int   r = (int)(long)v->Data();
5462  int   c = (int)(long)w->Data();
5463  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5464  {
5465    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5466           r,c,u->Fullname(),bim->rows(),bim->cols());
5467    return TRUE;
5468  }
5469  res->data=u->data; u->data=NULL;
5470  res->rtyp=u->rtyp; u->rtyp=0;
5471  res->name=u->name; u->name=NULL;
5472  Subexpr e=jjMakeSub(v);
5473          e->next=jjMakeSub(w);
5474  if (u->e==NULL)
5475    res->e=e;
5476  else
5477  {
5478    Subexpr h=u->e;
5479    while (h->next!=NULL) h=h->next;
5480    h->next=e;
5481    res->e=u->e;
5482    u->e=NULL;
5483  }
5484  return FALSE;
5485}
5486static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5487{
5488  matrix m= (matrix)u->Data();
5489  int   r = (int)(long)v->Data();
5490  int   c = (int)(long)w->Data();
5491  //Print("gen. elem %d, %d\n",r,c);
5492  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5493  {
5494    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5495      MATROWS(m),MATCOLS(m));
5496    return TRUE;
5497  }
5498  res->data=u->data; u->data=NULL;
5499  res->rtyp=u->rtyp; u->rtyp=0;
5500  res->name=u->name; u->name=NULL;
5501  Subexpr e=jjMakeSub(v);
5502          e->next=jjMakeSub(w);
5503  if (u->e==NULL)
5504    res->e=e;
5505  else
5506  {
5507    Subexpr h=u->e;
5508    while (h->next!=NULL) h=h->next;
5509    h->next=e;
5510    res->e=u->e;
5511    u->e=NULL;
5512  }
5513  return FALSE;
5514}
5515static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5516{
5517  sleftv t;
5518  sleftv ut;
5519  leftv p=NULL;
5520  intvec *iv=(intvec *)w->Data();
5521  int l;
5522  BOOLEAN nok;
5523
5524  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5525  {
5526    WerrorS("cannot build expression lists from unnamed objects");
5527    return TRUE;
5528  }
5529  memcpy(&ut,u,sizeof(ut));
5530  memset(&t,0,sizeof(t));
5531  t.rtyp=INT_CMD;
5532  for (l=0;l< iv->length(); l++)
5533  {
5534    t.data=(char *)(long)((*iv)[l]);
5535    if (p==NULL)
5536    {
5537      p=res;
5538    }
5539    else
5540    {
5541      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5542      p=p->next;
5543    }
5544    memcpy(u,&ut,sizeof(ut));
5545    if (u->Typ() == MATRIX_CMD)
5546      nok=jjBRACK_Ma(p,u,v,&t);
5547    else if (u->Typ() == BIGINTMAT_CMD)
5548      nok=jjBRACK_Bim(p,u,v,&t);
5549    else /* INTMAT_CMD */
5550      nok=jjBRACK_Im(p,u,v,&t);
5551    if (nok)
5552    {
5553      while (res->next!=NULL)
5554      {
5555        p=res->next->next;
5556        omFreeBin((ADDRESS)res->next, sleftv_bin);
5557        // res->e aufraeumen !!!!
5558        res->next=p;
5559      }
5560      return TRUE;
5561    }
5562  }
5563  return FALSE;
5564}
5565static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5566{
5567  sleftv t;
5568  sleftv ut;
5569  leftv p=NULL;
5570  intvec *iv=(intvec *)v->Data();
5571  int l;
5572  BOOLEAN nok;
5573
5574  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5575  {
5576    WerrorS("cannot build expression lists from unnamed objects");
5577    return TRUE;
5578  }
5579  memcpy(&ut,u,sizeof(ut));
5580  memset(&t,0,sizeof(t));
5581  t.rtyp=INT_CMD;
5582  for (l=0;l< iv->length(); l++)
5583  {
5584    t.data=(char *)(long)((*iv)[l]);
5585    if (p==NULL)
5586    {
5587      p=res;
5588    }
5589    else
5590    {
5591      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5592      p=p->next;
5593    }
5594    memcpy(u,&ut,sizeof(ut));
5595    if (u->Typ() == MATRIX_CMD)
5596      nok=jjBRACK_Ma(p,u,&t,w);
5597    else if (u->Typ() == BIGINTMAT_CMD)
5598      nok=jjBRACK_Bim(p,u,&t,w);
5599    else /* INTMAT_CMD */
5600      nok=jjBRACK_Im(p,u,&t,w);
5601    if (nok)
5602    {
5603      while (res->next!=NULL)
5604      {
5605        p=res->next->next;
5606        omFreeBin((ADDRESS)res->next, sleftv_bin);
5607        // res->e aufraeumen !!
5608        res->next=p;
5609      }
5610      return TRUE;
5611    }
5612  }
5613  return FALSE;
5614}
5615static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5616{
5617  sleftv t1,t2,ut;
5618  leftv p=NULL;
5619  intvec *vv=(intvec *)v->Data();
5620  intvec *wv=(intvec *)w->Data();
5621  int vl;
5622  int wl;
5623  BOOLEAN nok;
5624
5625  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5626  {
5627    WerrorS("cannot build expression lists from unnamed objects");
5628    return TRUE;
5629  }
5630  memcpy(&ut,u,sizeof(ut));
5631  memset(&t1,0,sizeof(sleftv));
5632  memset(&t2,0,sizeof(sleftv));
5633  t1.rtyp=INT_CMD;
5634  t2.rtyp=INT_CMD;
5635  for (vl=0;vl< vv->length(); vl++)
5636  {
5637    t1.data=(char *)(long)((*vv)[vl]);
5638    for (wl=0;wl< wv->length(); wl++)
5639    {
5640      t2.data=(char *)(long)((*wv)[wl]);
5641      if (p==NULL)
5642      {
5643        p=res;
5644      }
5645      else
5646      {
5647        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5648        p=p->next;
5649      }
5650      memcpy(u,&ut,sizeof(ut));
5651      if (u->Typ() == MATRIX_CMD)
5652        nok=jjBRACK_Ma(p,u,&t1,&t2);
5653      else if (u->Typ() == BIGINTMAT_CMD)
5654        nok=jjBRACK_Bim(p,u,&t1,&t2);
5655      else /* INTMAT_CMD */
5656        nok=jjBRACK_Im(p,u,&t1,&t2);
5657      if (nok)
5658      {
5659        res->CleanUp();
5660        return TRUE;
5661      }
5662    }
5663  }
5664  return FALSE;
5665}
5666static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5667{
5668  v->next=(leftv)omAllocBin(sleftv_bin);
5669  memcpy(v->next,w,sizeof(sleftv));
5670  memset(w,0,sizeof(sleftv));
5671  return jjPROC(res,u,v);
5672}
5673static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5674{
5675  intvec *iv;
5676  ideal m;
5677  lists l=(lists)omAllocBin(slists_bin);
5678  int k=(int)(long)w->Data();
5679  if (k>=0)
5680  {
5681    sm_CallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv, currRing);
5682    l->Init(2);
5683    l->m[0].rtyp=MODUL_CMD;
5684    l->m[1].rtyp=INTVEC_CMD;
5685    l->m[0].data=(void *)m;
5686    l->m[1].data=(void *)iv;
5687  }
5688  else
5689  {
5690    m=sm_CallSolv((ideal)u->Data(), currRing);
5691    l->Init(1);
5692    l->m[0].rtyp=IDEAL_CMD;
5693    l->m[0].data=(void *)m;
5694  }
5695  res->data = (char *)l;
5696  return FALSE;
5697}
5698static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5699{
5700  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5701  {
5702    WerrorS("3rd argument must be a name of a matrix");
5703    return TRUE;
5704  }
5705  ideal i=(ideal)u->Data();
5706  int rank=(int)i->rank;
5707  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5708  if (r) return TRUE;
5709  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5710  return FALSE;
5711}
5712static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5713{
5714  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5715           (ideal)(v->Data()),(poly)(w->Data()));
5716  return FALSE;
5717}
5718static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5719{
5720  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5721  {
5722    WerrorS("3rd argument must be a name of a matrix");
5723    return TRUE;
5724  }
5725  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5726  poly p=(poly)u->CopyD(POLY_CMD);
5727  ideal i=idInit(1,1);
5728  i->m[0]=p;
5729  sleftv t;
5730  memset(&t,0,sizeof(t));
5731  t.data=(char *)i;
5732  t.rtyp=IDEAL_CMD;
5733  int rank=1;
5734  if (u->Typ()==VECTOR_CMD)
5735  {
5736    i->rank=rank=pMaxComp(p);
5737    t.rtyp=MODUL_CMD;
5738  }
5739  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5740  t.CleanUp();
5741  if (r) return TRUE;
5742  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5743  return FALSE;
5744}
5745static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5746{
5747  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5748    (intvec *)w->Data());
5749  //setFlag(res,FLAG_STD);
5750  return FALSE;
5751}
5752static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5753{
5754  /*4
5755  * look for the substring what in the string where
5756  * starting at position n
5757  * return the position of the first char of what in where
5758  * or 0
5759  */
5760  int n=(int)(long)w->Data();
5761  char *where=(char *)u->Data();
5762  char *what=(char *)v->Data();
5763  char *found;
5764  if ((1>n)||(n>(int)strlen(where)))
5765  {
5766    Werror("start position %d out of range",n);
5767    return TRUE;
5768  }
5769  found = strchr(where+n-1,*what);
5770  if (*(what+1)!='\0')
5771  {
5772    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
5773    {
5774      found=strchr(found+1,*what);
5775    }
5776  }
5777  if (found != NULL)
5778  {
5779    res->data=(char *)((found-where)+1);
5780  }
5781  return FALSE;
5782}
5783static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
5784{
5785  if ((int)(long)w->Data()==0)
5786    res->data=(char *)walkProc(u,v);
5787  else
5788    res->dat