source: git/Singular/iparith.cc @ 606608

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