source: git/Singular/iparith.cc @ a1ef3a2

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