source: git/Singular/iparith.cc @ 762407

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