source: git/Singular/iparith.cc @ bee06d

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