source: git/Singular/iparith.cc @ 1879f2

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