source: git/Singular/iparith.cc @ a95069

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