source: git/Singular/iparith.cc @ ea4f38

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