source: git/Singular/iparith.cc @ 771339

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