source: git/Singular/iparith.cc @ da5d77

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