source: git/Singular/iparith.cc @ 5d51cc6

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