source: git/Singular/iparith.cc @ a704475

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