source: git/Singular/iparith.cc @ 9f7665

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