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

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