source: git/Singular/iparith.cc @ ebbb9c

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