source: git/Singular/iparith.cc @ f8fe72

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