source: git/Singular/iparith.cc @ c4d065

jengelh-datetimespielwiese
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