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

spielwiese
Last change on this file since 4def554 was 4def554, checked in by Hans Schoenemann <hannes@…>, 10 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 );