source: git/Singular/iparith.cc @ 511f2d

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