source: git/Singular/iparith.cc @ 4def554

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