source: git/Singular/iparith.cc @ 8c6ae50

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