source: git/Singular/iparith.cc @ bd9890

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