source: git/Singular/iparith.cc @ ff4cbac

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