source: git/Singular/iparith.cc @ 5edb77

spielwiese
Last change on this file since 5edb77 was 5edb77, checked in by Hans Schoenemann <hannes@…>, 11 years ago
fix: iiMake_proc (gcc 4.7)
  • Property mode set to 100644
File size: 216.5 KB
Line 
1/****************************************
2*  Computer Algebra System SINGULAR     *
3****************************************/
4
5/*
6* ABSTRACT: table driven kernel interface, used by interpreter
7*/
8
9#include <stdlib.h>
10#include <string.h>
11#include <ctype.h>
12#include <stdio.h>
13#include <time.h>
14#include <unistd.h>
15
16#include "config.h"
17#include <coeffs/bigintmat.h>
18#include <kernel/mod2.h>
19#include <Singular/tok.h>
20#include <misc/options.h>
21#include <Singular/ipid.h>
22#include <misc/intvec.h>
23#include <omalloc/omalloc.h>
24#include <kernel/polys.h>
25#include <kernel/febase.h>
26#include <Singular/sdb.h>
27#include <kernel/ideals.h>
28#include <polys/prCopy.h>
29#include <polys/matpol.h>
30#include <kernel/kstd1.h>
31#include <kernel/timer.h>
32
33#include <kernel/preimage.h>
34
35#include <Singular/subexpr.h>
36#include <Singular/lists.h>
37#include <kernel/modulop.h>
38#ifdef HAVE_RINGS
39#include <coeffs/rmodulon.h>
40#include <coeffs/rmodulo2m.h>
41#include <coeffs/rintegers.h>
42#endif
43#include <coeffs/numbers.h>
44#include <kernel/stairc.h>
45#include <polys/monomials/maps.h>
46#include <Singular/maps_ip.h>
47#include <kernel/syz.h>
48#include <polys/weight.h>
49#include <Singular/ipconv.h>
50#include <Singular/ipprint.h>
51#include <Singular/attrib.h>
52#include <Singular/silink.h>
53#include <polys/sparsmat.h>
54#include <kernel/units.h>
55#include <Singular/janet.h>
56#include <kernel/GMPrat.h>
57#include <kernel/tgb.h>
58#include <kernel/walkProc.h>
59#include <polys/mod_raw.h>
60#include <Singular/MinorInterface.h>
61#include <kernel/linearAlgebra.h>
62#include <Singular/misc_ip.h>
63#include <Singular/linearAlgebra_ip.h>
64#ifdef HAVE_FACTORY
65#  include <polys/clapsing.h>
66#  include <kernel/kstdfac.h>
67#endif /* HAVE_FACTORY */
68#ifdef HAVE_FACTORY
69#  include <kernel/fglm.h>
70#  include <Singular/fglm.h>
71#endif /* HAVE_FACTORY */
72#include <Singular/interpolation.h>
73
74#include <Singular/blackbox.h>
75#include <Singular/newstruct.h>
76#include <Singular/ipshell.h>
77//#include <kernel/mpr_inout.h>
78
79#include <kernel/timer.h>
80
81#include <polys/coeffrings.h>
82
83lists rDecompose(const ring r);
84ring rCompose(const lists  L, const BOOLEAN check_comp=TRUE);
85
86
87// defaults for all commands: NO_PLURAL | NO_RING | ALLOW_ZERODIVISOR
88
89#ifdef HAVE_PLURAL
90  #include <kernel/ratgring.h>
91  #include <kernel/nc.h>
92  #include <polys/nc/nc.h>
93  #include <polys/nc/sca.h>
94  #define ALLOW_PLURAL     1
95  #define NO_PLURAL        0
96  #define COMM_PLURAL      2
97  #define  PLURAL_MASK 3
98#else /* HAVE_PLURAL */
99  #define ALLOW_PLURAL     0
100  #define NO_PLURAL        0
101  #define COMM_PLURAL      0
102  #define  PLURAL_MASK     0
103#endif /* HAVE_PLURAL */
104
105#ifdef HAVE_RINGS
106  #define RING_MASK        4
107  #define ZERODIVISOR_MASK 8
108#else
109  #define RING_MASK        0
110  #define ZERODIVISOR_MASK 0
111#endif
112#define ALLOW_RING       4
113#define NO_RING          0
114#define NO_ZERODIVISOR   8
115#define ALLOW_ZERODIVISOR  0
116
117static BOOLEAN check_valid(const int p, const int op);
118
119/*=============== types =====================*/
120struct sValCmdTab
121{
122  short cmd;
123  short start;
124};
125
126typedef sValCmdTab jjValCmdTab[];
127
128struct _scmdnames
129{
130  char *name;
131  short alias;
132  short tokval;
133  short toktype;
134};
135typedef struct _scmdnames cmdnames;
136
137
138typedef char * (*Proc1)(char *);
139struct sValCmd1
140{
141  proc1 p;
142  short cmd;
143  short res;
144  short arg;
145  short valid_for;
146};
147
148typedef BOOLEAN (*proc2)(leftv,leftv,leftv);
149struct sValCmd2
150{
151  proc2 p;
152  short cmd;
153  short res;
154  short arg1;
155  short arg2;
156  short valid_for;
157};
158
159typedef BOOLEAN (*proc3)(leftv,leftv,leftv,leftv);
160struct sValCmd3
161{
162  proc3 p;
163  short cmd;
164  short res;
165  short arg1;
166  short arg2;
167  short arg3;
168  short valid_for;
169};
170struct sValCmdM
171{
172  proc1 p;
173  short cmd;
174  short res;
175  short number_of_args; /* -1: any, -2: any >0, .. */
176  short valid_for;
177};
178
179typedef struct
180{
181  cmdnames *sCmds;             /**< array of existing commands */
182  struct sValCmd1 *psValCmd1;
183  struct sValCmd2 *psValCmd2;
184  struct sValCmd3 *psValCmd3;
185  struct sValCmdM *psValCmdM;
186  int nCmdUsed;      /**< number of commands used */
187  int nCmdAllocated; /**< number of commands-slots allocated */
188  int nLastIdentifier; /**< valid indentifieres are slot 1..nLastIdentifier */
189} SArithBase;
190
191/*---------------------------------------------------------------------*
192 * File scope Variables (Variables share by several functions in
193 *                       the same file )
194 *
195 *---------------------------------------------------------------------*/
196static SArithBase sArithBase;  /**< Base entry for arithmetic */
197
198/*---------------------------------------------------------------------*
199 * Extern Functions declarations
200 *
201 *---------------------------------------------------------------------*/
202static int _gentable_sort_cmds(const void *a, const void *b);
203extern int iiArithRemoveCmd(char *szName);
204extern int iiArithAddCmd(const char *szName, short nAlias, short nTokval,
205                         short nToktype, short nPos=-1);
206
207/*============= proc =======================*/
208static BOOLEAN jjLOAD(leftv res, leftv v, BOOLEAN autoexport = FALSE);
209static int iiTabIndex(const jjValCmdTab dArithTab, const int len, const int op);
210static Subexpr jjMakeSub(leftv e);
211
212/*============= vars ======================*/
213extern int cmdtok;
214extern BOOLEAN expected_parms;
215
216#define ii_div_by_0 "div. by 0"
217
218int iiOp; /* the current operation*/
219
220/*=================== simple helpers =================*/
221poly pHeadProc(poly p)
222{
223  return pHead(p);
224}
225
226int iiTokType(int op)
227{
228  for (int i=0;i<sArithBase.nCmdUsed;i++)
229  {
230    if (sArithBase.sCmds[i].tokval==op)
231      return sArithBase.sCmds[i].toktype;
232  }
233  return 0;
234}
235
236/*=================== operations with 2 args.: static proc =================*/
237/* must be ordered: first operations for chars (infix ops),
238 * then alphabetically */
239
240static BOOLEAN jjOP_BIM_I(leftv res, leftv u, leftv v)
241{
242  bigintmat* aa= (bigintmat *)u->Data();
243  int bb = (int)(long)(v->Data());
244  if (errorreported) return TRUE;
245  bigintmat *cc=NULL;
246  switch (iiOp)
247  {
248    case '+': cc=bimAdd(aa,bb); break;
249    case '-': cc=bimSub(aa,bb); break;
250    case '*': cc=bimMult(aa,bb); break;
251  }
252  res->data=(char *)cc;
253  return cc==NULL;
254}
255static BOOLEAN jjOP_I_BIM(leftv res, leftv u, leftv v)
256{
257  return jjOP_BIM_I(res, v, u);
258}
259static BOOLEAN jjOP_BIM_BI(leftv res, leftv u, leftv v)
260{
261  bigintmat* aa= (bigintmat *)u->Data();
262  number bb = (number)(v->Data());
263  if (errorreported) return TRUE;
264  bigintmat *cc=NULL;
265  switch (iiOp)
266  {
267    case '*': cc=bimMult(aa,bb,coeffs_BIGINT); break;
268  }
269  res->data=(char *)cc;
270  return cc==NULL;
271}
272static BOOLEAN jjOP_BI_BIM(leftv res, leftv u, leftv v)
273{
274  return jjOP_BIM_BI(res, v, u);
275}
276static BOOLEAN jjOP_IV_I(leftv res, leftv u, leftv v)
277{
278  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
279  int bb = (int)(long)(v->Data());
280  if (errorreported) return TRUE;
281  switch (iiOp)
282  {
283    case '+': (*aa) += bb; break;
284    case '-': (*aa) -= bb; break;
285    case '*': (*aa) *= bb; break;
286    case '/':
287    case INTDIV_CMD: (*aa) /= bb; break;
288    case '%': (*aa) %= bb; break;
289  }
290  res->data=(char *)aa;
291  return FALSE;
292}
293static BOOLEAN jjOP_I_IV(leftv res, leftv u, leftv v)
294{
295  return jjOP_IV_I(res,v,u);
296}
297static BOOLEAN jjOP_IM_I(leftv res, leftv u, leftv v)
298{
299  intvec* aa= (intvec *)u->CopyD(INTVEC_CMD);
300  int bb = (int)(long)(v->Data());
301  int i=si_min(aa->rows(),aa->cols());
302  switch (iiOp)
303  {
304    case '+': for (;i>0;i--) IMATELEM(*aa,i,i) += bb;
305              break;
306    case '-': for (;i>0;i--) IMATELEM(*aa,i,i) -= bb;
307              break;
308  }
309  res->data=(char *)aa;
310  return FALSE;
311}
312static BOOLEAN jjOP_I_IM(leftv res, leftv u, leftv v)
313{
314  return jjOP_IM_I(res,v,u);
315}
316static BOOLEAN jjCOLON(leftv res, leftv u, leftv v)
317{
318  int l=(int)(long)v->Data();
319  if (l>0)
320  {
321    int d=(int)(long)u->Data();
322    intvec *vv=new intvec(l);
323    int i;
324    for(i=l-1;i>=0;i--) { (*vv)[i]=d; }
325    res->data=(char *)vv;
326  }
327  return (l<=0);
328}
329static BOOLEAN jjDOTDOT(leftv res, leftv u, leftv v)
330{
331  res->data=(char *)new intvec((int)(long)u->Data(),(int)(long)v->Data());
332  return FALSE;
333}
334static void jjEQUAL_REST(leftv res,leftv u,leftv v);
335static BOOLEAN jjCOMPARE_IV(leftv res, leftv u, leftv v)
336{
337  intvec*    a = (intvec * )(u->Data());
338  intvec*    b = (intvec * )(v->Data());
339  int r=a->compare(b);
340  switch  (iiOp)
341  {
342    case '<':
343      res->data  = (char *) (r<0);
344      break;
345    case '>':
346      res->data  = (char *) (r>0);
347      break;
348    case LE:
349      res->data  = (char *) (r<=0);
350      break;
351    case GE:
352      res->data  = (char *) (r>=0);
353      break;
354    case EQUAL_EQUAL:
355    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
356      res->data  = (char *) (r==0);
357      break;
358  }
359  jjEQUAL_REST(res,u,v);
360  if(r==-2) { WerrorS("size incompatible"); return TRUE; }
361  return FALSE;
362}
363static BOOLEAN jjCOMPARE_BIM(leftv res, leftv u, leftv v)
364{
365  bigintmat*    a = (bigintmat * )(u->Data());
366  bigintmat*    b = (bigintmat * )(v->Data());
367  int r=a->compare(b);
368  switch  (iiOp)
369  {
370    case '<':
371      res->data  = (char *) (r<0);
372      break;
373    case '>':
374      res->data  = (char *) (r>0);
375      break;
376    case LE:
377      res->data  = (char *) (r<=0);
378      break;
379    case GE:
380      res->data  = (char *) (r>=0);
381      break;
382    case EQUAL_EQUAL:
383    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
384      res->data  = (char *) (r==0);
385      break;
386  }
387  jjEQUAL_REST(res,u,v);
388  if(r==-2) { WerrorS("size incompatible"); return TRUE; }
389  return FALSE;
390}
391static BOOLEAN jjCOMPARE_IV_I(leftv res, leftv u, leftv v)
392{
393  intvec* a = (intvec * )(u->Data());
394  int     b = (int)(long)(v->Data());
395  int r=a->compare(b);
396  switch  (iiOp)
397  {
398    case '<':
399      res->data  = (char *) (r<0);
400      break;
401    case '>':
402      res->data  = (char *) (r>0);
403      break;
404    case LE:
405      res->data  = (char *) (r<=0);
406      break;
407    case GE:
408      res->data  = (char *) (r>=0);
409      break;
410    case EQUAL_EQUAL:
411    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
412      res->data  = (char *) (r==0);
413      break;
414  }
415  jjEQUAL_REST(res,u,v);
416  return FALSE;
417}
418static BOOLEAN jjCOMPARE_P(leftv res, leftv u, leftv v)
419{
420  poly p=(poly)u->Data();
421  poly q=(poly)v->Data();
422  int r=pCmp(p,q);
423  if (r==0)
424  {
425    number h=nSub(pGetCoeff(p),pGetCoeff(q));
426    /* compare lead coeffs */
427    r = -1+nIsZero(h)+2*nGreaterZero(h); /* -1: <, 0:==, 1: > */
428    nDelete(&h);
429  }
430  else if (p==NULL)
431  {
432    if (q==NULL)
433    {
434      /* compare 0, 0 */
435      r=0;
436    }
437    else if(pIsConstant(q))
438    {
439      /* compare 0, const */
440      r = 1-2*nGreaterZero(pGetCoeff(q)); /* -1: <, 1: > */
441    }
442  }
443  else if (q==NULL)
444  {
445    if (pIsConstant(p))
446    {
447      /* compare const, 0 */
448      r = -1+2*nGreaterZero(pGetCoeff(p)); /* -1: <, 1: > */
449    }
450  }
451  switch  (iiOp)
452  {
453    case '<':
454      res->data  = (char *) (r < 0);
455      break;
456    case '>':
457      res->data  = (char *) (r > 0);
458      break;
459    case LE:
460      res->data  = (char *) (r <= 0);
461      break;
462    case GE:
463      res->data  = (char *) (r >= 0);
464      break;
465    //case EQUAL_EQUAL:
466    //case NOTEQUAL: /* negation handled by jjEQUAL_REST */
467    //  res->data  = (char *) (r == 0);
468    //  break;
469  }
470  jjEQUAL_REST(res,u,v);
471  return FALSE;
472}
473static BOOLEAN jjCOMPARE_S(leftv res, leftv u, leftv v)
474{
475  char*    a = (char * )(u->Data());
476  char*    b = (char * )(v->Data());
477  int result = strcmp(a,b);
478  switch  (iiOp)
479  {
480    case '<':
481      res->data  = (char *) (result  < 0);
482      break;
483    case '>':
484      res->data  = (char *) (result  > 0);
485      break;
486    case LE:
487      res->data  = (char *) (result  <= 0);
488      break;
489    case GE:
490      res->data  = (char *) (result  >= 0);
491      break;
492    case EQUAL_EQUAL:
493    case NOTEQUAL: /* negation handled by jjEQUAL_REST */
494      res->data  = (char *) (result  == 0);
495      break;
496  }
497  jjEQUAL_REST(res,u,v);
498  return FALSE;
499}
500static BOOLEAN jjOP_REST(leftv res, leftv u, leftv v)
501{
502  if (u->Next()!=NULL)
503  {
504    u=u->next;
505    res->next = (leftv)omAllocBin(sleftv_bin);
506    return iiExprArith2(res->next,u,iiOp,v);
507  }
508  else if (v->Next()!=NULL)
509  {
510    v=v->next;
511    res->next = (leftv)omAllocBin(sleftv_bin);
512    return iiExprArith2(res->next,u,iiOp,v);
513  }
514  return FALSE;
515}
516static BOOLEAN jjPOWER_I(leftv res, leftv u, leftv v)
517{
518  int b=(int)(long)u->Data();
519  int e=(int)(long)v->Data();
520  int rc = 1;
521  BOOLEAN overflow=FALSE;
522  if (e >= 0)
523  {
524    if (b==0)
525    {
526      rc=(e==0);
527    }
528    else
529    {
530      int oldrc;
531      while ((e--)!=0)
532      {
533        oldrc=rc;
534        rc *= b;
535        if (!overflow)
536        {
537          if(rc/b!=oldrc) overflow=TRUE;
538        }
539      }
540      if (overflow)
541        WarnS("int overflow(^), result may be wrong");
542    }
543    res->data = (char *)((long)rc);
544    if (u!=NULL) return jjOP_REST(res,u,v);
545    return FALSE;
546  }
547  else
548  {
549    WerrorS("exponent must be non-negative");
550    return TRUE;
551  }
552}
553static BOOLEAN jjPOWER_BI(leftv res, leftv u, leftv v)
554{
555  int e=(int)(long)v->Data();
556  number n=(number)u->Data();
557  if (e>=0)
558  {
559    n_Power(n,e,(number*)&res->data,coeffs_BIGINT);
560  }
561  else
562  {
563    WerrorS("exponent must be non-negative");
564    return TRUE;
565  }
566  if (u!=NULL) return jjOP_REST(res,u,v);
567  return FALSE;
568}
569static BOOLEAN jjPOWER_N(leftv res, leftv u, leftv v)
570{
571  int e=(int)(long)v->Data();
572  number n=(number)u->Data();
573  int d=0;
574  if (e<0)
575  {
576    n=nInvers(n);
577    e=-e;
578    d=1;
579  }
580  nPower(n,e,(number*)&res->data);
581  if (d) nDelete(&n);
582  if (u!=NULL) return jjOP_REST(res,u,v);
583  return FALSE;
584}
585static BOOLEAN jjPOWER_P(leftv res, leftv u, leftv v)
586{
587  int v_i=(int)(long)v->Data();
588  if (v_i<0)
589  {
590    WerrorS("exponent must be non-negative");
591    return TRUE;
592  }
593  poly u_p=(poly)u->CopyD(POLY_CMD);
594  if ((u_p!=NULL)
595  && ((v_i!=0) &&
596      ((long)pTotaldegree(u_p) > (signed long)currRing->bitmask / (signed long)v_i)))
597  {
598    Werror("OVERFLOW in power(d=%ld, e=%d, max=%ld)",
599                                    pTotaldegree(u_p),v_i,currRing->bitmask);
600    pDelete(&u_p);
601    return TRUE;
602  }
603  res->data = (char *)pPower(u_p,v_i);
604  if (u!=NULL) return jjOP_REST(res,u,v);
605  return errorreported; /* pPower may set errorreported via Werror */
606}
607static BOOLEAN jjPOWER_ID(leftv res, leftv u, leftv v)
608{
609  res->data = (char *)id_Power((ideal)(u->Data()),(int)(long)(v->Data()), currRing);
610  if (u!=NULL) return jjOP_REST(res,u,v);
611  return FALSE;
612}
613static BOOLEAN jjPLUSMINUS_Gen(leftv res, leftv u, leftv v)
614{
615  u=u->next;
616  v=v->next;
617  if (u==NULL)
618  {
619    if (v==NULL) return FALSE;      /* u==NULL, v==NULL */
620    if (iiOp=='-')                  /* u==NULL, v<>NULL, iiOp=='-'*/
621    {
622      do
623      {
624        if (res->next==NULL)
625          res->next = (leftv)omAlloc0Bin(sleftv_bin);
626        leftv tmp_v=v->next;
627        v->next=NULL;
628        BOOLEAN b=iiExprArith1(res->next,v,'-');
629        v->next=tmp_v;
630        if (b)
631          return TRUE;
632        v=tmp_v;
633        res=res->next;
634      } while (v!=NULL);
635      return FALSE;
636    }
637    loop                            /* u==NULL, v<>NULL, iiOp=='+' */
638    {
639      res->next = (leftv)omAlloc0Bin(sleftv_bin);
640      res=res->next;
641      res->data = v->CopyD();
642      res->rtyp = v->Typ();
643      v=v->next;
644      if (v==NULL) return FALSE;
645    }
646  }
647  if (v!=NULL)                     /* u<>NULL, v<>NULL */
648  {
649    do
650    {
651      res->next = (leftv)omAlloc0Bin(sleftv_bin);
652      leftv tmp_u=u->next; u->next=NULL;
653      leftv tmp_v=v->next; v->next=NULL;
654      BOOLEAN b=iiExprArith2(res->next,u,iiOp,v);
655      u->next=tmp_u;
656      v->next=tmp_v;
657      if (b)
658        return TRUE;
659      u=tmp_u;
660      v=tmp_v;
661      res=res->next;
662    } while ((u!=NULL) && (v!=NULL));
663    return FALSE;
664  }
665  loop                             /* u<>NULL, v==NULL */
666  {
667    res->next = (leftv)omAlloc0Bin(sleftv_bin);
668    res=res->next;
669    res->data = u->CopyD();
670    res->rtyp = u->Typ();
671    u=u->next;
672    if (u==NULL) return FALSE;
673  }
674}
675static BOOLEAN jjCOLCOL(leftv res, leftv u, leftv v)
676{
677  idhdl packhdl;
678  switch(u->Typ())
679  {
680      case 0:
681        Print("%s of type 'ANY'. Trying load.\n", v->name);
682        if(iiTryLoadLib(u, u->name))
683        {
684          Werror("'%s' no such package", u->name);
685          return TRUE;
686        }
687        syMake(u,u->name,NULL);
688        // else: use next case !!! no break !!!
689      case PACKAGE_CMD:
690        packhdl = (idhdl)u->data;
691        if((!IDPACKAGE(packhdl)->loaded)
692        && (IDPACKAGE(packhdl)->language > LANG_TOP))
693        {
694          Werror("'%s' not loaded", u->name);
695          return TRUE;
696        }
697        if(v->rtyp == IDHDL)
698        {
699          v->name = omStrDup(v->name);
700        }
701        v->req_packhdl=IDPACKAGE(packhdl);
702        syMake(v, v->name, packhdl);
703        memcpy(res, v, sizeof(sleftv));
704        memset(v, 0, sizeof(sleftv));
705        break;
706      case DEF_CMD:
707        break;
708      default:
709        WerrorS("<package>::<id> expected");
710        return TRUE;
711  }
712  return FALSE;
713}
714static BOOLEAN jjPLUS_I(leftv res, leftv u, leftv v)
715{
716  unsigned int a=(unsigned int)(unsigned long)u->Data();
717  unsigned int b=(unsigned int)(unsigned long)v->Data();
718  unsigned int c=a+b;
719  res->data = (char *)((long)c);
720  if (((Sy_bit(31)&a)==(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
721  {
722    WarnS("int overflow(+), result may be wrong");
723  }
724  return jjPLUSMINUS_Gen(res,u,v);
725}
726static BOOLEAN jjPLUS_BI(leftv res, leftv u, leftv v)
727{
728  res->data = (char *)(n_Add((number)u->Data(), (number)v->Data(),coeffs_BIGINT));
729  return jjPLUSMINUS_Gen(res,u,v);
730}
731static BOOLEAN jjPLUS_N(leftv res, leftv u, leftv v)
732{
733  res->data = (char *)(nAdd((number)u->Data(), (number)v->Data()));
734  return jjPLUSMINUS_Gen(res,u,v);
735}
736static BOOLEAN jjPLUS_P(leftv res, leftv u, leftv v)
737{
738  res->data = (char *)(pAdd((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
739  return jjPLUSMINUS_Gen(res,u,v);
740}
741static BOOLEAN jjPLUS_IV(leftv res, leftv u, leftv v)
742{
743  res->data = (char *)ivAdd((intvec*)(u->Data()), (intvec*)(v->Data()));
744  if (res->data==NULL)
745  {
746     WerrorS("intmat size not compatible");
747     return TRUE;
748  }
749  return jjPLUSMINUS_Gen(res,u,v);
750}
751static BOOLEAN jjPLUS_BIM(leftv res, leftv u, leftv v)
752{
753  res->data = (char *)bimAdd((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
754  if (res->data==NULL)
755  {
756    WerrorS("bigintmat size not compatible");
757    return TRUE;
758  }
759  return jjPLUSMINUS_Gen(res,u,v);
760}
761static BOOLEAN jjPLUS_MA(leftv res, leftv u, leftv v)
762{
763  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
764  res->data = (char *)(mp_Add(A , B, currRing));
765  if (res->data==NULL)
766  {
767     Werror("matrix size not compatible(%dx%d, %dx%d)",
768             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
769     return TRUE;
770  }
771  return jjPLUSMINUS_Gen(res,u,v);
772}
773static BOOLEAN jjPLUS_MA_P(leftv res, leftv u, leftv v)
774{
775  matrix m=(matrix)u->Data();
776  matrix p= mp_InitP(m->nrows,m->ncols,(poly)(v->CopyD(POLY_CMD)),currRing);
777  if (iiOp=='+')
778    res->data = (char *)mp_Add(m , p,currRing);
779  else
780    res->data = (char *)mp_Sub(m , p,currRing);
781  idDelete((ideal *)&p);
782  return jjPLUSMINUS_Gen(res,u,v);
783}
784static BOOLEAN jjPLUS_P_MA(leftv res, leftv u, leftv v)
785{
786  return jjPLUS_MA_P(res,v,u);
787}
788static BOOLEAN jjPLUS_S(leftv res, leftv u, leftv v)
789{
790  char*    a = (char * )(u->Data());
791  char*    b = (char * )(v->Data());
792  char*    r = (char * )omAlloc(strlen(a) + strlen(b) + 1);
793  strcpy(r,a);
794  strcat(r,b);
795  res->data=r;
796  return jjPLUSMINUS_Gen(res,u,v);
797}
798static BOOLEAN jjPLUS_ID(leftv res, leftv u, leftv v)
799{
800  res->data = (char *)idAdd((ideal)u->Data(),(ideal)v->Data());
801  return jjPLUSMINUS_Gen(res,u,v);
802}
803static BOOLEAN jjMINUS_I(leftv res, leftv u, leftv v)
804{
805  void *ap=u->Data(); void *bp=v->Data();
806  int aa=(int)(long)ap;
807  int bb=(int)(long)bp;
808  int cc=aa-bb;
809  unsigned int a=(unsigned int)(unsigned long)ap;
810  unsigned int b=(unsigned int)(unsigned long)bp;
811  unsigned int c=a-b;
812  if (((Sy_bit(31)&a)!=(Sy_bit(31)&b))&&((Sy_bit(31)&a)!=(Sy_bit(31)&c)))
813  {
814    WarnS("int overflow(-), result may be wrong");
815  }
816  res->data = (char *)((long)cc);
817  return jjPLUSMINUS_Gen(res,u,v);
818}
819static BOOLEAN jjMINUS_BI(leftv res, leftv u, leftv v)
820{
821  res->data = (char *)(n_Sub((number)u->Data(), (number)v->Data(),coeffs_BIGINT));
822  return jjPLUSMINUS_Gen(res,u,v);
823}
824static BOOLEAN jjMINUS_N(leftv res, leftv u, leftv v)
825{
826  res->data = (char *)(nSub((number)u->Data(), (number)v->Data()));
827  return jjPLUSMINUS_Gen(res,u,v);
828}
829static BOOLEAN jjMINUS_P(leftv res, leftv u, leftv v)
830{
831  res->data = (char *)(pSub((poly)u->CopyD(POLY_CMD) , (poly)v->CopyD(POLY_CMD)));
832  return jjPLUSMINUS_Gen(res,u,v);
833}
834static BOOLEAN jjMINUS_IV(leftv res, leftv u, leftv v)
835{
836  res->data = (char *)ivSub((intvec*)(u->Data()), (intvec*)(v->Data()));
837  if (res->data==NULL)
838  {
839     WerrorS("intmat size not compatible");
840     return TRUE;
841  }
842  return jjPLUSMINUS_Gen(res,u,v);
843}
844static BOOLEAN jjMINUS_BIM(leftv res, leftv u, leftv v)
845{
846  res->data = (char *)bimSub((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
847  if (res->data==NULL)
848  {
849    WerrorS("bigintmat size not compatible");
850    return TRUE;
851  }
852  return jjPLUSMINUS_Gen(res,u,v);
853}
854static BOOLEAN jjMINUS_MA(leftv res, leftv u, leftv v)
855{
856  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
857  res->data = (char *)(mp_Sub(A , B, currRing));
858  if (res->data==NULL)
859  {
860     Werror("matrix size not compatible(%dx%d, %dx%d)",
861             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
862     return TRUE;
863  }
864  return jjPLUSMINUS_Gen(res,u,v);
865  return FALSE;
866}
867static BOOLEAN jjTIMES_I(leftv res, leftv u, leftv v)
868{
869  int a=(int)(long)u->Data();
870  int b=(int)(long)v->Data();
871  int64 c=(int64)a * (int64)b;
872  if ((c>INT_MAX)||(c<INT_MIN))
873    WarnS("int overflow(*), result may be wrong");
874  res->data = (char *)((long)((int)c));
875  if ((u->Next()!=NULL) || (v->Next()!=NULL))
876    return jjOP_REST(res,u,v);
877  return FALSE;
878}
879static BOOLEAN jjTIMES_BI(leftv res, leftv u, leftv v)
880{
881  res->data = (char *)(n_Mult( (number)u->Data(), (number)v->Data(),coeffs_BIGINT));
882  if ((v->next!=NULL) || (u->next!=NULL))
883    return jjOP_REST(res,u,v);
884  return FALSE;
885}
886static BOOLEAN jjTIMES_N(leftv res, leftv u, leftv v)
887{
888  res->data = (char *)(nMult( (number)u->Data(), (number)v->Data()));
889  number n=(number)res->data;
890  nNormalize(n);
891  res->data=(char *)n;
892  if ((v->next!=NULL) || (u->next!=NULL))
893    return jjOP_REST(res,u,v);
894  return FALSE;
895}
896static BOOLEAN jjTIMES_P(leftv res, leftv u, leftv v)
897{
898  poly a;
899  poly b;
900  if (v->next==NULL)
901  {
902    a=(poly)u->CopyD(POLY_CMD); // works also for VECTOR_CMD
903    if (u->next==NULL)
904    {
905      b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
906      if ((a!=NULL) && (b!=NULL)
907      && ((long)pTotaldegree(a)>si_max((long)rVar(currRing),(long)currRing->bitmask)-(long)pTotaldegree(b)))
908      {
909        Werror("OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
910          pTotaldegree(a),pTotaldegree(b),currRing->bitmask);
911        pDelete(&a);
912        pDelete(&b);
913        return TRUE;
914      }
915      res->data = (char *)(pMult( a, b));
916      pNormalize((poly)res->data);
917      return FALSE;
918    }
919    // u->next exists: copy v
920    b=pCopy((poly)v->Data());
921    if ((a!=NULL) && (b!=NULL)
922    && (pTotaldegree(a)+pTotaldegree(b)>si_max((long)rVar(currRing),(long)currRing->bitmask)))
923    {
924      Werror("OVERFLOW in mult(d=%ld, d=%ld, max=%ld)",
925          pTotaldegree(a),pTotaldegree(b),currRing->bitmask);
926      pDelete(&a);
927      pDelete(&b);
928      return TRUE;
929    }
930    res->data = (char *)(pMult( a, b));
931    pNormalize((poly)res->data);
932    return jjOP_REST(res,u,v);
933  }
934  // v->next exists: copy u
935  a=pCopy((poly)u->Data());
936  b=(poly)v->CopyD(POLY_CMD); // works also for VECTOR_CMD
937  if ((a!=NULL) && (b!=NULL)
938  && ((unsigned long)(pTotaldegree(a)+pTotaldegree(b))>=currRing->bitmask))
939  {
940    pDelete(&a);
941    pDelete(&b);
942    WerrorS("OVERFLOW");
943    return TRUE;
944  }
945  res->data = (char *)(pMult( a, b));
946  pNormalize((poly)res->data);
947  return jjOP_REST(res,u,v);
948}
949static BOOLEAN jjTIMES_ID(leftv res, leftv u, leftv v)
950{
951  res->data = (char *)idMult((ideal)u->Data(),(ideal)v->Data());
952  id_Normalize((ideal)res->data,currRing);
953  if ((v->next!=NULL) || (u->next!=NULL))
954    return jjOP_REST(res,u,v);
955  return FALSE;
956}
957static BOOLEAN jjTIMES_IV(leftv res, leftv u, leftv v)
958{
959  res->data = (char *)ivMult((intvec*)(u->Data()), (intvec*)(v->Data()));
960  if (res->data==NULL)
961  {
962     WerrorS("intmat size not compatible");
963     return TRUE;
964  }
965  if ((v->next!=NULL) || (u->next!=NULL))
966    return jjOP_REST(res,u,v);
967  return FALSE;
968}
969static BOOLEAN jjTIMES_BIM(leftv res, leftv u, leftv v)
970{
971  res->data = (char *)bimMult((bigintmat*)(u->Data()), (bigintmat*)(v->Data()));
972  if (res->data==NULL)
973  {
974    WerrorS("bigintmat size not compatible");
975    return TRUE;
976  }
977  if ((v->next!=NULL) || (u->next!=NULL))
978    return jjOP_REST(res,u,v);
979  return FALSE;
980}
981static BOOLEAN jjTIMES_MA_BI1(leftv res, leftv u, leftv v)
982{
983  number n=n_Init_bigint((number)v->Data(),coeffs_BIGINT,currRing->cf);
984  poly p=pNSet(n);
985  ideal I= (ideal)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
986  res->data = (char *)I;
987  return FALSE;
988}
989static BOOLEAN jjTIMES_MA_BI2(leftv res, leftv u, leftv v)
990{
991  return jjTIMES_MA_BI1(res,v,u);
992}
993static BOOLEAN jjTIMES_MA_P1(leftv res, leftv u, leftv v)
994{
995  poly p=(poly)v->CopyD(POLY_CMD);
996  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
997  ideal I= (ideal)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
998  if (r>0) I->rank=r;
999  id_Normalize(I,currRing);
1000  res->data = (char *)I;
1001  return FALSE;
1002}
1003static BOOLEAN jjTIMES_MA_P2(leftv res, leftv u, leftv v)
1004{
1005  poly p=(poly)u->CopyD(POLY_CMD);
1006  int r=pMaxComp(p);/* recompute the rank for the case ideal*vector*/
1007  ideal I= (ideal)pMultMp(p,(matrix)v->CopyD(MATRIX_CMD),currRing);
1008  if (r>0) I->rank=r;
1009  id_Normalize(I,currRing);
1010  res->data = (char *)I;
1011  return FALSE;
1012}
1013static BOOLEAN jjTIMES_MA_N1(leftv res, leftv u, leftv v)
1014{
1015  number n=(number)v->CopyD(NUMBER_CMD);
1016  poly p=pNSet(n);
1017  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),p,currRing);
1018  id_Normalize((ideal)res->data,currRing);
1019  return FALSE;
1020}
1021static BOOLEAN jjTIMES_MA_N2(leftv res, leftv u, leftv v)
1022{
1023  return jjTIMES_MA_N1(res,v,u);
1024}
1025static BOOLEAN jjTIMES_MA_I1(leftv res, leftv u, leftv v)
1026{
1027  res->data = (char *)mp_MultI((matrix)u->CopyD(MATRIX_CMD),(int)(long)v->Data(),currRing);
1028  id_Normalize((ideal)res->data,currRing);
1029  return FALSE;
1030}
1031static BOOLEAN jjTIMES_MA_I2(leftv res, leftv u, leftv v)
1032{
1033  return jjTIMES_MA_I1(res,v,u);
1034}
1035static BOOLEAN jjTIMES_MA(leftv res, leftv u, leftv v)
1036{
1037  matrix A=(matrix)u->Data(); matrix B=(matrix)v->Data();
1038  res->data = (char *)mp_Mult(A,B,currRing);
1039  if (res->data==NULL)
1040  {
1041     Werror("matrix size not compatible(%dx%d, %dx%d)",
1042             MATROWS(A),MATCOLS(A),MATROWS(B),MATCOLS(B));
1043     return TRUE;
1044  }
1045  id_Normalize((ideal)res->data,currRing);
1046  if ((v->next!=NULL) || (u->next!=NULL))
1047    return jjOP_REST(res,u,v);
1048  return FALSE;
1049}
1050static BOOLEAN jjGE_BI(leftv res, leftv u, leftv v)
1051{
1052  number h=n_Sub((number)u->Data(),(number)v->Data(),coeffs_BIGINT);
1053  res->data = (char *) (n_GreaterZero(h,coeffs_BIGINT)||(n_IsZero(h,coeffs_BIGINT)));
1054  n_Delete(&h,coeffs_BIGINT);
1055  return FALSE;
1056}
1057static BOOLEAN jjGE_I(leftv res, leftv u, leftv v)
1058{
1059  res->data = (char *)(long)((int)((long)u->Data()) >= (int)((long)v->Data()));
1060  return FALSE;
1061}
1062static BOOLEAN jjGE_N(leftv res, leftv u, leftv v)
1063{
1064  res->data = (char *)(long) (nGreater((number)u->Data(),(number)v->Data())
1065                       || nEqual((number)u->Data(),(number)v->Data()));
1066  return FALSE;
1067}
1068static BOOLEAN jjGT_BI(leftv res, leftv u, leftv v)
1069{
1070  number h=n_Sub((number)u->Data(),(number)v->Data(),coeffs_BIGINT);
1071  res->data = (char *)(long) (n_GreaterZero(h,coeffs_BIGINT)&&(!n_IsZero(h,coeffs_BIGINT)));
1072  n_Delete(&h,coeffs_BIGINT);
1073  return FALSE;
1074}
1075static BOOLEAN jjGT_I(leftv res, leftv u, leftv v)
1076{
1077  res->data = (char *)(long)((int)((long)u->Data()) > (int)((long)v->Data()));
1078  return FALSE;
1079}
1080static BOOLEAN jjGT_N(leftv res, leftv u, leftv v)
1081{
1082  res->data = (char *)(long)(nGreater((number)u->Data(),(number)v->Data()));
1083  return FALSE;
1084}
1085static BOOLEAN jjLE_BI(leftv res, leftv u, leftv v)
1086{
1087  return jjGE_BI(res,v,u);
1088}
1089static BOOLEAN jjLE_I(leftv res, leftv u, leftv v)
1090{
1091  res->data = (char *)(long)((int)((long)u->Data()) <= (int)((long)v->Data()));
1092  return FALSE;
1093}
1094static BOOLEAN jjLE_N(leftv res, leftv u, leftv v)
1095{
1096  return jjGE_N(res,v,u);
1097}
1098static BOOLEAN jjLT_BI(leftv res, leftv u, leftv v)
1099{
1100  return jjGT_BI(res,v,u);
1101}
1102static BOOLEAN jjLT_I(leftv res, leftv u, leftv v)
1103{
1104  res->data = (char *)(long)((int)((long)u->Data()) < (int)((long)v->Data()));
1105  return FALSE;
1106}
1107static BOOLEAN jjLT_N(leftv res, leftv u, leftv v)
1108{
1109  return jjGT_N(res,v,u);
1110}
1111static BOOLEAN jjDIVMOD_I(leftv res, leftv u, leftv v)
1112{
1113  if (iiOp=='/') Warn("int division with `/`: use `div` instead in line >>%s<<",my_yylinebuf);
1114  int a= (int)(long)u->Data();
1115  int b= (int)(long)v->Data();
1116  if (b==0)
1117  {
1118    WerrorS(ii_div_by_0);
1119    return TRUE;
1120  }
1121  int c=a%b;
1122  int r=0;
1123  switch (iiOp)
1124  {
1125    case '%':
1126        r=c;            break;
1127    case '/':
1128    case INTDIV_CMD:
1129        r=((a-c) /b);   break;
1130  }
1131  res->data=(void *)((long)r);
1132  return FALSE;
1133}
1134static BOOLEAN jjDIV_BI(leftv res, leftv u, leftv v)
1135{
1136  number q=(number)v->Data();
1137  if (n_IsZero(q,coeffs_BIGINT))
1138  {
1139    WerrorS(ii_div_by_0);
1140    return TRUE;
1141  }
1142  q = n_IntDiv((number)u->Data(),q,coeffs_BIGINT);
1143  n_Normalize(q,coeffs_BIGINT);
1144  res->data = (char *)q;
1145  return FALSE;
1146}
1147static BOOLEAN jjDIV_N(leftv res, leftv u, leftv v)
1148{
1149  number q=(number)v->Data();
1150  if (nIsZero(q))
1151  {
1152    WerrorS(ii_div_by_0);
1153    return TRUE;
1154  }
1155  q = nDiv((number)u->Data(),q);
1156  nNormalize(q);
1157  res->data = (char *)q;
1158  return FALSE;
1159}
1160static BOOLEAN jjDIV_P(leftv res, leftv u, leftv v)
1161{
1162  poly q=(poly)v->Data();
1163  if (q==NULL)
1164  {
1165    WerrorS(ii_div_by_0);
1166    return TRUE;
1167  }
1168  poly p=(poly)(u->Data());
1169  if (p==NULL)
1170  {
1171    res->data=NULL;
1172    return FALSE;
1173  }
1174  if ((pNext(q)!=NULL) && (!rField_is_Ring(currRing)))
1175  { /* This means that q != 0 consists of at least two terms.
1176       Moreover, currRing is over a field. */
1177#ifdef HAVE_FACTORY
1178    if(pGetComp(p)==0)
1179    {
1180      res->data=(void*)(singclap_pdivide(p /*(poly)(u->Data())*/ ,
1181                                         q /*(poly)(v->Data())*/ ,currRing));
1182    }
1183    else
1184    {
1185      int comps=pMaxComp(p);
1186      ideal I=idInit(comps,1);
1187      p=pCopy(p);
1188      poly h;
1189      int i;
1190      // conversion to a list of polys:
1191      while (p!=NULL)
1192      {
1193        i=pGetComp(p)-1;
1194        h=pNext(p);
1195        pNext(p)=NULL;
1196        pSetComp(p,0);
1197        I->m[i]=pAdd(I->m[i],p);
1198        p=h;
1199      }
1200      // division and conversion to vector:
1201      h=NULL;
1202      p=NULL;
1203      for(i=comps-1;i>=0;i--)
1204      {
1205        if (I->m[i]!=NULL)
1206        {
1207          h=singclap_pdivide(I->m[i],q,currRing);
1208          pSetCompP(h,i+1);
1209          p=pAdd(p,h);
1210        }
1211      }
1212      idDelete(&I);
1213      res->data=(void *)p;
1214    }
1215#else /* HAVE_FACTORY */
1216    WerrorS("division only by a monomial");
1217    return TRUE;
1218#endif /* HAVE_FACTORY */
1219  }
1220  else
1221  { /* This means that q != 0 consists of just one term,
1222       or that currRing is over a coefficient ring. */
1223#ifdef HAVE_RINGS
1224    if (!rField_is_Domain(currRing))
1225    {
1226      WerrorS("division only defined over coefficient domains");
1227      return TRUE;
1228    }
1229    if (pNext(q)!=NULL)
1230    {
1231      WerrorS("division over a coefficient domain only implemented for terms");
1232      return TRUE;
1233    }
1234#endif
1235    res->data = (char *)pDivideM(pCopy(p),pHead(q));
1236  }
1237  pNormalize((poly)res->data);
1238  return FALSE;
1239}
1240static BOOLEAN jjDIV_Ma(leftv res, leftv u, leftv v)
1241{
1242  poly q=(poly)v->Data();
1243  if (q==NULL)
1244  {
1245    WerrorS(ii_div_by_0);
1246    return TRUE;
1247  }
1248  matrix m=(matrix)(u->Data());
1249  int r=m->rows();
1250  int c=m->cols();
1251  matrix mm=mpNew(r,c);
1252  int i,j;
1253  for(i=r;i>0;i--)
1254  {
1255    for(j=c;j>0;j--)
1256    {
1257      if (pNext(q)!=NULL)
1258      {
1259      #ifdef HAVE_FACTORY
1260        MATELEM(mm,i,j) = singclap_pdivide( MATELEM(m,i,j) ,
1261                                           q /*(poly)(v->Data())*/, currRing );
1262#else /* HAVE_FACTORY */
1263        WerrorS("division only by a monomial");
1264        return TRUE;
1265#endif /* HAVE_FACTORY */
1266      }
1267      else
1268        MATELEM(mm,i,j) = pDivideM(pCopy(MATELEM(m,i,j)),pHead(q));
1269    }
1270  }
1271  id_Normalize((ideal)mm,currRing);
1272  res->data=(char *)mm;
1273  return FALSE;
1274}
1275static BOOLEAN jjEQUAL_BI(leftv res, leftv u, leftv v)
1276{
1277  res->data = (char *)((long)n_Equal((number)u->Data(),(number)v->Data(),coeffs_BIGINT));
1278  jjEQUAL_REST(res,u,v);
1279  return FALSE;
1280}
1281static BOOLEAN jjEQUAL_I(leftv res, leftv u, leftv v)
1282{
1283  res->data = (char *)((int)((long)u->Data()) == (int)((long)v->Data()));
1284  jjEQUAL_REST(res,u,v);
1285  return FALSE;
1286}
1287static BOOLEAN jjEQUAL_Ma(leftv res, leftv u, leftv v)
1288{
1289  res->data = (char *)((long)mp_Equal((matrix)u->Data(),(matrix)v->Data(),currRing));
1290  jjEQUAL_REST(res,u,v);
1291  return FALSE;
1292}
1293static BOOLEAN jjEQUAL_N(leftv res, leftv u, leftv v)
1294{
1295  res->data = (char *)((long)nEqual((number)u->Data(),(number)v->Data()));
1296  jjEQUAL_REST(res,u,v);
1297  return FALSE;
1298}
1299static BOOLEAN jjEQUAL_P(leftv res, leftv u, leftv v)
1300{
1301  poly p=(poly)u->Data();
1302  poly q=(poly)v->Data();
1303  res->data = (char *) ((long)pEqualPolys(p,q));
1304  jjEQUAL_REST(res,u,v);
1305  return FALSE;
1306}
1307static void jjEQUAL_REST(leftv res,leftv u,leftv v)
1308{
1309  if ((res->data) && (u->next!=NULL) && (v->next!=NULL))
1310  {
1311    int save_iiOp=iiOp;
1312    if (iiOp==NOTEQUAL)
1313      iiExprArith2(res,u->next,EQUAL_EQUAL,v->next);
1314    else
1315      iiExprArith2(res,u->next,iiOp,v->next);
1316    iiOp=save_iiOp;
1317  }
1318  if (iiOp==NOTEQUAL) res->data=(char *)(!(long)res->data);
1319}
1320static BOOLEAN jjAND_I(leftv res, leftv u, leftv v)
1321{
1322  res->data = (char *)((long)u->Data() && (long)v->Data());
1323  return FALSE;
1324}
1325static BOOLEAN jjOR_I(leftv res, leftv u, leftv v)
1326{
1327  res->data = (char *)((long)u->Data() || (long)v->Data());
1328  return FALSE;
1329}
1330static BOOLEAN jjINDEX_I(leftv res, leftv u, leftv v)
1331{
1332  res->rtyp=u->rtyp; u->rtyp=0;
1333  res->data=u->data; u->data=NULL;
1334  res->name=u->name; u->name=NULL;
1335  res->e=u->e;       u->e=NULL;
1336  if (res->e==NULL) res->e=jjMakeSub(v);
1337  else
1338  {
1339    Subexpr sh=res->e;
1340    while (sh->next != NULL) sh=sh->next;
1341    sh->next=jjMakeSub(v);
1342  }
1343  return FALSE;
1344}
1345static BOOLEAN jjINDEX_IV(leftv res, leftv u, leftv v)
1346{
1347  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1348  {
1349    WerrorS("indexed object must have a name");
1350    return TRUE;
1351  }
1352  intvec * iv=(intvec *)v->Data();
1353  leftv p=NULL;
1354  int i;
1355  sleftv t;
1356  memset(&t,0,sizeof(t));
1357  t.rtyp=INT_CMD;
1358  for (i=0;i<iv->length(); i++)
1359  {
1360    t.data=(char *)((long)(*iv)[i]);
1361    if (p==NULL)
1362    {
1363      p=res;
1364    }
1365    else
1366    {
1367      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1368      p=p->next;
1369    }
1370    p->rtyp=IDHDL;
1371    p->data=u->data;
1372    p->name=u->name;
1373    p->flag=u->flag;
1374    p->e=jjMakeSub(&t);
1375  }
1376  u->rtyp=0;
1377  u->data=NULL;
1378  u->name=NULL;
1379  return FALSE;
1380}
1381static BOOLEAN jjINDEX_P(leftv res, leftv u, leftv v)
1382{
1383  poly p=(poly)u->Data();
1384  int i=(int)(long)v->Data();
1385  int j=0;
1386  while (p!=NULL)
1387  {
1388    j++;
1389    if (j==i)
1390    {
1391      res->data=(char *)pHead(p);
1392      return FALSE;
1393    }
1394    pIter(p);
1395  }
1396  return FALSE;
1397}
1398static BOOLEAN jjINDEX_P_IV(leftv res, leftv u, leftv v)
1399{
1400  poly p=(poly)u->Data();
1401  poly r=NULL;
1402  intvec *iv=(intvec *)v->CopyD(INTVEC_CMD);
1403  int i;
1404  int sum=0;
1405  for(i=iv->length()-1;i>=0;i--)
1406    sum+=(*iv)[i];
1407  int j=0;
1408  while ((p!=NULL) && (sum>0))
1409  {
1410    j++;
1411    for(i=iv->length()-1;i>=0;i--)
1412    {
1413      if (j==(*iv)[i])
1414      {
1415        r=pAdd(r,pHead(p));
1416        sum-=j;
1417        (*iv)[i]=0;
1418        break;
1419      }
1420    }
1421    pIter(p);
1422  }
1423  delete iv;
1424  res->data=(char *)r;
1425  return FALSE;
1426}
1427static BOOLEAN jjINDEX_V(leftv res, leftv u, leftv v)
1428{
1429  poly p=(poly)u->CopyD(VECTOR_CMD);
1430  poly r=p; // pointer to the beginning of component i
1431  poly o=NULL;
1432  unsigned i=(unsigned)(long)v->Data();
1433  while (p!=NULL)
1434  {
1435    if (pGetComp(p)!=i)
1436    {
1437      if (r==p) r=pNext(p);
1438      if (o!=NULL)
1439      {
1440        if (pNext(o)!=NULL) pLmDelete(&pNext(o));
1441        p=pNext(o);
1442      }
1443      else
1444        pLmDelete(&p);
1445    }
1446    else
1447    {
1448      pSetComp(p, 0);
1449      p_SetmComp(p, currRing);
1450      o=p;
1451      p=pNext(o);
1452    }
1453  }
1454  res->data=(char *)r;
1455  return FALSE;
1456}
1457static BOOLEAN jjINDEX_V_IV(leftv res, leftv u, leftv v)
1458{
1459  poly p=(poly)u->CopyD(VECTOR_CMD);
1460  if (p!=NULL)
1461  {
1462    poly r=pOne();
1463    poly hp=r;
1464    intvec *iv=(intvec *)v->Data();
1465    int i;
1466    loop
1467    {
1468      for(i=0;i<iv->length();i++)
1469      {
1470        if (((int)pGetComp(p))==(*iv)[i])
1471        {
1472          poly h;
1473          pSplit(p,&h);
1474          pNext(hp)=p;
1475          p=h;
1476          pIter(hp);
1477          break;
1478        }
1479      }
1480      if (p==NULL) break;
1481      if (i==iv->length())
1482      {
1483        pLmDelete(&p);
1484        if (p==NULL) break;
1485      }
1486    }
1487    pLmDelete(&r);
1488    res->data=(char *)r;
1489  }
1490  return FALSE;
1491}
1492static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v);
1493static BOOLEAN jjKLAMMER(leftv res, leftv u, leftv v)
1494{
1495  if(u->name==NULL) return TRUE;
1496  char * nn = (char *)omAlloc(strlen(u->name) + 14);
1497  sprintf(nn,"%s(%d)",u->name,(int)(long)v->Data());
1498  omFree((ADDRESS)u->name);
1499  u->name=NULL;
1500  char *n=omStrDup(nn);
1501  omFree((ADDRESS)nn);
1502  syMake(res,n);
1503  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1504  return FALSE;
1505}
1506static BOOLEAN jjKLAMMER_IV(leftv res, leftv u, leftv v)
1507{
1508  intvec * iv=(intvec *)v->Data();
1509  leftv p=NULL;
1510  int i;
1511  long slen = strlen(u->name) + 14;
1512  char *n = (char*) omAlloc(slen);
1513
1514  for (i=0;i<iv->length(); i++)
1515  {
1516    if (p==NULL)
1517    {
1518      p=res;
1519    }
1520    else
1521    {
1522      p->next=(leftv)omAlloc0Bin(sleftv_bin);
1523      p=p->next;
1524    }
1525    sprintf(n,"%s(%d)",u->name,(*iv)[i]);
1526    syMake(p,omStrDup(n));
1527  }
1528  omFree((ADDRESS)u->name);
1529  u->name = NULL;
1530  omFreeSize(n, slen);
1531  if (u->next!=NULL) return jjKLAMMER_rest(res,u->next,v);
1532  return FALSE;
1533}
1534static BOOLEAN jjKLAMMER_rest(leftv res, leftv u, leftv v)
1535{
1536  leftv tmp=(leftv)omAllocBin(sleftv_bin);
1537  memset(tmp,0,sizeof(sleftv));
1538  BOOLEAN b;
1539  if (v->Typ()==INTVEC_CMD)
1540    b=jjKLAMMER_IV(tmp,u,v);
1541  else
1542    b=jjKLAMMER(tmp,u,v);
1543  if (b)
1544  {
1545    omFreeBin(tmp,sleftv_bin);
1546    return TRUE;
1547  }
1548  leftv h=res;
1549  while (h->next!=NULL) h=h->next;
1550  h->next=tmp;
1551  return FALSE;
1552}
1553BOOLEAN jjPROC(leftv res, leftv u, leftv v)
1554{
1555  void *d;
1556  Subexpr e;
1557  int typ;
1558  BOOLEAN t=FALSE;
1559  idhdl tmp_proc=NULL;
1560  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1561  {
1562    tmp_proc=(idhdl)omAlloc0(sizeof(idrec));
1563    tmp_proc->id="_auto";
1564    tmp_proc->typ=PROC_CMD;
1565    tmp_proc->data.pinf=(procinfo *)u->Data();
1566    tmp_proc->ref=1;
1567    d=u->data; u->data=(void *)tmp_proc;
1568    e=u->e; u->e=NULL;
1569    t=TRUE;
1570    typ=u->rtyp; u->rtyp=IDHDL;
1571  }
1572  BOOLEAN sl;
1573  if (u->req_packhdl==currPack)
1574    sl = iiMake_proc((idhdl)u->data,NULL,v);
1575  else
1576    sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1577  if (t)
1578  {
1579    u->rtyp=typ;
1580    u->data=d;
1581    u->e=e;
1582    omFreeSize(tmp_proc,sizeof(idrec));
1583  }
1584  if (sl) return TRUE;
1585  memcpy(res,&iiRETURNEXPR,sizeof(sleftv));
1586  iiRETURNEXPR.Init();
1587  return FALSE;
1588}
1589static BOOLEAN jjMAP(leftv res, leftv u, leftv v)
1590{
1591  //Print("try to map %s with %s\n",$3.Name(),$1.Name());
1592  leftv sl=NULL;
1593  if ((v->e==NULL)&&(v->name!=NULL))
1594  {
1595    map m=(map)u->Data();
1596    sl=iiMap(m,v->name);
1597  }
1598  else
1599  {
1600    Werror("%s(<name>) expected",u->Name());
1601  }
1602  if (sl==NULL) return TRUE;
1603  memcpy(res,sl,sizeof(sleftv));
1604  omFreeBin((ADDRESS)sl, sleftv_bin);
1605  return FALSE;
1606}
1607#ifdef HAVE_FACTORY
1608static BOOLEAN jjCHINREM_BI(leftv res, leftv u, leftv v)
1609{
1610  intvec *c=(intvec*)u->Data();
1611  intvec* p=(intvec*)v->Data();
1612  int rl=p->length();
1613  number *x=(number *)omAlloc(rl*sizeof(number));
1614  number *q=(number *)omAlloc(rl*sizeof(number));
1615  int i;
1616  for(i=rl-1;i>=0;i--)
1617  {
1618    q[i]=n_Init((*p)[i], coeffs_BIGINT);
1619    x[i]=n_Init((*c)[i], coeffs_BIGINT);
1620  }
1621  number n=n_ChineseRemainder(x,q,rl,coeffs_BIGINT);
1622  for(i=rl-1;i>=0;i--)
1623  {
1624    n_Delete(&(q[i]),coeffs_BIGINT);
1625    n_Delete(&(x[i]),coeffs_BIGINT);
1626  }
1627  omFree(x); omFree(q);
1628  res->data=(char *)n;
1629  return FALSE;
1630}
1631#endif
1632#if 0
1633static BOOLEAN jjCHINREM_P(leftv res, leftv u, leftv v)
1634{
1635  lists c=(lists)u->CopyD(); // list of poly
1636  intvec* p=(intvec*)v->Data();
1637  int rl=p->length();
1638  poly r=NULL,h, result=NULL;
1639  number *x=(number *)omAlloc(rl*sizeof(number));
1640  number *q=(number *)omAlloc(rl*sizeof(number));
1641  int i;
1642  for(i=rl-1;i>=0;i--)
1643  {
1644    q[i]=nlInit((*p)[i]);
1645  }
1646  loop
1647  {
1648    for(i=rl-1;i>=0;i--)
1649    {
1650      if (c->m[i].Typ()!=POLY_CMD)
1651      {
1652        Werror("poly expected at pos %d",i+1);
1653        for(i=rl-1;i>=0;i--)
1654        {
1655          nlDelete(&(q[i]),currRing);
1656        }
1657        omFree(x); omFree(q); // delete c
1658        return TRUE;
1659      }
1660      h=((poly)c->m[i].Data());
1661      if (r==NULL) r=h;
1662      else if (pLmCmp(r,h)==-1) r=h;
1663    }
1664    if (r==NULL) break;
1665    for(i=rl-1;i>=0;i--)
1666    {
1667      h=((poly)c->m[i].Data());
1668      if (pLmCmp(r,h)==0)
1669      {
1670        x[i]=pGetCoeff(h);
1671        h=pLmFreeAndNext(h);
1672        c->m[i].data=(char*)h;
1673      }
1674      else
1675        x[i]=nlInit(0);
1676    }
1677    number n=n_ChineseRemainder(x,q,rl,currRing->cf);
1678    for(i=rl-1;i>=0;i--)
1679    {
1680      nlDelete(&(x[i]),currRing);
1681    }
1682    h=pHead(r);
1683    pSetCoeff(h,n);
1684    result=pAdd(result,h);
1685  }
1686  for(i=rl-1;i>=0;i--)
1687  {
1688    nlDelete(&(q[i]),currRing);
1689  }
1690  omFree(x); omFree(q);
1691  res->data=(char *)result;
1692  return FALSE;
1693}
1694#endif
1695#ifdef HAVE_FACTORY
1696static BOOLEAN jjCHINREM_ID(leftv res, leftv u, leftv v)
1697{
1698  lists c=(lists)u->CopyD(); // list of ideal
1699  lists pl=NULL;
1700  intvec *p=NULL;
1701  if (v->Typ()==LIST_CMD) pl=(lists)v->Data();
1702  else                    p=(intvec*)v->Data();
1703  int rl=c->nr+1;
1704  ideal result;
1705  ideal *x=(ideal *)omAlloc(rl*sizeof(ideal));
1706  int i;
1707  int return_type=c->m[0].Typ();
1708  if ((return_type!=IDEAL_CMD)
1709  && (return_type!=MODUL_CMD)
1710  && (return_type!=MATRIX_CMD))
1711  {
1712    WerrorS("ideal/module/matrix expected");
1713    omFree(x); // delete c
1714    return TRUE;
1715  }
1716  for(i=rl-1;i>=0;i--)
1717  {
1718    if (c->m[i].Typ()!=return_type)
1719    {
1720      Werror("%s expected at pos %d",Tok2Cmdname(return_type),i+1);
1721      omFree(x); // delete c
1722      return TRUE;
1723    }
1724    x[i]=((ideal)c->m[i].Data());
1725  }
1726  number *q=(number *)omAlloc(rl*sizeof(number));
1727  if (p!=NULL)
1728  {
1729    for(i=rl-1;i>=0;i--)
1730    {
1731      q[i]=n_Init((*p)[i], currRing->cf);
1732    }
1733  }
1734  else
1735  {
1736    for(i=rl-1;i>=0;i--)
1737    {
1738      if (pl->m[i].Typ()==INT_CMD)
1739      {
1740        q[i]=n_Init((int)(long)pl->m[i].Data(),currRing->cf);
1741      }
1742      else if (pl->m[i].Typ()==BIGINT_CMD)
1743      {
1744        q[i]=n_Init_bigint((number)(pl->m[i].Data()),coeffs_BIGINT,currRing->cf);
1745      }
1746      else
1747      {
1748        Werror("bigint expected at pos %d",i+1);
1749        for(i++;i<rl;i++)
1750        {
1751          n_Delete(&(q[i]),currRing->cf);
1752        }
1753        omFree(x); // delete c
1754        omFree(q); // delete pl
1755        return TRUE;
1756      }
1757    }
1758  }
1759  result=id_ChineseRemainder(x,q,rl,currRing);
1760  for(i=rl-1;i>=0;i--)
1761  {
1762    n_Delete(&(q[i]),currRing->cf);
1763  }
1764  omFree(q);
1765  res->data=(char *)result;
1766  res->rtyp=return_type;
1767  return FALSE;
1768}
1769#endif
1770static BOOLEAN jjCOEF(leftv res, leftv u, leftv v)
1771{
1772  poly p=(poly)v->Data();
1773  if ((p==NULL)||(pNext(p)!=NULL)) return TRUE;
1774  res->data=(char *)mp_CoeffProc((poly)u->Data(),p /*(poly)v->Data()*/,currRing);
1775  return FALSE;
1776}
1777static BOOLEAN jjCOEFFS_Id(leftv res, leftv u, leftv v)
1778{
1779  int i=pVar((poly)v->Data());
1780  if (i==0)
1781  {
1782    WerrorS("ringvar expected");
1783    return TRUE;
1784  }
1785  res->data=(char *)mp_Coeffs((ideal)u->CopyD(),i,currRing);
1786  return FALSE;
1787}
1788static BOOLEAN jjCOEFFS2_KB(leftv res, leftv u, leftv v)
1789{
1790  poly p = pInit();
1791  int i;
1792  for (i=1; i<=currRing->N; i++)
1793  {
1794    pSetExp(p, i, 1);
1795  }
1796  pSetm(p);
1797  res->data = (void*)idCoeffOfKBase((ideal)(u->Data()),
1798                                    (ideal)(v->Data()), p);
1799  pDelete(&p);
1800  return FALSE;
1801}
1802static BOOLEAN jjCONTRACT(leftv res, leftv u, leftv v)
1803{
1804  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data(),FALSE);
1805  return FALSE;
1806}
1807static BOOLEAN jjDEG_M_IV(leftv res, leftv u, leftv v)
1808{
1809  short *iv=iv2array((intvec *)v->Data(),currRing);
1810  ideal I=(ideal)u->Data();
1811  int d=-1;
1812  int i;
1813  for(i=IDELEMS(I);i>=0;i--) d=si_max(d,(int)pDegW(I->m[i],iv));
1814  omFreeSize((ADDRESS)iv,(currRing->N+1)*sizeof(short));
1815  res->data = (char *)((long)d);
1816  return FALSE;
1817}
1818static BOOLEAN jjDEG_IV(leftv res, leftv u, leftv v)
1819{
1820  poly p=(poly)u->Data();
1821  if (p!=NULL)
1822  {
1823    short *iv=iv2array((intvec *)v->Data(),currRing);
1824    int d=(int)pDegW(p,iv);
1825    omFreeSize((ADDRESS)iv,(currRing->N+1)*sizeof(short));
1826    res->data = (char *)(long(d));
1827  }
1828  else
1829    res->data=(char *)(long)(-1);
1830  return FALSE;
1831}
1832static BOOLEAN jjDIFF_P(leftv res, leftv u, leftv v)
1833{
1834  int i=pVar((poly)v->Data());
1835  if (i==0)
1836  {
1837    WerrorS("ringvar expected");
1838    return TRUE;
1839  }
1840  res->data=(char *)pDiff((poly)(u->Data()),i);
1841  return FALSE;
1842}
1843static BOOLEAN jjDIFF_ID(leftv res, leftv u, leftv v)
1844{
1845  int i=pVar((poly)v->Data());
1846  if (i==0)
1847  {
1848    WerrorS("ringvar expected");
1849    return TRUE;
1850  }
1851  res->data=(char *)idDiff((matrix)(u->Data()),i);
1852  return FALSE;
1853}
1854static BOOLEAN jjDIFF_ID_ID(leftv res, leftv u, leftv v)
1855{
1856  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data());
1857  return FALSE;
1858}
1859static BOOLEAN jjDIM2(leftv res, leftv v, leftv w)
1860{
1861  assumeStdFlag(v);
1862#ifdef HAVE_RINGS
1863  if (rField_is_Ring(currRing))
1864  {
1865    //ring origR = currRing;
1866    //ring tempR = rCopy(origR);
1867    //coeffs new_cf=nInitChar(n_Q,NULL);
1868    //nKillChar(tempR->cf);
1869    //tempR->cf=new_cf;
1870    //rComplete(tempR);
1871    ideal vid = (ideal)v->Data();
1872    int i = idPosConstant(vid);
1873    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
1874    { /* ideal v contains unit; dim = -1 */
1875      res->data = (char *)-1;
1876      return FALSE;
1877    }
1878    //rChangeCurrRing(tempR);
1879    //ideal vv = idrCopyR(vid, origR, currRing);
1880    ideal vv = id_Copy(vid, currRing);
1881    //ideal ww = idrCopyR((ideal)w->Data(), origR, currRing);
1882    ideal ww = id_Copy((ideal)w->Data(), currRing);
1883    /* drop degree zero generator from vv (if any) */
1884    if (i != -1) pDelete(&vv->m[i]);
1885    long d = (long)scDimInt(vv, ww);
1886    if (rField_is_Ring_Z(currRing) && (i == -1)) d++;
1887    res->data = (char *)d;
1888    idDelete(&vv); idDelete(&ww);
1889    //rChangeCurrRing(origR);
1890    //rDelete(tempR);
1891    return FALSE;
1892  }
1893#endif
1894  if(currQuotient==NULL)
1895    res->data = (char *)((long)scDimInt((ideal)(v->Data()),(ideal)w->Data()));
1896  else
1897  {
1898    ideal q=idSimpleAdd(currQuotient,(ideal)w->Data());
1899    res->data = (char *)((long)scDimInt((ideal)(v->Data()),q));
1900    idDelete(&q);
1901  }
1902  return FALSE;
1903}
1904static BOOLEAN jjDIVISION(leftv res, leftv u, leftv v)
1905{
1906  ideal vi=(ideal)v->Data();
1907  int vl= IDELEMS(vi);
1908  ideal ui=(ideal)u->Data();
1909  int ul= IDELEMS(ui);
1910  ideal R; matrix U;
1911  ideal m = idLift(vi,ui,&R, FALSE,hasFlag(v,FLAG_STD),TRUE,&U);
1912  if (m==NULL) return TRUE;
1913  // now make sure that all matices have the corect size:
1914  matrix T = id_Module2formatedMatrix(m,vl,ul,currRing);
1915  int i;
1916  if (MATCOLS(U) != ul)
1917  {
1918    int mul=si_min(ul,MATCOLS(U));
1919    matrix UU=mpNew(ul,ul);
1920    int j;
1921    for(i=mul;i>0;i--)
1922    {
1923      for(j=mul;j>0;j--)
1924      {
1925        MATELEM(UU,i,j)=MATELEM(U,i,j);
1926        MATELEM(U,i,j)=NULL;
1927      }
1928    }
1929    idDelete((ideal *)&U);
1930    U=UU;
1931  }
1932  // make sure that U is a diagonal matrix of units
1933  for(i=ul;i>0;i--)
1934  {
1935    if(MATELEM(U,i,i)==NULL) MATELEM(U,i,i)=pOne();
1936  }
1937  lists L=(lists)omAllocBin(slists_bin);
1938  L->Init(3);
1939  L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)T;
1940  L->m[1].rtyp=u->Typ();     L->m[1].data=(void *)R;
1941  L->m[2].rtyp=MATRIX_CMD;   L->m[2].data=(void *)U;
1942  res->data=(char *)L;
1943  return FALSE;
1944}
1945static BOOLEAN jjELIMIN(leftv res, leftv u, leftv v)
1946{
1947  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data());
1948  //setFlag(res,FLAG_STD);
1949  return FALSE;
1950}
1951static BOOLEAN jjELIMIN_IV(leftv res, leftv u, leftv v)
1952{
1953  poly p=pOne();
1954  intvec *iv=(intvec*)v->Data();
1955  for(int i=iv->length()-1; i>=0; i--)
1956  {
1957    pSetExp(p,(*iv)[i],1);
1958  }
1959  pSetm(p);
1960  res->data=(char *)idElimination((ideal)u->Data(),p);
1961  pLmDelete(&p);
1962  //setFlag(res,FLAG_STD);
1963  return FALSE;
1964}
1965static BOOLEAN jjEXPORTTO(leftv, leftv u, leftv v)
1966{
1967  //Print("exportto %s -> %s\n",v->Name(),u->Name() );
1968  return iiExport(v,0,(idhdl)u->data);
1969}
1970static BOOLEAN jjERROR(leftv, leftv u)
1971{
1972  WerrorS((char *)u->Data());
1973  extern int inerror;
1974  inerror=3;
1975  return TRUE;
1976}
1977static BOOLEAN jjEXTGCD_BI(leftv res, leftv u, leftv v)
1978{
1979  number uu=(number)u->Data();number vv=(number)v->Data();
1980  lists L=(lists)omAllocBin(slists_bin);
1981  number a,b;
1982  number p0=n_ExtGcd(uu,vv,&a,&b,coeffs_BIGINT);
1983  L->Init(3);
1984  L->m[0].rtyp=BIGINT_CMD;   L->m[0].data=(void *)p0;
1985  L->m[1].rtyp=BIGINT_CMD;   L->m[1].data=(void *)a;
1986  L->m[2].rtyp=BIGINT_CMD;   L->m[2].data=(void *)b;
1987  res->rtyp=LIST_CMD;
1988  res->data=(char *)L;
1989  return FALSE;
1990}
1991static BOOLEAN jjEXTGCD_I(leftv res, leftv u, leftv v)
1992{
1993  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
1994  int p0=ABS(uu),p1=ABS(vv);
1995  int f0 = 1, f1 = 0, g0 = 0, g1 = 1, q, r;
1996
1997  while ( p1!=0 )
1998  {
1999    q=p0 / p1;
2000    r=p0 % p1;
2001    p0 = p1; p1 = r;
2002    r = g0 - g1 * q;
2003    g0 = g1; g1 = r;
2004    r = f0 - f1 * q;
2005    f0 = f1; f1 = r;
2006  }
2007  int a = f0;
2008  int b = g0;
2009  if ( uu /*(int)(long)u->Data()*/ < 0 ) a=-a;
2010  if ( vv /*(int)(long)v->Data()*/ < 0 ) b=-b;
2011  lists L=(lists)omAllocBin(slists_bin);
2012  L->Init(3);
2013  L->m[0].rtyp=INT_CMD;   L->m[0].data=(void *)(long)p0;
2014  L->m[1].rtyp=INT_CMD;   L->m[1].data=(void *)(long)a;
2015  L->m[2].rtyp=INT_CMD;   L->m[2].data=(void *)(long)b;
2016  res->rtyp=LIST_CMD;
2017  res->data=(char *)L;
2018  return FALSE;
2019}
2020#ifdef HAVE_FACTORY
2021static BOOLEAN jjEXTGCD_P(leftv res, leftv u, leftv v)
2022{
2023  poly r,pa,pb;
2024  BOOLEAN ret=singclap_extgcd((poly)u->Data(),(poly)v->Data(),r,pa,pb,currRing);
2025  if (ret) return TRUE;
2026  lists L=(lists)omAllocBin(slists_bin);
2027  L->Init(3);
2028  res->data=(char *)L;
2029  L->m[0].data=(void *)r;
2030  L->m[0].rtyp=POLY_CMD;
2031  L->m[1].data=(void *)pa;
2032  L->m[1].rtyp=POLY_CMD;
2033  L->m[2].data=(void *)pb;
2034  L->m[2].rtyp=POLY_CMD;
2035  return FALSE;
2036}
2037extern int singclap_factorize_retry;
2038static BOOLEAN jjFAC_P2(leftv res, leftv u,leftv dummy)
2039{
2040  intvec *v=NULL;
2041  int sw=(int)(long)dummy->Data();
2042  int fac_sw=sw;
2043  if ((sw<0)||(sw>2)) fac_sw=1;
2044  singclap_factorize_retry=0;
2045  ideal f=singclap_factorize((poly)(u->CopyD()), &v, fac_sw,currRing);
2046  if (f==NULL)
2047    return TRUE;
2048  switch(sw)
2049  {
2050    case 0:
2051    case 2:
2052    {
2053      lists l=(lists)omAllocBin(slists_bin);
2054      l->Init(2);
2055      l->m[0].rtyp=IDEAL_CMD;
2056      l->m[0].data=(void *)f;
2057      l->m[1].rtyp=INTVEC_CMD;
2058      l->m[1].data=(void *)v;
2059      res->data=(void *)l;
2060      res->rtyp=LIST_CMD;
2061      return FALSE;
2062    }
2063    case 1:
2064      res->data=(void *)f;
2065      return FALSE;
2066    case 3:
2067      {
2068        poly p=f->m[0];
2069        int i=IDELEMS(f);
2070        f->m[0]=NULL;
2071        while(i>1)
2072        {
2073          i--;
2074          p=pMult(p,f->m[i]);
2075          f->m[i]=NULL;
2076        }
2077        res->data=(void *)p;
2078        res->rtyp=POLY_CMD;
2079      }
2080      return FALSE;
2081  }
2082  WerrorS("invalid switch");
2083  return TRUE;
2084}
2085static BOOLEAN jjFACSTD2(leftv res, leftv v, leftv w)
2086{
2087  ideal_list p,h;
2088  h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL,(ideal)w->Data());
2089  p=h;
2090  int l=0;
2091  while (p!=NULL) { p=p->next;l++; }
2092  lists L=(lists)omAllocBin(slists_bin);
2093  L->Init(l);
2094  l=0;
2095  while(h!=NULL)
2096  {
2097    L->m[l].data=(char *)h->d;
2098    L->m[l].rtyp=IDEAL_CMD;
2099    p=h->next;
2100    omFreeSize(h,sizeof(*h));
2101    h=p;
2102    l++;
2103  }
2104  res->data=(void *)L;
2105  return FALSE;
2106}
2107#endif /* HAVE_FACTORY */
2108static BOOLEAN jjFAREY_BI(leftv res, leftv u, leftv v)
2109{
2110  if (rField_is_Q(currRing))
2111  {
2112    number uu=(number)u->Data();
2113    number vv=(number)v->Data();
2114    res->data=(char *)n_Farey(uu,vv,currRing->cf);
2115    return FALSE;
2116  }
2117  else return TRUE;
2118}
2119static BOOLEAN jjFAREY_ID(leftv res, leftv u, leftv v)
2120{
2121  if (rField_is_Q(currRing))
2122  {
2123    ideal uu=(ideal)u->Data();
2124    number vv=(number)v->Data();
2125    res->data=(void*)id_Farey(uu,vv,currRing);
2126    res->rtyp=u->Typ();
2127    return FALSE;
2128  }
2129  else return TRUE;
2130}
2131static BOOLEAN jjFETCH(leftv res, leftv u, leftv v)
2132{
2133  ring r=(ring)u->Data();
2134  idhdl w;
2135  int op=iiOp;
2136  nMapFunc nMap;
2137
2138  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
2139  {
2140    int *perm=NULL;
2141    int *par_perm=NULL;
2142    int par_perm_size=0;
2143    BOOLEAN bo;
2144    //if (!nSetMap(rInternalChar(r),r->parameter,rPar(r),r->minpoly))
2145    if ((nMap=n_SetMap(r->cf,currRing->cf))==NULL)
2146    {
2147      // Allow imap/fetch to be make an exception only for:
2148      if ( (rField_is_Q_a(r) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2149            (rField_is_Q(currRing) || rField_is_Q_a(currRing) ||
2150             (rField_is_Zp(currRing) || rField_is_Zp_a(currRing))))
2151           ||
2152           (rField_is_Zp_a(r) &&  // Zp(a..) -> Zp(a..) || Zp
2153            (rField_is_Zp(currRing, r->cf->ch) ||
2154             rField_is_Zp_a(currRing, r->cf->ch))) )
2155      {
2156        par_perm_size=rPar(r);
2157      }
2158      else
2159      {
2160        goto err_fetch;
2161      }
2162    }
2163    if ((iiOp!=FETCH_CMD) || (r->N!=currRing->N) || (rPar(r)!=rPar(currRing)))
2164    {
2165      perm=(int *)omAlloc0((r->N+1)*sizeof(int));
2166      if (par_perm_size!=0)
2167        par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2168      op=IMAP_CMD;
2169      if (iiOp==IMAP_CMD)
2170      {
2171        int r_par=0;
2172        char ** r_par_names=NULL;
2173        if (r->cf->extRing!=NULL)
2174        {
2175          r_par=r->cf->extRing->N;
2176          r_par_names=r->cf->extRing->names;
2177        }
2178        int c_par=0;
2179        char ** c_par_names=NULL;
2180        if (currRing->cf->extRing!=NULL)
2181        {
2182          c_par=currRing->cf->extRing->N;
2183          c_par_names=currRing->cf->extRing->names;
2184        }
2185        maFindPerm(r->names,       r->N,       r_par_names, r_par,
2186                   currRing->names,currRing->N,c_par_names, c_par,
2187                   perm,par_perm, currRing->cf->type);
2188      }
2189      else
2190      {
2191        int i;
2192        if (par_perm_size!=0)
2193          for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2194        for(i=si_min(r->N,currRing->N);i>0;i--) perm[i]=i;
2195      }
2196    }
2197    if ((iiOp==FETCH_CMD) &&(BVERBOSE(V_IMAP)))
2198    {
2199      int i;
2200      for(i=0;i<si_min(r->N,currRing->N);i++)
2201      {
2202        Print("// var nr %d: %s -> %s\n",i,r->names[i],currRing->names[i]);
2203      }
2204      for(i=0;i<si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
2205      {
2206        Print("// par nr %d: %s -> %s\n",
2207              i,rParameter(r)[i],rParameter(currRing)[i]);
2208      }
2209    }
2210    sleftv tmpW;
2211    memset(&tmpW,0,sizeof(sleftv));
2212    tmpW.rtyp=IDTYP(w);
2213    tmpW.data=IDDATA(w);
2214    if ((bo=maApplyFetch(op,NULL,res,&tmpW, r,
2215                         perm,par_perm,par_perm_size,nMap)))
2216    {
2217      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
2218    }
2219    if (perm!=NULL)
2220      omFreeSize((ADDRESS)perm,(r->N+1)*sizeof(int));
2221    if (par_perm!=NULL)
2222      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2223    return bo;
2224  }
2225  else
2226  {
2227    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
2228  }
2229  return TRUE;
2230err_fetch:
2231  Werror("no identity map from %s",u->Fullname());
2232  return TRUE;
2233}
2234static BOOLEAN jjFIND2(leftv res, leftv u, leftv v)
2235{
2236  /*4
2237  * look for the substring what in the string where
2238  * return the position of the first char of what in where
2239  * or 0
2240  */
2241  char *where=(char *)u->Data();
2242  char *what=(char *)v->Data();
2243  char *found = strstr(where,what);
2244  if (found != NULL)
2245  {
2246    res->data=(char *)((found-where)+1);
2247  }
2248  /*else res->data=NULL;*/
2249  return FALSE;
2250}
2251static BOOLEAN jjFWALK(leftv res, leftv u, leftv v)
2252{
2253  res->data=(char *)fractalWalkProc(u,v);
2254  setFlag( res, FLAG_STD );
2255  return FALSE;
2256}
2257static BOOLEAN jjGCD_I(leftv res, leftv u, leftv v)
2258{
2259  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2260  int p0=ABS(uu),p1=ABS(vv);
2261  int r;
2262  while ( p1!=0 )
2263  {
2264    r=p0 % p1;
2265    p0 = p1; p1 = r;
2266  }
2267  res->rtyp=INT_CMD;
2268  res->data=(char *)(long)p0;
2269  return FALSE;
2270}
2271static BOOLEAN jjGCD_BI(leftv res, leftv u, leftv v)
2272{
2273  number a=(number) u->Data();
2274  number b=(number) v->Data();
2275  if (n_IsZero(a,coeffs_BIGINT))
2276  {
2277    if (n_IsZero(b,coeffs_BIGINT)) res->data=(char *)n_Init(1,coeffs_BIGINT);
2278    else                           res->data=(char *)n_Copy(b,coeffs_BIGINT);
2279  }
2280  else
2281  {
2282    if (n_IsZero(b,coeffs_BIGINT))  res->data=(char *)n_Copy(a,coeffs_BIGINT);
2283    else res->data=(char *)n_Gcd(a, b, coeffs_BIGINT);
2284  }
2285  return FALSE;
2286}
2287static BOOLEAN jjGCD_N(leftv res, leftv u, leftv v)
2288{
2289  number a=(number) u->Data();
2290  number b=(number) v->Data();
2291  if (nIsZero(a))
2292  {
2293    if (nIsZero(b)) res->data=(char *)nInit(1);
2294    else            res->data=(char *)nCopy(b);
2295  }
2296  else
2297  {
2298    if (nIsZero(b))  res->data=(char *)nCopy(a);
2299    else res->data=(char *)nGcd(a, b, currRing);
2300  }
2301  return FALSE;
2302}
2303#ifdef HAVE_FACTORY
2304static BOOLEAN jjGCD_P(leftv res, leftv u, leftv v)
2305{
2306  res->data=(void *)singclap_gcd((poly)(u->CopyD(POLY_CMD)),
2307                                 (poly)(v->CopyD(POLY_CMD)),currRing);
2308  return FALSE;
2309}
2310#endif /* HAVE_FACTORY */
2311static BOOLEAN jjHILBERT2(leftv res, leftv u, leftv v)
2312{
2313#ifdef HAVE_RINGS
2314  if (rField_is_Ring_Z(currRing))
2315  {
2316    ring origR = currRing;
2317    ring tempR = rCopy(origR);
2318    coeffs new_cf=nInitChar(n_Q,NULL);
2319    nKillChar(tempR->cf);
2320    tempR->cf=new_cf;
2321    rComplete(tempR);
2322    ideal uid = (ideal)u->Data();
2323    rChangeCurrRing(tempR);
2324    ideal uu = idrCopyR(uid, origR, currRing);
2325    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
2326    uuAsLeftv.rtyp = IDEAL_CMD;
2327    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
2328    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
2329    assumeStdFlag(&uuAsLeftv);
2330    Print("// NOTE: computation of Hilbert series etc. is being\n");
2331    Print("//       performed for generic fibre, that is, over Q\n");
2332    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
2333    intvec *iv=hFirstSeries(uu,module_w,currQuotient);
2334    int returnWithTrue = 1;
2335    switch((int)(long)v->Data())
2336    {
2337      case 1:
2338        res->data=(void *)iv;
2339        returnWithTrue = 0;
2340      case 2:
2341        res->data=(void *)hSecondSeries(iv);
2342        delete iv;
2343        returnWithTrue = 0;
2344    }
2345    if (returnWithTrue)
2346    {
2347      WerrorS(feNotImplemented);
2348      delete iv;
2349    }
2350    idDelete(&uu);
2351    rChangeCurrRing(origR);
2352    rDelete(tempR);
2353    if (returnWithTrue) return TRUE; else return FALSE;
2354  }
2355#endif
2356  assumeStdFlag(u);
2357  intvec *module_w=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2358  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient);
2359  switch((int)(long)v->Data())
2360  {
2361    case 1:
2362      res->data=(void *)iv;
2363      return FALSE;
2364    case 2:
2365      res->data=(void *)hSecondSeries(iv);
2366      delete iv;
2367      return FALSE;
2368  }
2369  WerrorS(feNotImplemented);
2370  delete iv;
2371  return TRUE;
2372}
2373static BOOLEAN jjHOMOG_P(leftv res, leftv u, leftv v)
2374{
2375  int i=pVar((poly)v->Data());
2376  if (i==0)
2377  {
2378    WerrorS("ringvar expected");
2379    return TRUE;
2380  }
2381  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2382  int d=pWTotaldegree(p);
2383  pLmDelete(p);
2384  if (d==1)
2385    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
2386  else
2387    WerrorS("variable must have weight 1");
2388  return (d!=1);
2389}
2390static BOOLEAN jjHOMOG_ID(leftv res, leftv u, leftv v)
2391{
2392  int i=pVar((poly)v->Data());
2393  if (i==0)
2394  {
2395    WerrorS("ringvar expected");
2396    return TRUE;
2397  }
2398  pFDegProc deg;
2399  if (currRing->pLexOrder && (currRing->order[0]==ringorder_lp))
2400    deg=p_Totaldegree;
2401   else
2402    deg=currRing->pFDeg;
2403  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2404  int d=deg(p,currRing);
2405  pLmDelete(p);
2406  if (d==1)
2407    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
2408  else
2409    WerrorS("variable must have weight 1");
2410  return (d!=1);
2411}
2412static BOOLEAN jjHOMOG1_W(leftv res, leftv v, leftv u)
2413{
2414  intvec *w=new intvec(rVar(currRing));
2415  intvec *vw=(intvec*)u->Data();
2416  ideal v_id=(ideal)v->Data();
2417  pFDegProc save_FDeg=currRing->pFDeg;
2418  pLDegProc save_LDeg=currRing->pLDeg;
2419  BOOLEAN save_pLexOrder=currRing->pLexOrder;
2420  currRing->pLexOrder=FALSE;
2421  kHomW=vw;
2422  kModW=w;
2423  pSetDegProcs(currRing,kHomModDeg);
2424  res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
2425  currRing->pLexOrder=save_pLexOrder;
2426  kHomW=NULL;
2427  kModW=NULL;
2428  pRestoreDegProcs(currRing,save_FDeg,save_LDeg);
2429  if (w!=NULL) delete w;
2430  return FALSE;
2431}
2432static BOOLEAN jjINDEPSET2(leftv res, leftv u, leftv v)
2433{
2434  assumeStdFlag(u);
2435  res->data=(void *)scIndIndset((ideal)(u->Data()),(int)(long)(v->Data()),
2436                    currQuotient);
2437  return FALSE;
2438}
2439static BOOLEAN jjINTERSECT(leftv res, leftv u, leftv v)
2440{
2441  res->data=(char *)idSect((ideal)u->Data(),(ideal)v->Data());
2442  setFlag(res,FLAG_STD);
2443  return FALSE;
2444}
2445static BOOLEAN jjJanetBasis2(leftv res, leftv u, leftv v)
2446{
2447  return jjStdJanetBasis(res,u,(int)(long)v->Data());
2448}
2449static BOOLEAN jjJET_P(leftv res, leftv u, leftv v)
2450{
2451  res->data = (char *)pJet((poly)u->CopyD(), (int)(long)v->Data());
2452  return FALSE;
2453}
2454static BOOLEAN jjJET_ID(leftv res, leftv u, leftv v)
2455{
2456  res->data = (char *)id_Jet((ideal)u->Data(),(int)(long)v->Data(),currRing);
2457  return FALSE;
2458}
2459static BOOLEAN jjKBASE2(leftv res, leftv u, leftv v)
2460{
2461  assumeStdFlag(u);
2462  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2463  res->data = (char *)scKBase((int)(long)v->Data(),
2464                              (ideal)(u->Data()),currQuotient, w_u);
2465  if (w_u!=NULL)
2466  {
2467    atSet(res,omStrDup("isHomog"),ivCopy(w_u),INTVEC_CMD);
2468  }
2469  return FALSE;
2470}
2471static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w);
2472static BOOLEAN jjKERNEL(leftv res, leftv u, leftv v)
2473{
2474  return jjPREIMAGE(res,u,v,NULL);
2475}
2476static BOOLEAN jjKoszul(leftv res, leftv u, leftv v)
2477{
2478  return mpKoszul(res, u,v,NULL);
2479}
2480static BOOLEAN jjKoszul_Id(leftv res, leftv u, leftv v)
2481{
2482  sleftv h;
2483  memset(&h,0,sizeof(sleftv));
2484  h.rtyp=INT_CMD;
2485  h.data=(void *)(long)IDELEMS((ideal)v->Data());
2486  return mpKoszul(res, u, &h, v);
2487}
2488static BOOLEAN jjLIFT(leftv res, leftv u, leftv v)
2489{
2490  int ul= IDELEMS((ideal)u->Data());
2491  int vl= IDELEMS((ideal)v->Data());
2492  ideal m = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,
2493                   hasFlag(u,FLAG_STD));
2494  if (m==NULL) return TRUE;
2495  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
2496  return FALSE;
2497}
2498static BOOLEAN jjLIFTSTD(leftv res, leftv u, leftv v)
2499{
2500  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
2501  idhdl h=(idhdl)v->data;
2502  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
2503  res->data = (char *)idLiftStd((ideal)u->Data(),
2504                                &(h->data.umatrix),testHomog);
2505  setFlag(res,FLAG_STD); v->flag=0;
2506  return FALSE;
2507}
2508static BOOLEAN jjLOAD2(leftv res, leftv, leftv v)
2509{
2510  return jjLOAD(res, v,TRUE);
2511}
2512static BOOLEAN jjLOAD_E(leftv res, leftv v, leftv u)
2513{
2514  char * s=(char *)u->Data();
2515  if(strcmp(s, "with")==0)
2516    return jjLOAD(res, v, TRUE);
2517  WerrorS("invalid second argument");
2518  WerrorS("load(\"libname\" [,\"with\"]);");
2519  return TRUE;
2520}
2521static BOOLEAN jjMODULO(leftv res, leftv u, leftv v)
2522{
2523  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2524  tHomog hom=testHomog;
2525  if (w_u!=NULL)
2526  {
2527    w_u=ivCopy(w_u);
2528    hom=isHomog;
2529  }
2530  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
2531  if (w_v!=NULL)
2532  {
2533    w_v=ivCopy(w_v);
2534    hom=isHomog;
2535  }
2536  if ((w_u!=NULL) && (w_v==NULL))
2537    w_v=ivCopy(w_u);
2538  if ((w_v!=NULL) && (w_u==NULL))
2539    w_u=ivCopy(w_v);
2540  ideal u_id=(ideal)u->Data();
2541  ideal v_id=(ideal)v->Data();
2542  if (w_u!=NULL)
2543  {
2544     if ((*w_u).compare((w_v))!=0)
2545     {
2546       WarnS("incompatible weights");
2547       delete w_u; w_u=NULL;
2548       hom=testHomog;
2549     }
2550     else
2551     {
2552       if ((!idTestHomModule(u_id,currQuotient,w_v))
2553       || (!idTestHomModule(v_id,currQuotient,w_v)))
2554       {
2555         WarnS("wrong weights");
2556         delete w_u; w_u=NULL;
2557         hom=testHomog;
2558       }
2559     }
2560  }
2561  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u);
2562  if (w_u!=NULL)
2563  {
2564    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
2565  }
2566  delete w_v;
2567  return FALSE;
2568}
2569static BOOLEAN jjMOD_BI(leftv res, leftv u, leftv v)
2570{
2571  number q=(number)v->Data();
2572  if (n_IsZero(q,coeffs_BIGINT))
2573  {
2574    WerrorS(ii_div_by_0);
2575    return TRUE;
2576  }
2577  res->data =(char *) n_IntMod((number)u->Data(),q,coeffs_BIGINT);
2578  return FALSE;
2579}
2580static BOOLEAN jjMOD_N(leftv res, leftv u, leftv v)
2581{
2582  number q=(number)v->Data();
2583  if (nIsZero(q))
2584  {
2585    WerrorS(ii_div_by_0);
2586    return TRUE;
2587  }
2588  res->data =(char *) n_IntMod((number)u->Data(),q,currRing->cf);
2589  return FALSE;
2590}
2591static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v);
2592static BOOLEAN jjMONITOR1(leftv res, leftv v)
2593{
2594  return jjMONITOR2(res,v,NULL);
2595}
2596static BOOLEAN jjMONITOR2(leftv, leftv u,leftv v)
2597{
2598#if 0
2599  char *opt=(char *)v->Data();
2600  int mode=0;
2601  while(*opt!='\0')
2602  {
2603    if (*opt=='i') mode |= PROT_I;
2604    else if (*opt=='o') mode |= PROT_O;
2605    opt++;
2606  }
2607  monitor((char *)(u->Data()),mode);
2608#else
2609  si_link l=(si_link)u->Data();
2610  if (slOpen(l,SI_LINK_WRITE,u)) return TRUE;
2611  if(strcmp(l->m->type,"ASCII")!=0)
2612  {
2613    Werror("ASCII link required, not `%s`",l->m->type);
2614    slClose(l);
2615    return TRUE;
2616  }
2617  SI_LINK_SET_CLOSE_P(l); // febase handles the FILE*
2618  if ( l->name[0]!='\0') // "" is the stop condition
2619  {
2620    const char *opt;
2621    int mode=0;
2622    if (v==NULL) opt=(const char*)"i";
2623    else         opt=(const char *)v->Data();
2624    while(*opt!='\0')
2625    {
2626      if (*opt=='i') mode |= PROT_I;
2627      else if (*opt=='o') mode |= PROT_O;
2628      opt++;
2629    }
2630    monitor((FILE *)l->data,mode);
2631  }
2632  else
2633    monitor(NULL,0);
2634  return FALSE;
2635#endif
2636}
2637static BOOLEAN jjMONOM(leftv res, leftv v)
2638{
2639  intvec *iv=(intvec *)v->Data();
2640  poly p=pOne();
2641  int i,e;
2642  BOOLEAN err=FALSE;
2643  for(i=si_min(currRing->N,iv->length()); i>0; i--)
2644  {
2645    e=(*iv)[i-1];
2646    if (e>=0) pSetExp(p,i,e);
2647    else err=TRUE;
2648  }
2649  if (iv->length()==(currRing->N+1))
2650  {
2651    res->rtyp=VECTOR_CMD;
2652    e=(*iv)[currRing->N];
2653    if (e>=0) pSetComp(p,e);
2654    else err=TRUE;
2655  }
2656  pSetm(p);
2657  res->data=(char*)p;
2658  if(err) { pDelete(&p); WerrorS("no negative exponent allowed"); }
2659  return err;
2660}
2661static BOOLEAN jjNEWSTRUCT2(leftv, leftv u, leftv v)
2662{
2663  // u: the name of the new type
2664  // v: the elements
2665  newstruct_desc d=newstructFromString((const char *)v->Data());
2666  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
2667  return d==NULL;
2668}
2669static BOOLEAN jjPARSTR2(leftv res, leftv u, leftv v)
2670{
2671  idhdl h=(idhdl)u->data;
2672  int i=(int)(long)v->Data();
2673  int p=0;
2674  if ((0<i)
2675  && (rParameter(IDRING(h))!=NULL)
2676  && (i<=(p=rPar(IDRING(h)))))
2677    res->data=omStrDup(rParameter(IDRING(h))[i-1]);
2678  else
2679  {
2680    Werror("par number %d out of range 1..%d",i,p);
2681    return TRUE;
2682  }
2683  return FALSE;
2684}
2685#ifdef HAVE_PLURAL
2686static BOOLEAN jjPlural_num_poly(leftv res, leftv a, leftv b)
2687{
2688  if( currRing->qideal != NULL )
2689  {
2690    WerrorS("basering must NOT be a qring!");
2691    return TRUE;
2692  }
2693
2694  if (iiOp==NCALGEBRA_CMD)
2695  {
2696    return nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),currRing,false,true,false,currRing);
2697  }
2698  else
2699  {
2700    ring r=rCopy(currRing);
2701    BOOLEAN result=nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),r,false,true,false,currRing);
2702    res->data=r;
2703    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2704    return result;
2705  }
2706}
2707static BOOLEAN jjPlural_num_mat(leftv res, leftv a, leftv b)
2708{
2709  if( currRing->qideal != NULL )
2710  {
2711    WerrorS("basering must NOT be a qring!");
2712    return TRUE;
2713  }
2714
2715  if (iiOp==NCALGEBRA_CMD)
2716  {
2717    return nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,currRing,false,true,false,currRing);
2718  }
2719  else
2720  {
2721    ring r=rCopy(currRing);
2722    BOOLEAN result=nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,r,false,true,false,currRing);
2723    res->data=r;
2724    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2725    return result;
2726  }
2727}
2728static BOOLEAN jjPlural_mat_poly(leftv res, leftv a, leftv b)
2729{
2730  if( currRing->qideal != NULL )
2731  {
2732    WerrorS("basering must NOT be a qring!");
2733    return TRUE;
2734  }
2735
2736  if (iiOp==NCALGEBRA_CMD)
2737  {
2738    return nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),currRing,false,true,false,currRing);
2739  }
2740  else
2741  {
2742    ring r=rCopy(currRing);
2743    BOOLEAN result=nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),r,false,true,false,currRing);
2744    res->data=r;
2745    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2746    return result;
2747  }
2748}
2749static BOOLEAN jjPlural_mat_mat(leftv res, leftv a, leftv b)
2750{
2751  if( currRing->qideal != NULL )
2752  {
2753    WerrorS("basering must NOT be a qring!");
2754    return TRUE;
2755  }
2756
2757  if (iiOp==NCALGEBRA_CMD)
2758  {
2759    return nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,currRing,false,true,false,currRing);
2760  }
2761  else
2762  {
2763    ring r=rCopy(currRing);
2764    BOOLEAN result=nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,r,false,true,false,currRing);
2765    res->data=r;
2766    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2767    return result;
2768  }
2769}
2770static BOOLEAN jjBRACKET(leftv res, leftv a, leftv b)
2771{
2772  res->data=NULL;
2773
2774  if (rIsPluralRing(currRing))
2775  {
2776    const poly q = (poly)b->Data();
2777
2778    if( q != NULL )
2779    {
2780      if( (poly)a->Data() != NULL )
2781      {
2782        poly p = (poly)a->CopyD(POLY_CMD); // p = copy!
2783        res->data = nc_p_Bracket_qq(p,q, currRing); // p will be destroyed!
2784      }
2785    }
2786  }
2787  return FALSE;
2788}
2789static BOOLEAN jjOPPOSE(leftv res, leftv a, leftv b)
2790{
2791  /* number, poly, vector, ideal, module, matrix */
2792  ring  r = (ring)a->Data();
2793  if (r == currRing)
2794  {
2795    res->data = b->Data();
2796    res->rtyp = b->rtyp;
2797    return FALSE;
2798  }
2799  if (!rIsLikeOpposite(currRing, r))
2800  {
2801    Werror("%s is not an opposite ring to current ring",a->Fullname());
2802    return TRUE;
2803  }
2804  idhdl w;
2805  if( ((w=r->idroot->get(b->Name(),myynest))!=NULL) && (b->e==NULL))
2806  {
2807    int argtype = IDTYP(w);
2808    switch (argtype)
2809    {
2810    case NUMBER_CMD:
2811      {
2812        /* since basefields are equal, we can apply nCopy */
2813        res->data = nCopy((number)IDDATA(w));
2814        res->rtyp = argtype;
2815        break;
2816      }
2817    case POLY_CMD:
2818    case VECTOR_CMD:
2819      {
2820        poly    q = (poly)IDDATA(w);
2821        res->data = pOppose(r,q,currRing);
2822        res->rtyp = argtype;
2823        break;
2824      }
2825    case IDEAL_CMD:
2826    case MODUL_CMD:
2827      {
2828        ideal   Q = (ideal)IDDATA(w);
2829        res->data = idOppose(r,Q,currRing);
2830        res->rtyp = argtype;
2831        break;
2832      }
2833    case MATRIX_CMD:
2834      {
2835        ring save = currRing;
2836        rChangeCurrRing(r);
2837        matrix  m = (matrix)IDDATA(w);
2838        ideal   Q = id_Matrix2Module(mp_Copy(m, currRing),currRing);
2839        rChangeCurrRing(save);
2840        ideal   S = idOppose(r,Q,currRing);
2841        id_Delete(&Q, r);
2842        res->data = id_Module2Matrix(S,currRing);
2843        res->rtyp = argtype;
2844        break;
2845      }
2846    default:
2847      {
2848        WerrorS("unsupported type in oppose");
2849        return TRUE;
2850      }
2851    }
2852  }
2853  else
2854  {
2855    Werror("identifier %s not found in %s",b->Fullname(),a->Fullname());
2856    return TRUE;
2857  }
2858  return FALSE;
2859}
2860#endif /* HAVE_PLURAL */
2861
2862static BOOLEAN jjQUOT(leftv res, leftv u, leftv v)
2863{
2864  res->data = (char *)idQuot((ideal)u->Data(),(ideal)v->Data(),
2865    hasFlag(u,FLAG_STD),u->Typ()==v->Typ());
2866  id_DelMultiples((ideal)(res->data),currRing);
2867  return FALSE;
2868}
2869static BOOLEAN jjRANDOM(leftv res, leftv u, leftv v)
2870{
2871  int i=(int)(long)u->Data();
2872  int j=(int)(long)v->Data();
2873  res->data =(char *)(long)((i > j) ? i : (siRand() % (j-i+1)) + i);
2874  return FALSE;
2875}
2876static BOOLEAN jjRANK2(leftv res, leftv u, leftv v)
2877{
2878  matrix m =(matrix)u->Data();
2879  int isRowEchelon = (int)(long)v->Data();
2880  if (isRowEchelon != 1) isRowEchelon = 0;
2881  int rank = luRank(m, isRowEchelon);
2882  res->data =(char *)(long)rank;
2883  return FALSE;
2884}
2885static BOOLEAN jjREAD2(leftv res, leftv u, leftv v)
2886{
2887  si_link l=(si_link)u->Data();
2888  leftv r=slRead(l,v);
2889  if (r==NULL)
2890  {
2891    const char *s;
2892    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
2893    else                            s=sNoName;
2894    Werror("cannot read from `%s`",s);
2895    return TRUE;
2896  }
2897  memcpy(res,r,sizeof(sleftv));
2898  omFreeBin((ADDRESS)r, sleftv_bin);
2899  return FALSE;
2900}
2901static BOOLEAN jjREDUCE_P(leftv res, leftv u, leftv v)
2902{
2903  assumeStdFlag(v);
2904  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data());
2905  return FALSE;
2906}
2907static BOOLEAN jjREDUCE_ID(leftv res, leftv u, leftv v)
2908{
2909  assumeStdFlag(v);
2910  ideal ui=(ideal)u->Data();
2911  ideal vi=(ideal)v->Data();
2912  res->data = (char *)kNF(vi,currQuotient,ui);
2913  return FALSE;
2914}
2915#if 0
2916static BOOLEAN jjRES(leftv res, leftv u, leftv v)
2917{
2918  int maxl=(int)(long)v->Data();
2919  if (maxl<0)
2920  {
2921    WerrorS("length for res must not be negative");
2922    return TRUE;
2923  }
2924  int l=0;
2925  //resolvente r;
2926  syStrategy r;
2927  intvec *weights=NULL;
2928  int wmaxl=maxl;
2929  ideal u_id=(ideal)u->Data();
2930
2931  maxl--;
2932  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
2933  {
2934    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
2935    if (currQuotient!=NULL)
2936    {
2937      Warn(
2938      "full resolution in a qring may be infinite, setting max length to %d",
2939      maxl+1);
2940    }
2941  }
2942  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2943  if (weights!=NULL)
2944  {
2945    if (!idTestHomModule(u_id,currQuotient,weights))
2946    {
2947      WarnS("wrong weights given:");weights->show();PrintLn();
2948      weights=NULL;
2949    }
2950  }
2951  intvec *ww=NULL;
2952  int add_row_shift=0;
2953  if (weights!=NULL)
2954  {
2955     ww=ivCopy(weights);
2956     add_row_shift = ww->min_in();
2957     (*ww) -= add_row_shift;
2958  }
2959  else
2960    idHomModule(u_id,currQuotient,&ww);
2961  weights=ww;
2962
2963  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
2964  {
2965    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
2966  }
2967  else if (iiOp==SRES_CMD)
2968  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
2969    r=sySchreyer(u_id,maxl+1);
2970  else if (iiOp == LRES_CMD)
2971  {
2972    int dummy;
2973    if((currQuotient!=NULL)||
2974    (!idHomIdeal (u_id,NULL)))
2975    {
2976       WerrorS
2977       ("`lres` not implemented for inhomogeneous input or qring");
2978       return TRUE;
2979    }
2980    r=syLaScala3(u_id,&dummy);
2981  }
2982  else if (iiOp == KRES_CMD)
2983  {
2984    int dummy;
2985    if((currQuotient!=NULL)||
2986    (!idHomIdeal (u_id,NULL)))
2987    {
2988       WerrorS
2989       ("`kres` not implemented for inhomogeneous input or qring");
2990       return TRUE;
2991    }
2992    r=syKosz(u_id,&dummy);
2993  }
2994  else
2995  {
2996    int dummy;
2997    if((currQuotient!=NULL)||
2998    (!idHomIdeal (u_id,NULL)))
2999    {
3000       WerrorS
3001       ("`hres` not implemented for inhomogeneous input or qring");
3002       return TRUE;
3003    }
3004    r=syHilb(u_id,&dummy);
3005  }
3006  if (r==NULL) return TRUE;
3007  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3008  r->list_length=wmaxl;
3009  res->data=(void *)r;
3010  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3011  {
3012    intvec *w=ivCopy(r->weights[0]);
3013    if (weights!=NULL) (*w) += add_row_shift;
3014    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3015    w=NULL;
3016  }
3017  else
3018  {
3019//#if 0
3020// need to set weights for ALL components (sres)
3021    if (weights!=NULL)
3022    {
3023      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3024      r->weights = (intvec**)omAlloc0Bin(char_ptr_bin);
3025      (r->weights)[0] = ivCopy(weights);
3026    }
3027//#endif
3028  }
3029  if (ww!=NULL) { delete ww; ww=NULL; }
3030  return FALSE;
3031}
3032#else
3033static BOOLEAN jjRES(leftv res, leftv u, leftv v)
3034{
3035  int maxl=(int)(long)v->Data();
3036  if (maxl<0)
3037  {
3038    WerrorS("length for res must not be negative");
3039    return TRUE;
3040  }
3041  syStrategy r;
3042  intvec *weights=NULL;
3043  int wmaxl=maxl;
3044  ideal u_id=(ideal)u->Data();
3045
3046  maxl--;
3047  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
3048  {
3049    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3050    if (currQuotient!=NULL)
3051    {
3052      Warn(
3053      "full resolution in a qring may be infinite, setting max length to %d",
3054      maxl+1);
3055    }
3056  }
3057  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3058  if (weights!=NULL)
3059  {
3060    if (!idTestHomModule(u_id,currQuotient,weights))
3061    {
3062      WarnS("wrong weights given:");weights->show();PrintLn();
3063      weights=NULL;
3064    }
3065  }
3066  intvec *ww=NULL;
3067  int add_row_shift=0;
3068  if (weights!=NULL)
3069  {
3070     ww=ivCopy(weights);
3071     add_row_shift = ww->min_in();
3072     (*ww) -= add_row_shift;
3073  }
3074  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3075  {
3076    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3077  }
3078  else if (iiOp==SRES_CMD)
3079  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3080    r=sySchreyer(u_id,maxl+1);
3081  else if (iiOp == LRES_CMD)
3082  {
3083    int dummy;
3084    if((currQuotient!=NULL)||
3085    (!idHomIdeal (u_id,NULL)))
3086    {
3087       WerrorS
3088       ("`lres` not implemented for inhomogeneous input or qring");
3089       return TRUE;
3090    }
3091    if(currRing->N == 1)
3092      WarnS("the current implementation of `lres` may not work in the case of a single variable");
3093    r=syLaScala3(u_id,&dummy);
3094  }
3095  else if (iiOp == KRES_CMD)
3096  {
3097    int dummy;
3098    if((currQuotient!=NULL)||
3099    (!idHomIdeal (u_id,NULL)))
3100    {
3101       WerrorS
3102       ("`kres` not implemented for inhomogeneous input or qring");
3103       return TRUE;
3104    }
3105    r=syKosz(u_id,&dummy);
3106  }
3107  else
3108  {
3109    int dummy;
3110    if((currQuotient!=NULL)||
3111    (!idHomIdeal (u_id,NULL)))
3112    {
3113       WerrorS
3114       ("`hres` not implemented for inhomogeneous input or qring");
3115       return TRUE;
3116    }
3117    ideal u_id_copy=idCopy(u_id);
3118    idSkipZeroes(u_id_copy);
3119    r=syHilb(u_id_copy,&dummy);
3120    idDelete(&u_id_copy);
3121  }
3122  if (r==NULL) return TRUE;
3123  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3124  r->list_length=wmaxl;
3125  res->data=(void *)r;
3126  if ((weights!=NULL) && (ww!=NULL)) { delete ww; ww=NULL; }
3127  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3128  {
3129    ww=ivCopy(r->weights[0]);
3130    if (weights!=NULL) (*ww) += add_row_shift;
3131    atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
3132  }
3133  else
3134  {
3135    if (weights!=NULL)
3136    {
3137      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3138    }
3139  }
3140
3141  // test the La Scala case' output
3142  assume( ((iiOp == LRES_CMD) || (iiOp == HRES_CMD)) == (r->syRing != NULL) );
3143  assume( (r->syRing != NULL) == (r->resPairs != NULL) );
3144
3145  if(iiOp != HRES_CMD)
3146    assume( (r->minres != NULL) || (r->fullres != NULL) ); // is wrong for HRES_CMD...
3147  else
3148    assume( (r->orderedRes != NULL) || (r->res != NULL) ); // analog for hres...
3149
3150  return FALSE;
3151}
3152#endif
3153static BOOLEAN jjPFAC2(leftv res, leftv u, leftv v)
3154{
3155  number n1; number n2; number temp; int i;
3156
3157  if ((u->Typ() == BIGINT_CMD) ||
3158     ((u->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3159  {
3160    temp = (number)u->Data();
3161    n1 = n_Copy(temp,coeffs_BIGINT);
3162  }
3163  else if (u->Typ() == INT_CMD)
3164  {
3165    i = (int)(long)u->Data();
3166    n1 = n_Init(i, coeffs_BIGINT);
3167  }
3168  else
3169  {
3170    WerrorS("wrong type: expected int, bigint, or number as 1st argument");
3171    return TRUE;
3172  }
3173
3174  if ((v->Typ() == BIGINT_CMD) ||
3175     ((v->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3176  {
3177    temp = (number)v->Data();
3178    n2 = n_Copy(temp,coeffs_BIGINT);
3179  }
3180  else if (v->Typ() == INT_CMD)
3181  {
3182    i = (int)(long)v->Data();
3183    n2 = n_Init(i, coeffs_BIGINT);
3184  }
3185  else
3186  {
3187    WerrorS("wrong type: expected int, bigint, or number as 2nd argument");
3188    return TRUE;
3189  }
3190
3191  lists l = primeFactorisation(n1, n2);
3192  n_Delete(&n1, coeffs_BIGINT); n_Delete(&n2, coeffs_BIGINT);
3193  res->data = (char*)l;
3194  return FALSE;
3195}
3196static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
3197{
3198  ring r;
3199  int i=rSum((ring)u->Data(),(ring)v->Data(),r);
3200  res->data = (char *)r;
3201  return (i==-1);
3202}
3203#define SIMPL_LMDIV 32
3204#define SIMPL_LMEQ  16
3205#define SIMPL_MULT 8
3206#define SIMPL_EQU  4
3207#define SIMPL_NULL 2
3208#define SIMPL_NORM 1
3209static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
3210{
3211  int sw = (int)(long)v->Data();
3212  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
3213  ideal id = (ideal)u->CopyD(IDEAL_CMD);
3214  if (sw & SIMPL_LMDIV)
3215  {
3216    id_DelDiv(id,currRing);
3217  }
3218  if (sw & SIMPL_LMEQ)
3219  {
3220    id_DelLmEquals(id,currRing);
3221  }
3222  if (sw & SIMPL_MULT)
3223  {
3224    id_DelMultiples(id,currRing);
3225  }
3226  else if(sw & SIMPL_EQU)
3227  {
3228    id_DelEquals(id,currRing);
3229  }
3230  if (sw & SIMPL_NULL)
3231  {
3232    idSkipZeroes(id);
3233  }
3234  if (sw & SIMPL_NORM)
3235  {
3236    id_Norm(id,currRing);
3237  }
3238  res->data = (char * )id;
3239  return FALSE;
3240}
3241#ifdef HAVE_FACTORY
3242extern int singclap_factorize_retry;
3243static BOOLEAN jjSQR_FREE2(leftv res, leftv u, leftv dummy)
3244{
3245  intvec *v=NULL;
3246  int sw=(int)(long)dummy->Data();
3247  int fac_sw=sw;
3248  if (sw<0) fac_sw=1;
3249  singclap_factorize_retry=0;
3250  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, fac_sw, currRing);
3251  if (f==NULL)
3252    return TRUE;
3253  switch(sw)
3254  {
3255    case 0:
3256    case 2:
3257    {
3258      lists l=(lists)omAllocBin(slists_bin);
3259      l->Init(2);
3260      l->m[0].rtyp=IDEAL_CMD;
3261      l->m[0].data=(void *)f;
3262      l->m[1].rtyp=INTVEC_CMD;
3263      l->m[1].data=(void *)v;
3264      res->data=(void *)l;
3265      res->rtyp=LIST_CMD;
3266      return FALSE;
3267    }
3268    case 1:
3269      res->data=(void *)f;
3270      return FALSE;
3271    case 3:
3272      {
3273        poly p=f->m[0];
3274        int i=IDELEMS(f);
3275        f->m[0]=NULL;
3276        while(i>1)
3277        {
3278          i--;
3279          p=pMult(p,f->m[i]);
3280          f->m[i]=NULL;
3281        }
3282        res->data=(void *)p;
3283        res->rtyp=POLY_CMD;
3284      }
3285      return FALSE;
3286  }
3287  WerrorS("invalid switch");
3288  return FALSE;
3289}
3290#endif
3291static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
3292{
3293  res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
3294  return FALSE;
3295}
3296static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
3297{
3298  res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
3299  //return (res->data== (void*)(long)-2);
3300  return FALSE;
3301}
3302static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
3303{
3304  int sw = (int)(long)v->Data();
3305  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3306  poly p = (poly)u->CopyD(POLY_CMD);
3307  if (sw & SIMPL_NORM)
3308  {
3309    pNorm(p);
3310  }
3311  res->data = (char * )p;
3312  return FALSE;
3313}
3314static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
3315{
3316  ideal result;
3317  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3318  tHomog hom=testHomog;
3319  ideal u_id=(ideal)(u->Data());
3320  if (w!=NULL)
3321  {
3322    if (!idTestHomModule(u_id,currQuotient,w))
3323    {
3324      WarnS("wrong weights:");w->show();PrintLn();
3325      w=NULL;
3326    }
3327    else
3328    {
3329      w=ivCopy(w);
3330      hom=isHomog;
3331    }
3332  }
3333  result=kStd(u_id,currQuotient,hom,&w,(intvec *)v->Data());
3334  idSkipZeroes(result);
3335  res->data = (char *)result;
3336  setFlag(res,FLAG_STD);
3337  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3338  return FALSE;
3339}
3340static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v);
3341static void jjSTD_1_ID(leftv res, ideal i0, int t0, ideal p0, attr a)
3342/* destroys i0, p0 */
3343/* result (with attributes) in res */
3344/* i0: SB*/
3345/* t0: type of p0*/
3346/* p0 new elements*/
3347/* a attributes of i0*/
3348{
3349  int tp;
3350  if (t0==IDEAL_CMD) tp=POLY_CMD;
3351  else               tp=VECTOR_CMD;
3352  for (int i=IDELEMS(p0)-1; i>=0; i--)
3353  {
3354    poly p=p0->m[i];
3355    p0->m[i]=NULL;
3356    if (p!=NULL)
3357    {
3358      sleftv u0,v0;
3359      memset(&u0,0,sizeof(sleftv));
3360      memset(&v0,0,sizeof(sleftv));
3361      v0.rtyp=tp;
3362      v0.data=(void*)p;
3363      u0.rtyp=t0;
3364      u0.data=i0;
3365      u0.attribute=a;
3366      setFlag(&u0,FLAG_STD);
3367      jjSTD_1(res,&u0,&v0);
3368      i0=(ideal)res->data;
3369      res->data=NULL;
3370      a=res->attribute;
3371      res->attribute=NULL;
3372      u0.CleanUp();
3373      v0.CleanUp();
3374      res->CleanUp();
3375    }
3376  }
3377  idDelete(&p0);
3378  res->attribute=a;
3379  res->data=(void *)i0;
3380  res->rtyp=t0;
3381}
3382static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
3383{
3384  ideal result;
3385  assumeStdFlag(u);
3386  ideal i1=(ideal)(u->Data());
3387  ideal i0;
3388  int r=v->Typ();
3389  if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
3390  {
3391    i0=idInit(1,i1->rank); // TODO: rank is wrong (if v is a vector!)
3392    i0->m[0]=(poly)v->Data();
3393    int ii0=idElem(i0); /* size of i0 */
3394    i1=idSimpleAdd(i1,i0); //
3395    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3396    idDelete(&i0);
3397    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3398    tHomog hom=testHomog;
3399
3400    if (w!=NULL)
3401    {
3402      if (!idTestHomModule(i1,currQuotient,w))
3403      {
3404        // no warnung: this is legal, if i in std(i,p)
3405        // is homogeneous, but p not
3406        w=NULL;
3407      }
3408      else
3409      {
3410        w=ivCopy(w);
3411        hom=isHomog;
3412      }
3413    }
3414    BITSET save1;
3415    SI_SAVE_OPT1(save1);
3416    si_opt_1|=Sy_bit(OPT_SB_1);
3417    /* ii0 appears to be the position of the first element of il that
3418       does not belong to the old SB ideal */
3419    result=kStd(i1,currQuotient,hom,&w,NULL,0,ii0);
3420    SI_RESTORE_OPT1(save1);
3421    idDelete(&i1);
3422    idSkipZeroes(result);
3423    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3424    res->data = (char *)result;
3425  }
3426  else /*IDEAL/MODULE*/
3427  {
3428    attr *aa=u->Attribute();
3429    attr a=NULL;
3430    if (aa!=NULL) a=(*aa)->Copy();
3431    jjSTD_1_ID(res,(ideal)u->CopyD(),r,(ideal)v->CopyD(),a);
3432  }
3433  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
3434  return FALSE;
3435}
3436static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3437{
3438  idhdl h=(idhdl)u->data;
3439  int i=(int)(long)v->Data();
3440  if ((0<i) && (i<=IDRING(h)->N))
3441    res->data=omStrDup(IDRING(h)->names[i-1]);
3442  else
3443  {
3444    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3445    return TRUE;
3446  }
3447  return FALSE;
3448}
3449static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3450{
3451// input: u: a list with links of type
3452//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3453//        v: timeout for select in milliseconds
3454//           or 0 for polling
3455// returns: ERROR (via Werror): timeout negative
3456//           -1: the read state of all links is eof
3457//            0: timeout (or polling): none ready
3458//           i>0: (at least) L[i] is ready
3459  lists Lforks = (lists)u->Data();
3460  int t = (int)(long)v->Data();
3461  if(t < 0)
3462  {
3463    WerrorS("negative timeout"); return TRUE;
3464  }
3465  int i = slStatusSsiL(Lforks, t*1000);
3466  if(i == -2) /* error */
3467  {
3468    return TRUE;
3469  }
3470  res->data = (void*)(long)i;
3471  return FALSE;
3472}
3473static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3474{
3475// input: u: a list with links of type
3476//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3477//        v: timeout for select in milliseconds
3478//           or 0 for polling
3479// returns: ERROR (via Werror): timeout negative
3480//           -1: the read state of all links is eof
3481//           0: timeout (or polling): none ready
3482//           1: all links are ready
3483//              (caution: at least one is ready, but some maybe dead)
3484  lists Lforks = (lists)u->CopyD();
3485  int timeout = 1000*(int)(long)v->Data();
3486  if(timeout < 0)
3487  {
3488    WerrorS("negative timeout"); return TRUE;
3489  }
3490  int t = getRTimer()/TIMER_RESOLUTION;  // in seconds
3491  int i;
3492  int ret = -1;
3493  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
3494  {
3495    i = slStatusSsiL(Lforks, timeout);
3496    if(i > 0) /* Lforks[i] is ready */
3497    {
3498      ret = 1;
3499      Lforks->m[i-1].CleanUp();
3500      Lforks->m[i-1].rtyp=DEF_CMD;
3501      Lforks->m[i-1].data=NULL;
3502      timeout = si_max(0,timeout - 1000*(getRTimer()/TIMER_RESOLUTION - t));
3503    }
3504    else /* terminate the for loop */
3505    {
3506      if(i == -2) /* error */
3507      {
3508        return TRUE;
3509      }
3510      if(i == 0) /* timeout */
3511      {
3512        ret = 0;
3513      }
3514      break;
3515    }
3516  }
3517  Lforks->Clean();
3518  res->data = (void*)(long)ret;
3519  return FALSE;
3520}
3521static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3522{
3523  res->data = (char *)mp_Wedge((matrix)u->Data(),(int)(long)v->Data(),currRing);
3524  return FALSE;
3525}
3526#define jjWRONG2 (proc2)jjWRONG
3527#define jjWRONG3 (proc3)jjWRONG
3528static BOOLEAN jjWRONG(leftv, leftv)
3529{
3530  return TRUE;
3531}
3532
3533/*=================== operations with 1 arg.: static proc =================*/
3534/* must be ordered: first operations for chars (infix ops),
3535 * then alphabetically */
3536
3537static BOOLEAN jjDUMMY(leftv res, leftv u)
3538{
3539  res->data = (char *)u->CopyD();
3540  return FALSE;
3541}
3542static BOOLEAN jjNULL(leftv, leftv)
3543{
3544  return FALSE;
3545}
3546//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3547//{
3548//  res->data = (char *)((int)(long)u->Data()+1);
3549//  return FALSE;
3550//}
3551//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3552//{
3553//  res->data = (char *)((int)(long)u->Data()-1);
3554//  return FALSE;
3555//}
3556static BOOLEAN jjPLUSPLUS(leftv, leftv u)
3557{
3558  if (IDTYP((idhdl)u->data)==INT_CMD)
3559  {
3560    int i=IDINT((idhdl)u->data);
3561    if (iiOp==PLUSPLUS) i++;
3562    else                i--;
3563    IDDATA((idhdl)u->data)=(char *)(long)i;
3564    return FALSE;
3565  }
3566  return TRUE;
3567}
3568static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3569{
3570  number n=(number)u->CopyD(BIGINT_CMD);
3571  n=n_Neg(n,coeffs_BIGINT);
3572  res->data = (char *)n;
3573  return FALSE;
3574}
3575static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3576{
3577  res->data = (char *)(-(long)u->Data());
3578  return FALSE;
3579}
3580static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3581{
3582  number n=(number)u->CopyD(NUMBER_CMD);
3583  n=nNeg(n);
3584  res->data = (char *)n;
3585  return FALSE;
3586}
3587static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3588{
3589  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3590  return FALSE;
3591}
3592static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3593{
3594  poly m1=pISet(-1);
3595  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),m1,currRing);
3596  return FALSE;
3597}
3598static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3599{
3600  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3601  (*iv)*=(-1);
3602  res->data = (char *)iv;
3603  return FALSE;
3604}
3605static BOOLEAN jjUMINUS_BIM(leftv res, leftv u)
3606{
3607  bigintmat *bim=(bigintmat *)u->CopyD(BIGINTMAT_CMD);
3608  (*bim)*=(-1);
3609  res->data = (char *)bim;
3610  return FALSE;
3611}
3612static BOOLEAN jjPROC1(leftv res, leftv u)
3613{
3614  return jjPROC(res,u,NULL);
3615}
3616static BOOLEAN jjBAREISS(leftv res, leftv v)
3617{
3618  //matrix m=(matrix)v->Data();
3619  //lists l=mpBareiss(m,FALSE);
3620  intvec *iv;
3621  ideal m;
3622  sm_CallBareiss((ideal)v->Data(),0,0,m,&iv, currRing);
3623  lists l=(lists)omAllocBin(slists_bin);
3624  l->Init(2);
3625  l->m[0].rtyp=MODUL_CMD;
3626  l->m[1].rtyp=INTVEC_CMD;
3627  l->m[0].data=(void *)m;
3628  l->m[1].data=(void *)iv;
3629  res->data = (char *)l;
3630  return FALSE;
3631}
3632//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3633//{
3634//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3635//  ivTriangMat(m);
3636//  res->data = (char *)m;
3637//  return FALSE;
3638//}
3639static BOOLEAN jjBI2N(leftv res, leftv u)
3640{
3641  BOOLEAN bo=FALSE;
3642  number n=(number)u->CopyD();
3643  nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
3644  if (nMap!=NULL)
3645    res->data=nMap(n,coeffs_BIGINT,currRing->cf);
3646  else
3647  {
3648    WerrorS("cannot convert bigint to this field");
3649    bo=TRUE;
3650  }
3651  n_Delete(&n,coeffs_BIGINT);
3652  return bo;
3653}
3654static BOOLEAN jjBI2P(leftv res, leftv u)
3655{
3656  sleftv tmp;
3657  BOOLEAN bo=jjBI2N(&tmp,u);
3658  if (!bo)
3659  {
3660    number n=(number) tmp.data;
3661    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3662    else
3663    {
3664      res->data=(void *)pNSet(n);
3665    }
3666  }
3667  return bo;
3668}
3669static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3670{
3671  return iiExprArithM(res,u,iiOp);
3672}
3673static BOOLEAN jjCHAR(leftv res, leftv v)
3674{
3675  res->data = (char *)(long)rChar((ring)v->Data());
3676  return FALSE;
3677}
3678static BOOLEAN jjCOLS(leftv res, leftv v)
3679{
3680  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3681  return FALSE;
3682}
3683static BOOLEAN jjCOLS_BIM(leftv res, leftv v)
3684{
3685  res->data = (char *)(long)((bigintmat*)(v->Data()))->cols();
3686  return FALSE;
3687}
3688static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3689{
3690  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3691  return FALSE;
3692}
3693static BOOLEAN jjCONTENT(leftv res, leftv v)
3694{
3695  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3696  poly p=(poly)v->CopyD(POLY_CMD);
3697  if (p!=NULL) p_Cleardenom(p, currRing);
3698  res->data = (char *)p;
3699  return FALSE;
3700}
3701static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3702{
3703  res->data = (char *)(long)n_Size((number)v->Data(),coeffs_BIGINT);
3704  return FALSE;
3705}
3706static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3707{
3708  res->data = (char *)(long)nSize((number)v->Data());
3709  return FALSE;
3710}
3711static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3712{
3713  lists l=(lists)v->Data();
3714  res->data = (char *)(long)(lSize(l)+1);
3715  return FALSE;
3716}
3717static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3718{
3719  matrix m=(matrix)v->Data();
3720  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3721  return FALSE;
3722}
3723static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3724{
3725  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3726  return FALSE;
3727}
3728static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3729{
3730  ring r=(ring)v->Data();
3731  int elems=-1;
3732  if (rField_is_Zp(r)||rField_is_GF(r)) elems=r->cf->ch;
3733  else if (rField_is_Zp_a(r) && (r->cf->type==n_algExt))
3734  {
3735#ifdef HAVE_FACTORY
3736    extern int ipower ( int b, int n ); /* factory/cf_util */
3737    elems=ipower(r->cf->ch,r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3738#else
3739    elems=(int)pow((double) r->cf->ch,(double)r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3740#endif
3741  }
3742  res->data = (char *)(long)elems;
3743  return FALSE;
3744}
3745static BOOLEAN jjDEG(leftv res, leftv v)
3746{
3747  int dummy;
3748  poly p=(poly)v->Data();
3749  if (p!=NULL) res->data = (char *)currRing->pLDeg(p,&dummy,currRing);
3750  else res->data=(char *)-1;
3751  return FALSE;
3752}
3753static BOOLEAN jjDEG_M(leftv res, leftv u)
3754{
3755  ideal I=(ideal)u->Data();
3756  int d=-1;
3757  int dummy;
3758  int i;
3759  for(i=IDELEMS(I)-1;i>=0;i--)
3760    if (I->m[i]!=NULL) d=si_max(d,(int)currRing->pLDeg(I->m[i],&dummy,currRing));
3761  res->data = (char *)(long)d;
3762  return FALSE;
3763}
3764static BOOLEAN jjDEGREE(leftv res, leftv v)
3765{
3766  SPrintStart();
3767#ifdef HAVE_RINGS
3768  if (rField_is_Ring_Z(currRing))
3769  {
3770    ring origR = currRing;
3771    ring tempR = rCopy(origR);
3772    coeffs new_cf=nInitChar(n_Q,NULL);
3773    nKillChar(tempR->cf);
3774    tempR->cf=new_cf;
3775    rComplete(tempR);
3776    ideal vid = (ideal)v->Data();
3777    rChangeCurrRing(tempR);
3778    ideal vv = idrCopyR(vid, origR, currRing);
3779    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
3780    vvAsLeftv.rtyp = IDEAL_CMD;
3781    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
3782    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
3783    assumeStdFlag(&vvAsLeftv);
3784    Print("// NOTE: computation of degree is being performed for\n");
3785    Print("//       generic fibre, that is, over Q\n");
3786    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
3787    scDegree(vv,module_w,currQuotient);
3788    idDelete(&vv);
3789    rChangeCurrRing(origR);
3790    rDelete(tempR);
3791  }
3792#endif
3793  assumeStdFlag(v);
3794  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3795  scDegree((ideal)v->Data(),module_w,currQuotient);
3796  char *s=SPrintEnd();
3797  int l=strlen(s)-1;
3798  s[l]='\0';
3799  res->data=(void*)s;
3800  return FALSE;
3801}
3802static BOOLEAN jjDEFINED(leftv res, leftv v)
3803{
3804  if ((v->rtyp==IDHDL)
3805  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3806  {
3807    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3808  }
3809  else if (v->rtyp!=0) res->data=(void *)(-1);
3810  return FALSE;
3811}
3812
3813/// Return the denominator of the input number
3814/// NOTE: the input number is normalized as a side effect
3815static BOOLEAN jjDENOMINATOR(leftv res, leftv v)
3816{
3817  number n = reinterpret_cast<number>(v->Data());
3818  res->data = reinterpret_cast<void*>(n_GetDenom(n, currRing));
3819  return FALSE;
3820}
3821
3822/// Return the numerator of the input number
3823/// NOTE: the input number is normalized as a side effect
3824static BOOLEAN jjNUMERATOR(leftv res, leftv v)
3825{
3826  number n = reinterpret_cast<number>(v->Data());
3827  res->data = reinterpret_cast<void*>(n_GetNumerator(n, currRing));
3828  return FALSE;
3829}
3830
3831
3832
3833
3834#ifdef HAVE_FACTORY
3835static BOOLEAN jjDET(leftv res, leftv v)
3836{
3837  matrix m=(matrix)v->Data();
3838  poly p;
3839  if (sm_CheckDet((ideal)m,m->cols(),TRUE, currRing))
3840  {
3841    ideal I=id_Matrix2Module(mp_Copy(m, currRing),currRing);
3842    p=sm_CallDet(I, currRing);
3843    idDelete(&I);
3844  }
3845  else
3846    p=singclap_det(m,currRing);
3847  res ->data = (char *)p;
3848  return FALSE;
3849}
3850static BOOLEAN jjDET_BI(leftv res, leftv v)
3851{
3852  bigintmat * m=(bigintmat*)v->Data();
3853  int i,j;
3854  i=m->rows();j=m->cols();
3855  if(i==j)
3856    res->data = (char *)(long)singclap_det_bi(m,coeffs_BIGINT);
3857  else
3858  {
3859    Werror("det of %d x %d bigintmat",i,j);
3860    return TRUE;
3861  }
3862  return FALSE;
3863}
3864static BOOLEAN jjDET_I(leftv res, leftv v)
3865{
3866  intvec * m=(intvec*)v->Data();
3867  int i,j;
3868  i=m->rows();j=m->cols();
3869  if(i==j)
3870    res->data = (char *)(long)singclap_det_i(m,currRing);
3871  else
3872  {
3873    Werror("det of %d x %d intmat",i,j);
3874    return TRUE;
3875  }
3876  return FALSE;
3877}
3878static BOOLEAN jjDET_S(leftv res, leftv v)
3879{
3880  ideal I=(ideal)v->Data();
3881  poly p;
3882  if (IDELEMS(I)<1) return TRUE;
3883  if (sm_CheckDet(I,IDELEMS(I),FALSE, currRing))
3884  {
3885    matrix m=id_Module2Matrix(id_Copy(I,currRing),currRing);
3886    p=singclap_det(m,currRing);
3887    idDelete((ideal *)&m);
3888  }
3889  else
3890    p=sm_CallDet(I, currRing);
3891  res->data = (char *)p;
3892  return FALSE;
3893}
3894#endif
3895static BOOLEAN jjDIM(leftv res, leftv v)
3896{
3897  assumeStdFlag(v);
3898#ifdef HAVE_RINGS
3899  if (rField_is_Ring(currRing))
3900  {
3901    //ring origR = currRing;
3902    //ring tempR = rCopy(origR);
3903    //coeffs new_cf=nInitChar(n_Q,NULL);
3904    //nKillChar(tempR->cf);
3905    //tempR->cf=new_cf;
3906    //rComplete(tempR);
3907    ideal vid = (ideal)v->Data();
3908    int i = idPosConstant(vid);
3909    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
3910    { /* ideal v contains unit; dim = -1 */
3911      res->data = (char *)-1;
3912      return FALSE;
3913    }
3914    //rChangeCurrRing(tempR);
3915    //ideal vv = idrCopyR(vid, origR, currRing);
3916    ideal vv = id_Head(vid,currRing);
3917    /* drop degree zero generator from vv (if any) */
3918    if (i != -1) pDelete(&vv->m[i]);
3919    long d = (long)scDimInt(vv, currQuotient);
3920    if (rField_is_Ring_Z(currRing) && (i == -1)) d++;
3921    res->data = (char *)d;
3922    idDelete(&vv);
3923    //rChangeCurrRing(origR);
3924    //rDelete(tempR);
3925    return FALSE;
3926  }
3927#endif
3928  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currQuotient);
3929  return FALSE;
3930}
3931static BOOLEAN jjDUMP(leftv, leftv v)
3932{
3933  si_link l = (si_link)v->Data();
3934  if (slDump(l))
3935  {
3936    const char *s;
3937    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3938    else                            s=sNoName;
3939    Werror("cannot dump to `%s`",s);
3940    return TRUE;
3941  }
3942  else
3943    return FALSE;
3944}
3945static BOOLEAN jjE(leftv res, leftv v)
3946{
3947  res->data = (char *)pOne();
3948  int co=(int)(long)v->Data();
3949  if (co>0)
3950  {
3951    pSetComp((poly)res->data,co);
3952    pSetm((poly)res->data);
3953  }
3954  else WerrorS("argument of gen must be positive");
3955  return (co<=0);
3956}
3957static BOOLEAN jjEXECUTE(leftv, leftv v)
3958{
3959  char * d = (char *)v->Data();
3960  char * s = (char *)omAlloc(strlen(d) + 13);
3961  strcpy( s, (char *)d);
3962  strcat( s, "\n;RETURN();\n");
3963  newBuffer(s,BT_execute);
3964  return yyparse();
3965}
3966#ifdef HAVE_FACTORY
3967static BOOLEAN jjFACSTD(leftv res, leftv v)
3968{
3969  lists L=(lists)omAllocBin(slists_bin);
3970  if (rField_is_Zp(currRing)
3971  || rField_is_Q(currRing)
3972  || rField_is_Zp_a(currRing)
3973  || rField_is_Q_a(currRing))
3974  {
3975    ideal_list p,h;
3976    h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
3977    if (h==NULL)
3978    {
3979      L->Init(1);
3980      L->m[0].data=(char *)idInit(1);
3981      L->m[0].rtyp=IDEAL_CMD;
3982    }
3983    else
3984    {
3985      p=h;
3986      int l=0;
3987      while (p!=NULL) { p=p->next;l++; }
3988      L->Init(l);
3989      l=0;
3990      while(h!=NULL)
3991      {
3992        L->m[l].data=(char *)h->d;
3993        L->m[l].rtyp=IDEAL_CMD;
3994        p=h->next;
3995        omFreeSize(h,sizeof(*h));
3996        h=p;
3997        l++;
3998      }
3999    }
4000  }
4001  else
4002  {
4003    WarnS("no factorization implemented");
4004    L->Init(1);
4005    iiExprArith1(&(L->m[0]),v,STD_CMD);
4006  }
4007  res->data=(void *)L;
4008  return FALSE;
4009}
4010static BOOLEAN jjFAC_P(leftv res, leftv u)
4011{
4012  intvec *v=NULL;
4013  singclap_factorize_retry=0;
4014  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0,currRing);
4015  if (f==NULL) return TRUE;
4016  ivTest(v);
4017  lists l=(lists)omAllocBin(slists_bin);
4018  l->Init(2);
4019  l->m[0].rtyp=IDEAL_CMD;
4020  l->m[0].data=(void *)f;
4021  l->m[1].rtyp=INTVEC_CMD;
4022  l->m[1].data=(void *)v;
4023  res->data=(void *)l;
4024  return FALSE;
4025}
4026#endif
4027static BOOLEAN jjGETDUMP(leftv, leftv v)
4028{
4029  si_link l = (si_link)v->Data();
4030  if (slGetDump(l))
4031  {
4032    const char *s;
4033    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4034    else                            s=sNoName;
4035    Werror("cannot get dump from `%s`",s);
4036    return TRUE;
4037  }
4038  else
4039    return FALSE;
4040}
4041static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
4042{
4043  assumeStdFlag(v);
4044  ideal I=(ideal)v->Data();
4045  res->data=(void *)iiHighCorner(I,0);
4046  return FALSE;
4047}
4048static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
4049{
4050  assumeStdFlag(v);
4051  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4052  BOOLEAN delete_w=FALSE;
4053  ideal I=(ideal)v->Data();
4054  int i;
4055  poly p=NULL,po=NULL;
4056  int rk=id_RankFreeModule(I,currRing);
4057  if (w==NULL)
4058  {
4059    w = new intvec(rk);
4060    delete_w=TRUE;
4061  }
4062  for(i=rk;i>0;i--)
4063  {
4064    p=iiHighCorner(I,i);
4065    if (p==NULL)
4066    {
4067      WerrorS("module must be zero-dimensional");
4068      if (delete_w) delete w;
4069      return TRUE;
4070    }
4071    if (po==NULL)
4072    {
4073      po=p;
4074    }
4075    else
4076    {
4077      // now po!=NULL, p!=NULL
4078      int d=(currRing->pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - currRing->pFDeg(p,currRing)+(*w)[i-1]);
4079      if (d==0)
4080        d=pLmCmp(po,p);
4081      if (d > 0)
4082      {
4083        pDelete(&p);
4084      }
4085      else // (d < 0)
4086      {
4087        pDelete(&po); po=p;
4088      }
4089    }
4090  }
4091  if (delete_w) delete w;
4092  res->data=(void *)po;
4093  return FALSE;
4094}
4095static BOOLEAN jjHILBERT(leftv, leftv v)
4096{
4097#ifdef HAVE_RINGS
4098  if (rField_is_Ring_Z(currRing))
4099  {
4100    ring origR = currRing;
4101    ring tempR = rCopy(origR);
4102    coeffs new_cf=nInitChar(n_Q,NULL);
4103    nKillChar(tempR->cf);
4104    tempR->cf=new_cf;
4105    rComplete(tempR);
4106    ideal vid = (ideal)v->Data();
4107    rChangeCurrRing(tempR);
4108    ideal vv = idrCopyR(vid, origR, currRing);
4109    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
4110    vvAsLeftv.rtyp = IDEAL_CMD;
4111    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
4112    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
4113    assumeStdFlag(&vvAsLeftv);
4114    Print("// NOTE: computation of Hilbert series etc. is being\n");
4115    Print("//       performed for generic fibre, that is, over Q\n");
4116    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
4117    //scHilbertPoly(vv,currQuotient);
4118    hLookSeries(vv,module_w,currQuotient);
4119    idDelete(&vv);
4120    rChangeCurrRing(origR);
4121    rDelete(tempR);
4122    return FALSE;
4123  }
4124#endif
4125  assumeStdFlag(v);
4126  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4127  //scHilbertPoly((ideal)v->Data(),currQuotient);
4128  hLookSeries((ideal)v->Data(),module_w,currQuotient);
4129  return FALSE;
4130}
4131static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
4132{
4133#ifdef HAVE_RINGS
4134  if (rField_is_Ring_Z(currRing))
4135  {
4136    Print("// NOTE: computation of Hilbert series etc. is being\n");
4137    Print("//       performed for generic fibre, that is, over Q\n");
4138  }
4139#endif
4140  res->data=(void *)hSecondSeries((intvec *)v->Data());
4141  return FALSE;
4142}
4143static BOOLEAN jjHOMOG1(leftv res, leftv v)
4144{
4145  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4146  ideal v_id=(ideal)v->Data();
4147  if (w==NULL)
4148  {
4149    res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
4150    if (res->data!=NULL)
4151    {
4152      if (v->rtyp==IDHDL)
4153      {
4154        char *s_isHomog=omStrDup("isHomog");
4155        if (v->e==NULL)
4156          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
4157        else
4158          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
4159      }
4160      else if (w!=NULL) delete w;
4161    } // if res->data==NULL then w==NULL
4162  }
4163  else
4164  {
4165    res->data=(void *)(long)idTestHomModule(v_id,currQuotient,w);
4166    if((res->data==NULL) && (v->rtyp==IDHDL))
4167    {
4168      if (v->e==NULL)
4169        atKill((idhdl)(v->data),"isHomog");
4170      else
4171        atKill((idhdl)(v->LData()),"isHomog");
4172    }
4173  }
4174  return FALSE;
4175}
4176static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
4177{
4178  res->data = (char *)idMaxIdeal((int)(long)v->Data());
4179  setFlag(res,FLAG_STD);
4180  return FALSE;
4181}
4182static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
4183{
4184  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
4185  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
4186  if (IDELEMS((ideal)mat)==0)
4187  {
4188    idDelete((ideal *)&mat);
4189    mat=(matrix)idInit(1,1);
4190  }
4191  else
4192  {
4193    MATROWS(mat)=1;
4194    mat->rank=1;
4195    idTest((ideal)mat);
4196  }
4197  res->data=(char *)mat;
4198  return FALSE;
4199}
4200static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4201{
4202  map m=(map)v->CopyD(MAP_CMD);
4203  omFree((ADDRESS)m->preimage);
4204  m->preimage=NULL;
4205  ideal I=(ideal)m;
4206  I->rank=1;
4207  res->data=(char *)I;
4208  return FALSE;
4209}
4210static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4211{
4212  if (currRing!=NULL)
4213  {
4214    ring q=(ring)v->Data();
4215    if (rSamePolyRep(currRing, q))
4216    {
4217      if (q->qideal==NULL)
4218        res->data=(char *)idInit(1,1);
4219      else
4220        res->data=(char *)idCopy(q->qideal);
4221      return FALSE;
4222    }
4223  }
4224  WerrorS("can only get ideal from identical qring");
4225  return TRUE;
4226}
4227static BOOLEAN jjIm2Iv(leftv res, leftv v)
4228{
4229  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4230  iv->makeVector();
4231  res->data = iv;
4232  return FALSE;
4233}
4234static BOOLEAN jjIMPART(leftv res, leftv v)
4235{
4236  res->data = (char *)n_ImPart((number)v->Data(),currRing->cf);
4237  return FALSE;
4238}
4239static BOOLEAN jjINDEPSET(leftv res, leftv v)
4240{
4241  assumeStdFlag(v);
4242  res->data=(void *)scIndIntvec((ideal)(v->Data()),currQuotient);
4243  return FALSE;
4244}
4245static BOOLEAN jjINTERRED(leftv res, leftv v)
4246{
4247  ideal result=kInterRed((ideal)(v->Data()), currQuotient);
4248  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4249  res->data = result;
4250  return FALSE;
4251}
4252static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4253{
4254  res->data = (char *)(long)pVar((poly)v->Data());
4255  return FALSE;
4256}
4257static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4258{
4259  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing)+1);
4260  return FALSE;
4261}
4262static BOOLEAN jjIS_RINGVAR0(leftv res, leftv)
4263{
4264  res->data = (char *)0;
4265  return FALSE;
4266}
4267static BOOLEAN jjJACOB_P(leftv res, leftv v)
4268{
4269  ideal i=idInit(currRing->N,1);
4270  int k;
4271  poly p=(poly)(v->Data());
4272  for (k=currRing->N;k>0;k--)
4273  {
4274    i->m[k-1]=pDiff(p,k);
4275  }
4276  res->data = (char *)i;
4277  return FALSE;
4278}
4279/*2
4280 * compute Jacobi matrix of a module/matrix
4281 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(currRing->N))  ),
4282 * where Mt := transpose(M)
4283 * Note that this is consistent with the current conventions for jacob in Singular,
4284 * whereas M2 computes its transposed.
4285 */
4286static BOOLEAN jjJACOB_M(leftv res, leftv a)
4287{
4288  ideal id = (ideal)a->Data();
4289  id = idTransp(id);
4290  int W = IDELEMS(id);
4291
4292  ideal result = idInit(W * currRing->N, id->rank);
4293  poly *p = result->m;
4294
4295  for( int v = 1; v <= currRing->N; v++ )
4296  {
4297    poly* q = id->m;
4298    for( int i = 0; i < W; i++, p++, q++ )
4299      *p = pDiff( *q, v );
4300  }
4301  idDelete(&id);
4302
4303  res->data = (char *)result;
4304  return FALSE;
4305}
4306
4307
4308static BOOLEAN jjKBASE(leftv res, leftv v)
4309{
4310  assumeStdFlag(v);
4311  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currQuotient);
4312  return FALSE;
4313}
4314#ifdef MDEBUG
4315static BOOLEAN jjpHead(leftv res, leftv v)
4316{
4317  res->data=(char *)pHead((poly)v->Data());
4318  return FALSE;
4319}
4320#endif
4321static BOOLEAN jjL2R(leftv res, leftv v)
4322{
4323  res->data=(char *)syConvList((lists)v->Data(),FALSE);
4324  if (res->data != NULL)
4325    return FALSE;
4326  else
4327    return TRUE;
4328}
4329static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4330{
4331  poly p=(poly)v->Data();
4332  if (p==NULL)
4333  {
4334    res->data=(char *)nInit(0);
4335  }
4336  else
4337  {
4338    res->data=(char *)nCopy(pGetCoeff(p));
4339  }
4340  return FALSE;
4341}
4342static BOOLEAN jjLEADEXP(leftv res, leftv v)
4343{
4344  poly p=(poly)v->Data();
4345  int s=currRing->N;
4346  if (v->Typ()==VECTOR_CMD) s++;
4347  intvec *iv=new intvec(s);
4348  if (p!=NULL)
4349  {
4350    for(int i = currRing->N;i;i--)
4351    {
4352      (*iv)[i-1]=pGetExp(p,i);
4353    }
4354    if (s!=currRing->N)
4355      (*iv)[currRing->N]=pGetComp(p);
4356  }
4357  res->data=(char *)iv;
4358  return FALSE;
4359}
4360static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4361{
4362  poly p=(poly)v->Data();
4363  if (p == NULL)
4364  {
4365    res->data = (char*) NULL;
4366  }
4367  else
4368  {
4369    poly lm = pLmInit(p);
4370    pSetCoeff(lm, nInit(1));
4371    res->data = (char*) lm;
4372  }
4373  return FALSE;
4374}
4375static BOOLEAN jjLOAD1(leftv res, leftv v)
4376{
4377  return jjLOAD(res, v,FALSE);
4378}
4379static BOOLEAN jjLISTRING(leftv res, leftv v)
4380{
4381  ring r=rCompose((lists)v->Data());
4382  if (r==NULL) return TRUE;
4383  if (r->qideal!=NULL) res->rtyp=QRING_CMD;
4384  res->data=(char *)r;
4385  return FALSE;
4386}
4387#if SIZEOF_LONG == 8
4388static number jjLONG2N(long d)
4389{
4390  int i=(int)d;
4391  if ((long)i == d)
4392  {
4393    return n_Init(i, coeffs_BIGINT);
4394  }
4395  else
4396  {
4397     struct snumber_dummy
4398     {
4399      mpz_t z;
4400      mpz_t n;
4401      #if defined(LDEBUG)
4402      int debug;
4403      #endif
4404      BOOLEAN s;
4405    };
4406    typedef struct snumber_dummy  *number_dummy;
4407
4408    number_dummy z=(number_dummy)omAlloc(sizeof(snumber_dummy));
4409    #if defined(LDEBUG)
4410    z->debug=123456;
4411    #endif
4412    z->s=3;
4413    mpz_init_set_si(z->z,d);
4414    return (number)z;
4415  }
4416}
4417#else
4418#define jjLONG2N(D) n_Init((int)D, coeffs_BIGINT)
4419#endif
4420static BOOLEAN jjPFAC1(leftv res, leftv v)
4421{
4422  /* call method jjPFAC2 with second argument = 0 (meaning that no
4423     valid bound for the prime factors has been given) */
4424  sleftv tmp;
4425  memset(&tmp, 0, sizeof(tmp));
4426  tmp.rtyp = INT_CMD;
4427  return jjPFAC2(res, v, &tmp);
4428}
4429static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4430{
4431  /* computes the LU-decomposition of a matrix M;
4432     i.e., M = P * L * U, where
4433        - P is a row permutation matrix,
4434        - L is in lower triangular form,
4435        - U is in upper row echelon form
4436     Then, we also have P * M = L * U.
4437     A list [P, L, U] is returned. */
4438  matrix mat = (const matrix)v->Data();
4439  if (!idIsConstant((ideal)mat))
4440  {
4441    WerrorS("matrix must be constant");
4442    return TRUE;
4443  }
4444  matrix pMat;
4445  matrix lMat;
4446  matrix uMat;
4447
4448  luDecomp(mat, pMat, lMat, uMat);
4449
4450  lists ll = (lists)omAllocBin(slists_bin);
4451  ll->Init(3);
4452  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4453  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4454  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4455  res->data=(char*)ll;
4456
4457  return FALSE;
4458}
4459static BOOLEAN jjMEMORY(leftv res, leftv v)
4460{
4461  omUpdateInfo();
4462  switch(((int)(long)v->Data()))
4463  {
4464  case 0:
4465    res->data=(char *)jjLONG2N(om_Info.UsedBytes);
4466    break;
4467  case 1:
4468    res->data = (char *)jjLONG2N(om_Info.CurrentBytesSystem);
4469    break;
4470  case 2:
4471    res->data = (char *)jjLONG2N(om_Info.MaxBytesSystem);
4472    break;
4473  default:
4474    omPrintStats(stdout);
4475    omPrintInfo(stdout);
4476    omPrintBinStats(stdout);
4477    res->data = (char *)0;
4478    res->rtyp = NONE;
4479  }
4480  return FALSE;
4481  res->data = (char *)0;
4482  return FALSE;
4483}
4484//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4485//{
4486//  return jjMONITOR2(res,v,NULL);
4487//}
4488static BOOLEAN jjMSTD(leftv res, leftv v)
4489{
4490  int t=v->Typ();
4491  ideal r,m;
4492  r=kMin_std((ideal)v->Data(),currQuotient,testHomog,NULL,m);
4493  lists l=(lists)omAllocBin(slists_bin);
4494  l->Init(2);
4495  l->m[0].rtyp=t;
4496  l->m[0].data=(char *)r;
4497  setFlag(&(l->m[0]),FLAG_STD);
4498  l->m[1].rtyp=t;
4499  l->m[1].data=(char *)m;
4500  res->data=(char *)l;
4501  return FALSE;
4502}
4503static BOOLEAN jjMULT(leftv res, leftv v)
4504{
4505  assumeStdFlag(v);
4506  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currQuotient);
4507  return FALSE;
4508}
4509static BOOLEAN jjMINRES_R(leftv res, leftv v)
4510{
4511  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4512
4513  syStrategy tmp=(syStrategy)v->Data();
4514  tmp = syMinimize(tmp); // enrich itself!
4515
4516  res->data=(char *)tmp;
4517
4518  if (weights!=NULL)
4519    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4520
4521  return FALSE;
4522}
4523static BOOLEAN jjN2BI(leftv res, leftv v)
4524{
4525  number n,i; i=(number)v->Data();
4526  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4527  if (nMap!=NULL)
4528    n=nMap(i,currRing->cf,coeffs_BIGINT);
4529  else goto err;
4530  res->data=(void *)n;
4531  return FALSE;
4532err:
4533  WerrorS("cannot convert to bigint"); return TRUE;
4534}
4535static BOOLEAN jjNAMEOF(leftv res, leftv v)
4536{
4537  res->data = (char *)v->name;
4538  if (res->data==NULL) res->data=omStrDup("");
4539  v->name=NULL;
4540  return FALSE;
4541}
4542static BOOLEAN jjNAMES(leftv res, leftv v)
4543{
4544  res->data=ipNameList(((ring)v->Data())->idroot);
4545  return FALSE;
4546}
4547static BOOLEAN jjNVARS(leftv res, leftv v)
4548{
4549  res->data = (char *)(long)(((ring)(v->Data()))->N);
4550  return FALSE;
4551}
4552static BOOLEAN jjOpenClose(leftv, leftv v)
4553{
4554  si_link l=(si_link)v->Data();
4555  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4556  else                return slClose(l);
4557}
4558static BOOLEAN jjORD(leftv res, leftv v)
4559{
4560  poly p=(poly)v->Data();
4561  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4562  return FALSE;
4563}
4564static BOOLEAN jjPAR1(leftv res, leftv v)
4565{
4566  int i=(int)(long)v->Data();
4567  int p=0;
4568  p=rPar(currRing);
4569  if ((0<i) && (i<=p))
4570  {
4571    res->data=(char *)n_Param(i,currRing);
4572  }
4573  else
4574  {
4575    Werror("par number %d out of range 1..%d",i,p);
4576    return TRUE;
4577  }
4578  return FALSE;
4579}
4580static BOOLEAN jjPARDEG(leftv res, leftv v)
4581{
4582  number nn=(number)v->Data();
4583  res->data = (char *)(long)n_ParDeg(nn, currRing);
4584  return FALSE;
4585}
4586static BOOLEAN jjPARSTR1(leftv res, leftv v)
4587{
4588  if (currRing==NULL)
4589  {
4590    WerrorS("no ring active");
4591    return TRUE;
4592  }
4593  int i=(int)(long)v->Data();
4594  int p=0;
4595  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4596    res->data=omStrDup(rParameter(currRing)[i-1]);
4597  else
4598  {
4599    Werror("par number %d out of range 1..%d",i,p);
4600    return TRUE;
4601  }
4602  return FALSE;
4603}
4604static BOOLEAN jjP2BI(leftv res, leftv v)
4605{
4606  poly p=(poly)v->Data();
4607  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4608  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4609  {
4610    WerrorS("poly must be constant");
4611    return TRUE;
4612  }
4613  number i=pGetCoeff(p);
4614  number n;
4615  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4616  if (nMap!=NULL)
4617    n=nMap(i,currRing->cf,coeffs_BIGINT);
4618  else goto err;
4619  res->data=(void *)n;
4620  return FALSE;
4621err:
4622  WerrorS("cannot convert to bigint"); return TRUE;
4623}
4624static BOOLEAN jjP2I(leftv res, leftv v)
4625{
4626  poly p=(poly)v->Data();
4627  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4628  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4629  {
4630    WerrorS("poly must be constant");
4631    return TRUE;
4632  }
4633  res->data = (char *)(long)n_Int(pGetCoeff(p),currRing->cf);
4634  return FALSE;
4635}
4636static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4637{
4638  map mapping=(map)v->Data();
4639  syMake(res,omStrDup(mapping->preimage));
4640  return FALSE;
4641}
4642static BOOLEAN jjPRIME(leftv res, leftv v)
4643{
4644  int i = IsPrime((int)(long)(v->Data()));
4645  res->data = (char *)(long)(i > 1 ? i : 2);
4646  return FALSE;
4647}
4648static BOOLEAN jjPRUNE(leftv res, leftv v)
4649{
4650  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4651  ideal v_id=(ideal)v->Data();
4652  if (w!=NULL)
4653  {
4654    if (!idTestHomModule(v_id,currQuotient,w))
4655    {
4656      WarnS("wrong weights");
4657      w=NULL;
4658      // and continue at the non-homog case below
4659    }
4660    else
4661    {
4662      w=ivCopy(w);
4663      intvec **ww=&w;
4664      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4665      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4666      return FALSE;
4667    }
4668  }
4669  res->data = (char *)idMinEmbedding(v_id);
4670  return FALSE;
4671}
4672static BOOLEAN jjP2N(leftv res, leftv v)
4673{
4674  number n;
4675  poly p;
4676  if (((p=(poly)v->Data())!=NULL)
4677  && (pIsConstant(p)))
4678  {
4679    n=nCopy(pGetCoeff(p));
4680  }
4681  else
4682  {
4683    n=nInit(0);
4684  }
4685  res->data = (char *)n;
4686  return FALSE;
4687}
4688static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4689{
4690  char *s= (char *)v->Data();
4691  int i = 1;
4692  for(i=0; i<sArithBase.nCmdUsed; i++)
4693  {
4694    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4695    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4696    {
4697      res->data = (char *)1;
4698      return FALSE;
4699    }
4700  }
4701  //res->data = (char *)0;
4702  return FALSE;
4703}
4704static BOOLEAN jjRANK1(leftv res, leftv v)
4705{
4706  matrix m =(matrix)v->Data();
4707  int rank = luRank(m, 0);
4708  res->data =(char *)(long)rank;
4709  return FALSE;
4710}
4711static BOOLEAN jjREAD(leftv res, leftv v)
4712{
4713  return jjREAD2(res,v,NULL);
4714}
4715static BOOLEAN jjREGULARITY(leftv res, leftv v)
4716{
4717  res->data = (char *)(long)iiRegularity((lists)v->Data());
4718  return FALSE;
4719}
4720static BOOLEAN jjREPART(leftv res, leftv v)
4721{
4722  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4723  return FALSE;
4724}
4725static BOOLEAN jjRINGLIST(leftv res, leftv v)
4726{
4727  ring r=(ring)v->Data();
4728  if (r!=NULL)
4729    res->data = (char *)rDecompose((ring)v->Data());
4730  return (r==NULL)||(res->data==NULL);
4731}
4732static BOOLEAN jjROWS(leftv res, leftv v)
4733{
4734  ideal i = (ideal)v->Data();
4735  res->data = (char *)i->rank;
4736  return FALSE;
4737}
4738static BOOLEAN jjROWS_BIM(leftv res, leftv v)
4739{
4740  res->data = (char *)(long)((bigintmat*)(v->Data()))->rows();
4741  return FALSE;
4742}
4743static BOOLEAN jjROWS_IV(leftv res, leftv v)
4744{
4745  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4746  return FALSE;
4747}
4748static BOOLEAN jjRPAR(leftv res, leftv v)
4749{
4750  res->data = (char *)(long)rPar(((ring)v->Data()));
4751  return FALSE;
4752}
4753static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4754{
4755#ifdef HAVE_PLURAL
4756  const bool bIsSCA = rIsSCA(currRing);
4757#else
4758  const bool bIsSCA = false;
4759#endif
4760
4761  if ((currQuotient!=NULL) && !bIsSCA)
4762  {
4763    WerrorS("qring not supported by slimgb at the moment");
4764    return TRUE;
4765  }
4766  if (rHasLocalOrMixedOrdering_currRing())
4767  {
4768    WerrorS("ordering must be global for slimgb");
4769    return TRUE;
4770  }
4771  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4772  tHomog hom=testHomog;
4773  ideal u_id=(ideal)u->Data();
4774  if (w!=NULL)
4775  {
4776    if (!idTestHomModule(u_id,currQuotient,w))
4777    {
4778      WarnS("wrong weights");
4779      w=NULL;
4780    }
4781    else
4782    {
4783      w=ivCopy(w);
4784      hom=isHomog;
4785    }
4786  }
4787
4788  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
4789  res->data=(char *)t_rep_gb(currRing,
4790    u_id,u_id->rank);
4791  //res->data=(char *)t_rep_gb(currRing, u_id);
4792
4793  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4794  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4795  return FALSE;
4796}
4797static BOOLEAN jjSBA(leftv res, leftv v)
4798{
4799  ideal result;
4800  ideal v_id=(ideal)v->Data();
4801  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4802  tHomog hom=testHomog;
4803  if (w!=NULL)
4804  {
4805    if (!idTestHomModule(v_id,currQuotient,w))
4806    {
4807      WarnS("wrong weights");
4808      w=NULL;
4809    }
4810    else
4811    {
4812      hom=isHomog;
4813      w=ivCopy(w);
4814    }
4815  }
4816  result=kSba(v_id,currQuotient,hom,&w,1,0);
4817  idSkipZeroes(result);
4818  res->data = (char *)result;
4819  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4820  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4821  return FALSE;
4822}
4823static BOOLEAN jjSBA_1(leftv res, leftv v, leftv u)
4824{
4825  ideal result;
4826  ideal v_id=(ideal)v->Data();
4827  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4828  tHomog hom=testHomog;
4829  if (w!=NULL)
4830  {
4831    if (!idTestHomModule(v_id,currQuotient,w))
4832    {
4833      WarnS("wrong weights");
4834      w=NULL;
4835    }
4836    else
4837    {
4838      hom=isHomog;
4839      w=ivCopy(w);
4840    }
4841  }
4842  result=kSba(v_id,currQuotient,hom,&w,(int)(long)u->Data(),0);
4843  idSkipZeroes(result);
4844  res->data = (char *)result;
4845  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4846  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4847  return FALSE;
4848}
4849static BOOLEAN jjSBA_2(leftv res, leftv v, leftv u, leftv t)
4850{
4851  ideal result;
4852  ideal v_id=(ideal)v->Data();
4853  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4854  tHomog hom=testHomog;
4855  if (w!=NULL)
4856  {
4857    if (!idTestHomModule(v_id,currQuotient,w))
4858    {
4859      WarnS("wrong weights");
4860      w=NULL;
4861    }
4862    else
4863    {
4864      hom=isHomog;
4865      w=ivCopy(w);
4866    }
4867  }
4868  result=kSba(v_id,currQuotient,hom,&w,(int)(long)u->Data(),(int)(long)t->Data());
4869  idSkipZeroes(result);
4870  res->data = (char *)result;
4871  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4872  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4873  return FALSE;
4874}
4875static BOOLEAN jjSTD(leftv res, leftv v)
4876{
4877  ideal result;
4878  ideal v_id=(ideal)v->Data();
4879  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4880  tHomog hom=testHomog;
4881  if (w!=NULL)
4882  {
4883    if (!idTestHomModule(v_id,currQuotient,w))
4884    {
4885      WarnS("wrong weights");
4886      w=NULL;
4887    }
4888    else
4889    {
4890      hom=isHomog;
4891      w=ivCopy(w);
4892    }
4893  }
4894  result=kStd(v_id,currQuotient,hom,&w);
4895  idSkipZeroes(result);
4896  res->data = (char *)result;
4897  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4898  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4899  return FALSE;
4900}
4901static BOOLEAN jjSort_Id(leftv res, leftv v)
4902{
4903  res->data = (char *)idSort((ideal)v->Data());
4904  return FALSE;
4905}
4906#ifdef HAVE_FACTORY
4907static BOOLEAN jjSQR_FREE(leftv res, leftv u)
4908{
4909  singclap_factorize_retry=0;
4910  intvec *v=NULL;
4911  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
4912  if (f==NULL) return TRUE;
4913  ivTest(v);
4914  lists l=(lists)omAllocBin(slists_bin);
4915  l->Init(2);
4916  l->m[0].rtyp=IDEAL_CMD;
4917  l->m[0].data=(void *)f;
4918  l->m[1].rtyp=INTVEC_CMD;
4919  l->m[1].data=(void *)v;
4920  res->data=(void *)l;
4921  return FALSE;
4922}
4923#endif
4924#if 1
4925static BOOLEAN jjSYZYGY(leftv res, leftv v)
4926{
4927  intvec *w=NULL;
4928  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
4929  if (w!=NULL) delete w;
4930  return FALSE;
4931}
4932#else
4933// activate, if idSyz handle module weights correctly !
4934static BOOLEAN jjSYZYGY(leftv res, leftv v)
4935{
4936  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4937  ideal v_id=(ideal)v->Data();
4938  tHomog hom=testHomog;
4939  int add_row_shift=0;
4940  if (w!=NULL)
4941  {
4942    w=ivCopy(w);
4943    add_row_shift=w->min_in();
4944    (*w)-=add_row_shift;
4945    if (idTestHomModule(v_id,currQuotient,w))
4946      hom=isHomog;
4947    else
4948    {
4949      //WarnS("wrong weights");
4950      delete w; w=NULL;
4951      hom=testHomog;
4952    }
4953  }
4954  res->data = (char *)idSyzygies(v_id,hom,&w);
4955  if (w!=NULL)
4956  {
4957    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4958  }
4959  return FALSE;
4960}
4961#endif
4962static BOOLEAN jjTRACE_IV(leftv res, leftv v)
4963{
4964  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
4965  return FALSE;
4966}
4967static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
4968{
4969  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
4970  return FALSE;
4971}
4972static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
4973{
4974  res->data = (char *)ivTranp((intvec*)(v->Data()));
4975  return FALSE;
4976}
4977#ifdef HAVE_PLURAL
4978static BOOLEAN jjOPPOSITE(leftv res, leftv a)
4979{
4980  ring    r = (ring)a->Data();
4981  //if (rIsPluralRing(r))
4982  if (r->OrdSgn==1)
4983  {
4984    res->data = rOpposite(r);
4985  }
4986  else
4987  {
4988    WarnS("opposite only for global orderings");
4989    res->data = rCopy(r);
4990  }
4991  return FALSE;
4992}
4993static BOOLEAN jjENVELOPE(leftv res, leftv a)
4994{
4995  ring    r = (ring)a->Data();
4996  if (rIsPluralRing(r))
4997  {
4998    //    ideal   i;
4999//     if (a->rtyp == QRING_CMD)
5000//     {
5001//       i = r->qideal;
5002//       r->qideal = NULL;
5003//     }
5004    ring s = rEnvelope(r);
5005//     if (a->rtyp == QRING_CMD)
5006//     {
5007//       ideal is  = idOppose(r,i); /* twostd? */
5008//       is        = idAdd(is,i);
5009//       s->qideal = i;
5010//     }
5011    res->data = s;
5012  }
5013  else  res->data = rCopy(r);
5014  return FALSE;
5015}
5016static BOOLEAN jjTWOSTD(leftv res, leftv a)
5017{
5018  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
5019  else  res->data=(ideal)a->CopyD();
5020  setFlag(res,FLAG_STD);
5021  setFlag(res,FLAG_TWOSTD);
5022  return FALSE;
5023}
5024#endif
5025
5026static BOOLEAN jjTYPEOF(leftv res, leftv v)
5027{
5028  int t=(int)(long)v->data;
5029  switch (t)
5030  {
5031    case INT_CMD:        res->data=omStrDup("int"); break;
5032    case POLY_CMD:       res->data=omStrDup("poly"); break;
5033    case VECTOR_CMD:     res->data=omStrDup("vector"); break;
5034    case STRING_CMD:     res->data=omStrDup("string"); break;
5035    case INTVEC_CMD:     res->data=omStrDup("intvec"); break;
5036    case IDEAL_CMD:      res->data=omStrDup("ideal"); break;
5037    case MATRIX_CMD:     res->data=omStrDup("matrix"); break;
5038    case MODUL_CMD:      res->data=omStrDup("module"); break;
5039    case MAP_CMD:        res->data=omStrDup("map"); break;
5040    case PROC_CMD:       res->data=omStrDup("proc"); break;
5041    case RING_CMD:       res->data=omStrDup("ring"); break;
5042    case QRING_CMD:      res->data=omStrDup("qring"); break;
5043    case INTMAT_CMD:     res->data=omStrDup("intmat"); break;
5044    case NUMBER_CMD:     res->data=omStrDup("number"); break;
5045    case BIGINT_CMD:     res->data=omStrDup("bigint"); break;
5046    case LIST_CMD:       res->data=omStrDup("list"); break;
5047    case PACKAGE_CMD:    res->data=omStrDup("package"); break;
5048    case LINK_CMD:       res->data=omStrDup("link"); break;
5049    case RESOLUTION_CMD: res->data=omStrDup("resolution");break;
5050    case DEF_CMD:
5051    case NONE:           res->data=omStrDup("none"); break;
5052    default:
5053    {
5054      if (t>MAX_TOK)
5055        res->data=omStrDup(getBlackboxName(t));
5056      else
5057        res->data=omStrDup("?unknown type?");
5058      break;
5059    }
5060  }
5061  return FALSE;
5062}
5063static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5064{
5065  res->data=(char *)pIsUnivariate((poly)v->Data());
5066  return FALSE;
5067}
5068static BOOLEAN jjVAR1(leftv res, leftv v)
5069{
5070  int i=(int)(long)v->Data();
5071  if ((0<i) && (i<=currRing->N))
5072  {
5073    poly p=pOne();
5074    pSetExp(p,i,1);
5075    pSetm(p);
5076    res->data=(char *)p;
5077  }
5078  else
5079  {
5080    Werror("var number %d out of range 1..%d",i,currRing->N);
5081    return TRUE;
5082  }
5083  return FALSE;
5084}
5085static BOOLEAN jjVARSTR1(leftv res, leftv v)
5086{
5087  if (currRing==NULL)
5088  {
5089    WerrorS("no ring active");
5090    return TRUE;
5091  }
5092  int i=(int)(long)v->Data();
5093  if ((0<i) && (i<=currRing->N))
5094    res->data=omStrDup(currRing->names[i-1]);
5095  else
5096  {
5097    Werror("var number %d out of range 1..%d",i,currRing->N);
5098    return TRUE;
5099  }
5100  return FALSE;
5101}
5102static BOOLEAN jjVDIM(leftv res, leftv v)
5103{
5104  assumeStdFlag(v);
5105  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currQuotient);
5106  return FALSE;
5107}
5108BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5109{
5110// input: u: a list with links of type
5111//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5112// returns: -1:  the read state of all links is eof
5113//          i>0: (at least) u[i] is ready
5114  lists Lforks = (lists)u->Data();
5115  int i = slStatusSsiL(Lforks, -1);
5116  if(i == -2) /* error */
5117  {
5118    return TRUE;
5119  }
5120  res->data = (void*)(long)i;
5121  return FALSE;
5122}
5123BOOLEAN jjWAITALL1(leftv res, leftv u)
5124{
5125// input: u: a list with links of type
5126//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5127// returns: -1: the read state of all links is eof
5128//           1: all links are ready
5129//              (caution: at least one is ready, but some maybe dead)
5130  lists Lforks = (lists)u->CopyD();
5131  int i;
5132  int j = -1;
5133  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5134  {
5135    i = slStatusSsiL(Lforks, -1);
5136    if(i == -2) /* error */
5137    {
5138      return TRUE;
5139    }
5140    if(i == -1)
5141    {
5142      break;
5143    }
5144    j = 1;
5145    Lforks->m[i-1].CleanUp();
5146    Lforks->m[i-1].rtyp=DEF_CMD;
5147    Lforks->m[i-1].data=NULL;
5148  }
5149  res->data = (void*)(long)j;
5150  Lforks->Clean();
5151  return FALSE;
5152}
5153static BOOLEAN jjLOAD(leftv, leftv v, BOOLEAN autoexport)
5154{
5155  char * s=(char *)v->CopyD();
5156  char libnamebuf[256];
5157  lib_types LT = type_of_LIB(s, libnamebuf);
5158#ifdef HAVE_DYNAMIC_LOADING
5159  extern BOOLEAN load_modules(char *newlib, char *fullpath, BOOLEAN autoexport);
5160#endif /* HAVE_DYNAMIC_LOADING */
5161  switch(LT)
5162  {
5163      default:
5164      case LT_NONE:
5165        Werror("%s: unknown type", s);
5166        break;
5167      case LT_NOTFOUND:
5168        Werror("cannot open %s", s);
5169        break;
5170
5171      case LT_SINGULAR:
5172      {
5173        char *plib = iiConvName(s);
5174        idhdl pl = IDROOT->get(plib,0);
5175        if (pl==NULL)
5176        {
5177          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5178          IDPACKAGE(pl)->language = LANG_SINGULAR;
5179          IDPACKAGE(pl)->libname=omStrDup(plib);
5180        }
5181        else if (IDTYP(pl)!=PACKAGE_CMD)
5182        {
5183          Werror("can not create package `%s`",plib);
5184          omFree(plib);
5185          return TRUE;
5186        }
5187        package savepack=currPack;
5188        currPack=IDPACKAGE(pl);
5189        IDPACKAGE(pl)->loaded=TRUE;
5190        char libnamebuf[256];
5191        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5192        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5193        currPack=savepack;
5194        IDPACKAGE(pl)->loaded=(!bo);
5195        return bo;
5196      }
5197      case LT_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);