source: git/Singular/iparith.cc @ 57dcd6

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