source: git/Singular/iparith.cc @ fb8ba27

jengelh-datetimespielwiese
Last change on this file since fb8ba27 was fb8ba27, checked in by Hans Schoenemann <hannes@…>, 13 years ago
subtraction of int for 64bit git-svn-id: file:///usr/local/Singular/svn/trunk@13662 2c84dea3-7e68-4137-9b89-c4e89433aadc
  • Property mode set to 100644
File size: 226.1 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 jjGETPROPC(leftv res, leftv u, leftv v)
3478{
3479  /* method for retrieving cone properties;
3480     valid parametrizations: (cone, string),
3481     Errors will be invoked in the following cases:
3482     - invalid property string (see below for valid ones) */
3483  gfan::ZCone* zc = (gfan::ZCone*)u->Data();
3484  char* prop = (char*)v->Data();
3485  gfan::ZMatrix retMat;
3486  gfan::ZCone retCone;
3487  int retInt;
3488  gfan::ZVector retVec;
3489  int typeInfo;
3490
3491  /* ################ properties with return type intmat: ################## */
3492  if      (strcmp(prop, "INEQUALITIES") == 0)
3493  {
3494    retMat = zc->getInequalities();
3495    typeInfo = INTMAT_CMD;
3496  }
3497  else if (strcmp(prop, "EQUATIONS") == 0)
3498  {
3499    retMat = zc->getEquations();
3500    typeInfo = INTMAT_CMD;
3501  }
3502  else if (strcmp(prop, "FACETS") == 0)
3503  {
3504    retMat = zc->getFacets();
3505    typeInfo = INTMAT_CMD;
3506  }
3507  else if (strcmp(prop, "IMPLIED_EQUATIONS") == 0)
3508  {
3509    retMat = zc->getImpliedEquations();
3510    typeInfo = INTMAT_CMD;
3511  }
3512  else if (strcmp(prop, "GENERATORS_OF_SPAN") == 0)
3513  {
3514    retMat = zc->generatorsOfSpan();
3515    typeInfo = INTMAT_CMD;
3516  }
3517  else if (strcmp(prop, "GENERATORS_OF_LINEALITY_SPACE") == 0)
3518  {
3519    retMat = zc->generatorsOfLinealitySpace();
3520    typeInfo = INTMAT_CMD;
3521  }
3522  else if (strcmp(prop, "RAYS") == 0)
3523  {
3524    retMat = zc->extremeRays();
3525    typeInfo = INTMAT_CMD;
3526  }
3527  else if (strcmp(prop, "QUOTIENT_LATTICE_BASIS") == 0)
3528  {
3529    retMat = zc->quotientLatticeBasis();
3530    typeInfo = INTMAT_CMD;
3531  }
3532  else if (strcmp(prop, "LINEAR_FORMS") == 0)
3533  {
3534    retMat = zc->getLinearForms();
3535    typeInfo = INTMAT_CMD;
3536  }
3537  /* ################ properties with return type int: ################## */
3538  else if (strcmp(prop, "AMBIENT_DIM") == 0)
3539  {
3540    retInt = zc->ambientDimension();
3541    typeInfo = INT_CMD;
3542  }
3543  else if (strcmp(prop, "DIM") == 0)
3544  {
3545    retInt = zc->dimension();
3546    typeInfo = INT_CMD;
3547  }
3548  else if (strcmp(prop, "LINEALITY_DIM") == 0)
3549  {
3550    retInt = zc->dimensionOfLinealitySpace();
3551    typeInfo = INT_CMD;
3552  }
3553  else if (strcmp(prop, "MULTIPLICITY") == 0)
3554  {
3555    bool ok = true;
3556    retInt = integerToInt(zc->getMultiplicity(), ok);
3557    if (!ok)
3558      WerrorS("overflow while converting a gfan::Integer to an int");
3559    typeInfo = INT_CMD;
3560  }
3561  else if (strcmp(prop, "IS_ORIGIN") == 0)
3562  {
3563    retInt = zc->isOrigin() ? 1 : 0;
3564    typeInfo = INT_CMD;
3565  }
3566  else if (strcmp(prop, "IS_FULL_SPACE") == 0)
3567  {
3568    retInt = zc->isFullSpace() ? 1 : 0;
3569    typeInfo = INT_CMD;
3570  }
3571  else if (strcmp(prop, "SIMPLICIAL") == 0)
3572  {
3573    retInt = zc->isSimplicial() ? 1 : 0;
3574    typeInfo = INT_CMD;
3575  }
3576  else if (strcmp(prop, "CONTAINS_POSITIVE_VECTOR") == 0)
3577  {
3578    retInt = zc->containsPositiveVector() ? 1 : 0;
3579    typeInfo = INT_CMD;
3580  }
3581  /* ################ properties with return type ZCone: ################## */
3582  else if (strcmp(prop, "LINEALITY_SPACE") == 0)
3583  {
3584    retCone = zc->linealitySpace();
3585    typeInfo = CONE_CMD;
3586  }
3587  else if (strcmp(prop, "DUAL_CONE") == 0)
3588  {
3589    retCone = zc->dualCone();
3590    typeInfo = CONE_CMD;
3591  }
3592  else if (strcmp(prop, "NEGATED") == 0)
3593  {
3594    retCone = zc->negated();
3595    typeInfo = CONE_CMD;
3596  }
3597  /* ################ properties with return type intvec: ################## */
3598  else if (strcmp(prop, "SEMI_GROUP_GENERATOR") == 0)
3599  {
3600    /* test whether the cone's dim = dim of lin space + 1: */
3601    int d = zc->dimension();
3602    int dLS = zc->dimensionOfLinealitySpace();
3603    if (d == dLS + 1)
3604      retVec = zc->semiGroupGeneratorOfRay();
3605    else
3606    {
3607      Werror("expected dim of cone one larger than dim of lin space\n"
3608             "but got dimensions %d and %d", d, dLS);
3609    }
3610    typeInfo = INTVEC_CMD;
3611  }
3612  else if (strcmp(prop, "RELATIVE_INTERIOR_POINT") == 0)
3613  {
3614    retVec = zc->getRelativeInteriorPoint();
3615    typeInfo = INTVEC_CMD;
3616  }
3617  else if (strcmp(prop, "UNIQUE_POINT") == 0)
3618  {
3619    retVec = zc->getUniquePoint();
3620    typeInfo = INTVEC_CMD;
3621  }
3622  else
3623  {
3624    Werror("unexpected cone property '%s'", prop);
3625    return TRUE;
3626  }
3627
3628  res->rtyp = typeInfo;
3629  switch(typeInfo)
3630  {
3631    case INTMAT_CMD:
3632      res->data = (void*)zMatrix2Intvec(retMat);
3633      break;
3634    case INT_CMD:
3635      res->data = (void*)retInt;
3636      break;
3637    case CONE_CMD:
3638      res->data = (void*)new gfan::ZCone(retCone);
3639      break;
3640    case INTVEC_CMD:
3641      res->data = (void*)zVector2Intvec(retVec);
3642      break;
3643    default: ; /* should never be reached */
3644  }
3645  return FALSE;
3646}
3647/*
3648static BOOLEAN jjADJACENCY2(leftv res, leftv u, leftv v)
3649{
3650  /* method for retrieving all maximal cones in the given fan that
3651     are adjacent to a given maximal cone;
3652     valid parametrizations: (fan, int),
3653     Errors will be invoked in the following cases:
3654     - the maximal cone index is out of range [0..m-1],
3655       where m is the number of maximal cones in the given fan;
3656     In case there are no neighbours (yet) of the specified maximal
3657     cone, the method returns an intvec of length one with entry zero. */
3658/*  Fan* f = (Fan*)u->Data();
3659  int maxCone = (int)(long)v->Data();
3660  int nMaxCones = f->getNumberOfMaxCones();
3661  if ((maxCone < 0) || (nMaxCones <= maxCone))
3662  {
3663    Werror("index %d out of range [0..%d]",
3664           maxCone, nMaxCones - 1);
3665    return TRUE;
3666  }
3667  intvec* result = f->getAdjacency(maxCone);
3668  result = ivCopy(result);
3669  res->data = (char*)result;
3670  return FALSE;
3671}*/
3672#endif /* HAVE_FANS */
3673static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3674{
3675  idhdl h=(idhdl)u->data;
3676  int i=(int)(long)v->Data();
3677  if ((0<i) && (i<=IDRING(h)->N))
3678    res->data=omStrDup(IDRING(h)->names[i-1]);
3679  else
3680  {
3681    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3682    return TRUE;
3683  }
3684  return FALSE;
3685}
3686static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3687{
3688  lists Lforks = (lists)u->Data();
3689  int t = (int)(long)v->Data();
3690  int i = slStatusSsiL(Lforks, t*1000);
3691  if ( i < 0 ) i = 0;
3692  res->data = (void*)(long)i;
3693  return FALSE;
3694}
3695static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3696{
3697/* returns 1 iff all forks are finished; 0 otherwise */
3698  lists Lforks = (lists)u->Data();
3699  int timeout = 1000*(int)(long)v->Data();
3700  lists oneFork=(lists)omAllocBin(slists_bin);
3701  oneFork->Init(1);
3702  int i;
3703  int t = getTimer();
3704  int ret = 1;
3705  for (int j = 0; j <= Lforks->nr; j++)
3706  {
3707    oneFork->m[0].Copy(&Lforks->m[j]);
3708    i = slStatusSsiL(oneFork, timeout);
3709    if (i == 1)
3710    {
3711      timeout = timeout - getTimer() + t;
3712    }
3713    else { ret = 0; j = Lforks->nr+1; /* terminate the for loop */ }
3714    omFreeSize((ADDRESS)oneFork->m,sizeof(sleftv));
3715  }
3716  omFreeBin((ADDRESS)oneFork, slists_bin);
3717  res->data = (void*)(long)ret;
3718  return FALSE;
3719}
3720static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3721{
3722  res->data = (char *)mpWedge((matrix)u->Data(),(int)(long)v->Data());
3723  return FALSE;
3724}
3725#define jjWRONG2 (proc2)jjWRONG
3726#define jjWRONG3 (proc3)jjWRONG
3727static BOOLEAN jjWRONG(leftv res, leftv u)
3728{
3729  return TRUE;
3730}
3731
3732/*=================== operations with 1 arg.: static proc =================*/
3733/* must be ordered: first operations for chars (infix ops),
3734 * then alphabetically */
3735
3736static BOOLEAN jjDUMMY(leftv res, leftv u)
3737{
3738  res->data = (char *)u->CopyD();
3739  return FALSE;
3740}
3741static BOOLEAN jjNULL(leftv res, leftv u)
3742{
3743  return FALSE;
3744}
3745//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3746//{
3747//  res->data = (char *)((int)(long)u->Data()+1);
3748//  return FALSE;
3749//}
3750//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3751//{
3752//  res->data = (char *)((int)(long)u->Data()-1);
3753//  return FALSE;
3754//}
3755static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3756{
3757  if (IDTYP((idhdl)u->data)==INT_CMD)
3758  {
3759    int i=IDINT((idhdl)u->data);
3760    if (iiOp==PLUSPLUS) i++;
3761    else                i--;
3762    IDDATA((idhdl)u->data)=(char *)(long)i;
3763    return FALSE;
3764  }
3765  return TRUE;
3766}
3767static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3768{
3769  number n=(number)u->CopyD(BIGINT_CMD);
3770  n=nlNeg(n);
3771  res->data = (char *)n;
3772  return FALSE;
3773}
3774static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3775{
3776  res->data = (char *)(-(long)u->Data());
3777  return FALSE;
3778}
3779static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3780{
3781  number n=(number)u->CopyD(NUMBER_CMD);
3782  n=nNeg(n);
3783  res->data = (char *)n;
3784  return FALSE;
3785}
3786static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3787{
3788  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3789  return FALSE;
3790}
3791static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3792{
3793  poly m1=pISet(-1);
3794  res->data = (char *)mpMultP((matrix)u->CopyD(MATRIX_CMD),m1);
3795  return FALSE;
3796}
3797static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3798{
3799  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3800  (*iv)*=(-1);
3801  res->data = (char *)iv;
3802  return FALSE;
3803}
3804static BOOLEAN jjPROC1(leftv res, leftv u)
3805{
3806  return jjPROC(res,u,NULL);
3807}
3808static BOOLEAN jjBAREISS(leftv res, leftv v)
3809{
3810  //matrix m=(matrix)v->Data();
3811  //lists l=mpBareiss(m,FALSE);
3812  intvec *iv;
3813  ideal m;
3814  smCallBareiss((ideal)v->Data(),0,0,m,&iv);
3815  lists l=(lists)omAllocBin(slists_bin);
3816  l->Init(2);
3817  l->m[0].rtyp=MODUL_CMD;
3818  l->m[1].rtyp=INTVEC_CMD;
3819  l->m[0].data=(void *)m;
3820  l->m[1].data=(void *)iv;
3821  res->data = (char *)l;
3822  return FALSE;
3823}
3824//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3825//{
3826//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3827//  ivTriangMat(m);
3828//  res->data = (char *)m;
3829//  return FALSE;
3830//}
3831static BOOLEAN jjBI2N(leftv res, leftv u)
3832{
3833  if (rField_is_Q())
3834  {
3835    res->data=u->CopyD();
3836    return FALSE;
3837  }
3838  else
3839  {
3840    BOOLEAN bo=FALSE;
3841    number n=(number)u->CopyD();
3842    if (rField_is_Zp())
3843    {
3844      res->data=(void *)npMap0(n);
3845    }
3846    else if (rField_is_Q_a())
3847    {
3848      res->data=(void *)naMap00(n);
3849    }
3850    else if (rField_is_Zp_a())
3851    {
3852      res->data=(void *)naMap0P(n);
3853    }
3854#ifdef HAVE_RINGS
3855    else if (rField_is_Ring_Z())
3856    {
3857      res->data=(void *)nrzMapQ(n);
3858    }
3859    else if (rField_is_Ring_ModN())
3860    {
3861      res->data=(void *)nrnMapQ(n);
3862    }
3863    else if (rField_is_Ring_PtoM())
3864    {
3865      res->data=(void *)nrnMapQ(n);
3866    }
3867    else if (rField_is_Ring_2toM())
3868    {
3869      res->data=(void *)nr2mMapQ(n);
3870    }
3871#endif
3872    else
3873    {
3874      WerrorS("cannot convert bigint to this field");
3875      bo=TRUE;
3876    }
3877    nlDelete(&n,NULL);
3878    return bo;
3879  }
3880}
3881static BOOLEAN jjBI2P(leftv res, leftv u)
3882{
3883  sleftv tmp;
3884  BOOLEAN bo=jjBI2N(&tmp,u);
3885  if (!bo)
3886  {
3887    number n=(number) tmp.data;
3888    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3889    else
3890    {
3891      res->data=(void *)pNSet(n);
3892    }
3893  }
3894  return bo;
3895}
3896static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3897{
3898  return iiExprArithM(res,u,iiOp);
3899}
3900static BOOLEAN jjCHAR(leftv res, leftv v)
3901{
3902  res->data = (char *)(long)rChar((ring)v->Data());
3903  return FALSE;
3904}
3905static BOOLEAN jjCOLS(leftv res, leftv v)
3906{
3907  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3908  return FALSE;
3909}
3910static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3911{
3912  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3913  return FALSE;
3914}
3915static BOOLEAN jjCONTENT(leftv res, leftv v)
3916{
3917  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3918  poly p=(poly)v->CopyD(POLY_CMD);
3919  if (p!=NULL) p_Cleardenom(p, currRing);
3920  res->data = (char *)p;
3921  return FALSE;
3922}
3923static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3924{
3925  res->data = (char *)(long)nlSize((number)v->Data());
3926  return FALSE;
3927}
3928static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3929{
3930  res->data = (char *)(long)nSize((number)v->Data());
3931  return FALSE;
3932}
3933static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3934{
3935  lists l=(lists)v->Data();
3936  res->data = (char *)(long)(l->nr+1);
3937  return FALSE;
3938}
3939static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3940{
3941  matrix m=(matrix)v->Data();
3942  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3943  return FALSE;
3944}
3945static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3946{
3947  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3948  return FALSE;
3949}
3950static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3951{
3952  ring r=(ring)v->Data();
3953  int elems=-1;
3954  if (rField_is_Zp(r)||rField_is_GF(r)) elems=rInternalChar(r);
3955  else if (rField_is_Zp_a(r) && (r->minpoly!=NULL))
3956  {
3957#ifdef HAVE_FACTORY
3958    extern int ipower ( int b, int n ); /* factory/cf_util */
3959    elems=ipower(ABS(rInternalChar(r)),naParDeg(r->minpoly));
3960#else
3961    elems=(int)pow(ABS((double) rInternalChar(r)),(double)naParDeg(r->minpoly));
3962#endif
3963  }
3964  res->data = (char *)(long)elems;
3965  return FALSE;
3966}
3967static BOOLEAN jjDEG(leftv res, leftv v)
3968{
3969  int dummy;
3970  poly p=(poly)v->Data();
3971  if (p!=NULL) res->data = (char *)pLDeg(p,&dummy,currRing);
3972  else res->data=(char *)-1;
3973  return FALSE;
3974}
3975static BOOLEAN jjDEG_M(leftv res, leftv u)
3976{
3977  ideal I=(ideal)u->Data();
3978  int d=-1;
3979  int dummy;
3980  int i;
3981  for(i=IDELEMS(I)-1;i>=0;i--)
3982    if (I->m[i]!=NULL) d=si_max(d,(int)pLDeg(I->m[i],&dummy,currRing));
3983  res->data = (char *)(long)d;
3984  return FALSE;
3985}
3986static BOOLEAN jjDEGREE(leftv res, leftv v)
3987{
3988  assumeStdFlag(v);
3989  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3990  scDegree((ideal)v->Data(),module_w,currQuotient);
3991  return FALSE;
3992}
3993static BOOLEAN jjDEFINED(leftv res, leftv v)
3994{
3995  if ((v->rtyp==IDHDL)
3996  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3997  {
3998    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3999  }
4000  else if (v->rtyp!=0) res->data=(void *)(-1);
4001  return FALSE;
4002}
4003#ifdef HAVE_FACTORY
4004static BOOLEAN jjDET(leftv res, leftv v)
4005{
4006  matrix m=(matrix)v->Data();
4007  poly p;
4008  if (smCheckDet((ideal)m,m->cols(),TRUE))
4009  {
4010    ideal I=idMatrix2Module(mpCopy(m));
4011    p=smCallDet(I);
4012    idDelete(&I);
4013  }
4014  else
4015    p=singclap_det(m);
4016  res ->data = (char *)p;
4017  return FALSE;
4018}
4019static BOOLEAN jjDET_I(leftv res, leftv v)
4020{
4021  intvec * m=(intvec*)v->Data();
4022  int i,j;
4023  i=m->rows();j=m->cols();
4024  if(i==j)
4025    res->data = (char *)(long)singclap_det_i(m);
4026  else
4027  {
4028    Werror("det of %d x %d intmat",i,j);
4029    return TRUE;
4030  }
4031  return FALSE;
4032}
4033static BOOLEAN jjDET_S(leftv res, leftv v)
4034{
4035  ideal I=(ideal)v->Data();
4036  poly p;
4037  if (IDELEMS(I)<1) return TRUE;
4038  if (smCheckDet(I,IDELEMS(I),FALSE))
4039  {
4040    matrix m=idModule2Matrix(idCopy(I));
4041    p=singclap_det(m);
4042    idDelete((ideal *)&m);
4043  }
4044  else
4045    p=smCallDet(I);
4046  res->data = (char *)p;
4047  return FALSE;
4048}
4049#endif
4050static BOOLEAN jjDIM(leftv res, leftv v)
4051{
4052  assumeStdFlag(v);
4053  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currQuotient);
4054  return FALSE;
4055}
4056static BOOLEAN jjDUMP(leftv res, leftv v)
4057{
4058  si_link l = (si_link)v->Data();
4059  if (slDump(l))
4060  {
4061    const char *s;
4062    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4063    else                            s=sNoName;
4064    Werror("cannot dump to `%s`",s);
4065    return TRUE;
4066  }
4067  else
4068    return FALSE;
4069}
4070static BOOLEAN jjE(leftv res, leftv v)
4071{
4072  res->data = (char *)pOne();
4073  int co=(int)(long)v->Data();
4074  if (co>0)
4075  {
4076    pSetComp((poly)res->data,co);
4077    pSetm((poly)res->data);
4078  }
4079  else WerrorS("argument of gen must be positive");
4080  return (co<=0);
4081}
4082static BOOLEAN jjEXECUTE(leftv res, leftv v)
4083{
4084  char * d = (char *)v->Data();
4085  char * s = (char *)omAlloc(strlen(d) + 13);
4086  strcpy( s, (char *)d);
4087  strcat( s, "\n;RETURN();\n");
4088  newBuffer(s,BT_execute);
4089  return yyparse();
4090}
4091#ifdef HAVE_FACTORY
4092static BOOLEAN jjFACSTD(leftv res, leftv v)
4093{
4094  ideal_list p,h;
4095  h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
4096  lists L=(lists)omAllocBin(slists_bin);
4097  if (h==NULL)
4098  {
4099    L->Init(1);
4100    L->m[0].data=(char *)idInit(0,1);
4101    L->m[0].rtyp=IDEAL_CMD;
4102  }
4103  else
4104  {
4105    p=h;
4106    int l=0;
4107    while (p!=NULL) { p=p->next;l++; }
4108    L->Init(l);
4109    l=0;
4110    while(h!=NULL)
4111    {
4112      L->m[l].data=(char *)h->d;
4113      L->m[l].rtyp=IDEAL_CMD;
4114      p=h->next;
4115      omFreeSize(h,sizeof(*h));
4116      h=p;
4117      l++;
4118    }
4119  }
4120  res->data=(void *)L;
4121  return FALSE;
4122}
4123static BOOLEAN jjFAC_P(leftv res, leftv u)
4124{
4125  intvec *v=NULL;
4126  singclap_factorize_retry=0;
4127  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0);
4128  if (f==NULL) return TRUE;
4129  ivTest(v);
4130  lists l=(lists)omAllocBin(slists_bin);
4131  l->Init(2);
4132  l->m[0].rtyp=IDEAL_CMD;
4133  l->m[0].data=(void *)f;
4134  l->m[1].rtyp=INTVEC_CMD;
4135  l->m[1].data=(void *)v;
4136  res->data=(void *)l;
4137  return FALSE;
4138}
4139#endif
4140static BOOLEAN jjGETDUMP(leftv res, leftv v)
4141{
4142  si_link l = (si_link)v->Data();
4143  if (slGetDump(l))
4144  {
4145    const char *s;
4146    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4147    else                            s=sNoName;
4148    Werror("cannot get dump from `%s`",s);
4149    return TRUE;
4150  }
4151  else
4152    return FALSE;
4153}
4154static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
4155{
4156  assumeStdFlag(v);
4157  ideal I=(ideal)v->Data();
4158  res->data=(void *)iiHighCorner(I,0);
4159  return FALSE;
4160}
4161static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
4162{
4163  assumeStdFlag(v);
4164  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4165  BOOLEAN delete_w=FALSE;
4166  ideal I=(ideal)v->Data();
4167  int i;
4168  poly p=NULL,po=NULL;
4169  int rk=idRankFreeModule(I);
4170  if (w==NULL)
4171  {
4172    w = new intvec(rk);
4173    delete_w=TRUE;
4174  }
4175  for(i=rk;i>0;i--)
4176  {
4177    p=iiHighCorner(I,i);
4178    if (p==NULL)
4179    {
4180      WerrorS("module must be zero-dimensional");
4181      if (delete_w) delete w;
4182      return TRUE;
4183    }
4184    if (po==NULL)
4185    {
4186      po=p;
4187    }
4188    else
4189    {
4190      // now po!=NULL, p!=NULL
4191      int d=(pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - pFDeg(p,currRing)+(*w)[i-1]);
4192      if (d==0)
4193        d=pLmCmp(po,p);
4194      if (d > 0)
4195      {
4196        pDelete(&p);
4197      }
4198      else // (d < 0)
4199      {
4200        pDelete(&po); po=p;
4201      }
4202    }
4203  }
4204  if (delete_w) delete w;
4205  res->data=(void *)po;
4206  return FALSE;
4207}
4208static BOOLEAN jjHILBERT(leftv res, leftv v)
4209{
4210  assumeStdFlag(v);
4211  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4212  //scHilbertPoly((ideal)v->Data(),currQuotient);
4213  hLookSeries((ideal)v->Data(),module_w,currQuotient);
4214  return FALSE;
4215}
4216static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
4217{
4218  res->data=(void *)hSecondSeries((intvec *)v->Data());
4219  return FALSE;
4220}
4221static BOOLEAN jjHOMOG1(leftv res, leftv v)
4222{
4223  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4224  ideal v_id=(ideal)v->Data();
4225  if (w==NULL)
4226  {
4227    res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
4228    if (res->data!=NULL)
4229    {
4230      if (v->rtyp==IDHDL)
4231      {
4232        char *s_isHomog=omStrDup("isHomog");
4233        if (v->e==NULL)
4234          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
4235        else
4236          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
4237      }
4238      else if (w!=NULL) delete w;
4239    } // if res->data==NULL then w==NULL
4240  }
4241  else
4242  {
4243    res->data=(void *)(long)idTestHomModule(v_id,currQuotient,w);
4244    if((res->data==NULL) && (v->rtyp==IDHDL))
4245    {
4246      if (v->e==NULL)
4247        atKill((idhdl)(v->data),"isHomog");
4248      else
4249        atKill((idhdl)(v->LData()),"isHomog");
4250    }
4251  }
4252  return FALSE;
4253}
4254static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
4255{
4256  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
4257  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
4258  if (IDELEMS((ideal)mat)==0)
4259  {
4260    idDelete((ideal *)&mat);
4261    mat=(matrix)idInit(1,1);
4262  }
4263  else
4264  {
4265    MATROWS(mat)=1;
4266    mat->rank=1;
4267    idTest((ideal)mat);
4268  }
4269  res->data=(char *)mat;
4270  return FALSE;
4271}
4272static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4273{
4274  map m=(map)v->CopyD(MAP_CMD);
4275  omFree((ADDRESS)m->preimage);
4276  m->preimage=NULL;
4277  ideal I=(ideal)m;
4278  I->rank=1;
4279  res->data=(char *)I;
4280  return FALSE;
4281}
4282static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4283{
4284  if (currRing!=NULL)
4285  {
4286    ring q=(ring)v->Data();
4287    if (rSamePolyRep(currRing, q))
4288    {
4289      if (q->qideal==NULL)
4290        res->data=(char *)idInit(1,1);
4291      else
4292        res->data=(char *)idCopy(q->qideal);
4293      return FALSE;
4294    }
4295  }
4296  WerrorS("can only get ideal from identical qring");
4297  return TRUE;
4298}
4299static BOOLEAN jjIm2Iv(leftv res, leftv v)
4300{
4301  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4302  iv->makeVector();
4303  res->data = iv;
4304  return FALSE;
4305}
4306static BOOLEAN jjIMPART(leftv res, leftv v)
4307{
4308  res->data = (char *)nImPart((number)v->Data());
4309  return FALSE;
4310}
4311static BOOLEAN jjINDEPSET(leftv res, leftv v)
4312{
4313  assumeStdFlag(v);
4314  res->data=(void *)scIndIntvec((ideal)(v->Data()),currQuotient);
4315  return FALSE;
4316}
4317static BOOLEAN jjINTERRED(leftv res, leftv v)
4318{
4319  ideal result=kInterRed((ideal)(v->Data()), currQuotient);
4320  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4321  res->data = result;
4322  return FALSE;
4323}
4324static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4325{
4326  res->data = (char *)(long)pVar((poly)v->Data());
4327  return FALSE;
4328}
4329static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4330{
4331  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing)+1);
4332  return FALSE;
4333}
4334static BOOLEAN jjIS_RINGVAR0(leftv res, leftv v)
4335{
4336  res->data = (char *)0;
4337  return FALSE;
4338}
4339static BOOLEAN jjJACOB_P(leftv res, leftv v)
4340{
4341  ideal i=idInit(pVariables,1);
4342  int k;
4343  poly p=(poly)(v->Data());
4344  for (k=pVariables;k>0;k--)
4345  {
4346    i->m[k-1]=pDiff(p,k);
4347  }
4348  res->data = (char *)i;
4349  return FALSE;
4350}
4351/*2
4352 * compute Jacobi matrix of a module/matrix
4353 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(pVariables))  ),
4354 * where Mt := transpose(M)
4355 * Note that this is consistent with the current conventions for jacob in Singular,
4356 * whereas M2 computes its transposed.
4357 */
4358static BOOLEAN jjJACOB_M(leftv res, leftv a)
4359{
4360  ideal id = (ideal)a->Data();
4361  id = idTransp(id);
4362  int W = IDELEMS(id);
4363
4364  ideal result = idInit(W * pVariables, id->rank);
4365  poly *p = result->m;
4366
4367  for( int v = 1; v <= pVariables; v++ )
4368  {
4369    poly* q = id->m;
4370    for( int i = 0; i < W; i++, p++, q++ )
4371      *p = pDiff( *q, v );
4372  }
4373  idDelete(&id);
4374
4375  res->data = (char *)result;
4376  return FALSE;
4377}
4378
4379
4380static BOOLEAN jjKBASE(leftv res, leftv v)
4381{
4382  assumeStdFlag(v);
4383  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currQuotient);
4384  return FALSE;
4385}
4386#ifdef MDEBUG
4387static BOOLEAN jjpHead(leftv res, leftv v)
4388{
4389  res->data=(char *)pHead((poly)v->Data());
4390  return FALSE;
4391}
4392#endif
4393static BOOLEAN jjL2R(leftv res, leftv v)
4394{
4395  res->data=(char *)syConvList((lists)v->Data());
4396  if (res->data != NULL)
4397    return FALSE;
4398  else
4399    return TRUE;
4400}
4401static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4402{
4403  poly p=(poly)v->Data();
4404  if (p==NULL)
4405  {
4406    res->data=(char *)nInit(0);
4407  }
4408  else
4409  {
4410    res->data=(char *)nCopy(pGetCoeff(p));
4411  }
4412  return FALSE;
4413}
4414static BOOLEAN jjLEADEXP(leftv res, leftv v)
4415{
4416  poly p=(poly)v->Data();
4417  int s=pVariables;
4418  if (v->Typ()==VECTOR_CMD) s++;
4419  intvec *iv=new intvec(s);
4420  if (p!=NULL)
4421  {
4422    for(int i = pVariables;i;i--)
4423    {
4424      (*iv)[i-1]=pGetExp(p,i);
4425    }
4426    if (s!=pVariables)
4427      (*iv)[pVariables]=pGetComp(p);
4428  }
4429  res->data=(char *)iv;
4430  return FALSE;
4431}
4432static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4433{
4434  poly p=(poly)v->Data();
4435  if (p == NULL)
4436  {
4437    res->data = (char*) NULL;
4438  }
4439  else
4440  {
4441    poly lm = pLmInit(p);
4442    pSetCoeff(lm, nInit(1));
4443    res->data = (char*) lm;
4444  }
4445  return FALSE;
4446}
4447static BOOLEAN jjLOAD1(leftv res, leftv v)
4448{
4449  return jjLOAD(res, v,FALSE);
4450}
4451static BOOLEAN jjLISTRING(leftv res, leftv v)
4452{
4453  ring r=rCompose((lists)v->Data());
4454  if (r==NULL) return TRUE;
4455  if (r->qideal!=NULL) res->rtyp=QRING_CMD;
4456  res->data=(char *)r;
4457  return FALSE;
4458}
4459#if SIZEOF_LONG == 8
4460static number jjLONG2N(long d)
4461{
4462  int i=(int)d;
4463  if ((long)i == d)
4464  {
4465    return nlInit(i, NULL);
4466  }
4467  else
4468  {
4469#if !defined(OM_NDEBUG) && !defined(NDEBUG)
4470    omCheckBin(rnumber_bin);
4471#endif
4472    number z=(number)omAllocBin(rnumber_bin);
4473    #if defined(LDEBUG)
4474    z->debug=123456;
4475    #endif
4476    z->s=3;
4477    mpz_init_set_si(z->z,d);
4478    return z;
4479  }
4480}
4481#else
4482#define jjLONG2N(D) nlInit((int)D, NULL)
4483#endif
4484static BOOLEAN jjPFAC1(leftv res, leftv v)
4485{
4486  /* call method jjPFAC2 with second argument = 0 (meaning that no
4487     valid bound for the prime factors has been given) */
4488  sleftv tmp;
4489  memset(&tmp, 0, sizeof(tmp));
4490  tmp.rtyp = INT_CMD;
4491  return jjPFAC2(res, v, &tmp);
4492}
4493static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4494{
4495  /* computes the LU-decomposition of a matrix M;
4496     i.e., M = P * L * U, where
4497        - P is a row permutation matrix,
4498        - L is in lower triangular form,
4499        - U is in upper row echelon form
4500     Then, we also have P * M = L * U.
4501     A list [P, L, U] is returned. */
4502  matrix mat = (const matrix)v->Data();
4503  int rr = mat->rows();
4504  int cc = mat->cols();
4505  matrix pMat;
4506  matrix lMat;
4507  matrix uMat;
4508
4509  luDecomp(mat, pMat, lMat, uMat);
4510
4511  lists ll = (lists)omAllocBin(slists_bin);
4512  ll->Init(3);
4513  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4514  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4515  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4516  res->data=(char*)ll;
4517
4518  return FALSE;
4519}
4520static BOOLEAN jjMEMORY(leftv res, leftv v)
4521{
4522  omUpdateInfo();
4523  long d;
4524  switch(((int)(long)v->Data()))
4525  {
4526  case 0:
4527    res->data=(char *)jjLONG2N(om_Info.UsedBytes);
4528    break;
4529  case 1:
4530    res->data = (char *)jjLONG2N(om_Info.CurrentBytesSystem);
4531    break;
4532  case 2:
4533    res->data = (char *)jjLONG2N(om_Info.MaxBytesSystem);
4534    break;
4535  default:
4536    omPrintStats(stdout);
4537    omPrintInfo(stdout);
4538    omPrintBinStats(stdout);
4539    res->data = (char *)0;
4540    res->rtyp = NONE;
4541  }
4542  return FALSE;
4543  res->data = (char *)0;
4544  return FALSE;
4545}
4546//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4547//{
4548//  return jjMONITOR2(res,v,NULL);
4549//}
4550static BOOLEAN jjMSTD(leftv res, leftv v)
4551{
4552  int t=v->Typ();
4553  ideal r,m;
4554  r=kMin_std((ideal)v->Data(),currQuotient,testHomog,NULL,m);
4555  lists l=(lists)omAllocBin(slists_bin);
4556  l->Init(2);
4557  l->m[0].rtyp=t;
4558  l->m[0].data=(char *)r;
4559  setFlag(&(l->m[0]),FLAG_STD);
4560  l->m[1].rtyp=t;
4561  l->m[1].data=(char *)m;
4562  res->data=(char *)l;
4563  return FALSE;
4564}
4565static BOOLEAN jjMULT(leftv res, leftv v)
4566{
4567  assumeStdFlag(v);
4568  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currQuotient);
4569  return FALSE;
4570}
4571static BOOLEAN jjMINRES_R(leftv res, leftv v)
4572{
4573  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4574  res->data=(char *)syMinimize((syStrategy)v->Data());
4575  if (weights!=NULL)
4576    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4577  return FALSE;
4578}
4579static BOOLEAN jjN2BI(leftv res, leftv v)
4580{
4581  number n,i; i=(number)v->Data();
4582  if (rField_is_Zp())
4583  {
4584    n=nlInit(npInt(i,currRing),NULL);
4585  }
4586  else if (rField_is_Q()) n=nlBigInt(i);
4587#ifdef HAVE_RINGS
4588  else if (rField_is_Ring_Z() || rField_is_Ring_ModN() || rField_is_Ring_PtoM()) n=nlMapGMP(i);
4589  else if (rField_is_Ring_2toM()) n=nlInit((unsigned long) i,NULL);
4590#endif
4591  else goto err;
4592  res->data=(void *)n;
4593  return FALSE;
4594err:
4595  WerrorS("cannot convert to bigint"); return TRUE;
4596}
4597static BOOLEAN jjNAMEOF(leftv res, leftv v)
4598{
4599  res->data = (char *)v->name;
4600  if (res->data==NULL) res->data=omStrDup("");
4601  v->name=NULL;
4602  return FALSE;
4603}
4604static BOOLEAN jjNAMES(leftv res, leftv v)
4605{
4606  res->data=ipNameList(((ring)v->Data())->idroot);
4607  return FALSE;
4608}
4609static BOOLEAN jjNVARS(leftv res, leftv v)
4610{
4611  res->data = (char *)(long)(((ring)(v->Data()))->N);
4612  return FALSE;
4613}
4614static BOOLEAN jjOpenClose(leftv res, leftv v)
4615{
4616  si_link l=(si_link)v->Data();
4617  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4618  else                return slClose(l);
4619}
4620static BOOLEAN jjORD(leftv res, leftv v)
4621{
4622  poly p=(poly)v->Data();
4623  res->data=(char *)( p==NULL ? -1 : pFDeg(p,currRing) );
4624  return FALSE;
4625}
4626static BOOLEAN jjPAR1(leftv res, leftv v)
4627{
4628  int i=(int)(long)v->Data();
4629  int p=0;
4630  p=rPar(currRing);
4631  if ((0<i) && (i<=p))
4632  {
4633    res->data=(char *)nPar(i);
4634  }
4635  else
4636  {
4637    Werror("par number %d out of range 1..%d",i,p);
4638    return TRUE;
4639  }
4640  return FALSE;
4641}
4642static BOOLEAN jjPARDEG(leftv res, leftv v)
4643{
4644  res->data = (char *)(long)nParDeg((number)v->Data());
4645  return FALSE;
4646}
4647static BOOLEAN jjPARSTR1(leftv res, leftv v)
4648{
4649  if (currRing==NULL)
4650  {
4651    WerrorS("no ring active");
4652    return TRUE;
4653  }
4654  int i=(int)(long)v->Data();
4655  int p=0;
4656  if ((0<i) && (currRing->parameter!=NULL) && (i<=(p=rPar(currRing))))
4657    res->data=omStrDup(currRing->parameter[i-1]);
4658  else
4659  {
4660    Werror("par number %d out of range 1..%d",i,p);
4661    return TRUE;
4662  }
4663  return FALSE;
4664}
4665static BOOLEAN jjP2BI(leftv res, leftv v)
4666{
4667  poly p=(poly)v->Data();
4668  if (p==NULL) { res->data=(char *)nlInit(0,NULL); return FALSE; }
4669  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4670  {
4671    WerrorS("poly must be constant");
4672    return TRUE;
4673  }
4674  number i=pGetCoeff(p);
4675  number n;
4676  if (rField_is_Zp())
4677  {
4678    n=nlInit(npInt(i,currRing), NULL);
4679  }
4680  else if (rField_is_Q()) n=nlBigInt(i);
4681#ifdef HAVE_RINGS
4682  else if (rField_is_Ring_Z() || rField_is_Ring_ModN() || rField_is_Ring_PtoM())
4683    n=nlMapGMP(i);
4684  else if (rField_is_Ring_2toM())
4685    n=nlInit((unsigned long) i, NULL);
4686#endif
4687  else goto err;
4688  res->data=(void *)n;
4689  return FALSE;
4690err:
4691  WerrorS("cannot convert to bigint"); return TRUE;
4692}
4693static BOOLEAN jjP2I(leftv res, leftv v)
4694{
4695  poly p=(poly)v->Data();
4696  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4697  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4698  {
4699    WerrorS("poly must be constant");
4700    return TRUE;
4701  }
4702  res->data = (char *)(long)n_Int(pGetCoeff(p),currRing);
4703  return FALSE;
4704}
4705static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4706{
4707  map mapping=(map)v->Data();
4708  syMake(res,omStrDup(mapping->preimage));
4709  return FALSE;
4710}
4711static BOOLEAN jjPRIME(leftv res, leftv v)
4712{
4713  int i = IsPrime((int)(long)(v->Data()));
4714  res->data = (char *)(long)(i > 1 ? i : 2);
4715  return FALSE;
4716}
4717static BOOLEAN jjPRUNE(leftv res, leftv v)
4718{
4719  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4720  ideal v_id=(ideal)v->Data();
4721  if (w!=NULL)
4722  {
4723    if (!idTestHomModule(v_id,currQuotient,w))
4724    {
4725      WarnS("wrong weights");
4726      w=NULL;
4727      // and continue at the non-homog case below
4728    }
4729    else
4730    {
4731      w=ivCopy(w);
4732      intvec **ww=&w;
4733      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4734      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4735      return FALSE;
4736    }
4737  }
4738  res->data = (char *)idMinEmbedding(v_id);
4739  return FALSE;
4740}
4741static BOOLEAN jjP2N(leftv res, leftv v)
4742{
4743  number n;
4744  poly p;
4745  if (((p=(poly)v->Data())!=NULL)
4746  && (pIsConstant(p)))
4747  {
4748    n=nCopy(pGetCoeff(p));
4749  }
4750  else
4751  {
4752    n=nInit(0);
4753  }
4754  res->data = (char *)n;
4755  return FALSE;
4756}
4757static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4758{
4759  char *s= (char *)v->Data();
4760  int i = 1;
4761  int l = strlen(s);
4762  for(i=0; i<sArithBase.nCmdUsed; i++)
4763  {
4764    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4765    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4766    {
4767      res->data = (char *)1;
4768      return FALSE;
4769    }
4770  }
4771  //res->data = (char *)0;
4772  return FALSE;
4773}
4774static BOOLEAN jjRANK1(leftv res, leftv v)
4775{
4776  matrix m =(matrix)v->Data();
4777  int rank = luRank(m, 0);
4778  res->data =(char *)(long)rank;
4779  return FALSE;
4780}
4781static BOOLEAN jjREAD(leftv res, leftv v)
4782{
4783  return jjREAD2(res,v,NULL);
4784}
4785static BOOLEAN jjREGULARITY(leftv res, leftv v)
4786{
4787  res->data = (char *)(long)iiRegularity((lists)v->Data());
4788  return FALSE;
4789}
4790static BOOLEAN jjREPART(leftv res, leftv v)
4791{
4792  res->data = (char *)nRePart((number)v->Data());
4793  return FALSE;
4794}
4795static BOOLEAN jjRINGLIST(leftv res, leftv v)
4796{
4797  ring r=(ring)v->Data();
4798  if (r!=NULL)
4799    res->data = (char *)rDecompose((ring)v->Data());
4800  return (r==NULL)||(res->data==NULL);
4801}
4802static BOOLEAN jjROWS(leftv res, leftv v)
4803{
4804  ideal i = (ideal)v->Data();
4805  res->data = (char *)i->rank;
4806  return FALSE;
4807}
4808static BOOLEAN jjROWS_IV(leftv res, leftv v)
4809{
4810  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4811  return FALSE;
4812}
4813static BOOLEAN jjRPAR(leftv res, leftv v)
4814{
4815  res->data = (char *)(long)rPar(((ring)v->Data()));
4816  return FALSE;
4817}
4818static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4819{
4820#ifdef HAVE_PLURAL
4821  const bool bIsSCA = rIsSCA(currRing);
4822#else
4823  const bool bIsSCA = false;
4824#endif
4825
4826  if ((currQuotient!=NULL) && !bIsSCA)
4827  {
4828    WerrorS("qring not supported by slimgb at the moment");
4829    return TRUE;
4830  }
4831  if (rHasLocalOrMixedOrdering_currRing())
4832  {
4833    WerrorS("ordering must be global for slimgb");
4834    return TRUE;
4835  }
4836  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4837  tHomog hom=testHomog;
4838  ideal u_id=(ideal)u->Data();
4839  if (w!=NULL)
4840  {
4841    if (!idTestHomModule(u_id,currQuotient,w))
4842    {
4843      WarnS("wrong weights");
4844      w=NULL;
4845    }
4846    else
4847    {
4848      w=ivCopy(w);
4849      hom=isHomog;
4850    }
4851  }
4852
4853  assume(u_id->rank>=idRankFreeModule(u_id));
4854  res->data=(char *)t_rep_gb(currRing,
4855    u_id,u_id->rank);
4856  //res->data=(char *)t_rep_gb(currRing, u_id);
4857
4858  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4859  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4860  return FALSE;
4861}
4862static BOOLEAN jjSTD(leftv res, leftv v)
4863{
4864  ideal result;
4865  ideal v_id=(ideal)v->Data();
4866  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4867  tHomog hom=testHomog;
4868  if (w!=NULL)
4869  {
4870    if (!idTestHomModule(v_id,currQuotient,w))
4871    {
4872      WarnS("wrong weights");
4873      w=NULL;
4874    }
4875    else
4876    {
4877      hom=isHomog;
4878      w=ivCopy(w);
4879    }
4880  }
4881  result=kStd(v_id,currQuotient,hom,&w);
4882  idSkipZeroes(result);
4883  res->data = (char *)result;
4884  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4885  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4886  return FALSE;
4887}
4888static BOOLEAN jjSort_Id(leftv res, leftv v)
4889{
4890  res->data = (char *)idSort((ideal)v->Data());
4891  return FALSE;
4892}
4893#ifdef HAVE_FACTORY
4894extern int singclap_factorize_retry;
4895static BOOLEAN jjSQR_FREE(leftv res, leftv u)
4896{
4897  intvec *v=NULL;
4898  singclap_factorize_retry=0;
4899  ideal f=singclap_sqrfree((poly)(u->CopyD()));
4900  if (f==NULL)
4901    return TRUE;
4902  res->data=(void *)f;
4903  return FALSE;
4904}
4905#endif
4906#if 1
4907static BOOLEAN jjSYZYGY(leftv res, leftv v)
4908{
4909  intvec *w=NULL;
4910  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
4911  if (w!=NULL) delete w;
4912  return FALSE;
4913}
4914#else
4915// activate, if idSyz handle module weights correctly !
4916static BOOLEAN jjSYZYGY(leftv res, leftv v)
4917{
4918  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4919  ideal v_id=(ideal)v->Data();
4920  tHomog hom=testHomog;
4921  int add_row_shift=0;
4922  if (w!=NULL)
4923  {
4924    w=ivCopy(w);
4925    add_row_shift=w->min_in();
4926    (*w)-=add_row_shift;
4927    if (idTestHomModule(v_id,currQuotient,w))
4928      hom=isHomog;
4929    else
4930    {
4931      //WarnS("wrong weights");
4932      delete w; w=NULL;
4933      hom=testHomog;
4934    }
4935  }
4936  res->data = (char *)idSyzygies(v_id,hom,&w);
4937  if (w!=NULL)
4938  {
4939    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4940  }
4941  return FALSE;
4942}
4943#endif
4944static BOOLEAN jjTRACE_IV(leftv res, leftv v)
4945{
4946  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
4947  return FALSE;
4948}
4949static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
4950{
4951  res->data = (char *)ivTranp((intvec*)(v->Data()));
4952  return FALSE;
4953}
4954#ifdef HAVE_PLURAL
4955static BOOLEAN jjOPPOSITE(leftv res, leftv a)
4956{
4957  ring    r = (ring)a->Data();
4958  //if (rIsPluralRing(r))
4959  if (r->OrdSgn==1)
4960  {
4961    res->data = rOpposite(r);
4962  }
4963  else
4964  {
4965    WarnS("opposite only for global orderings");
4966    res->data = rCopy(r);
4967  }
4968  return FALSE;
4969}
4970static BOOLEAN jjENVELOPE(leftv res, leftv a)
4971{
4972  ring    r = (ring)a->Data();
4973  if (rIsPluralRing(r))
4974  {
4975    //    ideal   i;
4976//     if (a->rtyp == QRING_CMD)
4977//     {
4978//       i = r->qideal;
4979//       r->qideal = NULL;
4980//     }
4981    ring s = rEnvelope(r);
4982//     if (a->rtyp == QRING_CMD)
4983//     {
4984//       ideal is  = idOppose(r,i); /* twostd? */
4985//       is        = idAdd(is,i);
4986//       s->qideal = i;
4987//     }
4988    res->data = s;
4989  }
4990  else  res->data = rCopy(r);
4991  return FALSE;
4992}
4993static BOOLEAN jjTWOSTD(leftv res, leftv a)
4994{
4995  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
4996  else  res->data=(ideal)a->CopyD();
4997  setFlag(res,FLAG_STD);
4998  setFlag(res,FLAG_TWOSTD);
4999  return FALSE;
5000}
5001#endif
5002
5003static BOOLEAN jjTYPEOF(leftv res, leftv v)
5004{
5005  switch ((int)(long)v->data)
5006  {
5007    case INT_CMD:        res->data=omStrDup("int"); break;
5008    case POLY_CMD:       res->data=omStrDup("poly"); break;
5009    case VECTOR_CMD:     res->data=omStrDup("vector"); break;
5010    case STRING_CMD:     res->data=omStrDup("string"); break;
5011    case INTVEC_CMD:     res->data=omStrDup("intvec"); break;
5012    case IDEAL_CMD:      res->data=omStrDup("ideal"); break;
5013    case MATRIX_CMD:     res->data=omStrDup("matrix"); break;
5014    case MODUL_CMD:      res->data=omStrDup("module"); break;
5015    case MAP_CMD:        res->data=omStrDup("map"); break;
5016    case PROC_CMD:       res->data=omStrDup("proc"); break;
5017    case RING_CMD:       res->data=omStrDup("ring"); break;
5018    case QRING_CMD:      res->data=omStrDup("qring"); break;
5019    case INTMAT_CMD:     res->data=omStrDup("intmat"); break;
5020    case NUMBER_CMD:     res->data=omStrDup("number"); break;
5021    case BIGINT_CMD:     res->data=omStrDup("bigint"); break;
5022    case LIST_CMD:       res->data=omStrDup("list"); break;
5023    case PACKAGE_CMD:    res->data=omStrDup("package"); break;
5024    case LINK_CMD:       res->data=omStrDup("link"); break;
5025    case RESOLUTION_CMD: res->data=omStrDup("resolution");break;
5026#ifdef HAVE_FANS
5027//    case FAN_CMD:        res->data=omStrDup("fan");break;
5028    case CONE_CMD:       res->data=omStrDup("cone");break;
5029#endif /* HAVE_FANS */
5030    case DEF_CMD:
5031    case NONE:           res->data=omStrDup("none"); break;
5032    default:             res->data=omStrDup("?unknown type?");
5033  }
5034  return FALSE;
5035}
5036static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5037{
5038  res->data=(char *)pIsUnivariate((poly)v->Data());
5039  return FALSE;
5040}
5041static BOOLEAN jjVAR1(leftv res, leftv v)
5042{
5043  int i=(int)(long)v->Data();
5044  if ((0<i) && (i<=currRing->N))
5045  {
5046    poly p=pOne();
5047    pSetExp(p,i,1);
5048    pSetm(p);
5049    res->data=(char *)p;
5050  }
5051  else
5052  {
5053    Werror("var number %d out of range 1..%d",i,currRing->N);
5054    return TRUE;
5055  }
5056  return FALSE;
5057}
5058static BOOLEAN jjVARSTR1(leftv res, leftv v)
5059{
5060  if (currRing==NULL)
5061  {
5062    WerrorS("no ring active");
5063    return TRUE;
5064  }
5065  int i=(int)(long)v->Data();
5066  if ((0<i) && (i<=currRing->N))
5067    res->data=omStrDup(currRing->names[i-1]);
5068  else
5069  {
5070    Werror("var number %d out of range 1..%d",i,currRing->N);
5071    return TRUE;
5072  }
5073  return FALSE;
5074}
5075static BOOLEAN jjVDIM(leftv res, leftv v)
5076{
5077  assumeStdFlag(v);
5078  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currQuotient);
5079  return FALSE;
5080}
5081BOOLEAN jjWAIT1ST1(leftv res, leftv a)
5082{
5083  lists Lforks = (lists)a->Data();
5084  int i = slStatusSsiL(Lforks, -1);
5085  while (i <= 0) i = slStatusSsiL(Lforks, 10000000); /* redo this all 10 seconds */
5086  res->data = (void*)(long)i;
5087  return FALSE;
5088}
5089
5090BOOLEAN jjWAITALL1(leftv res, leftv a)
5091{
5092  lists Lforks = (lists)a->Data();
5093  lists oneFork=(lists)omAllocBin(slists_bin);
5094  oneFork->Init(1);
5095  int i;
5096  for (int j = 0; j <= Lforks->nr; j++)
5097  {
5098    oneFork->m[0].Copy(&Lforks->m[j]);
5099    i = slStatusSsiL(oneFork, -1);
5100    while (i != 1) i = slStatusSsiL(oneFork, 10000000); /* redo this all 10 seconds */
5101    omFreeSize((ADDRESS)oneFork->m,sizeof(sleftv));
5102  }
5103  omFreeBin((ADDRESS)oneFork, slists_bin);
5104  return FALSE;
5105}
5106
5107#ifdef HAVE_FANS
5108static BOOLEAN jjCONERAYS1(leftv res, leftv v)
5109{
5110  /* method for generating a cone object from half-lines
5111     (cone = convex hull of the half-lines; note: there may be
5112     entire lines in the cone);
5113     valid parametrizations: (intmat) */
5114  intvec* rays = (intvec *)v->CopyD(INTVEC_CMD);
5115  gfan::ZMatrix zm = intmat2ZMatrix(rays);
5116  gfan::ZCone* zc = new gfan::ZCone();
5117  *zc = gfan::ZCone::givenByRays(zm, gfan::ZMatrix(0, zm.getWidth()));
5118  res->data = (char *)zc;
5119  return FALSE;
5120}
5121static BOOLEAN jjCONENORMALS1(leftv res, leftv v)
5122{
5123  /* method for generating a cone object from inequalities;
5124     valid parametrizations: (intmat) */
5125  intvec* inequs = (intvec *)v->CopyD(INTVEC_CMD);
5126  gfan::ZMatrix zm = intmat2ZMatrix(inequs);
5127  gfan::ZCone* zc = new gfan::ZCone(zm, gfan::ZMatrix(0, zm.getWidth()));
5128  res->data = (char *)zc;
5129  return FALSE;
5130}
5131/*
5132static BOOLEAN jjDELMCONE1(leftv res, leftv v)
5133{
5134  /* method for deleting all maximal cones from a given fan;
5135     valid parametrizations: (fan) */
5136/*  Fan* f = (Fan*)v->Data();
5137  int n = f->getNumberOfMaxCones();
5138  intvec* iv = new intvec(1, n, 0);
5139  for (int i = 1; i <= n; i++)
5140    IMATELEM(*iv, 1, i) = i - 1;
5141  f->deleteMaxCones(iv);
5142  delete iv;
5143  return FALSE;
5144}
5145static BOOLEAN jjMAXRAYS1(leftv res, leftv v)
5146{
5147  /* method for retrieving all maximal rays of the given fan;
5148     valid parametrizations: (fan),
5149     If there are no maximal rays, the method returns a 1x1
5150     matrix with entry 0. Otherwise the returned matrix contains
5151     the maximal rays as row vectors. */
5152/*  Fan* f = (Fan*)v->Data();
5153  intvec* result = NULL;
5154  if (f->getMaxRays() == NULL)
5155    /* return a 1x1 matrix with sole entry zero */
5156/*    result = new intvec(1, 1, 0);
5157  else
5158    result = ivCopy(f->getMaxRays());
5159  res->data = (char*)result;
5160  return FALSE;
5161}
5162static BOOLEAN jjMAXRAYS2(leftv res, leftv v)
5163{
5164  /* method for retrieving all maximal rays of the given cone;
5165     valid parametrizations: (cone),
5166     If there are no maximal rays, the method returns a 1x1
5167     matrix with entry 0. Otherwise the returned matrix contains
5168     the maximal rays as row vectors. */
5169/*  Cone* c = (Cone*)v->Data();
5170  intvec* result = NULL;
5171  if (c->getMaxRays() == NULL)
5172    /* return a 1x1 matrix with sole entry zero */
5173/*    result = new intvec(1, 1, 0);
5174  else
5175    result = ivCopy(c->getMaxRays());
5176  res->data = (char*)result;
5177  return FALSE;
5178}
5179static BOOLEAN jjFACETNS1(leftv res, leftv v)
5180{
5181  /* method for retrieving the facet normals of the given fan;
5182     valid parametrizations: (fan),
5183     If there are no facet normals, a 1x1 matrix with entry 0
5184     is returned; otherwise a matrix the rows of which are
5185     the facet normals of the given fan. */
5186/*  Fan* f = (Fan*)v->Data();
5187  intvec* result = NULL;
5188  if (f->getFacetNs() == NULL)
5189    /* return a 1x1 matrix with sole entry zero */
5190/*    result = new intvec(1, 1, 0);
5191  else
5192    result = ivCopy(f->getFacetNs());
5193  res->data = (char*)result;
5194  return FALSE;
5195}
5196static BOOLEAN jjFACETNS2(leftv res, leftv v)
5197{
5198  /* method for retrieving the facet normals of the given cone;
5199     valid parametrizations: (cone),
5200     If there are no facet normals, a 1x1 matrix with entry 0
5201     is returned; otherwise a matrix the rows of which are
5202     the facet normals of the given cone. */
5203/*  Cone* c = (Cone*)v->Data();
5204  intvec* result = NULL;
5205  if (c->getFacetNs() == NULL)
5206    /* return a 1x1 matrix with sole entry zero */
5207/*    result = new intvec(1, 1, 0);
5208  else
5209    result = ivCopy(c->getFacetNs());
5210  res->data = (char*)result;
5211  return FALSE;
5212}
5213static BOOLEAN jjLINSPACE1(leftv res, leftv v)
5214{
5215  /* method for retrieving the lineality space of the given fan;
5216     valid parametrizations: (fan) */
5217/*  Fan* f = (Fan*)v->Data();
5218  intvec* result = ivCopy(f->getLinSpace());
5219  res->data = (char*)result;
5220  return FALSE;
5221}
5222static BOOLEAN jjLINSPACE2(leftv res, leftv v)
5223{
5224  /* method for retrieving the lineality space of the given cone;
5225     valid parametrizations: (cone) */
5226/*  Cone* c = (Cone*)v->Data();
5227  intvec* result = ivCopy(c->getLinSpace());
5228  res->data = (char*)result;
5229  return FALSE;
5230}
5231static BOOLEAN jjADJACENCY1(leftv res, leftv v)
5232{
5233  /* method for retrieving adjacency information for the given fan;
5234     valid parametrizations: (fan),
5235     Errors will be invoked in the following cases:
5236     - no maximal cone has been defined yet in the given fan;
5237     The method returns a list with an entry for each maximal cone
5238     in the given fan. Each such entry is an intvec with the indices
5239     of all neighbouring maximal cones. */
5240/*  Fan* f = (Fan*)v->Data();
5241  if (f->getNumberOfMaxCones() == 0)
5242  {
5243    WerrorS("no maximal cones defined yet");
5244    return TRUE;
5245  }
5246  lists adjacencyList = f->getAdjacencyList();
5247  adjacencyList = lCopy(adjacencyList);
5248  res->data = (char*)adjacencyList;
5249  return FALSE;
5250}*/
5251#endif /* HAVE_FANS */
5252static BOOLEAN jjLOAD(leftv res, leftv v, BOOLEAN autoexport)
5253{
5254  char * s=(char *)v->CopyD();
5255  char libnamebuf[256];
5256  lib_types LT = type_of_LIB(s, libnamebuf);
5257#ifdef HAVE_DYNAMIC_LOADING
5258  extern BOOLEAN load_modules(char *newlib, char *fullpath, BOOLEAN autoexport);
5259#endif /* HAVE_DYNAMIC_LOADING */
5260  switch(LT)
5261  {
5262      default:
5263      case LT_NONE:
5264        Werror("%s: unknown type", s);
5265        break;
5266      case LT_NOTFOUND:
5267        Werror("cannot open %s", s);
5268        break;
5269
5270      case LT_SINGULAR:
5271      {
5272        char *plib = iiConvName(s);
5273        idhdl pl = IDROOT->get(plib,0);
5274        if (pl==NULL)
5275        {
5276          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5277          IDPACKAGE(pl)->language = LANG_SINGULAR;
5278          IDPACKAGE(pl)->libname=omStrDup(plib);
5279        }
5280        else if (IDTYP(pl)!=PACKAGE_CMD)
5281        {
5282          Werror("can not create package `%s`",plib);
5283          omFree(plib);
5284          return TRUE;
5285        }
5286        package savepack=currPack;
5287        currPack=IDPACKAGE(pl);
5288        IDPACKAGE(pl)->loaded=TRUE;
5289        char libnamebuf[256];
5290        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5291        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5292        currPack=savepack;
5293        IDPACKAGE(pl)->loaded=(!bo);
5294        return bo;
5295      }
5296      case LT_MACH_O:
5297      case LT_ELF:
5298      case LT_HPUX:
5299#ifdef HAVE_DYNAMIC_LOADING
5300        return load_modules(s, libnamebuf, autoexport);
5301#else /* HAVE_DYNAMIC_LOADING */
5302        WerrorS("Dynamic modules are not supported by this version of Singular");
5303        break;
5304#endif /* HAVE_DYNAMIC_LOADING */
5305  }
5306  return TRUE;
5307}
5308
5309#ifdef INIT_BUG
5310#define XS(A) -((short)A)
5311#define jjstrlen       (proc1)1
5312#define jjpLength      (proc1)2
5313#define jjidElem       (proc1)3
5314#define jjmpDetBareiss (proc1)4
5315#define jjidFreeModule (proc1)5
5316#define jjidVec2Ideal  (proc1)6
5317#define jjrCharStr     (proc1)7
5318#ifndef MDEBUG
5319#define jjpHead        (proc1)8
5320#endif
5321#define jjidHead       (proc1)9
5322#define jjidMaxIdeal   (proc1)10
5323#define jjidMinBase    (proc1)11
5324#define jjsyMinBase    (proc1)12
5325#define jjpMaxComp     (proc1)13
5326#define jjmpTrace      (proc1)14
5327#define jjmpTransp     (proc1)15
5328#define jjrOrdStr      (proc1)16
5329#define jjrVarStr      (proc1)18
5330#define jjrParStr      (proc1)19
5331#define jjCOUNT_RES    (proc1)22
5332#define jjDIM_R        (proc1)23
5333#define jjidTransp     (proc1)24
5334
5335extern struct sValCmd1 dArith1[];
5336void jjInitTab1()
5337{
5338  int i=0;
5339  for (;dArith1[i].cmd!=0;i++)
5340  {
5341    if (dArith1[i].res<0)
5342    {
5343      switch ((int)dArith1[i].p)
5344      {
5345        case (int)jjstrlen:       dArith1[i].p=(proc1)strlen; break;
5346        case (int)jjpLength:      dArith1[i].p=(proc1)pLength; break;
5347        case (int)jjidElem:       dArith1[i].p=(proc1)idElem; break;
5348        case (int)jjidVec2Ideal:  dArith1[i].p=(proc1)idVec2Ideal; break;
5349#ifndef HAVE_FACTORY
5350        case (int)jjmpDetBareiss: dArith1[i].p=(proc1)mpDetBareiss; break;
5351#endif
5352        case (int)jjidFreeModule: dArith1[i].p=(proc1)idFreeModule; break;
5353        case (int)jjrCharStr:     dArith1[i].p=(proc1)rCharStr; break;
5354#ifndef MDEBUG
5355        case (int)jjpHead:        dArith1[i].p=(proc1)pHeadProc; break;
5356#endif
5357        case (int)jjidHead:       dArith1[i].p=(proc1)idHead; break;
5358        case (int)jjidMaxIdeal:   dArith1[i].p=(proc1)idMaxIdeal; break;
5359        case (int)jjidMinBase:    dArith1[i].p=(proc1)idMinBase; break;
5360        case (int)jjsyMinBase:    dArith1[i].p=(proc1)syMinBase; break;
5361        case (int)jjpMaxComp:     dArith1[i].p=(proc1)pMaxCompProc; break;
5362        case (int)jjmpTrace:      dArith1[i].p=(proc1)mpTrace; break;
5363        case (int)jjmpTransp:     dArith1[i].p=(proc1)mpTransp; break;
5364        case (int)jjrOrdStr:      dArith1[i].p=(proc1)rOrdStr; break;
5365        case (int)jjrVarStr:      dArith1[i].p=(proc1)rVarStr; break;
5366        case (int)jjrParStr:      dArith1[i].p=(proc1)rParStr; break;
5367        case (int)jjCOUNT_RES:    dArith1[i].p=(proc1)sySize; break;
5368        case (int)jjDIM_R:        dArith1[i].p=(proc1)syDim; break;
5369        case (int)jjidTransp:     dArith1[i].p=(proc1)idTransp; break;
5370#ifdef GENTABLE
5371        default: Werror("missing proc1-definition for %d",(int)(long)dArith1[i].p);
5372#endif
5373      }
5374    }
5375  }
5376}
5377#else
5378#if defined(PROC_BUG)
5379#define XS(A) A
5380static BOOLEAN jjstrlen(leftv res, leftv v)
5381{
5382  res->data = (char *)strlen((char *)v->Data());
5383  return FALSE;
5384}
5385static BOOLEAN jjpLength(leftv res, leftv v)
5386{
5387  res->data = (char *)pLength((poly)v->Data());
5388  return FALSE;
5389}
5390static BOOLEAN jjidElem(leftv res, leftv v)
5391{
5392  res->data = (char *)idElem((ideal)v->Data());
5393  return FALSE;
5394}
5395static BOOLEAN jjmpDetBareiss(leftv res, leftv v)
5396{
5397  res->data = (char *)mpDetBareiss((matrix)v->Data());
5398  return FALSE;
5399}
5400static BOOLEAN jjidFreeModule(leftv res, leftv v)
5401{
5402  res->data = (char *)idFreeModule((int)(long)v->Data());
5403  return FALSE;
5404}
5405static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5406{
5407  res->data = (char *)idVec2Ideal((poly)v->Data());
5408  return FALSE;
5409}
5410static BOOLEAN jjrCharStr(leftv res, leftv v)
5411{
5412  res->data = rCharStr((ring)v->Data());
5413  return FALSE;
5414}
5415#ifndef MDEBUG
5416static BOOLEAN jjpHead(leftv res, leftv v)
5417{
5418  res->data = (char *)pHead((poly)v->Data());
5419  return FALSE;
5420}
5421#endif
5422static BOOLEAN jjidHead(leftv res, leftv v)
5423{
5424  res->data = (char *)idHead((ideal)v->Data());
5425  return FALSE;
5426}
5427static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
5428{
5429  res->data = (char *)idMaxIdeal((int)(long)v->Data());
5430  return FALSE;
5431}
5432static BOOLEAN jjidMinBase(leftv res, leftv v)
5433{
5434  res->data = (char *)idMinBase((ideal)v->Data());
5435  return FALSE;
5436}
5437static BOOLEAN jjsyMinBase(leftv res, leftv v)
5438{
5439  res->data = (char *)syMinBase((ideal)v->Data());
5440  return FALSE;
5441}
5442static BOOLEAN jjpMaxComp(leftv res, leftv v)
5443{
5444  res->data = (char *)pMaxComp((poly)v->Data());
5445  return FALSE;
5446}
5447static BOOLEAN jjmpTrace(leftv res, leftv v)
5448{
5449  res->data = (char *)mpTrace((matrix)v->Data());
5450  return FALSE;
5451}
5452static BOOLEAN jjmpTransp(leftv res, leftv v)
5453{
5454  res->data = (char *)mpTransp((matrix)v->Data());
5455  return FALSE;
5456}
5457static BOOLEAN jjrOrdStr(leftv res, leftv v)
5458{
5459  res->data = rOrdStr((ring)v->Data());
5460  return FALSE;
5461}
5462static BOOLEAN jjrVarStr(leftv res, leftv v)
5463{
5464  res->data = rVarStr((ring)v->Data());
5465  return FALSE;
5466}
5467static BOOLEAN jjrParStr(leftv res, leftv v)
5468{
5469  res->data = rParStr((ring)v->Data());
5470  return FALSE;
5471}
5472static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5473{
5474  res->data=(char *)sySize((syStrategy)v->Data());
5475  return FALSE;
5476}
5477static BOOLEAN jjDIM_R(leftv res, leftv v)
5478{
5479  res->data = (char *)syDim((syStrategy)v->Data());
5480  return FALSE;
5481}
5482static BOOLEAN jjidTransp(leftv res, leftv v)
5483{
5484  res->data = (char *)idTransp((ideal)v->Data());
5485  return FALSE;
5486}
5487#else
5488#define XS(A)          -((short)A)
5489#define jjstrlen       (proc1)strlen
5490#define jjpLength      (proc1)pLength
5491#define jjidElem       (proc1)idElem
5492#define jjmpDetBareiss (proc1)mpDetBareiss
5493#define jjidFreeModule (proc1)idFreeModule
5494#define jjidVec2Ideal  (proc1)idVec2Ideal
5495#define jjrCharStr     (proc1)rCharStr
5496#ifndef MDEBUG
5497#define jjpHead        (proc1)pHeadProc
5498#endif
5499#define jjidHead       (proc1)idHead
5500#define jjidMaxIdeal   (proc1)idMaxIdeal
5501#define jjidMinBase    (proc1)idMinBase
5502#define jjsyMinBase    (proc1)syMinBase
5503#define jjpMaxComp     (proc1)pMaxCompProc
5504#define jjmpTrace      (proc1)mpTrace
5505#define jjmpTransp     (proc1)mpTransp
5506#define jjrOrdStr      (proc1)rOrdStr
5507#define jjrVarStr      (proc1)rVarStr
5508#define jjrParStr      (proc1)rParStr
5509#define jjCOUNT_RES    (proc1)sySize
5510#define jjDIM_R        (proc1)syDim
5511#define jjidTransp     (proc1)idTransp
5512#endif
5513#endif
5514static BOOLEAN jjnInt(leftv res, leftv u)
5515{
5516  number n=(number)u->Data();
5517  res->data=(char *)(long)n_Int(n,currRing);
5518  return FALSE;
5519}
5520static BOOLEAN jjnlInt(leftv res, leftv u)
5521{
5522  number n=(number)u->Data();
5523  res->data=(char *)(long)nlInt(n,NULL /*dummy for nlInt*/);
5524  return FALSE;
5525}
5526/*=================== operations with 3 args.: static proc =================*/
5527/* must be ordered: first operations for chars (infix ops),
5528 * then alphabetically */
5529static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5530{
5531  char *s= (char *)u->Data();
5532  int   r = (int)(long)v->Data();
5533  int   c = (int)(long)w->Data();
5534  int l = strlen(s);
5535
5536  if ( (r<1) || (r>l) || (c<0) )
5537  {
5538    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5539    return TRUE;
5540  }
5541  res->data = (char *)omAlloc((long)(c+1));
5542  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5543  return FALSE;
5544}
5545static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5546{
5547  intvec *iv = (intvec *)u->Data();
5548  int   r = (int)(long)v->Data();
5549  int   c = (int)(long)w->Data();
5550  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5551  {
5552    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5553           r,c,u->Fullname(),iv->rows(),iv->cols());
5554    return TRUE;
5555  }
5556  res->data=u->data; u->data=NULL;
5557  res->rtyp=u->rtyp; u->rtyp=0;
5558  res->name=u->name; u->name=NULL;
5559  res->attribute=u->attribute; u->attribute=NULL;
5560  Subexpr e=jjMakeSub(v);
5561          e->next=jjMakeSub(w);
5562  if (u->e==NULL) res->e=e;
5563  else
5564  {
5565    Subexpr h=u->e;
5566    while (h->next!=NULL) h=h->next;
5567    h->next=e;
5568    res->e=u->e;
5569    u->e=NULL;
5570  }
5571  return FALSE;
5572}
5573static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5574{
5575  matrix m= (matrix)u->Data();
5576  int   r = (int)(long)v->Data();
5577  int   c = (int)(long)w->Data();
5578  //Print("gen. elem %d, %d\n",r,c);
5579  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5580  {
5581    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5582      MATROWS(m),MATCOLS(m));
5583    return TRUE;
5584  }
5585  res->data=u->data; u->data=NULL;
5586  res->rtyp=u->rtyp; u->rtyp=0;
5587  res->name=u->name; u->name=NULL;
5588  res->attribute=u->attribute; u->attribute=NULL;
5589  Subexpr e=jjMakeSub(v);
5590          e->next=jjMakeSub(w);
5591  if (u->e==NULL)
5592    res->e=e;
5593  else
5594  {
5595    Subexpr h=u->e;
5596    while (h->next!=NULL) h=h->next;
5597    h->next=e;
5598    res->e=u->e;
5599    u->e=NULL;
5600  }
5601  return FALSE;
5602}
5603static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5604{
5605  sleftv t;
5606  sleftv ut;
5607  leftv p=NULL;
5608  intvec *iv=(intvec *)w->Data();
5609  int l;
5610  BOOLEAN nok;
5611
5612  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5613  {
5614    WerrorS("cannot build expression lists from unnamed objects");
5615    return TRUE;
5616  }
5617  memcpy(&ut,u,sizeof(ut));
5618  memset(&t,0,sizeof(t));
5619  t.rtyp=INT_CMD;
5620  for (l=0;l< iv->length(); l++)
5621  {
5622    t.data=(char *)(long)((*iv)[l]);
5623    if (p==NULL)
5624    {
5625      p=res;
5626    }
5627    else
5628    {
5629      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5630      p=p->next;
5631    }
5632    memcpy(u,&ut,sizeof(ut));
5633    if (u->Typ() == MATRIX_CMD)
5634      nok=jjBRACK_Ma(p,u,v,&t);
5635    else /* INTMAT_CMD */
5636      nok=jjBRACK_Im(p,u,v,&t);
5637    if (nok)
5638    {
5639      while (res->next!=NULL)
5640      {
5641        p=res->next->next;
5642        omFreeBin((ADDRESS)res->next, sleftv_bin);
5643        // res->e aufraeumen !!!!
5644        res->next=p;
5645      }
5646      return TRUE;
5647    }
5648  }
5649  return FALSE;
5650}
5651static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5652{
5653  sleftv t;
5654  sleftv ut;
5655  leftv p=NULL;
5656  intvec *iv=(intvec *)v->Data();
5657  int l;
5658  BOOLEAN nok;
5659
5660  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5661  {
5662    WerrorS("cannot build expression lists from unnamed objects");
5663    return TRUE;
5664  }
5665  memcpy(&ut,u,sizeof(ut));
5666  memset(&t,0,sizeof(t));
5667  t.rtyp=INT_CMD;
5668  for (l=0;l< iv->length(); l++)
5669  {
5670    t.data=(char *)(long)((*iv)[l]);
5671    if (p==NULL)
5672    {
5673      p=res;
5674    }
5675    else
5676    {
5677      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5678      p=p->next;
5679    }
5680    memcpy(u,&ut,sizeof(ut));
5681    if (u->Typ() == MATRIX_CMD)
5682      nok=jjBRACK_Ma(p,u,&t,w);
5683    else /* INTMAT_CMD */
5684      nok=jjBRACK_Im(p,u,&t,w);
5685    if (nok)
5686    {
5687      while (res->next!=NULL)
5688      {
5689        p=res->next->next;
5690        omFreeBin((ADDRESS)res->next, sleftv_bin);
5691        // res->e aufraeumen !!
5692        res->next=p;
5693      }
5694      return TRUE;
5695    }
5696  }
5697  return FALSE;
5698}
5699static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5700{
5701  sleftv t1,t2,ut;
5702  leftv p=NULL;
5703  intvec *vv=(intvec *)v->Data();
5704  intvec *wv=(intvec *)w->Data();
5705  int vl;
5706  int wl;
5707  BOOLEAN nok;
5708
5709  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5710  {
5711    WerrorS("cannot build expression lists from unnamed objects");
5712    return TRUE;
5713  }
5714  memcpy(&ut,u,sizeof(ut));
5715  memset(&t1,0,sizeof(sleftv));
5716  memset(&t2,0,sizeof(sleftv));
5717  t1.rtyp=INT_CMD;
5718  t2.rtyp=INT_CMD;
5719  for (vl=0;vl< vv->length(); vl++)
5720  {
5721    t1.data=(char *)(long)((*vv)[vl]);
5722    for (wl=0;wl< wv->length(); wl++)
5723    {
5724      t2.data=(char *)(long)((*wv)[wl]);
5725      if (p==NULL)
5726      {
5727        p=res;
5728      }
5729      else
5730      {
5731        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5732        p=p->next;
5733      }
5734      memcpy(u,&ut,sizeof(ut));
5735      if (u->Typ() == MATRIX_CMD)
5736        nok=jjBRACK_Ma(p,u,&t1,&t2);
5737      else /* INTMAT_CMD */
5738        nok=jjBRACK_Im(p,u,&t1,&t2);
5739      if (nok)
5740      {
5741        res->CleanUp();
5742        return TRUE;
5743      }
5744    }
5745  }
5746  return FALSE;
5747}
5748static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5749{
5750  v->next=(leftv)omAllocBin(sleftv_bin);
5751  memcpy(v->next,w,sizeof(sleftv));
5752  memset(w,0,sizeof(sleftv));
5753  return jjPROC(res,u,v);
5754}
5755static BOOLEAN jjCALL3MANY(leftv res, leftv u, leftv v, leftv w)
5756{
5757  u->next=(leftv)omAllocBin(sleftv_bin);
5758  memcpy(u->next,v,sizeof(sleftv));
5759  u->next->next=(leftv)omAllocBin(sleftv_bin);
5760  memcpy(u->next->next,w,sizeof(sleftv));
5761  BOOLEAN r=iiExprArithM(res,u,iiOp);
5762  v->Init();
5763  w->Init();
5764  //w->rtyp=0; w->data=NULL;
5765  // iiExprArithM did the CleanUp
5766  return r;
5767}
5768static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5769{
5770  intvec *iv;
5771  ideal m;
5772  lists l=(lists)omAllocBin(slists_bin);
5773  int k=(int)(long)w->Data();
5774  if (k>=0)
5775  {
5776    smCallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv);
5777    l->Init(2);
5778    l->m[0].rtyp=MODUL_CMD;
5779    l->m[1].rtyp=INTVEC_CMD;
5780    l->m[0].data=(void *)m;
5781    l->m[1].data=(void *)iv;
5782  }
5783  else
5784  {
5785    m=smCallSolv((ideal)u->Data());
5786    l->Init(1);
5787    l->m[0].rtyp=IDEAL_CMD;
5788    l->m[0].data=(void *)m;
5789  }
5790  res->data = (char *)l;
5791  return FALSE;
5792}
5793static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5794{
5795  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5796  {
5797    WerrorS("3rd argument must be a name of a matrix");
5798    return TRUE;
5799  }
5800  ideal i=(ideal)u->Data();
5801  int rank=(int)i->rank;
5802  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5803  if (r) return TRUE;
5804  mpMonomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data());
5805  return FALSE;
5806}
5807static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5808{
5809  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5810           (ideal)(v->Data()),(poly)(w->Data()));
5811  return FALSE;
5812}
5813static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5814{
5815  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5816  {
5817    WerrorS("3rd argument must be a name of a matrix");
5818    return TRUE;
5819  }
5820  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5821  poly p=(poly)u->CopyD(POLY_CMD);
5822  ideal i=idInit(1,1);
5823  i->m[0]=p;
5824  sleftv t;
5825  memset(&t,0,sizeof(t));
5826  t.data=(char *)i;
5827  t.rtyp=IDEAL_CMD;
5828  int rank=1;
5829  if (u->Typ()==VECTOR_CMD)
5830  {
5831    i->rank=rank=pMaxComp(p);
5832    t.rtyp=MODUL_CMD;
5833  }
5834  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5835  t.CleanUp();
5836  if (r) return TRUE;
5837  mpMonomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data());
5838  return FALSE;
5839}
5840static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5841{
5842  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5843    (intvec *)w->Data());
5844  //setFlag(res,FLAG_STD);
5845  return FALSE;
5846}
5847static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5848{
5849  /*4
5850  * look for the substring what in the string where
5851  * starting at position n
5852  * return the position of the first char of what in where
5853  * or 0
5854  */
5855  int n=(int)(long)w->Data();
5856  char *where=(char *)u->Data();
5857  char *what=(char *)v->Data();
5858  char *found;
5859  if ((1>n)||(n>(int)strlen(where)))
5860  {
5861    Werror("start position %d out of range",n);
5862    return TRUE;
5863  }
5864  found = strchr(where+n-1,*what);
5865  if (*(what+1)!='\0')
5866  {
5867    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
5868    {
5869      found=strchr(found+1,*what);
5870    }
5871  }
5872  if (found != NULL)
5873  {
5874    res->data=(char *)((found-where)+1);
5875  }
5876  return FALSE;
5877}
5878static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
5879{
5880  if ((int)(long)w->Data()==0)
5881    res->data=(char *)walkProc(u,v);
5882  else
5883    res->data=(char *)fractalWalkProc(u,v);
5884  setFlag( res, FLAG_STD );
5885  return FALSE;
5886}
5887static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
5888{
5889  assumeStdFlag(u);
5890  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
5891  intvec *wdegree=(intvec*)w->Data();
5892  if (wdegree->length()!=pVariables)
5893  {
5894    Werror("weight vector must have size %d, not %d",
5895           pVariables,wdegree->length());
5896    return TRUE;
5897  }
5898  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient,wdegree);
5899  switch((int)(long)v->Data())
5900  {
5901    case 1:
5902      res->data=(void *)iv;
5903      return FALSE;
5904    case 2:
5905      res->data=(void *)hSecondSeries(iv);
5906      delete iv;
5907      return FALSE;
5908  }
5909  WerrorS(feNotImplemented);
5910  delete iv;
5911  return TRUE;
5912}
5913static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv w)
5914{
5915  PrintS("TODO\n");
5916  int i=pVar((poly)v->Data());
5917  if (i==0)
5918  {
5919    WerrorS("ringvar expected");
5920    return TRUE;
5921  }
5922  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5923  int d=pWTotaldegree(p);
5924  pLmDelete(p);
5925  if (d==1)
5926    res->data = (char *)idHomogen((ideal)u->Data(),i);
5927  else
5928    WerrorS("variable must have weight 1");
5929  return (d!=1);
5930}
5931static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv w)
5932{
5933  PrintS("TODO\n");
5934  int i=pVar((poly)v->Data());
5935  if (i==0)
5936  {
5937    WerrorS("ringvar expected");
5938    return TRUE;
5939  }
5940  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5941  int d=pWTotaldegree(p);
5942  pLmDelete(p);
5943  if (d==1)
5944    res->data = (char *)pHomogen((poly)u->Data(),i);