source: git/Singular/iparith.cc @ 1d579f6

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