source: git/Singular/iparith.cc @ bdfe704

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