source: git/Singular/iparith.cc @ 6f0279

spielwiese
Last change on this file since 6f0279 was 75f10d, checked in by Hans Schoenemann <hannes@…>, 12 years ago
add: bigintmat stuff from master
  • Property mode set to 100644
File size: 212.5 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_IV(leftv res, leftv v)
3677{
3678  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3679  return FALSE;
3680}
3681static BOOLEAN jjCONTENT(leftv res, leftv v)
3682{
3683  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3684  poly p=(poly)v->CopyD(POLY_CMD);
3685  if (p!=NULL) p_Cleardenom(p, currRing);
3686  res->data = (char *)p;
3687  return FALSE;
3688}
3689static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3690{
3691  res->data = (char *)(long)n_Size((number)v->Data(),coeffs_BIGINT);
3692  return FALSE;
3693}
3694static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3695{
3696  res->data = (char *)(long)nSize((number)v->Data());
3697  return FALSE;
3698}
3699static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3700{
3701  lists l=(lists)v->Data();
3702  res->data = (char *)(long)(lSize(l)+1);
3703  return FALSE;
3704}
3705static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3706{
3707  matrix m=(matrix)v->Data();
3708  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3709  return FALSE;
3710}
3711static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3712{
3713  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3714  return FALSE;
3715}
3716static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3717{
3718  ring r=(ring)v->Data();
3719  int elems=-1;
3720  if (rField_is_Zp(r)||rField_is_GF(r)) elems=r->cf->ch;
3721  else if (rField_is_Zp_a(r) && (r->cf->type==n_algExt))
3722  {
3723#ifdef HAVE_FACTORY
3724    extern int ipower ( int b, int n ); /* factory/cf_util */
3725    elems=ipower(r->cf->ch,r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3726#else
3727    elems=(int)pow((double) r->cf->ch,(double)r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3728#endif
3729  }
3730  res->data = (char *)(long)elems;
3731  return FALSE;
3732}
3733static BOOLEAN jjDEG(leftv res, leftv v)
3734{
3735  int dummy;
3736  poly p=(poly)v->Data();
3737  if (p!=NULL) res->data = (char *)currRing->pLDeg(p,&dummy,currRing);
3738  else res->data=(char *)-1;
3739  return FALSE;
3740}
3741static BOOLEAN jjDEG_M(leftv res, leftv u)
3742{
3743  ideal I=(ideal)u->Data();
3744  int d=-1;
3745  int dummy;
3746  int i;
3747  for(i=IDELEMS(I)-1;i>=0;i--)
3748    if (I->m[i]!=NULL) d=si_max(d,(int)currRing->pLDeg(I->m[i],&dummy,currRing));
3749  res->data = (char *)(long)d;
3750  return FALSE;
3751}
3752static BOOLEAN jjDEGREE(leftv res, leftv v)
3753{
3754  SPrintStart();
3755#ifdef HAVE_RINGS
3756  if (rField_is_Ring_Z(currRing))
3757  {
3758    ring origR = currRing;
3759    ring tempR = rCopy(origR);
3760    coeffs new_cf=nInitChar(n_Q,NULL);
3761    nKillChar(tempR->cf);
3762    tempR->cf=new_cf;
3763    rComplete(tempR);
3764    ideal vid = (ideal)v->Data();
3765    rChangeCurrRing(tempR);
3766    ideal vv = idrCopyR(vid, origR, currRing);
3767    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
3768    vvAsLeftv.rtyp = IDEAL_CMD;
3769    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
3770    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
3771    assumeStdFlag(&vvAsLeftv);
3772    Print("// NOTE: computation of degree is being performed for\n");
3773    Print("//       generic fibre, that is, over Q\n");
3774    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
3775    scDegree(vv,module_w,currQuotient);
3776    idDelete(&vv);
3777    rChangeCurrRing(origR);
3778    rDelete(tempR);
3779  }
3780#endif
3781  assumeStdFlag(v);
3782  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3783  scDegree((ideal)v->Data(),module_w,currQuotient);
3784  char *s=SPrintEnd();
3785  int l=strlen(s)-1;
3786  s[l]='\0';
3787  res->data=(void*)s;
3788  return FALSE;
3789}
3790static BOOLEAN jjDEFINED(leftv res, leftv v)
3791{
3792  if ((v->rtyp==IDHDL)
3793  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3794  {
3795    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3796  }
3797  else if (v->rtyp!=0) res->data=(void *)(-1);
3798  return FALSE;
3799}
3800
3801/// Return the denominator of the input number
3802/// NOTE: the input number is normalized as a side effect
3803static BOOLEAN jjDENOMINATOR(leftv res, leftv v)
3804{
3805  number n = reinterpret_cast<number>(v->Data());
3806  res->data = reinterpret_cast<void*>(n_GetDenom(n, currRing));
3807  return FALSE;
3808}
3809
3810/// Return the numerator of the input number
3811/// NOTE: the input number is normalized as a side effect
3812static BOOLEAN jjNUMERATOR(leftv res, leftv v)
3813{
3814  number n = reinterpret_cast<number>(v->Data());
3815  res->data = reinterpret_cast<void*>(n_GetNumerator(n, currRing));
3816  return FALSE;
3817}
3818
3819
3820
3821
3822#ifdef HAVE_FACTORY
3823static BOOLEAN jjDET(leftv res, leftv v)
3824{
3825  matrix m=(matrix)v->Data();
3826  poly p;
3827  if (sm_CheckDet((ideal)m,m->cols(),TRUE, currRing))
3828  {
3829    ideal I=id_Matrix2Module(mp_Copy(m, currRing),currRing);
3830    p=sm_CallDet(I, currRing);
3831    idDelete(&I);
3832  }
3833  else
3834    p=singclap_det(m,currRing);
3835  res ->data = (char *)p;
3836  return FALSE;
3837}
3838static BOOLEAN jjDET_I(leftv res, leftv v)
3839{
3840  intvec * m=(intvec*)v->Data();
3841  int i,j;
3842  i=m->rows();j=m->cols();
3843  if(i==j)
3844    res->data = (char *)(long)singclap_det_i(m,currRing);
3845  else
3846  {
3847    Werror("det of %d x %d intmat",i,j);
3848    return TRUE;
3849  }
3850  return FALSE;
3851}
3852static BOOLEAN jjDET_S(leftv res, leftv v)
3853{
3854  ideal I=(ideal)v->Data();
3855  poly p;
3856  if (IDELEMS(I)<1) return TRUE;
3857  if (sm_CheckDet(I,IDELEMS(I),FALSE, currRing))
3858  {
3859    matrix m=id_Module2Matrix(id_Copy(I,currRing),currRing);
3860    p=singclap_det(m,currRing);
3861    idDelete((ideal *)&m);
3862  }
3863  else
3864    p=sm_CallDet(I, currRing);
3865  res->data = (char *)p;
3866  return FALSE;
3867}
3868#endif
3869static BOOLEAN jjDIM(leftv res, leftv v)
3870{
3871  assumeStdFlag(v);
3872#ifdef HAVE_RINGS
3873  if (rField_is_Ring(currRing))
3874  {
3875    ring origR = currRing;
3876    ring tempR = rCopy(origR);
3877    coeffs new_cf=nInitChar(n_Q,NULL);
3878    nKillChar(tempR->cf);
3879    tempR->cf=new_cf;
3880    rComplete(tempR);
3881    ideal vid = (ideal)v->Data();
3882    int i = idPosConstant(vid);
3883    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
3884    { /* ideal v contains unit; dim = -1 */
3885      res->data = (char *)-1;
3886      return FALSE;
3887    }
3888    rChangeCurrRing(tempR);
3889    ideal vv = idrCopyR(vid, origR, currRing);
3890    /* drop degree zero generator from vv (if any) */
3891    if (i != -1) pDelete(&vv->m[i]);
3892    long d = (long)scDimInt(vv, currQuotient);
3893    if (rField_is_Ring_Z(origR) && (i == -1)) d++;
3894    res->data = (char *)d;
3895    idDelete(&vv);
3896    rChangeCurrRing(origR);
3897    rDelete(tempR);
3898    return FALSE;
3899  }
3900#endif
3901  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currQuotient);
3902  return FALSE;
3903}
3904static BOOLEAN jjDUMP(leftv, leftv v)
3905{
3906  si_link l = (si_link)v->Data();
3907  if (slDump(l))
3908  {
3909    const char *s;
3910    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3911    else                            s=sNoName;
3912    Werror("cannot dump to `%s`",s);
3913    return TRUE;
3914  }
3915  else
3916    return FALSE;
3917}
3918static BOOLEAN jjE(leftv res, leftv v)
3919{
3920  res->data = (char *)pOne();
3921  int co=(int)(long)v->Data();
3922  if (co>0)
3923  {
3924    pSetComp((poly)res->data,co);
3925    pSetm((poly)res->data);
3926  }
3927  else WerrorS("argument of gen must be positive");
3928  return (co<=0);
3929}
3930static BOOLEAN jjEXECUTE(leftv, leftv v)
3931{
3932  char * d = (char *)v->Data();
3933  char * s = (char *)omAlloc(strlen(d) + 13);
3934  strcpy( s, (char *)d);
3935  strcat( s, "\n;RETURN();\n");
3936  newBuffer(s,BT_execute);
3937  return yyparse();
3938}
3939#ifdef HAVE_FACTORY
3940static BOOLEAN jjFACSTD(leftv res, leftv v)
3941{
3942  lists L=(lists)omAllocBin(slists_bin);
3943  if (rField_is_Zp(currRing)
3944  || rField_is_Q(currRing)
3945  || rField_is_Zp_a(currRing)
3946  || rField_is_Q_a(currRing))
3947  {
3948    ideal_list p,h;
3949    h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
3950    if (h==NULL)
3951    {
3952      L->Init(1);
3953      L->m[0].data=(char *)idInit(0,1);
3954      L->m[0].rtyp=IDEAL_CMD;
3955    }
3956    else
3957    {
3958      p=h;
3959      int l=0;
3960      while (p!=NULL) { p=p->next;l++; }
3961      L->Init(l);
3962      l=0;
3963      while(h!=NULL)
3964      {
3965        L->m[l].data=(char *)h->d;
3966        L->m[l].rtyp=IDEAL_CMD;
3967        p=h->next;
3968        omFreeSize(h,sizeof(*h));
3969        h=p;
3970        l++;
3971      }
3972    }
3973  }
3974  else
3975  {
3976    WarnS("no factorization implemented");
3977    L->Init(1);
3978    iiExprArith1(&(L->m[0]),v,STD_CMD);
3979  }
3980  res->data=(void *)L;
3981  return FALSE;
3982}
3983static BOOLEAN jjFAC_P(leftv res, leftv u)
3984{
3985  intvec *v=NULL;
3986  singclap_factorize_retry=0;
3987  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0,currRing);
3988  if (f==NULL) return TRUE;
3989  ivTest(v);
3990  lists l=(lists)omAllocBin(slists_bin);
3991  l->Init(2);
3992  l->m[0].rtyp=IDEAL_CMD;
3993  l->m[0].data=(void *)f;
3994  l->m[1].rtyp=INTVEC_CMD;
3995  l->m[1].data=(void *)v;
3996  res->data=(void *)l;
3997  return FALSE;
3998}
3999#endif
4000static BOOLEAN jjGETDUMP(leftv, leftv v)
4001{
4002  si_link l = (si_link)v->Data();
4003  if (slGetDump(l))
4004  {
4005    const char *s;
4006    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4007    else                            s=sNoName;
4008    Werror("cannot get dump from `%s`",s);
4009    return TRUE;
4010  }
4011  else
4012    return FALSE;
4013}
4014static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
4015{
4016  assumeStdFlag(v);
4017  ideal I=(ideal)v->Data();
4018  res->data=(void *)iiHighCorner(I,0);
4019  return FALSE;
4020}
4021static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
4022{
4023  assumeStdFlag(v);
4024  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4025  BOOLEAN delete_w=FALSE;
4026  ideal I=(ideal)v->Data();
4027  int i;
4028  poly p=NULL,po=NULL;
4029  int rk=id_RankFreeModule(I,currRing);
4030  if (w==NULL)
4031  {
4032    w = new intvec(rk);
4033    delete_w=TRUE;
4034  }
4035  for(i=rk;i>0;i--)
4036  {
4037    p=iiHighCorner(I,i);
4038    if (p==NULL)
4039    {
4040      WerrorS("module must be zero-dimensional");
4041      if (delete_w) delete w;
4042      return TRUE;
4043    }
4044    if (po==NULL)
4045    {
4046      po=p;
4047    }
4048    else
4049    {
4050      // now po!=NULL, p!=NULL
4051      int d=(currRing->pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - currRing->pFDeg(p,currRing)+(*w)[i-1]);
4052      if (d==0)
4053        d=pLmCmp(po,p);
4054      if (d > 0)
4055      {
4056        pDelete(&p);
4057      }
4058      else // (d < 0)
4059      {
4060        pDelete(&po); po=p;
4061      }
4062    }
4063  }
4064  if (delete_w) delete w;
4065  res->data=(void *)po;
4066  return FALSE;
4067}
4068static BOOLEAN jjHILBERT(leftv, leftv v)
4069{
4070#ifdef HAVE_RINGS
4071  if (rField_is_Ring_Z(currRing))
4072  {
4073    ring origR = currRing;
4074    ring tempR = rCopy(origR);
4075    coeffs new_cf=nInitChar(n_Q,NULL);
4076    nKillChar(tempR->cf);
4077    tempR->cf=new_cf;
4078    rComplete(tempR);
4079    ideal vid = (ideal)v->Data();
4080    rChangeCurrRing(tempR);
4081    ideal vv = idrCopyR(vid, origR, currRing);
4082    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
4083    vvAsLeftv.rtyp = IDEAL_CMD;
4084    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
4085    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
4086    assumeStdFlag(&vvAsLeftv);
4087    Print("// NOTE: computation of Hilbert series etc. is being\n");
4088    Print("//       performed for generic fibre, that is, over Q\n");
4089    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
4090    //scHilbertPoly(vv,currQuotient);
4091    hLookSeries(vv,module_w,currQuotient);
4092    idDelete(&vv);
4093    rChangeCurrRing(origR);
4094    rDelete(tempR);
4095    return FALSE;
4096  }
4097#endif
4098  assumeStdFlag(v);
4099  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4100  //scHilbertPoly((ideal)v->Data(),currQuotient);
4101  hLookSeries((ideal)v->Data(),module_w,currQuotient);
4102  return FALSE;
4103}
4104static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
4105{
4106#ifdef HAVE_RINGS
4107  if (rField_is_Ring_Z(currRing))
4108  {
4109    Print("// NOTE: computation of Hilbert series etc. is being\n");
4110    Print("//       performed for generic fibre, that is, over Q\n");
4111  }
4112#endif
4113  res->data=(void *)hSecondSeries((intvec *)v->Data());
4114  return FALSE;
4115}
4116static BOOLEAN jjHOMOG1(leftv res, leftv v)
4117{
4118  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4119  ideal v_id=(ideal)v->Data();
4120  if (w==NULL)
4121  {
4122    res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
4123    if (res->data!=NULL)
4124    {
4125      if (v->rtyp==IDHDL)
4126      {
4127        char *s_isHomog=omStrDup("isHomog");
4128        if (v->e==NULL)
4129          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
4130        else
4131          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
4132      }
4133      else if (w!=NULL) delete w;
4134    } // if res->data==NULL then w==NULL
4135  }
4136  else
4137  {
4138    res->data=(void *)(long)idTestHomModule(v_id,currQuotient,w);
4139    if((res->data==NULL) && (v->rtyp==IDHDL))
4140    {
4141      if (v->e==NULL)
4142        atKill((idhdl)(v->data),"isHomog");
4143      else
4144        atKill((idhdl)(v->LData()),"isHomog");
4145    }
4146  }
4147  return FALSE;
4148}
4149static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
4150{
4151  res->data = (char *)idMaxIdeal((int)(long)v->Data());
4152  setFlag(res,FLAG_STD);
4153  return FALSE;
4154}
4155static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
4156{
4157  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
4158  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
4159  if (IDELEMS((ideal)mat)==0)
4160  {
4161    idDelete((ideal *)&mat);
4162    mat=(matrix)idInit(1,1);
4163  }
4164  else
4165  {
4166    MATROWS(mat)=1;
4167    mat->rank=1;
4168    idTest((ideal)mat);
4169  }
4170  res->data=(char *)mat;
4171  return FALSE;
4172}
4173static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4174{
4175  map m=(map)v->CopyD(MAP_CMD);
4176  omFree((ADDRESS)m->preimage);
4177  m->preimage=NULL;
4178  ideal I=(ideal)m;
4179  I->rank=1;
4180  res->data=(char *)I;
4181  return FALSE;
4182}
4183static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4184{
4185  if (currRing!=NULL)
4186  {
4187    ring q=(ring)v->Data();
4188    if (rSamePolyRep(currRing, q))
4189    {
4190      if (q->qideal==NULL)
4191        res->data=(char *)idInit(1,1);
4192      else
4193        res->data=(char *)idCopy(q->qideal);
4194      return FALSE;
4195    }
4196  }
4197  WerrorS("can only get ideal from identical qring");
4198  return TRUE;
4199}
4200static BOOLEAN jjIm2Iv(leftv res, leftv v)
4201{
4202  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4203  iv->makeVector();
4204  res->data = iv;
4205  return FALSE;
4206}
4207static BOOLEAN jjIMPART(leftv res, leftv v)
4208{
4209  res->data = (char *)n_ImPart((number)v->Data(),currRing->cf);
4210  return FALSE;
4211}
4212static BOOLEAN jjINDEPSET(leftv res, leftv v)
4213{
4214  assumeStdFlag(v);
4215  res->data=(void *)scIndIntvec((ideal)(v->Data()),currQuotient);
4216  return FALSE;
4217}
4218static BOOLEAN jjINTERRED(leftv res, leftv v)
4219{
4220  ideal result=kInterRed((ideal)(v->Data()), currQuotient);
4221  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4222  res->data = result;
4223  return FALSE;
4224}
4225static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4226{
4227  res->data = (char *)(long)pVar((poly)v->Data());
4228  return FALSE;
4229}
4230static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4231{
4232  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing)+1);
4233  return FALSE;
4234}
4235static BOOLEAN jjIS_RINGVAR0(leftv res, leftv)
4236{
4237  res->data = (char *)0;
4238  return FALSE;
4239}
4240static BOOLEAN jjJACOB_P(leftv res, leftv v)
4241{
4242  ideal i=idInit(currRing->N,1);
4243  int k;
4244  poly p=(poly)(v->Data());
4245  for (k=currRing->N;k>0;k--)
4246  {
4247    i->m[k-1]=pDiff(p,k);
4248  }
4249  res->data = (char *)i;
4250  return FALSE;
4251}
4252/*2
4253 * compute Jacobi matrix of a module/matrix
4254 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(currRing->N))  ),
4255 * where Mt := transpose(M)
4256 * Note that this is consistent with the current conventions for jacob in Singular,
4257 * whereas M2 computes its transposed.
4258 */
4259static BOOLEAN jjJACOB_M(leftv res, leftv a)
4260{
4261  ideal id = (ideal)a->Data();
4262  id = idTransp(id);
4263  int W = IDELEMS(id);
4264
4265  ideal result = idInit(W * currRing->N, id->rank);
4266  poly *p = result->m;
4267
4268  for( int v = 1; v <= currRing->N; v++ )
4269  {
4270    poly* q = id->m;
4271    for( int i = 0; i < W; i++, p++, q++ )
4272      *p = pDiff( *q, v );
4273  }
4274  idDelete(&id);
4275
4276  res->data = (char *)result;
4277  return FALSE;
4278}
4279
4280
4281static BOOLEAN jjKBASE(leftv res, leftv v)
4282{
4283  assumeStdFlag(v);
4284  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currQuotient);
4285  return FALSE;
4286}
4287#ifdef MDEBUG
4288static BOOLEAN jjpHead(leftv res, leftv v)
4289{
4290  res->data=(char *)pHead((poly)v->Data());
4291  return FALSE;
4292}
4293#endif
4294static BOOLEAN jjL2R(leftv res, leftv v)
4295{
4296  res->data=(char *)syConvList((lists)v->Data(),FALSE);
4297  if (res->data != NULL)
4298    return FALSE;
4299  else
4300    return TRUE;
4301}
4302static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4303{
4304  poly p=(poly)v->Data();
4305  if (p==NULL)
4306  {
4307    res->data=(char *)nInit(0);
4308  }
4309  else
4310  {
4311    res->data=(char *)nCopy(pGetCoeff(p));
4312  }
4313  return FALSE;
4314}
4315static BOOLEAN jjLEADEXP(leftv res, leftv v)
4316{
4317  poly p=(poly)v->Data();
4318  int s=currRing->N;
4319  if (v->Typ()==VECTOR_CMD) s++;
4320  intvec *iv=new intvec(s);
4321  if (p!=NULL)
4322  {
4323    for(int i = currRing->N;i;i--)
4324    {
4325      (*iv)[i-1]=pGetExp(p,i);
4326    }
4327    if (s!=currRing->N)
4328      (*iv)[currRing->N]=pGetComp(p);
4329  }
4330  res->data=(char *)iv;
4331  return FALSE;
4332}
4333static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4334{
4335  poly p=(poly)v->Data();
4336  if (p == NULL)
4337  {
4338    res->data = (char*) NULL;
4339  }
4340  else
4341  {
4342    poly lm = pLmInit(p);
4343    pSetCoeff(lm, nInit(1));
4344    res->data = (char*) lm;
4345  }
4346  return FALSE;
4347}
4348static BOOLEAN jjLOAD1(leftv res, leftv v)
4349{
4350  return jjLOAD(res, v,FALSE);
4351}
4352static BOOLEAN jjLISTRING(leftv res, leftv v)
4353{
4354  ring r=rCompose((lists)v->Data());
4355  if (r==NULL) return TRUE;
4356  if (r->qideal!=NULL) res->rtyp=QRING_CMD;
4357  res->data=(char *)r;
4358  return FALSE;
4359}
4360#if SIZEOF_LONG == 8
4361static number jjLONG2N(long d)
4362{
4363  int i=(int)d;
4364  if ((long)i == d)
4365  {
4366    return n_Init(i, coeffs_BIGINT);
4367  }
4368  else
4369  {
4370     struct snumber_dummy
4371     {
4372      mpz_t z;
4373      mpz_t n;
4374      #if defined(LDEBUG)
4375      int debug;
4376      #endif
4377      BOOLEAN s;
4378    };
4379    typedef struct snumber_dummy  *number_dummy;
4380
4381    number_dummy z=(number_dummy)omAlloc(sizeof(snumber_dummy));
4382    #if defined(LDEBUG)
4383    z->debug=123456;
4384    #endif
4385    z->s=3;
4386    mpz_init_set_si(z->z,d);
4387    return (number)z;
4388  }
4389}
4390#else
4391#define jjLONG2N(D) n_Init((int)D, coeffs_BIGINT)
4392#endif
4393static BOOLEAN jjPFAC1(leftv res, leftv v)
4394{
4395  /* call method jjPFAC2 with second argument = 0 (meaning that no
4396     valid bound for the prime factors has been given) */
4397  sleftv tmp;
4398  memset(&tmp, 0, sizeof(tmp));
4399  tmp.rtyp = INT_CMD;
4400  return jjPFAC2(res, v, &tmp);
4401}
4402static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4403{
4404  /* computes the LU-decomposition of a matrix M;
4405     i.e., M = P * L * U, where
4406        - P is a row permutation matrix,
4407        - L is in lower triangular form,
4408        - U is in upper row echelon form
4409     Then, we also have P * M = L * U.
4410     A list [P, L, U] is returned. */
4411  matrix mat = (const matrix)v->Data();
4412  matrix pMat;
4413  matrix lMat;
4414  matrix uMat;
4415
4416  luDecomp(mat, pMat, lMat, uMat);
4417
4418  lists ll = (lists)omAllocBin(slists_bin);
4419  ll->Init(3);
4420  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4421  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4422  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4423  res->data=(char*)ll;
4424
4425  return FALSE;
4426}
4427static BOOLEAN jjMEMORY(leftv res, leftv v)
4428{
4429  omUpdateInfo();
4430  switch(((int)(long)v->Data()))
4431  {
4432  case 0:
4433    res->data=(char *)jjLONG2N(om_Info.UsedBytes);
4434    break;
4435  case 1:
4436    res->data = (char *)jjLONG2N(om_Info.CurrentBytesSystem);
4437    break;
4438  case 2:
4439    res->data = (char *)jjLONG2N(om_Info.MaxBytesSystem);
4440    break;
4441  default:
4442    omPrintStats(stdout);
4443    omPrintInfo(stdout);
4444    omPrintBinStats(stdout);
4445    res->data = (char *)0;
4446    res->rtyp = NONE;
4447  }
4448  return FALSE;
4449  res->data = (char *)0;
4450  return FALSE;
4451}
4452//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4453//{
4454//  return jjMONITOR2(res,v,NULL);
4455//}
4456static BOOLEAN jjMSTD(leftv res, leftv v)
4457{
4458  int t=v->Typ();
4459  ideal r,m;
4460  r=kMin_std((ideal)v->Data(),currQuotient,testHomog,NULL,m);
4461  lists l=(lists)omAllocBin(slists_bin);
4462  l->Init(2);
4463  l->m[0].rtyp=t;
4464  l->m[0].data=(char *)r;
4465  setFlag(&(l->m[0]),FLAG_STD);
4466  l->m[1].rtyp=t;
4467  l->m[1].data=(char *)m;
4468  res->data=(char *)l;
4469  return FALSE;
4470}
4471static BOOLEAN jjMULT(leftv res, leftv v)
4472{
4473  assumeStdFlag(v);
4474  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currQuotient);
4475  return FALSE;
4476}
4477static BOOLEAN jjMINRES_R(leftv res, leftv v)
4478{
4479  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4480
4481  syStrategy tmp=(syStrategy)v->Data();
4482  tmp = syMinimize(tmp); // enrich itself!
4483
4484  res->data=(char *)tmp;
4485
4486  if (weights!=NULL)
4487    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4488
4489  return FALSE;
4490}
4491static BOOLEAN jjN2BI(leftv res, leftv v)
4492{
4493  number n,i; i=(number)v->Data();
4494  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4495  if (nMap!=NULL)
4496    n=nMap(i,currRing->cf,coeffs_BIGINT);
4497  else goto err;
4498  res->data=(void *)n;
4499  return FALSE;
4500err:
4501  WerrorS("cannot convert to bigint"); return TRUE;
4502}
4503static BOOLEAN jjNAMEOF(leftv res, leftv v)
4504{
4505  res->data = (char *)v->name;
4506  if (res->data==NULL) res->data=omStrDup("");
4507  v->name=NULL;
4508  return FALSE;
4509}
4510static BOOLEAN jjNAMES(leftv res, leftv v)
4511{
4512  res->data=ipNameList(((ring)v->Data())->idroot);
4513  return FALSE;
4514}
4515static BOOLEAN jjNVARS(leftv res, leftv v)
4516{
4517  res->data = (char *)(long)(((ring)(v->Data()))->N);
4518  return FALSE;
4519}
4520static BOOLEAN jjOpenClose(leftv, leftv v)
4521{
4522  si_link l=(si_link)v->Data();
4523  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4524  else                return slClose(l);
4525}
4526static BOOLEAN jjORD(leftv res, leftv v)
4527{
4528  poly p=(poly)v->Data();
4529  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4530  return FALSE;
4531}
4532static BOOLEAN jjPAR1(leftv res, leftv v)
4533{
4534  int i=(int)(long)v->Data();
4535  int p=0;
4536  p=rPar(currRing);
4537  if ((0<i) && (i<=p))
4538  {
4539    res->data=(char *)n_Param(i,currRing);
4540  }
4541  else
4542  {
4543    Werror("par number %d out of range 1..%d",i,p);
4544    return TRUE;
4545  }
4546  return FALSE;
4547}
4548static BOOLEAN jjPARDEG(leftv res, leftv v)
4549{
4550  number nn=(number)v->Data();
4551  res->data = (char *)(long)n_ParDeg(nn, currRing);
4552  return FALSE;
4553}
4554static BOOLEAN jjPARSTR1(leftv res, leftv v)
4555{
4556  if (currRing==NULL)
4557  {
4558    WerrorS("no ring active");
4559    return TRUE;
4560  }
4561  int i=(int)(long)v->Data();
4562  int p=0;
4563  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4564    res->data=omStrDup(rParameter(currRing)[i-1]);
4565  else
4566  {
4567    Werror("par number %d out of range 1..%d",i,p);
4568    return TRUE;
4569  }
4570  return FALSE;
4571}
4572static BOOLEAN jjP2BI(leftv res, leftv v)
4573{
4574  poly p=(poly)v->Data();
4575  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4576  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4577  {
4578    WerrorS("poly must be constant");
4579    return TRUE;
4580  }
4581  number i=pGetCoeff(p);
4582  number n;
4583  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4584  if (nMap!=NULL)
4585    n=nMap(i,currRing->cf,coeffs_BIGINT);
4586  else goto err;
4587  res->data=(void *)n;
4588  return FALSE;
4589err:
4590  WerrorS("cannot convert to bigint"); return TRUE;
4591}
4592static BOOLEAN jjP2I(leftv res, leftv v)
4593{
4594  poly p=(poly)v->Data();
4595  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4596  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4597  {
4598    WerrorS("poly must be constant");
4599    return TRUE;
4600  }
4601  res->data = (char *)(long)n_Int(pGetCoeff(p),currRing->cf);
4602  return FALSE;
4603}
4604static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4605{
4606  map mapping=(map)v->Data();
4607  syMake(res,omStrDup(mapping->preimage));
4608  return FALSE;
4609}
4610static BOOLEAN jjPRIME(leftv res, leftv v)
4611{
4612  int i = IsPrime((int)(long)(v->Data()));
4613  res->data = (char *)(long)(i > 1 ? i : 2);
4614  return FALSE;
4615}
4616static BOOLEAN jjPRUNE(leftv res, leftv v)
4617{
4618  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4619  ideal v_id=(ideal)v->Data();
4620  if (w!=NULL)
4621  {
4622    if (!idTestHomModule(v_id,currQuotient,w))
4623    {
4624      WarnS("wrong weights");
4625      w=NULL;
4626      // and continue at the non-homog case below
4627    }
4628    else
4629    {
4630      w=ivCopy(w);
4631      intvec **ww=&w;
4632      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4633      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4634      return FALSE;
4635    }
4636  }
4637  res->data = (char *)idMinEmbedding(v_id);
4638  return FALSE;
4639}
4640static BOOLEAN jjP2N(leftv res, leftv v)
4641{
4642  number n;
4643  poly p;
4644  if (((p=(poly)v->Data())!=NULL)
4645  && (pIsConstant(p)))
4646  {
4647    n=nCopy(pGetCoeff(p));
4648  }
4649  else
4650  {
4651    n=nInit(0);
4652  }
4653  res->data = (char *)n;
4654  return FALSE;
4655}
4656static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4657{
4658  char *s= (char *)v->Data();
4659  int i = 1;
4660  for(i=0; i<sArithBase.nCmdUsed; i++)
4661  {
4662    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4663    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4664    {
4665      res->data = (char *)1;
4666      return FALSE;
4667    }
4668  }
4669  //res->data = (char *)0;
4670  return FALSE;
4671}
4672static BOOLEAN jjRANK1(leftv res, leftv v)
4673{
4674  matrix m =(matrix)v->Data();
4675  int rank = luRank(m, 0);
4676  res->data =(char *)(long)rank;
4677  return FALSE;
4678}
4679static BOOLEAN jjREAD(leftv res, leftv v)
4680{
4681  return jjREAD2(res,v,NULL);
4682}
4683static BOOLEAN jjREGULARITY(leftv res, leftv v)
4684{
4685  res->data = (char *)(long)iiRegularity((lists)v->Data());
4686  return FALSE;
4687}
4688static BOOLEAN jjREPART(leftv res, leftv v)
4689{
4690  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4691  return FALSE;
4692}
4693static BOOLEAN jjRINGLIST(leftv res, leftv v)
4694{
4695  ring r=(ring)v->Data();
4696  if (r!=NULL)
4697    res->data = (char *)rDecompose((ring)v->Data());
4698  return (r==NULL)||(res->data==NULL);
4699}
4700static BOOLEAN jjROWS(leftv res, leftv v)
4701{
4702  ideal i = (ideal)v->Data();
4703  res->data = (char *)i->rank;
4704  return FALSE;
4705}
4706static BOOLEAN jjROWS_IV(leftv res, leftv v)
4707{
4708  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4709  return FALSE;
4710}
4711static BOOLEAN jjRPAR(leftv res, leftv v)
4712{
4713  res->data = (char *)(long)rPar(((ring)v->Data()));
4714  return FALSE;
4715}
4716static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4717{
4718#ifdef HAVE_PLURAL
4719  const bool bIsSCA = rIsSCA(currRing);
4720#else
4721  const bool bIsSCA = false;
4722#endif
4723
4724  if ((currQuotient!=NULL) && !bIsSCA)
4725  {
4726    WerrorS("qring not supported by slimgb at the moment");
4727    return TRUE;
4728  }
4729  if (rHasLocalOrMixedOrdering_currRing())
4730  {
4731    WerrorS("ordering must be global for slimgb");
4732    return TRUE;
4733  }
4734  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4735  tHomog hom=testHomog;
4736  ideal u_id=(ideal)u->Data();
4737  if (w!=NULL)
4738  {
4739    if (!idTestHomModule(u_id,currQuotient,w))
4740    {
4741      WarnS("wrong weights");
4742      w=NULL;
4743    }
4744    else
4745    {
4746      w=ivCopy(w);
4747      hom=isHomog;
4748    }
4749  }
4750
4751  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
4752  res->data=(char *)t_rep_gb(currRing,
4753    u_id,u_id->rank);
4754  //res->data=(char *)t_rep_gb(currRing, u_id);
4755
4756  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4757  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4758  return FALSE;
4759}
4760static BOOLEAN jjSTD(leftv res, leftv v)
4761{
4762  ideal result;
4763  ideal v_id=(ideal)v->Data();
4764  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4765  tHomog hom=testHomog;
4766  if (w!=NULL)
4767  {
4768    if (!idTestHomModule(v_id,currQuotient,w))
4769    {
4770      WarnS("wrong weights");
4771      w=NULL;
4772    }
4773    else
4774    {
4775      hom=isHomog;
4776      w=ivCopy(w);
4777    }
4778  }
4779  result=kStd(v_id,currQuotient,hom,&w);
4780  idSkipZeroes(result);
4781  res->data = (char *)result;
4782  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4783  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4784  return FALSE;
4785}
4786static BOOLEAN jjSort_Id(leftv res, leftv v)
4787{
4788  res->data = (char *)idSort((ideal)v->Data());
4789  return FALSE;
4790}
4791#ifdef HAVE_FACTORY
4792static BOOLEAN jjSQR_FREE(leftv res, leftv u)
4793{
4794  singclap_factorize_retry=0;
4795  intvec *v=NULL;
4796  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
4797  if (f==NULL) return TRUE;
4798  ivTest(v);
4799  lists l=(lists)omAllocBin(slists_bin);
4800  l->Init(2);
4801  l->m[0].rtyp=IDEAL_CMD;
4802  l->m[0].data=(void *)f;
4803  l->m[1].rtyp=INTVEC_CMD;
4804  l->m[1].data=(void *)v;
4805  res->data=(void *)l;
4806  return FALSE;
4807}
4808#endif
4809#if 1
4810static BOOLEAN jjSYZYGY(leftv res, leftv v)
4811{
4812  intvec *w=NULL;
4813  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
4814  if (w!=NULL) delete w;
4815  return FALSE;
4816}
4817#else
4818// activate, if idSyz handle module weights correctly !
4819static BOOLEAN jjSYZYGY(leftv res, leftv v)
4820{
4821  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4822  ideal v_id=(ideal)v->Data();
4823  tHomog hom=testHomog;
4824  int add_row_shift=0;
4825  if (w!=NULL)
4826  {
4827    w=ivCopy(w);
4828    add_row_shift=w->min_in();
4829    (*w)-=add_row_shift;
4830    if (idTestHomModule(v_id,currQuotient,w))
4831      hom=isHomog;
4832    else
4833    {
4834      //WarnS("wrong weights");
4835      delete w; w=NULL;
4836      hom=testHomog;
4837    }
4838  }
4839  res->data = (char *)idSyzygies(v_id,hom,&w);
4840  if (w!=NULL)
4841  {
4842    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4843  }
4844  return FALSE;
4845}
4846#endif
4847static BOOLEAN jjTRACE_IV(leftv res, leftv v)
4848{
4849  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
4850  return FALSE;
4851}
4852static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
4853{
4854  res->data = (char *)ivTranp((intvec*)(v->Data()));
4855  return FALSE;
4856}
4857#ifdef HAVE_PLURAL
4858static BOOLEAN jjOPPOSITE(leftv res, leftv a)
4859{
4860  ring    r = (ring)a->Data();
4861  //if (rIsPluralRing(r))
4862  if (r->OrdSgn==1)
4863  {
4864    res->data = rOpposite(r);
4865  }
4866  else
4867  {
4868    WarnS("opposite only for global orderings");
4869    res->data = rCopy(r);
4870  }
4871  return FALSE;
4872}
4873static BOOLEAN jjENVELOPE(leftv res, leftv a)
4874{
4875  ring    r = (ring)a->Data();
4876  if (rIsPluralRing(r))
4877  {
4878    //    ideal   i;
4879//     if (a->rtyp == QRING_CMD)
4880//     {
4881//       i = r->qideal;
4882//       r->qideal = NULL;
4883//     }
4884    ring s = rEnvelope(r);
4885//     if (a->rtyp == QRING_CMD)
4886//     {
4887//       ideal is  = idOppose(r,i); /* twostd? */
4888//       is        = idAdd(is,i);
4889//       s->qideal = i;
4890//     }
4891    res->data = s;
4892  }
4893  else  res->data = rCopy(r);
4894  return FALSE;
4895}
4896static BOOLEAN jjTWOSTD(leftv res, leftv a)
4897{
4898  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
4899  else  res->data=(ideal)a->CopyD();
4900  setFlag(res,FLAG_STD);
4901  setFlag(res,FLAG_TWOSTD);
4902  return FALSE;
4903}
4904#endif
4905
4906static BOOLEAN jjTYPEOF(leftv res, leftv v)
4907{
4908  int t=(int)(long)v->data;
4909  switch (t)
4910  {
4911    case INT_CMD:        res->data=omStrDup("int"); break;
4912    case POLY_CMD:       res->data=omStrDup("poly"); break;
4913    case VECTOR_CMD:     res->data=omStrDup("vector"); break;
4914    case STRING_CMD:     res->data=omStrDup("string"); break;
4915    case INTVEC_CMD:     res->data=omStrDup("intvec"); break;
4916    case IDEAL_CMD:      res->data=omStrDup("ideal"); break;
4917    case MATRIX_CMD:     res->data=omStrDup("matrix"); break;
4918    case MODUL_CMD:      res->data=omStrDup("module"); break;
4919    case MAP_CMD:        res->data=omStrDup("map"); break;
4920    case PROC_CMD:       res->data=omStrDup("proc"); break;
4921    case RING_CMD:       res->data=omStrDup("ring"); break;
4922    case QRING_CMD:      res->data=omStrDup("qring"); break;
4923    case INTMAT_CMD:     res->data=omStrDup("intmat"); break;
4924    case NUMBER_CMD:     res->data=omStrDup("number"); break;
4925    case BIGINT_CMD:     res->data=omStrDup("bigint"); break;
4926    case LIST_CMD:       res->data=omStrDup("list"); break;
4927    case PACKAGE_CMD:    res->data=omStrDup("package"); break;
4928    case LINK_CMD:       res->data=omStrDup("link"); break;
4929    case RESOLUTION_CMD: res->data=omStrDup("resolution");break;
4930    case DEF_CMD:
4931    case NONE:           res->data=omStrDup("none"); break;
4932    default:
4933    {
4934      if (t>MAX_TOK)
4935        res->data=omStrDup(getBlackboxName(t));
4936      else
4937        res->data=omStrDup("?unknown type?");
4938      break;
4939    }
4940  }
4941  return FALSE;
4942}
4943static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
4944{
4945  res->data=(char *)pIsUnivariate((poly)v->Data());
4946  return FALSE;
4947}
4948static BOOLEAN jjVAR1(leftv res, leftv v)
4949{
4950  int i=(int)(long)v->Data();
4951  if ((0<i) && (i<=currRing->N))
4952  {
4953    poly p=pOne();
4954    pSetExp(p,i,1);
4955    pSetm(p);
4956    res->data=(char *)p;
4957  }
4958  else
4959  {
4960    Werror("var number %d out of range 1..%d",i,currRing->N);
4961    return TRUE;
4962  }
4963  return FALSE;
4964}
4965static BOOLEAN jjVARSTR1(leftv res, leftv v)
4966{
4967  if (currRing==NULL)
4968  {
4969    WerrorS("no ring active");
4970    return TRUE;
4971  }
4972  int i=(int)(long)v->Data();
4973  if ((0<i) && (i<=currRing->N))
4974    res->data=omStrDup(currRing->names[i-1]);
4975  else
4976  {
4977    Werror("var number %d out of range 1..%d",i,currRing->N);
4978    return TRUE;
4979  }
4980  return FALSE;
4981}
4982static BOOLEAN jjVDIM(leftv res, leftv v)
4983{
4984  assumeStdFlag(v);
4985  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currQuotient);
4986  return FALSE;
4987}
4988BOOLEAN jjWAIT1ST1(leftv res, leftv u)
4989{
4990// input: u: a list with links of type
4991//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
4992// returns: -1:  the read state of all links is eof
4993//          i>0: (at least) u[i] is ready
4994  lists Lforks = (lists)u->Data();
4995  int i = slStatusSsiL(Lforks, -1);
4996  if(i == -2) /* error */
4997  {
4998    return TRUE;
4999  }
5000  res->data = (void*)(long)i;
5001  return FALSE;
5002}
5003BOOLEAN jjWAITALL1(leftv res, leftv u)
5004{
5005// input: u: a list with links of type
5006//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5007// returns: -1: the read state of all links is eof
5008//           1: all links are ready
5009//              (caution: at least one is ready, but some maybe dead)
5010  lists Lforks = (lists)u->CopyD();
5011  int i;
5012  int j = -1;
5013  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5014  {
5015    i = slStatusSsiL(Lforks, -1);
5016    if(i == -2) /* error */
5017    {
5018      return TRUE;
5019    }
5020    if(i == -1)
5021    {
5022      break;
5023    }
5024    j = 1;
5025    Lforks->m[i-1].CleanUp();
5026    Lforks->m[i-1].rtyp=DEF_CMD;
5027    Lforks->m[i-1].data=NULL;
5028  }
5029  res->data = (void*)(long)j;
5030  Lforks->Clean();
5031  return FALSE;
5032}
5033static BOOLEAN jjLOAD(leftv, leftv v, BOOLEAN autoexport)
5034{
5035  char * s=(char *)v->CopyD();
5036  char libnamebuf[256];
5037  lib_types LT = type_of_LIB(s, libnamebuf);
5038#ifdef HAVE_DYNAMIC_LOADING
5039  extern BOOLEAN load_modules(char *newlib, char *fullpath, BOOLEAN autoexport);
5040#endif /* HAVE_DYNAMIC_LOADING */
5041  switch(LT)
5042  {
5043      default:
5044      case LT_NONE:
5045        Werror("%s: unknown type", s);
5046        break;
5047      case LT_NOTFOUND:
5048        Werror("cannot open %s", s);
5049        break;
5050
5051      case LT_SINGULAR:
5052      {
5053        char *plib = iiConvName(s);
5054        idhdl pl = IDROOT->get(plib,0);
5055        if (pl==NULL)
5056        {
5057          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5058          IDPACKAGE(pl)->language = LANG_SINGULAR;
5059          IDPACKAGE(pl)->libname=omStrDup(plib);
5060        }
5061        else if (IDTYP(pl)!=PACKAGE_CMD)
5062        {
5063          Werror("can not create package `%s`",plib);
5064          omFree(plib);
5065          return TRUE;
5066        }
5067        package savepack=currPack;
5068        currPack=IDPACKAGE(pl);
5069        IDPACKAGE(pl)->loaded=TRUE;
5070        char libnamebuf[256];
5071        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5072        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5073        currPack=savepack;
5074        IDPACKAGE(pl)->loaded=(!bo);
5075        return bo;
5076      }
5077      case LT_MACH_O:
5078      case LT_ELF:
5079      case LT_HPUX:
5080#ifdef HAVE_DYNAMIC_LOADING
5081        return load_modules(s, libnamebuf, autoexport);
5082#else /* HAVE_DYNAMIC_LOADING */
5083        WerrorS("Dynamic modules are not supported by this version of Singular");
5084        break;
5085#endif /* HAVE_DYNAMIC_LOADING */
5086  }
5087  return TRUE;
5088}
5089
5090#ifdef INIT_BUG
5091#define XS(A) -((short)A)
5092#define jjstrlen       (proc1)1
5093#define jjpLength      (proc1)2
5094#define jjidElem       (proc1)3
5095#define jjmpDetBareiss (proc1)4
5096#define jjidFreeModule (proc1)5
5097#define jjidVec2Ideal  (proc1)6
5098#define jjrCharStr     (proc1)7
5099#ifndef MDEBUG
5100#define jjpHead        (proc1)8
5101#endif
5102#define jjidMinBase    (proc1)11
5103#define jjsyMinBase    (proc1)12
5104#define jjpMaxComp     (proc1)13
5105#define jjmpTrace      (proc1)14
5106#define jjmpTransp     (proc1)15
5107#define jjrOrdStr      (proc1)16
5108#define jjrVarStr      (proc1)18
5109#define jjrParStr      (proc1)19
5110#define jjCOUNT_RES    (proc1)22
5111#define jjDIM_R        (proc1)23
5112#define jjidTransp     (proc1)24
5113
5114extern struct sValCmd1 dArith1[];
5115void jjInitTab1()
5116{
5117  int i=0;
5118  for (;dArith1[i].cmd!=0;i++)
5119  {
5120    if (dArith1[i].res<0)
5121    {
5122      switch ((int)dArith1[i].p)
5123      {
5124        case (int)jjstrlen:       dArith1[i].p=(proc1)strlen; break;
5125        case (int)jjpLength:      dArith1[i].p=(proc1)pLength; break;
5126        case (int)jjidElem:       dArith1[i].p=(proc1)idElem; break;
5127        case (int)jjidVec2Ideal:  dArith1[i].p=(proc1)idVec2Ideal; break;
5128#ifndef HAVE_FACTORY
5129        case (int)jjmpDetBareiss: dArith1[i].p=(proc1)mpDetBareiss; break;
5130#endif
5131        case (int)jjidFreeModule: dArith1[i].p=(proc1)idFreeModule; break;
5132        case (int)jjrCharStr:     dArith1[i].p=(proc1)rCharStr; break;
5133#ifndef MDEBUG
5134        case (int)jjpHead:        dArith1[i].p=(proc1)pHeadProc; break;
5135#endif
5136        case (int)jjidMinBase:    dArith1[i].p=(proc1)idMinBase; break;
5137        case (int)jjsyMinBase:    dArith1[i].p=(proc1)syMinBase; break;
5138        case (int)jjpMaxComp:     dArith1[i].p=(proc1)pMaxCompProc; break;
5139        case (int)jjmpTrace:      dArith1[i].p=(proc1)mpTrace; break;
5140        case (int)jjmpTransp:     dArith1[i].p=(proc1)mpTransp; break;
5141        case (int)jjrOrdStr:      dArith1[i].p=(proc1)rOrdStr; break;
5142        case (int)jjrVarStr:      dArith1[i].p=(proc1)rVarStr; break;
5143        case (int)jjrParStr:      dArith1[i].p=(proc1)rParStr; break;
5144        case (int)jjCOUNT_RES:    dArith1[i].p=(proc1)sySize; break;
5145        case (int)jjDIM_R:        dArith1[i].p=(proc1)syDim; break;
5146        case (int)jjidTransp:     dArith1[i].p=(proc1)idTransp; break;
5147        default: Werror("missing proc1-definition for %d",(int)(long)dArith1[i].p);
5148      }
5149    }
5150  }
5151}
5152#else
5153#if defined(PROC_BUG)
5154#define XS(A) A
5155static BOOLEAN jjstrlen(leftv res, leftv v)
5156{
5157  res->data = (char *)strlen((char *)v->Data());
5158  return FALSE;
5159}
5160static BOOLEAN jjpLength(leftv res, leftv v)
5161{
5162  res->data = (char *)pLength((poly)v->Data());
5163  return FALSE;
5164}
5165static BOOLEAN jjidElem(leftv res, leftv v)
5166{
5167  res->data = (char *)idElem((ideal)v->Data());
5168  return FALSE;
5169}
5170static BOOLEAN jjmpDetBareiss(leftv res, leftv v)
5171{
5172  res->data = (char *)mp_DetBareiss((matrix)v->Data(),currRing);
5173  return FALSE;
5174}
5175static BOOLEAN jjidFreeModule(leftv res, leftv v)
5176{
5177  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5178  return FALSE;
5179}
5180static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5181{
5182  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5183  return FALSE;
5184}
5185static BOOLEAN jjrCharStr(leftv res, leftv v)
5186{
5187  res->data = rCharStr((ring)v->Data());
5188  return FALSE;
5189}
5190#ifndef MDEBUG
5191static BOOLEAN jjpHead(leftv res, leftv v)
5192{
5193  res->data = (char *)pHead((poly)v->Data());
5194  return FALSE;
5195}
5196#endif
5197static BOOLEAN jjidHead(leftv res, leftv v)
5198{
5199  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5200  return FALSE;
5201}
5202static BOOLEAN jjidMinBase(leftv res, leftv v)
5203{
5204  res->data = (char *)idMinBase((ideal)v->Data());
5205  return FALSE;
5206}
5207static BOOLEAN jjsyMinBase(leftv res, leftv v)
5208{
5209  res->data = (char *)syMinBase((ideal)v->Data());
5210  return FALSE;
5211}
5212static BOOLEAN jjpMaxComp(leftv res, leftv v)
5213{
5214  res->data = (char *)pMaxComp((poly)v->Data());
5215  return FALSE;
5216}
5217static BOOLEAN jjmpTrace(leftv res, leftv v)
5218{
5219  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5220  return FALSE;
5221}
5222static BOOLEAN jjmpTransp(leftv res, leftv v)
5223{
5224  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5225  return FALSE;
5226}
5227static BOOLEAN jjrOrdStr(leftv res, leftv v)
5228{
5229  res->data = rOrdStr((ring)v->Data());
5230  return FALSE;
5231}
5232static BOOLEAN jjrVarStr(leftv res, leftv v)
5233{
5234  res->data = rVarStr((ring)v->Data());
5235  return FALSE;
5236}
5237static BOOLEAN jjrParStr(leftv res, leftv v)
5238{
5239  res->data = rParStr((ring)v->Data());
5240  return FALSE;
5241}
5242static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5243{
5244  res->data=(char *)sySize((syStrategy)v->Data());
5245  return FALSE;
5246}
5247static BOOLEAN jjDIM_R(leftv res, leftv v)
5248{
5249  res->data = (char *)syDim((syStrategy)v->Data());
5250  return FALSE;
5251}
5252static BOOLEAN jjidTransp(leftv res, leftv v)
5253{
5254  res->data = (char *)idTransp((ideal)v->Data());
5255  return FALSE;
5256}
5257#else
5258#define XS(A)          -((short)A)
5259#define jjstrlen       (proc1)strlen
5260#define jjpLength      (proc1)pLength
5261#define jjidElem       (proc1)idElem
5262#define jjmpDetBareiss (proc1)mpDetBareiss
5263#define jjidFreeModule (proc1)idFreeModule
5264#define jjidVec2Ideal  (proc1)idVec2Ideal
5265#define jjrCharStr     (proc1)rCharStr
5266#ifndef MDEBUG
5267#define jjpHead        (proc1)pHeadProc
5268#endif
5269#define jjidHead       (proc1)idHead
5270#define jjidMinBase    (proc1)idMinBase
5271#define jjsyMinBase    (proc1)syMinBase
5272#define jjpMaxComp     (proc1)pMaxCompProc
5273#define jjrOrdStr      (proc1)rOrdStr
5274#define jjrVarStr      (proc1)rVarStr
5275#define jjrParStr      (proc1)rParStr
5276#define jjCOUNT_RES    (proc1)sySize
5277#define jjDIM_R        (proc1)syDim
5278#define jjidTransp     (proc1)idTransp
5279#endif
5280#endif
5281static BOOLEAN jjnInt(leftv res, leftv u)
5282{
5283  number n=(number)u->Data();
5284  res->data=(char *)(long)n_Int(n,currRing->cf);
5285  return FALSE;
5286}
5287static BOOLEAN jjnlInt(leftv res, leftv u)
5288{
5289  number n=(number)u->Data();
5290  res->data=(char *)(long)n_Int(n,coeffs_BIGINT );
5291  return FALSE;
5292}
5293/*=================== operations with 3 args.: static proc =================*/
5294/* must be ordered: first operations for chars (infix ops),
5295 * then alphabetically */
5296static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5297{
5298  char *s= (char *)u->Data();
5299  int   r = (int)(long)v->Data();
5300  int   c = (int)(long)w->Data();
5301  int l = strlen(s);
5302
5303  if ( (r<1) || (r>l) || (c<0) )
5304  {
5305    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5306    return TRUE;
5307  }
5308  res->data = (char *)omAlloc((long)(c+1));
5309  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5310  return FALSE;
5311}
5312static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5313{
5314  intvec *iv = (intvec *)u->Data();
5315  int   r = (int)(long)v->Data();
5316  int   c = (int)(long)w->Data();
5317  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5318  {
5319    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5320           r,c,u->Fullname(),iv->rows(),iv->cols());
5321    return TRUE;
5322  }
5323  res->data=u->data; u->data=NULL;
5324  res->rtyp=u->rtyp; u->rtyp=0;
5325  res->name=u->name; u->name=NULL;
5326  Subexpr e=jjMakeSub(v);
5327          e->next=jjMakeSub(w);
5328  if (u->e==NULL) res->e=e;
5329  else
5330  {
5331    Subexpr h=u->e;
5332    while (h->next!=NULL) h=h->next;
5333    h->next=e;
5334    res->e=u->e;
5335    u->e=NULL;
5336  }
5337  return FALSE;
5338}
5339static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5340{
5341  bigintmat *bim = (bigintmat *)u->Data();
5342  int   r = (int)(long)v->Data();
5343  int   c = (int)(long)w->Data();
5344  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5345  {
5346    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5347           r,c,u->Fullname(),bim->rows(),bim->cols());
5348    return TRUE;
5349  }
5350  res->data=u->data; u->data=NULL;
5351  res->rtyp=u->rtyp; u->rtyp=0;
5352  res->name=u->name; u->name=NULL;
5353  Subexpr e=jjMakeSub(v);
5354          e->next=jjMakeSub(w);
5355  if (u->e==NULL)
5356    res->e=e;
5357  else
5358  {
5359    Subexpr h=u->e;
5360    while (h->next!=NULL) h=h->next;
5361    h->next=e;
5362    res->e=u->e;
5363    u->e=NULL;
5364  }
5365  return FALSE;
5366}
5367static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5368{
5369  matrix m= (matrix)u->Data();
5370  int   r = (int)(long)v->Data();
5371  int   c = (int)(long)w->Data();
5372  //Print("gen. elem %d, %d\n",r,c);
5373  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5374  {
5375    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5376      MATROWS(m),MATCOLS(m));
5377    return TRUE;
5378  }
5379  res->data=u->data; u->data=NULL;
5380  res->rtyp=u->rtyp; u->rtyp=0;
5381  res->name=u->name; u->name=NULL;
5382  Subexpr e=jjMakeSub(v);
5383          e->next=jjMakeSub(w);
5384  if (u->e==NULL)
5385    res->e=e;
5386  else
5387  {
5388    Subexpr h=u->e;
5389    while (h->next!=NULL) h=h->next;
5390    h->next=e;
5391    res->e=u->e;
5392    u->e=NULL;
5393  }
5394  return FALSE;
5395}
5396static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5397{
5398  sleftv t;
5399  sleftv ut;
5400  leftv p=NULL;
5401  intvec *iv=(intvec *)w->Data();
5402  int l;
5403  BOOLEAN nok;
5404
5405  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5406  {
5407    WerrorS("cannot build expression lists from unnamed objects");
5408    return TRUE;
5409  }
5410  memcpy(&ut,u,sizeof(ut));
5411  memset(&t,0,sizeof(t));
5412  t.rtyp=INT_CMD;
5413  for (l=0;l< iv->length(); l++)
5414  {
5415    t.data=(char *)(long)((*iv)[l]);
5416    if (p==NULL)
5417    {
5418      p=res;
5419    }
5420    else
5421    {
5422      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5423      p=p->next;
5424    }
5425    memcpy(u,&ut,sizeof(ut));
5426    if (u->Typ() == MATRIX_CMD)
5427      nok=jjBRACK_Ma(p,u,v,&t);
5428    else /* INTMAT_CMD */
5429      nok=jjBRACK_Im(p,u,v,&t);
5430    if (nok)
5431    {
5432      while (res->next!=NULL)
5433      {
5434        p=res->next->next;
5435        omFreeBin((ADDRESS)res->next, sleftv_bin);
5436        // res->e aufraeumen !!!!
5437        res->next=p;
5438      }
5439      return TRUE;
5440    }
5441  }
5442  return FALSE;
5443}
5444static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5445{
5446  sleftv t;
5447  sleftv ut;
5448  leftv p=NULL;
5449  intvec *iv=(intvec *)v->Data();
5450  int l;
5451  BOOLEAN nok;
5452
5453  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5454  {
5455    WerrorS("cannot build expression lists from unnamed objects");
5456    return TRUE;
5457  }
5458  memcpy(&ut,u,sizeof(ut));
5459  memset(&t,0,sizeof(t));
5460  t.rtyp=INT_CMD;
5461  for (l=0;l< iv->length(); l++)
5462  {
5463    t.data=(char *)(long)((*iv)[l]);
5464    if (p==NULL)
5465    {
5466      p=res;
5467    }
5468    else
5469    {
5470      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5471      p=p->next;
5472    }
5473    memcpy(u,&ut,sizeof(ut));
5474    if (u->Typ() == MATRIX_CMD)
5475      nok=jjBRACK_Ma(p,u,&t,w);
5476    else /* INTMAT_CMD */
5477      nok=jjBRACK_Im(p,u,&t,w);
5478    if (nok)
5479    {
5480      while (res->next!=NULL)
5481      {
5482        p=res->next->next;
5483        omFreeBin((ADDRESS)res->next, sleftv_bin);
5484        // res->e aufraeumen !!
5485        res->next=p;
5486      }
5487      return TRUE;
5488    }
5489  }
5490  return FALSE;
5491}
5492static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5493{
5494  sleftv t1,t2,ut;
5495  leftv p=NULL;
5496  intvec *vv=(intvec *)v->Data();
5497  intvec *wv=(intvec *)w->Data();
5498  int vl;
5499  int wl;
5500  BOOLEAN nok;
5501
5502  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5503  {
5504    WerrorS("cannot build expression lists from unnamed objects");
5505    return TRUE;
5506  }
5507  memcpy(&ut,u,sizeof(ut));
5508  memset(&t1,0,sizeof(sleftv));
5509  memset(&t2,0,sizeof(sleftv));
5510  t1.rtyp=INT_CMD;
5511  t2.rtyp=INT_CMD;
5512  for (vl=0;vl< vv->length(); vl++)
5513  {
5514    t1.data=(char *)(long)((*vv)[vl]);
5515    for (wl=0;wl< wv->length(); wl++)
5516    {
5517      t2.data=(char *)(long)((*wv)[wl]);
5518      if (p==NULL)
5519      {
5520        p=res;
5521      }
5522      else
5523      {
5524        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5525        p=p->next;
5526      }
5527      memcpy(u,&ut,sizeof(ut));
5528      if (u->Typ() == MATRIX_CMD)
5529        nok=jjBRACK_Ma(p,u,&t1,&t2);
5530      else /* INTMAT_CMD */
5531        nok=jjBRACK_Im(p,u,&t1,&t2);
5532      if (nok)
5533      {
5534        res->CleanUp();
5535        return TRUE;
5536      }
5537    }
5538  }
5539  return FALSE;
5540}
5541static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5542{
5543  v->next=(leftv)omAllocBin(sleftv_bin);
5544  memcpy(v->next,w,sizeof(sleftv));
5545  memset(w,0,sizeof(sleftv));
5546  return jjPROC(res,u,v);
5547}
5548static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5549{
5550  intvec *iv;
5551  ideal m;
5552  lists l=(lists)omAllocBin(slists_bin);
5553  int k=(int)(long)w->Data();
5554  if (k>=0)
5555  {
5556    sm_CallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv, currRing);
5557    l->Init(2);
5558    l->m[0].rtyp=MODUL_CMD;
5559    l->m[1].rtyp=INTVEC_CMD;
5560    l->m[0].data=(void *)m;
5561    l->m[1].data=(void *)iv;
5562  }
5563  else
5564  {
5565    m=sm_CallSolv((ideal)u->Data(), currRing);
5566    l->Init(1);
5567    l->m[0].rtyp=IDEAL_CMD;
5568    l->m[0].data=(void *)m;
5569  }
5570  res->data = (char *)l;
5571  return FALSE;
5572}
5573static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5574{
5575  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5576  {
5577    WerrorS("3rd argument must be a name of a matrix");
5578    return TRUE;
5579  }
5580  ideal i=(ideal)u->Data();
5581  int rank=(int)i->rank;
5582  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5583  if (r) return TRUE;
5584  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5585  return FALSE;
5586}
5587static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5588{
5589  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5590           (ideal)(v->Data()),(poly)(w->Data()));
5591  return FALSE;
5592}
5593static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5594{
5595  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5596  {
5597    WerrorS("3rd argument must be a name of a matrix");
5598    return TRUE;
5599  }
5600  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5601  poly p=(poly)u->CopyD(POLY_CMD);
5602  ideal i=idInit(1,1);
5603  i->m[0]=p;
5604  sleftv t;
5605  memset(&t,0,sizeof(t));
5606  t.data=(char *)i;
5607  t.rtyp=IDEAL_CMD;
5608  int rank=1;
5609  if (u->Typ()==VECTOR_CMD)
5610  {
5611    i->rank=rank=pMaxComp(p);
5612    t.rtyp=MODUL_CMD;
5613  }
5614  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5615  t.CleanUp();
5616  if (r) return TRUE;
5617  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5618  return FALSE;
5619}
5620static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5621{
5622  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5623    (intvec *)w->Data());
5624  //setFlag(res,FLAG_STD);
5625  return FALSE;
5626}
5627static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5628{
5629  /*4
5630  * look for the substring what in the string where
5631  * starting at position n
5632  * return the position of the first char of what in where
5633  * or 0
5634  */
5635  int n=(int)(long)w->Data();
5636  char *where=(char *)u->Data();
5637  char *what=(char *)v->Data();
5638  char *found;
5639  if ((1>n)||(n>(int)strlen(where)))
5640  {
5641    Werror("start position %d out of range",n);
5642    return TRUE;
5643  }
5644  found = strchr(where+n-1,*what);
5645  if (*(what+1)!='\0')
5646  {
5647    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
5648    {
5649      found=strchr(found+1,*what);
5650    }
5651  }
5652  if (found != NULL)
5653  {
5654    res->data=(char *)((found-where)+1);
5655  }
5656  return FALSE;
5657}
5658static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
5659{
5660  if ((int)(long)w->Data()==0)
5661    res->data=(char *)walkProc(u,v);
5662  else
5663    res->data=(char *)fractalWalkProc(u,v);
5664  setFlag( res, FLAG_STD );
5665  return FALSE;
5666}
5667static BOOLEAN jjHILBERT3(leftv res, leftv u, leftv v, leftv w)
5668{
5669  intvec *wdegree=(intvec*)w->Data();
5670  if (wdegree->length()!=currRing->N)
5671  {
5672    Werror("weight vector must have size %d, not %d",
5673           currRing->N,wdegree->length());
5674    return TRUE;
5675  }
5676#ifdef HAVE_RINGS
5677  if (rField_is_Ring_Z(currRing))
5678  {
5679    ring origR = currRing;
5680    ring tempR = rCopy(origR);
5681    coeffs new_cf=nInitChar(n_Q,NULL);
5682    nKillChar(tempR->cf);
5683    tempR->cf=new_cf;
5684    rComplete(tempR);
5685    ideal uid = (ideal)u->Data();
5686    rChangeCurrRing(tempR);
5687    ideal uu = idrCopyR(uid, origR, currRing);
5688    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
5689    uuAsLeftv.rtyp = IDEAL_CMD;
5690    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
5691    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
5692    assumeStdFlag(&uuAsLeftv);
5693    Print("// NOTE: computation of Hilbert series etc. is being\n");
5694    Print("//       performed for generic fibre, that is, over Q\n");
5695    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
5696    intvec *iv=hFirstSeries(uu,module_w,currQuotient,wdegree);
5697    int returnWithTrue = 1;
5698    switch((int)(long)v->Data())
5699    {
5700      case 1:
5701        res->data=(void *)iv;
5702        returnWithTrue = 0;
5703      case 2:
5704        res->data=(void *)hSecondSeries(iv);
5705        delete iv;
5706        returnWithTrue = 0;
5707    }
5708    if (returnWithTrue)
5709    {
5710      WerrorS(feNotImplemented);
5711      delete iv;
5712    }
5713    idDelete(&uu);
5714    rChangeCurrRing(origR);
5715    rDelete(tempR);
5716    if (returnWithTrue) return TRUE; else return FALSE;
5717  }
5718#endif
5719  assumeStdFlag(u);
5720  intvec *module_w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
5721  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient,wdegree);
5722  switch((int)(long)v->Data())
5723  {
5724    case 1:
5725      res->data=(void *)iv;
5726      return FALSE;
5727    case 2:
5728      res->data=(void *)hSecondSeries(iv);
5729      delete iv;
5730      return FALSE;
5731  }
5732  WerrorS(feNotImplemented);
5733  delete iv;
5734  return TRUE;
5735}
5736static BOOLEAN jjHOMOG_ID_W(leftv res, leftv u, leftv v, leftv w)
5737{
5738  PrintS("TODO\n");
5739  int i=pVar((poly)v->Data());
5740  if (i==0)
5741  {
5742    WerrorS("ringvar expected");
5743    return TRUE;
5744  }
5745  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5746  int d=pWTotaldegree(p);
5747  pLmDelete(p);
5748  if (d==1)
5749    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
5750  else
5751    WerrorS("variable must have weight 1");
5752  return (d!=1);
5753}
5754static BOOLEAN jjHOMOG_P_W(leftv res, leftv u, leftv v,leftv w)
5755{
5756  PrintS("TODO\n");
5757  int i=pVar((poly)v->Data());
5758  if (i==0)
5759  {
5760    WerrorS("ringvar expected");
5761    return TRUE;
5762  }
5763  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
5764  int d=pWTotaldegree(p);
5765  pLmDelete(p);
5766  if (d==1)
5767    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
5768  else
5769    WerrorS("variable must have weight 1");
5770  return (d!=1);
5771}
5772static BOOLEAN jjINTMAT3(leftv res, leftv u, leftv v,leftv w)
5773{
5774  intvec* im= new intvec((int)(long)v->Data(),(int)(long)w->Data(), 0);
5775  intvec* arg = (intvec*) u->Data();
5776  int i, n = si_min(im->cols()*im->rows(), arg->cols()*arg->rows());
5777
5778  for (i=0; i<n; i++)
5779  {
5780    (*im)[i] = (*arg)[i];
5781  }
5782
5783  res->data = (char *)im;
5784  return FALSE;
5785}
5786static BOOLEAN jjJET_P_IV(leftv res, leftv u, leftv v, leftv w)
5787{
5788  short *iw=iv2array((intvec *)w->Data(),currRing);
5789  res->data = (char *)ppJetW((poly)u->Data(),(int)(long)v->Data(),iw);
5790  omFreeSize((ADDRESS)iw,(currRing->N+1)*sizeof(short));
5791  return FALSE;
5792}
5793static BOOLEAN jjJET_P_P(leftv res, leftv u, leftv v, leftv w)
5794{
5795  if (!pIsUnit((poly)v->Data()))
5796  {
5797    WerrorS("2nd argument must be a unit");
5798    return TRUE;
5799  }
5800  res->data = (char *)p_Series((int)(long)w->Data(),(poly)u->CopyD(),(poly)v->CopyD(),NULL,currRing);
5801  return FALSE;
5802}
5803static BOOLEAN jjJET_ID_IV(leftv res, leftv u, leftv v, leftv w)
5804{
5805  res->data = (char *)id_JetW((ideal)u->Data(),(int)(long)v->Data(),
5806                             (intvec *)w->Data(),currRing);
5807  return FALSE;
5808}
5809static BOOLEAN jjJET_ID_M(leftv res, leftv u, leftv v, leftv w)
5810{
5811  if (!mp_IsDiagUnit((matrix)v->Data(), currRing))
5812  {
5813    WerrorS("2nd argument must be a diagonal matrix of units");
5814    return TRUE;
5815  }
5816  res->data = (char *)idSeries((int)(long)w->Data(),(ideal)u->CopyD(),
5817                               (matrix)v->CopyD());
5818  return FALSE;
5819}
5820static BOOLEAN currRingIsOverIntegralDomain ()
5821{
5822  /* true for fields and Z, false otherwise */
5823  if (rField_is_Ring_PtoM(currRing)) return FALSE;
5824  if (rField_is_Ring_2toM(currRing)) return FALSE;
5825  if (rField_is_Ring_ModN(currRing)) return FALSE;
5826  return TRUE;
5827}
5828static BOOLEAN jjMINOR_M(leftv res, leftv v)
5829{
5830  /* Here's the use pattern for the minor command:
5831        minor ( matrix_expression m, int_expression minorSize,
5832                optional ideal_expression IasSB, optional int_expression k,
5833                optional string_expression algorithm,
5834                optional int_expression cachedMinors,
5835                optional int_expression cachedMonomials )
5836     This method here assumes that there are at least two arguments.
5837     - If IasSB is present, it must be a std basis. All minors will be
5838       reduced w.r.t. IasSB.
5839     - If k is absent, all non-zero minors will be computed.
5840       If k is present and k > 0, the first k non-zero minors will be
5841       computed.
5842       If k is present and k < 0, the first |k| minors (some of which
5843       may be zero) will be computed.
5844       If k is present and k = 0, an error is reported.
5845     - If algorithm is absent, all the following arguments must be absent too.
5846       In this case, a heuristic picks the best-suited algorithm (among
5847       Bareiss, Laplace, and Laplace with caching).
5848       If algorithm is present, it must be one of "Bareiss", "bareiss",
5849       "Laplace", "laplace", "Cache", "cache". In the cases "Cache" and
5850       "cache" two more arguments may be given, determining how many entries
5851       the cache may have at most, and how many cached monomials there are at
5852       most. (Cached monomials are counted over all cached polynomials.)
5853       If these two additional arguments are not provided, 200 and 100000
5854       will be used as defaults.
5855  */
5856  matrix m;
5857  leftv u=v->next;
5858  v->next=NULL;
5859  int v_typ=v->Typ();
5860  if (v_typ==MATRIX_CMD)
5861  {
5862     m = (const matrix)v->Data();
5863  }
5864  else
5865  {
5866    if (v_typ==0)
5867    {
5868      Werror("`%s` is undefined",v->Fullname());
5869      return TRUE;
5870    }
5871    // try to convert to MATRIX:
5872    int ii=iiTestConvert(v_typ,MATRIX_CMD);
5873    BOOLEAN bo;
5874    sleftv tmp;
5875    if (ii>0) bo=iiConvert(v_typ,MATRIX_CMD,ii,v,&tmp);
5876    else bo=TRUE;
5877    if (bo)
5878    {
5879      Werror("cannot convert %s to matrix",Tok2Cmdname(v_typ));
5880      return TRUE;
5881    }
5882    m=(matrix)tmp.data;
5883  }
5884  const int mk = (const int)(long)u->Data();
5885  bool noIdeal = true; bool noK = true; bool noAlgorithm = true;
5886  bool noCacheMinors = true; bool noCacheMonomials = true;
5887  ideal IasSB; int k; char* algorithm; int cacheMinors; int cacheMonomials;
5888
5889  /* here come the different cases of correct argument sets */
5890  if ((u->next != NULL) && (u->next->Typ() == IDEAL_CMD))
5891  {
5892    IasSB = (ideal)u->next->Data();
5893    noIdeal = false;
5894    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
5895    {
5896      k = (int)(long)u->next->next->Data();
5897      noK = false;
5898      assume(k != 0);
5899      if ((u->next->next->next != NULL) &&
5900          (u->next->next->next->Typ() == STRING_CMD))
5901      {
5902        algorithm = (char*)u->next->next->next->Data();
5903        noAlgorithm = false;
5904        if ((u->next->next->next->next != NULL) &&
5905            (u->next->next->next->next->Typ() == INT_CMD))
5906        {
5907          cacheMinors = (int)(long)u->next->next->next->next->Data();
5908          noCacheMinors = false;
5909          if ((u->next->next->next->next->next != NULL) &&
5910              (u->next->next->next->next->next->Typ() == INT_CMD))
5911          {
5912            cacheMonomials =
5913               (int)(long)u->next->next->next->next->next->Data();
5914            noCacheMonomials = false;
5915          }
5916        }
5917      }
5918    }
5919  }
5920  else if ((u->next != NULL) && (u->next->Typ() == INT_CMD))
5921  {
5922    k = (int)(long)u->next->Data();
5923    noK = false;
5924    assume(k != 0);
5925    if ((u->next->next != NULL) && (u->next->next->Typ() == STRING_CMD))
5926    {
5927      algorithm = (char*)u->next->next->Data();
5928      noAlgorithm = false;
5929      if ((u->next->next->next != NULL) &&
5930          (u->next->next->next->Typ() == INT_CMD))
5931      {
5932        cacheMinors = (int)(long)u->next->next->next->Data();
5933        noCacheMinors = false;
5934        if ((u->next->next->next->next != NULL) &&
5935            (u->next->next->next->next->Typ() == INT_CMD))
5936        {
5937          cacheMonomials = (int)(long)u->next->next->next->next->Data();
5938          noCacheMonomials = false;
5939        }
5940      }
5941    }
5942  }
5943  else if ((u->next != NULL) && (u->next->Typ() == STRING_CMD))
5944  {
5945    algorithm = (char*)u->next->Data();
5946    noAlgorithm = false;
5947    if ((u->next->next != NULL) && (u->next->next->Typ() == INT_CMD))
5948    {
5949      cacheMinors = (int)(long)u->next->next->Data();
5950      noCacheMinors = false;
5951      if ((u->next->next->next != NULL) &&
5952          (u->next->next->next->Typ() == INT_CMD))
5953      {
5954        cacheMonomials = (int)(long)u->next->next->next->Data();
5955        noCacheMonomials = false;
5956      }
5957    }
5958  }
5959
5960  /* upper case conversion for the algorithm if present */
5961  if (!noAlgorithm)
5962  {
5963    if (strcmp(algorithm, "bareiss") == 0)
5964      algorithm = (char*)"Bareiss";
5965    if (strcmp(algorithm, "laplace") == 0)
5966      algorithm = (char*)"Laplace";
5967    if (strcmp(algorithm, "cache") == 0)
5968      algorithm = (char*)"Cache";
5969  }
5970
5971  v->next=u;
5972  /* here come some tests */
5973  if (!noIdeal)
5974  {
5975    assumeStdFlag(u->next);
5976  }
5977  if ((!noK) && (k == 0))
5978  {
5979    WerrorS("Provided number of minors to be computed is zero.");
5980    return TRUE;
5981  }
5982  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") != 0)
5983      && (strcmp(algorithm, "Laplace") != 0)
5984      && (strcmp(algorithm, "Cache") != 0))
5985  {
5986    WerrorS("Expected as algorithm one of 'B/bareiss', 'L/laplace', or 'C/cache'.");
5987    return TRUE;
5988  }
5989  if ((!noAlgorithm) && (strcmp(algorithm, "Bareiss") == 0)
5990      && (!currRingIsOverIntegralDomain()))
5991  {
5992    Werror("Bareiss algorithm not defined over coefficient rings %s",
5993           "with zero divisors.");
5994    return TRUE;
5995  }
5996  if ((mk < 1) || (mk > m->rows()) || (mk > m->cols()))
5997  {
5998    Werror("invalid size of minors: %d (matrix is (%d x %d))", mk,
5999           m->rows(), m->cols());
6000    return TRUE;
6001  }
6002  if ((!noAlgorithm) && (strcmp(algorithm, "Cache") == 0)
6003      && (noCacheMinors || noCacheMonomials))
6004  {
6005    cacheMinors = 200;
6006    cacheMonomials = 100000;
6007  }
6008
6009  /* here come the actual procedure calls */
6010  if (noAlgorithm)
6011    res->data = getMinorIdealHeuristic(m, mk, (noK ? 0 : k),
6012                                       (noIdeal ? 0 : IasSB), false);
6013  else if (strcmp(algorithm, "Cache") == 0)
6014    res->data = getMinorIdealCache(m, mk, (noK ? 0 : k),
6015                                   (noIdeal ? 0 : IasSB), 3, cacheMinors,
6016                                   cacheMonomials, false);
6017  else
6018    res->data = getMinorIdeal(m, mk, (noK ? 0 : k), algorithm,
6019                              (noIdeal ? 0 : IasSB), false);
6020  if (v_typ!=MATRIX_CMD) idDelete((ideal *)&m);
6021  res->rtyp = IDEAL_CMD;
6022  return FALSE;
6023}
6024static BOOLEAN jjNEWSTRUCT3(leftv, leftv u, leftv v, leftv w)
6025{
6026  // u: the name of the new type
6027  // v: the parent type
6028  // w: the elements
6029  newstruct_desc d=newstructChildFromString((const char *)v->Data(),
6030                                            (const char *)w->Data());
6031  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
6032  return (d==NULL);
6033}
6034static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w)
6035{
6036  // handles preimage(r,phi,i) and kernel(r,phi)
6037  idhdl h;
6038  ring rr;
6039  map mapping;
6040  BOOLEAN kernel_cmd= (iiOp==KERNEL_CMD);
6041
6042  if ((v->name==NULL) || (!kernel_cmd && (w->name==NULL)))
6043  {
6044    WerrorS("2nd/3rd arguments must have names");
6045    return TRUE;
6046  }
6047  rr=(ring)u->Data();
6048  const char *ring_name=u->Name();
6049  if ((h=rr->idroot->get(v->name,myynest))!=NULL)
6050  {
6051    if (h->typ==MAP_CMD)
6052    {
6053      mapping=IDMAP(h);
6054      idhdl preim_ring=IDROOT->get(mapping->preimage,myynest);
6055      if ((preim_ring==NULL)
6056      || (IDRING(preim_ring)!=currRing))
6057      {
6058        Werror("preimage ring `%s` is not the basering",mapping->preimage);
6059        return TRUE;
6060      }
6061    }
6062    else if (h->typ==IDEAL_CMD)
6063    {
6064      mapping=IDMAP(h);
6065    }
6066    else
6067    {
6068      Werror("`%s` is no map nor ideal",IDID(h));
6069      return TRUE;
6070    }
6071  }
6072  else
6073  {
6074    Werror("`%s` is not defined in `%s`",v->name,ring_name);
6075    return TRUE;
6076  }
6077  ideal image;
6078  if (kernel_cmd) image=idInit(1,1);
6079  else
6080  {
6081    if ((h=rr->idroot->get(w->name,myynest))!=NULL)
6082    {
6083      if (h->typ==IDEAL_CMD)
6084      {
6085        image=IDIDEAL(h);
6086      }
6087      else
6088      {
6089        Werror("`%s` is no ideal",IDID(h));
6090        return TRUE;
6091      }
6092    }
6093    else
6094    {
6095      Werror("`%s` is not defined in `%s`",w->name,ring_name);
6096      return TRUE;
6097    }
6098  }
6099  if (((currRing->qideal!=NULL) && (rHasLocalOrMixedOrdering_currRing()))
6100  || ((rr->qideal!=NULL) && (rHasLocalOrMixedOrdering(rr))))
6101  {
6102    WarnS("preimage in local qring may be wrong: use Ring::preimageLoc instead");
6103  }
6104  res->data=(char *)maGetPreimage(rr,mapping,image,currRing);
6105  if (kernel_cmd) idDelete(&image);
6106  return (res->data==NULL/* is of type ideal, should not be NULL*/);
6107}
6108static BOOLEAN jjRANDOM_Im(leftv res, leftv u, leftv v, leftv w)
6109{
6110  int di, k;
6111  int i=(int)(long)u->Data();
6112  int r=(int)(long)v->Data();
6113  int c=(int)(long)w->Data();
6114  if ((r<=0) || (c<=0)) return TRUE;
6115  intvec *iv = new intvec(r, c, 0);
6116  if (iv->rows()==0)
6117  {
6118    delete iv;
6119    return TRUE;
6120  }
6121  if (i!=0)
6122  {
6123    if (i<0) i = -i;
6124    di = 2 * i + 1;
6125    for (k=0; k<iv->length(); k++)
6126    {
6127      (*iv)[k] = ((siRand() % di) - i);
6128    }
6129  }
6130  res->data = (char *)iv;
6131  return FALSE;
6132}
6133static BOOLEAN jjSUBST_Test(leftv v,leftv w,
6134  int &ringvar, poly &monomexpr)
6135{
6136  monomexpr=(poly)w->Data();
6137  poly p=(poly)v->Data();
6138#if 0
6139  if (pLength(monomexpr)>1)
6140  {
6141    Werror("`%s` substitutes a ringvar only by a term",
6142      Tok2Cmdname(SUBST_CMD));
6143    return TRUE;
6144  }
6145#endif
6146  if ((ringvar=pVar(p))==0)
6147  {
6148    if (rField_is_Extension(currRing))
6149    {
6150      assume(currRing->cf->extRing!=NULL);
6151      number n = pGetCoeff(p);
6152      ringvar= -n_IsParam(n, currRing);
6153    }
6154    if(ringvar==0)
6155    {
6156      WerrorS("ringvar/par expected");
6157      return TRUE;
6158    }
6159  }
6160  return FALSE;
6161}
6162static BOOLEAN jjSUBST_P(leftv res, leftv u, leftv v,leftv w)
6163{
6164  int ringvar;
6165  poly monomexpr;
6166  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6167  if (nok) return TRUE;
6168  poly p=(poly)u->Data();
6169  if (ringvar>0)
6170  {
6171    if ((monomexpr!=NULL) && (p!=NULL) && (pTotaldegree(p)!=0) &&
6172    ((unsigned long)pTotaldegree(monomexpr) > (currRing->bitmask / (unsigned long)pTotaldegree(p))))
6173    {
6174      Warn("possible OVERFLOW in subst, max exponent is %ld, subtituting deg %d by deg %d",currRing->bitmask, pTotaldegree(monomexpr), pTotaldegree(p));
6175      //return TRUE;
6176    }
6177    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6178      res->data = pSubst((poly)u->CopyD(res->rtyp),ringvar,monomexpr);
6179    else
6180      res->data= pSubstPoly(p,ringvar,monomexpr);
6181  }
6182  else
6183  {
6184    res->data=pSubstPar(p,-ringvar,monomexpr);
6185  }
6186  return FALSE;
6187}
6188static BOOLEAN jjSUBST_Id(leftv res, leftv u, leftv v,leftv w)
6189{
6190  int ringvar;
6191  poly monomexpr;
6192  BOOLEAN nok=jjSUBST_Test(v,w,ringvar,monomexpr);
6193  if (nok) return TRUE;
6194  if (ringvar>0)
6195  {
6196    if ((monomexpr==NULL)||(pNext(monomexpr)==NULL))
6197      res->data = id_Subst((ideal)u->CopyD(res->rtyp), ringvar, monomexpr, currRing);
6198    else
6199      res->data = idSubstPoly((ideal)u->Data(),ringvar,monomexpr);
6200  }
6201  else
6202  {
6203    res->data = idSubstPar((ideal)u->Data(),-ringvar,monomexpr);
6204  }
6205  return FALSE;
6206}
6207// we do not want to have jjSUBST_Id_X inlined:
6208static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w,
6209                            int input_type);
6210static BOOLEAN jjSUBST_Id_I(leftv res, leftv u, leftv v,leftv w)
6211{
6212  return jjSUBST_Id_X(res,u,v,w,INT_CMD);
6213}
6214static BOOLEAN jjSUBST_Id_N(leftv res, leftv u, leftv v,leftv w)
6215{
6216  return jjSUBST_Id_X(res,u,v,w,NUMBER_CMD);
6217}
6218static BOOLEAN jjSUBST_Id_X(leftv res, leftv u, leftv v,leftv w, int input_type)
6219{
6220  sleftv tmp;
6221  memset(&tmp,0,sizeof(tmp));
6222  // do not check the result, conversion from int/number to poly works always
6223  iiConvert(input_type,POLY_CMD,iiTestConvert(input_type,POLY_CMD),w,&tmp);
6224  BOOLEAN b=jjSUBST_Id(res,u,v,&tmp);
6225  tmp.CleanUp();
6226  return b;
6227}
6228static BOOLEAN jjMATRIX_Id(leftv res, leftv u, leftv v,leftv w)
6229{
6230  int mi=(int)(long)v->Data();
6231  int ni=(int)(long)w->Data();
6232  if ((mi<1)||(ni<1))
6233  {
6234    Werror("converting ideal to matrix: dimensions must be positive(%dx%d)",mi,ni);
6235    return TRUE;
6236  }
6237  matrix m=mpNew(mi,ni);
6238  ideal I=(ideal)u->CopyD(IDEAL_CMD);
6239  int i=si_min(IDELEMS(I),mi*ni);
6240  //for(i=i-1;i>=0;i--)
6241  //{
6242  //  m->m[i]=I->m[i];
6243  //  I->m[i]=NULL;
6244  //}
6245  memcpy(m->m,I->m,i*sizeof(poly));
6246  memset(I->m,0,i*sizeof(poly));
6247  id_Delete(&I,currRing);
6248  res->data = (char *)m;
6249  return FALSE;
6250}
6251static BOOLEAN jjMATRIX_Mo(leftv res, leftv u, leftv v,leftv w)
6252{
6253  int mi=(int)(long)v->Data();
6254  int ni=(int)(long)w->Data();
6255  if ((mi<1)||(ni<1))
6256  {
6257    Werror("converting module to matrix: dimensions must be positive(%dx%d)",mi,ni);
6258    return TRUE;
6259  }
6260  res->data = (char *)id_Module2formatedMatrix((ideal)u->CopyD(MODUL_CMD),
6261           mi,ni,currRing);
6262  return FALSE;
6263}
6264static BOOLEAN jjMATRIX_Ma(leftv res, leftv u, leftv v,leftv w)
6265{
6266  int mi=(int)(long)v->Data();
6267  int ni=(int)(long)w->Data();
6268  if ((mi<1)||(ni<1))
6269  {
6270     Werror("converting matrix to matrix: dimensions must be positive(%dx%d)",mi,ni);
6271    return TRUE;
6272  }
6273  matrix m=mpNew(mi,ni);
6274  matrix I=(matrix)u->CopyD(MATRIX_CMD);
6275  int r=si_min(MATROWS(I),mi);
6276  int c=si_min(MATCOLS(I),ni);
6277  int i,j;
6278  for(i=r;i>0;i--)
6279  {
6280    for(j=c;j>0;j--)
6281    {
6282      MATELEM(m,i,j)=MATELEM(I,i,j);
6283      MATELEM(I,i,j)=NULL;
6284    }
6285  }
6286  id_Delete((ideal *)&I,currRing);
6287  res->data = (char *)m;
6288  return FALSE;
6289}
6290static BOOLEAN jjLIFT3(leftv res, leftv u, leftv v, leftv w)
6291{
6292  if (w->rtyp!=IDHDL) return TRUE;
6293  BITSET save_test=test;
6294  int ul= IDELEMS((ideal)u->Data());
6295  int vl= IDELEMS((ideal)v->Data());
6296  ideal m
6297    = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,hasFlag(u,FLAG_STD),
6298             FALSE, (matrix *)(&(IDMATRIX((idhdl)(w->data)))));
6299  if (m==NULL) return TRUE;
6300  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
6301  test=save_test;
6302  return FALSE;
6303}
6304static BOOLEAN jjLIFTSTD3(leftv res, leftv u, leftv v, leftv w)
6305{
6306  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
6307  if ((w->rtyp!=IDHDL)||(w->e!=NULL)) return TRUE;
6308  idhdl hv=(idhdl)v->data;
6309  idhdl hw=(idhdl)w->data;
6310  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
6311  res->data = (char *)idLiftStd((ideal)u->Data(),
6312                                &(hv->data.umatrix),testHomog,
6313                                &(hw->data.uideal));
6314  setFlag(res,FLAG_STD); v->flag=0; w->flag=0;
6315  return FALSE;
6316}
6317static BOOLEAN jjREDUCE3_CP(leftv res, leftv u, leftv v, leftv w)
6318{
6319  assumeStdFlag(v);
6320  if (!idIsZeroDim((ideal)v->Data()))
6321  {
6322    Werror("`%s` must be 0-dimensional",v->Name());
6323    return TRUE;
6324  }
6325  res->data = (char *)redNF((ideal)v->CopyD(),(poly)u->CopyD(),
6326    (poly)w->CopyD());
6327  return FALSE;
6328}
6329static BOOLEAN jjREDUCE3_CID(leftv res, leftv u, leftv v, leftv w)
6330{
6331  assumeStdFlag(v);
6332  if (!idIsZeroDim((ideal)v->Data()))
6333  {
6334    Werror("`%s` must be 0-dimensional",v->Name());
6335    return TRUE;
6336  }
6337  res->data = (char *)redNF((ideal)v->CopyD(),(ideal)u->CopyD(),
6338    (matrix)w->CopyD());
6339  return FALSE;
6340}
6341static BOOLEAN jjREDUCE3_P(leftv res, leftv u, leftv v, leftv w)
6342{
6343  assumeStdFlag(v);
6344  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data(),
6345    0,(int)(long)w->Data());
6346  return FALSE;
6347}
6348static BOOLEAN jjREDUCE3_ID(leftv res, leftv u, leftv v, leftv w)
6349{
6350  assumeStdFlag(v);
6351  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(ideal)u->Data(),
6352    0,(int)(long)w->Data());
6353  return FALSE;
6354}
6355#ifdef OLD_RES
6356static BOOLEAN jjRES3(leftv res, leftv u, leftv v, leftv w)
6357{
6358  int maxl=(int)v->Data();
6359  ideal u_id=(ideal)u->Data();
6360  int l=0;
6361  resolvente r;
6362  intvec **weights=NULL;
6363  int wmaxl=maxl;
6364  maxl--;
6365  if ((maxl==-1) && (iiOp!=MRES_CMD))
6366    maxl = currRing->N-1;
6367  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
6368  {
6369    intvec * iv=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
6370    if (iv!=NULL)
6371    {
6372      l=1;
6373      if (!idTestHomModule(u_id,currQuotient,iv))
6374      {
6375        WarnS("wrong weights");
6376        iv=NULL;
6377      }
6378      else
6379      {
6380        weights = (intvec**)omAlloc0Bin(char_ptr_bin);
6381        weights[0] = ivCopy(iv);
6382      }
6383    }
6384    r=syResolvente(u_id,maxl,&l, &weights, iiOp==MRES_CMD);
6385  }
6386  else
6387    r=sySchreyerResolvente((ideal)u->Data(),maxl+1,&l);
6388  if (r==NULL) return TRUE;
6389  int t3=u->Typ();
6390  iiMakeResolv(r,l,wmaxl,w->name,t3,weights);
6391  return FALSE;
6392}
6393#endif
6394static BOOLEAN jjRING3(leftv res, leftv u, leftv v, leftv w)
6395{
6396  res->data=(void *)rInit(u,v,w);
6397  return (res->data==NULL);
6398}
6399static BOOLEAN jjSTATUS3(leftv res, leftv u, leftv v, leftv w)
6400{
6401  int yes;
6402  jjSTATUS2(res, u, v);
6403  yes = (strcmp((char *) res->data, (char *) w->Data()) == 0);
6404  omFree((ADDRESS) res->data);
6405  res->data = (void *)(long)yes;
6406  return FALSE;
6407}
6408static BOOLEAN jjSTD_HILB_W(leftv res, leftv u, leftv v, leftv w)
6409{
6410  intvec *vw=(intvec *)w->Data(); // weights of vars
6411  if (vw->length()!=currRing->N)
6412  {
6413    Werror("%d weights for %d variables",vw->length(),currRing->N);
6414    return TRUE;
6415  }
6416  ideal result;
6417  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
6418  tHomog hom=testHomog;
6419  ideal u_id=(ideal)(u->Data());
6420  if (ww!=NULL)
6421  {
6422    if (!idTestHomModule(u_id,currQuotient,ww))
6423    {
6424      WarnS("wrong weights");
6425      ww=NULL;
6426    }
6427    else
6428    {
6429      ww=ivCopy(ww);
6430      hom=isHomog;
6431    }
6432  }
6433  result=kStd(u_id,
6434              currQuotient,
6435              hom,
6436              &ww,                  // module weights
6437              (intvec *)v->Data(),  // hilbert series
6438              0,0,                  // syzComp, newIdeal
6439              vw);                  // weights of vars
6440  idSkipZeroes(result);
6441  res->data = (char *)result;
6442  setFlag(res,FLAG_STD);
6443  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
6444  return FALSE;
6445}
6446
6447/*=================== operations with many arg.: static proc =================*/
6448/* must be ordered: first operations for chars (infix ops),
6449 * then alphabetically */
6450static BOOLEAN jjBREAK0(leftv, leftv)
6451{
6452#ifdef HAVE_SDB
6453  sdb_show_bp();
6454#endif
6455  return FALSE;
6456}
6457static BOOLEAN jjBREAK1(leftv, leftv v)
6458{
6459#ifdef HAVE_SDB
6460  if(v->Typ()==PROC_CMD)
6461  {
6462    int lineno=0;
6463    if((v->next!=NULL) && (v->next->Typ()==INT_CMD))
6464    {
6465      lineno=(int)(long)v->next->Data();
6466    }
6467    return sdb_set_breakpoint(v->Name(),lineno);
6468  }
6469  return TRUE;
6470#else
6471 return FALSE;
6472#endif
6473}
6474static BOOLEAN jjCALL1ARG(leftv res, leftv v)
6475{
6476  return iiExprArith1(res,v,iiOp);
6477}
6478static BOOLEAN jjCALL2ARG(leftv res, leftv u)
6479{
6480  leftv v=u->next;
6481  u->next=NULL;
6482  BOOLEAN b=iiExprArith2(res,u,iiOp,v, (iiOp > 255));
6483  u->next=v;
6484  return b;
6485}
6486static BOOLEAN jjCALL3ARG(leftv res, leftv u)
6487{
6488  leftv v = u->next;
6489  leftv w = v->next;
6490  u->next = NULL;
6491  v->next = NULL;
6492  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
6493  u->next = v;
6494  v->next = w;
6495  return b;
6496}
6497
6498static BOOLEAN jjCOEF_M(leftv, leftv v)
6499{
6500  if((v->Typ() != VECTOR_CMD)
6501  || (v->next->Typ() != POLY_CMD)
6502  || (v->next->next->Typ() != MATRIX_CMD)
6503  || (v->next->next->next->Typ() != MATRIX_CMD))
6504     return TRUE;
6505  if (v->next->next->rtyp!=IDHDL) return TRUE;
6506  idhdl c=(idhdl)v->next->next->data;
6507  if (v->next->next->next->rtyp!=IDHDL) return TRUE;
6508  idhdl m=(idhdl)v->next->next->next->data;
6509  idDelete((ideal *)&(c->data.uideal));
6510  idDelete((ideal *)&(m->data.uideal));
6511  mp_Coef2((poly)v->Data(),(poly)v->next->Data(),
6512    (matrix *)&(c->data.umatrix),(matrix *)&(m->data.umatrix),currRing);
6513  return FALSE;
6514}
6515
6516static BOOLEAN jjDIVISION4(leftv res, leftv v)
6517{ // may have 3 or 4 arguments
6518  leftv v1=v;
6519  leftv v2=v1->next;
6520  leftv v3=v2->next;
6521  leftv v4=v3->next;
6522  assumeStdFlag(v2);
6523
6524  int i1=iiTestConvert(v1->Typ(),MODUL_CMD);
6525  int i2=iiTestConvert(v2->Typ(),MODUL_CMD);
6526
6527  if((i1==0)||(i2==0)
6528  ||(v3->Typ()!=INT_CMD)||((v4!=NULL)&&(v4->Typ()!=INTVEC_CMD)))
6529  {
6530    WarnS("<module>,<module>,<int>[,<intvec>] expected!");
6531    return TRUE;
6532  }
6533
6534  sleftv w1,w2;
6535  iiConvert(v1->Typ(),MODUL_CMD,i1,v1,&w1);
6536  iiConvert(v2->Typ(),MODUL_CMD,i2,v2,&w2);
6537  ideal P=(ideal)w1.Data();
6538  ideal Q=(ideal)w2.Data();
6539
6540  int n=(int)(long)v3->Data();
6541  short *w=NULL;
6542  if(v4!=NULL)
6543  {
6544    w=iv2array((intvec *)v4->Data(),currRing);
6545    short *w0=w+1;
6546    int i=currRing->N;
6547    while(i>0&&*w0>0)
6548    {
6549      w0++;
6550      i--;
6551    }
6552    if(i>0)
6553      WarnS("not all weights are positive!");
6554  }
6555
6556  matrix T;
6557  ideal R;
6558  idLiftW(P,Q,n,T,R,w);
6559
6560  w1.CleanUp();
6561  w2.CleanUp();
6562  if(w!=NULL)
6563    omFree(w);
6564
6565  lists L=(lists) omAllocBin(slists_bin);
6566  L->Init(2);
6567  L->m[1].rtyp=v1->Typ();
6568  if(v1->Typ()==POLY_CMD||v1->Typ()==VECTOR_CMD)
6569  {
6570    if(v1->Typ()==POLY_CMD)
6571      p_Shift(&R->m[0],-1,currRing);
6572    L->m[1].data=(void *)R->m[0];
6573    R->m[0]=NULL;
6574    idDelete(&R);
6575  }
6576  else if(v1->Typ()==IDEAL_CMD||v1->Typ()==MATRIX_CMD)
6577    L->m[1].data=(void *)id_Module2Matrix(R,currRing);
6578  else
6579  {
6580    L->m[1].rtyp=MODUL_CMD;
6581    L->m[1].data=(void *)R;
6582  }
6583  L->m[0].rtyp=MATRIX_CMD;
6584  L->m[0].data=(char *)T;
6585
6586  res->data=L;
6587  res->rtyp=LIST_CMD;
6588
6589  return FALSE;
6590}
6591
6592//static BOOLEAN jjEXPORTTO_M(leftv res, leftv u)
6593//{
6594//  int l=u->listLength();
6595//  if (l<2) return TRUE;
6596//  BOOLEAN b;
6597//  leftv v=u->next;
6598//  leftv zz=v;
6599//  leftv z=zz;
6600//  u->next=NULL;
6601//  do
6602//  {
6603//    leftv z=z->next;
6604//    b=iiExprArith2(res,u,iiOp,z, (iiOp > 255));
6605//    if (b) break;
6606//  } while (z!=NULL);
6607//  u->next=zz;
6608//  return b;
6609//}
6610static BOOLEAN jjIDEAL_PL(leftv res, leftv v)
6611{
6612  int s=1;
6613  leftv h=v;
6614  if (h!=NULL) s=exprlist_length(h);
6615  ideal id=idInit(s,1);
6616  int rank=1;
6617  int i=0;
6618  poly p;
6619  while (h!=NULL)
6620  {
6621    switch(h->Typ())
6622    {
6623      case POLY_CMD:
6624      {
6625        p=(poly)h->CopyD(POLY_CMD);
6626        break;
6627      }
6628      case INT_CMD:
6629      {
6630        number n=nInit((int)(long)h->Data());
6631        if (!nIsZero(n))
6632        {
6633          p=pNSet(n);
6634        }
6635        else
6636        {
6637          p=NULL;
6638          nDelete(&n);
6639        }
6640        break;
6641      }
6642      case BIGINT_CMD:
6643      {
6644        number b=(number)h->Data();
6645        number n=n_Init_bigint(b,coeffs_BIGINT,currRing->cf);
6646        if (!nIsZero(n))
6647        {
6648          p=pNSet(n);
6649        }
6650        else
6651        {
6652          p=NULL;
6653          nDelete(&n);
6654        }
6655        break;
6656      }
6657      case NUMBER_CMD:
6658      {
6659        number n=(number)h->CopyD(NUMBER_CMD);
6660        if (!nIsZero(n))
6661        {
6662          p=pNSet(n);
6663        }
6664        else
6665        {
6666          p=NULL;
6667          nDelete(&n);
6668        }
6669        break;
6670      }
6671      case VECTOR_CMD:
6672      {
6673        p=(poly)h->CopyD(VECTOR_CMD);
6674        if (iiOp!=MODUL_CMD)
6675        {
6676          idDelete(&id);
6677          pDelete(&p);
6678          return TRUE;
6679        }
6680        rank=si_max(rank,(int)pMaxComp(p));
6681        break;
6682      }
6683      default:
6684      {
6685        idDelete(&id);
6686        return TRUE;
6687      }
6688    }
6689    if ((iiOp==MODUL_CMD)&&(p!=NULL)&&(pGetComp(p)==0))
6690    {
6691      pSetCompP(p,1);
6692    }
6693    id->m[i]=p;
6694    i++;
6695    h=h->next;
6696  }
6697  id->rank=rank;
6698  res->data=(char *)id;
6699  return FALSE;
6700}
6701static BOOLEAN jjINTERSECT_PL(leftv res, leftv v)
6702{
6703  leftv h=v;
6704  int l=v->listLength();
6705  resolvente r=(resolvente)omAlloc0(l*sizeof(ideal));
6706  BOOLEAN *copied=(BOOLEAN *)omAlloc0(l*sizeof(BOOLEAN));
6707  int t=0;
6708  // try to convert to IDEAL_CMD
6709  while (h!=NULL)
6710  {
6711    if (iiTestConvert(h->Typ(),IDEAL_CMD)!=0)
6712    {
6713      t=IDEAL_CMD;
6714    }
6715    else break;
6716    h=h->next;
6717  }
6718  // if failure, try MODUL_CMD
6719  if (t==0)
6720  {
6721    h=v;
6722    while (h!=NULL)
6723    {
6724      if (iiTestConvert(h->Typ(),MODUL_CMD)!=0)
6725      {
6726        t=MODUL_CMD;
6727      }
6728      else break;
6729      h=h->next;
6730    }
6731  }
6732  // check for success  in converting
6733  if (t==0)
6734  {
6735    WerrorS("cannot convert to ideal or module");
6736    return TRUE;
6737  }
6738  // call idMultSect
6739  h=v;
6740  int i=0;
6741  sleftv tmp;
6742  while (h!=NULL)
6743  {
6744    if (h->Typ()==t)
6745    {
6746      r[i]=(ideal)h->Data(); /*no copy*/
6747      h=h->next;
6748    }
6749    else if(iiConvert(h->Typ(),t,iiTestConvert(h->Typ(),t),h,&tmp))
6750    {
6751      omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
6752      omFreeSize((ADDRESS)r,l*sizeof(ideal));
6753      Werror("cannot convert arg. %d to %s",i+1,Tok2Cmdname(t));
6754      return TRUE;
6755    }
6756    else
6757    {
6758      r[i]=(ideal)tmp.Data(); /*now it's a copy*/
6759      copied[i]=TRUE;
6760      h=tmp.next;
6761    }
6762    i++;
6763  }
6764  res->rtyp=t;
6765  res->data=(char *)idMultSect(r,i);
6766  while(i>0)
6767  {
6768    i--;
6769    if (copied[i]) idDelete(&(r[i]));
6770  }
6771  omFreeSize((ADDRESS)copied,l*sizeof(BOOLEAN));
6772  omFreeSize((ADDRESS)r,l*sizeof(ideal));
6773  return FALSE;
6774}
6775static BOOLEAN jjLU_INVERSE(leftv res, leftv v)
6776{
6777  /* computation of the inverse of a quadratic matrix A
6778     using the L-U-decomposition of A;
6779     There are two valid parametrisations:
6780     1) exactly one argument which is just the matrix A,
6781     2) exactly three arguments P, L, U which already
6782        realise the L-U-decomposition of A, that is,
6783        P * A = L * U, and P, L, and U satisfy the
6784        properties decribed in method 'jjLU_DECOMP';
6785        see there;
6786     If A is invertible, the list [1, A^(-1)] is returned,
6787     otherwise the list [0] is returned. Thus, the user may
6788     inspect the first entry of the returned list to see
6789     whether A is invertible. */
6790  matrix iMat; int invertible;
6791  if (v->next == NULL)
6792  {
6793    if (v->Typ() != MATRIX_CMD)
6794    {
6795      Werror("expected either one or three matrices");
6796      return TRUE;
6797    }
6798    else
6799    {
6800      matrix aMat = (matrix)v->Data();
6801      int rr = aMat->rows();
6802      int cc = aMat->cols();
6803      if (rr != cc)
6804      {
6805        Werror("given matrix (%d x %d) is not quadratic, hence not invertible", rr, cc);
6806        return TRUE;
6807      }
6808      invertible = luInverse(aMat, iMat);
6809    }
6810  }
6811  else if ((v->Typ() == MATRIX_CMD) &&
6812           (v->next->Typ() == MATRIX_CMD) &&
6813           (v->next->next != NULL) &&
6814           (v->next->next->Typ() == MATRIX_CMD) &&
6815           (v->next->next->next == NULL))
6816  {
6817     matrix pMat = (matrix)v->Data();
6818     matrix lMat = (matrix)v->next->Data();
6819     matrix uMat = (matrix)v->next->next->Data();
6820     int rr = uMat->rows();
6821     int cc = uMat->cols();
6822     if (rr != cc)
6823     {
6824       Werror("third matrix (%d x %d) is not quadratic, hence not invertible",
6825              rr, cc);
6826       return TRUE;
6827     }
6828     invertible = luInverseFromLUDecomp(pMat, lMat, uMat, iMat);
6829  }
6830  else
6831  {
6832    Werror("expected either one or three matrices");
6833    return TRUE;
6834  }
6835
6836  /* build the return structure; a list with either one or two entries */
6837  lists ll = (lists)omAllocBin(slists_bin);
6838  if (invertible)
6839  {
6840    ll->Init(2);
6841    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)invertible;
6842    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)iMat;
6843  }
6844  else
6845  {
6846    ll->Init(1);
6847    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)invertible;
6848  }
6849
6850  res->data=(char*)ll;
6851  return FALSE;
6852}
6853static BOOLEAN jjLU_SOLVE(leftv res, leftv v)
6854{
6855  /* for solving a linear equation system A * x = b, via the
6856     given LU-decomposition of the matrix A;
6857     There is one valid parametrisation:
6858     1) exactly four arguments P, L, U, b;
6859        P, L, and U realise the L-U-decomposition of A, that is,
6860        P * A = L * U, and P, L, and U satisfy the
6861        properties decribed in method 'jjLU_DECOMP';
6862        see there;
6863        b is the right-hand side vector of the equation system;
6864     The method will return a list of either 1 entry or three entries:
6865     1) [0] if there is no solution to the system;
6866     2) [1, x, H] if there is at least one solution;
6867        x is any solution of the given linear system,
6868        H is the matrix with column vectors spanning the homogeneous
6869        solution space.
6870     The method produces an error if matrix and vector sizes do not fit. */
6871  if ((v == NULL) || (v->Typ() != MATRIX_CMD) ||
6872      (v->next == NULL) || (v->next->Typ() != MATRIX_CMD) ||
6873      (v->next->next == NULL) || (v->next->next->Typ() != MATRIX_CMD) ||
6874      (v->next->next->next == NULL) ||
6875      (v->next->next->next->Typ() != MATRIX_CMD) ||
6876      (v->next->next->next->next != NULL))
6877  {
6878    WerrorS("expected exactly three matrices and one vector as input");
6879    return TRUE;
6880  }
6881  matrix pMat = (matrix)v->Data();
6882  matrix lMat = (matrix)v->next->Data();
6883  matrix uMat = (matrix)v->next->next->Data();
6884  matrix bVec = (matrix)v->next->next->next->Data();
6885  matrix xVec; int solvable; matrix homogSolSpace;
6886  if (pMat->rows() != pMat->cols())
6887  {
6888    Werror("first matrix (%d x %d) is not quadratic",
6889           pMat->rows(), pMat->cols());
6890    return TRUE;
6891  }
6892  if (lMat->rows() != lMat->cols())
6893  {
6894    Werror("second matrix (%d x %d) is not quadratic",
6895           lMat->rows(), lMat->cols());
6896    return TRUE;
6897  }
6898  if (lMat->rows() != uMat->rows())
6899  {
6900    Werror("second matrix (%d x %d) and third matrix (%d x %d) do not fit",
6901           lMat->rows(), lMat->cols(), uMat->rows(), uMat->cols());
6902    return TRUE;
6903  }
6904  if (uMat->rows() != bVec->rows())
6905  {
6906    Werror("third matrix (%d x %d) and vector (%d x 1) do not fit",
6907           uMat->rows(), uMat->cols(), bVec->rows());
6908    return TRUE;
6909  }
6910  solvable = luSolveViaLUDecomp(pMat, lMat, uMat, bVec, xVec, homogSolSpace);
6911
6912  /* build the return structure; a list with either one or three entries */
6913  lists ll = (lists)omAllocBin(slists_bin);
6914  if (solvable)
6915  {
6916    ll->Init(3);
6917    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)solvable;
6918    ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)xVec;
6919    ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)homogSolSpace;
6920  }
6921  else
6922  {
6923    ll->Init(1);
6924    ll->m[0].rtyp=INT_CMD;    ll->m[0].data=(void *)solvable;
6925  }
6926
6927  res->data=(char*)ll;
6928  return FALSE;
6929}
6930static BOOLEAN jjINTVEC_PL(leftv res, leftv v)
6931{
6932  int i=0;
6933  leftv h=v;
6934  if (h!=NULL) i=exprlist_length(h);
6935  intvec *iv=new intvec(i);
6936  i=0;
6937  while (h!=NULL)
6938  {
6939    if(h->Typ()==INT_CMD)
6940    {
6941      (*iv)[i]=(int)(long)h->Data();
6942    }
6943    else
6944    {
6945      delete iv;
6946      return TRUE;
6947    }
6948    i++;
6949    h=h->next;
6950  }
6951  res->data=(char *)iv;
6952  return FALSE;
6953}
6954static BOOLEAN jjJET4(leftv res, leftv u)
6955{
6956  leftv u1=u;
6957  leftv u2=u1->next;
6958  leftv u3=u2->next;
6959  leftv u4=u3->next;
6960  if((u2->Typ()==POLY_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
6961  &&((u1->Typ()==POLY_CMD)||(u1->Typ()==VECTOR_CMD)))
6962  {
6963    if(!pIsUnit((poly)u2->Data()))
6964    {
6965      WerrorS("2nd argument must be a unit");
6966      return TRUE;
6967    }
6968    res->rtyp=u1->Typ();
6969    res->data=(char*)pSeries((int)(long)u3->Data(),pCopy((poly)u1->Data()),
6970                             pCopy((poly)u2->Data()),(intvec*)u4->Data());
6971    return FALSE;
6972  }
6973  else
6974  if((u2->Typ()==MATRIX_CMD)&&(u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD)
6975  &&((u1->Typ()==IDEAL_CMD)||(u1->Typ()==MODUL_CMD)))
6976  {
6977    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
6978    {
6979      WerrorS("2nd argument must be a diagonal matrix of units");
6980      return TRUE;
6981    }
6982    res->rtyp=u1->Typ();
6983    res->data=(char*)idSeries(
6984                              (int)(long)u3->Data(),
6985                              idCopy((ideal)u1->Data()),
6986                              mp_Copy((matrix)u2->Data(), currRing),
6987                              (intvec*)u4->Data()
6988                             );
6989    return FALSE;
6990  }
6991  else
6992  {
6993    Werror("%s(`poly`,`poly`,`int`,`intvec`) exppected",
6994           Tok2Cmdname(iiOp));
6995    return TRUE;
6996  }
6997}
6998static BOOLEAN jjKLAMMER_PL(leftv res, leftv u)
6999{
7000  if ((yyInRingConstruction)
7001  && ((strcmp(u->Name(),"real")==0) || (strcmp(u->Name(),"complex")==0)))
7002  {
7003    memcpy(res,u,sizeof(sleftv));
7004    memset(u,0,sizeof(sleftv));
7005    return FALSE;
7006  }
7007  leftv v=u->next;
7008  BOOLEAN b;
7009  if(v==NULL)
7010    b=iiExprArith1(res,u,iiOp);
7011  else
7012  {
7013    u->next=NULL;
7014    b=iiExprArith2(res,u,iiOp,v);
7015    u->next=v;
7016  }
7017  return b;
7018}
7019BOOLEAN jjLIST_PL(leftv res, leftv v)
7020{
7021  int sl=0;
7022  if (v!=NULL) sl = v->listLength();
7023  lists L;
7024  if((sl==1)&&(v->Typ()==RESOLUTION_CMD))
7025  {
7026    int add_row_shift = 0;
7027    intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
7028    if (weights!=NULL)  add_row_shift=weights->min_in();
7029    L=syConvRes((syStrategy)v->Data(),FALSE,add_row_shift);
7030  }
7031  else
7032  {
7033    L=(lists)omAllocBin(slists_bin);
7034    leftv h=NULL;
7035    int i;
7036    int rt;
7037
7038    L->Init(sl);
7039    for (i=0;i<sl;i++)
7040    {
7041      if (h!=NULL)
7042      { /* e.g. not in the first step:
7043         * h is the pointer to the old sleftv,
7044         * v is the pointer to the next sleftv
7045         * (in this moment) */
7046         h->next=v;
7047      }
7048      h=v;
7049      v=v->next;
7050      h->next=NULL;
7051      rt=h->Typ();
7052      if (rt==0)
7053      {
7054        L->Clean();
7055        Werror("`%s` is undefined",h->Fullname());
7056        return TRUE;
7057      }
7058      if ((rt==RING_CMD)||(rt==QRING_CMD))
7059      {
7060        L->m[i].rtyp=rt;  L->m[i].data=h->Data();
7061        ((ring)L->m[i].data)->ref++;
7062      }
7063      else
7064        L->m[i].Copy(h);
7065    }
7066  }
7067  res->data=(char *)L;
7068  return FALSE;
7069}
7070static BOOLEAN jjNAMES0(leftv res, leftv)
7071{
7072  res->data=(void *)ipNameList(IDROOT);
7073  return FALSE;
7074}
7075static BOOLEAN jjOPTION_PL(leftv res, leftv v)
7076{
7077  if(v==NULL)
7078  {
7079    res->data=(char *)showOption();
7080    return FALSE;
7081  }
7082  res->rtyp=NONE;
7083  return setOption(res,v);
7084}
7085static BOOLEAN jjREDUCE4(leftv res, leftv u)
7086{
7087  leftv u1=u;
7088  leftv u2=u1->next;
7089  leftv u3=u2->next;
7090  leftv u4=u3->next;
7091  if((u3->Typ()==INT_CMD)&&(u4->Typ()==INTVEC_CMD))
7092  {
7093    int save_d=Kstd1_deg;
7094    Kstd1_deg=(int)(long)u3->Data();
7095    kModW=(intvec *)u4->Data();
7096    BITSET save=verbose;
7097    verbose|=Sy_bit(V_DEG_STOP);
7098    u2->next=NULL;
7099    BOOLEAN r=jjCALL2ARG(res,u);
7100    kModW=NULL;
7101    Kstd1_deg=save_d;
7102    verbose=save;
7103    u->next->next=u3;
7104    return r;
7105  }
7106  else
7107  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7108     (u4->Typ()==INT_CMD))
7109  {
7110    assumeStdFlag(u3);
7111    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7112    {
7113      WerrorS("2nd argument must be a diagonal matrix of units");
7114      return TRUE;
7115    }
7116    res->rtyp=IDEAL_CMD;
7117    res->data=(char*)redNF(
7118                           idCopy((ideal)u3->Data()),
7119                           idCopy((ideal)u1->Data()),
7120                           mp_Copy((matrix)u2->Data(), currRing),
7121                           (int)(long)u4->Data()
7122                          );
7123    return FALSE;
7124  }
7125  else
7126  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7127     (u4->Typ()==INT_CMD))
7128  {
7129    assumeStdFlag(u3);
7130    if(!pIsUnit((poly)u2->Data()))
7131    {
7132      WerrorS("2nd argument must be a unit");
7133      return TRUE;
7134    }
7135    res->rtyp=POLY_CMD;
7136    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7137                           pCopy((poly)u2->Data()),(int)(long)u4->Data());
7138    return FALSE;
7139  }
7140  else
7141  {
7142    Werror("%s(`poly`,`ideal`,`int`,`intvec`) expected",Tok2Cmdname(iiOp));
7143    return TRUE;
7144  }
7145}
7146static BOOLEAN jjREDUCE5(leftv res, leftv u)
7147{
7148  leftv u1=u;
7149  leftv u2=u1->next;
7150  leftv u3=u2->next;
7151  leftv u4=u3->next;
7152  leftv u5=u4->next;
7153  if((u1->Typ()==IDEAL_CMD)&&(u2->Typ()==MATRIX_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7154     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7155  {
7156    assumeStdFlag(u3);
7157    if(!mp_IsDiagUnit((matrix)u2->Data(), currRing))
7158    {
7159      WerrorS("2nd argument must be a diagonal matrix of units");
7160      return TRUE;
7161    }
7162    res->rtyp=IDEAL_CMD;
7163    res->data=(char*)redNF(
7164                           idCopy((ideal)u3->Data()),
7165                           idCopy((ideal)u1->Data()),
7166                           mp_Copy((matrix)u2->Data(),currRing),
7167                           (int)(long)u4->Data(),
7168                           (intvec*)u5->Data()
7169                          );
7170    return FALSE;
7171  }
7172  else
7173  if((u1->Typ()==POLY_CMD)&&(u2->Typ()==POLY_CMD)&&(u3->Typ()==IDEAL_CMD)&&
7174     (u4->Typ()==INT_CMD)&&(u5->Typ()==INTVEC_CMD))
7175  {
7176    assumeStdFlag(u3);
7177    if(!pIsUnit((poly)u2->Data()))
7178    {
7179      WerrorS("2nd argument must be a unit");
7180      return TRUE;
7181    }
7182    res->rtyp=POLY_CMD;
7183    res->data=(char*)redNF(idCopy((ideal)u3->Data()),pCopy((poly)u1->Data()),
7184                           pCopy((poly)u2->Data()),
7185                           (int)(long)u4->Data(),(intvec*)u5->Data());
7186    return FALSE;
7187  }
7188  else
7189  {
7190    Werror("%s(`ideal`,`ideal`,`matrix`,`int`,`intvec`) exppected",
7191           Tok2Cmdname(iiOp));
7192    return TRUE;
7193  }
7194}
7195static BOOLEAN jjRESERVED0(leftv, leftv)
7196{
7197  int i=1;
7198  int nCount = (sArithBase.nCmdUsed-1)/3;
7199  if((3*nCount)<sArithBase.nCmdUsed) nCount++;
7200  //Print("CMDS: %d/%d\n", sArithBase.nCmdUsed,
7201  //      sArithBase.nCmdAllocated);
7202  for(i=0; i<nCount; i++)
7203  {
7204    Print("%-20s",sArithBase.sCmds[i+1].name);
7205    if(i+1+nCount<sArithBase.nCmdUsed)
7206      Print("%-20s",sArithBase.sCmds[i+1+nCount].name);
7207    if(i+1+2*nCount<sArithBase.nCmdUsed)
7208      Print("%-20s",sArithBase.sCmds[i+1+2*nCount].name);
7209    //if ((i%3)==1) PrintLn();
7210    PrintLn();
7211  }
7212  PrintLn();
7213  printBlackboxTypes();
7214  return FALSE;
7215}
7216static BOOLEAN jjSTRING_PL(leftv res, leftv v)
7217{
7218  if (v == NULL)
7219  {
7220    res->data = omStrDup("");
7221    return FALSE;
7222  }
7223  int n = v->listLength();
7224  if (n == 1)
7225  {
7226    res->data = v->String();
7227    return FALSE;
7228  }
7229
7230  char** slist = (char**) omAlloc(n*sizeof(char*));
7231  int i, j;
7232
7233  for (i=0, j=0; i<n; i++, v = v ->next)
7234  {
7235    slist[i] = v->String();
7236    assume(slist[i] != NULL);
7237    j+=strlen(slist[i]);
7238  }
7239  char* s = (char*) omAlloc((j+1)*sizeof(char));
7240  *s='\0';
7241  for (i=0;i<n;i++)
7242  {
7243    strcat(s, slist[i]);
7244    omFree(slist[i]);
7245  }
7246  omFreeSize(slist, n*sizeof(char*));
7247  res->data = s;
7248  return FALSE;
7249}
7250static BOOLEAN jjTEST(leftv, leftv v)
7251{
7252  do
7253  {
7254    if (v->Typ()!=INT_CMD)
7255      return TRUE;
7256    test_cmd((int)(long)v->Data());
7257    v=v->next;
7258  }
7259  while (v!=NULL);
7260  return FALSE;
7261}
7262
7263#if defined(__alpha) && !defined(linux)
7264extern "C"
7265{
7266  void usleep(unsigned long usec);
7267};
7268#endif
7269static BOOLEAN jjFactModD_M(leftv res, leftv v)
7270{
7271  /* compute two factors of h(x,y) modulo x^(d+1) in K[[x]][y],
7272     see a detailed documentation in /kernel/linearAlgebra.h
7273
7274     valid argument lists:
7275     - (poly h, int d),
7276     - (poly h, int d, poly f0, poly g0),       optional: factors of h(0,y),
7277     - (poly h, int d, int xIndex, int yIndex), optional: indices of vars x & y
7278                                                          in list of ring vars,
7279     - (poly h, int d, poly f0, poly g0, int xIndex, int yIndec),
7280                                                optional: all 4 optional args
7281     (The defaults are xIndex = 1, yIndex = 2, f0 and g0 polynomials as found
7282      by singclap_factorize in the case that HAVE_FACTORY is defined and h(0, y)
7283      has exactly two distinct monic factors [possibly with exponent > 1].)
7284     result:
7285     - list with the two factors f and g such that
7286       h(x,y) = f(x,y)*g(x,y) mod x^(d+1)   */
7287
7288  poly h      = NULL;
7289  int  d      =    1;
7290  poly f0     = NULL;
7291  poly g0     = NULL;
7292  int  xIndex =    1;   /* default index if none provided */
7293  int  yIndex =    2;   /* default index if none provided */
7294
7295  leftv u = v; int factorsGiven = 0;
7296  if ((u == NULL) || (u->Typ() != POLY_CMD))
7297  {
7298    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7299    return TRUE;
7300  }
7301  else h = (poly)u->Data();
7302  u = u->next;
7303  if ((u == NULL) || (u->Typ() != INT_CMD))
7304  {
7305    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7306    return TRUE;
7307  }
7308  else d = (int)(long)u->Data();
7309  u = u->next;
7310  if ((u != NULL) && (u->Typ() == POLY_CMD))
7311  {
7312    if ((u->next == NULL) || (u->next->Typ() != POLY_CMD))
7313    {
7314      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7315      return TRUE;
7316    }
7317    else
7318    {
7319      f0 = (poly)u->Data();
7320      g0 = (poly)u->next->Data();
7321      factorsGiven = 1;
7322      u = u->next->next;
7323    }
7324  }
7325  if ((u != NULL) && (u->Typ() == INT_CMD))
7326  {
7327    if ((u->next == NULL) || (u->next->Typ() != INT_CMD))
7328    {
7329      WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7330      return TRUE;
7331    }
7332    else
7333    {
7334      xIndex = (int)(long)u->Data();
7335      yIndex = (int)(long)u->next->Data();
7336      u = u->next->next;
7337    }
7338  }
7339  if (u != NULL)
7340  {
7341    WerrorS("expected arguments (poly, int [, poly, poly] [, int, int])");
7342    return TRUE;
7343  }
7344
7345  /* checks for provided arguments */
7346  if (pIsConstant(h) || (factorsGiven && (pIsConstant(f0) || pIsConstant(g0))))
7347  {
7348    WerrorS("expected non-constant polynomial argument(s)");
7349    return TRUE;
7350  }
7351  int n = rVar(currRing);
7352  if ((xIndex < 1) || (n < xIndex))
7353  {
7354    Werror("index for variable x (%d) out of range [1..%d]", xIndex, n);
7355    return TRUE;
7356  }
7357  if ((yIndex < 1) || (n < yIndex))
7358  {
7359    Werror("index for variable y (%d) out of range [1..%d]", yIndex, n);
7360    return TRUE;
7361  }
7362  if (xIndex == yIndex)
7363  {
7364    WerrorS("expected distinct indices for variables x and y");
7365    return TRUE;
7366  }
7367
7368  /* computation of f0 and g0 if missing */
7369  if (factorsGiven == 0)
7370  {
7371#ifdef HAVE_FACTORY
7372    poly h0 = pSubst(pCopy(h), xIndex, NULL);
7373    intvec* v = NULL;
7374    ideal i = singclap_factorize(h0, &v, 0,currRing);
7375
7376    ivTest(v);
7377
7378    if (i == NULL) return TRUE;
7379
7380    idTest(i);
7381
7382    if ((v->rows() != 3) || ((*v)[0] =! 1) || (!nIsOne(pGetCoeff(i->m[0]))))
7383    {
7384      WerrorS("expected h(0,y) to have exactly two distinct monic factors");
7385      return TRUE;
7386    }
7387    f0 = pPower(pCopy(i->m[1]), (*v)[1]);
7388    g0 = pPower(pCopy(i->m[2]), (*v)[2]);
7389    idDelete(&i);
7390#else
7391    WerrorS("cannot factorize h(0,y) due to missing module 'factory'");
7392    return TRUE;
7393#endif
7394  }
7395
7396  poly f; poly g;
7397  henselFactors(xIndex, yIndex, h, f0, g0, d, f, g);
7398  lists L = (lists)omAllocBin(slists_bin);
7399  L->Init(2);
7400  L->m[0].rtyp = POLY_CMD; L->m[0].data=(void*)f;
7401  L->m[1].rtyp = POLY_CMD; L->m[1].data=(void*)g;
7402  res->rtyp = LIST_CMD;
7403  res->data = (char*)L;
7404  return FALSE;
7405}
7406static BOOLEAN jjSTATUS_M(leftv res, leftv v)
7407{
7408  if ((v->Typ() != LINK_CMD) ||
7409      (v->next->Typ() != STRING_CMD) ||
7410      (v->next->next->Typ() != STRING_CMD) ||
7411      (v->next->next->next->Typ() != INT_CMD))
7412    return TRUE;
7413  jjSTATUS3(res, v, v->next, v->next->next);
7414#if defined(HAVE_USLEEP)
7415  if (((long) res->data) == 0L)
7416  {
7417    int i_s = (int)(long) v->next->next->next->Data();
7418    if (i_s > 0)
7419    {
7420      usleep((int)(long) v->next->next->next->Data());
7421      jjSTATUS3(res, v, v->next, v->next->next);
7422    }
7423  }
7424#elif defined(HAVE_SLEEP)
7425  if (((int) res->data) == 0)
7426  {
7427    int i_s = (int) v->next->next->next->Data();
7428    if (i_s > 0)
7429    {
7430      sleep((is - 1)/1000000 + 1);
7431      jjSTATUS3(res, v, v->next, v->next->next);
7432    }
7433  }
7434#endif
7435  return FALSE;
7436}
7437static BOOLEAN jjSUBST_M(leftv res, leftv u)
7438{
7439  leftv v = u->next; // number of args > 0
7440  if (v==NULL) return TRUE;
7441  leftv w = v->next;
7442  if (w==NULL) return TRUE;
7443  leftv rest = w->next;;
7444
7445  u->next = NULL;
7446  v->next = NULL;
7447  w->next = NULL;
7448  BOOLEAN b = iiExprArith3(res, iiOp, u, v, w);
7449  if ((rest!=NULL) && (!b))
7450  {
7451    sleftv tmp_res;
7452    leftv tmp_next=res->next;
7453    res->next=rest;
7454    memset(&tmp_res,0,sizeof(tmp_res));
7455    b = iiExprArithM(&tmp_res,res,iiOp);
7456    memcpy(res,&tmp_res,sizeof(tmp_res));
7457    res->next=tmp_next;
7458  }
7459  u->next = v;
7460  v->next = w;
7461  // rest was w->next, but is already cleaned
7462  return b;
7463}
7464static BOOLEAN jjQRDS(leftv res, leftv INPUT)
7465{
7466  if ((INPUT->Typ() != MATRIX_CMD) ||
7467      (INPUT->next->Typ() != NUMBER_CMD) ||
7468      (INPUT->next->next->Typ() != NUMBER_CMD) ||
7469      (INPUT->next->next->next->Typ() != NUMBER_CMD))
7470  {
7471    WerrorS("expected (matrix, number, number, number) as arguments");
7472    return TRUE;
7473  }
7474  leftv u = INPUT; leftv v = u->next; leftv w = v->next; leftv x = w->next;
7475  res->data = (char *)qrDoubleShift((matrix)(u->Data()),
7476                                    (number)(v->Data()),
7477                                    (number)(w->Data()),
7478                                    (number)(x->Data()));
7479  return FALSE;
7480}
7481static BOOLEAN jjSTD_HILB_WP(leftv res, leftv INPUT)
7482{ ideal result;
7483  leftv u = INPUT;    /* an ideal, weighted homogeneous and standard */
7484  leftv v = u->next;  /* one additional polynomial or ideal */
7485  leftv h = v->next;  /* Hilbert vector */
7486  leftv w = h->next;  /* weight vector */
7487  assumeStdFlag(u);
7488  ideal i1=(ideal)(u->Data());
7489  ideal i0;
7490  if (((u->Typ()!=IDEAL_CMD)&&(u->Typ()!=MODUL_CMD))
7491  || (h->Typ()!=INTVEC_CMD)
7492  || (w->Typ()!=INTVEC_CMD))
7493  {
7494    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7495    return TRUE;
7496  }
7497  intvec *vw=(intvec *)w->Data(); // weights of vars
7498  /* merging std_hilb_w and std_1 */
7499  if (vw->length()!=currRing->N)
7500  {
7501    Werror("%d weights for %d variables",vw->length(),currRing->N);
7502    return TRUE;
7503  }
7504  int r=v->Typ();
7505  BOOLEAN cleanup_i0=FALSE;
7506  if ((r==POLY_CMD) ||(r==VECTOR_CMD))
7507  {
7508    i0=idInit(1,i1->rank);
7509    i0->m[0]=(poly)v->Data();
7510    BOOLEAN cleanup_i0=TRUE;
7511  }
7512  else if (r==IDEAL_CMD)/* IDEAL */
7513  {
7514    i0=(ideal)v->Data();
7515  }
7516  else
7517  {
7518    WerrorS("expected `std(`ideal/module`,`poly/vector`,`intvec`,`intvec`)");
7519    return TRUE;
7520  }
7521  int ii0=idElem(i0);
7522  i1 = idSimpleAdd(i1,i0);
7523  if (cleanup_i0)
7524  {
7525    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
7526    idDelete(&i0);
7527  }
7528  intvec *ww=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
7529  tHomog hom=testHomog;
7530  /* u_id from jjSTD_W is now i1 as in jjSTD_1 */
7531  if (ww!=NULL)
7532  {
7533    if (!idTestHomModule(i1,currQuotient,ww))
7534    {
7535      WarnS("wrong weights");
7536      ww=NULL;
7537    }
7538    else
7539    {
7540      ww=ivCopy(ww);
7541      hom=isHomog;
7542    }
7543  }
7544  BITSET save_test=test;
7545  test|=Sy_bit(OPT_SB_1);
7546  result=kStd(i1,
7547              currQuotient,
7548              hom,
7549              &ww,                  // module weights
7550              (intvec *)h->Data(),  // hilbert series
7551              0,                    // syzComp, whatever it is...
7552              IDELEMS(i1)-ii0,      // new ideal
7553              vw);                  // weights of vars
7554  test=save_test;
7555  idDelete(&i1);
7556  idSkipZeroes(result);
7557  res->data = (char *)result;
7558  if (!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
7559  if (ww!=NULL) atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
7560  return FALSE;
7561}
7562
7563
7564static Subexpr jjMakeSub(leftv e)
7565{
7566  assume( e->Typ()==INT_CMD );
7567  Subexpr r=(Subexpr)omAlloc0Bin(sSubexpr_bin);
7568  r->start =(int)(long)e->Data();
7569  return r;
7570}
7571#define D(A) (A)
7572#define IPARITH
7573#include "table.h"
7574
7575#include "iparith.inc"
7576
7577/*=================== operations with 2 args. ============================*/
7578/* must be ordered: first operations for chars (infix ops),
7579 * then alphabetically */
7580
7581BOOLEAN iiExprArith2(leftv res, leftv a, int op, leftv b, BOOLEAN proccall)
7582{
7583  memset(res,0,sizeof(sleftv));
7584  BOOLEAN call_failed=FALSE;
7585
7586  if (!errorreported)
7587  {
7588#ifdef SIQ
7589    if (siq>0)
7590    {
7591      //Print("siq:%d\n",siq);
7592      command d=(command)omAlloc0Bin(sip_command_bin);
7593      memcpy(&d->arg1,a,sizeof(sleftv));
7594      //a->Init();
7595      memcpy(&d->arg2,b,sizeof(sleftv));
7596      //b->Init();
7597      d->argc=2;
7598      d->op=op;
7599      res->data=(char *)d;
7600      res->rtyp=COMMAND;
7601      return FALSE;
7602    }
7603#endif
7604    int at=a->Typ();
7605    if (at>MAX_TOK)
7606    {
7607      blackbox *bb=getBlackboxStuff(at);
7608      if (bb!=NULL) return bb->blackbox_Op2(op,res,a,b);
7609      else          return TRUE;
7610    }
7611    int bt=b->Typ();
7612    int i=iiTabIndex(dArithTab2,JJTAB2LEN,op);
7613    int index=i;
7614
7615    iiOp=op;
7616    while (dArith2[i].cmd==op)
7617    {
7618      if ((at==dArith2[i].arg1)
7619      && (bt==dArith2[i].arg2))
7620      {
7621        res->rtyp=dArith2[i].res;
7622        if (currRing!=NULL)
7623        {
7624          if (check_valid(dArith2[i].valid_for,op)) break;
7625        }
7626        if (TEST_V_ALLWARN)
7627          Print("call %s(%s,%s)\n",iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt));
7628        if ((call_failed=dArith2[i].p(res,a,b)))
7629        {
7630          break;// leave loop, goto error handling
7631        }
7632        a->CleanUp();
7633        b->CleanUp();
7634        //Print("op: %d,result typ:%d\n",op,res->rtyp);
7635        return FALSE;
7636      }
7637      i++;
7638    }
7639    // implicite type conversion ----------------------------------------------
7640    if (dArith2[i].cmd!=op)
7641    {
7642      int ai,bi;
7643      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7644      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
7645      BOOLEAN failed=FALSE;
7646      i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7647      //Print("op: %c, type: %s %s\n",op,Tok2Cmdname(at),Tok2Cmdname(bt));
7648      while (dArith2[i].cmd==op)
7649      {
7650        //Print("test %s %s\n",Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
7651        if ((ai=iiTestConvert(at,dArith2[i].arg1))!=0)
7652        {
7653          if ((bi=iiTestConvert(bt,dArith2[i].arg2))!=0)
7654          {
7655            res->rtyp=dArith2[i].res;
7656            if (currRing!=NULL)
7657            {
7658              if (check_valid(dArith2[i].valid_for,op)) break;
7659            }
7660            if (TEST_V_ALLWARN)
7661              Print("call %s(%s,%s)\n",iiTwoOps(op),
7662              Tok2Cmdname(an->rtyp),Tok2Cmdname(bn->rtyp));
7663            failed= ((iiConvert(at,dArith2[i].arg1,ai,a,an))
7664            || (iiConvert(bt,dArith2[i].arg2,bi,b,bn))
7665            || (call_failed=dArith2[i].p(res,an,bn)));
7666            // everything done, clean up temp. variables
7667            if (failed)
7668            {
7669              // leave loop, goto error handling
7670              break;
7671            }
7672            else
7673            {
7674              // everything ok, clean up and return
7675              an->CleanUp();
7676              bn->CleanUp();
7677              omFreeBin((ADDRESS)an, sleftv_bin);
7678              omFreeBin((ADDRESS)bn, sleftv_bin);
7679              a->CleanUp();
7680              b->CleanUp();
7681              return FALSE;
7682            }
7683          }
7684        }
7685        i++;
7686      }
7687      an->CleanUp();
7688      bn->CleanUp();
7689      omFreeBin((ADDRESS)an, sleftv_bin);
7690      omFreeBin((ADDRESS)bn, sleftv_bin);
7691    }
7692    // error handling ---------------------------------------------------
7693    const char *s=NULL;
7694    if (!errorreported)
7695    {
7696      if ((at==0) && (a->Fullname()!=sNoName))
7697      {
7698        s=a->Fullname();
7699      }
7700      else if ((bt==0) && (b->Fullname()!=sNoName))
7701      {
7702        s=b->Fullname();
7703      }
7704      if (s!=NULL)
7705        Werror("`%s` is not defined",s);
7706      else
7707      {
7708        i=index; /*iiTabIndex(dArithTab2,JJTAB2LEN,op);*/
7709        s = iiTwoOps(op);
7710        if (proccall)
7711        {
7712          Werror("%s(`%s`,`%s`) failed"
7713                ,s,Tok2Cmdname(at),Tok2Cmdname(bt));
7714        }
7715        else
7716        {
7717          Werror("`%s` %s `%s` failed"
7718                ,Tok2Cmdname(at),s,Tok2Cmdname(bt));
7719        }
7720        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
7721        {
7722          while (dArith2[i].cmd==op)
7723          {
7724            if(((at==dArith2[i].arg1)||(bt==dArith2[i].arg2))
7725            && (dArith2[i].res!=0)
7726            && (dArith2[i].p!=jjWRONG2))
7727            {
7728              if (proccall)
7729                Werror("expected %s(`%s`,`%s`)"
7730                  ,s,Tok2Cmdname(dArith2[i].arg1),Tok2Cmdname(dArith2[i].arg2));
7731              else
7732                Werror("expected `%s` %s `%s`"
7733                  ,Tok2Cmdname(dArith2[i].arg1),s,Tok2Cmdname(dArith2[i].arg2));
7734            }
7735            i++;
7736          }
7737        }
7738      }
7739    }
7740    res->rtyp = UNKNOWN;
7741  }
7742  a->CleanUp();
7743  b->CleanUp();
7744  return TRUE;
7745}
7746
7747/*==================== operations with 1 arg. ===============================*/
7748/* must be ordered: first operations for chars (infix ops),
7749 * then alphabetically */
7750
7751BOOLEAN iiExprArith1(leftv res, leftv a, int op)
7752{
7753  memset(res,0,sizeof(sleftv));
7754  BOOLEAN call_failed=FALSE;
7755
7756  if (!errorreported)
7757  {
7758#ifdef SIQ
7759    if (siq>0)
7760    {
7761      //Print("siq:%d\n",siq);
7762      command d=(command)omAlloc0Bin(sip_command_bin);
7763      memcpy(&d->arg1,a,sizeof(sleftv));
7764      //a->Init();
7765      d->op=op;
7766      d->argc=1;
7767      res->data=(char *)d;
7768      res->rtyp=COMMAND;
7769      return FALSE;
7770    }
7771#endif
7772    int at=a->Typ();
7773    if (at>MAX_TOK)
7774    {
7775      blackbox *bb=getBlackboxStuff(at);
7776      if (bb!=NULL) return bb->blackbox_Op1(op,res,a);
7777      else          return TRUE;
7778    }
7779
7780    BOOLEAN failed=FALSE;
7781    iiOp=op;
7782    int i=iiTabIndex(dArithTab1,JJTAB1LEN,op);
7783    int ti = i;
7784    while (dArith1[i].cmd==op)
7785    {
7786      if (at==dArith1[i].arg)
7787      {
7788        int r=res->rtyp=dArith1[i].res;
7789        if (currRing!=NULL)
7790        {
7791          if (check_valid(dArith1[i].valid_for,op)) break;
7792        }
7793        if (TEST_V_ALLWARN)
7794          Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(at));
7795        if (r<0)
7796        {
7797          res->rtyp=-r;
7798          #ifdef PROC_BUG
7799          dArith1[i].p(res,a);
7800          #else
7801          res->data=(char *)((Proc1)dArith1[i].p)((char *)a->Data());
7802          #endif
7803        }
7804        else if ((call_failed=dArith1[i].p(res,a)))
7805        {
7806          break;// leave loop, goto error handling
7807        }
7808        if (a->Next()!=NULL)
7809        {
7810          res->next=(leftv)omAllocBin(sleftv_bin);
7811          failed=iiExprArith1(res->next,a->next,op);
7812        }
7813        a->CleanUp();
7814        return failed;
7815      }
7816      i++;
7817    }
7818    // implicite type conversion --------------------------------------------
7819    if (dArith1[i].cmd!=op)
7820    {
7821      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7822      i=ti;
7823      //Print("fuer %c , typ: %s\n",op,Tok2Cmdname(at));
7824      while (dArith1[i].cmd==op)
7825      {
7826        int ai;
7827        //Print("test %s\n",Tok2Cmdname(dArith1[i].arg));
7828        if ((ai=iiTestConvert(at,dArith1[i].arg))!=0)
7829        {
7830          int r=res->rtyp=dArith1[i].res;
7831          if (currRing!=NULL)
7832          {
7833            if (check_valid(dArith1[i].valid_for,op)) break;
7834          }
7835          if (r<0)
7836          {
7837            res->rtyp=-r;
7838            failed= iiConvert(at,dArith1[i].arg,ai,a,an);
7839            if (!failed)
7840            {
7841              #ifdef PROC_BUG
7842              dArith1[i].p(res,a);
7843              #else
7844              res->data=(char *)((Proc1)dArith1[i].p)((char *)an->Data());
7845              #endif
7846            }
7847          }
7848          else
7849          {
7850            failed= ((iiConvert(at,dArith1[i].arg,ai,a,an))
7851            || (call_failed=dArith1[i].p(res,an)));
7852          }
7853          // everything done, clean up temp. variables
7854          if (failed)
7855          {
7856            // leave loop, goto error handling
7857            break;
7858          }
7859          else
7860          {
7861            if (TEST_V_ALLWARN)
7862              Print("call %s(%s)\n",iiTwoOps(op),Tok2Cmdname(an->rtyp));
7863            if (an->Next() != NULL)
7864            {
7865              res->next = (leftv)omAllocBin(sleftv_bin);
7866              failed=iiExprArith1(res->next,an->next,op);
7867            }
7868            // everything ok, clean up and return
7869            an->CleanUp();
7870            omFreeBin((ADDRESS)an, sleftv_bin);
7871            a->CleanUp();
7872            return failed;
7873          }
7874        }
7875        i++;
7876      }
7877      an->CleanUp();
7878      omFreeBin((ADDRESS)an, sleftv_bin);
7879    }
7880    // error handling
7881    if (!errorreported)
7882    {
7883      if ((at==0) && (a->Fullname()!=sNoName))
7884      {
7885        Werror("`%s` is not defined",a->Fullname());
7886      }
7887      else
7888      {
7889        i=ti;
7890        const char *s = iiTwoOps(op);
7891        Werror("%s(`%s`) failed"
7892                ,s,Tok2Cmdname(at));
7893        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
7894        {
7895          while (dArith1[i].cmd==op)
7896          {
7897            if ((dArith1[i].res!=0)
7898            && (dArith1[i].p!=jjWRONG))
7899              Werror("expected %s(`%s`)"
7900                ,s,Tok2Cmdname(dArith1[i].arg));
7901            i++;
7902          }
7903        }
7904      }
7905    }
7906    res->rtyp = UNKNOWN;
7907  }
7908  a->CleanUp();
7909  return TRUE;
7910}
7911
7912/*=================== operations with 3 args. ============================*/
7913/* must be ordered: first operations for chars (infix ops),
7914 * then alphabetically */
7915
7916BOOLEAN iiExprArith3(leftv res, int op, leftv a, leftv b, leftv c)
7917{
7918  memset(res,0,sizeof(sleftv));
7919  BOOLEAN call_failed=FALSE;
7920
7921  if (!errorreported)
7922  {
7923#ifdef SIQ
7924    if (siq>0)
7925    {
7926      //Print("siq:%d\n",siq);
7927      command d=(command)omAlloc0Bin(sip_command_bin);
7928      memcpy(&d->arg1,a,sizeof(sleftv));
7929      //a->Init();
7930      memcpy(&d->arg2,b,sizeof(sleftv));
7931      //b->Init();
7932      memcpy(&d->arg3,c,sizeof(sleftv));
7933      //c->Init();
7934      d->op=op;
7935      d->argc=3;
7936      res->data=(char *)d;
7937      res->rtyp=COMMAND;
7938      return FALSE;
7939    }
7940#endif
7941    int at=a->Typ();
7942    if (at>MAX_TOK)
7943    {
7944      blackbox *bb=getBlackboxStuff(at);
7945      if (bb!=NULL) return bb->blackbox_Op3(op,res,a,b,c);
7946      else          return TRUE;
7947    }
7948    int bt=b->Typ();
7949    int ct=c->Typ();
7950
7951    iiOp=op;
7952    int i=0;
7953    while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
7954    while (dArith3[i].cmd==op)
7955    {
7956      if ((at==dArith3[i].arg1)
7957      && (bt==dArith3[i].arg2)
7958      && (ct==dArith3[i].arg3))
7959      {
7960        res->rtyp=dArith3[i].res;
7961        if (currRing!=NULL)
7962        {
7963          if (check_valid(dArith3[i].valid_for,op)) break;
7964        }
7965        if (TEST_V_ALLWARN)
7966          Print("call %s(%s,%s,%s)\n",
7967            iiTwoOps(op),Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
7968        if ((call_failed=dArith3[i].p(res,a,b,c)))
7969        {
7970          break;// leave loop, goto error handling
7971        }
7972        a->CleanUp();
7973        b->CleanUp();
7974        c->CleanUp();
7975        return FALSE;
7976      }
7977      i++;
7978    }
7979    // implicite type conversion ----------------------------------------------
7980    if (dArith3[i].cmd!=op)
7981    {
7982      int ai,bi,ci;
7983      leftv an = (leftv)omAlloc0Bin(sleftv_bin);
7984      leftv bn = (leftv)omAlloc0Bin(sleftv_bin);
7985      leftv cn = (leftv)omAlloc0Bin(sleftv_bin);
7986      BOOLEAN failed=FALSE;
7987      i=0;
7988      while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
7989      while (dArith3[i].cmd==op)
7990      {
7991        if ((ai=iiTestConvert(at,dArith3[i].arg1))!=0)
7992        {
7993          if ((bi=iiTestConvert(bt,dArith3[i].arg2))!=0)
7994          {
7995            if ((ci=iiTestConvert(ct,dArith3[i].arg3))!=0)
7996            {
7997              res->rtyp=dArith3[i].res;
7998              if (currRing!=NULL)
7999              {
8000                if (check_valid(dArith3[i].valid_for,op)) break;
8001              }
8002              if (TEST_V_ALLWARN)
8003                Print("call %s(%s,%s,%s)\n",
8004                  iiTwoOps(op),Tok2Cmdname(an->rtyp),
8005                  Tok2Cmdname(bn->rtyp),Tok2Cmdname(cn->rtyp));
8006              failed= ((iiConvert(at,dArith3[i].arg1,ai,a,an))
8007                || (iiConvert(bt,dArith3[i].arg2,bi,b,bn))
8008                || (iiConvert(ct,dArith3[i].arg3,ci,c,cn))
8009                || (call_failed=dArith3[i].p(res,an,bn,cn)));
8010              // everything done, clean up temp. variables
8011              if (failed)
8012              {
8013                // leave loop, goto error handling
8014                break;
8015              }
8016              else
8017              {
8018                // everything ok, clean up and return
8019                an->CleanUp();
8020                bn->CleanUp();
8021                cn->CleanUp();
8022                omFreeBin((ADDRESS)an, sleftv_bin);
8023                omFreeBin((ADDRESS)bn, sleftv_bin);
8024                omFreeBin((ADDRESS)cn, sleftv_bin);
8025                a->CleanUp();
8026                b->CleanUp();
8027                c->CleanUp();
8028        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8029                return FALSE;
8030              }
8031            }
8032          }
8033        }
8034        i++;
8035      }
8036      an->CleanUp();
8037      bn->CleanUp();
8038      cn->CleanUp();
8039      omFreeBin((ADDRESS)an, sleftv_bin);
8040      omFreeBin((ADDRESS)bn, sleftv_bin);
8041      omFreeBin((ADDRESS)cn, sleftv_bin);
8042    }
8043    // error handling ---------------------------------------------------
8044    if (!errorreported)
8045    {
8046      const char *s=NULL;
8047      if ((at==0) && (a->Fullname()!=sNoName))
8048      {
8049        s=a->Fullname();
8050      }
8051      else if ((bt==0) && (b->Fullname()!=sNoName))
8052      {
8053        s=b->Fullname();
8054      }
8055      else if ((ct==0) && (c->Fullname()!=sNoName))
8056      {
8057        s=c->Fullname();
8058      }
8059      if (s!=NULL)
8060        Werror("`%s` is not defined",s);
8061      else
8062      {
8063        i=0;
8064        while ((dArith3[i].cmd!=op)&&(dArith3[i].cmd!=0)) i++;
8065        const char *s = iiTwoOps(op);
8066        Werror("%s(`%s`,`%s`,`%s`) failed"
8067                ,s,Tok2Cmdname(at),Tok2Cmdname(bt),Tok2Cmdname(ct));
8068        if ((!call_failed) && BVERBOSE(V_SHOW_USE))
8069        {
8070          while (dArith3[i].cmd==op)
8071          {
8072            if(((at==dArith3[i].arg1)
8073            ||(bt==dArith3[i].arg2)
8074            ||(ct==dArith3[i].arg3))
8075            && (dArith3[i].res!=0))
8076            {
8077              Werror("expected %s(`%s`,`%s`,`%s`)"
8078                  ,s,Tok2Cmdname(dArith3[i].arg1)
8079                  ,Tok2Cmdname(dArith3[i].arg2)
8080                  ,Tok2Cmdname(dArith3[i].arg3));
8081            }
8082            i++;
8083          }
8084        }
8085      }
8086    }
8087    res->rtyp = UNKNOWN;
8088  }
8089  a->CleanUp();
8090  b->CleanUp();
8091  c->CleanUp();
8092        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8093  return TRUE;
8094}
8095/*==================== operations with many arg. ===============================*/
8096/* must be ordered: first operations for chars (infix ops),
8097 * then alphabetically */
8098
8099BOOLEAN jjANY2LIST(leftv res, leftv v, int cnt)
8100{
8101  // cnt = 0: all
8102  // cnt = 1: only first one
8103  leftv next;
8104  BOOLEAN failed = TRUE;
8105  if(v==NULL) return failed;
8106  res->rtyp = LIST_CMD;
8107  if(cnt) v->next = NULL;
8108  next = v->next;             // saving next-pointer
8109  failed = jjLIST_PL(res, v);
8110  v->next = next;             // writeback next-pointer
8111  return failed;
8112}
8113
8114BOOLEAN iiExprArithM(leftv res, leftv a, int op)
8115{
8116  memset(res,0,sizeof(sleftv));
8117
8118  if (!errorreported)
8119  {
8120#ifdef SIQ
8121    if (siq>0)
8122    {
8123      //Print("siq:%d\n",siq);
8124      command d=(command)omAlloc0Bin(sip_command_bin);
8125      d->op=op;
8126      res->data=(char *)d;
8127      if (a!=NULL)
8128      {
8129        d->argc=a->listLength();
8130        // else : d->argc=0;
8131        memcpy(&d->arg1,a,sizeof(sleftv));
8132        switch(d->argc)
8133        {
8134          case 3:
8135            memcpy(&d->arg3,a->next->next,sizeof(sleftv));
8136            a->next->next->Init();
8137            /* no break */
8138          case 2:
8139            memcpy(&d->arg2,a->next,sizeof(sleftv));
8140            a->next->Init();
8141            a->next->next=d->arg2.next;
8142            d->arg2.next=NULL;
8143            /* no break */
8144          case 1:
8145            a->Init();
8146            a->next=d->arg1.next;
8147            d->arg1.next=NULL;
8148        }
8149        if (d->argc>3) a->next=NULL;
8150        a->name=NULL;
8151        a->rtyp=0;
8152        a->data=NULL;
8153        a->e=NULL;
8154        a->attribute=NULL;
8155        a->CleanUp();
8156      }
8157      res->rtyp=COMMAND;
8158      return FALSE;
8159    }
8160#endif
8161    if ((a!=NULL) && (a->Typ()>MAX_TOK))
8162    {
8163      blackbox *bb=getBlackboxStuff(a->Typ());
8164      if (bb!=NULL) return bb->blackbox_OpM(op,res,a);
8165      else          return TRUE;
8166    }
8167    BOOLEAN failed=FALSE;
8168    int args=0;
8169    if (a!=NULL) args=a->listLength();
8170
8171    iiOp=op;
8172    int i=0;
8173    while ((dArithM[i].cmd!=op)&&(dArithM[i].cmd!=0)) i++;
8174    while (dArithM[i].cmd==op)
8175    {
8176      if ((args==dArithM[i].number_of_args)
8177      || (dArithM[i].number_of_args==-1)
8178      || ((dArithM[i].number_of_args==-2)&&(args>0)))
8179      {
8180        res->rtyp=dArithM[i].res;
8181        if (currRing!=NULL)
8182        {
8183          if (check_valid(dArithM[i].valid_for,op)) break;
8184        }
8185        if (TEST_V_ALLWARN)
8186          Print("call %s(... (%d args))\n", iiTwoOps(op),args);
8187        if (dArithM[i].p(res,a))
8188        {
8189          break;// leave loop, goto error handling
8190        }
8191        if (a!=NULL) a->CleanUp();
8192        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8193        return failed;
8194      }
8195      i++;
8196    }
8197    // error handling
8198    if (!errorreported)
8199    {
8200      if ((args>0) && (a->rtyp==0) && (a->Name()!=sNoName))
8201      {
8202        Werror("`%s` is not defined",a->Fullname());
8203      }
8204      else
8205      {
8206        const char *s = iiTwoOps(op);
8207        Werror("%s(...) failed",s);
8208      }
8209    }
8210    res->rtyp = UNKNOWN;
8211  }
8212  if (a!=NULL) a->CleanUp();
8213        //Print("op: %d,result typ:%d\n",op,res->rtyp);
8214  return TRUE;
8215}
8216
8217/*=================== general utilities ============================*/
8218int IsCmd(const char *n, int & tok)
8219{
8220  int i;
8221  int an=1;
8222  int en=sArithBase.nLastIdentifier;
8223
8224  loop
8225  //for(an=0; an<sArithBase.nCmdUsed; )
8226  {
8227    if(an>=en-1)
8228    {
8229      if (strcmp(n, sArithBase.sCmds[an].name) == 0)
8230      {
8231        i=an;
8232        break;
8233      }
8234      else if ((an!=en) && (strcmp(n, sArithBase.sCmds[en].name) == 0))
8235      {
8236        i=en;
8237        break;
8238      }
8239      else
8240      {
8241        // -- blackbox extensions:
8242        // return 0;
8243        return blackboxIsCmd(n,tok);
8244      }
8245    }
8246    i=(an+en)/2;
8247    if (*n < *(sArithBase.sCmds[i].name))
8248    {
8249      en=i-1;
8250    }
8251    else if (*n > *(sArithBase.sCmds[i].name))
8252    {
8253      an=i+1;
8254    }
8255    else
8256    {
8257      int v=strcmp(n,sArithBase.sCmds[i].name);
8258      if(v<0)
8259      {
8260        en=i-1;
8261      }
8262      else if(v>0)
8263      {
8264        an=i+1;
8265      }
8266      else /*v==0*/
8267      {
8268        break;
8269      }
8270    }
8271  }
8272  lastreserved=sArithBase.sCmds[i].name;
8273  tok=sArithBase.sCmds[i].tokval;
8274  if(sArithBase.sCmds[i].alias==2)
8275  {
8276    Warn("outdated identifier `%s` used - please change your code",
8277    sArithBase.sCmds[i].name);
8278    sArithBase.sCmds[i].alias=1;
8279  }
8280  if (currRingHdl==NULL)
8281  {
8282    #ifdef SIQ
8283    if (siq<=0)
8284    {
8285    #endif
8286      if ((tok>=BEGIN_RING) && (tok<=END_RING))
8287      {
8288        WerrorS("no ring active");
8289        return 0;
8290      }
8291    #ifdef SIQ
8292    }
8293    #endif
8294  }
8295  if (!expected_parms)
8296  {
8297    switch (tok)
8298    {
8299      case IDEAL_CMD:
8300      case INT_CMD:
8301      case INTVEC_CMD:
8302      case MAP_CMD:
8303      case MATRIX_CMD:
8304      case MODUL_CMD:
8305      case POLY_CMD:
8306      case PROC_CMD:
8307      case RING_CMD:
8308      case STRING_CMD:
8309        cmdtok = tok;
8310        break;
8311    }
8312  }
8313  return sArithBase.sCmds[i].toktype;
8314}
8315static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op)
8316{
8317  int a=0;
8318  int e=len;
8319  int p=len/2;
8320  do
8321  {
8322     if (op==dArithTab[p].cmd) return dArithTab[p].start;
8323     if (op<dArithTab[p].cmd) e=p-1;
8324     else   a = p+1;
8325     p=a+(e-a)/2;
8326  }
8327  while ( a <= e);
8328
8329  assume(0);
8330  return 0;
8331}
8332
8333const char * Tok2Cmdname(int tok)
8334{
8335  int i = 0;
8336  if (tok <= 0)
8337  {
8338    return sArithBase.sCmds[0].name;
8339  }
8340  if (tok==ANY_TYPE) return "any_type";
8341  if (tok==COMMAND) return "command";
8342  if (tok==NONE) return "nothing";
8343  //if (tok==IFBREAK) return "if_break";
8344  //if (tok==VECTOR_FROM_POLYS) return "vector_from_polys";
8345  //if (tok==ORDER_VECTOR) return "ordering";
8346  //if (tok==REF_VAR) return "ref";
8347  //if (tok==OBJECT) return "object";
8348  //if (tok==PRINT_EXPR) return "print_expr";
8349  if (tok==IDHDL) return "identifier";
8350  if (tok>MAX_TOK) return getBlackboxName(tok);
8351  for(i=0; i<sArithBase.nCmdUsed; i++)
8352    //while (sArithBase.sCmds[i].tokval!=0)
8353  {
8354    if ((sArithBase.sCmds[i].tokval == tok)&&
8355        (sArithBase.sCmds[i].alias==0))
8356    {
8357      return sArithBase.sCmds[i].name;
8358    }
8359  }
8360  return sArithBase.sCmds[0].name;
8361}
8362
8363
8364/*---------------------------------------------------------------------*/
8365/**
8366 * @brief compares to entry of cmdsname-list
8367
8368 @param[in] a
8369 @param[in] b
8370
8371 @return <ReturnValue>
8372**/
8373/*---------------------------------------------------------------------*/
8374static int _gentable_sort_cmds( const void *a, const void *b )
8375{
8376  cmdnames *pCmdL = (cmdnames*)a;
8377  cmdnames *pCmdR = (cmdnames*)b;
8378
8379  if(a==NULL || b==NULL)             return 0;
8380
8381  /* empty entries goes to the end of the list for later reuse */
8382  if(pCmdL->name==NULL) return 1;
8383  if(pCmdR->name==NULL) return -1;
8384
8385  /* $INVALID$ must come first */
8386  if(strcmp(pCmdL->name, "$INVALID$")==0) return -1;
8387  if(strcmp(pCmdR->name, "$INVALID$")==0) return  1;
8388
8389  /* tokval=-1 are reserved names at the end */
8390  if (pCmdL->tokval==-1)
8391  {
8392    if (pCmdR->tokval==-1)
8393       return strcmp(pCmdL->name, pCmdR->name);
8394    /* pCmdL->tokval==-1, pCmdL goes at the end */
8395    return 1;
8396  }
8397  /* pCmdR->tokval==-1, pCmdR goes at the end */
8398  if(pCmdR->tokval==-1) return -1;
8399
8400  return strcmp(pCmdL->name, pCmdR->name);
8401}
8402
8403/*---------------------------------------------------------------------*/
8404/**
8405 * @brief initialisation of arithmetic structured data
8406
8407 @retval 0 on success
8408
8409**/
8410/*---------------------------------------------------------------------*/
8411int iiInitArithmetic()
8412{
8413  //printf("iiInitArithmetic()\n");
8414  memset(&sArithBase, 0, sizeof(sArithBase));
8415  iiInitCmdName();
8416  /* fix last-identifier */
8417#if 0
8418  /* we expect that gentable allready did every thing */
8419  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8420      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--) {
8421    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8422  }
8423#endif
8424  //Print("L=%d\n", sArithBase.nLastIdentifier);
8425
8426  //iiArithAddCmd(szName, nAlias, nTokval, nToktype);
8427  //iiArithAddCmd("mygcd", 1, GCD_CMD, CMD_2);
8428
8429  //iiArithAddCmd("Top", 0,-1,0);
8430
8431
8432  //for(i=0; i<sArithBase.nCmdUsed; i++) {
8433  //  printf("CMD[%03d] %s, %d, %d, %d\n", i,
8434  //         sArithBase.sCmds[i].name,
8435  //         sArithBase.sCmds[i].alias,
8436  //         sArithBase.sCmds[i].tokval,
8437  //         sArithBase.sCmds[i].toktype);
8438  //}
8439  //iiArithRemoveCmd("Top");
8440  //iiArithAddCmd("mygcd", 2, GCD_CMD, CMD_2);
8441  //iiArithRemoveCmd("mygcd");
8442  //iiArithAddCmd("kkk", 1, 1234, CMD_1);
8443  return 0;
8444}
8445
8446int iiArithFindCmd(const char *szName)
8447{
8448  int an=0;
8449  int i = 0,v = 0;
8450  int en=sArithBase.nLastIdentifier;
8451
8452  loop
8453  //for(an=0; an<sArithBase.nCmdUsed; )
8454  {
8455    if(an>=en-1)
8456    {
8457      if (strcmp(szName, sArithBase.sCmds[an].name) == 0)
8458      {
8459        //Print("RET-an=%d %s\n", an, sArithBase.sCmds[an].name);
8460        return an;
8461      }
8462      else if (strcmp(szName, sArithBase.sCmds[en].name) == 0)
8463      {
8464        //Print("RET-en=%d %s\n", en, sArithBase.sCmds[en].name);
8465        return en;
8466      }
8467      else
8468      {
8469        //Print("RET- 1\n");
8470        return -1;
8471      }
8472    }
8473    i=(an+en)/2;
8474    if (*szName < *(sArithBase.sCmds[i].name))
8475    {
8476      en=i-1;
8477    }
8478    else if (*szName > *(sArithBase.sCmds[i].name))
8479    {
8480      an=i+1;
8481    }
8482    else
8483    {
8484      v=strcmp(szName,sArithBase.sCmds[i].name);
8485      if(v<0)
8486      {
8487        en=i-1;
8488      }
8489      else if(v>0)
8490      {
8491        an=i+1;
8492      }
8493      else /*v==0*/
8494      {
8495        //Print("RET-i=%d %s\n", i, sArithBase.sCmds[i].name);
8496        return i;
8497      }
8498    }
8499  }
8500  //if(i>=0 && i<sArithBase.nCmdUsed)
8501  //  return i;
8502  //Print("RET-2\n");
8503  return -2;
8504}
8505
8506char *iiArithGetCmd( int nPos )
8507{
8508  if(nPos<0) return NULL;
8509  if(nPos<sArithBase.nCmdUsed)
8510    return sArithBase.sCmds[nPos].name;
8511  return NULL;
8512}
8513
8514int iiArithRemoveCmd(const char *szName)
8515{
8516  int nIndex;
8517  if(szName==NULL) return -1;
8518
8519  nIndex = iiArithFindCmd(szName);
8520  if(nIndex<0 || nIndex>=sArithBase.nCmdUsed)
8521  {
8522    Print("'%s' not found (%d)\n", szName, nIndex);
8523    return -1;
8524  }
8525  omFree(sArithBase.sCmds[nIndex].name);
8526  sArithBase.sCmds[nIndex].name=NULL;
8527  qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
8528        (&_gentable_sort_cmds));
8529  sArithBase.nCmdUsed--;
8530
8531  /* fix last-identifier */
8532  for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8533      sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
8534  {
8535    if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8536  }
8537  //Print("L=%d\n", sArithBase.nLastIdentifier);
8538  return 0;
8539}
8540
8541int iiArithAddCmd(
8542  const char *szName,
8543  short nAlias,
8544  short nTokval,
8545  short nToktype,
8546  short nPos
8547  )
8548{
8549  //printf("AddCmd(%s, %d, %d, %d, %d)\n", szName, nAlias,
8550  //       nTokval, nToktype, nPos);
8551  if(nPos>=0)
8552  {
8553    // no checks: we rely on a correct generated code in iparith.inc
8554    assume(nPos < sArithBase.nCmdAllocated);
8555    assume(szName!=NULL);
8556    sArithBase.sCmds[nPos].name    = omStrDup(szName);
8557    sArithBase.sCmds[nPos].alias   = nAlias;
8558    sArithBase.sCmds[nPos].tokval  = nTokval;
8559    sArithBase.sCmds[nPos].toktype = nToktype;
8560    sArithBase.nCmdUsed++;
8561    //if(nTokval>0) sArithBase.nLastIdentifier++;
8562  }
8563  else
8564  {
8565    if(szName==NULL) return -1;
8566    int nIndex = iiArithFindCmd(szName);
8567    if(nIndex>=0)
8568    {
8569      Print("'%s' already exists at %d\n", szName, nIndex);
8570      return -1;
8571    }
8572
8573    if(sArithBase.nCmdUsed>=sArithBase.nCmdAllocated)
8574    {
8575      /* needs to create new slots */
8576      unsigned long nSize = (sArithBase.nCmdAllocated+1)*sizeof(cmdnames);
8577      sArithBase.sCmds = (cmdnames *)omRealloc(sArithBase.sCmds, nSize);
8578      if(sArithBase.sCmds==NULL) return -1;
8579      sArithBase.nCmdAllocated++;
8580    }
8581    /* still free slots available */
8582    sArithBase.sCmds[sArithBase.nCmdUsed].name    = omStrDup(szName);
8583    sArithBase.sCmds[sArithBase.nCmdUsed].alias   = nAlias;
8584    sArithBase.sCmds[sArithBase.nCmdUsed].tokval  = nTokval;
8585    sArithBase.sCmds[sArithBase.nCmdUsed].toktype = nToktype;
8586    sArithBase.nCmdUsed++;
8587
8588    qsort(sArithBase.sCmds, sArithBase.nCmdUsed, sizeof(cmdnames),
8589          (&_gentable_sort_cmds));
8590    for(sArithBase.nLastIdentifier=sArithBase.nCmdUsed-1;
8591        sArithBase.nLastIdentifier>0; sArithBase.nLastIdentifier--)
8592    {
8593      if(sArithBase.sCmds[sArithBase.nLastIdentifier].tokval>=0) break;
8594    }
8595    //Print("L=%d\n", sArithBase.nLastIdentifier);
8596  }
8597  return 0;
8598}
8599
8600static BOOLEAN check_valid(const int p, const int op)
8601{
8602  #ifdef HAVE_PLURAL
8603  if (rIsPluralRing(currRing))
8604  {
8605    if ((p & PLURAL_MASK)==0 /*NO_PLURAL*/)
8606    {
8607      WerrorS("not implemented for non-commutative rings");
8608      return TRUE;
8609    }
8610    else if ((p & PLURAL_MASK)==2 /*, COMM_PLURAL */)
8611    {
8612      Warn("assume commutative subalgebra for cmd `%s`",Tok2Cmdname(op));
8613      return FALSE;
8614    }
8615    /* else, ALLOW_PLURAL */
8616  }
8617  #endif
8618  #ifdef HAVE_RINGS
8619  if (rField_is_Ring(currRing))
8620  {
8621    if ((p & RING_MASK)==0 /*NO_RING*/)
8622    {
8623      WerrorS("not implemented for rings with rings as coeffients");
8624      return TRUE;
8625    }
8626    /* else ALLOW_RING */
8627    else if (((p & ZERODIVISOR_MASK)==NO_ZERODIVISOR)
8628    &&(!rField_is_Domain(currRing)))
8629    {
8630      WerrorS("domain required as coeffients");
8631      return TRUE;
8632    }
8633    /* else ALLOW_ZERODIVISOR */
8634  }
8635  #endif
8636  return FALSE;
8637}
Note: See TracBrowser for help on using the repository browser.