source: git/Singular/iparith.cc @ 487594

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