source: git/Singular/iparith.cc @ 579253

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