source: git/Singular/iparith.cc @ 33b097

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