source: git/Singular/iparith.cc @ c4d065

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