source: git/Singular/iparith.cc @ 317eb8

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