source: git/Singular/iparith.cc @ 69eed9

fieker-DuValspielwiese
Last change on this file since 69eed9 was 69eed9, checked in by Hans Schoenemann <hannes@…>, 16 months ago
opt: use of std/NF for SB
  • Property mode set to 100644
File size: 253.6 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  sprintf(nn,"%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    sprintf(n,"%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      sprintf(name_buffer, "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  if (IDELEMS((ideal)mat)==0)
4365  {
4366    idDelete((ideal *)&mat);
4367    mat=(matrix)idInit(1,1);
4368  }
4369  else
4370  {
4371    MATROWS(mat)=1;
4372    mat->rank=1;
4373    idTest((ideal)mat);
4374  }
4375  res->data=(char *)mat;
4376  return FALSE;
4377}
4378static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4379{
4380  map m=(map)v->CopyD(MAP_CMD);
4381  omFreeBinAddr((ADDRESS)m->preimage);
4382  m->preimage=NULL;
4383  ideal I=(ideal)m;
4384  I->rank=1;
4385  res->data=(char *)I;
4386  return FALSE;
4387}
4388static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4389{
4390  if (currRing!=NULL)
4391  {
4392    ring q=(ring)v->Data();
4393    if (rSamePolyRep(currRing, q))
4394    {
4395      if (q->qideal==NULL)
4396        res->data=(char *)idInit(1,1);
4397      else
4398        res->data=(char *)idCopy(q->qideal);
4399      return FALSE;
4400    }
4401  }
4402  WerrorS("can only get ideal from identical qring");
4403  return TRUE;
4404}
4405static BOOLEAN jjIm2Iv(leftv res, leftv v)
4406{
4407  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4408  iv->makeVector();
4409  res->data = iv;
4410  return FALSE;
4411}
4412static BOOLEAN jjIMPART(leftv res, leftv v)
4413{
4414  res->data = (char *)n_ImPart((number)v->Data(),currRing->cf);
4415  return FALSE;
4416}
4417static BOOLEAN jjINDEPSET(leftv res, leftv v)
4418{
4419  assumeStdFlag(v);
4420  res->data=(void *)scIndIntvec((ideal)(v->Data()),currRing->qideal);
4421  return FALSE;
4422}
4423static BOOLEAN jjINTERRED(leftv res, leftv v)
4424{
4425  ideal result=kInterRed((ideal)(v->Data()), currRing->qideal);
4426  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4427  res->data = result;
4428  return FALSE;
4429}
4430static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4431{
4432  res->data = (char *)(long)pVar((poly)v->Data());
4433  return FALSE;
4434}
4435static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4436{
4437  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing->names,
4438                                                            currRing->N)+1);
4439  return FALSE;
4440}
4441static BOOLEAN jjIS_RINGVAR0(leftv res, leftv)
4442{
4443  res->data = (char *)0;
4444  return FALSE;
4445}
4446static BOOLEAN jjJACOB_P(leftv res, leftv v)
4447{
4448  ideal i=idInit(currRing->N,1);
4449  int k;
4450  poly p=(poly)(v->Data());
4451  for (k=currRing->N;k>0;k--)
4452  {
4453    i->m[k-1]=pDiff(p,k);
4454  }
4455  res->data = (char *)i;
4456  return FALSE;
4457}
4458static BOOLEAN jjDIFF_COEF(leftv res, leftv u, leftv v)
4459{
4460  if (!nCoeff_is_transExt(currRing->cf))
4461  {
4462    WerrorS("differentiation not defined in the coefficient ring");
4463    return TRUE;
4464  }
4465  number n = (number) u->Data();
4466  number k = (number) v->Data();
4467  res->data = ntDiff(n,k,currRing->cf);
4468  return FALSE;
4469}
4470/*2
4471 * compute Jacobi matrix of a module/matrix
4472 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(currRing->N))  ),
4473 * where Mt := transpose(M)
4474 * Note that this is consistent with the current conventions for jacob in Singular,
4475 * whereas M2 computes its transposed.
4476 */
4477static BOOLEAN jjJACOB_M(leftv res, leftv a)
4478{
4479  ideal id = (ideal)a->Data();
4480  id = id_Transp(id,currRing);
4481  int W = IDELEMS(id);
4482
4483  ideal result = idInit(W * currRing->N, id->rank);
4484  poly *p = result->m;
4485
4486  for( int v = 1; v <= currRing->N; v++ )
4487  {
4488    poly* q = id->m;
4489    for( int i = 0; i < W; i++, p++, q++ )
4490      *p = pDiff( *q, v );
4491  }
4492  idDelete(&id);
4493
4494  res->data = (char *)result;
4495  return FALSE;
4496}
4497
4498static BOOLEAN jjKERNEL_M(leftv res, leftv v)
4499{
4500#ifdef HAVE_FLINT
4501  res->data = (char *)singflint_kernel((matrix)(v->Data()),currRing);
4502  return res->data==NULL;
4503#else
4504  return TRUE;
4505#endif
4506}
4507static BOOLEAN jjKERNEL_SM(leftv res, leftv v)
4508{
4509#ifdef HAVE_FLINT
4510  res->data = (char *)singflint_kernel((ideal)(v->Data()),currRing);
4511  return res->data==NULL;
4512#else
4513  return TRUE;
4514#endif
4515}
4516static BOOLEAN jjKBASE(leftv res, leftv v)
4517{
4518  assumeStdFlag(v);
4519  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currRing->qideal);
4520  return FALSE;
4521}
4522static BOOLEAN jjL2R(leftv res, leftv v)
4523{
4524  res->data=(char *)syConvList((lists)v->Data());
4525  if (res->data != NULL)
4526    return FALSE;
4527  else
4528    return TRUE;
4529}
4530static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4531{
4532  poly p=(poly)v->Data();
4533  if (p==NULL)
4534  {
4535    res->data=(char *)nInit(0);
4536  }
4537  else
4538  {
4539    nNormalize(pGetCoeff(p));
4540    res->data=(char *)nCopy(pGetCoeff(p));
4541  }
4542  return FALSE;
4543}
4544static BOOLEAN jjLEADEXP(leftv res, leftv v)
4545{
4546  poly p=(poly)v->Data();
4547  int s=currRing->N;
4548  if (v->Typ()==VECTOR_CMD) s++;
4549  intvec *iv=new intvec(s);
4550  if (p!=NULL)
4551  {
4552    for(int i = currRing->N;i;i--)
4553    {
4554      (*iv)[i-1]=pGetExp(p,i);
4555    }
4556    if (s!=currRing->N)
4557      (*iv)[currRing->N]=pGetComp(p);
4558  }
4559  res->data=(char *)iv;
4560  return FALSE;
4561}
4562static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4563{
4564  poly p=(poly)v->Data();
4565  if (p == NULL)
4566  {
4567    res->data = (char*) NULL;
4568  }
4569  else
4570  {
4571    poly lm = pLmInit(p);
4572    pSetCoeff0(lm, nInit(1));
4573    res->data = (char*) lm;
4574  }
4575  return FALSE;
4576}
4577static BOOLEAN jjLOAD1(leftv /*res*/, leftv v)
4578{
4579  return jjLOAD((char*)v->Data(),FALSE);
4580}
4581static BOOLEAN jjLISTRING(leftv res, leftv v)
4582{
4583  lists l=(lists)v->Data();
4584  long mm=(long)atGet(v,"maxExp",INT_CMD);
4585  int isLetterplace=(int)(long)atGet(v,"isLetterplaceRing",INT_CMD);
4586  ring r=rCompose(l,TRUE,mm,isLetterplace);
4587  res->data=(char *)r;
4588  return (r==NULL);
4589}
4590static BOOLEAN jjPFAC1(leftv res, leftv v)
4591{
4592  /* call method jjPFAC2 with second argument = 0 (meaning that no
4593     valid bound for the prime factors has been given) */
4594  sleftv tmp;
4595  tmp.Init();
4596  tmp.rtyp = INT_CMD;
4597  return jjPFAC2(res, v, &tmp);
4598}
4599static BOOLEAN jjLagSolve(leftv res, leftv v)
4600{
4601  sleftv a2,a3;
4602  memset(&a2,0,sizeof(a2));
4603  memset(&a3,0,sizeof(a3));
4604  a2.rtyp=INT_CMD; a2.data=(void*)10;
4605  a3.rtyp=INT_CMD; a3.data=(void*)1;
4606  return nuLagSolve(res,v,&a2,&a3);
4607}
4608static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4609{
4610  /* computes the LU-decomposition of a matrix M;
4611     i.e., M = P * L * U, where
4612        - P is a row permutation matrix,
4613        - L is in lower triangular form,
4614        - U is in upper row echelon form
4615     Then, we also have P * M = L * U.
4616     A list [P, L, U] is returned. */
4617  matrix mat = (const matrix)v->Data();
4618  if (!idIsConstant((ideal)mat))
4619  {
4620    WerrorS("matrix must be constant");
4621    return TRUE;
4622  }
4623  matrix pMat;
4624  matrix lMat;
4625  matrix uMat;
4626
4627  luDecomp(mat, pMat, lMat, uMat);
4628
4629  lists ll = (lists)omAllocBin(slists_bin);
4630  ll->Init(3);
4631  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4632  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4633  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4634  res->data=(char*)ll;
4635
4636  return FALSE;
4637}
4638static BOOLEAN jjMEMORY(leftv res, leftv v)
4639{
4640  // clean out "_":
4641  sLastPrinted.CleanUp();
4642  // collect all info:
4643  omUpdateInfo();
4644  switch(((int)(long)v->Data()))
4645  {
4646  case 0:
4647    res->data=(char *)n_Init(om_Info.UsedBytes,coeffs_BIGINT);
4648    break;
4649  case 1:
4650    res->data = (char *)n_Init(om_Info.CurrentBytesSystem,coeffs_BIGINT);
4651    break;
4652  case 2:
4653    res->data = (char *)n_Init(om_Info.MaxBytesSystem,coeffs_BIGINT);
4654    break;
4655  default:
4656    omPrintStats(stdout);
4657    omPrintInfo(stdout);
4658    omPrintBinStats(stdout);
4659    res->data = (char *)0;
4660    res->rtyp = NONE;
4661  }
4662  return FALSE;
4663}
4664//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4665//{
4666//  return jjMONITOR2(res,v,NULL);
4667//}
4668static BOOLEAN jjMSTD(leftv res, leftv v)
4669{
4670  int t=v->Typ();
4671  ideal r,m;
4672  r=kMin_std((ideal)v->Data(),currRing->qideal,testHomog,NULL,m);
4673  lists l=(lists)omAllocBin(slists_bin);
4674  l->Init(2);
4675  l->m[0].rtyp=t;
4676  l->m[0].data=(char *)r;
4677  setFlag(&(l->m[0]),FLAG_STD);
4678  l->m[1].rtyp=t;
4679  l->m[1].data=(char *)m;
4680  res->data=(char *)l;
4681  return FALSE;
4682}
4683static BOOLEAN jjMULT(leftv res, leftv v)
4684{
4685  assumeStdFlag(v);
4686  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currRing->qideal);
4687  return FALSE;
4688}
4689static BOOLEAN jjMINRES_R(leftv res, leftv v)
4690{
4691  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4692
4693  syStrategy tmp=(syStrategy)v->Data();
4694  tmp = syMinimize(tmp); // enrich itself!
4695
4696  res->data=(char *)tmp;
4697
4698  if (weights!=NULL)
4699    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4700
4701  return FALSE;
4702}
4703static BOOLEAN jjN2BI(leftv res, leftv v)
4704{
4705  number n,i; i=(number)v->Data();
4706  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4707  if (nMap!=NULL)
4708    n=nMap(i,currRing->cf,coeffs_BIGINT);
4709  else goto err;
4710  res->data=(void *)n;
4711  return FALSE;
4712err:
4713  WerrorS("cannot convert to bigint"); return TRUE;
4714}
4715static BOOLEAN jjNAMEOF(leftv res, leftv v)
4716{
4717  if ((v->rtyp==IDHDL)||(v->rtyp==ALIAS_CMD))
4718    res->data=omStrDup(v->name);
4719  else if (v->name==NULL)
4720    res->data=omStrDup("");
4721  else
4722  {
4723    res->data = (char *)v->name;
4724    v->name=NULL;
4725  }
4726  return FALSE;
4727}
4728static BOOLEAN jjNAMES(leftv res, leftv v)
4729{
4730  res->data=ipNameList(((ring)v->Data())->idroot);
4731  return FALSE;
4732}
4733static BOOLEAN jjNAMES_I(leftv res, leftv v)
4734{
4735  res->data=ipNameListLev((IDROOT),(int)(long)v->Data());
4736  return FALSE;
4737}
4738static BOOLEAN jjNOT(leftv res, leftv v)
4739{
4740  res->data=(char*)(long)((long)v->Data()==0 ? 1 : 0);
4741  return FALSE;
4742}
4743static BOOLEAN jjNVARS(leftv res, leftv v)
4744{
4745  res->data = (char *)(long)(((ring)(v->Data()))->N);
4746  return FALSE;
4747}
4748static BOOLEAN jjOpenClose(leftv, leftv v)
4749{
4750  si_link l=(si_link)v->Data();
4751  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4752  else { slPrepClose(l); return slClose(l);}
4753}
4754static BOOLEAN jjORD(leftv res, leftv v)
4755{
4756  poly p=(poly)v->Data();
4757  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4758  return FALSE;
4759}
4760static BOOLEAN jjPAR1(leftv res, leftv v)
4761{
4762  int i=(int)(long)v->Data();
4763  int p=0;
4764  p=rPar(currRing);
4765  if ((0<i) && (i<=p))
4766  {
4767    res->data=(char *)n_Param(i,currRing);
4768  }
4769  else
4770  {
4771    Werror("par number %d out of range 1..%d",i,p);
4772    return TRUE;
4773  }
4774  return FALSE;
4775}
4776static BOOLEAN jjPARDEG(leftv res, leftv v)
4777{
4778  number nn=(number)v->Data();
4779  res->data = (char *)(long)n_ParDeg(nn, currRing->cf);
4780  return FALSE;
4781}
4782static BOOLEAN jjPARSTR1(leftv res, leftv v)
4783{
4784  if (currRing==NULL)
4785  {
4786    WerrorS("no ring active (1)");
4787    return TRUE;
4788  }
4789  int i=(int)(long)v->Data();
4790  int p=0;
4791  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4792    res->data=omStrDup(rParameter(currRing)[i-1]);
4793  else
4794  {
4795    Werror("par number %d out of range 1..%d",i,p);
4796    return TRUE;
4797  }
4798  return FALSE;
4799}
4800static BOOLEAN jjP2BI(leftv res, leftv v)
4801{
4802  poly p=(poly)v->Data();
4803  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4804  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4805  {
4806    WerrorS("poly must be constant");
4807    return TRUE;
4808  }
4809  number i=pGetCoeff(p);
4810  number n;
4811  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4812  if (nMap!=NULL)
4813    n=nMap(i,currRing->cf,coeffs_BIGINT);
4814  else goto err;
4815  res->data=(void *)n;
4816  return FALSE;
4817err:
4818  WerrorS("cannot convert to bigint"); return TRUE;
4819}
4820static BOOLEAN jjP2I(leftv res, leftv v)
4821{
4822  poly p=(poly)v->Data();
4823  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4824  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4825  {
4826    WerrorS("poly must be constant");
4827    return TRUE;
4828  }
4829  res->data = (char *)(long)iin_Int(pGetCoeff(p),currRing->cf);
4830  return FALSE;
4831}
4832static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4833{
4834  map mapping=(map)v->Data();
4835  syMake(res,omStrDup(mapping->preimage));
4836  return FALSE;
4837}
4838static BOOLEAN jjPRIME(leftv res, leftv v)
4839{
4840  int i = IsPrime((int)(long)(v->Data()));
4841  res->data = (char *)(long)(i > 1 ? i : 2);
4842  return FALSE;
4843}
4844static BOOLEAN jjPRUNE(leftv res, leftv v)
4845{
4846  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4847  ideal v_id=(ideal)v->Data();
4848  if (w!=NULL)
4849  {
4850    if (!idTestHomModule(v_id,currRing->qideal,w))
4851    {
4852      WarnS("wrong weights");
4853      w=NULL;
4854      // and continue at the non-homog case below
4855    }
4856    else
4857    {
4858      w=ivCopy(w);
4859      intvec **ww=&w;
4860      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4861      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4862      return FALSE;
4863    }
4864  }
4865  res->data = (char *)idMinEmbedding(v_id);
4866  return FALSE;
4867}
4868static BOOLEAN jjP2N(leftv res, leftv v)
4869{
4870  number n;
4871  poly p;
4872  if (((p=(poly)v->Data())!=NULL)
4873  && (pIsConstant(p)))
4874  {
4875    n=nCopy(pGetCoeff(p));
4876  }
4877  else
4878  {
4879    n=nInit(0);
4880  }
4881  res->data = (char *)n;
4882  return FALSE;
4883}
4884static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4885{
4886  char *s= (char *)v->Data();
4887  // try system keywords
4888  for(unsigned i=0; i<sArithBase.nCmdUsed; i++)
4889  {
4890    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4891    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4892    {
4893      res->data = (char *)1;
4894      return FALSE;
4895    }
4896  }
4897  // try blackbox names
4898  int id;
4899  blackboxIsCmd(s,id);
4900  if (id>0)
4901  {
4902    res->data = (char *)1;
4903  }
4904  return FALSE;
4905}
4906static BOOLEAN jjRANK1(leftv res, leftv v)
4907{
4908  matrix m =(matrix)v->Data();
4909  int rank = luRank(m, 0);
4910  res->data =(char *)(long)rank;
4911  return FALSE;
4912}
4913static BOOLEAN jjREAD(leftv res, leftv v)
4914{
4915  return jjREAD2(res,v,NULL);
4916}
4917static BOOLEAN jjREGULARITY(leftv res, leftv v)
4918{
4919  res->data = (char *)(long)iiRegularity((lists)v->Data());
4920  return FALSE;
4921}
4922static BOOLEAN jjREPART(leftv res, leftv v)
4923{
4924  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4925  return FALSE;
4926}
4927static BOOLEAN jjRINGLIST(leftv res, leftv v)
4928{
4929  ring r=(ring)v->Data();
4930  if (r!=NULL)
4931  {
4932    res->data = (char *)rDecompose((ring)v->Data());
4933    if (res->data!=NULL)
4934    {
4935      long mm=r->wanted_maxExp;
4936      if (mm!=0) atSet(res,omStrDup("maxExp"),(void*)mm,INT_CMD);
4937      return FALSE;
4938    }
4939  }
4940  return TRUE;
4941}
4942static BOOLEAN jjRINGLIST_C(leftv res, leftv v)
4943{
4944  coeffs r=(coeffs)v->Data();
4945  if (r!=NULL)
4946    return rDecompose_CF(res,r);
4947  return TRUE;
4948}
4949static BOOLEAN jjRING_LIST(leftv res, leftv v)
4950{
4951  ring r=(ring)v->Data();
4952  if (r!=NULL)
4953    res->data = (char *)rDecompose_list_cf((ring)v->Data());
4954  return (r==NULL)||(res->data==NULL);
4955}
4956static BOOLEAN jjROWS(leftv res, leftv v)
4957{
4958  ideal i = (ideal)v->Data();
4959  res->data = (char *)i->rank;
4960  return FALSE;
4961}
4962static BOOLEAN jjROWS_BIM(leftv res, leftv v)
4963{
4964  res->data = (char *)(long)((bigintmat*)(v->Data()))->rows();
4965  return FALSE;
4966}
4967static BOOLEAN jjROWS_IV(leftv res, leftv v)
4968{
4969  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4970  return FALSE;
4971}
4972static BOOLEAN jjRPAR(leftv res, leftv v)
4973{
4974  res->data = (char *)(long)rPar(((ring)v->Data()));
4975  return FALSE;
4976}
4977static BOOLEAN jjS2I(leftv res, leftv v)
4978{
4979  res->data = (char *)(long)atoi((char*)v->Data());
4980  return FALSE;
4981}
4982static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4983{
4984  const bool bIsSCA = rIsSCA(currRing);
4985
4986  if ((currRing->qideal!=NULL) && !bIsSCA)
4987  {
4988    WerrorS("qring not supported by slimgb at the moment");
4989    return TRUE;
4990  }
4991  if (rHasLocalOrMixedOrdering(currRing))
4992  {
4993    WerrorS("ordering must be global for slimgb");
4994    return TRUE;
4995  }
4996  if (rField_is_numeric(currRing))
4997    WarnS("groebner base computations with inexact coefficients can not be trusted due to rounding errors");
4998  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4999  // tHomog hom=testHomog;
5000  ideal u_id=(ideal)u->Data();
5001  if (w!=NULL)
5002  {
5003    if (!idTestHomModule(u_id,currRing->qideal,w))
5004    {
5005      WarnS("wrong weights");
5006      w=NULL;
5007    }
5008    else
5009    {
5010      w=ivCopy(w);
5011      // hom=isHomog;
5012    }
5013  }
5014
5015  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
5016  res->data=(char *)t_rep_gb(currRing,
5017    u_id,u_id->rank);
5018  //res->data=(char *)t_rep_gb(currRing, u_id);
5019
5020  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5021  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5022  return FALSE;
5023}
5024static BOOLEAN jjSBA(leftv res, leftv v)
5025{
5026  ideal result;
5027  ideal v_id=(ideal)v->Data();
5028  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5029  tHomog hom=testHomog;
5030  if (w!=NULL)
5031  {
5032    if (!idTestHomModule(v_id,currRing->qideal,w))
5033    {
5034      WarnS("wrong weights");
5035      w=NULL;
5036    }
5037    else
5038    {
5039      hom=isHomog;
5040      w=ivCopy(w);
5041    }
5042  }
5043  result=kSba(v_id,currRing->qideal,hom,&w,1,0);
5044  idSkipZeroes(result);
5045  res->data = (char *)result;
5046  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5047  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5048  return FALSE;
5049}
5050static BOOLEAN jjSBA_1(leftv res, leftv v, leftv u)
5051{
5052  ideal result;
5053  ideal v_id=(ideal)v->Data();
5054  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5055  tHomog hom=testHomog;
5056  if (w!=NULL)
5057  {
5058    if (!idTestHomModule(v_id,currRing->qideal,w))
5059    {
5060      WarnS("wrong weights");
5061      w=NULL;
5062    }
5063    else
5064    {
5065      hom=isHomog;
5066      w=ivCopy(w);
5067    }
5068  }
5069  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),0);
5070  idSkipZeroes(result);
5071  res->data = (char *)result;
5072  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5073  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5074  return FALSE;
5075}
5076static BOOLEAN jjSBA_2(leftv res, leftv v, leftv u, leftv t)
5077{
5078  ideal result;
5079  ideal v_id=(ideal)v->Data();
5080  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5081  tHomog hom=testHomog;
5082  if (w!=NULL)
5083  {
5084    if (!idTestHomModule(v_id,currRing->qideal,w))
5085    {
5086      WarnS("wrong weights");
5087      w=NULL;
5088    }
5089    else
5090    {
5091      hom=isHomog;
5092      w=ivCopy(w);
5093    }
5094  }
5095  result=kSba(v_id,currRing->qideal,hom,&w,(int)(long)u->Data(),(int)(long)t->Data());
5096  idSkipZeroes(result);
5097  res->data = (char *)result;
5098  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5099  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5100  return FALSE;
5101}
5102static BOOLEAN jjSTD(leftv res, leftv v)
5103{
5104  if (rField_is_numeric(currRing))
5105    WarnS("groebner base computations with inexact coefficients can not be trusted due to rounding errors");
5106  ideal result;
5107  ideal v_id=(ideal)v->Data();
5108  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5109  tHomog hom=testHomog;
5110  if (w!=NULL)
5111  {
5112    if (!idTestHomModule(v_id,currRing->qideal,w))
5113    {
5114      WarnS("wrong weights");
5115      w=NULL;
5116    }
5117    else
5118    {
5119      hom=isHomog;
5120      w=ivCopy(w);
5121    }
5122  }
5123  result=kStd(v_id,currRing->qideal,hom,&w);
5124  idSkipZeroes(result);
5125  res->data = (char *)result;
5126  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5127  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
5128  return FALSE;
5129}
5130static BOOLEAN jjSort_Id(leftv res, leftv v)
5131{
5132  res->data = (char *)idSort((ideal)v->Data());
5133  return FALSE;
5134}
5135static BOOLEAN jjSQR_FREE(leftv res, leftv u)
5136{
5137  singclap_factorize_retry=0;
5138  intvec *v=NULL;
5139  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
5140  if (f==NULL) return TRUE;
5141  ivTest(v);
5142  lists l=(lists)omAllocBin(slists_bin);
5143  l->Init(2);
5144  l->m[0].rtyp=IDEAL_CMD;
5145  l->m[0].data=(void *)f;
5146  l->m[1].rtyp=INTVEC_CMD;
5147  l->m[1].data=(void *)v;
5148  res->data=(void *)l;
5149  return FALSE;
5150}
5151#if 0
5152static BOOLEAN jjSYZYGY(leftv res, leftv v)
5153{
5154  intvec *w=NULL;
5155  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
5156  if (w!=NULL) delete w;
5157  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
5158  return FALSE;
5159}
5160#else
5161// activate, if idSyz handle module weights correctly !
5162static BOOLEAN jjSYZYGY(leftv res, leftv v)
5163{
5164  ideal v_id=(ideal)v->Data();
5165#ifdef HAVE_SHIFTBBA
5166  if (rIsLPRing(currRing))
5167  {
5168    if (currRing->LPncGenCount < IDELEMS(v_id))
5169    {
5170      Werror("At least %d ncgen variables are needed for this computation.", IDELEMS(v_id));
5171      return TRUE;
5172    }
5173  }
5174#endif
5175  intvec *ww=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
5176  intvec *w=NULL;
5177  tHomog hom=testHomog;
5178  if (ww!=NULL)
5179  {
5180    if (idTestHomModule(v_id,currRing->qideal,ww))
5181    {
5182      w=ivCopy(ww);
5183      int add_row_shift=w->min_in();
5184      (*w)-=add_row_shift;
5185      hom=isHomog;
5186    }
5187    else
5188    {
5189      //WarnS("wrong weights");
5190      delete ww; ww=NULL;
5191      hom=testHomog;
5192    }
5193  }
5194  else
5195  {
5196    if (v->Typ()==IDEAL_CMD)
5197      if (idHomIdeal(v_id,currRing->qideal))
5198        hom=isHomog;
5199  }
5200  ideal S=idSyzygies(v_id,hom,&w);
5201  res->data = (char *)S;
5202  if (hom==isHomog)
5203  {
5204    int vl=S->rank;
5205    intvec *vv=new intvec(vl);
5206    if ((v->Typ()==IDEAL_CMD)||(ww==NULL))
5207    {
5208      for(int i=0;i<vl;i++)
5209      {
5210        if (v_id->m[i]!=NULL)
5211          (*vv)[i]=p_Deg(v_id->m[i],currRing);
5212      }
5213    }
5214    else
5215    {
5216      p_SetModDeg(ww, currRing);
5217      for(int i=0;i<vl;i++)
5218      {
5219        if (v_id->m[i]!=NULL)
5220          (*vv)[i]=currRing->pFDeg(v_id->m[i],currRing);
5221      }
5222      p_SetModDeg(NULL, currRing);
5223    }
5224    if (idTestHomModule(S,currRing->qideal,vv))
5225      atSet(res,omStrDup("isHomog"),vv,INTVEC_CMD);
5226    else
5227      delete vv;
5228  }
5229  if (w!=NULL) delete w;
5230  return FALSE;
5231}
5232#endif
5233static BOOLEAN jjTRACE_IV(leftv res, leftv v)
5234{
5235  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
5236  return FALSE;
5237}
5238static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
5239{
5240  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
5241  return FALSE;
5242}
5243static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
5244{
5245  res->data = (char *)ivTranp((intvec*)(v->Data()));
5246  return FALSE;
5247}
5248static BOOLEAN jjOPPOSITE(leftv res, leftv a)
5249{
5250#ifdef HAVE_PLURAL
5251  ring    r = (ring)a->Data();
5252  //if (rIsPluralRing(r))
5253  if (r->OrdSgn==1)
5254  {
5255    res->data = rOpposite(r);
5256  }
5257  else
5258  {
5259    WarnS("opposite only for global orderings");
5260    res->data = rCopy(r);
5261  }
5262  return FALSE;
5263#else
5264  return TRUE;
5265#endif
5266}
5267static BOOLEAN jjENVELOPE(leftv res, leftv a)
5268{
5269#ifdef HAVE_PLURAL
5270  ring    r = (ring)a->Data();
5271  if (rIsPluralRing(r))
5272  {
5273    ring s = rEnvelope(r);
5274    res->data = s;
5275  }
5276  else  res->data = rCopy(r);
5277  return FALSE;
5278#else
5279  return TRUE;
5280#endif
5281}
5282static BOOLEAN jjTWOSTD(leftv res, leftv a)
5283{
5284#ifdef HAVE_PLURAL
5285  ideal result;
5286  ideal v_id=(ideal)a->Data();
5287  if (rIsPluralRing(currRing))
5288    result=(ideal)twostd(v_id);
5289  else /*commutative or shiftalgebra*/
5290  {
5291    return jjSTD(res,a);
5292  }
5293  res->data = (char *)result;
5294  setFlag(res,FLAG_STD);
5295  setFlag(res,FLAG_TWOSTD);
5296  return FALSE;
5297#else
5298  return TRUE;
5299#endif
5300}
5301static BOOLEAN jjRIGHTSTD(leftv res, leftv v)
5302{
5303#if defined(HAVE_SHIFTBBA) || defined(HAVE_PLURAL)// do not place above jjSTD in this file because we need to reference it
5304  if (rIsLPRing(currRing))
5305  {
5306    if (rField_is_numeric(currRing))
5307      WarnS("groebner base computations with inexact coefficients can not be trusted due to rounding errors");
5308    ideal result;
5309    ideal v_id=(ideal)v->Data();
5310    /* intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD); */
5311    /* tHomog hom=testHomog; */
5312    /* if (w!=NULL) */
5313    /* { */
5314    /*   if (!idTestHomModule(v_id,currRing->qideal,w)) */
5315    /*   { */
5316    /*     WarnS("wrong weights"); */
5317    /*     w=NULL; */
5318    /*   } */
5319    /*   else */
5320    /*   { */
5321    /*     hom=isHomog; */
5322    /*     w=ivCopy(w); */
5323    /*   } */
5324    /* } */
5325    /* result=kStd(v_id,currRing->qideal,hom,&w); */
5326    result = rightgb(v_id, currRing->qideal);
5327    idSkipZeroes(result);
5328    res->data = (char *)result;
5329    if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5330    /* if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD); */
5331    return FALSE;
5332  }
5333  else if (rIsPluralRing(currRing))
5334  {
5335    ideal I=(ideal)v->Data();
5336
5337    ring A = currRing;
5338    ring Aopp = rOpposite(A);
5339    currRing = Aopp;
5340    ideal Iopp = idOppose(A, I, Aopp);
5341    ideal Jopp = kStd(Iopp,currRing->qideal,testHomog,NULL);
5342    currRing = A;
5343    ideal J = idOppose(Aopp, Jopp, A);
5344
5345    id_Delete(&Iopp, Aopp);
5346    id_Delete(&Jopp, Aopp);
5347    rDelete(Aopp);
5348
5349    idSkipZeroes(J);
5350    res->data = (char *)J;
5351    if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
5352    return FALSE;
5353  }
5354  else
5355  {
5356    return jjSTD(res, v);
5357  }
5358#else
5359  return TRUE;
5360#endif
5361}
5362static BOOLEAN jjTYPEOF(leftv res, leftv v)
5363{
5364  int t=(int)(long)v->data;
5365  switch (t)
5366  {
5367    case CRING_CMD:
5368    case INT_CMD:
5369    case POLY_CMD:
5370    case VECTOR_CMD:
5371    case STRING_CMD:
5372    case INTVEC_CMD:
5373    case IDEAL_CMD:
5374    case MATRIX_CMD:
5375    case MODUL_CMD:
5376    case MAP_CMD:
5377    case PROC_CMD:
5378    case RING_CMD:
5379    case SMATRIX_CMD:
5380    //case QRING_CMD:
5381    case INTMAT_CMD:
5382    case BIGINTMAT_CMD:
5383    case NUMBER_CMD:
5384    #ifdef SINGULAR_4_2
5385    case CNUMBER_CMD:
5386    #endif
5387    case BIGINT_CMD:
5388    case BUCKET_CMD:
5389    case LIST_CMD:
5390    case PACKAGE_CMD:
5391    case LINK_CMD:
5392    case RESOLUTION_CMD:
5393         res->data=omStrDup(Tok2Cmdname(t)); break;
5394    case DEF_CMD:
5395    case NONE:           res->data=omStrDup("none"); break;
5396    default:
5397    {
5398      if (t>MAX_TOK)
5399        res->data=omStrDup(getBlackboxName(t));
5400      else
5401        res->data=omStrDup("?unknown type?");
5402      break;
5403    }
5404  }
5405  return FALSE;
5406}
5407static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5408{
5409  res->data=(char *)(long)pIsUnivariate((poly)v->Data());
5410  return FALSE;
5411}
5412static BOOLEAN jjVAR1(leftv res, leftv v)
5413{
5414  int i=(int)(long)v->Data();
5415  if ((0<i) && (i<=currRing->N))
5416  {
5417    poly p=pOne();
5418    pSetExp(p,i,1);
5419    pSetm(p);
5420    res->data=(char *)p;
5421  }
5422  else
5423  {
5424    Werror("var number %d out of range 1..%d",i,currRing->N);
5425    return TRUE;
5426  }
5427  return FALSE;
5428}
5429static BOOLEAN jjVARSTR1(leftv res, leftv v)
5430{
5431  if (currRing==NULL)
5432  {
5433    WerrorS("no ring active (2)");
5434    return TRUE;
5435  }
5436  int i=(int)(long)v->Data();
5437  if ((0<i) && (i<=currRing->N))
5438    res->data=omStrDup(currRing->names[i-1]);
5439  else
5440  {
5441    Werror("var number %d out of range 1..%d",i,currRing->N);
5442    return TRUE;
5443  }
5444  return FALSE;
5445}
5446static BOOLEAN jjVDIM(leftv res, leftv v)
5447{
5448  assumeStdFlag(v);
5449#ifdef HAVE_SHIFTBBA
5450  if (rIsLPRing(currRing))
5451  {
5452#ifdef HAVE_RINGS
5453    if (rField_is_Ring(currRing))
5454    {
5455      WerrorS("`vdim` is not implemented for letterplace rings over rings");
5456      return TRUE;
5457    }
5458#endif
5459    if (currRing->qideal != NULL)
5460    {
5461      WerrorS("qring not supported by `vdim` for letterplace rings at the moment");
5462      return TRUE;
5463    }
5464    int kDim = lp_kDim((ideal)(v->Data()));
5465    res->data = (char *)(long)kDim;
5466    return (kDim == -2);
5467  }
5468#endif
5469  long l=scMult0Int((ideal)v->Data(),currRing->qideal);
5470  if (l<-1L)
5471    WerrorS("int overflow in vdim");
5472  res->data = (char *)l;
5473  return FALSE;
5474}
5475BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5476{
5477// input: u: a list with links of type
5478//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5479// returns: -1:  the read state of all links is eof
5480//          i>0: (at least) u[i] is ready
5481  lists Lforks = (lists)u->Data();
5482  int i = slStatusSsiL(Lforks, -1);
5483  if(i == -2) /* error */
5484  {
5485    return TRUE;
5486  }
5487  res->data = (void*)(long)i;
5488  return FALSE;
5489}
5490BOOLEAN jjWAITALL1(leftv res, leftv u)
5491{
5492// input: u: a list with links of type
5493//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5494// returns: -1: the read state of all links is eof
5495//           1: all links are ready
5496//              (caution: at least one is ready, but some maybe dead)
5497  lists Lforks = (lists)u->CopyD();
5498  int i;
5499  int j = -1;
5500  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5501  {
5502    i = slStatusSsiL(Lforks, -1);
5503    if(i == -2) /* error */
5504    {
5505      return TRUE;
5506    }
5507    if(i == -1)
5508    {
5509      break;
5510    }
5511    j = 1;
5512    Lforks->m[i-1].CleanUp();
5513    Lforks->m[i-1].rtyp=DEF_CMD;
5514    Lforks->m[i-1].data=NULL;
5515  }
5516  res->data = (void*)(long)j;
5517  Lforks->Clean();
5518  return FALSE;
5519}
5520
5521BOOLEAN jjLOAD(const char *s, BOOLEAN autoexport)
5522{
5523  char libnamebuf[1024];
5524  lib_types LT = type_of_LIB(s, libnamebuf);
5525
5526#ifdef HAVE_DYNAMIC_LOADING
5527  extern BOOLEAN load_modules(const char *newlib, char *fullpath, BOOLEAN autoexport);
5528#endif /* HAVE_DYNAMIC_LOADING */
5529  switch(LT)
5530  {
5531      default:
5532      case LT_NONE:
5533        Werror("%s: unknown type", s);
5534        break;
5535      case LT_NOTFOUND:
5536        Werror("cannot open %s", s);
5537        break;
5538
5539      case LT_SINGULAR:
5540      {
5541        char *plib = iiConvName(s);
5542        idhdl pl = IDROOT->get_level(plib,0);
5543        if (pl==NULL)
5544        {
5545          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5546          IDPACKAGE(pl)->language = LANG_SINGULAR;
5547          IDPACKAGE(pl)->libname=omStrDup(s);
5548        }
5549        else if (IDTYP(pl)!=PACKAGE_CMD)
5550        {
5551          Werror("can not create package `%s`",plib);
5552          omFreeBinAddr(plib);
5553          return TRUE;
5554        }
5555        else /* package */
5556        {
5557          package pa=IDPACKAGE(pl);
5558          if ((pa->language==LANG_C)
5559          || (pa->language==LANG_MIX))
5560          {
5561            Werror("can not create package `%s` - binaries  exists",plib);
5562            omFreeBinAddr(plib);
5563            return TRUE;
5564          }
5565        }
5566        omFreeBinAddr(plib);
5567        package savepack=currPack;
5568        currPack=IDPACKAGE(pl);
5569        IDPACKAGE(pl)->loaded=TRUE;
5570        char libnamebuf[1024];
5571        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5572        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5573        currPack=savepack;
5574        IDPACKAGE(pl)->loaded=(!bo);
5575        return bo;
5576      }
5577      case LT_BUILTIN:
5578        SModulFunc_t iiGetBuiltinModInit(const char*);
5579        return load_builtin(s,autoexport, iiGetBuiltinModInit(s));
5580      case LT_MACH_O:
5581      case LT_ELF:
5582      case LT_HPUX:
5583#ifdef HAVE_DYNAMIC_LOADING
5584        return load_modules(s, libnamebuf, autoexport);
5585#else /* HAVE_DYNAMIC_LOADING */
5586        WerrorS("Dynamic modules are not supported by this version of Singular");
5587        break;
5588#endif /* HAVE_DYNAMIC_LOADING */
5589  }
5590  return TRUE;
5591}
5592STATIC_VAR int WerrorS_dummy_cnt=0;
5593static void WerrorS_dummy(const char *)
5594{
5595  WerrorS_dummy_cnt++;
5596}
5597BOOLEAN jjLOAD_TRY(const char *s)
5598{
5599  if (!iiGetLibStatus(s))
5600  {
5601    void (*WerrorS_save)(const char *s) = WerrorS_callback;
5602    WerrorS_callback=WerrorS_dummy;
5603    WerrorS_dummy_cnt=0;
5604    BOOLEAN bo=jjLOAD(s,TRUE);
5605    if (TEST_OPT_PROT && (bo || (WerrorS_dummy_cnt>0)))
5606      Print("loading of >%s< failed\n",s);
5607    WerrorS_callback=WerrorS_save;
5608    errorreported=0;
5609  }
5610  return FALSE;
5611}
5612
5613static BOOLEAN jjstrlen(leftv res, leftv v)
5614{
5615  res->data = (char *)strlen((char *)v->Data());
5616  return FALSE;
5617}
5618static BOOLEAN jjpLength(leftv res, leftv v)
5619{
5620  res->data = (char *)(long)pLength((poly)v->Data());
5621  return FALSE;
5622}
5623static BOOLEAN jjidElem(leftv res, leftv v)
5624{
5625  res->data = (char *)(long)idElem((ideal)v->Data());
5626  return FALSE;
5627}
5628static BOOLEAN jjidFreeModule(leftv res, leftv v)
5629{
5630  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5631  return FALSE;
5632}
5633static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5634{
5635  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5636  return FALSE;
5637}
5638static BOOLEAN jjrCharStr(leftv res, leftv v)
5639{
5640  res->data = rCharStr((ring)v->Data());
5641  return FALSE;
5642}
5643static BOOLEAN jjpHead(leftv res, leftv v)
5644{
5645  res->data = (char *)pHead((poly)v->Data());
5646  return FALSE;
5647}
5648static BOOLEAN jjidHead(leftv res, leftv v)
5649{
5650  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5651  setFlag(res,FLAG_STD);
5652  return FALSE;
5653}
5654static BOOLEAN jjidMinBase(leftv res, leftv v)
5655{
5656  res->data = (char *)idMinBase((ideal)v->Data());
5657  return FALSE;
5658}
5659#if 0 // unused
5660static BOOLEAN jjsyMinBase(leftv res, leftv v)
5661{
5662  res->data = (char *)syMinBase((ideal)v->Data());
5663  return FALSE;
5664}
5665#endif
5666static BOOLEAN jjpMaxComp(leftv res, leftv v)
5667{
5668  res->data = (char *)pMaxComp((poly)v->Data());
5669  return FALSE;
5670}
5671static BOOLEAN jjmpTrace(leftv res, leftv v)
5672{
5673  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5674  return FALSE;
5675}
5676static BOOLEAN jjmpTransp(leftv res, leftv v)
5677{
5678  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5679  return FALSE;
5680}
5681static BOOLEAN jjrOrdStr(leftv res, leftv v)
5682{
5683  res->data = rOrdStr((ring)v->Data());
5684  return FALSE;
5685}
5686static BOOLEAN jjrVarStr(leftv res, leftv v)
5687{
5688  res->data = rVarStr((ring)v->Data());
5689  return FALSE;
5690}
5691static BOOLEAN jjrParStr(leftv res, leftv v)
5692{
5693  res->data = rParStr((ring)v->Data());
5694  return FALSE;
5695}
5696static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5697{
5698  res->data=(char *)(long)sySize((syStrategy)v->Data());
5699  return FALSE;
5700}
5701static BOOLEAN jjDIM_R(leftv res, leftv v)
5702{
5703  res->data = (char *)(long)syDim((syStrategy)v->Data());
5704  return FALSE;
5705}
5706static BOOLEAN jjidTransp(leftv res, leftv v)
5707{
5708  res->data = (char *)id_Transp((ideal)v->Data(),currRing);
5709  return FALSE;
5710}
5711static BOOLEAN jjnInt(leftv res, leftv u)
5712{
5713  number n=(number)u->CopyD(); // n_Int may call n_Normalize
5714  res->data=(char *)(long)iin_Int(n,currRing->cf);
5715  n_Delete(&n,currRing->cf);
5716  return FALSE;
5717}
5718static BOOLEAN jjnlInt(leftv res, leftv u)
5719{
5720  number n=(number)u->Data();
5721  res->data=(char *)(long)iin_Int(n,coeffs_BIGINT );
5722  return FALSE;
5723}
5724/*=================== operations with 3 args.: static proc =================*/
5725/* must be ordered: first operations for chars (infix ops),
5726 * then alphabetically */
5727static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5728{
5729  char *s= (char *)u->Data();
5730  int   r = (int)(long)v->Data();
5731  int   c = (int)(long)w->Data();
5732  int l = strlen(s);
5733
5734  if ( (r<1) || (r>l) || (c<0) )
5735  {
5736    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5737    return TRUE;
5738  }
5739  res->data = (char *)omAlloc((long)(c+1));
5740  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5741  return FALSE;
5742}
5743static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5744{
5745  intvec *iv = (intvec *)u->Data();
5746  int   r = (int)(long)v->Data();
5747  int   c = (int)(long)w->Data();
5748  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5749  {
5750    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5751           r,c,u->Fullname(),iv->rows(),iv->cols());
5752    return TRUE;
5753  }
5754  res->data=u->data; u->data=NULL;
5755  res->rtyp=u->rtyp; u->rtyp=0;
5756  res->name=u->name; u->name=NULL;
5757  Subexpr e=jjMakeSub(v);
5758          e->next=jjMakeSub(w);
5759  if (u->e==NULL) res->e=e;
5760  else
5761  {
5762    Subexpr h=u->e;
5763    while (h->next!=NULL) h=h->next;
5764    h->next=e;
5765    res->e=u->e;
5766    u->e=NULL;
5767  }
5768  return FALSE;
5769}
5770static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5771{
5772  bigintmat *bim = (bigintmat *)u->Data();
5773  int   r = (int)(long)v->Data();
5774  int   c = (int)(long)w->Data();
5775  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5776  {
5777    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5778           r,c,u->Fullname(),bim->rows(),bim->cols());
5779    return TRUE;
5780  }
5781  res->data=u->data; u->data=NULL;
5782  res->rtyp=u->rtyp; u->rtyp=0;
5783  res->name=u->name; u->name=NULL;
5784  Subexpr e=jjMakeSub(v);
5785          e->next=jjMakeSub(w);
5786  if (u->e==NULL)
5787    res->e=e;
5788  else
5789  {
5790    Subexpr h=u->e;
5791    while (h->next!=NULL) h=h->next;
5792    h->next=e;
5793    res->e=u->e;
5794    u->e=NULL;
5795  }
5796  return FALSE;
5797}
5798static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5799{
5800  matrix m= (matrix)u->Data();
5801  int   r = (int)(long)v->Data();
5802  int   c = (int)(long)w->Data();
5803  //Print("gen. elem %d, %d\n",r,c);
5804  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5805  {
5806    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5807      MATROWS(m),MATCOLS(m));
5808    return TRUE;
5809  }
5810  res->data=u->data; u->data=NULL;
5811  res->rtyp=u->rtyp; u->rtyp=0;
5812  res->name=u->name; u->name=NULL;
5813  Subexpr e=jjMakeSub(v);
5814          e->next=jjMakeSub(w);
5815  if (u->e==NULL)
5816    res->e=e;
5817  else
5818  {
5819    Subexpr h=u->e;
5820    while (h->next!=NULL) h=h->next;
5821    h->next=e;
5822    res->e=u->e;
5823    u->e=NULL;
5824  }
5825  return FALSE;
5826}
5827static BOOLEAN jjBRACK_SM(leftv res, leftv u, leftv v,leftv w)
5828{
5829  ideal m= (ideal)u->Data();
5830  int   r = (int)(long)v->Data();
5831  int   c = (int)(long)w->Data();
5832  //Print("gen. elem %d, %d\n",r,c);
5833  if ((r<1)||(r>m->rank)||(c<1)||(c>IDELEMS(m)))
5834  {
5835    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5836      (int)m->rank,IDELEMS(m));
5837    return TRUE;
5838  }
5839  res->data=u->data; u->data=NULL;
5840  res->rtyp=u->rtyp; u->rtyp=0;
5841  res->name=u->name; u->name=NULL;
5842  Subexpr e=jjMakeSub(v);
5843          e->next=jjMakeSub(w);
5844  if (u->e==NULL)
5845    res->e=e;
5846  else
5847  {
5848    Subexpr h=u->e;
5849    while (h->next!=NULL) h=h->next;
5850    h->next=e;
5851    res->e=u->e;
5852    u->e=NULL;
5853  }
5854  return FALSE;
5855}
5856static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5857{
5858  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5859  {
5860    WerrorS("cannot build expression lists from unnamed objects");
5861    return TRUE;
5862  }
5863
5864  leftv p=NULL;
5865  intvec *iv=(intvec *)w->Data();
5866  int l;
5867  BOOLEAN nok;
5868  sleftv ut;
5869  memcpy(&ut,u,sizeof(ut));
5870  sleftv t;
5871  t.Init();
5872  t.rtyp=INT_CMD;
5873  for (l=0;l< iv->length(); l++)
5874  {
5875    t.data=(char *)(long)((*iv)[l]);
5876    if (p==NULL)
5877    {
5878      p=res;
5879    }
5880    else
5881    {
5882      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5883      p=p->next;
5884    }
5885    memcpy(u,&ut,sizeof(ut));
5886    if (u->Typ() == MATRIX_CMD)
5887      nok=jjBRACK_Ma(p,u,v,&t);
5888    else if (u->Typ() == BIGINTMAT_CMD)
5889      nok=jjBRACK_Bim(p,u,v,&t);
5890    else /* INTMAT_CMD */
5891      nok=jjBRACK_Im(p,u,v,&t);
5892    if (nok)
5893    {
5894      while (res->next!=NULL)
5895      {
5896        p=res->next->next;
5897        omFreeBin((ADDRESS)res->next, sleftv_bin);
5898        // res->e aufraeumen !!!!
5899        res->next=p;
5900      }
5901      return TRUE;
5902    }
5903  }
5904  return FALSE;
5905}
5906static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5907{
5908  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5909  {
5910    WerrorS("cannot build expression lists from unnamed objects");
5911    return TRUE;
5912  }
5913  leftv p=NULL;
5914  intvec *iv=(intvec *)v->Data();
5915  int l;
5916  BOOLEAN nok;
5917  sleftv ut;
5918  memcpy(&ut,u,sizeof(ut));
5919  sleftv t;
5920  t.Init();
5921  t.rtyp=INT_CMD;
5922  for (l=0;l< iv->length(); l++)
5923  {
5924    t.data=(char *)(long)((*iv)[l]);
5925    if (p==NULL)
5926    {
5927      p=res;
5928    }
5929    else
5930    {
5931      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5932      p=p->next;
5933    }
5934    memcpy(u,&ut,sizeof(ut));
5935    if (u->Typ() == MATRIX_CMD)
5936      nok=jjBRACK_Ma(p,u,&t,w);
5937    else if (u->Typ() == BIGINTMAT_CMD)
5938      nok=jjBRACK_Bim(p,u,&t,w);
5939    else /* INTMAT_CMD */
5940      nok=jjBRACK_Im(p,u,&t,w);
5941    if (nok)
5942    {
5943      while (res->next!=NULL)
5944      {
5945        p=res->next->next;
5946        omFreeBin((ADDRESS)res->next, sleftv_bin);
5947        // res->e aufraeumen !!
5948        res->next=p;
5949      }
5950      return TRUE;
5951    }
5952  }
5953  return FALSE;
5954}
5955static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5956{
5957  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5958  {
5959    WerrorS("cannot build expression lists from unnamed objects");
5960    return TRUE;
5961  }
5962  leftv p=NULL;
5963  intvec *vv=(intvec *)v->Data();
5964  intvec *wv=(intvec *)w->Data();
5965  int vl;
5966  int wl;
5967  BOOLEAN nok;
5968
5969  sleftv t1,t2,ut;
5970  memcpy(&ut,u,sizeof(ut));
5971  t1.Init();
5972  t1.rtyp=INT_CMD;
5973  t2.Init();
5974  t2.rtyp=INT_CMD;
5975  for (vl=0;vl< vv->length(); vl++)
5976  {
5977    t1.data=(char *)(long)((*vv)[vl]);
5978    for (wl=0;wl< wv->length(); wl++)
5979    {
5980      t2.data=(char *)(long)((*wv)[wl]);
5981      if (p==NULL)
5982      {
5983        p=res;
5984      }
5985      else
5986      {
5987        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5988        p=p->next;
5989      }
5990      memcpy(u,&ut,sizeof(ut));
5991      if (u->Typ() == MATRIX_CMD)
5992        nok=jjBRACK_Ma(p,u,&t1,&t2);
5993      else if (u->Typ() == BIGINTMAT_CMD)
5994        nok=jjBRACK_Bim(p,u,&t1,&t2);
5995      else /* INTMAT_CMD */
5996        nok=jjBRACK_Im(p,u,&t1,&t2);
5997      if (nok)
5998      {
5999        res->CleanUp();
6000        return TRUE;
6001      }
6002    }
6003  }
6004  return FALSE;
6005}
6006static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
6007{
6008  v->next=(leftv)omAllocBin(sleftv_bin);
6009  memcpy(v->next,w,sizeof(sleftv));
6010  w->Init();
6011  return jjPROC(res,u,v);
6012}
6013static BOOLEAN jjRING_2(leftv res, leftv u, leftv v, leftv w)
6014{
6015  u->next=(leftv)omAlloc(sizeof(sleftv));
6016  memcpy(u->next,v,sizeof(sleftv));
6017  v->Init();
6018  u->next->next=(leftv)omAlloc(sizeof(sleftv));
6019  memcpy(u->next->next,w,sizeof(sleftv));
6020  w->Init();
6021  BOOLEAN bo=iiExprArithM(res,u,'[');
6022  u->next=NULL;
6023  return bo;
6024}
6025static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
6026{
6027  intvec *iv;
6028  ideal m;
6029  lists l=(lists)omAllocBin(slists_bin);
6030  int k=(int)(long)w->Data();
6031  if (k>=0)
6032  {
6033    sm_CallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv, currRing);
6034    l->Init(2);
6035    l->m[0].rtyp=MODUL_CMD;
6036    l->m[1].rtyp=INTVEC_CMD;
6037    l->m[0].data=(void *)m;
6038    l->m[1].data=(void *)iv;
6039  }
6040  else
6041  {
6042    m=sm_CallSolv((ideal)u->Data(), currRing);
6043    l->Init(1);
6044    l->m[0].rtyp=IDEAL_CMD;
6045    l->m[0].data=(void *)m;
6046  }
6047  res->data = (char *)l;
6048  return FALSE;
6049}
6050static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
6051{
6052  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
6053  {
6054    WerrorS("3rd argument must be a name of a matrix");
6055    return TRUE;
6056  }
6057  ideal i=(ideal)u->Data();
6058  int rank=(int)i->rank;
6059  BOOLEAN r=jjCOEFFS_Id(res,u,v);
6060  if (r) return TRUE;
6061  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
6062  return FALSE;
6063}
6064static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
6065{
6066  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
6067           (ideal)(v->Data()),(poly)(w->Data()));
6068  return FALSE;
6069}
6070static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
6071{
6072  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
6073  {
6074    WerrorS("3rd argument must be a name of a matrix");
6075    return TRUE;
6076  }
6077  // CopyD for POLY_CMD and VECTOR_CMD are identical:
6078  poly p=(poly)u->CopyD(POLY_CMD);
6079  ideal i=idInit(1,1);
6080  i->m[0]=p;
6081  sleftv t;
6082  t.Init();
6083  t.data=(char *)i;
6084  t.rtyp=IDEAL_CMD;
6085  int rank=1;
6086  if (u->Typ()==VECTOR_CMD)
6087  {
6088    i->rank=rank=pMaxComp(p);
6089    t.rtyp=MODUL_CMD;
6090  }
6091  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
6092  t.CleanUp();
6093  if (r) return TRUE;
6094  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
6095  return FALSE;
6096}
6097static BOOLEAN jjELIMIN_ALG(leftv res, leftv u, leftv v, leftv w)
6098{
6099  ideal I=(ideal)u->Data();
6100  GbVariant alg=syGetAlgorithm((char*)w->Data(),currRing,I);
6101  res->data=(char *)idElimination(I,(poly)v->Data(),NULL,alg);
6102  //setFlag(res,FLAG_STD);
6103  return v->next!=NULL; //do not allow next like in eliminate(I,a(1..4))
6104}
6105static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
6106{
6107  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
6108    (intvec *)w->Data());
6109  //setFlag(res,FLAG_STD);
6110  return FALSE;
6111}
6112static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
6113{
6114  /*4
6115  * look for the substring what in the string where
6116  * starting at position n
6117  * return the position of the first char of what in where
6118  * or 0
6119  */
6120  int n=(int)(long)w->Data();
6121  char *where=(char *)u->Data();
6122  char *what=(char *)v->Data();
6123  char *found;
6124  if ((1>n)||(n>(int)strlen(where)))
6125  {
6126    Werror("start position %d out of range",n);
6127    return TRUE;
6128  }
6129  found = strchr(where+n-1,*what);
6130  if (*(what+1)!='\0')
6131  {
6132    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
6133    {
6134      found=strchr(found+1,*what);
6135    }
6136  }
6137  if (found != NULL)
6138  {
6139    res->data=(char *)((found-where)+1);
6140  }
6141  return FALSE;
6142}
6143static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
6144{
6145  if ((int)(long)w->Data()==0)
6146    res->data=(char *)walkProc(u,v);
6147  else
6148    res->data=(char *)fractalWalkProc(u,v);
6149  setFlag( res, FLAG_STD );
6150  return FALSE;
6151}
6152static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
6153{
6154  intvec *wdegree=(intvec*)w->Data();
6155  if (wdegree->length()!=currRing->N)
6156  {
6157    Werror("weight vector must have size %d, not %d",
6158           currRing->N,wdegree->length());
6159    return TRUE;
6160  }
6161#ifdef HAVE_RINGS
6162  if (rField_is_Z(currRing))
6163  {
6164    PrintS("// NOTE: computation of Hilbert series etc. is being\n");
6165    PrintS("//       performed for generic fibre, that is, over Q\n");
6166  }
6167#endif
6168  assumeStdFlag(u);
6169  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6170  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currRing->qideal,wdegree);
6171  if (errorreported) return TRUE;
6172
6173  switch((int)(long)v->Data())
6174  {
6175    case 1:
6176      res->data=(void *)iv;
6177      return FALSE;
6178    case 2:
6179      res->data=(void *)hSecondSeries(iv);
6180      delete iv;
6181      return FALSE;
6182  }
6183  delete iv;
6184  WerrorS(feNotImplemented);
6185  return TRUE;
6186}
6187static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv /*w*/)
6188{
6189  PrintS("TODO\n");
6190  int i=pVar((poly)v->Data());
6191  if (i==0)
6192  {
6193    WerrorS("ringvar expected");
6194    return TRUE;
6195  }
6196  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
6197  int d=pWTotaldegree(p);
6198  pLmDelete(p);
6199  if (d==1)
6200    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
6201  else
6202    WerrorS("variable must have weight 1");
6203  return (d!=1);
6204}
6205static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv /*w*/)
6206{
6207  PrintS("TODO\n");
6208  int i=pVar((poly)v->Data());
6209  if (i==0)
6210  {
6211    WerrorS("ringvar expected");
6212    return TRUE;
6213  }
6214  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
6215  int d=pWTotaldegree(p);
6216  pLmDelete(p);
6217  if (d==1)
6218    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
6219  else
6220    WerrorS("variable must have weight 1");
6221  return (d!=1);
6222}
6223static BOOLEAN jjHOMOG_W_M(leftv res, leftv v1, leftv v2, leftv v3)
6224{
6225  intvec *w=(intvec *)v3->Data();
6226  intvec *vw=(intvec*)v2->Data();
6227  ideal v_id=(ideal)v1->Data();
6228  res->data=(void *)(long)id_HomModuleW(v_id,currRing->qideal,vw,w,currRing);
6229  return FALSE;
6230}
6231static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
6232{
6233  intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
6234  intvec* arg = (intvec*) u->Data();
6235  int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
6236
6237  for (i=0; i<n; i++)
6238  {
6239    (*im)[i] = (*arg)[i];
6240  }
6241
6242  res->data = (char *)im;
6243  return FALSE;
6244}
6245static BOOLEAN jjINTERSECT3(leftv res, leftv u, leftv v, leftv w)
6246{
6247  ideal I1=(ideal)u->Data();
6248  ideal I2=(ideal)v->Data();
6249  ideal I3=(ideal)w->Data();
6250  resolvente r=(resolvente)omAlloc0(3*sizeof(ideal));
6251  r[0]=I1;
6252  r[1]=I2;
6253  r[2]=I3;
6254  res->data=(char *)idMultSect(r,3);
6255  omFreeSize((ADDRESS)r,3*sizeof(ideal));
6256  return FALSE;
6257}
6258static BOOLEAN jjINTERSEC3S(leftv res, leftv u, leftv v, leftv w)
6259{
6260  ideal I=(ideal)u->Data();
6261  GbVariant alg=syGetAlgorithm((char*)w->Data(),currRing,I);
6262  res->data=(char *)idSect(I,(ideal)v->Data(),alg);
6263  if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
6264  return FALSE;
6265}
6266static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
6267{
6268  int *iw=iv2array((intvec *)w->Data(),currRing);
6269  res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
6270  omFreeSize( (ADDRESS)iw, (rVar(currRing)+1)*sizeof(int) );
6271  return FALSE;
6272}
6273static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
6274{
6275  if (!pIsUnit((poly)v->Data()))
6276  {
6277    WerrorS("2nd argument must be a unit");
6278    return TRUE;
6279  }
6280  res->data = (char *)p_Series((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD(),NULL,currRing);
6281  return FALSE;
6282}
6283static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
6284{
6285  res->data = (char *)id_JetW((ideal)u->Data(),(int)(long)v->Data(),
6286                             (intvec *)w->Data(),currRing);
6287  return FALSE;
6288}
6289static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
6290{
6291  if (!mp_IsDiagUnit((matrix)v->Data(), currRing))
6292  {
6293    WerrorS("2nd argument must be a diagonal matrix of units");
6294    return TRUE;
6295  }
6296  res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
6297                               (matrix)v->CopyD());
6298  return FALSE;
6299}
6300static BOOLEAN jjMINOR_M(leftv res, leftv v)
6301{
6302  /* Here's the use pattern for the minor command:
6303        minor ( matrix_expression m, int_expression minorSize,
6304                optional ideal_expression IasSB, optional int_expression k,
6305                optional string_expression algorithm,
6306                optional int_expression cachedMinors,
6307                optional int_expression cachedMonomials )
6308     This method here assumes that there are at least two arguments.
6309     - If IasSB is present, it must be a std basis. All minors will be
6310       reduced w.r.t. IasSB.
6311     - If k is absent, all non-zero minors will be computed.
6312       If k is present and k > 0, the first k non-zero minors will be
6313       computed.
6314       If k is present and k < 0, the first |k| minors (some of which
6315       may be zero) will be computed.
6316       If k is present and k = 0, an error is reported.
6317     - If algorithm is absent, all the following arguments must be absent too.
6318       In this case, a heuristic picks the best-suited algorithm (among
6319       Bareiss, Laplace, and Laplace with caching).
6320       If algorithm is present, it must be one of "Bareiss", "bareiss",
6321       "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
6322       "cache" two more arguments may be given, determining how many entries
6323       the cache may have at most, and how many cached monomials there are at
6324       most. (Cached monomials are counted over all cached polynomials.)
6325       If these two additional arguments are not provided, 200 and 100000
6326       will be used as defaults.
6327  */
6328  matrix m;
6329  leftv u=v->next;
6330  v->next=NULL;
6331  int v_typ=v->Typ();
6332  if (v_typ==MATRIX_CMD)
6333  {
6334     m = (const matrix)v->Data();
6335  }
6336  else
6337  {
6338    if (v_typ==0)
6339    {
6340      Werror("`%s` is undefined",v->Fullname());
6341      return TRUE;
6342    }
6343    // try to convert to MATRIX:
6344    int ii=iiTestConvert(v_typ,MATRIX_CMD);
6345    BOOLEAN bo;
6346    sleftv tmp;
6347    if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
6348    else bo=TRUE;
6349    if (bo)
6350    {
6351      Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
6352      return TRUE;
6353    }
6354    m=(matrix)tmp.data;
6355  }
6356  const int mk = (const int)(long)u->Data();
6357  bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
6358  bool noCacheMinors = true; bool noCacheMonomials = true;
6359  ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
6360
6361  /* here come the different cases of correct argument sets */
6362  if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
6363  {
6364    IasSB = (ideal)u->next->Data();
6365    noIdeal = false;
6366    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6367    {
6368      k = (int)(long)u->next->next->Data();
6369      noK = false;
6370      if ((u->next->next->next != NULL) &&
6371          (u->next->next->next->Typ() == STRING_CMD))
6372      {
6373        algorithm = (char*)u->next->next->next->Data();
6374        noAlgorithm = false;
6375        if ((u->next->next->next->next != NULL) &&
6376            (u->next->next->next->next->Typ() == INT_CMD))
6377        {
6378          cacheMinors = (int)(long)u->next->next->next->next->Data();
6379          noCacheMinors = false;
6380          if ((u->next->next->next->next->next != NULL) &&
6381              (u->next->next->next->next->next->Typ() == INT_CMD))
6382          {
6383            cacheMonomials =
6384               (int)(long)u->next->next->next->next->next->Data();
6385            noCacheMonomials = false;
6386          }
6387        }
6388      }
6389    }
6390  }
6391  else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
6392  {
6393    k = (int)(long)u->next->Data();
6394    noK = false;
6395    if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
6396    {
6397      algorithm = (char*)u->next->next->Data();
6398      noAlgorithm = false;
6399      if ((u->next->next->next != NULL) &&
6400          (u->next->next->next->Typ() == INT_CMD))
6401      {
6402        cacheMinors = (int)(long)u->next->next->next->Data();
6403        noCacheMinors = false;
6404        if ((u->next->next->next->next != NULL) &&
6405            (u->next->next->next->next->Typ() == INT_CMD))
6406        {
6407          cacheMonomials = (int)(long)u->next->next->next->next->Data();
6408          noCacheMonomials = false;
6409        }
6410      }
6411    }
6412  }
6413  else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
6414  {
6415    algorithm = (char*)u->next->Data();
6416    noAlgorithm = false;
6417    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
6418    {
6419      cacheMinors = (int)(long)u->next->next->Data();
6420      noCacheMinors = false;
6421      if ((u->next->next->next != NULL) &&
6422          (u->next->next->next->Typ() == INT_CMD))
6423      {
6424        cacheMonomials = (int)(long)u->next->next->next->Data();
6425        noCacheMonomials = false;
6426      }
6427    }
6428  }
6429
6430  /* upper case conversion for the algorithm if present */
6431  if (!noAlgorithm)
6432  {
6433    if (strcmp(algorithm, "bareiss") == 0)
6434      algorithm = (char*)"Bareiss";
6435    if (strcmp(algorithm, "laplace") == 0)
6436      algorithm = (char*)"Laplace";
6437    if (strcmp(algorithm, "cache") == 0)
6438      algorithm = (char*)"Cache";
6439  }
6440
6441  v->next=u;
6442  /* here come some tests */
6443  if (!noIdeal)
6444  {
6445    assumeStdFlag(u->next);
6446  }
6447  if ((!noK) && (k == 0))
6448  {
6449    WerrorS("Provided number of minors to be computed is zero.");
6450    return TRUE;
6451  }
6452  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") != 0)
6453      && (strcmp(algorithm, "Laplace") != 0)
6454      && (strcmp(algorithm, "Cache") != 0))
6455  {
6456    WerrorS("Expected as algorithm one of 'B/bareiss', 'L/laplace', or 'C/cache'.");
6457    return TRUE;
6458  }
6459  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") == 0)
6460      && (!rField_is_Domain(currRing)))
6461  {
6462    Werror("Bareiss algorithm not defined over coefficient rings %s",
6463           "with zero divisors.");
6464    return TRUE;
6465  }
6466  if ((mk < 1) || (mk > m->rows()) || (mk > m->cols()))
6467  {
6468    ideal I=idInit(1,1);
6469    if (mk<1) I->m[0]=p_One(currRing);
6470    //Werror("invalid size of minors: %d (matrix is (%d x %d))", mk,
6471    //       m->rows(), m->cols());
6472    res->data=(void*)I;
6473    return FALSE;
6474  }
6475  if ((!noAlgorithm) && (strcmp(algorithm, "Cache") == 0)
6476      && (noCacheMinors || noCacheMonomials))
6477  {
6478    cacheMinors = 200;
6479    cacheMonomials = 100000;
6480  }
6481
6482  /* here come the actual procedure calls */
6483  if (noAlgorithm)
6484    res->data = getMinorIdealHeuristic(m, mk, (noK ? 0 : k),
6485                                       (noIdeal ? 0 : IasSB), false);
6486  else if (strcmp(algorithm, "Cache") == 0)
6487    res->data = getMinorIdealCache(m, mk, (noK ? 0 : k),
6488                                   (noIdeal ? 0 : IasSB), 3, cacheMinors,
6489                                   cacheMonomials, false);
6490  else
6491    res->data = getMinorIdeal(m, mk, (noK ? 0 : k), algorithm,
6492                              (noIdeal ? 0 : IasSB), false);
6493  if (v_typ!=MATRIX_CMD) idDelete((ideal *)&m);
6494  return FALSE;
6495}
6496static BOOLEAN jjNEWSTRUCT3(leftv, leftv u, leftv v, leftv w)
6497{
6498  // u: the name of the new type
6499  // v: the parent type
6500  // w: the elements
6501  newstruct_desc d=newstructChildFromString((const char *)v->Data(),
6502                                            (const char *)w->Data());
6503  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
6504  return (d==NULL);
6505}
6506static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w)
6507{
6508  // handles preimage(r,phi,i) and kernel(r,phi)
6509  idhdl h;
6510  ring rr;
6511  map mapping;
6512  BOOLEAN kernel_cmd= (iiOp==KERNEL_CMD);
6513
6514  if ((v->name==NULL) || (!kernel_cmd && (w->name==NULL)))
6515  {
6516    WerrorS("2nd/3rd arguments must have names");
6517    return TRUE;
6518  }
6519  rr=(ring)u->Data();
6520  const char *ring_name=u->Name();
6521  if ((h=rr->idroot->get(v->name,myynest))!=NULL)
6522  {
6523    if (h->typ==MAP_CMD)
6524    {
6525      mapping=IDMAP(h);
6526      idhdl preim_ring=IDROOT->get(mapping->preimage,myynest);
6527      if ((preim_ring==NULL)
6528      || (IDRING(preim_ring)!=currRing))
6529      {
6530        Werror("preimage ring `%s` is not the basering",mapping->preimage);
6531        return TRUE;
6532      }
6533    }
6534    else if (h->typ==IDEAL_CMD)
6535    {
6536      mapping=IDMAP(h);
6537    }
6538    else
6539    {
6540      Werror("`%s` is no map nor ideal",IDID(h));
6541      return TRUE;
6542    }
6543  }
6544  else
6545  {
6546    Werror("`%s` is not defined in `%s`",v->name,ring_name);
6547    return TRUE;
6548  }
6549  ideal image;
6550  if (kernel_cmd) image=idInit(1,1);
6551  else
6552  {
6553    if ((h=rr->idroot->get(w->name,myynest))!=NULL)
6554    {
6555      if (h->typ==IDEAL_CMD)
6556      {
6557        image=IDIDEAL(h);
6558      }
6559      else
6560      {
6561        Werror("`%s` is no ideal",IDID(h));
6562        return TRUE;
6563      }
6564    }
6565    else
6566    {
6567      Werror("`%s` is not defined in `%s`",w->name,ring_name);
6568      return TRUE;
6569    }
6570  }
6571  if (((currRing->qideal!=NULL) && (rHasLocalOrMixedOrdering(currRing)))
6572  || ((rr->qideal!=NULL) && (rHasLocalOrMixedOrdering(rr))))
6573  {
6574    WarnS("preimage in local qring may be wrong: use Ring::preimageLoc instead");
6575  }
6576  res->data=(char *)maGetPreimage(rr,mapping,image,currRing);
6577  if (kernel_cmd) idDelete(&image);
6578  return (res->data==NULL/* is of type ideal, should not be NULL*/);
6579}
6580static BOOLEAN jjRANDOM_Im(leftv res, leftv u, leftv v, leftv w)
6581{
6582  int di, k;
6583  int i=(int)(long)u->Data();
6584  int r=(int)(long)v->Data();
6585  int c=(int)(long)w->Data();
6586  if ((r<=0) || (c<=0)) return TRUE;
6587  intvec *iv = new intvec(r, c, 0);
6588  if (iv->rows()==0)
6589  {
6590    delete iv;
6591    return TRUE;
6592  }
6593  if (i!=0)
6594  {
6595    if (i<0) i = -i;
6596    di = 2 * i + 1;
6597    for (k=0; k<iv->length(); k++)
6598    {
6599      (*iv)[k] = ((siRand() % di) - i);
6600    }
6601  }
6602  res->data = (char *)iv;
6603  return FALSE;
6604}
6605#ifdef SINGULAR_4_2
6606static BOOLEAN jjRANDOM_CF(leftv res, leftv u, leftv v, leftv w)
6607// <coeff>, par1, par2 -> number2
6608{
6609  coeffs cf=(coeffs)u->Data();
6610  if ((cf==NULL) ||(cf->cfRandom==NULL))
6611  {
6612    Werror("no random function defined for coeff %d",cf->type);
6613    return TRUE;
6614  }
6615  else
6616  {
6617    number n= n_Random(siRand,(number)v->Data(),(number)w->Data(),cf);
6618    number2 nn=(number2)omAlloc(sizeof(*nn));
6619    nn->cf=cf;
6620    nn->n=n;
6621    res->data=nn;
6622    return FALSE;
6623  }
6624  return TRUE;
6625}
6626#endif
6627static BOOLEAN jjSUBST_Test(leftv v,leftv w,
6628  int &ringvar, poly &monomexpr)
6629{
6630  monomexpr=(poly)w->Data();
6631  poly p=(poly)v->Data();
6632#if 0
6633  if (pLength(monomexpr)>1)
6634  {
6635    Werror("`%s` substitutes a ringvar only by a term",
6636      Tok2Cmdname(SUBST_CMD));
6637    return TRUE;
6638  }
6639#endif
6640  if ((ringvar=pVar(p))==0)
6641  {
6642    if ((p!=NULL) && (currRing->cf->extRing!=NULL))
6643    {
6644      number n = pGetCoeff(p);
6645      ringvar= -n_IsParam(n, currRing);
6646    }
6647    if(ringvar==0)
6648    {
6649      WerrorS("ringvar/par expected");
6650      return TRUE;
6651    }
6652  }
6653  return FALSE;
6654}
6655static BOOLEAN jjSUBST_Bu(leftv res, leftv u, leftv v,leftv w)
6656{
6657  // generic conversion from polyBucket to poly:
6658  // force this to be the first try everytime
6659  poly p; int l;
6660  sBucket_pt bu=(sBucket_pt)w->CopyD();
6661  sBucketDestroyAdd(bu,&p,&l);
6662  sleftv tmpw;
6663  tmpw.Init();
6664  tmpw.rtyp=POLY_CMD;
6665  tmpw.data=p;
6666  return iiExprArith3(res, iiOp, u, v, &tmpw);
6667}
6668static BOOLEAN jjSUBST_P(leftv res, leftv u, leftv v,leftv w)
6669{
6670  int ringvar;
6671  poly monomexpr;
6672  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6673  if (nok) return TRUE;
6674  poly p=(poly)u->Data();
6675  if (ringvar>0)
6676  {
6677    int mm=p_MaxExpPerVar(p,ringvar,currRing);
6678    if (!rIsLPRing(currRing) &&
6679    (monomexpr!=NULL) && (p!=NULL) && (mm!=0) &&
6680    ((unsigned long)pTotaldegree(monomexpr) > (currRing->bitmask / (unsigned long)mm/2)))
6681    {
6682      Warn("possible OVERFLOW in subst, max exponent is %ld, substituting deg %d by deg %d",currRing->bitmask/2, pTotaldegree(monomexpr), mm);
6683      //return TRUE;
6684    }
6685    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6686      res->data = pSubst((poly)u->CopyD(res->rtyp),ringvar,monomexpr);
6687    else
6688      res->data= pSubstPoly(p,ringvar,monomexpr);
6689  }
6690  else
6691  {
6692    if (rIsLPRing(currRing))
6693    {
6694      WerrorS("Substituting parameters not implemented for Letterplace rings.");
6695      return TRUE;
6696    }
6697    res->data=pSubstPar(p,-ringvar,monomexpr);
6698  }
6699  return FALSE;
6700}
6701static BOOLEAN jjSUBST_Id(leftv res, leftv u, leftv v,leftv w)
6702{
6703  int ringvar;
6704  poly monomexpr;
6705  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6706  if (nok) return TRUE;
6707  ideal id=(ideal)u->Data();
6708  if (ringvar>0)
6709  {
6710    BOOLEAN overflow=FALSE;
6711    if (!rIsLPRing(currRing) && (monomexpr!=NULL))
6712    {
6713      long deg_monexp=pTotaldegree(monomexpr);
6714      for(int i=IDELEMS(id)-1;i>=0;i--)
6715      {
6716        poly p=id->m[i];
6717        int mm=p_MaxExpPerVar(p,ringvar,currRing);
6718        if ((p!=NULL) && (mm!=0) &&
6719        ((unsigned long)deg_monexp > (currRing->bitmask / (unsigned long)mm/2)))
6720        {
6721          overflow=TRUE;
6722          break;
6723        }
6724      }
6725    }
6726    if (overflow)
6727      Warn("possible OVERFLOW in subst, max exponent is %ld",currRing->bitmask/2);
6728    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6729    {
6730      if (res->rtyp==MATRIX_CMD) id=(ideal)mp_Copy((matrix)id,currRing);
6731      else                       id=id_Copy(id,currRing);
6732      res->data = id_Subst(id, ringvar, monomexpr, currRing);
6733    }
6734    else
6735      res->data = idSubstPoly(id,ringvar,monomexpr);
6736  }
6737  else
6738  {
6739    if (rIsLPRing(currRing))
6740    {
6741      WerrorS("Substituting parameters not implemented for Letterplace rings.");
6742      return TRUE;
6743    }
6744    res->data = idSubstPar(id,-ringvar,monomexpr);
6745  }
6746  return FALSE;
6747}
6748// we do not want to have jjSUBST_Id_X inlined:
6749static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w,
6750                            int input_type);
6751static BOOLEAN jjSUBST_Id_I(leftv res, leftv u, leftv v,leftv w)
6752{
6753  return jjSUBST_Id_X(res,u,v,w,INT_CMD);
6754}
6755static BOOLEAN jjSUBST_Id_N(leftv res, leftv u, leftv v,leftv w)
6756{
6757  return jjSUBST_Id_X(res,u,v,w,NUMBER_CMD);
6758}
6759static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w, int input_type)
6760{
6761  sleftv tmp;
6762  tmp.Init();
6763  // do not check the result, conversion from int/number to poly works always
6764  iiConvert(input_type,POLY_CMD,iiTestConvert(input_type,POLY_CMD),w,&tmp);
6765  BOOLEAN b=jjSUBST_Id(res,u,v,&tmp);
6766  tmp.CleanUp();
6767  return b;
6768}
6769static BOOLEAN jjMATRIX_Id(leftv res, leftv u, leftv v,leftv w)
6770{
6771  int mi=(int)(long)v->Data();
6772  int ni=(int)(long)w->Data();
6773  if ((mi<1)||(ni<1))
6774  {
6775    Werror("converting ideal to matrix: dimensions must be positive(%dx%d)",mi,ni);
6776    return TRUE;
6777  }
6778  matrix m=mpNew(mi,ni);
6779  ideal I=(ideal)u->CopyD(IDEAL_CMD);
6780  int i=si_min(IDELEMS(I),mi*ni);
6781  //for(i=i-1;i>=0;i--)
6782  //{
6783  //  m->m[i]=I->m[i];
6784  //  I->m[i]=NULL;
6785  //}
6786  memcpy(m->m,I->m,i*sizeof(poly));
6787  memset(I->m,0,i*sizeof(poly));
6788  id_Delete(&I,currRing);
6789  res->data = (char *)m;
6790  return FALSE;
6791}
6792static BOOLEAN jjMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6793{
6794  int mi=(int)(long)v->Data();
6795  int ni=(int)(long)w->Data();
6796  if ((mi<0)||(ni<1))
6797  {
6798    Werror("converting module to matrix: dimensions must be positive(%dx%d)",mi,ni);
6799    return TRUE;
6800  }
6801  res->data = (char *)id_Module2formatedMatrix((ideal)u->CopyD(MODUL_CMD),
6802           mi,ni,currRing);
6803  return FALSE;
6804}
6805static BOOLEAN jjMATRIX_Ma(leftv res, leftv u, leftv v,leftv w)
6806{
6807  int mi=(int)(long)v->Data();
6808  int ni=(int)(long)w->Data();
6809  if ((mi<1)||(ni<1))
6810  {
6811     Werror("converting matrix to matrix: dimensions must be positive(%dx%d)",mi,ni);
6812    return TRUE;
6813  }
6814  matrix m=mpNew(mi,ni);
6815  matrix I=(matrix)u->CopyD(MATRIX_CMD);
6816  int r=si_min(MATROWS(I),mi);
6817  int c=si_min(MATCOLS(I),ni);
6818  int i,j;
6819  for(i=r;i>0;i--)
6820  {
6821    for(j=c;j>0;j--)
6822    {
6823      MATELEM(m,i,j)=MATELEM(I,i,j);
6824      MATELEM(I,i,j)=NULL;
6825    }
6826  }
6827  id_Delete((ideal *)&I,currRing);
6828  res->data = (char *)m;
6829  return FALSE;
6830}
6831static BOOLEAN jjMODULO3(leftv res, leftv u, leftv v, leftv w)
6832{
6833  if (w->rtyp!=IDHDL) return TRUE; /* idhdhl required */
6834  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6835  tHomog hom=testHomog;
6836  if (w_u!=NULL)
6837  {
6838    w_u=ivCopy(w_u);
6839    hom=isHomog;
6840  }
6841  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
6842  if (w_v!=NULL)
6843  {
6844    w_v=ivCopy(w_v);
6845    hom=isHomog;
6846  }
6847  if ((w_u!=NULL) && (w_v==NULL))
6848    w_v=ivCopy(w_u);
6849  if ((w_v!=NULL) && (w_u==NULL))
6850    w_u=ivCopy(w_v);
6851  ideal u_id=(ideal)u->Data();
6852  ideal v_id=(ideal)v->Data();
6853  if (w_u!=NULL)
6854  {
6855     if ((*w_u).compare((w_v))!=0)
6856     {
6857       WarnS("incompatible weights");
6858       delete w_u; w_u=NULL;
6859       hom=testHomog;
6860     }
6861     else
6862     {
6863       if ((!idTestHomModule(u_id,currRing->qideal,w_v))
6864       || (!idTestHomModule(v_id,currRing->qideal,w_v)))
6865       {
6866         WarnS("wrong weights");
6867         delete w_u; w_u=NULL;
6868         hom=testHomog;
6869       }
6870     }
6871  }
6872  idhdl h=(idhdl)w->data;
6873  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u, &(h->data.umatrix));
6874  if (w_u!=NULL)
6875  {
6876    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
6877  }
6878  delete w_v;
6879  //if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
6880  return FALSE;
6881}
6882static BOOLEAN jjMODULO3S(leftv res, leftv u, leftv v, leftv w)
6883{
6884  if (w->rtyp!=IDHDL) return TRUE; /* idhdhl required */
6885  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6886  tHomog hom=testHomog;
6887  if (w_u!=NULL)
6888  {
6889    w_u=ivCopy(w_u);
6890    hom=isHomog;
6891  }
6892  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
6893  if (w_v!=NULL)
6894  {
6895    w_v=ivCopy(w_v);
6896    hom=isHomog;
6897  }
6898  if ((w_u!=NULL) && (w_v==NULL))
6899    w_v=ivCopy(w_u);
6900  if ((w_v!=NULL) && (w_u==NULL))
6901    w_u=ivCopy(w_v);
6902  ideal u_id=(ideal)u->Data();
6903  GbVariant alg=syGetAlgorithm((char*)w->Data(),currRing,u_id);
6904  ideal v_id=(ideal)v->Data();
6905  if (w_u!=NULL)
6906  {
6907     if ((*w_u).compare((w_v))!=0)
6908     {
6909       WarnS("incompatible weights");
6910       delete w_u; w_u=NULL;
6911       hom=testHomog;
6912     }
6913     else
6914     {
6915       if ((!idTestHomModule(u_id,currRing->qideal,w_v))
6916       || (!idTestHomModule(v_id,currRing->qideal,w_v)))
6917       {
6918         WarnS("wrong weights");
6919         delete w_u; w_u=NULL;
6920         hom=testHomog;
6921       }
6922     }
6923  }
6924  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u, NULL,alg);
6925  if (w_u!=NULL)
6926  {
6927    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
6928  }
6929  delete w_v;
6930  //if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
6931  return FALSE;
6932}
6933static BOOLEAN jjSMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6934{
6935  int mi=(int)(long)v->Data();
6936  int ni=(int)(long)w->Data();
6937  if ((mi<0)||(ni<1))
6938  {
6939    Werror("converting to smatrix: dimensions must be positive(%dx%d)",mi,ni);
6940    return TRUE;
6941  }
6942  res->data = (char *)id_ResizeModule((ideal)u->CopyD(),
6943           mi,ni,currRing);
6944  return FALSE;
6945}
6946static BOOLEAN jjLIFT3(leftv res, leftv u, leftv v, leftv w)
6947{
6948  if (w->rtyp!=IDHDL) return TRUE;
6949  int ul= IDELEMS((ideal)u->Data());
6950  int vl= IDELEMS((ideal)v->Data());
6951#ifdef HAVE_SHIFTBBA
6952  if (rIsLPRing(currRing))
6953  {
6954    if (currRing->LPncGenCount < ul)
6955    {
6956      Werror("At least %d ncgen variables are needed for this computation.", ul);
6957      return TRUE;
6958    }
6959  }
6960#endif
6961  ideal m
6962    = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
6963             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))));
6964  if (m==NULL) return TRUE;
6965  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
6966  return FALSE;
6967}
6968static BOOLEAN jjLIFTSTD_SYZ(leftv res, leftv u, leftv v, leftv w)
6969{
6970  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
6971  if ((w->rtyp!=IDHDL)||(w->e!=NULL)) return TRUE;
6972  idhdl hv=(idhdl)v->data;
6973  idhdl hw=(idhdl)w->data;
6974#ifdef HAVE_SHIFTBBA
6975  if (rIsLPRing(currRing))
6976  {
6977    if (currRing->LPncGenCount < IDELEMS((ideal)u->Data()))
6978    {
6979      Werror("At least %d ncgen variables are needed for this computation.", IDELEMS((ideal)u->Data()));
6980      return TRUE;
6981    }
6982  }
6983#endif
6984  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
6985  res->data = (char *)idLiftStd((ideal)u->Data(),
6986                                &(hv->data.umatrix),testHomog,
6987                                &(hw->data.uideal));
6988  setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
6989  return FALSE;
6990}
6991static BOOLEAN jjLIFTSTD_ALG(leftv res, leftv u, leftv v, leftv w)
6992{
6993  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
6994  idhdl hv=(idhdl)v->data;
6995  GbVariant alg=syGetAlgorithm((char*)w->Data(),currRing,(ideal)u->Data());
6996#ifdef HAVE_SHIFTBBA
6997  if (rIsLPRing(currRing))
6998  {
6999    if (currRing->LPncGenCount < IDELEMS((ideal)u->Data()))
7000    {
7001      Werror("At least %d ncgen variables are needed for this computation.", IDELEMS((ideal)u->Data()));
7002      return TRUE;
7003    }
7004  }
7005#endif
7006  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
7007  res->data = (char *)idLiftStd((ideal)u->Data(),
7008                                &(hv->data.umatrix),testHomog,
7009                                NULL,alg);
7010  setFlag(res,FLAG_STD); v->flag=0;
7011  return FALSE;
7012}
7013static BOOLEAN jjREDUCE3_CP(leftv res, leftv u, leftv v, leftv w)
7014{
7015  assumeStdFlag(v);
7016  if (!idIsZeroDim((ideal)v->Data()))
7017  {
7018    Werror("`%s` must be 0-dimensional",v->Name());
7019    return TRUE;
7020  }
7021  res->data = (char *)redNF((ideal)v->CopyD(),(poly)u->CopyD(),
7022    (poly)w->CopyD());
7023  return FALSE;
7024}
7025static BOOLEAN jjREDUCE3_CID(leftv res, leftv u, leftv v, leftv w)
7026{
7027  assumeStdFlag(v);
7028  if (!idIsZeroDim((ideal)v->Data()))
7029  {
7030    Werror("`%s` must be 0-dimensional",v->Name());
7031    return TRUE;
7032  }
7033  res->data = (char *)redNF((ideal)v->CopyD(),(ideal)u->CopyD(),
7034    (matrix)w->CopyD());
7035  return FALSE;
7036}
7037static BOOLEAN jjREDUCE3_P(leftv res, leftv u, leftv v, leftv w)
7038{
7039  assumeStdFlag(v);
7040  res->data = (char *)kNF((ideal)v->Data(),currRing->qideal,(poly)u->Data(),
7041    0,(int)(long)w->Data());
7042  return FALSE;
7043}
7044static BOOLEAN jjREDUCE3_ID(leftv res, leftv u, leftv v, leftv w)
7045{
7046  assumeStdFlag(v);
7047  res->data = (char *)kNF((ideal)v->Data(),currRing->qideal,(ideal)u->Data(),
7048    0,(int)(long)w->Data());
7049  return FALSE;
7050}
7051#ifdef OLD_RES
7052static BOOLEAN jjRES3(leftv res, leftv u, leftv v, leftv w)
7053{
7054  int maxl=(int)v->Data();
7055  ideal u_id=(ideal)u->Data();
7056  int l=0;
7057  resolvente r;
7058  intvec **weights=NULL;
7059  int wmaxl=maxl;
7060  maxl--;
7061  unsigned save_opt=si_opt_1;
7062  si_opt_1 |= Sy_bit(OPT_REDTAIL_SYZ);
7063  if ((maxl==-1) && (iiOp!=MRES_CMD))
7064    maxl = currRing->N-1;
7065  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
7066  {
7067    intvec * iv=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
7068    if (iv!=NULL)
7069    {
7070      l=1;
7071      if (!idTestHomModule(u_id,currRing->qideal,iv))
7072      {
7073        WarnS("wrong weights");
7074        iv=NULL;
7075      }
7076      else
7077      {
7078        weights = (intvec**)omAlloc0Bin(char_ptr_bin);
7079        weights[0] = ivCopy(iv);
7080      }
7081    }
7082    r=syResolvente(u_id,maxl,&l, &weights, iiOp==MRES_CMD);
7083  }
7084  else
7085    r=sySchreyerResolvente((ideal)u->Data(),maxl+1,&l);
7086  if (r==NULL) return TRUE;
7087  int t3=u->Typ();
7088  iiMakeResolv(r,l,wmaxl,w->name,t3,weights);
7089  si_opt_1=save_opt;
7090  return FALSE;
7091}
7092#endif
7093static BOOLEAN jjRING3(leftv res, leftv u, leftv v, leftv w)
7094{
7095  res->data=(void *)rInit(u,v,w);
7096  return (res->data==NULL);
7097}
7098static BOOLEAN jjSTATUS3(leftv res, leftv u, leftv v, leftv w)
7099{
7100  int yes;
7101  jjSTATUS2(res, u, v);
7102  yes = (strcmp((char *) res->data, (char *) w->Data()) == 0);
7103  omFreeBinAddr((ADDRESS) res->data);
7104  res->data = (void *)(long)yes;
7105  return FALSE;
7106}
7107static BOOLEAN jjSTD_HILB_W(leftv res, leftv u, leftv v, leftv w)
7108{
7109  intvec *vw=(intvec *)w->Data(); // weights of vars
7110  if (vw->length()!=currRing->N)
7111  {
7112    Werror("%d weights for %d variables",vw->length(),currRing->N);
7113    return TRUE;
7114  }
7115  ideal result;
7116  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
7117  tHomog hom=testHomog;
7118  ideal u_id=(ideal)(u->Data());
7119  if (ww!=NULL)
7120  {
7121    if (!idTestHomModule(u_id,currRing->qideal,ww))
7122    {
7123      WarnS("wrong weights");
7124      ww=NULL;
7125    }
7126    else
7127    {
7128      ww=ivCopy(ww);
7129      hom=isHomog;
7130    }
7131  }
7132  result=kStd(u_id,
7133              currRing->qideal,
7134              hom,
7135              &ww,                  // module weights
7136              (intvec *)v->Data(),  // hilbert series
7137              0,0,                  // syzComp, newIdeal
7138              vw);                  // weights of vars
7139  idSkipZeroes(result);
7140  res->data = (char *)result;
7141  setFlag(res,FLAG_STD);
7142  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
7143  return FALSE;
7144}
7145
7146/*=================== operations with many arg.: static proc =================*/
7147/* must be ordered: first operations for chars (infix ops),
7148 * then alphabetically */
7149static BOOLEAN jjBREAK0(leftv, leftv)
7150{
7151#ifdef HAVE_SDB
7152  sdb_show_bp();
7153#endif
7154  return FALSE;
7155}
7156static BOOLEAN jjBREAK1(leftv, leftv v)
7157{
7158#ifdef HAVE_SDB
7159  if(v->Typ()==PROC_CMD)
7160  {
7161    int lineno=0;
7162    if((v->next!=NULL) && (v->next->Typ()==INT_CMD))
7163    {
7164      lineno=(int)(long)v->next->Data();
7165    }
7166    return sdb_set_breakpoint(v->Name(),lineno);
7167  }
7168  return TRUE;
7169#else
7170 return FALSE;
7171#endif
7172}
7173static BOOLEAN jjCALL1ARG(leftv res, leftv v)
7174{
7175  return iiExprArith1(res,v,iiOp);
7176}
7177static BOOLEAN jjCALL2ARG(leftv res, leftv u)
7178{
7179  leftv v=u->next;
7180  u->next=NULL;
7181  BOOLEAN b=iiExprArith2(res,u,iiOp,v, (iiOp > 255));
7182  u->next=v;
7183  return b;
7184}
7185static BOOLEAN jjCALL3ARG(leftv res, leftv u)
7186{
7187  leftv v = u->next;
7188  leftv w = v->next;
7189  u->next = NULL;
7190  v->next = NULL;
7191  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
7192  u->next = v;
7193  v->next = w;
7194  return b;
7195}
7196
7197static BOOLEAN jjCOEF_M(leftv, leftv v)
7198{
7199  const short t[]={4,VECTOR_CMD,POLY_CMD,MATRIX_CMD,MATRIX_CMD};
7200  if (iiCheckTypes(v,t,1))
7201  {
7202    idhdl c=(idhdl)v->next->next->data;
7203    if (v->next->next->next->rtyp!=IDHDL) return TRUE;
7204    idhdl m=(idhdl)v->next->next->next->data;
7205    idDelete((ideal *)&(c->data.uideal));
7206    idDelete((ideal *)&(m->data.uideal));
7207    mp_Coef2((poly)v->Data(),(poly)v->next->Data(),
7208      (matrix *)&(c->data.umatrix),(matrix *)&(m->data.umatrix),currRing);
7209    return FALSE;
7210  }
7211  return TRUE;
7212}
7213
7214static BOOLEAN jjDIVISION4(leftv res, leftv v)
7215{ // may have 3 or 4 arguments
7216  leftv v1=v;
7217  leftv v2=v1->next;
7218  leftv v3=v2->next;
7219  leftv v4=v3->next;
7220  assumeStdFlag(v2);
7221
7222  int i1=iiTestConvert(v1->Typ(),MODUL_CMD);
7223  int i2=iiTestConvert(v2->Typ(),MODUL_CMD);
7224
7225  if((i1==0)||(i2==0)
7226  ||(v3->Typ()!=INT_CMD)||((v4!=NULL)&&(v4->Typ()!=INTVEC_CMD)))
7227  {
7228    WarnS("<module>,<module>,<int>[,<intvec>] expected!");
7229    return TRUE;
7230  }
7231
7232  sleftv w1,w2;
7233  iiConvert(v1->Typ(),MODUL_CMD,i1,v1,&w1);
7234  iiConvert(v2->Typ(),MODUL_CMD,i2,v2,&w2);
7235  ideal P=(ideal)w1.Data();
7236  ideal Q=(ideal)w2.Data();
7237
7238  int n=(int)(long)v3->Data();
7239  int *w=NULL;
7240  if(v4!=NULL)
7241  {
7242    w = iv2array((intvec *)v4->Data(),currRing);
7243    int * w0 = w + 1;
7244    int i = currRing->N;
7245    while( (i > 0) && ((*w0) > 0) )
7246    {
7247      w0++;
7248      i--;
7249    }
7250    if(i>0)
7251      WarnS("not all weights are positive!");
7252  }
7253
7254  matrix T;
7255  ideal R;
7256  idLiftW(P,Q,n,T,R,w);
7257
7258  w1.CleanUp();
7259  w2.CleanUp();
7260  if(w!=NULL)
7261    omFreeSize( (ADDRESS)w, (rVar(currRing)+1)*sizeof(int) );
7262
7263  lists L=(lists) omAllocBin(slists_bin);
7264  L->Init(2);
7265  L->m[1].rtyp=v1->Typ();
7266  if(v1->Typ()==POLY_CMD||v1->Typ()==VECTOR_CMD)
7267  {
7268    if(v1->Typ()==POLY_CMD)
7269      p_Shift(&R->m[0],-1,currRing);
7270    L->m[1].data=(void *)R->m[0];
7271    R->m[0]=NULL;
7272    idDelete(&R);
7273  }
7274  else if(v1->Typ()==IDEAL_CMD||v1->Typ()==MATRIX_CMD)
7275    L->m[1].data=(void *)id_Module2Matrix(R,currRing);
7276  else
7277  {
7278    L->m[1].rtyp=MODUL_CMD;
7279    L->m[1].data=(void *)R;
7280  }
7281  L->m[0].rtyp=MATRIX_CMD;
7282  L->m[0].data=(char *)T;
7283
7284  res->data=L;
7285
7286  return FALSE;
7287}
7288
7289//BOOLEAN jjDISPATCH(leftv res, leftv v)
7290//{
7291//  WerrorS("`dispatch`: not implemented");
7292//  return TRUE;
7293//}
7294
7295//static BOOLEAN jjEXPORTTO_M(leftv res, leftv u)
7296//{
7297//  int l=u->listLength();
7298//  if (l<2) return TRUE;
7299//  BOOLEAN b;
7300//  leftv v=u->next;
7301//  leftv zz=v;
7302//  leftv z=zz;
7303//  u->next=NULL;
7304//  do
7305//  {
7306//    leftv z=z->next;
7307//    b=iiExprArith2(res,u,iiOp,z, (iiOp > 255));
7308//    if (b) break;
7309//  } while (z!=NULL);
7310//  u->next=zz;
7311//  return b;
7312//}
7313static BOOLEAN jjIDEAL_PL(leftv res, leftv v)
7314{
7315  int s=1;
7316  leftv h=v;
7317  if (h!=NULL) s=exprlist_length(h);
7318  ideal id=idInit(s,1);
7319  int rank=1;
7320  int i=0;
7321  poly p;
7322  int dest_type=POLY_CMD;
7323  if (iiOp==MODUL_CMD) dest_type=VECTOR_CMD;
7324  while (h!=NULL)
7325  {
7326    // use standard type conversions to poly/vector
7327    int ri;
7328    int ht=h->Typ();
7329    if (ht==dest_type)
7330    {
7331      p=(poly)h->CopyD();
7332      if (p!=NULL) rank=si_max(rank,(int)pMaxComp(p));
7333    }
7334    else if ((ri=iiTestConvert(ht,dest_type,dConvertTypes))!=0)
7335    {
7336      sleftv tmp;
7337      leftv hnext=h->next;
7338      h->next=NULL;
7339      iiConvert(ht,dest_type,ri,h,&tmp,dConvertTypes);
7340      h->next=hnext;
7341      p=(poly)tmp.data;
7342      if (p!=NULL) rank=si_max(rank,(int)pMaxComp(p));
7343    }
7344    else
7345    {
7346      idDelete(&id);
7347      return TRUE;
7348    }
7349    id->m[i]=p;
7350    i++;
7351    h=h->next;
7352  }
7353  id->rank=rank;
7354  res->data=(char *)id;
7355  return FALSE;
7356}
7357static BOOLEAN jjFETCH_M(leftv res, leftv u)
7358{
7359  ring r=(ring)u->Data();
7360  leftv v=u->next;
7361  leftv perm_var_l=v->next;
7362  leftv perm_par_l=v->next->next;
7363  if ((perm_var_l->Typ()!=INTVEC_CMD)
7364  ||((perm_par_l!=NULL)&&(perm_par_l->Typ()!=INTVEC_CMD))
7365  ||(u->Typ()!=RING_CMD))
7366  {
7367    WerrorS("fetch(<ring>,<name>[,<intvec>[,<intvec>])");
7368    return TRUE;
7369  }
7370  intvec *perm_var_v=(intvec*)perm_var_l->Data();
7371  intvec *perm_par_v=NULL;
7372  if (perm_par_l!=NULL)
7373    perm_par_v=(intvec*)perm_par_l->Data();
7374  idhdl w;
7375  nMapFunc nMap;
7376
7377  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
7378  {
7379    int *perm=NULL;
7380    int *par_perm=NULL;
7381    int par_perm_size=0;
7382    BOOLEAN bo;
7383    if ((nMap=n_SetMap(r->cf,currRing->cf))==NULL)
7384    {
7385      // Allow imap/fetch to be make an exception only for:
7386      if (nCoeff_is_Extension(r->cf) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
7387         ((n_SetMap(r->cf->extRing->cf,currRing->cf)!=NULL)
7388         || (nCoeff_is_Extension(currRing->cf) && (n_SetMap(r->cf->extRing->cf,currRing->cf->extRing->cf)!=NULL))))
7389      {
7390        par_perm_size=rPar(r);
7391      }
7392      else
7393      {
7394        goto err_fetch;
7395      }
7396    }
7397    else
7398      par_perm_size=rPar(r);
7399    perm=(int *)omAlloc0((rVar(r)+1)*sizeof(int));
7400    if (par_perm_size!=0)
7401      par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
7402    int i;
7403    if (perm_par_l==NULL)
7404    {
7405      if (par_perm_size!=0)
7406        for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
7407    }
7408    else
7409    {
7410      if (par_perm_size==0) WarnS("source ring has no parameters");
7411      else
7412      {
7413        for(i=rPar(r)-1;i>=0;i--)
7414        {
7415          if (i<perm_par_v->length()) par_perm[i]=(*perm_par_v)[i];
7416          if ((par_perm[i]<-rPar(currRing))
7417          || (par_perm[i]>rVar(currRing)))
7418          {
7419            Warn("invalid entry for par %d: %d\n",i,par_perm[i]);
7420            par_perm[i]=0;
7421          }
7422        }
7423      }
7424    }
7425    for(i=rVar(r)-1;i>=0;i--)
7426    {
7427      if (i<perm_var_v->length()) perm[i+1]=(*perm_var_v)[i];
7428      if ((perm[i]<-rPar(currRing))
7429      || (perm[i]>rVar(currRing)))
7430      {
7431        Warn("invalid entry for var %d: %d\n",i,perm[i]);
7432        perm[i]=0;
7433      }
7434    }
7435    if (BVERBOSE(V_IMAP))
7436    {
7437      for(i=1;i<=si_min(rVar(r),rVar(currRing));i++)
7438      {
7439        if (perm[i]>0)
7440          Print("// var nr %d: %s -> var %s\n",i,r->names[i-1],currRing->names[perm[i]-1]);
7441        else if (perm[i]<0)
7442          Print("// var nr %d: %s -> par %s\n",i,r->names[i-1],rParameter(currRing)[-perm[i]-1]);
7443      }
7444      for(i=1;i<=si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
7445      {
7446        if (par_perm[i-1]<0)
7447          Print("// par nr %d: %s -> par %s\n",
7448              i,rParameter(r)[i-1],rParameter(currRing)[-par_perm[i-1]-1]);
7449        else if (par_perm[i-1]>0)
7450          Print("// par nr %d: %s -> var %s\n",
7451              i,rParameter(r)[i-1],currRing->names[par_perm[i-1]-1]);
7452      }
7453    }
7454    if (IDTYP(w)==ALIAS_CMD) w=(idhdl)IDDATA(w);
7455    sleftv tmpW;
7456    tmpW.Init();
7457    tmpW.rtyp=IDTYP(w);
7458    tmpW.data=IDDATA(w);
7459    if ((bo=maApplyFetch(IMAP_CMD,NULL,res,&tmpW, r,
7460                         perm,par_perm,par_perm_size,nMap)))
7461    {
7462      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
7463    }
7464    if (perm!=NULL)
7465      omFreeSize((ADDRESS)perm,(rVar(r)+1)*sizeof(int));
7466    if (par_perm!=NULL)
7467      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
7468    return bo;
7469  }
7470  else
7471  {
7472    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
7473  }
7474  return TRUE;
7475err_fetch:
7476  char *s1=nCoeffString(r->cf);
7477  char *s2=nCoeffString(currRing->cf);
7478  Werror("no identity map from %s (%s -> %s)",u->Fullname(),s1,s2);
7479  omFreeBinAddr(s2);omFreeBinAddr(s1);
7480  return TRUE;
7481}
7482static BOOLEAN jjINTERSECT_PL(leftv res, leftv v)
7483{
7484  leftv h=v;
7485  int l=v->listLength();
7486  resolvente r=(resolvente)omAlloc0(l*sizeof(ideal));
7487  BOOLEAN *copied=(BOOLEAN *)omAlloc0(l*sizeof(BOOLEAN));
7488  int t=0;
7489  // try to convert to IDEAL_CMD
7490  while (h!=NULL)
7491  {
7492    if (iiTestConvert(h->Typ(),IDEAL_CMD)!=0)
7493    {
7494      t=IDEAL_CMD;
7495    }
7496    else break;
7497    h=h->next;
7498  }
7499  // if failure, try MODUL_CMD
7500  if (t==0)
7501  {
7502    h=v;
7503    while (h!=NULL)
7504    {
7505      if (iiTestConvert(h->Typ(),MODUL_CMD)!=0)
7506      {
7507        t=MODUL_CMD;
7508      }
7509      else break;
7510      h=h->next;
7511    }
7512  }
7513  // check for success  in converting
7514  if (t==0)
7515  {
7516    WerrorS("cannot convert to ideal or module");
7517    return TRUE;
7518  }
7519  // call idMultSect
7520  h=v;
7521  int i=0;
7522  sleftv tmp;
7523  while (h!=NULL)
7524  {
7525    if (h->Typ()==t)
7526    {
7527      r[i]=(ideal)h->Data(); /*no copy*/
7528      h=h->next;
7529    }
7530    else if(iiConvert(h->Typ(),t,iiTestConvert(h->Typ(),t),h,&tmp))
7531    {
7532      omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
7533      omFreeSize((ADDRESS)r,l*sizeof(ideal));
7534      Werror("cannot convert arg. %d to %s",i+1,Tok2Cmdname(t));
7535      return TRUE;
7536    }
7537    else
7538    {
7539      r[i]=(ideal)tmp.Data(); /*now it's a copy*/
7540      copied[i]=TRUE;
7541      h=tmp.next;
7542    }
7543    i++;
7544  }
7545  res->rtyp=t;
7546  res->data=(char *)idMultSect(r,i);
7547  while(i>0)
7548  {
7549    i--;
7550    if (copied[i]) idDelete(&(r[i]));
7551  }
7552  omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
7553  omFreeSize((ADDRESS)r,l*sizeof(ideal));
7554  return FALSE;
7555}
7556static BOOLEAN jjLU_INVERSE(leftv res, leftv v)
7557{
7558  /* computation of the inverse of a quadratic matrix A
7559     using the L-U-decomposition of A;
7560     There are two valid parametrisations:
7561     1) exactly one argument which is just the matrix A,
7562     2) exactly three arguments P, L, U which already
7563        realise the L-U-decomposition of A, that is,
7564        P * A = L * U, and P, L, and U satisfy the
7565        properties decribed in method 'jjLU_DECOMP';
7566        see there;
7567     If A is invertible, the list [1, A^(-1)] is returned,
7568     otherwise the list [0] is returned. Thus, the user may
7569     inspect the first entry of the returned list to see
7570     whether A is invertible. */
7571  matrix iMat; int invertible;
7572  const short t1[]={1,MATRIX_CMD};
7573  const short t2[]={3,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD};
7574  if (iiCheckTypes(v,t1))
7575  {
7576    matrix aMat = (matrix)v->Data();
7577    int rr = aMat->rows();
7578    int cc = aMat->cols();
7579    if (rr != cc)
7580    {
7581      Werror("given matrix (%d x %d) is not quadratic, hence not invertible", rr, cc);
7582      return TRUE;
7583    }
7584    if (!idIsConstant((ideal)aMat))
7585    {
7586      WerrorS("matrix must be constant");
7587      return TRUE;
7588    }
7589    invertible = luInverse(aMat, iMat);
7590  }
7591  else if (iiCheckTypes(v,t2))
7592  {
7593     matrix pMat = (matrix)v->Data();
7594     matrix lMat = (matrix)v->next->Data();
7595     matrix uMat = (matrix)v->next->next->Data();
7596     int rr = uMat->rows();
7597     int cc = uMat->cols();
7598     if (rr != cc)
7599     {
7600       Werror("third matrix (%d x %d) is not quadratic, hence not invertible",
7601              rr, cc);
7602       return TRUE;
7603     }
7604      if (!idIsConstant((ideal)pMat)
7605      || (!idIsConstant((ideal)lMat))
7606      || (!idIsConstant((ideal)uMat))
7607      )
7608      {
7609        WerrorS("matricesx must be constant");
7610        return TRUE;
7611      }
7612     invertible = luInverseFromLUDecomp(pMat, lMat, uMat, iMat);
7613  }
7614  else
7615  {
7616    Werror("expected either one or three matrices");
7617    return TRUE;
7618  }
7619
7620  /* build the return structure; a list with either one or two entries */
7621  lists ll = (lists)omAllocBin(slists_bin);
7622  if (invertible)
7623  {
7624    ll->Init(2);
7625    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)invertible;
7626    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)iMat;
7627  }
7628  else
7629  {
7630    ll->Init(1);
7631    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)invertible;
7632  }
7633
7634  res->data=(char*)ll;
7635  return FALSE;
7636}
7637static BOOLEAN jjLU_SOLVE(leftv res, leftv v)
7638{
7639  /* for solving a linear equation system A * x = b, via the
7640     given LU-decomposition of the matrix A;
7641     There is one valid parametrisation:
7642     1) exactly four arguments P, L, U, b;
7643        P, L, and U realise the L-U-decomposition of A, that is,
7644        P * A = L * U, and P, L, and U satisfy the
7645        properties decribed in method 'jjLU_DECOMP';
7646        see there;
7647        b is the right-hand side vector of the equation system;
7648     The method will return a list of either 1 entry or three entries:
7649     1) [0] if there is no solution to the system;
7650     2) [1, x, H] if there is at least one solution;
7651        x is any solution of the given linear system,
7652        H is the matrix with column vectors spanning the homogeneous
7653        solution space.
7654     The method produces an error if matrix and vector sizes do not fit. */
7655  const short t[]={4,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD,MATRIX_CMD};
7656  if (!iiCheckTypes(v,t))
7657  {
7658    WerrorS("expected exactly three matrices and one vector as input");
7659    return TRUE;
7660  }
7661  matrix pMat = (matrix)v->Data();
7662  matrix lMat = (matrix)v->next->Data();
7663  matrix uMat = (matrix)v->next->next->Data();
7664  matrix bVec = (matrix)v->next->next->next->Data();
7665  matrix xVec; int solvable; matrix homogSolSpace;
7666  if (pMat->rows() != pMat->cols())
7667  {
7668    Werror("first matrix (%d x %d) is not quadratic",
7669           pMat->rows(), pMat->cols());
7670    return TRUE;
7671  }
7672  if (lMat->rows() != lMat->cols())
7673  {
7674    Werror("second matrix (%d x %d) is not quadratic",
7675           lMat->rows(), lMat->cols());
7676    return TRUE;
7677  }
7678  if (lMat->rows() != uMat->rows())
7679  {
7680    Werror("second matrix (%d x %d) and third matrix (%d x %d) do not fit",
7681           lMat->rows(), lMat->cols(), uMat->rows(), uMat->cols());
7682    return TRUE;
7683  }
7684  if (uMat->rows() != bVec->rows())
7685  {
7686    Werror("third matrix (%d x %d) and vector (%d x 1) do not fit",
7687           uMat->rows(), uMat->cols(), bVec->rows());
7688    return TRUE;
7689  }
7690  if (!idIsConstant((ideal)pMat)
7691  ||(!idIsConstant((ideal)lMat))
7692  ||(!idIsConstant((ideal)uMat))
7693  )
7694  {
7695    WerrorS("matrices must be constant");
7696    return TRUE;
7697  }
7698  solvable = luSolveViaLUDecomp(pMat, lMat, uMat, bVec, xVec, homogSolSpace);
7699
7700  /* build the return structure; a list with either one or three entries */
7701  lists ll = (lists)omAllocBin(slists_bin);
7702  if (solvable)
7703  {
7704    ll->Init(3);
7705    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
7706    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
7707    ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
7708  }
7709  else
7710  {
7711    ll->Init(1);
7712    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)(long)solvable;
7713  }
7714
7715  res->data=(char*)ll;
7716  return FALSE;
7717}
7718static BOOLEAN jjINTVEC_PL(leftv res, leftv v)
7719{
7720  int i=0;
7721  leftv h=v;
7722  if (h!=NULL) i=exprlist_length(h);
7723  intvec *iv=new intvec(i);
7724  i=0;
7725  while (h!=NULL)
7726  {
7727    if(h->Typ()==INT_CMD)
7728    {
7729      (*iv)[i]=(int)(long)h->Data();
7730    }
7731    else if (h->Typ()==INTVEC_CMD)
7732    {
7733      intvec *ivv=(intvec*)h->Data();
7734      for(int j=0;j<ivv->length();j++,i++)
7735      {
7736        (*iv)[i]=(*ivv)[j];
7737      }
7738      i--;
7739    }
7740    else
7741    {
7742      delete iv;
7743      return TRUE;
7744    }
7745    i++;
7746    h=h->next;
7747  }
7748  res->data=(char *)iv;
7749  return FALSE;
7750}
7751static BOOLEAN jjJET4(leftv res, leftv u)
7752{
7753  const short t1[]={4,POLY_CMD,POLY_CMD,POLY_CMD,INTVEC_CMD};
7754  const short t2[]={4,VECTOR_CMD,POLY_CMD,POLY_CMD,INTVEC_CMD};
7755  const short t3[]={4,IDEAL_CMD,MATRIX_CMD,INT_CMD,INTVEC_CMD};
7756  const short t4[]={4,MODUL_CMD,MATRIX_CMD,INT_CMD,INTVEC_CMD};
7757  leftv u1=u;
7758  leftv u2=u1->next;
7759  leftv u3=u2->next;
7760  leftv u4=u3->next;
7761  if (iiCheckTypes(u,t1)||iiCheckTypes(u,t2))
7762  {
7763    if(!pIsUnit((poly)u2->Data()))
7764    {
7765      WerrorS("2nd argument must be a unit");
7766      return TRUE;
7767    }
7768    res->rtyp=u1->Typ();
7769    res->data=(char*)pSeries((int)(long)u3->Data(),pCopy((poly)u1->Data()),
7770                             pCopy((poly)u2->Data()),(intvec*)u4->Data());
7771    return FALSE;
7772  }
7773  else
7774  if (iiCheckTypes(u,t3)||iiCheckTypes(u,t4))
7775  {
7776    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7777    {
7778      WerrorS("2nd argument must be a diagonal matrix of units");
7779      return TRUE;
7780    }
7781    res->rtyp=u1->Typ();
7782    res->data=(char*)idSeries(
7783                              (int)(long)u3->Data(),
7784                              idCopy((ideal)u1->Data()),
7785                              mp_Copy((matrix)u2->Data(), currRing),
7786                              (intvec*)u4->Data()
7787                             );
7788    return FALSE;
7789  }
7790  else
7791  {
7792    Werror("%s(`poly`,`poly`,`int`,`intvec`) exppected",
7793           Tok2Cmdname(iiOp));
7794    return TRUE;
7795  }
7796}
7797#if 0
7798static BOOLEAN jjBRACKET_PL(leftv res, leftv u)
7799{
7800  int ut=u->Typ();
7801  leftv v=u->next; u->next=NULL;
7802  leftv w=v->next; v->next=NULL;
7803  if ((ut!=CRING_CMD)&&(ut!=RING_CMD))
7804  {
7805    BOOLEAN bo=TRUE;
7806    if (w==NULL)
7807    {
7808      bo=iiExprArith2(res,u,'[',v);
7809    }
7810    else if (w->next==NULL)
7811    {
7812      bo=iiExprArith3(res,'[',u,v,w);
7813    }
7814    v->next=w;
7815    u->next=v;
7816    return bo;
7817  }
7818  v->next=w;
7819  u->next=v;
7820  #ifdef SINGULAR_4_1
7821  // construct new rings:
7822  while (u!=NULL)
7823  {
7824    Print("name: %s,\n",u->Name());
7825    u=u->next;
7826  }
7827  #else
7828  res->Init();
7829  res->rtyp=NONE;
7830  return TRUE;
7831  #endif
7832}
7833#endif
7834static BOOLEAN jjKLAMMER_PL(leftv res, leftv u)
7835{
7836  if ((yyInRingConstruction)
7837  && ((strcmp(u->Name(),"real")==0) || (strcmp(u->Name(),"complex")==0)))
7838  {
7839    memcpy(res,u,sizeof(sleftv));
7840    u->Init();
7841    return FALSE;
7842  }
7843  leftv v=u->next;
7844  BOOLEAN b;
7845  if(v==NULL)  // p()
7846    b=iiExprArith1(res,u,iiOp);
7847  else if ((v->next==NULL) // p(1)
7848  || (u->Typ()!=UNKNOWN))  // p(1,2), p proc or map
7849  {
7850    u->next=NULL;
7851    b=iiExprArith2(res,u,iiOp,v);
7852    u->next=v;
7853  }
7854  else // p(1,2), p undefined
7855  {
7856    if (v->Typ()!=INT_CMD)
7857    {
7858      Werror("`%s` undefined or  `int` expected while building `%s(`",u->name,u->name);
7859      return TRUE;
7860    }
7861    int l=u->listLength();
7862    char * nn = (char *)omAlloc(strlen(u->name) + 12*l);
7863    sprintf(nn,"%s(%d",u->name,(int)(long)v->Data());
7864    char *s=nn;
7865    do
7866    {
7867      while (*s!='\0') s++;
7868      v=v->next;
7869      if (v->Typ()!=INT_CMD)
7870      {
7871        Werror("`%s` undefined or  `int` expected while building `%s(`",u->name,u->name);
7872        omFree((ADDRESS)nn);
7873        return TRUE;
7874      }
7875      sprintf(s,",%d",(int)(long)v->Data());
7876    } while (v->next!=NULL);
7877    while (*s!='\0') s++;
7878    nn=strcat(nn,")");
7879    char *n=omStrDup(nn);
7880    omFree((ADDRESS)nn);
7881    syMake(res,n);
7882    b=FALSE;
7883  }
7884  return b;
7885}
7886static BOOLEAN jjLIFT_4(leftv res, leftv U)
7887{
7888  const short t1[]={4,IDEAL_CMD,IDEAL_CMD,MATRIX_CMD,STRING_CMD};
7889  const short t2[]={4,MODUL_CMD,MODUL_CMD,MATRIX_CMD,STRING_CMD};
7890  leftv u=U;
7891  leftv v=u->next;
7892  leftv w=v->next;
7893  leftv u4=w->next;
7894  if (w->rtyp!=IDHDL) return TRUE;
7895  if (iiCheckTypes(U,t1)||iiCheckTypes(U,t2))
7896  {
7897    // see jjLIFT3
7898    ideal I=(ideal)u->Data();
7899    int ul= IDELEMS(I /*(ideal)u->Data()*/);
7900    int vl= IDELEMS((ideal)v->Data());
7901    GbVariant alg=syGetAlgorithm((char*)u4->Data(),currRing,I);
7902    ideal m
7903    = idLift(I,(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
7904             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))),alg);
7905    if (m==NULL) return TRUE;
7906    res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
7907    return FALSE;
7908  }
7909  else
7910  {
7911    Werror("%s(`ideal`,`ideal`,`matrix`,`string`)\n"
7912           "or (`module`,`module`,`matrix`,`string`) expected",
7913           Tok2Cmdname(iiOp));
7914    return TRUE;
7915  }
7916}
7917static BOOLEAN jjLIFTSTD_M(leftv res, leftv U)
7918{
7919  // we have 4 or 5 arguments
7920  leftv u=U;
7921  leftv v=u->next;
7922  leftv u3=v->next;
7923  leftv u4=u3->next;
7924  leftv u5=u4->next; // might be NULL
7925
7926  ideal *syz=NULL;
7927  GbVariant alg=GbDefault;
7928  ideal h11=NULL;
7929
7930  if(u5==NULL)
7931  {
7932    // test all three possibilities for 4 arguments
7933    const short t1[]={4,IDEAL_CMD,MATRIX_CMD,MODUL_CMD,STRING_CMD};
7934    const short t2[]={4,MODUL_CMD,MATRIX_CMD,MODUL_CMD,STRING_CMD};
7935    const short t3[]={4,IDEAL_CMD,MATRIX_CMD,MODUL_CMD,IDEAL_CMD};
7936    const short t4[]={4,MODUL_CMD,MATRIX_CMD,MODUL_CMD,MODUL_CMD};
7937    const short t5[]={4,IDEAL_CMD,MATRIX_CMD,STRING_CMD,IDEAL_CMD};
7938    const short t6[]={4,MODUL_CMD,MATRIX_CMD,STRING_CMD,MODUL_CMD};
7939
7940    if(iiCheckTypes(U,t1)||iiCheckTypes(U,t2))
7941    {
7942      if ((u3->rtyp!=IDHDL)||(u3->e!=NULL)) return TRUE;
7943      idhdl hw=(idhdl)u3->data;
7944      syz=&(hw->data.uideal);
7945      alg=syGetAlgorithm((char*)u4->Data(),currRing,(ideal)u->Data());
7946    }
7947    else if(iiCheckTypes(U,t3)||iiCheckTypes(U,t4))
7948    {
7949      if ((u3->rtyp!=IDHDL)||(u3->e!=NULL)) return TRUE;
7950      idhdl hw=(idhdl)u3->data;
7951      syz=&(hw->data.uideal);
7952      h11=(ideal)u4->Data();
7953    }
7954    else if(iiCheckTypes(U,t5)||iiCheckTypes(U,t6))
7955    {
7956      alg=syGetAlgorithm((char*)u3->Data(),currRing,(ideal)u->Data());
7957      h11=(ideal)u4->Data();
7958    }
7959    else
7960    {
7961      Werror("%s(`ideal/module`,`matrix`[,`module`][,`string`][,`ideal/module`]) expected",Tok2Cmdname(iiOp));
7962      return TRUE;
7963    }
7964  }
7965  else
7966  {
7967    // we have 5 arguments
7968    const short t1[]={5,IDEAL_CMD,MATRIX_CMD,MODUL_CMD,STRING_CMD,IDEAL_CMD};
7969    const short t2[]={5,MODUL_CMD,MATRIX_CMD,MODUL_CMD,STRING_CMD,MODUL_CMD};
7970    if(iiCheckTypes(U,t1)||iiCheckTypes(U,t2))
7971    {
7972      idhdl hw=(idhdl)u3->data;
7973      syz=&(hw->data.uideal);
7974      alg=syGetAlgorithm((char*)u4->Data(),currRing,(ideal)u->Data());
7975      h11=(ideal)u5->Data();
7976    }
7977    else
7978    {
7979      Werror("%s(`ideal/module`,`matrix`[,`module`][,`string`][,`ideal/module`]) expected",Tok2Cmdname(iiOp));
7980      return TRUE;
7981    }
7982  }
7983
7984#ifdef HAVE_SHIFTBBA
7985  if (rIsLPRing(currRing))
7986  {
7987    if (currRing->LPncGenCount < IDELEMS((ideal)u->Data()))
7988    {
7989      Werror("At least %d ncgen variables are needed for this computation.", IDELEMS((ideal)u->Data()));
7990      return TRUE;
7991    }
7992  }
7993#endif
7994
7995  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
7996  idhdl hv=(idhdl)v->data;
7997  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
7998  res->rtyp = u->Typ();
7999  res->data = (char *)idLiftStd((ideal)u->Data(),
8000                              &(hv->data.umatrix),testHomog,
8001                              syz,alg,h11);
8002  setFlag(res,FLAG_STD); v->flag=0;
8003  if(syz!=NULL)
8004    u3->flag=0;
8005  return FALSE;
8006}
8007BOOLEAN jjLIST_PL(leftv res, leftv v)
8008{
8009  int sl=0;
8010  if (v!=NULL) sl = v->listLength();
8011  lists L;
8012  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
8013  {
8014    int add_row_shift = 0;
8015    intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
8016    if (weights!=NULL)  add_row_shift=weights->min_in();
8017    L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
8018  }
8019  else
8020  {
8021    L=(lists)omAllocBin(slists_bin);
8022    leftv h=NULL;
8023    int i;
8024    int rt;
8025
8026    L->Init(sl);
8027    for (i=0;i<sl;i++)
8028    {
8029      if (h!=NULL)
8030      { /* e.g. not in the first step:
8031         * h is the pointer to the old sleftv,
8032         * v is the pointer to the next sleftv
8033         * (in this moment) */
8034         h->next=v;
8035      }
8036      h=v;
8037      v=v->next;
8038      h->next=NULL;
8039      rt=h->Typ();
8040      if (rt==0)
8041      {
8042        L->Clean();
8043        Werror("`%s` is undefined",h->Fullname());
8044        return TRUE;
8045      }
8046      if (rt==RING_CMD)
8047      {
8048        L->m[i].rtyp=rt;
8049        L->m[i].data=rIncRefCnt(((ring)h->Data()));
8050      }
8051      else
8052        L->m[i].Copy(h);
8053    }
8054  }
8055  res->data=(char *)L;
8056  return FALSE;
8057}
8058static BOOLEAN jjMODULO4(leftv res, leftv u)
8059{
8060  leftv v=u->next;
8061  leftv w=v->next;
8062  leftv u4=w->next;
8063  GbVariant alg;
8064  ideal u_id,v_id;
8065  // we have 4 arguments
8066  const short t1[]={4,IDEAL_CMD,IDEAL_CMD,MATRIX_CMD,STRING_CMD};
8067  const short t2[]={4,MODUL_CMD,MODUL_CMD,MATRIX_CMD,STRING_CMD};
8068  if(iiCheckTypes(u,t1)||iiCheckTypes(u,t2)||(w->rtyp!=IDHDL))
8069  {
8070    u_id=(ideal)u->Data();
8071    v_id=(ideal)v->Data();
8072    alg=syGetAlgorithm((char*)u4->Data(),currRing,u_id);
8073  }
8074  else
8075  {
8076    Werror("%s(`ideal/module`,`ideal/module`[,`matrix`][,`string`]) expected",Tok2Cmdname(iiOp));
8077    return TRUE;
8078  }
8079  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
8080  tHomog hom=testHomog;
8081  if (w_u!=NULL)
8082  {
8083    w_u=ivCopy(w_u);
8084    hom=isHomog;
8085  }
8086  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
8087  if (w_v!=NULL)
8088  {
8089    w_v=ivCopy(w_v);
8090    hom=isHomog;
8091  }
8092  if ((w_u!=NULL) && (w_v==NULL))
8093    w_v=ivCopy(w_u);
8094  if ((w_v!=NULL) && (w_u==NULL))
8095    w_u=ivCopy(w_v);
8096  if (w_u!=NULL)
8097  {
8098     if ((*w_u).compare((w_v))!=0)
8099     {
8100       WarnS("incompatible weights");
8101       delete w_u; w_u=NULL;
8102       hom=testHomog;
8103     }
8104     else
8105     {
8106       if ((!idTestHomModule(u_id,currRing->qideal,w_v))
8107       || (!idTestHomModule(v_id,currRing->qideal,w_v)))
8108       {
8109         WarnS("wrong weights");
8110         delete w_u; w_u=NULL;
8111         hom=testHomog;
8112       }
8113     }
8114  }
8115  idhdl h=(idhdl)w->data;
8116  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u, &(h->data.umatrix),alg);
8117  if (w_u!=NULL)
8118  {
8119    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
8120  }
8121  delete w_v;
8122  //if (TEST_OPT_RETURN_SB) setFlag(res,FLAG_STD);
8123  return FALSE;
8124}
8125static BOOLEAN jjNAMES0(leftv res, leftv)
8126{
8127  res->data=(void *)ipNameList(IDROOT);
8128  return FALSE;
8129}
8130static BOOLEAN jjOPTION_PL(leftv res, leftv v)
8131{
8132  if(v==NULL)
8133  {
8134    res->data=(char *)showOption();
8135    return FALSE;
8136  }
8137  res->rtyp=NONE;
8138  return setOption(res,v);
8139}
8140static BOOLEAN jjREDUCE4(leftv res, leftv u)
8141{
8142  leftv u1=u;
8143  leftv u2=u1->next;
8144  leftv u3=u2->next;
8145  leftv u4=u3->next;
8146  int u1t=u1->Typ(); if (u1t==BUCKET_CMD) u1t=POLY_CMD;
8147  int u2t=u2->Typ(); if (u2t==BUCKET_CMD) u2t=POLY_CMD;
8148  if((u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD))
8149  {
8150    int save_d=Kstd1_deg;
8151    Kstd1_deg=(int)(long)u3->Data();
8152    kModW=(intvec *)u4->Data();
8153    BITSET save2;
8154    SI_SAVE_OPT2(save2);
8155    si_opt_2|=Sy_bit(V_DEG_STOP);
8156    u2->next=NULL;
8157    BOOLEAN r=jjCALL2ARG(res,u);
8158    kModW=NULL;
8159    Kstd1_deg=save_d;
8160    SI_RESTORE_OPT2(save2);
8161    u->next->next=u3;
8162    return r;
8163  }
8164  else
8165  if((u1t==IDEAL_CMD)&&(u2t==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
8166     (u4->Typ()==INT_CMD))
8167  {
8168    assumeStdFlag(u3);
8169    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
8170    {
8171      WerrorS("2nd argument must be a diagonal matrix of units");
8172      return TRUE;
8173    }
8174    res->data=(char*)redNF(
8175                           idCopy((ideal)u3->Data()),
8176                           idCopy((ideal)u1->Data()),
8177                           mp_Copy((matrix)u2->Data(), currRing),
8178                           (int)(long)u4->Data()
8179                          );
8180    return FALSE;
8181  }
8182  else
8183  if((u1t==POLY_CMD)&&(u2t==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
8184     (u4->Typ()==INT_CMD))
8185  {
8186    poly u1p;
8187    if (u1->Typ()==BUCKET_CMD) u1p=sBucketPeek((sBucket_pt)u1->Data());
8188    else                     u1p=(poly)u1->Data();
8189    poly u2p;
8190    if (u2->Typ()==BUCKET_CMD) u2p=sBucketPeek((sBucket_pt)u2->Data());
8191    else                     u2p=(poly)u2->Data();
8192    assumeStdFlag(u3);
8193    if(!pIsUnit(u2p))
8194    {
8195      WerrorS("2nd argument must be a unit");
8196      return TRUE;
8197    }
8198    res->rtyp=POLY_CMD;
8199    res->data=(char*)redNF((ideal)u3->CopyD(),pCopy(u1p),
8200                           pCopy(u2p),(int)(long)u4->Data());
8201    return FALSE;
8202  }
8203  else
8204  {
8205    Werror("%s(`poly`,`ideal`,`int`,`intvec`) expected",Tok2Cmdname(iiOp));
8206    Werror("%s(`ideal`,`matrix`,`ideal`,`int`) expected",Tok2Cmdname(iiOp));
8207    Werror("%s(`poly`,`poly`,`ideal`,`int`) expected",Tok2Cmdname(iiOp));
8208    return TRUE;
8209  }
8210}
8211static BOOLEAN jjREDUCE5(leftv res, leftv u)
8212{
8213  leftv u1=u;
8214  leftv u2=u1->next;
8215  leftv u3=u2->next;
8216  leftv u4=u3->next;
8217  leftv u5=u4->next;
8218  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
8219     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
8220  {
8221    assumeStdFlag(u3);
8222    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
8223    {
8224      WerrorS("2nd argument must be a diagonal matrix of units");
8225      return TRUE;
8226    }
8227    res->data=(char*)redNF(
8228                           idCopy((ideal)u3->Data()),
8229                           idCopy((ideal)u1->Data()),
8230                           mp_Copy((matrix)u2->Data(),currRing),
8231                           (int)(long)u4->Data(),
8232                           (intvec*)u5->Data()
8233                          );
8234    return FALSE;
8235  }
8236  else
8237  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
8238     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
8239  {
8240    assumeStdFlag(u3);
8241    if(!pIsUnit((poly)u2->Data()))
8242    {
8243      WerrorS("2nd argument must be a unit");
8244      return TRUE;
8245    }
8246    res->rtyp=POLY_CMD;
8247    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
8248                           pCopy((poly)u2->Data()),
8249                           (int)(long)u4->Data(),(intvec*)u5->Data());
8250    return FALSE;
8251  }
8252  else
8253  {
8254    Werror("%s(`ideal`,`ideal`,`matrix`,`int`,`intvec`) exppected",
8255           Tok2Cmdname(iiOp));
8256    return TRUE;
8257  }
8258}
8259static BOOLEAN jjRESERVED0(leftv, leftv)
8260{
8261  unsigned i=1;
8262  unsigned nCount = (sArithBase.nCmdUsed-1)/3;
8263  if((3*nCount)<sArithBase.nCmdUsed) nCount++;
8264  //Print("CMDS: %d/%d\n", sArithBase.nCmdUsed,
8265  //      sArithBase.nCmdAllocated);
8266  for(i=0; i<nCount; i++)
8267  {
8268    Print("%-20s",sArithBase.sCmds[i+1].name);
8269    if(i+1+nCount<sArithBase.nCmdUsed)
8270      Print("%-20s",sArithBase.sCmds[i+1+nCount].name);
8271    if(i+1+2*nCount<sArithBase.nCmdUsed)
8272      Print("%-20s",sArithBase.sCmds[i+1+2*nCount].name);
8273    //if ((i%3)==1) PrintLn();
8274    PrintLn();
8275  }
8276  PrintLn();
8277  printBlackboxTypes();
8278  return FALSE;
8279}
8280
8281static BOOLEAN jjRESERVEDLIST0(leftv res, leftv)
8282{
8283  int i=1;
8284  int l = 0;
8285  int k = 0;
8286  lists L = (lists)omAllocBin(slists_bin);
8287  struct blackbox_list *bb_list = NULL;
8288  unsigned nCount = (sArithBase.nCmdUsed-1) / 3;
8289
8290  if ((3*nCount) < sArithBase.nCmdUsed)
8291  {
8292    nCount++;
8293  }
8294  bb_list = getBlackboxTypes();
8295  // count the  number of entries;
8296  for (i=0; i<nCount; i++)
8297  {
8298    l++;
8299    if (i + 1 + nCount < sArithBase.nCmdUsed)
8300    {
8301      l++;
8302    }
8303    if(i+1+2*nCount<sArithBase.nCmdUsed)
8304    {
8305      l++;
8306    }
8307  }
8308  for (i = 0; i < bb_list->count; i++)
8309  {
8310    if (bb_list->list[i] != NULL)
8311    {
8312      l++;
8313    }
8314  }
8315  // initiate list
8316  L->Init(l);
8317  k = 0;
8318  for (i=0; i<nCount; i++)
8319  {
8320    L->m[k].rtyp = STRING_CMD;
8321    L->m[k].data = omStrDup(sArithBase.sCmds[i+1].name);
8322    k++;
8323    // Print("%-20s", sArithBase.sCmds[i+1].name);
8324    if (i + 1 + nCount < sArithBase.nCmdUsed)
8325    {
8326      L->m[k].rtyp = STRING_CMD;
8327      L->m[k].data = omStrDup(sArithBase.sCmds[i+1+nCount].name);
8328      k++;
8329      // Print("%-20s", sArithBase.sCmds[i+1 + nCount].name);
8330    }
8331    if(i+1+2*nCount<sArithBase.nCmdUsed)
8332    {
8333      L->m[k].rtyp = STRING_CMD;
8334      L->m[k].data = omStrDup(sArithBase.sCmds[i+1+2*nCount].name);
8335      k++;
8336      // Print("%-20s", sArithBase.sCmds[i+1+2*nCount].name);
8337    }
8338    // PrintLn();
8339  }
8340
8341  // assign blackbox types
8342  for (i = 0; i < bb_list->count; i++)
8343  {
8344    if (bb_list->list[i] != NULL)
8345    {
8346      L->m[k].rtyp = STRING_CMD;
8347      // already used strdup in getBlackBoxTypes
8348      L->m[k].data = bb_list->list[i];
8349      k++;
8350    }
8351  }
8352  // free the struct (not the list entries itself, which were allocated
8353  // by strdup)
8354  omfree(bb_list->list);
8355  omfree(bb_list);
8356
8357  // pass the resultant list to the res datastructure
8358  res->data=(void *)L;
8359
8360  return FALSE;
8361}
8362static BOOLEAN jjSTRING_PL(leftv res, leftv v)
8363{
8364  if (v == NULL)
8365  {
8366    res->data = omStrDup("");
8367    return FALSE;
8368  }
8369  int n = v->listLength();
8370  if (n == 1)
8371  {
8372    res->data = v->String();
8373    return FALSE;
8374  }
8375
8376  char** slist = (char**) omAlloc(n*sizeof(char*));
8377  int i, j;
8378
8379  for (i=0, j=0; i<n; i++, v = v ->next)
8380  {
8381    slist[i] = v->String();
8382    assume(slist[i] != NULL);
8383    j+=strlen(slist[i]);
8384  }
8385  char* s = (char*) omAlloc((j+1)*sizeof(char));
8386  *s='\0';
8387  for (i=0;i<n;i++)
8388  {
8389    strcat(s, slist[i]);
8390    omFree(slist[i]);
8391  }
8392  omFreeSize(slist, n*sizeof(char*));
8393  res->data = s;
8394  return FALSE;
8395}
8396static BOOLEAN jjTEST(leftv, leftv v)
8397{
8398  do
8399  {
8400    if (v->Typ()!=INT_CMD)
8401      return TRUE;
8402    test_cmd((int)(long)v->Data());
8403    v=v->next;
8404  }
8405  while (v!=NULL);
8406  return FALSE;
8407}
8408
8409#if defined(__alpha) && !defined(linux)
8410extern "C"
8411{
8412  void usleep(unsigned long usec);
8413};
8414#endif
8415static BOOLEAN jjFactModD_M(leftv res, leftv v)
8416{
8417  /* compute two factors of h(x,y) modulo x^(d+1) in K[[x]][y],
8418     see a detailed documentation in /kernel/linear_algebra/linearAlgebra.h
8419
8420     valid argument lists:
8421     - (poly h, int d),
8422     - (poly h, int d, poly f0, poly g0),       optional: factors of h(0,y),
8423     - (poly h, int d, int xIndex, int yIndex), optional: indices of vars x & y
8424                                                          in list of ring vars,
8425     - (poly h, int d, poly f0, poly g0, int xIndex, int yIndec),
8426                                                optional: all 4 optional args
8427     (The defaults are xIndex = 1, yIndex = 2, f0 and g0 polynomials as found
8428      by singclap_factorize and h(0, y)
8429      has exactly two distinct monic factors [possibly with exponent > 1].)
8430     result:
8431     - list with the two factors f and g such that
8432       h(x,y) = f(x,y)*g(x,y) mod x^(d+1)   */
8433
8434  poly h      = NULL;
8435  int  d      =    1;
8436  poly f0     = NULL;
8437  poly g0     = NULL;
8438  int  xIndex =    1;   /* default index if none provided */
8439  int  yIndex =    2;   /* default index if none provided */
8440
8441  leftv u = v; int factorsGiven = 0;
8442  if ((u == NULL) || (u->Typ() != POLY_CMD))
8443  {
8444    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8445    return TRUE;
8446  }
8447  else h = (poly)u->Data();
8448  u = u->next;
8449  if ((u == NULL) || (u->Typ() != INT_CMD))
8450  {
8451    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8452    return TRUE;
8453  }
8454  else d = (int)(long)u->Data();
8455  u = u->next;
8456  if ((u != NULL) && (u->Typ() == POLY_CMD))
8457  {
8458    if ((u->next == NULL) || (u->next->Typ() != POLY_CMD))
8459    {
8460      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8461      return TRUE;
8462    }
8463    else
8464    {
8465      f0 = (poly)u->Data();
8466      g0 = (poly)u->next->Data();
8467      factorsGiven = 1;
8468      u = u->next->next;
8469    }
8470  }
8471  if ((u != NULL) && (u->Typ() == INT_CMD))
8472  {
8473    if ((u->next == NULL) || (u->next->Typ() != INT_CMD))
8474    {
8475      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8476      return TRUE;
8477    }
8478    else
8479    {
8480      xIndex = (int)(long)u->Data();
8481      yIndex = (int)(long)u->next->Data();
8482      u = u->next->next;
8483    }
8484  }
8485  if (u != NULL)
8486  {
8487    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
8488    return TRUE;
8489  }
8490
8491  /* checks for provided arguments */
8492  if (pIsConstant(h) || (factorsGiven && (pIsConstant(f0) || pIsConstant(g0))))
8493  {
8494    WerrorS("expected non-constant polynomial argument(s)");
8495    return TRUE;
8496  }
8497  int n = rVar(currRing);
8498  if ((xIndex < 1) || (n < xIndex))
8499  {
8500    Werror("index for variable x (%d) out of range [1..%d]", xIndex, n);
8501    return TRUE;
8502  }
8503  if ((yIndex < 1) || (n < yIndex))
8504  {
8505    Werror("index for variable y (%d) out of range [1..%d]", yIndex, n);
8506    return TRUE;
8507  }
8508  if (xIndex == yIndex)
8509  {
8510    WerrorS("expected distinct indices for variables x and y");
8511    return TRUE;
8512  }
8513
8514  /* computation of f0 and g0 if missing */
8515  if (factorsGiven == 0)
8516  {
8517    poly h0 = pSubst(pCopy(h), xIndex, NULL);
8518    intvec* v = NULL;
8519    ideal i = singclap_factorize(h0, &v, 0,currRing);
8520
8521    ivTest(v);
8522
8523    if (i == NULL) return TRUE;
8524
8525    idTest(i);
8526
8527    if ((v->rows() != 3) || ((*v)[0] =! 1) || (!nIsOne(pGetCoeff(i->m[0]))))
8528    {
8529      WerrorS("expected h(0,y) to have exactly two distinct monic factors");
8530      return TRUE;
8531    }
8532    f0 = pPower(pCopy(i->m[1]), (*v)[1]);
8533    g0 = pPower(pCopy(i->m[2]), (*v)[2]);
8534    idDelete(&i);
8535  }
8536
8537  poly f; poly g;
8538  henselFactors(xIndex, yIndex, h, f0, g0, d, f, g);
8539  lists L = (lists)omAllocBin(slists_bin);
8540  L->Init(2);
8541  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
8542  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
8543  res->rtyp = LIST_CMD;
8544  res->data = (char*)L;
8545  return FALSE;
8546}
8547static BOOLEAN jjSTATUS_M(leftv res, leftv v)
8548{
8549  if ((v->Typ() != LINK_CMD) ||
8550      (v->next->Typ() != STRING_CMD) ||
8551      (v->next->next->Typ() != STRING_CMD) ||
8552      (v->next->next->next->Typ() != INT_CMD))
8553    return TRUE;
8554  jjSTATUS3(res, v, v->next, v->next->next);
8555#if defined(HAVE_USLEEP)
8556  if (((long) res->data) == 0L)
8557  {
8558    int i_s = (int)(long) v->next->next->next->Data();
8559    if (i_s > 0)
8560    {
8561      usleep((int)(long) v->next->next->next->Data());
8562      jjSTATUS3(res, v, v->next, v->next->next);
8563    }
8564  }
8565#elif defined(HAVE_SLEEP)
8566  if (((int) res->data) == 0)
8567  {
8568    int i_s = (int) v->next->next->next->Data();
8569    if (i_s > 0)
8570    {
8571      si_sleep((is - 1)/1000000 + 1);
8572      jjSTATUS3(res, v, v->next, v->next->next);
8573    }
8574  }
8575#endif
8576  return FALSE;
8577}
8578static BOOLEAN jjSUBST_M(leftv res, leftv u)
8579{
8580  leftv v = u->next; // number of args > 0
8581  if (v==NULL) return TRUE;
8582  leftv w = v->next;
8583  if (w==NULL) return TRUE;
8584  leftv rest = w->next;
8585
8586  u->next = NULL;
8587  v->next = NULL;
8588  w->next = NULL;
8589  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
8590  if ((rest!=NULL) && (!b))
8591  {
8592    leftv tmp_next=res->next;
8593    res->next=rest;
8594    sleftv tmp_res;
8595    tmp_res.Init();
8596    b = iiExprArithM(&tmp_res,res,iiOp);
8597    memcpy(res,&tmp_res,sizeof(tmp_res));
8598    res->next=tmp_next;
8599  }
8600  u->next = v;
8601  v->next = w;
8602  // rest was w->next, but is already cleaned
8603  return b;
8604}
8605static BOOLEAN jjQRDS(leftv res, leftv INPUT)
8606{
8607  if ((INPUT->Typ() != MATRIX_CMD) ||
8608      (INPUT->next->Typ() != NUMBER_CMD) ||
8609      (INPUT->next->next->Typ() != NUMBER_CMD) ||
8610      (INPUT->next->next->next->Typ() != NUMBER_CMD))
8611  {
8612    WerrorS("expected (matrix, number, number, number) as arguments");
8613    return TRUE;
8614  }
8615  leftv u = INPUT; leftv v = u->next; leftv w = v->next; leftv x = w->next;
8616  res->data = (char *)qrDoubleShift((matrix)(u->Data()),
8617                                    (number)(v->Data()),
8618                                    (number)(w->Data()),
8619                                    (number)(x->Data()));
8620  return FALSE;
8621}
8622static BOOLEAN jjSTD_HILB_WP(leftv res, leftv INPUT)
8623{ ideal result;
8624  leftv u = INPUT;    /* an ideal, weighted homogeneous and standard */
8625  leftv v = u->next;  /* one additional polynomial or ideal */
8626  leftv h = v->next;  /* Hilbert vector */
8627  leftv w = h->next;  /* weight vector */
8628  assumeStdFlag(u);
8629  ideal i1=(ideal)(u->Data());
8630  ideal i0;
8631  if (((u->Typ()!=IDEAL_CMD)&&(u->Typ()!=MODUL_CMD))
8632  || (h->Typ()!=INTVEC_CMD)
8633  || (w->Typ()!=INTVEC_CMD))
8634  {
8635    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
8636    return TRUE;
8637  }
8638  intvec *vw=(intvec *)w->Data(); // weights of vars
8639  /* merging std_hilb_w and std_1 */
8640  if (vw->length()!=currRing->N)
8641  {
8642    Werror("%d weights for %d variables",vw->length(),currRing->N);
8643    return TRUE;
8644  }
8645  int r=v->Typ();
8646  BOOLEAN cleanup_i0=FALSE;
8647  if ((r==POLY_CMD) ||(r==VECTOR_CMD))
8648  {
8649    i0=idInit(1,i1->rank);
8650    i0->m[0]=(poly)v->Data();
8651    cleanup_i0=TRUE;
8652  }
8653  else if (r==IDEAL_CMD)/* IDEAL */
8654  {
8655    i0=(ideal)v->Data();
8656  }
8657  else
8658  {
8659    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
8660    return TRUE;
8661  }
8662  int ii0=idElem(i0);
8663  i1 = idSimpleAdd(i1,i0);
8664  if (cleanup_i0)
8665  {
8666    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
8667    idDelete(&i0);
8668  }
8669  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
8670  tHomog hom=testHomog;
8671  /* u_id from jjSTD_W is now i1 as in jjSTD_1 */
8672  if (ww!=NULL)
8673  {
8674    if (!idTestHomModule(i1,currRing->qideal,ww))
8675    {
8676      WarnS("wrong weights");
8677      ww=NULL;
8678    }
8679    else
8680    {
8681      ww=ivCopy(ww);
8682      hom=isHomog;
8683    }
8684  }
8685  BITSET save1;
8686  SI_SAVE_OPT1(save1);
8687  si_opt_1|=Sy_bit(OPT_SB_1);
8688  result=kStd(i1,
8689              currRing->qideal,
8690              hom,
8691              &ww,                  // module weights
8692              (intvec *)h->Data(),  // hilbert series
8693              0,                    // syzComp, whatever it is...
8694              IDELEMS(i1)-ii0,      // new ideal
8695              vw);                  // weights of vars
8696  SI_RESTORE_OPT1(save1);
8697  idDelete(&i1);
8698  idSkipZeroes(result);
8699  res->data = (char *)result;
8700  if (!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
8701  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
8702  return FALSE;
8703}
8704
8705static BOOLEAN jjRING_PL(leftv res, leftv a)
8706{
8707  //Print("construct ring\n");
8708  if (a->Typ()!=CRING_CMD)
8709  {
8710    WerrorS("expected `cring` [ `id` ... ]");
8711    return TRUE;
8712  }
8713  assume(a->next!=NULL);
8714  leftv names=a->next;
8715  int N=names->listLength();
8716  char **n=(char**)omAlloc0(N*sizeof(char*));
8717  for(int i=0; i<N;i++,names=names->next)
8718  {
8719    n[i]=(char *)names->Name();
8720  }
8721  coeffs cf=(coeffs)a->CopyD();
8722  res->data=rDefault(cf,N,n, ringorder_dp);
8723  omFreeSize(n,N*sizeof(char*));
8724  return FALSE;
8725}
8726
8727static Subexpr jjMakeSub(leftv e)
8728{
8729  assume( e->Typ()==INT_CMD );
8730  Subexpr r=(Subexpr)omAlloc0Bin(sSubexpr_bin);
8731  r->start =(int)(long)e->Data();
8732  return r;
8733}
8734static BOOLEAN jjRESTART(leftv, leftv u)
8735{
8736  int c=(int)(long)u->Data();
8737  switch(c)
8738  {
8739    case 0:{
8740        PrintS("delete all variables\n");
8741        killlocals(0);
8742        WerrorS("restarting...");
8743        break;
8744      };
8745    default: WerrorS("not implemented");
8746  }
8747  return FALSE;
8748}
8749#define D(A)    (A)
8750#define NULL_VAL NULL
8751#define IPARITH
8752#include "table.h"
8753
8754#include "iparith.inc"
8755
8756/*=================== operations with 2 args. ============================*/
8757/* must be ordered: first operations for chars (infix ops),
8758 * then alphabetically */
8759
8760static BOOLEAN iiExprArith2TabIntern(leftv res, leftv a, int op, leftv b,
8761                                    BOOLEAN proccall,
8762                                    const struct sValCmd2* dA2,
8763                                    int at, int bt,
8764                                    const struct sConvertTypes *dConvertTypes)
8765{
8766  BOOLEAN call_failed=FALSE;
8767
8768  if (!errorreported)
8769  {
8770    int i=0;
8771    iiOp=op;
8772    while (dA2[i].cmd==op)
8773    {
8774      if ((at==dA2[i].arg1)
8775      && (bt==dA2[i].arg2))
8776      {
8777        res->rtyp=dA2[i].res;
8778        if (currRing!=NULL)
8779        {
8780          if (check_valid(dA2[i].valid_for,op)) break;
8781        }
8782        else
8783        {
8784          if (RingDependend(dA2[i].res))
8785          {
8786            WerrorS("no ring active (3)");
8787            break;
8788          }
8789        }
8790        if (traceit&TRACE_CALL)
8791          Print("call %s(%s,%s)\n",iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt));
8792        if ((call_failed=dA2[i].p(res,a,b)))
8793        {
8794          break;// leave loop, goto error handling
8795        }
8796        a->CleanUp();
8797        b->CleanUp();
8798        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8799        return FALSE;
8800      }
8801      i++;
8802    }
8803    // implicite type conversion ----------------------------------------------
8804    if (dA2[i].cmd!=op)
8805    {
8806      int ai,bi;
8807      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
8808      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
8809      BOOLEAN failed=FALSE;
8810      i=0; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
8811      //Print("op: %c, type: %s %s\n",op,Tok2Cmdname(at),Tok2Cmdname(bt));
8812      while (dA2[i].cmd==op)
8813      {
8814        //Print("test %s %s\n",Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8815        if ((dA2[i].valid_for & NO_CONVERSION)==0)
8816        {
8817          if ((ai=iiTestConvert(at,dA2[i].arg1,dConvertTypes))!=0)
8818          {
8819            if ((bi=iiTestConvert(bt,dA2[i].arg2,dConvertTypes))!=0)
8820            {
8821              res->rtyp=dA2[i].res;
8822              if (currRing!=NULL)
8823              {
8824                if (check_valid(dA2[i].valid_for,op)) break;
8825              }
8826              else
8827              {
8828                if (RingDependend(dA2[i].res))
8829                {
8830                  WerrorS("no ring active (4)");
8831                  break;
8832                }
8833              }
8834              if (traceit&TRACE_CALL)
8835                Print("call %s(%s,%s)\n",iiTwoOps(op),
8836                Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8837              failed= ((iiConvert(at,dA2[i].arg1,ai,a,an))
8838              || (iiConvert(bt,dA2[i].arg2,bi,b,bn))
8839              || (call_failed=dA2[i].p(res,an,bn)));
8840              // everything done, clean up temp. variables
8841              if (failed)
8842              {
8843                // leave loop, goto error handling
8844                break;
8845              }
8846              else
8847              {
8848                // everything ok, clean up and return
8849                an->CleanUp();
8850                bn->CleanUp();
8851                omFreeBin((ADDRESS)an, sleftv_bin);
8852                omFreeBin((ADDRESS)bn, sleftv_bin);
8853                return FALSE;
8854              }
8855            }
8856          }
8857        }
8858        i++;
8859      }
8860      an->CleanUp();
8861      bn->CleanUp();
8862      omFreeBin((ADDRESS)an, sleftv_bin);
8863      omFreeBin((ADDRESS)bn, sleftv_bin);
8864    }
8865    // error handling ---------------------------------------------------
8866    const char *s=NULL;
8867    if (!errorreported)
8868    {
8869      if ((at==0) && (a->Fullname()!=sNoName_fe))
8870      {
8871        s=a->Fullname();
8872      }
8873      else if ((bt==0) && (b->Fullname()!=sNoName_fe))
8874      {
8875        s=b->Fullname();
8876      }
8877      if (s!=NULL)
8878        Werror("`%s` is not defined",s);
8879      else
8880      {
8881        i=0; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
8882        s = iiTwoOps(op);
8883        if (proccall)
8884        {
8885          Werror("%s(`%s`,`%s`) failed"
8886                ,s,Tok2Cmdname(at),Tok2Cmdname(bt));
8887        }
8888        else
8889        {
8890          Werror("`%s` %s `%s` failed"
8891                ,Tok2Cmdname(at),s,Tok2Cmdname(bt));
8892        }
8893        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8894        {
8895          while (dA2[i].cmd==op)
8896          {
8897            if(((at==dA2[i].arg1)||(bt==dA2[i].arg2))
8898            && (dA2[i].res!=0)
8899            && (dA2[i].p!=jjWRONG2))
8900            {
8901              if (proccall)
8902                Werror("expected %s(`%s`,`%s`)"
8903                  ,s,Tok2Cmdname(dA2[i].arg1),Tok2Cmdname(dA2[i].arg2));
8904              else
8905                Werror("expected `%s` %s `%s`"
8906                  ,Tok2Cmdname(dA2[i].arg1),s,Tok2Cmdname(dA2[i].arg2));
8907            }
8908            i++;
8909          }
8910        }
8911      }
8912    }
8913    a->CleanUp();
8914    b->CleanUp();
8915    res->rtyp = UNKNOWN;
8916  }
8917  return TRUE;
8918}
8919BOOLEAN iiExprArith2Tab(leftv res, leftv a, int op,
8920                                    const struct sValCmd2* dA2,
8921                                    int at,
8922                                    const struct sConvertTypes *dConvertTypes)
8923{
8924  res->Init();
8925  leftv b=a->next;
8926  a->next=NULL;
8927  int bt=b->Typ();
8928  BOOLEAN bo=iiExprArith2TabIntern(res,a,op,b,TRUE,dA2,at,bt,dConvertTypes);
8929  a->next=b;
8930  a->CleanUp(); // to clean up the chain, content already done in iiExprArith2TabIntern
8931  return bo;
8932}
8933BOOLEAN iiExprArith2(leftv res, leftv a, int op, leftv b, BOOLEAN proccall)
8934{
8935  res->Init();
8936
8937  if (!errorreported)
8938  {
8939#ifdef SIQ
8940    if (siq>0)
8941    {
8942      //Print("siq:%d\n",siq);
8943      command d=(command)omAlloc0Bin(sip_command_bin);
8944      memcpy(&d->arg1,a,sizeof(sleftv));
8945      a->Init();
8946      memcpy(&d->arg2,b,sizeof(sleftv));
8947      b->Init();
8948      d->argc=2;
8949      d->op=op;
8950      res->data=(char *)d;
8951      res->rtyp=COMMAND;
8952      return FALSE;
8953    }
8954#endif
8955    int at=a->Typ();
8956    int bt=b->Typ();
8957    // handling bb-objects ----------------------------------------------------
8958    if (at>MAX_TOK)
8959    {
8960      blackbox *bb=getBlackboxStuff(at);
8961      if (bb!=NULL)
8962      {
8963        if(!bb->blackbox_Op2(op,res,a,b)) return FALSE;
8964        // if not defined, try generic (attrib, ..)
8965      }
8966      else
8967      return TRUE;
8968    }
8969    else if ((bt>MAX_TOK)&&(op!='('))
8970    {
8971      blackbox *bb=getBlackboxStuff(bt);
8972      if (bb!=NULL)
8973      {
8974        if(!bb->blackbox_Op2(op,res,a,b)) return FALSE;
8975        // if not defined, try generic (attrib, ..)
8976      }
8977      else
8978      return TRUE;
8979    }
8980    int i=iiTabIndex(dArithTab2,JJTAB2LEN,op);
8981    return iiExprArith2TabIntern(res,a,op,b,proccall,dArith2+i,at,bt,dConvertTypes);
8982  }
8983  a->CleanUp();
8984  b->CleanUp();
8985  return TRUE;
8986}
8987
8988/*==================== operations with 1 arg. ===============================*/
8989/* must be ordered: first operations for chars (infix ops),
8990 * then alphabetically */
8991
8992BOOLEAN iiExprArith1Tab(leftv res, leftv a, int op, const struct sValCmd1* dA1, int at, const struct sConvertTypes *dConvertTypes)
8993{
8994  res->Init();
8995  BOOLEAN call_failed=FALSE;
8996
8997  if (!errorreported)
8998  {
8999    BOOLEAN failed=FALSE;
9000    iiOp=op;
9001    int i = 0;
9002    while (dA1[i].cmd==op)
9003    {
9004      if (at==dA1[i].arg)
9005      {
9006        if (currRing!=NULL)
9007        {
9008          if (check_valid(dA1[i].valid_for,op)) break;
9009        }
9010        else
9011        {
9012          if (RingDependend(dA1[i].res))
9013          {
9014            WerrorS("no ring active (5)");
9015            break;
9016          }
9017        }
9018        if (traceit&TRACE_CALL)
9019          Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
9020        res->rtyp=dA1[i].res;
9021        if ((call_failed=dA1[i].p(res,a)))
9022        {
9023          break;// leave loop, goto error handling
9024        }
9025        if (a->Next()!=NULL)
9026        {
9027          res->next=(leftv)omAllocBin(sleftv_bin);
9028          failed=iiExprArith1(res->next,a->next,op);
9029        }
9030        a->CleanUp();
9031        return failed;
9032      }
9033      i++;
9034    }
9035    // implicite type conversion --------------------------------------------
9036    if (dA1[i].cmd!=op)
9037    {
9038      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
9039      i=0;
9040      //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
9041      while (dA1[i].cmd==op)
9042      {
9043        int ai;
9044        //Print("test %s\n",Tok2Cmdname(dA1[i].arg));
9045        if ((dA1[i].valid_for & NO_CONVERSION)==0)
9046        {
9047          if ((ai=iiTestConvert(at,dA1[i].arg,dConvertTypes))!=0)
9048          {
9049            if (currRing!=NULL)
9050            {
9051              if (check_valid(dA1[i].valid_for,op)) break;
9052            }
9053            else
9054            {
9055              if (RingDependend(dA1[i].res))
9056              {
9057                WerrorS("no ring active (6)");
9058                break;
9059              }
9060            }
9061            if (traceit&TRACE_CALL)
9062              Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(dA1[i].arg));
9063            res->rtyp=dA1[i].res;
9064            failed= ((iiConvert(at,dA1[i].arg,ai,a,an,dConvertTypes))
9065            || (call_failed=dA1[i].p(res,an)));
9066            // everything done, clean up temp. variables
9067            if (failed)
9068            {
9069              // leave loop, goto error handling
9070              break;
9071            }
9072            else
9073            {
9074              if (an->Next() != NULL)
9075              {
9076                res->next = (leftv)omAllocBin(sleftv_bin);
9077                failed=iiExprArith1(res->next,an->next,op);
9078              }
9079              // everything ok, clean up and return
9080              an->CleanUp();
9081              omFreeBin((ADDRESS)an, sleftv_bin);
9082              return failed;
9083            }
9084          }
9085        }
9086        i++;
9087      }
9088      an->CleanUp();
9089      omFreeBin((ADDRESS)an, sleftv_bin);
9090    }
9091    // error handling
9092    if (!errorreported)
9093    {
9094      if ((at==0) && (a->Fullname()!=sNoName_fe))
9095      {
9096        Werror("`%s` is not defined",a->Fullname());
9097      }
9098      else
9099      {
9100        i=0;
9101        const char *s = iiTwoOps(op);
9102        Werror("%s(`%s`) failed"
9103                ,s,Tok2Cmdname(at));
9104        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
9105        {
9106          while (dA1[i].cmd==op)
9107          {
9108            if ((dA1[i].res!=0)
9109            && (dA1[i].p!=jjWRONG))
9110              Werror("expected %s(`%s`)"
9111                ,s,Tok2Cmdname(dA1[i].arg));
9112            i++;
9113          }
9114        }
9115      }
9116    }
9117    res->rtyp = UNKNOWN;
9118  }
9119  a->CleanUp();
9120  return TRUE;
9121}
9122BOOLEAN iiExprArith1(leftv res, leftv a, int op)
9123{
9124  if (!errorreported)
9125  {
9126    res->Init();
9127#ifdef SIQ
9128    if (siq>0)
9129    {
9130      //Print("siq:%d\n",siq);
9131      command d=(command)omAlloc0Bin(sip_command_bin);
9132      memcpy(&d->arg1,a,sizeof(sleftv));
9133      a->Init();
9134      d->op=op;
9135      d->argc=1;
9136      res->data=(char *)d;
9137      res->rtyp=COMMAND;
9138      return FALSE;
9139    }
9140#endif
9141    int at=a->Typ();
9142    // handling bb-objects ----------------------------------------------------
9143    if(op>MAX_TOK) // explicit type conversion to bb
9144    {
9145      blackbox *bb=getBlackboxStuff(op);
9146      if (bb!=NULL)
9147      {
9148        res->rtyp=op;
9149        res->data=bb->blackbox_Init(bb);
9150        return bb->blackbox_Assign(res,a);
9151      }
9152      else
9153      return TRUE;
9154    }
9155    else if (at>MAX_TOK) // argument is of bb-type
9156    {
9157      blackbox *bb=getBlackboxStuff(at);
9158      if (bb!=NULL)
9159      {
9160        if(!bb->blackbox_Op1(op,res,a)) return FALSE;
9161        // if not defined, try generic routines (attrib, defined,..)
9162      }
9163      else
9164      return TRUE;
9165    }
9166    if (errorreported) return TRUE;
9167
9168    int i=iiTabIndex(dArithTab1,JJTAB1LEN,op);
9169    return iiExprArith1Tab(res,a,op, dArith1+i,at,dConvertTypes);
9170  }
9171  a->CleanUp();
9172  return TRUE;
9173}
9174
9175/*=================== operations with 3 args. ============================*/
9176/* must be ordered: first operations for chars (infix ops),
9177 * then alphabetically */
9178
9179static BOOLEAN iiExprArith3TabIntern(leftv res, int op, leftv a, leftv b, leftv c,
9180  const struct sValCmd3* dA3, int at, int bt, int ct,
9181  const struct sConvertTypes *dConvertTypes)
9182{
9183  BOOLEAN call_failed=FALSE;
9184
9185  assume(dA3[0].cmd==op);
9186
9187  if (!errorreported)
9188  {
9189    int i=0;
9190    iiOp=op;
9191    while (dA3[i].cmd==op)
9192    {
9193      if ((at==dA3[i].arg1)
9194      && (bt==dA3[i].arg2)
9195      && (ct==dA3[i].arg3))
9196      {
9197        res->rtyp=dA3[i].res;
9198        if (currRing!=NULL)
9199        {
9200          if (check_valid(dA3[i].valid_for,op)) break;
9201        }
9202        if (traceit&TRACE_CALL)
9203          Print("call %s(%s,%s,%s)\n",
9204            iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
9205        if ((call_failed=dA3[i].p(res,a,b,c)))
9206        {
9207          break;// leave loop, goto error handling
9208        }
9209        a->CleanUp();
9210        b->CleanUp();
9211        c->CleanUp();
9212        return FALSE;
9213      }
9214      i++;
9215    }
9216    // implicite type conversion ----------------------------------------------
9217    if (dA3[i].cmd!=op)
9218    {
9219      int ai,bi,ci;
9220      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
9221      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
9222      leftv cn = (leftv)omAlloc0Bin(sleftv_bin);
9223      BOOLEAN failed=FALSE;
9224      i=0;
9225      //while ((dA3[i].cmd!=op)&&(dA3[i].cmd!=0)) i++;
9226      while (dA3[i].cmd==op)
9227      {
9228        if ((dA3[i].valid_for & NO_CONVERSION)==0)
9229        {
9230          if ((ai=iiTestConvert(at,dA3[i].arg1,dConvertTypes))!=0)
9231          {
9232            if ((bi=iiTestConvert(bt,dA3[i].arg2,dConvertTypes))!=0)
9233            {
9234              if ((ci=iiTestConvert(ct,dA3[i].arg3,dConvertTypes))!=0)
9235              {
9236                res->rtyp=dA3[i].res;
9237                if (currRing!=NULL)
9238                {
9239                  if (check_valid(dA3[i].valid_for,op)) break;
9240                }
9241                if (traceit&TRACE_CALL)
9242                  Print("call %s(%s,%s,%s)\n",
9243                    iiTwoOps(op),Tok2Cmdname(dA3[i].arg1),
9244                    Tok2Cmdname(dA3[i].arg2),Tok2Cmdname(dA3[i].arg3));
9245                failed= ((iiConvert(at,dA3[i].arg1,ai,a,an,dConvertTypes))
9246                  || (iiConvert(bt,dA3[i].arg2,bi,b,bn,dConvertTypes))
9247                  || (iiConvert(ct,dA3[i].arg3,ci,c,cn,dConvertTypes))
9248                  || (call_failed=dA3[i].p(res,an,bn,cn)));
9249                // everything done, clean up temp. variables
9250                if (failed)
9251                {
9252                  // leave loop, goto error handling
9253                  break;
9254                }
9255                else
9256                {
9257                  // everything ok, clean up and return
9258                  an->CleanUp();
9259                  bn->CleanUp();
9260                  cn->CleanUp();
9261                  omFreeBin((ADDRESS)an, sleftv_bin);
9262                  omFreeBin((ADDRESS)bn, sleftv_bin);
9263                  omFreeBin((ADDRESS)cn, sleftv_bin);
9264                  //Print("op: %d,result typ:%d\n",op,res->rtyp);
9265                  return FALSE;
9266                }
9267              }
9268            }
9269          }
9270        }
9271        i++;
9272      }
9273      an->CleanUp();
9274      bn->CleanUp();
9275      cn->CleanUp();
9276      omFreeBin((ADDRESS)an, sleftv_bin);
9277      omFreeBin((ADDRESS)bn, sleftv_bin);
9278      omFreeBin((ADDRESS)cn, sleftv_bin);
9279    }
9280    // error handling ---------------------------------------------------
9281    if (!errorreported)
9282    {
9283      const char *s=NULL;
9284      if ((at==0) && (a->Fullname()!=sNoName_fe))
9285      {
9286        s=a->Fullname();
9287      }
9288      else if ((bt==0) && (b->Fullname()!=sNoName_fe))
9289      {
9290        s=b->Fullname();
9291      }
9292      else if ((ct==0) && (c->Fullname()!=sNoName_fe))
9293      {
9294        s=c->Fullname();
9295      }
9296      if (s!=NULL)
9297        Werror("`%s` is not defined",s);
9298      else
9299      {
9300        i=0;
9301        //while ((dA3[i].cmd!=op)&&(dA3[i].cmd!=0)) i++;
9302        const char *s = iiTwoOps(op);
9303        Werror("%s(`%s`,`%s`,`%s`) failed"
9304                ,s,Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
9305        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
9306        {
9307          while (dA3[i].cmd==op)
9308          {
9309            if(((at==dA3[i].arg1)
9310            ||(bt==dA3[i].arg2)
9311            ||(ct==dA3[i].arg3))
9312            && (dA3[i].res!=0))
9313            {
9314              Werror("expected %s(`%s`,`%s`,`%s`)"
9315                  ,s,Tok2Cmdname(dA3[i].arg1)
9316                  ,Tok2Cmdname(dA3[i].arg2)
9317                  ,Tok2Cmdname(dA3[i].arg3));
9318            }
9319            i++;
9320          }
9321        }
9322      }
9323    }
9324    res->rtyp = UNKNOWN;
9325  }
9326  a->CleanUp();
9327  b->CleanUp();
9328  c->CleanUp();
9329  //Print("op: %d,result typ:%d\n",op,res->rtyp);
9330  return TRUE;
9331}
9332BOOLEAN iiExprArith3(leftv res, int op, leftv a, leftv b, leftv c)
9333{
9334  res->Init();
9335
9336  if (!errorreported)
9337  {
9338#ifdef SIQ
9339    if (siq>0)
9340    {
9341      //Print("siq:%d\n",siq);
9342      command d=(command)omAlloc0Bin(sip_command_bin);
9343      memcpy(&d->arg1,a,sizeof(sleftv));
9344      a->Init();
9345      memcpy(&d->arg2,b,sizeof(sleftv));
9346      b->Init();
9347      memcpy(&d->arg3,c,sizeof(sleftv));
9348      c->Init();
9349      d->op=op;
9350      d->argc=3;
9351      res->data=(char *)d;
9352      res->rtyp=COMMAND;
9353      return FALSE;
9354    }
9355#endif
9356    int at=a->Typ();
9357    // handling bb-objects ----------------------------------------------
9358    if (at>MAX_TOK)
9359    {
9360      blackbox *bb=getBlackboxStuff(at);
9361      if (bb!=NULL)
9362      {
9363        if(!bb->blackbox_Op3(op,res,a,b,c)) return FALSE;
9364        // otherwise, try defaul (attrib,..)
9365      }
9366      else
9367      return TRUE;
9368      if (errorreported) return TRUE;
9369    }
9370    int bt=b->Typ();
9371    int ct=c->Typ();
9372
9373    iiOp=op;
9374    int i=0;
9375    while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
9376    return iiExprArith3TabIntern(res,op,a,b,c,dArith3+i,at,bt,ct,dConvertTypes);
9377  }
9378  a->CleanUp();
9379  b->CleanUp();
9380  c->CleanUp();
9381  //Print("op: %d,result typ:%d\n",op,res->rtyp);
9382  return TRUE;
9383}
9384BOOLEAN iiExprArith3Tab(leftv res, leftv a, int op,
9385                                    const struct sValCmd3* dA3,
9386                                    int at,
9387                                    const struct sConvertTypes *dConvertTypes)
9388{
9389  res->Init();
9390  leftv b=a->next;
9391  a->next=NULL;
9392  int bt=b->Typ();
9393  leftv c=b->next;
9394  b->next=NULL;
9395  int ct=c->Typ();
9396  BOOLEAN bo=iiExprArith3TabIntern(res,op,a,b,c,dA3,at,bt,ct,dConvertTypes);
9397  b->next=c;
9398  a->next=b;
9399  a->CleanUp(); // to cleanup the chain, content already done
9400  return bo;
9401}
9402/*==================== operations with many arg. ===============================*/
9403/* must be ordered: first operations for chars (infix ops),
9404 * then alphabetically */
9405
9406#if 0 // unused
9407static BOOLEAN jjANY2LIST(leftv res, leftv v, int cnt)
9408{
9409  // cnt = 0: all
9410  // cnt = 1: only first one
9411  leftv next;
9412  BOOLEAN failed = TRUE;
9413  if(v==NULL) return failed;
9414  res->rtyp = LIST_CMD;
9415  if(cnt) v->next = NULL;
9416  next = v->next;             // saving next-pointer
9417  failed = jjLIST_PL(res, v);
9418  v->next = next;             // writeback next-pointer
9419  return failed;
9420}
9421#endif
9422
9423BOOLEAN iiExprArithM(leftv res, leftv a, int op)
9424{
9425  res->Init();
9426
9427  if (!errorreported)
9428  {
9429#ifdef SIQ
9430    if (siq>0)
9431    {
9432      //Print("siq:%d\n",siq);
9433      command d=(command)omAlloc0Bin(sip_command_bin);
9434      d->op=op;
9435      res->data=(char *)d;
9436      if (a!=NULL)
9437      {
9438        d->argc=a->listLength();
9439        // else : d->argc=0;
9440        memcpy(&d->arg1,a,sizeof(sleftv));
9441        switch(d->argc)
9442        {
9443          case 3:
9444            memcpy(&d->arg3,a->next->next,sizeof(sleftv));
9445            a->next->next->Init();
9446            /* no break */
9447          case 2:
9448            memcpy(&d->arg2,a->next,sizeof(sleftv));
9449            a->next->Init();
9450            a->next->next=d->arg2.next;
9451            d->arg2.next=NULL;
9452            /* no break */
9453          case 1:
9454            a->Init();
9455            a->next=d->arg1.next;
9456            d->arg1.next=NULL;
9457        }
9458        if (d->argc>3) a->next=NULL;
9459        a->name=NULL;
9460        a->rtyp=0;
9461        a->data=NULL;
9462        a->e=NULL;
9463        a->attribute=NULL;
9464        a->CleanUp();
9465      }
9466      res->rtyp=COMMAND;
9467      return FALSE;
9468    }
9469#endif
9470    if ((a!=NULL) && (a->Typ()>MAX_TOK))
9471    {
9472      blackbox *bb=getBlackboxStuff(a->Typ());
9473      if (bb!=NULL)
9474      {
9475        if(!bb->blackbox_OpM(op,res,a)) return FALSE;
9476        // otherwise, try default
9477      }
9478      else
9479      return TRUE;
9480      if (errorreported) return TRUE;
9481    }
9482    int args=0;
9483    if (a!=NULL) args=a->listLength();
9484
9485    iiOp=op;
9486    int i=0;
9487    while ((dArithM[i].cmd!=op)&&(dArithM[i].cmd!=0)) i++;
9488    while (dArithM[i].cmd==op)
9489    {
9490      if ((args==dArithM[i].number_of_args)
9491      || (dArithM[i].number_of_args==-1)
9492      || ((dArithM[i].number_of_args==-2)&&(args>0)))
9493      {
9494        res->rtyp=dArithM[i].res;
9495        if (currRing!=NULL)
9496        {
9497          if (check_valid(dArithM[i].valid_for,op)) break;
9498        }
9499        if (traceit&TRACE_CALL)
9500          Print("call %s(... (%d args))\n", iiTwoOps(op),args);
9501        if (dArithM[i].p(res,a))
9502        {
9503          break;// leave loop, goto error handling
9504        }
9505        if (a!=NULL) a->CleanUp();
9506        //Print("op: %d,result typ:%d\n",op,res->rtyp);
9507        return FALSE;
9508      }
9509      i++;
9510    }
9511    // error handling
9512    if (!errorreported)
9513    {
9514      if ((args>0) && (a->rtyp==0) && (a->Name()!=sNoName_fe))
9515      {
9516        Werror("`%s` is not defined",a->Fullname());
9517      }
9518      else
9519      {
9520        const char *s = iiTwoOps(op);
9521        Werror("%s(...) failed",s);
9522      }
9523    }
9524    res->rtyp = UNKNOWN;
9525  }
9526  if (a!=NULL) a->CleanUp();
9527        //Print("op: %d,result typ:%d\n",op,res->rtyp);
9528  return TRUE;
9529}
9530
9531/*=================== general utilities ============================*/
9532int IsCmd(const char *n, int & tok)
9533{
9534  int i;
9535  int an=1;
9536  int en=sArithBase.nLastIdentifier;
9537
9538  loop
9539  //for(an=0; an<sArithBase.nCmdUsed; )
9540  {
9541    if(an>=en-1)
9542    {
9543      if (strcmp(n, sArithBase.sCmds[an].name) == 0)
9544      {
9545        i=an;
9546        break;
9547      }
9548      else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
9549      {
9550        i=en;
9551        break;
9552      }
9553      else
9554      {
9555        // -- blackbox extensions:
9556        // return 0;
9557        return blackboxIsCmd(n,tok);
9558      }
9559    }
9560    i=(an+en)/2;
9561    if (*n < *(sArithBase.sCmds[i].name))
9562    {
9563      en=i-1;
9564    }
9565    else if (*n > *(sArithBase.sCmds[i].name))
9566    {
9567      an=i+1;
9568    }
9569    else
9570    {
9571      int v=strcmp(n,sArithBase.sCmds[i].name);
9572      if(v<0)
9573      {
9574        en=i-1;
9575      }
9576      else if(v>0)
9577      {
9578        an=i+1;
9579      }
9580      else /*v==0*/
9581      {
9582        break;
9583      }
9584    }
9585  }
9586  lastreserved=sArithBase.sCmds[i].name;
9587  tok=sArithBase.sCmds[i].tokval;
9588  if(sArithBase.sCmds[i].alias==2)
9589  {
9590    Warn("outdated identifier `%s` used - please change your code",
9591    sArithBase.sCmds[i].name);
9592    sArithBase.sCmds[i].alias=1;
9593  }
9594  #if 0
9595  if (currRingHdl==NULL)
9596  {
9597    #ifdef SIQ
9598    if (siq<=0)
9599    {
9600    #endif
9601      if ((tok>=BEGIN_RING) && (tok<=END_RING))
9602      {
9603        WerrorS("no ring active");
9604        return 0;
9605      }
9606    #ifdef SIQ
9607    }
9608    #endif
9609  }
9610  #endif
9611  if (!expected_parms)
9612  {
9613    switch (tok)
9614    {
9615      case IDEAL_CMD:
9616      case INT_CMD:
9617      case INTVEC_CMD:
9618      case MAP_CMD:
9619      case MATRIX_CMD:
9620      case MODUL_CMD:
9621      case POLY_CMD:
9622      case PROC_CMD:
9623      case RING_CMD:
9624      case STRING_CMD:
9625        cmdtok = tok;
9626        break;
9627    }
9628  }
9629  return sArithBase.sCmds[i].toktype;
9630}
9631static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op)
9632{
9633  // user defined types are not in the pre-computed table:
9634  if (op>MAX_TOK) return 0;
9635
9636  int a=0;
9637  int e=len;
9638  int p=len/2;
9639  do
9640  {
9641     if (op==dArithTab[p].cmd) return dArithTab[p].start;
9642     if (op<dArithTab[p].cmd) e=p-1;
9643     else   a = p+1;
9644     p=a+(e-a)/2;
9645  }
9646  while ( a <= e);
9647
9648  // catch missing a cmd:
9649  // may be missing as a op for blackbox, if the first operand is "undef" instead of bb
9650  // Print("op %d (%c) unknown",op,op);
9651  return 0;
9652}
9653
9654typedef char si_char_2[2];
9655STATIC_VAR si_char_2 Tok2Cmdname_buf=" ";
9656const char * Tok2Cmdname(int tok)
9657{
9658  if (tok <= 0)
9659  {
9660    return sArithBase.sCmds[0].name;
9661  }
9662  if (tok==ANY_TYPE) return "any_type";
9663  if (tok==COMMAND) return "command";
9664  if (tok==NONE) return "nothing";
9665  if (tok < 128)
9666  {
9667    Tok2Cmdname_buf[0]=(char)tok;
9668    return Tok2Cmdname_buf;
9669  }
9670  //if (tok==IFBREAK) return "if_break";
9671  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
9672  //if (tok==ORDER_VECTOR) return "ordering";
9673  //if (tok==REF_VAR) return "ref";
9674  //if (tok==OBJECT) return "object";
9675  //if (tok==PRINT_EXPR) return "print_expr";
9676  if (tok==IDHDL) return "identifier";
9677  if (tok>MAX_TOK) return getBlackboxName(tok);
9678  unsigned i;
9679  for(i=0; i<sArithBase.nCmdUsed; i++)
9680    //while (sArithBase.sCmds[i].tokval!=0)
9681  {
9682    if ((sArithBase.sCmds[i].tokval == tok)&&
9683        (sArithBase.sCmds[i].alias==0))
9684    {
9685      return sArithBase.sCmds[i].name;
9686    }
9687  }
9688  // try gain for alias/old names:
9689  for(i=0; i<sArithBase.nCmdUsed; i++)
9690  {
9691    if (sArithBase.sCmds[i].tokval == tok)
9692    {
9693      return sArithBase.sCmds[i].name;
9694    }
9695  }
9696  return sArithBase.sCmds[0].name;
9697}
9698
9699
9700/*---------------------------------------------------------------------*/
9701/**
9702 * @brief compares to entry of cmdsname-list
9703
9704 @param[in] a
9705 @param[in] b
9706
9707 @return <ReturnValue>
9708**/
9709/*---------------------------------------------------------------------*/
9710static int _gentable_sort_cmds( const void *a, const void *b )
9711{
9712  cmdnames *pCmdL = (cmdnames*)a;
9713  cmdnames *pCmdR = (cmdnames*)b;
9714
9715  if(a==NULL || b==NULL)             return 0;
9716
9717  /* empty entries goes to the end of the list for later reuse */
9718  if(pCmdL->name==NULL) return 1;
9719  if(pCmdR->name==NULL) return -1;
9720
9721  /* $INVALID$ must come first */
9722  if(strcmp(pCmdL->name, "$INVALID$")==0) return -1;
9723  if(strcmp(pCmdR->name, "$INVALID$")==0) return  1;
9724
9725  /* tokval=-1 are reserved names at the end */
9726  if (pCmdL->tokval==-1)
9727  {
9728    if (pCmdR->tokval==-1)
9729       return strcmp(pCmdL->name, pCmdR->name);
9730    /* pCmdL->tokval==-1, pCmdL goes at the end */
9731    return 1;
9732  }
9733  /* pCmdR->tokval==-1, pCmdR goes at the end */
9734  if(pCmdR->tokval==-1) return -1;
9735
9736  return strcmp(pCmdL->name, pCmdR->name);
9737}
9738
9739/*---------------------------------------------------------------------*/
9740/**
9741 * @brief initialisation of arithmetic structured data
9742
9743 @retval 0 on success
9744
9745**/
9746/*---------------------------------------------------------------------*/
9747int iiInitArithmetic()
9748{
9749  //printf("iiInitArithmetic()\n");
9750  memset(&sArithBase, 0, sizeof(sArithBase));
9751  iiInitCmdName();
9752  /* fix last-identifier */
9753#if 0
9754  /* we expect that gentable allready did every thing */
9755  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9756      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--) {
9757    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9758  }
9759#endif
9760  //Print("L=%d\n", sArithBase.nLastIdentifier);
9761
9762  //iiArithAddCmd(szName, nAlias, nTokval, nToktype);
9763  //iiArithAddCmd("mygcd", 1, GCD_CMD, CMD_2);
9764
9765  //iiArithAddCmd("Top", 0,-1,0);
9766
9767
9768  //for(i=0; i<sArithBase.nCmdUsed; i++) {
9769  //  printf("CMD[%03d] %s, %d, %d, %d\n", i,
9770  //         sArithBase.sCmds[i].name,
9771  //         sArithBase.sCmds[i].alias,
9772  //         sArithBase.sCmds[i].tokval,
9773  //         sArithBase.sCmds[i].toktype);
9774  //}
9775  //iiArithRemoveCmd("Top");
9776  //iiArithAddCmd("mygcd", 2, GCD_CMD, CMD_2);
9777  //iiArithRemoveCmd("mygcd");
9778  //iiArithAddCmd("kkk", 1, 1234, CMD_1);
9779  return 0;
9780}
9781
9782int iiArithFindCmd(const char *szName)
9783{
9784  int an=0;
9785  int i = 0,v = 0;
9786  int en=sArithBase.nLastIdentifier;
9787
9788  loop
9789  //for(an=0; an<sArithBase.nCmdUsed; )
9790  {
9791    if(an>=en-1)
9792    {
9793      if (strcmp(szName, sArithBase.sCmds[an].name) == 0)
9794      {
9795        //Print("RET-an=%d %s\n", an, sArithBase.sCmds[an].name);
9796        return an;
9797      }
9798      else if (strcmp(szName, sArithBase.sCmds[en].name) == 0)
9799      {
9800        //Print("RET-en=%d %s\n", en, sArithBase.sCmds[en].name);
9801        return en;
9802      }
9803      else
9804      {
9805        //Print("RET- 1\n");
9806        return -1;
9807      }
9808    }
9809    i=(an+en)/2;
9810    if (*szName < *(sArithBase.sCmds[i].name))
9811    {
9812      en=i-1;
9813    }
9814    else if (*szName > *(sArithBase.sCmds[i].name))
9815    {
9816      an=i+1;
9817    }
9818    else
9819    {
9820      v=strcmp(szName,sArithBase.sCmds[i].name);
9821      if(v<0)
9822      {
9823        en=i-1;
9824      }
9825      else if(v>0)
9826      {
9827        an=i+1;
9828      }
9829      else /*v==0*/
9830      {
9831        //Print("RET-i=%d %s\n", i, sArithBase.sCmds[i].name);
9832        return i;
9833      }
9834    }
9835  }
9836  //if(i>=0 && i<sArithBase.nCmdUsed)
9837  //  return i;
9838  //PrintS("RET-2\n");
9839  return -2;
9840}
9841
9842char *iiArithGetCmd( int nPos )
9843{
9844  if(nPos<0) return NULL;
9845  if(nPos<(int)sArithBase.nCmdUsed)
9846    return sArithBase.sCmds[nPos].name;
9847  return NULL;
9848}
9849
9850int iiArithRemoveCmd(const char *szName)
9851{
9852  int nIndex;
9853  if(szName==NULL) return -1;
9854
9855  nIndex = iiArithFindCmd(szName);
9856  if(nIndex<0 || nIndex>=(int)sArithBase.nCmdUsed)
9857  {
9858    Print("'%s' not found (%d)\n", szName, nIndex);
9859    return -1;
9860  }
9861  omFreeBinAddr(sArithBase.sCmds[nIndex].name);
9862  sArithBase.sCmds[nIndex].name=NULL;
9863  qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
9864        (&_gentable_sort_cmds));
9865  sArithBase.nCmdUsed--;
9866
9867  /* fix last-identifier */
9868  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9869      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
9870  {
9871    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9872  }
9873  //Print("L=%d\n", sArithBase.nLastIdentifier);
9874  return 0;
9875}
9876
9877int iiArithAddCmd(
9878  const char *szName,
9879  short nAlias,
9880  short nTokval,
9881  short nToktype,
9882  short nPos
9883  )
9884{
9885  //printf("AddCmd(%s, %d, %d, %d, %d)\n", szName, nAlias,
9886  //       nTokval, nToktype, nPos);
9887  if(nPos>=0)
9888  {
9889    // no checks: we rely on a correct generated code in iparith.inc
9890    assume((unsigned)nPos < sArithBase.nCmdAllocated);
9891    assume(szName!=NULL);
9892    sArithBase.sCmds[nPos].name    = omStrDup(szName);
9893    sArithBase.sCmds[nPos].alias   = nAlias;
9894    sArithBase.sCmds[nPos].tokval  = nTokval;
9895    sArithBase.sCmds[nPos].toktype = nToktype;
9896    sArithBase.nCmdUsed++;
9897    //if(nTokval>0) sArithBase.nLastIdentifier++;
9898  }
9899  else
9900  {
9901    if(szName==NULL) return -1;
9902    int nIndex = iiArithFindCmd(szName);
9903    if(nIndex>=0)
9904    {
9905      Print("'%s' already exists at %d\n", szName, nIndex);
9906      return -1;
9907    }
9908
9909    if(sArithBase.nCmdUsed>=sArithBase.nCmdAllocated)
9910    {
9911      /* needs to create new slots */
9912      unsigned long nSize = (sArithBase.nCmdAllocated+1)*sizeof(cmdnames);
9913      sArithBase.sCmds = (cmdnames *)omRealloc(sArithBase.sCmds, nSize);
9914      if(sArithBase.sCmds==NULL) return -1;
9915      sArithBase.nCmdAllocated++;
9916    }
9917    /* still free slots available */
9918    sArithBase.sCmds[sArithBase.nCmdUsed].name    = omStrDup(szName);
9919    sArithBase.sCmds[sArithBase.nCmdUsed].alias   = nAlias;
9920    sArithBase.sCmds[sArithBase.nCmdUsed].tokval  = nTokval;
9921    sArithBase.sCmds[sArithBase.nCmdUsed].toktype = nToktype;
9922    sArithBase.nCmdUsed++;
9923
9924    qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
9925          (&_gentable_sort_cmds));
9926    for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
9927        sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
9928    {
9929      if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
9930    }
9931    //Print("L=%d\n", sArithBase.nLastIdentifier);
9932  }
9933  return 0;
9934}
9935
9936static BOOLEAN check_valid(const int p, const int op)
9937{
9938  if (rIsPluralRing(currRing))
9939  {
9940    if ((p & NC_MASK)==NO_NC)
9941    {
9942      WerrorS("not implemented for non-commutative rings");
9943      return TRUE;
9944    }
9945    else if ((p & NC_MASK)==COMM_PLURAL)
9946    {
9947      Warn("assume commutative subalgebra for cmd `%s` in >>%s<<",Tok2Cmdname(op),my_yylinebuf);
9948      return FALSE;
9949    }
9950    /* else, ALLOW_PLURAL */
9951  }
9952  else if (rIsLPRing(currRing))
9953  {
9954    if ((p & ALLOW_LP)==0)
9955    {
9956      Werror("`%s` not implemented for letterplace rings in >>%s<<",Tok2Cmdname(op),my_yylinebuf);
9957      return TRUE;
9958    }
9959  }
9960  if (rField_is_Ring(currRing))
9961  {
9962    if ((p & RING_MASK)==0 /*NO_RING*/)
9963    {
9964      WerrorS("not implemented for rings with rings as coeffients");
9965      return TRUE;
9966    }
9967    /* else ALLOW_RING */
9968    else if (((p & ZERODIVISOR_MASK)==NO_ZERODIVISOR)
9969    &&(!rField_is_Domain(currRing)))
9970    {
9971      WerrorS("domain required as coeffients");
9972      return TRUE;
9973    }
9974    /* else ALLOW_ZERODIVISOR */
9975    else if(((p & WARN_RING)==WARN_RING)&&(myynest==0))
9976    {
9977      WarnS("considering the image in Q[...]");
9978    }
9979  }
9980  return FALSE;
9981}
9982// --------------------------------------------------------------------
9983static BOOLEAN jjCHINREM_ID(leftv res, leftv u, leftv v)
9984{
9985  if ((currRing!=NULL)
9986  && rField_is_Ring(currRing)
9987  && (!rField_is_Z(currRing)))
9988  {
9989    WerrorS("not implemented for rings with rings as coeffients (except ZZ)");
9990    return TRUE;
9991  }
9992  coeffs cf;
9993  lists c=(lists)u->CopyD(); // list of ideal or bigint/int
9994  int rl=c->nr+1;
9995  int return_type=c->m[0].Typ();
9996  if ((return_type!=IDEAL_CMD)
9997  && (return_type!=MODUL_CMD)
9998  && (return_type!=SMATRIX_CMD)
9999  && (return_type!=MATRIX_CMD)
10000  && (return_type!=POLY_CMD))
10001  {
10002    if((return_type==BIGINT_CMD)
10003    ||(return_type==INT_CMD))
10004      return_type=BIGINT_CMD;
10005    else if (return_type==LIST_CMD)
10006    {
10007      // create a tmp list of the correct size
10008      lists res_l=(lists)omAllocBin(slists_bin);
10009      res_l->Init(rl /*c->nr+1*/);
10010      BOOLEAN bo=FALSE;
10011      int tab_pos=iiTabIndex(dArithTab2,JJTAB2LEN,CHINREM_CMD);
10012      for (unsigned i=0;i<=(unsigned)c->nr;i++)
10013      {
10014        sleftv tmp;
10015        tmp.Copy(v);
10016        bo=iiExprArith2TabIntern(&res_l->m[i],&c->m[i],CHINREM_CMD,&tmp,TRUE,dArith2+tab_pos,c->m[i].rtyp,tmp.rtyp,dConvertTypes);
10017        if (bo) { Werror("chinrem failed for list entry %d",i+1); break;}
10018      }
10019      c->Clean();
10020      res->data=res_l;
10021      res->rtyp=LIST_CMD;
10022      return bo;
10023    }
10024    else
10025    {
10026      c->Clean();
10027      WerrorS("poly/ideal/module/matrix/list expected");
10028      return TRUE;
10029    }
10030  }
10031  if (return_type==BIGINT_CMD)
10032    cf=coeffs_BIGINT;
10033  else
10034  {
10035    cf=currRing->cf;
10036    if (nCoeff_is_Extension(cf) && (cf->extRing!=NULL))
10037      cf=cf->extRing->cf;
10038  }
10039  lists pl=NULL;
10040  intvec *p=NULL;
10041  if (v->Typ()==LIST_CMD)
10042  {
10043    pl=(lists)v->Data();
10044    if (pl->nr!=rl-1)
10045    {
10046      WerrorS("wromg number of primes");
10047      return TRUE;
10048    }
10049  }
10050  else
10051  {
10052    p=(intvec*)v->Data();
10053    if (p->length()!=rl)
10054    {
10055      WerrorS("wromg number of primes");
10056      return TRUE;
10057    }
10058  }
10059  ideal result;
10060  ideal *x=(ideal *)omAlloc(rl*sizeof(ideal));
10061  number *xx=NULL;
10062  nMapFunc nMap=n_SetMap(coeffs_BIGINT,cf);
10063  int i;
10064  if (return_type!=BIGINT_CMD)
10065  {
10066    for(i=rl-1;i>=0;i--)
10067    {
10068      if (c->m[i].Typ()!=return_type)
10069      {
10070        Werror("%s expected at pos %d",Tok2Cmdname(return_type),i+1);
10071        omFree(x); // delete c
10072        return TRUE;
10073      }
10074      if (return_type==POLY_CMD)
10075      {
10076        x[i]=idInit(1,1);
10077        x[i]->m[0]=(poly)c->m[i].CopyD();
10078      }
10079      else
10080      {
10081        x[i]=(ideal)c->m[i].CopyD();
10082      }
10083      //c->m[i].Init();
10084    }
10085  }
10086  else
10087  {
10088    if (nMap==NULL)
10089    {
10090      Werror("not implemented: map bigint -> %s", nCoeffName(cf));
10091      return TRUE;
10092    }
10093    xx=(number *)omAlloc(rl*sizeof(number));
10094    for(i=rl-1;i>=0;i--)
10095    {
10096      if (c->m[i].Typ()==INT_CMD)
10097      {
10098        xx[i]=n_Init(((int)(long)c->m[i].Data()),cf);
10099      }
10100      else if (c->m[i].Typ()==BIGINT_CMD)
10101      {
10102        xx[i]=nMap((number)c->m[i].Data(),coeffs_BIGINT,cf);
10103      }
10104      else
10105      {
10106        Werror("bigint expected at pos %d",i+1);
10107        omFree(x); // delete c
10108        omFree(xx); // delete c
10109        return TRUE;
10110      }
10111    }
10112  }
10113  number *q=(number *)omAlloc(rl*sizeof(number));
10114  if (p!=NULL)
10115  {
10116    for(i=rl-1;i>=0;i--)
10117    {
10118      q[i]=n_Init((*p)[i], cf);
10119    }
10120  }
10121  else
10122  {
10123    for(i=rl-1;i>=0;i--)
10124    {
10125      if (pl->m[i].Typ()==INT_CMD)
10126      {
10127        q[i]=n_Init((int)(long)pl->m[i].Data(),cf);
10128      }
10129      else if (pl->m[i].Typ()==BIGINT_CMD)
10130      {
10131        q[i]=nMap((number)(pl->m[i].Data()),coeffs_BIGINT,cf);
10132      }
10133      else
10134      {
10135        Werror("bigint expected at pos %d",i+1);
10136        for(i++;i<rl;i++)
10137        {
10138          n_Delete(&(q[i]),cf);
10139        }
10140        omFree(x); // delete c
10141        omFree(q); // delete pl
10142        if (xx!=NULL) omFree(xx); // delete c
10143        return TRUE;
10144      }
10145    }
10146  }
10147  if (return_type==BIGINT_CMD)
10148  {
10149    CFArray i_v(rl);
10150    number n=n_ChineseRemainderSym(xx,q,rl,TRUE,i_v,coeffs_BIGINT);
10151    res->data=(char *)n;
10152  }
10153  else
10154  {
10155    #if 0
10156    #ifdef HAVE_VSPACE
10157    int cpus = (long) feOptValue(FE_OPT_CPUS);
10158    if ((cpus>1) && (rField_is_Q(currRing)))
10159      result=id_ChineseRemainder_0(x,q,rl,currRing); // deletes also x
10160    else
10161    #endif
10162    #endif
10163      result=id_ChineseRemainder(x,q,rl,currRing); // deletes also x
10164    c->Clean();
10165    if ((return_type==POLY_CMD) &&(result!=NULL))
10166    {
10167      res->data=(char *)result->m[0];
10168      result->m[0]=NULL;
10169      idDelete(&result);
10170    }
10171    else
10172      res->data=(char *)result;
10173  }
10174  for(i=rl-1;i>=0;i--)
10175  {
10176    n_Delete(&(q[i]),cf);
10177  }
10178  omFree(q);
10179  res->rtyp=return_type;
10180  return result==NULL;
10181}
10182static BOOLEAN jjFAREY_LI(leftv res, leftv u, leftv v)
10183{
10184  lists c=(lists)u->CopyD();
10185  lists res_l=(lists)omAllocBin(slists_bin);
10186  res_l->Init(c->nr+1);
10187  BOOLEAN bo=FALSE;
10188  int tab_pos=iiTabIndex(dArithTab2,JJTAB2LEN,FAREY_CMD);
10189  for (unsigned i=0;i<=(unsigned)c->nr;i++)
10190  {
10191    sleftv tmp;
10192    tmp.Copy(v);
10193    bo=iiExprArith2TabIntern(&res_l->m[i],&c->m[i],FAREY_CMD,&tmp,TRUE,dArith2+tab_pos,c->m[i].rtyp,tmp.rtyp,dConvertTypes);
10194    if (bo) { Werror("farey failed for list entry %d",i+1); break;}
10195  }
10196  c->Clean();
10197  res->data=res_l;
10198  return bo;
10199}
10200// --------------------------------------------------------------------
10201static int jjCOMPARE_ALL(const void * aa, const void * bb)
10202{
10203  leftv a=(leftv)aa;
10204  int at=a->Typ();
10205  leftv b=(leftv)bb;
10206  int bt=b->Typ();
10207  if (at < bt) return -1;
10208  if (at > bt) return 1;
10209  int tab_pos=iiTabIndex(dArithTab2,JJTAB2LEN,'<');
10210  sleftv tmp;
10211  tmp.Init();
10212  iiOp='<';
10213  BOOLEAN bo=iiExprArith2TabIntern(&tmp,a,'<',b,FALSE,dArith2+tab_pos,at,bt,dConvertTypes);
10214  if (bo)
10215  {
10216    Werror(" no `<` for %s",Tok2Cmdname(at));
10217    unsigned long ad=(unsigned long)a->Data();
10218    unsigned long bd=(unsigned long)b->Data();
10219    if (ad<bd) return -1;
10220    else if (ad==bd) return 0;
10221    else return 1;
10222  }
10223  else if (tmp.data==NULL) /* not < */
10224  {
10225    iiOp=EQUAL_EQUAL;
10226    tab_pos=iiTabIndex(dArithTab2,JJTAB2LEN,EQUAL_EQUAL);
10227    bo=iiExprArith2TabIntern(&tmp,a,EQUAL_EQUAL,b,FALSE,dArith2+tab_pos,at,bt,dConvertTypes);
10228    if (bo)
10229    {
10230      Werror(" no `==` for %s",Tok2Cmdname(at));
10231      unsigned long ad=(unsigned long)a->Data();
10232      unsigned long bd=(unsigned long)b->Data();
10233      if (ad<bd) return -1;
10234      else if (ad==bd) return 0;
10235      else return 1;
10236    }
10237    else if (tmp.data==NULL) /* not <,== */ return 1;
10238    else return 0;
10239  }
10240  else return -1;
10241}
10242BOOLEAN jjSORTLIST(leftv, leftv arg)
10243{
10244  lists l=(lists)arg->Data();
10245  if (l->nr>0)
10246  {
10247    qsort(l->m,l->nr+1,sizeof(sleftv),jjCOMPARE_ALL);
10248  }
10249  return FALSE;
10250}
10251BOOLEAN jjUNIQLIST(leftv, leftv arg)
10252{
10253  lists l=(lists)arg->Data();
10254  if (l->nr>0)
10255  {
10256    qsort(l->m,l->nr+1,sizeof(sleftv),jjCOMPARE_ALL);
10257    int i, j, len;
10258    len=l->nr;
10259    i=0;
10260    while(i<len)
10261    {
10262      if(jjCOMPARE_ALL(&(l->m[i]),&(l->m[i+1]))==0)
10263      {
10264        l->m[i].CleanUp();
10265        for(j=i; j<len;j++) l->m[j]=l->m[j+1];
10266        memset(&(l->m[len]),0,sizeof(sleftv));
10267        l->m[len].rtyp=DEF_CMD;
10268        len--;
10269      }
10270      else
10271        i++;
10272    }
10273    //Print("new len:%d\n",len);
10274  }
10275  return FALSE;
10276}
Note: See TracBrowser for help on using the repository browser.