source: git/Singular/iparith.cc @ 1a2a74

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