source: git/Singular/iparith.cc @ d914cf0

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