source: git/Singular/iparith.cc @ 780b52

spielwiese
Last change on this file since 780b52 was 780b52, checked in by Hans Schoenemann <hannes@…>, 11 years ago
fix: opt. in gcc 4.7 (iiMake_proc)
  • Property mode set to 100644
File size: 216.4 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  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
1560  {
1561    idrec tmp_proc;
1562    tmp_proc.id="_auto";
1563    tmp_proc.typ=PROC_CMD;
1564    tmp_proc.data.pinf=(procinfo *)u->Data();
1565    tmp_proc.ref=1;
1566    d=u->data; u->data=(void *)&tmp_proc;
1567    e=u->e; u->e=NULL;
1568    t=TRUE;
1569    typ=u->rtyp; u->rtyp=IDHDL;
1570  }
1571  leftv sl;
1572  if (u->req_packhdl==currPack)
1573    sl = iiMake_proc((idhdl)u->data,NULL,v);
1574  else
1575    sl = iiMake_proc((idhdl)u->data,u->req_packhdl,v);
1576  if (t)
1577  {
1578    u->rtyp=typ;
1579    u->data=d;
1580    u->e=e;
1581  }
1582  if (sl==NULL)
1583  {
1584    return TRUE;
1585  }
1586  else
1587  {
1588    memcpy(res,&iiRETURNEXPR,sizeof(sleftv));
1589  }
1590  iiRETURNEXPR.Init();
1591  return FALSE;
1592}
1593static BOOLEAN jjMAP(leftv res, leftv u, leftv v)
1594{
1595  //Print("try to map %s with %s\n",$3.Name(),$1.Name());
1596  leftv sl=NULL;
1597  if ((v->e==NULL)&&(v->name!=NULL))
1598  {
1599    map m=(map)u->Data();
1600    sl=iiMap(m,v->name);
1601  }
1602  else
1603  {
1604    Werror("%s(<name>) expected",u->Name());
1605  }
1606  if (sl==NULL) return TRUE;
1607  memcpy(res,sl,sizeof(sleftv));
1608  omFreeBin((ADDRESS)sl, sleftv_bin);
1609  return FALSE;
1610}
1611#ifdef HAVE_FACTORY
1612static BOOLEAN jjCHINREM_BI(leftv res, leftv u, leftv v)
1613{
1614  intvec *c=(intvec*)u->Data();
1615  intvec* p=(intvec*)v->Data();
1616  int rl=p->length();
1617  number *x=(number *)omAlloc(rl*sizeof(number));
1618  number *q=(number *)omAlloc(rl*sizeof(number));
1619  int i;
1620  for(i=rl-1;i>=0;i--)
1621  {
1622    q[i]=n_Init((*p)[i], coeffs_BIGINT);
1623    x[i]=n_Init((*c)[i], coeffs_BIGINT);
1624  }
1625  number n=n_ChineseRemainder(x,q,rl,coeffs_BIGINT);
1626  for(i=rl-1;i>=0;i--)
1627  {
1628    n_Delete(&(q[i]),coeffs_BIGINT);
1629    n_Delete(&(x[i]),coeffs_BIGINT);
1630  }
1631  omFree(x); omFree(q);
1632  res->data=(char *)n;
1633  return FALSE;
1634}
1635#endif
1636#if 0
1637static BOOLEAN jjCHINREM_P(leftv res, leftv u, leftv v)
1638{
1639  lists c=(lists)u->CopyD(); // list of poly
1640  intvec* p=(intvec*)v->Data();
1641  int rl=p->length();
1642  poly r=NULL,h, result=NULL;
1643  number *x=(number *)omAlloc(rl*sizeof(number));
1644  number *q=(number *)omAlloc(rl*sizeof(number));
1645  int i;
1646  for(i=rl-1;i>=0;i--)
1647  {
1648    q[i]=nlInit((*p)[i]);
1649  }
1650  loop
1651  {
1652    for(i=rl-1;i>=0;i--)
1653    {
1654      if (c->m[i].Typ()!=POLY_CMD)
1655      {
1656        Werror("poly expected at pos %d",i+1);
1657        for(i=rl-1;i>=0;i--)
1658        {
1659          nlDelete(&(q[i]),currRing);
1660        }
1661        omFree(x); omFree(q); // delete c
1662        return TRUE;
1663      }
1664      h=((poly)c->m[i].Data());
1665      if (r==NULL) r=h;
1666      else if (pLmCmp(r,h)==-1) r=h;
1667    }
1668    if (r==NULL) break;
1669    for(i=rl-1;i>=0;i--)
1670    {
1671      h=((poly)c->m[i].Data());
1672      if (pLmCmp(r,h)==0)
1673      {
1674        x[i]=pGetCoeff(h);
1675        h=pLmFreeAndNext(h);
1676        c->m[i].data=(char*)h;
1677      }
1678      else
1679        x[i]=nlInit(0);
1680    }
1681    number n=n_ChineseRemainder(x,q,rl,currRing->cf);
1682    for(i=rl-1;i>=0;i--)
1683    {
1684      nlDelete(&(x[i]),currRing);
1685    }
1686    h=pHead(r);
1687    pSetCoeff(h,n);
1688    result=pAdd(result,h);
1689  }
1690  for(i=rl-1;i>=0;i--)
1691  {
1692    nlDelete(&(q[i]),currRing);
1693  }
1694  omFree(x); omFree(q);
1695  res->data=(char *)result;
1696  return FALSE;
1697}
1698#endif
1699#ifdef HAVE_FACTORY
1700static BOOLEAN jjCHINREM_ID(leftv res, leftv u, leftv v)
1701{
1702  lists c=(lists)u->CopyD(); // list of ideal
1703  lists pl=NULL;
1704  intvec *p=NULL;
1705  if (v->Typ()==LIST_CMD) pl=(lists)v->Data();
1706  else                    p=(intvec*)v->Data();
1707  int rl=c->nr+1;
1708  ideal result;
1709  ideal *x=(ideal *)omAlloc(rl*sizeof(ideal));
1710  int i;
1711  int return_type=c->m[0].Typ();
1712  if ((return_type!=IDEAL_CMD)
1713  && (return_type!=MODUL_CMD)
1714  && (return_type!=MATRIX_CMD))
1715  {
1716    WerrorS("ideal/module/matrix expected");
1717    omFree(x); // delete c
1718    return TRUE;
1719  }
1720  for(i=rl-1;i>=0;i--)
1721  {
1722    if (c->m[i].Typ()!=return_type)
1723    {
1724      Werror("%s expected at pos %d",Tok2Cmdname(return_type),i+1);
1725      omFree(x); // delete c
1726      return TRUE;
1727    }
1728    x[i]=((ideal)c->m[i].Data());
1729  }
1730  number *q=(number *)omAlloc(rl*sizeof(number));
1731  if (p!=NULL)
1732  {
1733    for(i=rl-1;i>=0;i--)
1734    {
1735      q[i]=n_Init((*p)[i], currRing->cf);
1736    }
1737  }
1738  else
1739  {
1740    for(i=rl-1;i>=0;i--)
1741    {
1742      if (pl->m[i].Typ()==INT_CMD)
1743      {
1744        q[i]=n_Init((int)(long)pl->m[i].Data(),currRing->cf);
1745      }
1746      else if (pl->m[i].Typ()==BIGINT_CMD)
1747      {
1748        q[i]=n_Init_bigint((number)(pl->m[i].Data()),coeffs_BIGINT,currRing->cf);
1749      }
1750      else
1751      {
1752        Werror("bigint expected at pos %d",i+1);
1753        for(i++;i<rl;i++)
1754        {
1755          n_Delete(&(q[i]),currRing->cf);
1756        }
1757        omFree(x); // delete c
1758        omFree(q); // delete pl
1759        return TRUE;
1760      }
1761    }
1762  }
1763  result=id_ChineseRemainder(x,q,rl,currRing);
1764  for(i=rl-1;i>=0;i--)
1765  {
1766    n_Delete(&(q[i]),currRing->cf);
1767  }
1768  omFree(q);
1769  res->data=(char *)result;
1770  res->rtyp=return_type;
1771  return FALSE;
1772}
1773#endif
1774static BOOLEAN jjCOEF(leftv res, leftv u, leftv v)
1775{
1776  poly p=(poly)v->Data();
1777  if ((p==NULL)||(pNext(p)!=NULL)) return TRUE;
1778  res->data=(char *)mp_CoeffProc((poly)u->Data(),p /*(poly)v->Data()*/,currRing);
1779  return FALSE;
1780}
1781static BOOLEAN jjCOEFFS_Id(leftv res, leftv u, leftv v)
1782{
1783  int i=pVar((poly)v->Data());
1784  if (i==0)
1785  {
1786    WerrorS("ringvar expected");
1787    return TRUE;
1788  }
1789  res->data=(char *)mp_Coeffs((ideal)u->CopyD(),i,currRing);
1790  return FALSE;
1791}
1792static BOOLEAN jjCOEFFS2_KB(leftv res, leftv u, leftv v)
1793{
1794  poly p = pInit();
1795  int i;
1796  for (i=1; i<=currRing->N; i++)
1797  {
1798    pSetExp(p, i, 1);
1799  }
1800  pSetm(p);
1801  res->data = (void*)idCoeffOfKBase((ideal)(u->Data()),
1802                                    (ideal)(v->Data()), p);
1803  pDelete(&p);
1804  return FALSE;
1805}
1806static BOOLEAN jjCONTRACT(leftv res, leftv u, leftv v)
1807{
1808  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data(),FALSE);
1809  return FALSE;
1810}
1811static BOOLEAN jjDEG_M_IV(leftv res, leftv u, leftv v)
1812{
1813  short *iv=iv2array((intvec *)v->Data(),currRing);
1814  ideal I=(ideal)u->Data();
1815  int d=-1;
1816  int i;
1817  for(i=IDELEMS(I);i>=0;i--) d=si_max(d,(int)pDegW(I->m[i],iv));
1818  omFreeSize((ADDRESS)iv,(currRing->N+1)*sizeof(short));
1819  res->data = (char *)((long)d);
1820  return FALSE;
1821}
1822static BOOLEAN jjDEG_IV(leftv res, leftv u, leftv v)
1823{
1824  poly p=(poly)u->Data();
1825  if (p!=NULL)
1826  {
1827    short *iv=iv2array((intvec *)v->Data(),currRing);
1828    int d=(int)pDegW(p,iv);
1829    omFreeSize((ADDRESS)iv,(currRing->N+1)*sizeof(short));
1830    res->data = (char *)(long(d));
1831  }
1832  else
1833    res->data=(char *)(long)(-1);
1834  return FALSE;
1835}
1836static BOOLEAN jjDIFF_P(leftv res, leftv u, leftv v)
1837{
1838  int i=pVar((poly)v->Data());
1839  if (i==0)
1840  {
1841    WerrorS("ringvar expected");
1842    return TRUE;
1843  }
1844  res->data=(char *)pDiff((poly)(u->Data()),i);
1845  return FALSE;
1846}
1847static BOOLEAN jjDIFF_ID(leftv res, leftv u, leftv v)
1848{
1849  int i=pVar((poly)v->Data());
1850  if (i==0)
1851  {
1852    WerrorS("ringvar expected");
1853    return TRUE;
1854  }
1855  res->data=(char *)idDiff((matrix)(u->Data()),i);
1856  return FALSE;
1857}
1858static BOOLEAN jjDIFF_ID_ID(leftv res, leftv u, leftv v)
1859{
1860  res->data=(char *)idDiffOp((ideal)u->Data(),(ideal)v->Data());
1861  return FALSE;
1862}
1863static BOOLEAN jjDIM2(leftv res, leftv v, leftv w)
1864{
1865  assumeStdFlag(v);
1866#ifdef HAVE_RINGS
1867  if (rField_is_Ring(currRing))
1868  {
1869    //ring origR = currRing;
1870    //ring tempR = rCopy(origR);
1871    //coeffs new_cf=nInitChar(n_Q,NULL);
1872    //nKillChar(tempR->cf);
1873    //tempR->cf=new_cf;
1874    //rComplete(tempR);
1875    ideal vid = (ideal)v->Data();
1876    int i = idPosConstant(vid);
1877    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
1878    { /* ideal v contains unit; dim = -1 */
1879      res->data = (char *)-1;
1880      return FALSE;
1881    }
1882    //rChangeCurrRing(tempR);
1883    //ideal vv = idrCopyR(vid, origR, currRing);
1884    ideal vv = id_Copy(vid, currRing);
1885    //ideal ww = idrCopyR((ideal)w->Data(), origR, currRing);
1886    ideal ww = id_Copy((ideal)w->Data(), currRing);
1887    /* drop degree zero generator from vv (if any) */
1888    if (i != -1) pDelete(&vv->m[i]);
1889    long d = (long)scDimInt(vv, ww);
1890    if (rField_is_Ring_Z(currRing) && (i == -1)) d++;
1891    res->data = (char *)d;
1892    idDelete(&vv); idDelete(&ww);
1893    //rChangeCurrRing(origR);
1894    //rDelete(tempR);
1895    return FALSE;
1896  }
1897#endif
1898  if(currQuotient==NULL)
1899    res->data = (char *)((long)scDimInt((ideal)(v->Data()),(ideal)w->Data()));
1900  else
1901  {
1902    ideal q=idSimpleAdd(currQuotient,(ideal)w->Data());
1903    res->data = (char *)((long)scDimInt((ideal)(v->Data()),q));
1904    idDelete(&q);
1905  }
1906  return FALSE;
1907}
1908static BOOLEAN jjDIVISION(leftv res, leftv u, leftv v)
1909{
1910  ideal vi=(ideal)v->Data();
1911  int vl= IDELEMS(vi);
1912  ideal ui=(ideal)u->Data();
1913  int ul= IDELEMS(ui);
1914  ideal R; matrix U;
1915  ideal m = idLift(vi,ui,&R, FALSE,hasFlag(v,FLAG_STD),TRUE,&U);
1916  if (m==NULL) return TRUE;
1917  // now make sure that all matices have the corect size:
1918  matrix T = id_Module2formatedMatrix(m,vl,ul,currRing);
1919  int i;
1920  if (MATCOLS(U) != ul)
1921  {
1922    int mul=si_min(ul,MATCOLS(U));
1923    matrix UU=mpNew(ul,ul);
1924    int j;
1925    for(i=mul;i>0;i--)
1926    {
1927      for(j=mul;j>0;j--)
1928      {
1929        MATELEM(UU,i,j)=MATELEM(U,i,j);
1930        MATELEM(U,i,j)=NULL;
1931      }
1932    }
1933    idDelete((ideal *)&U);
1934    U=UU;
1935  }
1936  // make sure that U is a diagonal matrix of units
1937  for(i=ul;i>0;i--)
1938  {
1939    if(MATELEM(U,i,i)==NULL) MATELEM(U,i,i)=pOne();
1940  }
1941  lists L=(lists)omAllocBin(slists_bin);
1942  L->Init(3);
1943  L->m[0].rtyp=MATRIX_CMD;   L->m[0].data=(void *)T;
1944  L->m[1].rtyp=u->Typ();     L->m[1].data=(void *)R;
1945  L->m[2].rtyp=MATRIX_CMD;   L->m[2].data=(void *)U;
1946  res->data=(char *)L;
1947  return FALSE;
1948}
1949static BOOLEAN jjELIMIN(leftv res, leftv u, leftv v)
1950{
1951  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data());
1952  //setFlag(res,FLAG_STD);
1953  return FALSE;
1954}
1955static BOOLEAN jjELIMIN_IV(leftv res, leftv u, leftv v)
1956{
1957  poly p=pOne();
1958  intvec *iv=(intvec*)v->Data();
1959  for(int i=iv->length()-1; i>=0; i--)
1960  {
1961    pSetExp(p,(*iv)[i],1);
1962  }
1963  pSetm(p);
1964  res->data=(char *)idElimination((ideal)u->Data(),p);
1965  pLmDelete(&p);
1966  //setFlag(res,FLAG_STD);
1967  return FALSE;
1968}
1969static BOOLEAN jjEXPORTTO(leftv, leftv u, leftv v)
1970{
1971  //Print("exportto %s -> %s\n",v->Name(),u->Name() );
1972  return iiExport(v,0,(idhdl)u->data);
1973}
1974static BOOLEAN jjERROR(leftv, leftv u)
1975{
1976  WerrorS((char *)u->Data());
1977  extern int inerror;
1978  inerror=3;
1979  return TRUE;
1980}
1981static BOOLEAN jjEXTGCD_BI(leftv res, leftv u, leftv v)
1982{
1983  number uu=(number)u->Data();number vv=(number)v->Data();
1984  lists L=(lists)omAllocBin(slists_bin);
1985  number a,b;
1986  number p0=n_ExtGcd(uu,vv,&a,&b,coeffs_BIGINT);
1987  L->Init(3);
1988  L->m[0].rtyp=BIGINT_CMD;   L->m[0].data=(void *)p0;
1989  L->m[1].rtyp=BIGINT_CMD;   L->m[1].data=(void *)a;
1990  L->m[2].rtyp=BIGINT_CMD;   L->m[2].data=(void *)b;
1991  res->rtyp=LIST_CMD;
1992  res->data=(char *)L;
1993  return FALSE;
1994}
1995static BOOLEAN jjEXTGCD_I(leftv res, leftv u, leftv v)
1996{
1997  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
1998  int p0=ABS(uu),p1=ABS(vv);
1999  int f0 = 1, f1 = 0, g0 = 0, g1 = 1, q, r;
2000
2001  while ( p1!=0 )
2002  {
2003    q=p0 / p1;
2004    r=p0 % p1;
2005    p0 = p1; p1 = r;
2006    r = g0 - g1 * q;
2007    g0 = g1; g1 = r;
2008    r = f0 - f1 * q;
2009    f0 = f1; f1 = r;
2010  }
2011  int a = f0;
2012  int b = g0;
2013  if ( uu /*(int)(long)u->Data()*/ < 0 ) a=-a;
2014  if ( vv /*(int)(long)v->Data()*/ < 0 ) b=-b;
2015  lists L=(lists)omAllocBin(slists_bin);
2016  L->Init(3);
2017  L->m[0].rtyp=INT_CMD;   L->m[0].data=(void *)(long)p0;
2018  L->m[1].rtyp=INT_CMD;   L->m[1].data=(void *)(long)a;
2019  L->m[2].rtyp=INT_CMD;   L->m[2].data=(void *)(long)b;
2020  res->rtyp=LIST_CMD;
2021  res->data=(char *)L;
2022  return FALSE;
2023}
2024#ifdef HAVE_FACTORY
2025static BOOLEAN jjEXTGCD_P(leftv res, leftv u, leftv v)
2026{
2027  poly r,pa,pb;
2028  BOOLEAN ret=singclap_extgcd((poly)u->Data(),(poly)v->Data(),r,pa,pb,currRing);
2029  if (ret) return TRUE;
2030  lists L=(lists)omAllocBin(slists_bin);
2031  L->Init(3);
2032  res->data=(char *)L;
2033  L->m[0].data=(void *)r;
2034  L->m[0].rtyp=POLY_CMD;
2035  L->m[1].data=(void *)pa;
2036  L->m[1].rtyp=POLY_CMD;
2037  L->m[2].data=(void *)pb;
2038  L->m[2].rtyp=POLY_CMD;
2039  return FALSE;
2040}
2041extern int singclap_factorize_retry;
2042static BOOLEAN jjFAC_P2(leftv res, leftv u,leftv dummy)
2043{
2044  intvec *v=NULL;
2045  int sw=(int)(long)dummy->Data();
2046  int fac_sw=sw;
2047  if ((sw<0)||(sw>2)) fac_sw=1;
2048  singclap_factorize_retry=0;
2049  ideal f=singclap_factorize((poly)(u->CopyD()), &v, fac_sw,currRing);
2050  if (f==NULL)
2051    return TRUE;
2052  switch(sw)
2053  {
2054    case 0:
2055    case 2:
2056    {
2057      lists l=(lists)omAllocBin(slists_bin);
2058      l->Init(2);
2059      l->m[0].rtyp=IDEAL_CMD;
2060      l->m[0].data=(void *)f;
2061      l->m[1].rtyp=INTVEC_CMD;
2062      l->m[1].data=(void *)v;
2063      res->data=(void *)l;
2064      res->rtyp=LIST_CMD;
2065      return FALSE;
2066    }
2067    case 1:
2068      res->data=(void *)f;
2069      return FALSE;
2070    case 3:
2071      {
2072        poly p=f->m[0];
2073        int i=IDELEMS(f);
2074        f->m[0]=NULL;
2075        while(i>1)
2076        {
2077          i--;
2078          p=pMult(p,f->m[i]);
2079          f->m[i]=NULL;
2080        }
2081        res->data=(void *)p;
2082        res->rtyp=POLY_CMD;
2083      }
2084      return FALSE;
2085  }
2086  WerrorS("invalid switch");
2087  return TRUE;
2088}
2089static BOOLEAN jjFACSTD2(leftv res, leftv v, leftv w)
2090{
2091  ideal_list p,h;
2092  h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL,(ideal)w->Data());
2093  p=h;
2094  int l=0;
2095  while (p!=NULL) { p=p->next;l++; }
2096  lists L=(lists)omAllocBin(slists_bin);
2097  L->Init(l);
2098  l=0;
2099  while(h!=NULL)
2100  {
2101    L->m[l].data=(char *)h->d;
2102    L->m[l].rtyp=IDEAL_CMD;
2103    p=h->next;
2104    omFreeSize(h,sizeof(*h));
2105    h=p;
2106    l++;
2107  }
2108  res->data=(void *)L;
2109  return FALSE;
2110}
2111#endif /* HAVE_FACTORY */
2112static BOOLEAN jjFAREY_BI(leftv res, leftv u, leftv v)
2113{
2114  if (rField_is_Q(currRing))
2115  {
2116    number uu=(number)u->Data();
2117    number vv=(number)v->Data();
2118    res->data=(char *)n_Farey(uu,vv,currRing->cf);
2119    return FALSE;
2120  }
2121  else return TRUE;
2122}
2123static BOOLEAN jjFAREY_ID(leftv res, leftv u, leftv v)
2124{
2125  if (rField_is_Q(currRing))
2126  {
2127    ideal uu=(ideal)u->Data();
2128    number vv=(number)v->Data();
2129    res->data=(void*)id_Farey(uu,vv,currRing);
2130    res->rtyp=u->Typ();
2131    return FALSE;
2132  }
2133  else return TRUE;
2134}
2135static BOOLEAN jjFETCH(leftv res, leftv u, leftv v)
2136{
2137  ring r=(ring)u->Data();
2138  idhdl w;
2139  int op=iiOp;
2140  nMapFunc nMap;
2141
2142  if ((w=r->idroot->get(v->Name(),myynest))!=NULL)
2143  {
2144    int *perm=NULL;
2145    int *par_perm=NULL;
2146    int par_perm_size=0;
2147    BOOLEAN bo;
2148    //if (!nSetMap(rInternalChar(r),r->parameter,rPar(r),r->minpoly))
2149    if ((nMap=n_SetMap(r->cf,currRing->cf))==NULL)
2150    {
2151      // Allow imap/fetch to be make an exception only for:
2152      if ( (rField_is_Q_a(r) &&  // Q(a..) -> Q(a..) || Q || Zp || Zp(a)
2153            (rField_is_Q(currRing) || rField_is_Q_a(currRing) ||
2154             (rField_is_Zp(currRing) || rField_is_Zp_a(currRing))))
2155           ||
2156           (rField_is_Zp_a(r) &&  // Zp(a..) -> Zp(a..) || Zp
2157            (rField_is_Zp(currRing, r->cf->ch) ||
2158             rField_is_Zp_a(currRing, r->cf->ch))) )
2159      {
2160        par_perm_size=rPar(r);
2161      }
2162      else
2163      {
2164        goto err_fetch;
2165      }
2166    }
2167    if ((iiOp!=FETCH_CMD) || (r->N!=currRing->N) || (rPar(r)!=rPar(currRing)))
2168    {
2169      perm=(int *)omAlloc0((r->N+1)*sizeof(int));
2170      if (par_perm_size!=0)
2171        par_perm=(int *)omAlloc0(par_perm_size*sizeof(int));
2172      op=IMAP_CMD;
2173      if (iiOp==IMAP_CMD)
2174      {
2175        int r_par=0;
2176        char ** r_par_names=NULL;
2177        if (r->cf->extRing!=NULL)
2178        {
2179          r_par=r->cf->extRing->N;
2180          r_par_names=r->cf->extRing->names;
2181        }
2182        int c_par=0;
2183        char ** c_par_names=NULL;
2184        if (currRing->cf->extRing!=NULL)
2185        {
2186          c_par=currRing->cf->extRing->N;
2187          c_par_names=currRing->cf->extRing->names;
2188        }
2189        maFindPerm(r->names,       r->N,       r_par_names, r_par,
2190                   currRing->names,currRing->N,c_par_names, c_par,
2191                   perm,par_perm, currRing->cf->type);
2192      }
2193      else
2194      {
2195        int i;
2196        if (par_perm_size!=0)
2197          for(i=si_min(rPar(r),rPar(currRing))-1;i>=0;i--) par_perm[i]=-(i+1);
2198        for(i=si_min(r->N,currRing->N);i>0;i--) perm[i]=i;
2199      }
2200    }
2201    if ((iiOp==FETCH_CMD) &&(BVERBOSE(V_IMAP)))
2202    {
2203      int i;
2204      for(i=0;i<si_min(r->N,currRing->N);i++)
2205      {
2206        Print("// var nr %d: %s -> %s\n",i,r->names[i],currRing->names[i]);
2207      }
2208      for(i=0;i<si_min(rPar(r),rPar(currRing));i++) // possibly empty loop
2209      {
2210        Print("// par nr %d: %s -> %s\n",
2211              i,rParameter(r)[i],rParameter(currRing)[i]);
2212      }
2213    }
2214    sleftv tmpW;
2215    memset(&tmpW,0,sizeof(sleftv));
2216    tmpW.rtyp=IDTYP(w);
2217    tmpW.data=IDDATA(w);
2218    if ((bo=maApplyFetch(op,NULL,res,&tmpW, r,
2219                         perm,par_perm,par_perm_size,nMap)))
2220    {
2221      Werror("cannot map %s of type %s(%d)",v->name, Tok2Cmdname(w->typ),w->typ);
2222    }
2223    if (perm!=NULL)
2224      omFreeSize((ADDRESS)perm,(r->N+1)*sizeof(int));
2225    if (par_perm!=NULL)
2226      omFreeSize((ADDRESS)par_perm,par_perm_size*sizeof(int));
2227    return bo;
2228  }
2229  else
2230  {
2231    Werror("identifier %s not found in %s",v->Fullname(),u->Fullname());
2232  }
2233  return TRUE;
2234err_fetch:
2235  Werror("no identity map from %s",u->Fullname());
2236  return TRUE;
2237}
2238static BOOLEAN jjFIND2(leftv res, leftv u, leftv v)
2239{
2240  /*4
2241  * look for the substring what in the string where
2242  * return the position of the first char of what in where
2243  * or 0
2244  */
2245  char *where=(char *)u->Data();
2246  char *what=(char *)v->Data();
2247  char *found = strstr(where,what);
2248  if (found != NULL)
2249  {
2250    res->data=(char *)((found-where)+1);
2251  }
2252  /*else res->data=NULL;*/
2253  return FALSE;
2254}
2255static BOOLEAN jjFWALK(leftv res, leftv u, leftv v)
2256{
2257  res->data=(char *)fractalWalkProc(u,v);
2258  setFlag( res, FLAG_STD );
2259  return FALSE;
2260}
2261static BOOLEAN jjGCD_I(leftv res, leftv u, leftv v)
2262{
2263  int uu=(int)(long)u->Data();int vv=(int)(long)v->Data();
2264  int p0=ABS(uu),p1=ABS(vv);
2265  int r;
2266  while ( p1!=0 )
2267  {
2268    r=p0 % p1;
2269    p0 = p1; p1 = r;
2270  }
2271  res->rtyp=INT_CMD;
2272  res->data=(char *)(long)p0;
2273  return FALSE;
2274}
2275static BOOLEAN jjGCD_BI(leftv res, leftv u, leftv v)
2276{
2277  number a=(number) u->Data();
2278  number b=(number) v->Data();
2279  if (n_IsZero(a,coeffs_BIGINT))
2280  {
2281    if (n_IsZero(b,coeffs_BIGINT)) res->data=(char *)n_Init(1,coeffs_BIGINT);
2282    else                           res->data=(char *)n_Copy(b,coeffs_BIGINT);
2283  }
2284  else
2285  {
2286    if (n_IsZero(b,coeffs_BIGINT))  res->data=(char *)n_Copy(a,coeffs_BIGINT);
2287    else res->data=(char *)n_Gcd(a, b, coeffs_BIGINT);
2288  }
2289  return FALSE;
2290}
2291static BOOLEAN jjGCD_N(leftv res, leftv u, leftv v)
2292{
2293  number a=(number) u->Data();
2294  number b=(number) v->Data();
2295  if (nIsZero(a))
2296  {
2297    if (nIsZero(b)) res->data=(char *)nInit(1);
2298    else            res->data=(char *)nCopy(b);
2299  }
2300  else
2301  {
2302    if (nIsZero(b))  res->data=(char *)nCopy(a);
2303    else res->data=(char *)nGcd(a, b, currRing);
2304  }
2305  return FALSE;
2306}
2307#ifdef HAVE_FACTORY
2308static BOOLEAN jjGCD_P(leftv res, leftv u, leftv v)
2309{
2310  res->data=(void *)singclap_gcd((poly)(u->CopyD(POLY_CMD)),
2311                                 (poly)(v->CopyD(POLY_CMD)),currRing);
2312  return FALSE;
2313}
2314#endif /* HAVE_FACTORY */
2315static BOOLEAN jjHILBERT2(leftv res, leftv u, leftv v)
2316{
2317#ifdef HAVE_RINGS
2318  if (rField_is_Ring_Z(currRing))
2319  {
2320    ring origR = currRing;
2321    ring tempR = rCopy(origR);
2322    coeffs new_cf=nInitChar(n_Q,NULL);
2323    nKillChar(tempR->cf);
2324    tempR->cf=new_cf;
2325    rComplete(tempR);
2326    ideal uid = (ideal)u->Data();
2327    rChangeCurrRing(tempR);
2328    ideal uu = idrCopyR(uid, origR, currRing);
2329    sleftv uuAsLeftv; memset(&uuAsLeftv, 0, sizeof(uuAsLeftv));
2330    uuAsLeftv.rtyp = IDEAL_CMD;
2331    uuAsLeftv.data = uu; uuAsLeftv.next = NULL;
2332    if (hasFlag(u, FLAG_STD)) setFlag(&uuAsLeftv,FLAG_STD);
2333    assumeStdFlag(&uuAsLeftv);
2334    Print("// NOTE: computation of Hilbert series etc. is being\n");
2335    Print("//       performed for generic fibre, that is, over Q\n");
2336    intvec *module_w=(intvec*)atGet(&uuAsLeftv,"isHomog",INTVEC_CMD);
2337    intvec *iv=hFirstSeries(uu,module_w,currQuotient);
2338    int returnWithTrue = 1;
2339    switch((int)(long)v->Data())
2340    {
2341      case 1:
2342        res->data=(void *)iv;
2343        returnWithTrue = 0;
2344      case 2:
2345        res->data=(void *)hSecondSeries(iv);
2346        delete iv;
2347        returnWithTrue = 0;
2348    }
2349    if (returnWithTrue)
2350    {
2351      WerrorS(feNotImplemented);
2352      delete iv;
2353    }
2354    idDelete(&uu);
2355    rChangeCurrRing(origR);
2356    rDelete(tempR);
2357    if (returnWithTrue) return TRUE; else return FALSE;
2358  }
2359#endif
2360  assumeStdFlag(u);
2361  intvec *module_w=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2362  intvec *iv=hFirstSeries((ideal)u->Data(),module_w,currQuotient);
2363  switch((int)(long)v->Data())
2364  {
2365    case 1:
2366      res->data=(void *)iv;
2367      return FALSE;
2368    case 2:
2369      res->data=(void *)hSecondSeries(iv);
2370      delete iv;
2371      return FALSE;
2372  }
2373  WerrorS(feNotImplemented);
2374  delete iv;
2375  return TRUE;
2376}
2377static BOOLEAN jjHOMOG_P(leftv res, leftv u, leftv v)
2378{
2379  int i=pVar((poly)v->Data());
2380  if (i==0)
2381  {
2382    WerrorS("ringvar expected");
2383    return TRUE;
2384  }
2385  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2386  int d=pWTotaldegree(p);
2387  pLmDelete(p);
2388  if (d==1)
2389    res->data = (char *)p_Homogen((poly)u->Data(), i, currRing);
2390  else
2391    WerrorS("variable must have weight 1");
2392  return (d!=1);
2393}
2394static BOOLEAN jjHOMOG_ID(leftv res, leftv u, leftv v)
2395{
2396  int i=pVar((poly)v->Data());
2397  if (i==0)
2398  {
2399    WerrorS("ringvar expected");
2400    return TRUE;
2401  }
2402  pFDegProc deg;
2403  if (currRing->pLexOrder && (currRing->order[0]==ringorder_lp))
2404    deg=p_Totaldegree;
2405   else
2406    deg=currRing->pFDeg;
2407  poly p=pOne(); pSetExp(p,i,1); pSetm(p);
2408  int d=deg(p,currRing);
2409  pLmDelete(p);
2410  if (d==1)
2411    res->data = (char *)id_Homogen((ideal)u->Data(), i, currRing);
2412  else
2413    WerrorS("variable must have weight 1");
2414  return (d!=1);
2415}
2416static BOOLEAN jjHOMOG1_W(leftv res, leftv v, leftv u)
2417{
2418  intvec *w=new intvec(rVar(currRing));
2419  intvec *vw=(intvec*)u->Data();
2420  ideal v_id=(ideal)v->Data();
2421  pFDegProc save_FDeg=currRing->pFDeg;
2422  pLDegProc save_LDeg=currRing->pLDeg;
2423  BOOLEAN save_pLexOrder=currRing->pLexOrder;
2424  currRing->pLexOrder=FALSE;
2425  kHomW=vw;
2426  kModW=w;
2427  pSetDegProcs(currRing,kHomModDeg);
2428  res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
2429  currRing->pLexOrder=save_pLexOrder;
2430  kHomW=NULL;
2431  kModW=NULL;
2432  pRestoreDegProcs(currRing,save_FDeg,save_LDeg);
2433  if (w!=NULL) delete w;
2434  return FALSE;
2435}
2436static BOOLEAN jjINDEPSET2(leftv res, leftv u, leftv v)
2437{
2438  assumeStdFlag(u);
2439  res->data=(void *)scIndIndset((ideal)(u->Data()),(int)(long)(v->Data()),
2440                    currQuotient);
2441  return FALSE;
2442}
2443static BOOLEAN jjINTERSECT(leftv res, leftv u, leftv v)
2444{
2445  res->data=(char *)idSect((ideal)u->Data(),(ideal)v->Data());
2446  setFlag(res,FLAG_STD);
2447  return FALSE;
2448}
2449static BOOLEAN jjJanetBasis2(leftv res, leftv u, leftv v)
2450{
2451  return jjStdJanetBasis(res,u,(int)(long)v->Data());
2452}
2453static BOOLEAN jjJET_P(leftv res, leftv u, leftv v)
2454{
2455  res->data = (char *)pJet((poly)u->CopyD(), (int)(long)v->Data());
2456  return FALSE;
2457}
2458static BOOLEAN jjJET_ID(leftv res, leftv u, leftv v)
2459{
2460  res->data = (char *)id_Jet((ideal)u->Data(),(int)(long)v->Data(),currRing);
2461  return FALSE;
2462}
2463static BOOLEAN jjKBASE2(leftv res, leftv u, leftv v)
2464{
2465  assumeStdFlag(u);
2466  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2467  res->data = (char *)scKBase((int)(long)v->Data(),
2468                              (ideal)(u->Data()),currQuotient, w_u);
2469  if (w_u!=NULL)
2470  {
2471    atSet(res,omStrDup("isHomog"),ivCopy(w_u),INTVEC_CMD);
2472  }
2473  return FALSE;
2474}
2475static BOOLEAN jjPREIMAGE(leftv res, leftv u, leftv v, leftv w);
2476static BOOLEAN jjKERNEL(leftv res, leftv u, leftv v)
2477{
2478  return jjPREIMAGE(res,u,v,NULL);
2479}
2480static BOOLEAN jjKoszul(leftv res, leftv u, leftv v)
2481{
2482  return mpKoszul(res, u,v,NULL);
2483}
2484static BOOLEAN jjKoszul_Id(leftv res, leftv u, leftv v)
2485{
2486  sleftv h;
2487  memset(&h,0,sizeof(sleftv));
2488  h.rtyp=INT_CMD;
2489  h.data=(void *)(long)IDELEMS((ideal)v->Data());
2490  return mpKoszul(res, u, &h, v);
2491}
2492static BOOLEAN jjLIFT(leftv res, leftv u, leftv v)
2493{
2494  int ul= IDELEMS((ideal)u->Data());
2495  int vl= IDELEMS((ideal)v->Data());
2496  ideal m = idLift((ideal)u->Data(),(ideal)v->Data(),NULL,FALSE,
2497                   hasFlag(u,FLAG_STD));
2498  if (m==NULL) return TRUE;
2499  res->data = (char *)id_Module2formatedMatrix(m,ul,vl,currRing);
2500  return FALSE;
2501}
2502static BOOLEAN jjLIFTSTD(leftv res, leftv u, leftv v)
2503{
2504  if ((v->rtyp!=IDHDL)||(v->e!=NULL)) return TRUE;
2505  idhdl h=(idhdl)v->data;
2506  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
2507  res->data = (char *)idLiftStd((ideal)u->Data(),
2508                                &(h->data.umatrix),testHomog);
2509  setFlag(res,FLAG_STD); v->flag=0;
2510  return FALSE;
2511}
2512static BOOLEAN jjLOAD2(leftv res, leftv, leftv v)
2513{
2514  return jjLOAD(res, v,TRUE);
2515}
2516static BOOLEAN jjLOAD_E(leftv res, leftv v, leftv u)
2517{
2518  char * s=(char *)u->Data();
2519  if(strcmp(s, "with")==0)
2520    return jjLOAD(res, v, TRUE);
2521  WerrorS("invalid second argument");
2522  WerrorS("load(\"libname\" [,\"with\"]);");
2523  return TRUE;
2524}
2525static BOOLEAN jjMODULO(leftv res, leftv u, leftv v)
2526{
2527  intvec *w_u=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
2528  tHomog hom=testHomog;
2529  if (w_u!=NULL)
2530  {
2531    w_u=ivCopy(w_u);
2532    hom=isHomog;
2533  }
2534  intvec *w_v=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
2535  if (w_v!=NULL)
2536  {
2537    w_v=ivCopy(w_v);
2538    hom=isHomog;
2539  }
2540  if ((w_u!=NULL) && (w_v==NULL))
2541    w_v=ivCopy(w_u);
2542  if ((w_v!=NULL) && (w_u==NULL))
2543    w_u=ivCopy(w_v);
2544  ideal u_id=(ideal)u->Data();
2545  ideal v_id=(ideal)v->Data();
2546  if (w_u!=NULL)
2547  {
2548     if ((*w_u).compare((w_v))!=0)
2549     {
2550       WarnS("incompatible weights");
2551       delete w_u; w_u=NULL;
2552       hom=testHomog;
2553     }
2554     else
2555     {
2556       if ((!idTestHomModule(u_id,currQuotient,w_v))
2557       || (!idTestHomModule(v_id,currQuotient,w_v)))
2558       {
2559         WarnS("wrong weights");
2560         delete w_u; w_u=NULL;
2561         hom=testHomog;
2562       }
2563     }
2564  }
2565  res->data = (char *)idModulo(u_id,v_id ,hom,&w_u);
2566  if (w_u!=NULL)
2567  {
2568    atSet(res,omStrDup("isHomog"),w_u,INTVEC_CMD);
2569  }
2570  delete w_v;
2571  return FALSE;
2572}
2573static BOOLEAN jjMOD_BI(leftv res, leftv u, leftv v)
2574{
2575  number q=(number)v->Data();
2576  if (n_IsZero(q,coeffs_BIGINT))
2577  {
2578    WerrorS(ii_div_by_0);
2579    return TRUE;
2580  }
2581  res->data =(char *) n_IntMod((number)u->Data(),q,coeffs_BIGINT);
2582  return FALSE;
2583}
2584static BOOLEAN jjMOD_N(leftv res, leftv u, leftv v)
2585{
2586  number q=(number)v->Data();
2587  if (nIsZero(q))
2588  {
2589    WerrorS(ii_div_by_0);
2590    return TRUE;
2591  }
2592  res->data =(char *) n_IntMod((number)u->Data(),q,currRing->cf);
2593  return FALSE;
2594}
2595static BOOLEAN jjMONITOR2(leftv res, leftv u,leftv v);
2596static BOOLEAN jjMONITOR1(leftv res, leftv v)
2597{
2598  return jjMONITOR2(res,v,NULL);
2599}
2600static BOOLEAN jjMONITOR2(leftv, leftv u,leftv v)
2601{
2602#if 0
2603  char *opt=(char *)v->Data();
2604  int mode=0;
2605  while(*opt!='\0')
2606  {
2607    if (*opt=='i') mode |= PROT_I;
2608    else if (*opt=='o') mode |= PROT_O;
2609    opt++;
2610  }
2611  monitor((char *)(u->Data()),mode);
2612#else
2613  si_link l=(si_link)u->Data();
2614  if (slOpen(l,SI_LINK_WRITE,u)) return TRUE;
2615  if(strcmp(l->m->type,"ASCII")!=0)
2616  {
2617    Werror("ASCII link required, not `%s`",l->m->type);
2618    slClose(l);
2619    return TRUE;
2620  }
2621  SI_LINK_SET_CLOSE_P(l); // febase handles the FILE*
2622  if ( l->name[0]!='\0') // "" is the stop condition
2623  {
2624    const char *opt;
2625    int mode=0;
2626    if (v==NULL) opt=(const char*)"i";
2627    else         opt=(const char *)v->Data();
2628    while(*opt!='\0')
2629    {
2630      if (*opt=='i') mode |= PROT_I;
2631      else if (*opt=='o') mode |= PROT_O;
2632      opt++;
2633    }
2634    monitor((FILE *)l->data,mode);
2635  }
2636  else
2637    monitor(NULL,0);
2638  return FALSE;
2639#endif
2640}
2641static BOOLEAN jjMONOM(leftv res, leftv v)
2642{
2643  intvec *iv=(intvec *)v->Data();
2644  poly p=pOne();
2645  int i,e;
2646  BOOLEAN err=FALSE;
2647  for(i=si_min(currRing->N,iv->length()); i>0; i--)
2648  {
2649    e=(*iv)[i-1];
2650    if (e>=0) pSetExp(p,i,e);
2651    else err=TRUE;
2652  }
2653  if (iv->length()==(currRing->N+1))
2654  {
2655    res->rtyp=VECTOR_CMD;
2656    e=(*iv)[currRing->N];
2657    if (e>=0) pSetComp(p,e);
2658    else err=TRUE;
2659  }
2660  pSetm(p);
2661  res->data=(char*)p;
2662  if(err) { pDelete(&p); WerrorS("no negative exponent allowed"); }
2663  return err;
2664}
2665static BOOLEAN jjNEWSTRUCT2(leftv, leftv u, leftv v)
2666{
2667  // u: the name of the new type
2668  // v: the elements
2669  newstruct_desc d=newstructFromString((const char *)v->Data());
2670  if (d!=NULL) newstruct_setup((const char *)u->Data(),d);
2671  return d==NULL;
2672}
2673static BOOLEAN jjPARSTR2(leftv res, leftv u, leftv v)
2674{
2675  idhdl h=(idhdl)u->data;
2676  int i=(int)(long)v->Data();
2677  int p=0;
2678  if ((0<i)
2679  && (rParameter(IDRING(h))!=NULL)
2680  && (i<=(p=rPar(IDRING(h)))))
2681    res->data=omStrDup(rParameter(IDRING(h))[i-1]);
2682  else
2683  {
2684    Werror("par number %d out of range 1..%d",i,p);
2685    return TRUE;
2686  }
2687  return FALSE;
2688}
2689#ifdef HAVE_PLURAL
2690static BOOLEAN jjPlural_num_poly(leftv res, leftv a, leftv b)
2691{
2692  if( currRing->qideal != NULL )
2693  {
2694    WerrorS("basering must NOT be a qring!");
2695    return TRUE;
2696  }
2697
2698  if (iiOp==NCALGEBRA_CMD)
2699  {
2700    return nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),currRing,false,true,false,currRing);
2701  }
2702  else
2703  {
2704    ring r=rCopy(currRing);
2705    BOOLEAN result=nc_CallPlural(NULL,NULL,(poly)a->Data(),(poly)b->Data(),r,false,true,false,currRing);
2706    res->data=r;
2707    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2708    return result;
2709  }
2710}
2711static BOOLEAN jjPlural_num_mat(leftv res, leftv a, leftv b)
2712{
2713  if( currRing->qideal != NULL )
2714  {
2715    WerrorS("basering must NOT be a qring!");
2716    return TRUE;
2717  }
2718
2719  if (iiOp==NCALGEBRA_CMD)
2720  {
2721    return nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,currRing,false,true,false,currRing);
2722  }
2723  else
2724  {
2725    ring r=rCopy(currRing);
2726    BOOLEAN result=nc_CallPlural(NULL,(matrix)b->Data(),(poly)a->Data(),NULL,r,false,true,false,currRing);
2727    res->data=r;
2728    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2729    return result;
2730  }
2731}
2732static BOOLEAN jjPlural_mat_poly(leftv res, leftv a, leftv b)
2733{
2734  if( currRing->qideal != NULL )
2735  {
2736    WerrorS("basering must NOT be a qring!");
2737    return TRUE;
2738  }
2739
2740  if (iiOp==NCALGEBRA_CMD)
2741  {
2742    return nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),currRing,false,true,false,currRing);
2743  }
2744  else
2745  {
2746    ring r=rCopy(currRing);
2747    BOOLEAN result=nc_CallPlural((matrix)a->Data(),NULL,NULL,(poly)b->Data(),r,false,true,false,currRing);
2748    res->data=r;
2749    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2750    return result;
2751  }
2752}
2753static BOOLEAN jjPlural_mat_mat(leftv res, leftv a, leftv b)
2754{
2755  if( currRing->qideal != NULL )
2756  {
2757    WerrorS("basering must NOT be a qring!");
2758    return TRUE;
2759  }
2760
2761  if (iiOp==NCALGEBRA_CMD)
2762  {
2763    return nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,currRing,false,true,false,currRing);
2764  }
2765  else
2766  {
2767    ring r=rCopy(currRing);
2768    BOOLEAN result=nc_CallPlural((matrix)a->Data(),(matrix)b->Data(),NULL,NULL,r,false,true,false,currRing);
2769    res->data=r;
2770    if (r->qideal!=NULL) res->rtyp=QRING_CMD;
2771    return result;
2772  }
2773}
2774static BOOLEAN jjBRACKET(leftv res, leftv a, leftv b)
2775{
2776  res->data=NULL;
2777
2778  if (rIsPluralRing(currRing))
2779  {
2780    const poly q = (poly)b->Data();
2781
2782    if( q != NULL )
2783    {
2784      if( (poly)a->Data() != NULL )
2785      {
2786        poly p = (poly)a->CopyD(POLY_CMD); // p = copy!
2787        res->data = nc_p_Bracket_qq(p,q, currRing); // p will be destroyed!
2788      }
2789    }
2790  }
2791  return FALSE;
2792}
2793static BOOLEAN jjOPPOSE(leftv res, leftv a, leftv b)
2794{
2795  /* number, poly, vector, ideal, module, matrix */
2796  ring  r = (ring)a->Data();
2797  if (r == currRing)
2798  {
2799    res->data = b->Data();
2800    res->rtyp = b->rtyp;
2801    return FALSE;
2802  }
2803  if (!rIsLikeOpposite(currRing, r))
2804  {
2805    Werror("%s is not an opposite ring to current ring",a->Fullname());
2806    return TRUE;
2807  }
2808  idhdl w;
2809  if( ((w=r->idroot->get(b->Name(),myynest))!=NULL) && (b->e==NULL))
2810  {
2811    int argtype = IDTYP(w);
2812    switch (argtype)
2813    {
2814    case NUMBER_CMD:
2815      {
2816        /* since basefields are equal, we can apply nCopy */
2817        res->data = nCopy((number)IDDATA(w));
2818        res->rtyp = argtype;
2819        break;
2820      }
2821    case POLY_CMD:
2822    case VECTOR_CMD:
2823      {
2824        poly    q = (poly)IDDATA(w);
2825        res->data = pOppose(r,q,currRing);
2826        res->rtyp = argtype;
2827        break;
2828      }
2829    case IDEAL_CMD:
2830    case MODUL_CMD:
2831      {
2832        ideal   Q = (ideal)IDDATA(w);
2833        res->data = idOppose(r,Q,currRing);
2834        res->rtyp = argtype;
2835        break;
2836      }
2837    case MATRIX_CMD:
2838      {
2839        ring save = currRing;
2840        rChangeCurrRing(r);
2841        matrix  m = (matrix)IDDATA(w);
2842        ideal   Q = id_Matrix2Module(mp_Copy(m, currRing),currRing);
2843        rChangeCurrRing(save);
2844        ideal   S = idOppose(r,Q,currRing);
2845        id_Delete(&Q, r);
2846        res->data = id_Module2Matrix(S,currRing);
2847        res->rtyp = argtype;
2848        break;
2849      }
2850    default:
2851      {
2852        WerrorS("unsupported type in oppose");
2853        return TRUE;
2854      }
2855    }
2856  }
2857  else
2858  {
2859    Werror("identifier %s not found in %s",b->Fullname(),a->Fullname());
2860    return TRUE;
2861  }
2862  return FALSE;
2863}
2864#endif /* HAVE_PLURAL */
2865
2866static BOOLEAN jjQUOT(leftv res, leftv u, leftv v)
2867{
2868  res->data = (char *)idQuot((ideal)u->Data(),(ideal)v->Data(),
2869    hasFlag(u,FLAG_STD),u->Typ()==v->Typ());
2870  id_DelMultiples((ideal)(res->data),currRing);
2871  return FALSE;
2872}
2873static BOOLEAN jjRANDOM(leftv res, leftv u, leftv v)
2874{
2875  int i=(int)(long)u->Data();
2876  int j=(int)(long)v->Data();
2877  res->data =(char *)(long)((i > j) ? i : (siRand() % (j-i+1)) + i);
2878  return FALSE;
2879}
2880static BOOLEAN jjRANK2(leftv res, leftv u, leftv v)
2881{
2882  matrix m =(matrix)u->Data();
2883  int isRowEchelon = (int)(long)v->Data();
2884  if (isRowEchelon != 1) isRowEchelon = 0;
2885  int rank = luRank(m, isRowEchelon);
2886  res->data =(char *)(long)rank;
2887  return FALSE;
2888}
2889static BOOLEAN jjREAD2(leftv res, leftv u, leftv v)
2890{
2891  si_link l=(si_link)u->Data();
2892  leftv r=slRead(l,v);
2893  if (r==NULL)
2894  {
2895    const char *s;
2896    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
2897    else                            s=sNoName;
2898    Werror("cannot read from `%s`",s);
2899    return TRUE;
2900  }
2901  memcpy(res,r,sizeof(sleftv));
2902  omFreeBin((ADDRESS)r, sleftv_bin);
2903  return FALSE;
2904}
2905static BOOLEAN jjREDUCE_P(leftv res, leftv u, leftv v)
2906{
2907  assumeStdFlag(v);
2908  res->data = (char *)kNF((ideal)v->Data(),currQuotient,(poly)u->Data());
2909  return FALSE;
2910}
2911static BOOLEAN jjREDUCE_ID(leftv res, leftv u, leftv v)
2912{
2913  assumeStdFlag(v);
2914  ideal ui=(ideal)u->Data();
2915  ideal vi=(ideal)v->Data();
2916  res->data = (char *)kNF(vi,currQuotient,ui);
2917  return FALSE;
2918}
2919#if 0
2920static BOOLEAN jjRES(leftv res, leftv u, leftv v)
2921{
2922  int maxl=(int)(long)v->Data();
2923  if (maxl<0)
2924  {
2925    WerrorS("length for res must not be negative");
2926    return TRUE;
2927  }
2928  int l=0;
2929  //resolvente r;
2930  syStrategy r;
2931  intvec *weights=NULL;
2932  int wmaxl=maxl;
2933  ideal u_id=(ideal)u->Data();
2934
2935  maxl--;
2936  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
2937  {
2938    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
2939    if (currQuotient!=NULL)
2940    {
2941      Warn(
2942      "full resolution in a qring may be infinite, setting max length to %d",
2943      maxl+1);
2944    }
2945  }
2946  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
2947  if (weights!=NULL)
2948  {
2949    if (!idTestHomModule(u_id,currQuotient,weights))
2950    {
2951      WarnS("wrong weights given:");weights->show();PrintLn();
2952      weights=NULL;
2953    }
2954  }
2955  intvec *ww=NULL;
2956  int add_row_shift=0;
2957  if (weights!=NULL)
2958  {
2959     ww=ivCopy(weights);
2960     add_row_shift = ww->min_in();
2961     (*ww) -= add_row_shift;
2962  }
2963  else
2964    idHomModule(u_id,currQuotient,&ww);
2965  weights=ww;
2966
2967  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
2968  {
2969    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
2970  }
2971  else if (iiOp==SRES_CMD)
2972  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
2973    r=sySchreyer(u_id,maxl+1);
2974  else if (iiOp == LRES_CMD)
2975  {
2976    int dummy;
2977    if((currQuotient!=NULL)||
2978    (!idHomIdeal (u_id,NULL)))
2979    {
2980       WerrorS
2981       ("`lres` not implemented for inhomogeneous input or qring");
2982       return TRUE;
2983    }
2984    r=syLaScala3(u_id,&dummy);
2985  }
2986  else if (iiOp == KRES_CMD)
2987  {
2988    int dummy;
2989    if((currQuotient!=NULL)||
2990    (!idHomIdeal (u_id,NULL)))
2991    {
2992       WerrorS
2993       ("`kres` not implemented for inhomogeneous input or qring");
2994       return TRUE;
2995    }
2996    r=syKosz(u_id,&dummy);
2997  }
2998  else
2999  {
3000    int dummy;
3001    if((currQuotient!=NULL)||
3002    (!idHomIdeal (u_id,NULL)))
3003    {
3004       WerrorS
3005       ("`hres` not implemented for inhomogeneous input or qring");
3006       return TRUE;
3007    }
3008    r=syHilb(u_id,&dummy);
3009  }
3010  if (r==NULL) return TRUE;
3011  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3012  r->list_length=wmaxl;
3013  res->data=(void *)r;
3014  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3015  {
3016    intvec *w=ivCopy(r->weights[0]);
3017    if (weights!=NULL) (*w) += add_row_shift;
3018    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3019    w=NULL;
3020  }
3021  else
3022  {
3023//#if 0
3024// need to set weights for ALL components (sres)
3025    if (weights!=NULL)
3026    {
3027      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3028      r->weights = (intvec**)omAlloc0Bin(char_ptr_bin);
3029      (r->weights)[0] = ivCopy(weights);
3030    }
3031//#endif
3032  }
3033  if (ww!=NULL) { delete ww; ww=NULL; }
3034  return FALSE;
3035}
3036#else
3037static BOOLEAN jjRES(leftv res, leftv u, leftv v)
3038{
3039  int maxl=(int)(long)v->Data();
3040  if (maxl<0)
3041  {
3042    WerrorS("length for res must not be negative");
3043    return TRUE;
3044  }
3045  syStrategy r;
3046  intvec *weights=NULL;
3047  int wmaxl=maxl;
3048  ideal u_id=(ideal)u->Data();
3049
3050  maxl--;
3051  if ((maxl==-1) /*&& (iiOp!=MRES_CMD)*/)
3052  {
3053    maxl = currRing->N-1+2*(iiOp==MRES_CMD);
3054    if (currQuotient!=NULL)
3055    {
3056      Warn(
3057      "full resolution in a qring may be infinite, setting max length to %d",
3058      maxl+1);
3059    }
3060  }
3061  weights=(intvec*)atGet(u,"isHomog",INTVEC_CMD);
3062  if (weights!=NULL)
3063  {
3064    if (!idTestHomModule(u_id,currQuotient,weights))
3065    {
3066      WarnS("wrong weights given:");weights->show();PrintLn();
3067      weights=NULL;
3068    }
3069  }
3070  intvec *ww=NULL;
3071  int add_row_shift=0;
3072  if (weights!=NULL)
3073  {
3074     ww=ivCopy(weights);
3075     add_row_shift = ww->min_in();
3076     (*ww) -= add_row_shift;
3077  }
3078  if ((iiOp == RES_CMD) || (iiOp == MRES_CMD))
3079  {
3080    r=syResolution(u_id,maxl, ww, iiOp==MRES_CMD);
3081  }
3082  else if (iiOp==SRES_CMD)
3083  //  r=sySchreyerResolvente(u_id,maxl+1,&l);
3084    r=sySchreyer(u_id,maxl+1);
3085  else if (iiOp == LRES_CMD)
3086  {
3087    int dummy;
3088    if((currQuotient!=NULL)||
3089    (!idHomIdeal (u_id,NULL)))
3090    {
3091       WerrorS
3092       ("`lres` not implemented for inhomogeneous input or qring");
3093       return TRUE;
3094    }
3095    if(currRing->N == 1)
3096      WarnS("the current implementation of `lres` may not work in the case of a single variable");
3097    r=syLaScala3(u_id,&dummy);
3098  }
3099  else if (iiOp == KRES_CMD)
3100  {
3101    int dummy;
3102    if((currQuotient!=NULL)||
3103    (!idHomIdeal (u_id,NULL)))
3104    {
3105       WerrorS
3106       ("`kres` not implemented for inhomogeneous input or qring");
3107       return TRUE;
3108    }
3109    r=syKosz(u_id,&dummy);
3110  }
3111  else
3112  {
3113    int dummy;
3114    if((currQuotient!=NULL)||
3115    (!idHomIdeal (u_id,NULL)))
3116    {
3117       WerrorS
3118       ("`hres` not implemented for inhomogeneous input or qring");
3119       return TRUE;
3120    }
3121    ideal u_id_copy=idCopy(u_id);
3122    idSkipZeroes(u_id_copy);
3123    r=syHilb(u_id_copy,&dummy);
3124    idDelete(&u_id_copy);
3125  }
3126  if (r==NULL) return TRUE;
3127  //res->data=(void *)liMakeResolv(r,l,wmaxl,u->Typ(),weights);
3128  r->list_length=wmaxl;
3129  res->data=(void *)r;
3130  if ((weights!=NULL) && (ww!=NULL)) { delete ww; ww=NULL; }
3131  if ((r->weights!=NULL) && (r->weights[0]!=NULL))
3132  {
3133    ww=ivCopy(r->weights[0]);
3134    if (weights!=NULL) (*ww) += add_row_shift;
3135    atSet(res,omStrDup("isHomog"),ww,INTVEC_CMD);
3136  }
3137  else
3138  {
3139    if (weights!=NULL)
3140    {
3141      atSet(res,omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
3142    }
3143  }
3144
3145  // test the La Scala case' output
3146  assume( ((iiOp == LRES_CMD) || (iiOp == HRES_CMD)) == (r->syRing != NULL) );
3147  assume( (r->syRing != NULL) == (r->resPairs != NULL) );
3148
3149  if(iiOp != HRES_CMD)
3150    assume( (r->minres != NULL) || (r->fullres != NULL) ); // is wrong for HRES_CMD...
3151  else
3152    assume( (r->orderedRes != NULL) || (r->res != NULL) ); // analog for hres...
3153
3154  return FALSE;
3155}
3156#endif
3157static BOOLEAN jjPFAC2(leftv res, leftv u, leftv v)
3158{
3159  number n1; number n2; number temp; int i;
3160
3161  if ((u->Typ() == BIGINT_CMD) ||
3162     ((u->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3163  {
3164    temp = (number)u->Data();
3165    n1 = n_Copy(temp,coeffs_BIGINT);
3166  }
3167  else if (u->Typ() == INT_CMD)
3168  {
3169    i = (int)(long)u->Data();
3170    n1 = n_Init(i, coeffs_BIGINT);
3171  }
3172  else
3173  {
3174    WerrorS("wrong type: expected int, bigint, or number as 1st argument");
3175    return TRUE;
3176  }
3177
3178  if ((v->Typ() == BIGINT_CMD) ||
3179     ((v->Typ() == NUMBER_CMD) && rField_is_Q(currRing)))
3180  {
3181    temp = (number)v->Data();
3182    n2 = n_Copy(temp,coeffs_BIGINT);
3183  }
3184  else if (v->Typ() == INT_CMD)
3185  {
3186    i = (int)(long)v->Data();
3187    n2 = n_Init(i, coeffs_BIGINT);
3188  }
3189  else
3190  {
3191    WerrorS("wrong type: expected int, bigint, or number as 2nd argument");
3192    return TRUE;
3193  }
3194
3195  lists l = primeFactorisation(n1, n2);
3196  n_Delete(&n1, coeffs_BIGINT); n_Delete(&n2, coeffs_BIGINT);
3197  res->data = (char*)l;
3198  return FALSE;
3199}
3200static BOOLEAN jjRSUM(leftv res, leftv u, leftv v)
3201{
3202  ring r;
3203  int i=rSum((ring)u->Data(),(ring)v->Data(),r);
3204  res->data = (char *)r;
3205  return (i==-1);
3206}
3207#define SIMPL_LMDIV 32
3208#define SIMPL_LMEQ  16
3209#define SIMPL_MULT 8
3210#define SIMPL_EQU  4
3211#define SIMPL_NULL 2
3212#define SIMPL_NORM 1
3213static BOOLEAN jjSIMPL_ID(leftv res, leftv u, leftv v)
3214{
3215  int sw = (int)(long)v->Data();
3216  // CopyD for IDEAL_CMD and MODUL_CMD are identical:
3217  ideal id = (ideal)u->CopyD(IDEAL_CMD);
3218  if (sw & SIMPL_LMDIV)
3219  {
3220    id_DelDiv(id,currRing);
3221  }
3222  if (sw & SIMPL_LMEQ)
3223  {
3224    id_DelLmEquals(id,currRing);
3225  }
3226  if (sw & SIMPL_MULT)
3227  {
3228    id_DelMultiples(id,currRing);
3229  }
3230  else if(sw & SIMPL_EQU)
3231  {
3232    id_DelEquals(id,currRing);
3233  }
3234  if (sw & SIMPL_NULL)
3235  {
3236    idSkipZeroes(id);
3237  }
3238  if (sw & SIMPL_NORM)
3239  {
3240    id_Norm(id,currRing);
3241  }
3242  res->data = (char * )id;
3243  return FALSE;
3244}
3245#ifdef HAVE_FACTORY
3246extern int singclap_factorize_retry;
3247static BOOLEAN jjSQR_FREE2(leftv res, leftv u, leftv dummy)
3248{
3249  intvec *v=NULL;
3250  int sw=(int)(long)dummy->Data();
3251  int fac_sw=sw;
3252  if (sw<0) fac_sw=1;
3253  singclap_factorize_retry=0;
3254  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, fac_sw, currRing);
3255  if (f==NULL)
3256    return TRUE;
3257  switch(sw)
3258  {
3259    case 0:
3260    case 2:
3261    {
3262      lists l=(lists)omAllocBin(slists_bin);
3263      l->Init(2);
3264      l->m[0].rtyp=IDEAL_CMD;
3265      l->m[0].data=(void *)f;
3266      l->m[1].rtyp=INTVEC_CMD;
3267      l->m[1].data=(void *)v;
3268      res->data=(void *)l;
3269      res->rtyp=LIST_CMD;
3270      return FALSE;
3271    }
3272    case 1:
3273      res->data=(void *)f;
3274      return FALSE;
3275    case 3:
3276      {
3277        poly p=f->m[0];
3278        int i=IDELEMS(f);
3279        f->m[0]=NULL;
3280        while(i>1)
3281        {
3282          i--;
3283          p=pMult(p,f->m[i]);
3284          f->m[i]=NULL;
3285        }
3286        res->data=(void *)p;
3287        res->rtyp=POLY_CMD;
3288      }
3289      return FALSE;
3290  }
3291  WerrorS("invalid switch");
3292  return FALSE;
3293}
3294#endif
3295static BOOLEAN jjSTATUS2(leftv res, leftv u, leftv v)
3296{
3297  res->data = omStrDup(slStatus((si_link) u->Data(), (char *) v->Data()));
3298  return FALSE;
3299}
3300static BOOLEAN jjSTATUS2L(leftv res, leftv u, leftv v)
3301{
3302  res->data = (void *)(long)slStatusSsiL((lists) u->Data(), (int)(long) v->Data());
3303  //return (res->data== (void*)(long)-2);
3304  return FALSE;
3305}
3306static BOOLEAN jjSIMPL_P(leftv res, leftv u, leftv v)
3307{
3308  int sw = (int)(long)v->Data();
3309  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3310  poly p = (poly)u->CopyD(POLY_CMD);
3311  if (sw & SIMPL_NORM)
3312  {
3313    pNorm(p);
3314  }
3315  res->data = (char * )p;
3316  return FALSE;
3317}
3318static BOOLEAN jjSTD_HILB(leftv res, leftv u, leftv v)
3319{
3320  ideal result;
3321  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3322  tHomog hom=testHomog;
3323  ideal u_id=(ideal)(u->Data());
3324  if (w!=NULL)
3325  {
3326    if (!idTestHomModule(u_id,currQuotient,w))
3327    {
3328      WarnS("wrong weights:");w->show();PrintLn();
3329      w=NULL;
3330    }
3331    else
3332    {
3333      w=ivCopy(w);
3334      hom=isHomog;
3335    }
3336  }
3337  result=kStd(u_id,currQuotient,hom,&w,(intvec *)v->Data());
3338  idSkipZeroes(result);
3339  res->data = (char *)result;
3340  setFlag(res,FLAG_STD);
3341  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3342  return FALSE;
3343}
3344static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v);
3345static void jjSTD_1_ID(leftv res, ideal i0, int t0, ideal p0, attr a)
3346/* destroys i0, p0 */
3347/* result (with attributes) in res */
3348/* i0: SB*/
3349/* t0: type of p0*/
3350/* p0 new elements*/
3351/* a attributes of i0*/
3352{
3353  int tp;
3354  if (t0==IDEAL_CMD) tp=POLY_CMD;
3355  else               tp=VECTOR_CMD;
3356  for (int i=IDELEMS(p0)-1; i>=0; i--)
3357  {
3358    poly p=p0->m[i];
3359    p0->m[i]=NULL;
3360    if (p!=NULL)
3361    {
3362      sleftv u0,v0;
3363      memset(&u0,0,sizeof(sleftv));
3364      memset(&v0,0,sizeof(sleftv));
3365      v0.rtyp=tp;
3366      v0.data=(void*)p;
3367      u0.rtyp=t0;
3368      u0.data=i0;
3369      u0.attribute=a;
3370      setFlag(&u0,FLAG_STD);
3371      jjSTD_1(res,&u0,&v0);
3372      i0=(ideal)res->data;
3373      res->data=NULL;
3374      a=res->attribute;
3375      res->attribute=NULL;
3376      u0.CleanUp();
3377      v0.CleanUp();
3378      res->CleanUp();
3379    }
3380  }
3381  idDelete(&p0);
3382  res->attribute=a;
3383  res->data=(void *)i0;
3384  res->rtyp=t0;
3385}
3386static BOOLEAN jjSTD_1(leftv res, leftv u, leftv v)
3387{
3388  ideal result;
3389  assumeStdFlag(u);
3390  ideal i1=(ideal)(u->Data());
3391  ideal i0;
3392  int r=v->Typ();
3393  if ((/*v->Typ()*/r==POLY_CMD) ||(r==VECTOR_CMD))
3394  {
3395    i0=idInit(1,i1->rank); // TODO: rank is wrong (if v is a vector!)
3396    i0->m[0]=(poly)v->Data();
3397    int ii0=idElem(i0); /* size of i0 */
3398    i1=idSimpleAdd(i1,i0); //
3399    memset(i0->m,0,sizeof(poly)*IDELEMS(i0));
3400    idDelete(&i0);
3401    intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
3402    tHomog hom=testHomog;
3403
3404    if (w!=NULL)
3405    {
3406      if (!idTestHomModule(i1,currQuotient,w))
3407      {
3408        // no warnung: this is legal, if i in std(i,p)
3409        // is homogeneous, but p not
3410        w=NULL;
3411      }
3412      else
3413      {
3414        w=ivCopy(w);
3415        hom=isHomog;
3416      }
3417    }
3418    BITSET save1;
3419    SI_SAVE_OPT1(save1);
3420    si_opt_1|=Sy_bit(OPT_SB_1);
3421    /* ii0 appears to be the position of the first element of il that
3422       does not belong to the old SB ideal */
3423    result=kStd(i1,currQuotient,hom,&w,NULL,0,ii0);
3424    SI_RESTORE_OPT1(save1);
3425    idDelete(&i1);
3426    idSkipZeroes(result);
3427    if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
3428    res->data = (char *)result;
3429  }
3430  else /*IDEAL/MODULE*/
3431  {
3432    attr *aa=u->Attribute();
3433    attr a=NULL;
3434    if (aa!=NULL) a=(*aa)->Copy();
3435    jjSTD_1_ID(res,(ideal)u->CopyD(),r,(ideal)v->CopyD(),a);
3436  }
3437  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
3438  return FALSE;
3439}
3440static BOOLEAN jjVARSTR2(leftv res, leftv u, leftv v)
3441{
3442  idhdl h=(idhdl)u->data;
3443  int i=(int)(long)v->Data();
3444  if ((0<i) && (i<=IDRING(h)->N))
3445    res->data=omStrDup(IDRING(h)->names[i-1]);
3446  else
3447  {
3448    Werror("var number %d out of range 1..%d",i,IDRING(h)->N);
3449    return TRUE;
3450  }
3451  return FALSE;
3452}
3453static BOOLEAN jjWAIT1ST2(leftv res, leftv u, leftv v)
3454{
3455// input: u: a list with links of type
3456//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3457//        v: timeout for select in milliseconds
3458//           or 0 for polling
3459// returns: ERROR (via Werror): timeout negative
3460//           -1: the read state of all links is eof
3461//            0: timeout (or polling): none ready
3462//           i>0: (at least) L[i] is ready
3463  lists Lforks = (lists)u->Data();
3464  int t = (int)(long)v->Data();
3465  if(t < 0)
3466  {
3467    WerrorS("negative timeout"); return TRUE;
3468  }
3469  int i = slStatusSsiL(Lforks, t*1000);
3470  if(i == -2) /* error */
3471  {
3472    return TRUE;
3473  }
3474  res->data = (void*)(long)i;
3475  return FALSE;
3476}
3477static BOOLEAN jjWAITALL2(leftv res, leftv u, leftv v)
3478{
3479// input: u: a list with links of type
3480//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
3481//        v: timeout for select in milliseconds
3482//           or 0 for polling
3483// returns: ERROR (via Werror): timeout negative
3484//           -1: the read state of all links is eof
3485//           0: timeout (or polling): none ready
3486//           1: all links are ready
3487//              (caution: at least one is ready, but some maybe dead)
3488  lists Lforks = (lists)u->CopyD();
3489  int timeout = 1000*(int)(long)v->Data();
3490  if(timeout < 0)
3491  {
3492    WerrorS("negative timeout"); return TRUE;
3493  }
3494  int t = getRTimer()/TIMER_RESOLUTION;  // in seconds
3495  int i;
3496  int ret = -1;
3497  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
3498  {
3499    i = slStatusSsiL(Lforks, timeout);
3500    if(i > 0) /* Lforks[i] is ready */
3501    {
3502      ret = 1;
3503      Lforks->m[i-1].CleanUp();
3504      Lforks->m[i-1].rtyp=DEF_CMD;
3505      Lforks->m[i-1].data=NULL;
3506      timeout = si_max(0,timeout - 1000*(getRTimer()/TIMER_RESOLUTION - t));
3507    }
3508    else /* terminate the for loop */
3509    {
3510      if(i == -2) /* error */
3511      {
3512        return TRUE;
3513      }
3514      if(i == 0) /* timeout */
3515      {
3516        ret = 0;
3517      }
3518      break;
3519    }
3520  }
3521  Lforks->Clean();
3522  res->data = (void*)(long)ret;
3523  return FALSE;
3524}
3525static BOOLEAN jjWEDGE(leftv res, leftv u, leftv v)
3526{
3527  res->data = (char *)mp_Wedge((matrix)u->Data(),(int)(long)v->Data(),currRing);
3528  return FALSE;
3529}
3530#define jjWRONG2 (proc2)jjWRONG
3531#define jjWRONG3 (proc3)jjWRONG
3532static BOOLEAN jjWRONG(leftv, leftv)
3533{
3534  return TRUE;
3535}
3536
3537/*=================== operations with 1 arg.: static proc =================*/
3538/* must be ordered: first operations for chars (infix ops),
3539 * then alphabetically */
3540
3541static BOOLEAN jjDUMMY(leftv res, leftv u)
3542{
3543  res->data = (char *)u->CopyD();
3544  return FALSE;
3545}
3546static BOOLEAN jjNULL(leftv, leftv)
3547{
3548  return FALSE;
3549}
3550//static BOOLEAN jjPLUSPLUS(leftv res, leftv u)
3551//{
3552//  res->data = (char *)((int)(long)u->Data()+1);
3553//  return FALSE;
3554//}
3555//static BOOLEAN jjMINUSMINUS(leftv res, leftv u)
3556//{
3557//  res->data = (char *)((int)(long)u->Data()-1);
3558//  return FALSE;
3559//}
3560static BOOLEAN jjPLUSPLUS(leftv, leftv u)
3561{
3562  if (IDTYP((idhdl)u->data)==INT_CMD)
3563  {
3564    int i=IDINT((idhdl)u->data);
3565    if (iiOp==PLUSPLUS) i++;
3566    else                i--;
3567    IDDATA((idhdl)u->data)=(char *)(long)i;
3568    return FALSE;
3569  }
3570  return TRUE;
3571}
3572static BOOLEAN jjUMINUS_BI(leftv res, leftv u)
3573{
3574  number n=(number)u->CopyD(BIGINT_CMD);
3575  n=n_Neg(n,coeffs_BIGINT);
3576  res->data = (char *)n;
3577  return FALSE;
3578}
3579static BOOLEAN jjUMINUS_I(leftv res, leftv u)
3580{
3581  res->data = (char *)(-(long)u->Data());
3582  return FALSE;
3583}
3584static BOOLEAN jjUMINUS_N(leftv res, leftv u)
3585{
3586  number n=(number)u->CopyD(NUMBER_CMD);
3587  n=nNeg(n);
3588  res->data = (char *)n;
3589  return FALSE;
3590}
3591static BOOLEAN jjUMINUS_P(leftv res, leftv u)
3592{
3593  res->data = (char *)pNeg((poly)u->CopyD(POLY_CMD));
3594  return FALSE;
3595}
3596static BOOLEAN jjUMINUS_MA(leftv res, leftv u)
3597{
3598  poly m1=pISet(-1);
3599  res->data = (char *)mp_MultP((matrix)u->CopyD(MATRIX_CMD),m1,currRing);
3600  return FALSE;
3601}
3602static BOOLEAN jjUMINUS_IV(leftv res, leftv u)
3603{
3604  intvec *iv=(intvec *)u->CopyD(INTVEC_CMD);
3605  (*iv)*=(-1);
3606  res->data = (char *)iv;
3607  return FALSE;
3608}
3609static BOOLEAN jjUMINUS_BIM(leftv res, leftv u)
3610{
3611  bigintmat *bim=(bigintmat *)u->CopyD(BIGINTMAT_CMD);
3612  (*bim)*=(-1);
3613  res->data = (char *)bim;
3614  return FALSE;
3615}
3616static BOOLEAN jjPROC1(leftv res, leftv u)
3617{
3618  return jjPROC(res,u,NULL);
3619}
3620static BOOLEAN jjBAREISS(leftv res, leftv v)
3621{
3622  //matrix m=(matrix)v->Data();
3623  //lists l=mpBareiss(m,FALSE);
3624  intvec *iv;
3625  ideal m;
3626  sm_CallBareiss((ideal)v->Data(),0,0,m,&iv, currRing);
3627  lists l=(lists)omAllocBin(slists_bin);
3628  l->Init(2);
3629  l->m[0].rtyp=MODUL_CMD;
3630  l->m[1].rtyp=INTVEC_CMD;
3631  l->m[0].data=(void *)m;
3632  l->m[1].data=(void *)iv;
3633  res->data = (char *)l;
3634  return FALSE;
3635}
3636//static BOOLEAN jjBAREISS_IM(leftv res, leftv v)
3637//{
3638//  intvec *m=(intvec *)v->CopyD(INTMAT_CMD);
3639//  ivTriangMat(m);
3640//  res->data = (char *)m;
3641//  return FALSE;
3642//}
3643static BOOLEAN jjBI2N(leftv res, leftv u)
3644{
3645  BOOLEAN bo=FALSE;
3646  number n=(number)u->CopyD();
3647  nMapFunc nMap=n_SetMap(coeffs_BIGINT,currRing->cf);
3648  if (nMap!=NULL)
3649    res->data=nMap(n,coeffs_BIGINT,currRing->cf);
3650  else
3651  {
3652    WerrorS("cannot convert bigint to this field");
3653    bo=TRUE;
3654  }
3655  n_Delete(&n,coeffs_BIGINT);
3656  return bo;
3657}
3658static BOOLEAN jjBI2P(leftv res, leftv u)
3659{
3660  sleftv tmp;
3661  BOOLEAN bo=jjBI2N(&tmp,u);
3662  if (!bo)
3663  {
3664    number n=(number) tmp.data;
3665    if (nIsZero(n)) { res->data=NULL;nDelete(&n); }
3666    else
3667    {
3668      res->data=(void *)pNSet(n);
3669    }
3670  }
3671  return bo;
3672}
3673static BOOLEAN jjCALL1MANY(leftv res, leftv u)
3674{
3675  return iiExprArithM(res,u,iiOp);
3676}
3677static BOOLEAN jjCHAR(leftv res, leftv v)
3678{
3679  res->data = (char *)(long)rChar((ring)v->Data());
3680  return FALSE;
3681}
3682static BOOLEAN jjCOLS(leftv res, leftv v)
3683{
3684  res->data = (char *)(long)MATCOLS((matrix)(v->Data()));
3685  return FALSE;
3686}
3687static BOOLEAN jjCOLS_BIM(leftv res, leftv v)
3688{
3689  res->data = (char *)(long)((bigintmat*)(v->Data()))->cols();
3690  return FALSE;
3691}
3692static BOOLEAN jjCOLS_IV(leftv res, leftv v)
3693{
3694  res->data = (char *)(long)((intvec*)(v->Data()))->cols();
3695  return FALSE;
3696}
3697static BOOLEAN jjCONTENT(leftv res, leftv v)
3698{
3699  // CopyD for POLY_CMD and VECTOR_CMD are identical:
3700  poly p=(poly)v->CopyD(POLY_CMD);
3701  if (p!=NULL) p_Cleardenom(p, currRing);
3702  res->data = (char *)p;
3703  return FALSE;
3704}
3705static BOOLEAN jjCOUNT_BI(leftv res, leftv v)
3706{
3707  res->data = (char *)(long)n_Size((number)v->Data(),coeffs_BIGINT);
3708  return FALSE;
3709}
3710static BOOLEAN jjCOUNT_N(leftv res, leftv v)
3711{
3712  res->data = (char *)(long)nSize((number)v->Data());
3713  return FALSE;
3714}
3715static BOOLEAN jjCOUNT_L(leftv res, leftv v)
3716{
3717  lists l=(lists)v->Data();
3718  res->data = (char *)(long)(lSize(l)+1);
3719  return FALSE;
3720}
3721static BOOLEAN jjCOUNT_M(leftv res, leftv v)
3722{
3723  matrix m=(matrix)v->Data();
3724  res->data = (char *)(long)(MATROWS(m)*MATCOLS(m));
3725  return FALSE;
3726}
3727static BOOLEAN jjCOUNT_IV(leftv res, leftv v)
3728{
3729  res->data = (char *)(long)((intvec*)(v->Data()))->length();
3730  return FALSE;
3731}
3732static BOOLEAN jjCOUNT_RG(leftv res, leftv v)
3733{
3734  ring r=(ring)v->Data();
3735  int elems=-1;
3736  if (rField_is_Zp(r)||rField_is_GF(r)) elems=r->cf->ch;
3737  else if (rField_is_Zp_a(r) && (r->cf->type==n_algExt))
3738  {
3739#ifdef HAVE_FACTORY
3740    extern int ipower ( int b, int n ); /* factory/cf_util */
3741    elems=ipower(r->cf->ch,r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3742#else
3743    elems=(int)pow((double) r->cf->ch,(double)r->cf->extRing->pFDeg(r->cf->extRing->qideal->m[0],r->cf->extRing));
3744#endif
3745  }
3746  res->data = (char *)(long)elems;
3747  return FALSE;
3748}
3749static BOOLEAN jjDEG(leftv res, leftv v)
3750{
3751  int dummy;
3752  poly p=(poly)v->Data();
3753  if (p!=NULL) res->data = (char *)currRing->pLDeg(p,&dummy,currRing);
3754  else res->data=(char *)-1;
3755  return FALSE;
3756}
3757static BOOLEAN jjDEG_M(leftv res, leftv u)
3758{
3759  ideal I=(ideal)u->Data();
3760  int d=-1;
3761  int dummy;
3762  int i;
3763  for(i=IDELEMS(I)-1;i>=0;i--)
3764    if (I->m[i]!=NULL) d=si_max(d,(int)currRing->pLDeg(I->m[i],&dummy,currRing));
3765  res->data = (char *)(long)d;
3766  return FALSE;
3767}
3768static BOOLEAN jjDEGREE(leftv res, leftv v)
3769{
3770  SPrintStart();
3771#ifdef HAVE_RINGS
3772  if (rField_is_Ring_Z(currRing))
3773  {
3774    ring origR = currRing;
3775    ring tempR = rCopy(origR);
3776    coeffs new_cf=nInitChar(n_Q,NULL);
3777    nKillChar(tempR->cf);
3778    tempR->cf=new_cf;
3779    rComplete(tempR);
3780    ideal vid = (ideal)v->Data();
3781    rChangeCurrRing(tempR);
3782    ideal vv = idrCopyR(vid, origR, currRing);
3783    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
3784    vvAsLeftv.rtyp = IDEAL_CMD;
3785    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
3786    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
3787    assumeStdFlag(&vvAsLeftv);
3788    Print("// NOTE: computation of degree is being performed for\n");
3789    Print("//       generic fibre, that is, over Q\n");
3790    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
3791    scDegree(vv,module_w,currQuotient);
3792    idDelete(&vv);
3793    rChangeCurrRing(origR);
3794    rDelete(tempR);
3795  }
3796#endif
3797  assumeStdFlag(v);
3798  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
3799  scDegree((ideal)v->Data(),module_w,currQuotient);
3800  char *s=SPrintEnd();
3801  int l=strlen(s)-1;
3802  s[l]='\0';
3803  res->data=(void*)s;
3804  return FALSE;
3805}
3806static BOOLEAN jjDEFINED(leftv res, leftv v)
3807{
3808  if ((v->rtyp==IDHDL)
3809  && ((myynest==IDLEV((idhdl)v->data))||(0==IDLEV((idhdl)v->data))))
3810  {
3811    res->data=(void *)(long)(IDLEV((idhdl)v->data)+1);
3812  }
3813  else if (v->rtyp!=0) res->data=(void *)(-1);
3814  return FALSE;
3815}
3816
3817/// Return the denominator of the input number
3818/// NOTE: the input number is normalized as a side effect
3819static BOOLEAN jjDENOMINATOR(leftv res, leftv v)
3820{
3821  number n = reinterpret_cast<number>(v->Data());
3822  res->data = reinterpret_cast<void*>(n_GetDenom(n, currRing));
3823  return FALSE;
3824}
3825
3826/// Return the numerator of the input number
3827/// NOTE: the input number is normalized as a side effect
3828static BOOLEAN jjNUMERATOR(leftv res, leftv v)
3829{
3830  number n = reinterpret_cast<number>(v->Data());
3831  res->data = reinterpret_cast<void*>(n_GetNumerator(n, currRing));
3832  return FALSE;
3833}
3834
3835
3836
3837
3838#ifdef HAVE_FACTORY
3839static BOOLEAN jjDET(leftv res, leftv v)
3840{
3841  matrix m=(matrix)v->Data();
3842  poly p;
3843  if (sm_CheckDet((ideal)m,m->cols(),TRUE, currRing))
3844  {
3845    ideal I=id_Matrix2Module(mp_Copy(m, currRing),currRing);
3846    p=sm_CallDet(I, currRing);
3847    idDelete(&I);
3848  }
3849  else
3850    p=singclap_det(m,currRing);
3851  res ->data = (char *)p;
3852  return FALSE;
3853}
3854static BOOLEAN jjDET_BI(leftv res, leftv v)
3855{
3856  bigintmat * m=(bigintmat*)v->Data();
3857  int i,j;
3858  i=m->rows();j=m->cols();
3859  if(i==j)
3860    res->data = (char *)(long)singclap_det_bi(m,coeffs_BIGINT);
3861  else
3862  {
3863    Werror("det of %d x %d bigintmat",i,j);
3864    return TRUE;
3865  }
3866  return FALSE;
3867}
3868static BOOLEAN jjDET_I(leftv res, leftv v)
3869{
3870  intvec * m=(intvec*)v->Data();
3871  int i,j;
3872  i=m->rows();j=m->cols();
3873  if(i==j)
3874    res->data = (char *)(long)singclap_det_i(m,currRing);
3875  else
3876  {
3877    Werror("det of %d x %d intmat",i,j);
3878    return TRUE;
3879  }
3880  return FALSE;
3881}
3882static BOOLEAN jjDET_S(leftv res, leftv v)
3883{
3884  ideal I=(ideal)v->Data();
3885  poly p;
3886  if (IDELEMS(I)<1) return TRUE;
3887  if (sm_CheckDet(I,IDELEMS(I),FALSE, currRing))
3888  {
3889    matrix m=id_Module2Matrix(id_Copy(I,currRing),currRing);
3890    p=singclap_det(m,currRing);
3891    idDelete((ideal *)&m);
3892  }
3893  else
3894    p=sm_CallDet(I, currRing);
3895  res->data = (char *)p;
3896  return FALSE;
3897}
3898#endif
3899static BOOLEAN jjDIM(leftv res, leftv v)
3900{
3901  assumeStdFlag(v);
3902#ifdef HAVE_RINGS
3903  if (rField_is_Ring(currRing))
3904  {
3905    //ring origR = currRing;
3906    //ring tempR = rCopy(origR);
3907    //coeffs new_cf=nInitChar(n_Q,NULL);
3908    //nKillChar(tempR->cf);
3909    //tempR->cf=new_cf;
3910    //rComplete(tempR);
3911    ideal vid = (ideal)v->Data();
3912    int i = idPosConstant(vid);
3913    if ((i != -1) && (n_IsUnit(pGetCoeff(vid->m[i]),currRing->cf)))
3914    { /* ideal v contains unit; dim = -1 */
3915      res->data = (char *)-1;
3916      return FALSE;
3917    }
3918    //rChangeCurrRing(tempR);
3919    //ideal vv = idrCopyR(vid, origR, currRing);
3920    ideal vv = id_Head(vid,currRing);
3921    /* drop degree zero generator from vv (if any) */
3922    if (i != -1) pDelete(&vv->m[i]);
3923    long d = (long)scDimInt(vv, currQuotient);
3924    if (rField_is_Ring_Z(currRing) && (i == -1)) d++;
3925    res->data = (char *)d;
3926    idDelete(&vv);
3927    //rChangeCurrRing(origR);
3928    //rDelete(tempR);
3929    return FALSE;
3930  }
3931#endif
3932  res->data = (char *)(long)scDimInt((ideal)(v->Data()),currQuotient);
3933  return FALSE;
3934}
3935static BOOLEAN jjDUMP(leftv, leftv v)
3936{
3937  si_link l = (si_link)v->Data();
3938  if (slDump(l))
3939  {
3940    const char *s;
3941    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
3942    else                            s=sNoName;
3943    Werror("cannot dump to `%s`",s);
3944    return TRUE;
3945  }
3946  else
3947    return FALSE;
3948}
3949static BOOLEAN jjE(leftv res, leftv v)
3950{
3951  res->data = (char *)pOne();
3952  int co=(int)(long)v->Data();
3953  if (co>0)
3954  {
3955    pSetComp((poly)res->data,co);
3956    pSetm((poly)res->data);
3957  }
3958  else WerrorS("argument of gen must be positive");
3959  return (co<=0);
3960}
3961static BOOLEAN jjEXECUTE(leftv, leftv v)
3962{
3963  char * d = (char *)v->Data();
3964  char * s = (char *)omAlloc(strlen(d) + 13);
3965  strcpy( s, (char *)d);
3966  strcat( s, "\n;RETURN();\n");
3967  newBuffer(s,BT_execute);
3968  return yyparse();
3969}
3970#ifdef HAVE_FACTORY
3971static BOOLEAN jjFACSTD(leftv res, leftv v)
3972{
3973  lists L=(lists)omAllocBin(slists_bin);
3974  if (rField_is_Zp(currRing)
3975  || rField_is_Q(currRing)
3976  || rField_is_Zp_a(currRing)
3977  || rField_is_Q_a(currRing))
3978  {
3979    ideal_list p,h;
3980    h=kStdfac((ideal)v->Data(),NULL,testHomog,NULL);
3981    if (h==NULL)
3982    {
3983      L->Init(1);
3984      L->m[0].data=(char *)idInit(1);
3985      L->m[0].rtyp=IDEAL_CMD;
3986    }
3987    else
3988    {
3989      p=h;
3990      int l=0;
3991      while (p!=NULL) { p=p->next;l++; }
3992      L->Init(l);
3993      l=0;
3994      while(h!=NULL)
3995      {
3996        L->m[l].data=(char *)h->d;
3997        L->m[l].rtyp=IDEAL_CMD;
3998        p=h->next;
3999        omFreeSize(h,sizeof(*h));
4000        h=p;
4001        l++;
4002      }
4003    }
4004  }
4005  else
4006  {
4007    WarnS("no factorization implemented");
4008    L->Init(1);
4009    iiExprArith1(&(L->m[0]),v,STD_CMD);
4010  }
4011  res->data=(void *)L;
4012  return FALSE;
4013}
4014static BOOLEAN jjFAC_P(leftv res, leftv u)
4015{
4016  intvec *v=NULL;
4017  singclap_factorize_retry=0;
4018  ideal f=singclap_factorize((poly)(u->CopyD()), &v, 0,currRing);
4019  if (f==NULL) return TRUE;
4020  ivTest(v);
4021  lists l=(lists)omAllocBin(slists_bin);
4022  l->Init(2);
4023  l->m[0].rtyp=IDEAL_CMD;
4024  l->m[0].data=(void *)f;
4025  l->m[1].rtyp=INTVEC_CMD;
4026  l->m[1].data=(void *)v;
4027  res->data=(void *)l;
4028  return FALSE;
4029}
4030#endif
4031static BOOLEAN jjGETDUMP(leftv, leftv v)
4032{
4033  si_link l = (si_link)v->Data();
4034  if (slGetDump(l))
4035  {
4036    const char *s;
4037    if ((l!=NULL)&&(l->name!=NULL)) s=l->name;
4038    else                            s=sNoName;
4039    Werror("cannot get dump from `%s`",s);
4040    return TRUE;
4041  }
4042  else
4043    return FALSE;
4044}
4045static BOOLEAN jjHIGHCORNER(leftv res, leftv v)
4046{
4047  assumeStdFlag(v);
4048  ideal I=(ideal)v->Data();
4049  res->data=(void *)iiHighCorner(I,0);
4050  return FALSE;
4051}
4052static BOOLEAN jjHIGHCORNER_M(leftv res, leftv v)
4053{
4054  assumeStdFlag(v);
4055  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4056  BOOLEAN delete_w=FALSE;
4057  ideal I=(ideal)v->Data();
4058  int i;
4059  poly p=NULL,po=NULL;
4060  int rk=id_RankFreeModule(I,currRing);
4061  if (w==NULL)
4062  {
4063    w = new intvec(rk);
4064    delete_w=TRUE;
4065  }
4066  for(i=rk;i>0;i--)
4067  {
4068    p=iiHighCorner(I,i);
4069    if (p==NULL)
4070    {
4071      WerrorS("module must be zero-dimensional");
4072      if (delete_w) delete w;
4073      return TRUE;
4074    }
4075    if (po==NULL)
4076    {
4077      po=p;
4078    }
4079    else
4080    {
4081      // now po!=NULL, p!=NULL
4082      int d=(currRing->pFDeg(po,currRing)-(*w)[pGetComp(po)-1] - currRing->pFDeg(p,currRing)+(*w)[i-1]);
4083      if (d==0)
4084        d=pLmCmp(po,p);
4085      if (d > 0)
4086      {
4087        pDelete(&p);
4088      }
4089      else // (d < 0)
4090      {
4091        pDelete(&po); po=p;
4092      }
4093    }
4094  }
4095  if (delete_w) delete w;
4096  res->data=(void *)po;
4097  return FALSE;
4098}
4099static BOOLEAN jjHILBERT(leftv, leftv v)
4100{
4101#ifdef HAVE_RINGS
4102  if (rField_is_Ring_Z(currRing))
4103  {
4104    ring origR = currRing;
4105    ring tempR = rCopy(origR);
4106    coeffs new_cf=nInitChar(n_Q,NULL);
4107    nKillChar(tempR->cf);
4108    tempR->cf=new_cf;
4109    rComplete(tempR);
4110    ideal vid = (ideal)v->Data();
4111    rChangeCurrRing(tempR);
4112    ideal vv = idrCopyR(vid, origR, currRing);
4113    sleftv vvAsLeftv; memset(&vvAsLeftv, 0, sizeof(vvAsLeftv));
4114    vvAsLeftv.rtyp = IDEAL_CMD;
4115    vvAsLeftv.data = vv; vvAsLeftv.next = NULL;
4116    if (hasFlag(v, FLAG_STD)) setFlag(&vvAsLeftv,FLAG_STD);
4117    assumeStdFlag(&vvAsLeftv);
4118    Print("// NOTE: computation of Hilbert series etc. is being\n");
4119    Print("//       performed for generic fibre, that is, over Q\n");
4120    intvec *module_w=(intvec*)atGet(&vvAsLeftv,"isHomog",INTVEC_CMD);
4121    //scHilbertPoly(vv,currQuotient);
4122    hLookSeries(vv,module_w,currQuotient);
4123    idDelete(&vv);
4124    rChangeCurrRing(origR);
4125    rDelete(tempR);
4126    return FALSE;
4127  }
4128#endif
4129  assumeStdFlag(v);
4130  intvec *module_w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4131  //scHilbertPoly((ideal)v->Data(),currQuotient);
4132  hLookSeries((ideal)v->Data(),module_w,currQuotient);
4133  return FALSE;
4134}
4135static BOOLEAN jjHILBERT_IV(leftv res, leftv v)
4136{
4137#ifdef HAVE_RINGS
4138  if (rField_is_Ring_Z(currRing))
4139  {
4140    Print("// NOTE: computation of Hilbert series etc. is being\n");
4141    Print("//       performed for generic fibre, that is, over Q\n");
4142  }
4143#endif
4144  res->data=(void *)hSecondSeries((intvec *)v->Data());
4145  return FALSE;
4146}
4147static BOOLEAN jjHOMOG1(leftv res, leftv v)
4148{
4149  intvec *w=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4150  ideal v_id=(ideal)v->Data();
4151  if (w==NULL)
4152  {
4153    res->data=(void *)(long)idHomModule(v_id,currQuotient,&w);
4154    if (res->data!=NULL)
4155    {
4156      if (v->rtyp==IDHDL)
4157      {
4158        char *s_isHomog=omStrDup("isHomog");
4159        if (v->e==NULL)
4160          atSet((idhdl)(v->data),s_isHomog,w,INTVEC_CMD);
4161        else
4162          atSet((idhdl)(v->LData()),s_isHomog,w,INTVEC_CMD);
4163      }
4164      else if (w!=NULL) delete w;
4165    } // if res->data==NULL then w==NULL
4166  }
4167  else
4168  {
4169    res->data=(void *)(long)idTestHomModule(v_id,currQuotient,w);
4170    if((res->data==NULL) && (v->rtyp==IDHDL))
4171    {
4172      if (v->e==NULL)
4173        atKill((idhdl)(v->data),"isHomog");
4174      else
4175        atKill((idhdl)(v->LData()),"isHomog");
4176    }
4177  }
4178  return FALSE;
4179}
4180static BOOLEAN jjidMaxIdeal(leftv res, leftv v)
4181{
4182  res->data = (char *)idMaxIdeal((int)(long)v->Data());
4183  setFlag(res,FLAG_STD);
4184  return FALSE;
4185}
4186static BOOLEAN jjIDEAL_Ma(leftv res, leftv v)
4187{
4188  matrix mat=(matrix)v->CopyD(MATRIX_CMD);
4189  IDELEMS((ideal)mat)=MATCOLS(mat)*MATROWS(mat);
4190  if (IDELEMS((ideal)mat)==0)
4191  {
4192    idDelete((ideal *)&mat);
4193    mat=(matrix)idInit(1,1);
4194  }
4195  else
4196  {
4197    MATROWS(mat)=1;
4198    mat->rank=1;
4199    idTest((ideal)mat);
4200  }
4201  res->data=(char *)mat;
4202  return FALSE;
4203}
4204static BOOLEAN jjIDEAL_Map(leftv res, leftv v)
4205{
4206  map m=(map)v->CopyD(MAP_CMD);
4207  omFree((ADDRESS)m->preimage);
4208  m->preimage=NULL;
4209  ideal I=(ideal)m;
4210  I->rank=1;
4211  res->data=(char *)I;
4212  return FALSE;
4213}
4214static BOOLEAN jjIDEAL_R(leftv res, leftv v)
4215{
4216  if (currRing!=NULL)
4217  {
4218    ring q=(ring)v->Data();
4219    if (rSamePolyRep(currRing, q))
4220    {
4221      if (q->qideal==NULL)
4222        res->data=(char *)idInit(1,1);
4223      else
4224        res->data=(char *)idCopy(q->qideal);
4225      return FALSE;
4226    }
4227  }
4228  WerrorS("can only get ideal from identical qring");
4229  return TRUE;
4230}
4231static BOOLEAN jjIm2Iv(leftv res, leftv v)
4232{
4233  intvec *iv = (intvec *)v->CopyD(INTMAT_CMD);
4234  iv->makeVector();
4235  res->data = iv;
4236  return FALSE;
4237}
4238static BOOLEAN jjIMPART(leftv res, leftv v)
4239{
4240  res->data = (char *)n_ImPart((number)v->Data(),currRing->cf);
4241  return FALSE;
4242}
4243static BOOLEAN jjINDEPSET(leftv res, leftv v)
4244{
4245  assumeStdFlag(v);
4246  res->data=(void *)scIndIntvec((ideal)(v->Data()),currQuotient);
4247  return FALSE;
4248}
4249static BOOLEAN jjINTERRED(leftv res, leftv v)
4250{
4251  ideal result=kInterRed((ideal)(v->Data()), currQuotient);
4252  if (TEST_OPT_PROT) { PrintLn(); mflush(); }
4253  res->data = result;
4254  return FALSE;
4255}
4256static BOOLEAN jjIS_RINGVAR_P(leftv res, leftv v)
4257{
4258  res->data = (char *)(long)pVar((poly)v->Data());
4259  return FALSE;
4260}
4261static BOOLEAN jjIS_RINGVAR_S(leftv res, leftv v)
4262{
4263  res->data = (char *)(long)(r_IsRingVar((char *)v->Data(), currRing)+1);
4264  return FALSE;
4265}
4266static BOOLEAN jjIS_RINGVAR0(leftv res, leftv)
4267{
4268  res->data = (char *)0;
4269  return FALSE;
4270}
4271static BOOLEAN jjJACOB_P(leftv res, leftv v)
4272{
4273  ideal i=idInit(currRing->N,1);
4274  int k;
4275  poly p=(poly)(v->Data());
4276  for (k=currRing->N;k>0;k--)
4277  {
4278    i->m[k-1]=pDiff(p,k);
4279  }
4280  res->data = (char *)i;
4281  return FALSE;
4282}
4283/*2
4284 * compute Jacobi matrix of a module/matrix
4285 * Jacobi(M) := ( diff(Mt,var(1))|, ... ,| diff(Mt,var(currRing->N))  ),
4286 * where Mt := transpose(M)
4287 * Note that this is consistent with the current conventions for jacob in Singular,
4288 * whereas M2 computes its transposed.
4289 */
4290static BOOLEAN jjJACOB_M(leftv res, leftv a)
4291{
4292  ideal id = (ideal)a->Data();
4293  id = idTransp(id);
4294  int W = IDELEMS(id);
4295
4296  ideal result = idInit(W * currRing->N, id->rank);
4297  poly *p = result->m;
4298
4299  for( int v = 1; v <= currRing->N; v++ )
4300  {
4301    poly* q = id->m;
4302    for( int i = 0; i < W; i++, p++, q++ )
4303      *p = pDiff( *q, v );
4304  }
4305  idDelete(&id);
4306
4307  res->data = (char *)result;
4308  return FALSE;
4309}
4310
4311
4312static BOOLEAN jjKBASE(leftv res, leftv v)
4313{
4314  assumeStdFlag(v);
4315  res->data = (char *)scKBase(-1,(ideal)(v->Data()),currQuotient);
4316  return FALSE;
4317}
4318#ifdef MDEBUG
4319static BOOLEAN jjpHead(leftv res, leftv v)
4320{
4321  res->data=(char *)pHead((poly)v->Data());
4322  return FALSE;
4323}
4324#endif
4325static BOOLEAN jjL2R(leftv res, leftv v)
4326{
4327  res->data=(char *)syConvList((lists)v->Data(),FALSE);
4328  if (res->data != NULL)
4329    return FALSE;
4330  else
4331    return TRUE;
4332}
4333static BOOLEAN jjLEADCOEF(leftv res, leftv v)
4334{
4335  poly p=(poly)v->Data();
4336  if (p==NULL)
4337  {
4338    res->data=(char *)nInit(0);
4339  }
4340  else
4341  {
4342    res->data=(char *)nCopy(pGetCoeff(p));
4343  }
4344  return FALSE;
4345}
4346static BOOLEAN jjLEADEXP(leftv res, leftv v)
4347{
4348  poly p=(poly)v->Data();
4349  int s=currRing->N;
4350  if (v->Typ()==VECTOR_CMD) s++;
4351  intvec *iv=new intvec(s);
4352  if (p!=NULL)
4353  {
4354    for(int i = currRing->N;i;i--)
4355    {
4356      (*iv)[i-1]=pGetExp(p,i);
4357    }
4358    if (s!=currRing->N)
4359      (*iv)[currRing->N]=pGetComp(p);
4360  }
4361  res->data=(char *)iv;
4362  return FALSE;
4363}
4364static BOOLEAN jjLEADMONOM(leftv res, leftv v)
4365{
4366  poly p=(poly)v->Data();
4367  if (p == NULL)
4368  {
4369    res->data = (char*) NULL;
4370  }
4371  else
4372  {
4373    poly lm = pLmInit(p);
4374    pSetCoeff(lm, nInit(1));
4375    res->data = (char*) lm;
4376  }
4377  return FALSE;
4378}
4379static BOOLEAN jjLOAD1(leftv res, leftv v)
4380{
4381  return jjLOAD(res, v,FALSE);
4382}
4383static BOOLEAN jjLISTRING(leftv res, leftv v)
4384{
4385  ring r=rCompose((lists)v->Data());
4386  if (r==NULL) return TRUE;
4387  if (r->qideal!=NULL) res->rtyp=QRING_CMD;
4388  res->data=(char *)r;
4389  return FALSE;
4390}
4391#if SIZEOF_LONG == 8
4392static number jjLONG2N(long d)
4393{
4394  int i=(int)d;
4395  if ((long)i == d)
4396  {
4397    return n_Init(i, coeffs_BIGINT);
4398  }
4399  else
4400  {
4401     struct snumber_dummy
4402     {
4403      mpz_t z;
4404      mpz_t n;
4405      #if defined(LDEBUG)
4406      int debug;
4407      #endif
4408      BOOLEAN s;
4409    };
4410    typedef struct snumber_dummy  *number_dummy;
4411
4412    number_dummy z=(number_dummy)omAlloc(sizeof(snumber_dummy));
4413    #if defined(LDEBUG)
4414    z->debug=123456;
4415    #endif
4416    z->s=3;
4417    mpz_init_set_si(z->z,d);
4418    return (number)z;
4419  }
4420}
4421#else
4422#define jjLONG2N(D) n_Init((int)D, coeffs_BIGINT)
4423#endif
4424static BOOLEAN jjPFAC1(leftv res, leftv v)
4425{
4426  /* call method jjPFAC2 with second argument = 0 (meaning that no
4427     valid bound for the prime factors has been given) */
4428  sleftv tmp;
4429  memset(&tmp, 0, sizeof(tmp));
4430  tmp.rtyp = INT_CMD;
4431  return jjPFAC2(res, v, &tmp);
4432}
4433static BOOLEAN jjLU_DECOMP(leftv res, leftv v)
4434{
4435  /* computes the LU-decomposition of a matrix M;
4436     i.e., M = P * L * U, where
4437        - P is a row permutation matrix,
4438        - L is in lower triangular form,
4439        - U is in upper row echelon form
4440     Then, we also have P * M = L * U.
4441     A list [P, L, U] is returned. */
4442  matrix mat = (const matrix)v->Data();
4443  if (!idIsConstant((ideal)mat))
4444  {
4445    WerrorS("matrix must be constant");
4446    return TRUE;
4447  }
4448  matrix pMat;
4449  matrix lMat;
4450  matrix uMat;
4451
4452  luDecomp(mat, pMat, lMat, uMat);
4453
4454  lists ll = (lists)omAllocBin(slists_bin);
4455  ll->Init(3);
4456  ll->m[0].rtyp=MATRIX_CMD; ll->m[0].data=(void *)pMat;
4457  ll->m[1].rtyp=MATRIX_CMD; ll->m[1].data=(void *)lMat;
4458  ll->m[2].rtyp=MATRIX_CMD; ll->m[2].data=(void *)uMat;
4459  res->data=(char*)ll;
4460
4461  return FALSE;
4462}
4463static BOOLEAN jjMEMORY(leftv res, leftv v)
4464{
4465  omUpdateInfo();
4466  switch(((int)(long)v->Data()))
4467  {
4468  case 0:
4469    res->data=(char *)jjLONG2N(om_Info.UsedBytes);
4470    break;
4471  case 1:
4472    res->data = (char *)jjLONG2N(om_Info.CurrentBytesSystem);
4473    break;
4474  case 2:
4475    res->data = (char *)jjLONG2N(om_Info.MaxBytesSystem);
4476    break;
4477  default:
4478    omPrintStats(stdout);
4479    omPrintInfo(stdout);
4480    omPrintBinStats(stdout);
4481    res->data = (char *)0;
4482    res->rtyp = NONE;
4483  }
4484  return FALSE;
4485  res->data = (char *)0;
4486  return FALSE;
4487}
4488//static BOOLEAN jjMONITOR1(leftv res, leftv v)
4489//{
4490//  return jjMONITOR2(res,v,NULL);
4491//}
4492static BOOLEAN jjMSTD(leftv res, leftv v)
4493{
4494  int t=v->Typ();
4495  ideal r,m;
4496  r=kMin_std((ideal)v->Data(),currQuotient,testHomog,NULL,m);
4497  lists l=(lists)omAllocBin(slists_bin);
4498  l->Init(2);
4499  l->m[0].rtyp=t;
4500  l->m[0].data=(char *)r;
4501  setFlag(&(l->m[0]),FLAG_STD);
4502  l->m[1].rtyp=t;
4503  l->m[1].data=(char *)m;
4504  res->data=(char *)l;
4505  return FALSE;
4506}
4507static BOOLEAN jjMULT(leftv res, leftv v)
4508{
4509  assumeStdFlag(v);
4510  res->data = (char *)(long)scMultInt((ideal)(v->Data()),currQuotient);
4511  return FALSE;
4512}
4513static BOOLEAN jjMINRES_R(leftv res, leftv v)
4514{
4515  intvec *weights=(intvec*)atGet(v,"isHomog",INTVEC_CMD);
4516
4517  syStrategy tmp=(syStrategy)v->Data();
4518  tmp = syMinimize(tmp); // enrich itself!
4519
4520  res->data=(char *)tmp;
4521
4522  if (weights!=NULL)
4523    atSet(res, omStrDup("isHomog"),ivCopy(weights),INTVEC_CMD);
4524
4525  return FALSE;
4526}
4527static BOOLEAN jjN2BI(leftv res, leftv v)
4528{
4529  number n,i; i=(number)v->Data();
4530  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4531  if (nMap!=NULL)
4532    n=nMap(i,currRing->cf,coeffs_BIGINT);
4533  else goto err;
4534  res->data=(void *)n;
4535  return FALSE;
4536err:
4537  WerrorS("cannot convert to bigint"); return TRUE;
4538}
4539static BOOLEAN jjNAMEOF(leftv res, leftv v)
4540{
4541  res->data = (char *)v->name;
4542  if (res->data==NULL) res->data=omStrDup("");
4543  v->name=NULL;
4544  return FALSE;
4545}
4546static BOOLEAN jjNAMES(leftv res, leftv v)
4547{
4548  res->data=ipNameList(((ring)v->Data())->idroot);
4549  return FALSE;
4550}
4551static BOOLEAN jjNVARS(leftv res, leftv v)
4552{
4553  res->data = (char *)(long)(((ring)(v->Data()))->N);
4554  return FALSE;
4555}
4556static BOOLEAN jjOpenClose(leftv, leftv v)
4557{
4558  si_link l=(si_link)v->Data();
4559  if (iiOp==OPEN_CMD) return slOpen(l, SI_LINK_OPEN,v);
4560  else                return slClose(l);
4561}
4562static BOOLEAN jjORD(leftv res, leftv v)
4563{
4564  poly p=(poly)v->Data();
4565  res->data=(char *)( p==NULL ? -1 : currRing->pFDeg(p,currRing) );
4566  return FALSE;
4567}
4568static BOOLEAN jjPAR1(leftv res, leftv v)
4569{
4570  int i=(int)(long)v->Data();
4571  int p=0;
4572  p=rPar(currRing);
4573  if ((0<i) && (i<=p))
4574  {
4575    res->data=(char *)n_Param(i,currRing);
4576  }
4577  else
4578  {
4579    Werror("par number %d out of range 1..%d",i,p);
4580    return TRUE;
4581  }
4582  return FALSE;
4583}
4584static BOOLEAN jjPARDEG(leftv res, leftv v)
4585{
4586  number nn=(number)v->Data();
4587  res->data = (char *)(long)n_ParDeg(nn, currRing);
4588  return FALSE;
4589}
4590static BOOLEAN jjPARSTR1(leftv res, leftv v)
4591{
4592  if (currRing==NULL)
4593  {
4594    WerrorS("no ring active");
4595    return TRUE;
4596  }
4597  int i=(int)(long)v->Data();
4598  int p=0;
4599  if ((0<i) && (rParameter(currRing)!=NULL) && (i<=(p=rPar(currRing))))
4600    res->data=omStrDup(rParameter(currRing)[i-1]);
4601  else
4602  {
4603    Werror("par number %d out of range 1..%d",i,p);
4604    return TRUE;
4605  }
4606  return FALSE;
4607}
4608static BOOLEAN jjP2BI(leftv res, leftv v)
4609{
4610  poly p=(poly)v->Data();
4611  if (p==NULL) { res->data=(char *)n_Init(0,coeffs_BIGINT); return FALSE; }
4612  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4613  {
4614    WerrorS("poly must be constant");
4615    return TRUE;
4616  }
4617  number i=pGetCoeff(p);
4618  number n;
4619  nMapFunc nMap=n_SetMap(currRing->cf,coeffs_BIGINT);
4620  if (nMap!=NULL)
4621    n=nMap(i,currRing->cf,coeffs_BIGINT);
4622  else goto err;
4623  res->data=(void *)n;
4624  return FALSE;
4625err:
4626  WerrorS("cannot convert to bigint"); return TRUE;
4627}
4628static BOOLEAN jjP2I(leftv res, leftv v)
4629{
4630  poly p=(poly)v->Data();
4631  if (p==NULL) { /*res->data=(char *)0;*/ return FALSE; }
4632  if ((pNext(p)!=NULL)|| (!pIsConstant(p)))
4633  {
4634    WerrorS("poly must be constant");
4635    return TRUE;
4636  }
4637  res->data = (char *)(long)n_Int(pGetCoeff(p),currRing->cf);
4638  return FALSE;
4639}
4640static BOOLEAN jjPREIMAGE_R(leftv res, leftv v)
4641{
4642  map mapping=(map)v->Data();
4643  syMake(res,omStrDup(mapping->preimage));
4644  return FALSE;
4645}
4646static BOOLEAN jjPRIME(leftv res, leftv v)
4647{
4648  int i = IsPrime((int)(long)(v->Data()));
4649  res->data = (char *)(long)(i > 1 ? i : 2);
4650  return FALSE;
4651}
4652static BOOLEAN jjPRUNE(leftv res, leftv v)
4653{
4654  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4655  ideal v_id=(ideal)v->Data();
4656  if (w!=NULL)
4657  {
4658    if (!idTestHomModule(v_id,currQuotient,w))
4659    {
4660      WarnS("wrong weights");
4661      w=NULL;
4662      // and continue at the non-homog case below
4663    }
4664    else
4665    {
4666      w=ivCopy(w);
4667      intvec **ww=&w;
4668      res->data = (char *)idMinEmbedding(v_id,FALSE,ww);
4669      atSet(res,omStrDup("isHomog"),*ww,INTVEC_CMD);
4670      return FALSE;
4671    }
4672  }
4673  res->data = (char *)idMinEmbedding(v_id);
4674  return FALSE;
4675}
4676static BOOLEAN jjP2N(leftv res, leftv v)
4677{
4678  number n;
4679  poly p;
4680  if (((p=(poly)v->Data())!=NULL)
4681  && (pIsConstant(p)))
4682  {
4683    n=nCopy(pGetCoeff(p));
4684  }
4685  else
4686  {
4687    n=nInit(0);
4688  }
4689  res->data = (char *)n;
4690  return FALSE;
4691}
4692static BOOLEAN jjRESERVEDNAME(leftv res, leftv v)
4693{
4694  char *s= (char *)v->Data();
4695  int i = 1;
4696  for(i=0; i<sArithBase.nCmdUsed; i++)
4697  {
4698    //Print("test %d, >>%s<<, tab:>>%s<<\n",i,s,sArithBase.sCmds[i].name);
4699    if (strcmp(s, sArithBase.sCmds[i].name) == 0)
4700    {
4701      res->data = (char *)1;
4702      return FALSE;
4703    }
4704  }
4705  //res->data = (char *)0;
4706  return FALSE;
4707}
4708static BOOLEAN jjRANK1(leftv res, leftv v)
4709{
4710  matrix m =(matrix)v->Data();
4711  int rank = luRank(m, 0);
4712  res->data =(char *)(long)rank;
4713  return FALSE;
4714}
4715static BOOLEAN jjREAD(leftv res, leftv v)
4716{
4717  return jjREAD2(res,v,NULL);
4718}
4719static BOOLEAN jjREGULARITY(leftv res, leftv v)
4720{
4721  res->data = (char *)(long)iiRegularity((lists)v->Data());
4722  return FALSE;
4723}
4724static BOOLEAN jjREPART(leftv res, leftv v)
4725{
4726  res->data = (char *)n_RePart((number)v->Data(),currRing->cf);
4727  return FALSE;
4728}
4729static BOOLEAN jjRINGLIST(leftv res, leftv v)
4730{
4731  ring r=(ring)v->Data();
4732  if (r!=NULL)
4733    res->data = (char *)rDecompose((ring)v->Data());
4734  return (r==NULL)||(res->data==NULL);
4735}
4736static BOOLEAN jjROWS(leftv res, leftv v)
4737{
4738  ideal i = (ideal)v->Data();
4739  res->data = (char *)i->rank;
4740  return FALSE;
4741}
4742static BOOLEAN jjROWS_BIM(leftv res, leftv v)
4743{
4744  res->data = (char *)(long)((bigintmat*)(v->Data()))->rows();
4745  return FALSE;
4746}
4747static BOOLEAN jjROWS_IV(leftv res, leftv v)
4748{
4749  res->data = (char *)(long)((intvec*)(v->Data()))->rows();
4750  return FALSE;
4751}
4752static BOOLEAN jjRPAR(leftv res, leftv v)
4753{
4754  res->data = (char *)(long)rPar(((ring)v->Data()));
4755  return FALSE;
4756}
4757static BOOLEAN jjSLIM_GB(leftv res, leftv u)
4758{
4759#ifdef HAVE_PLURAL
4760  const bool bIsSCA = rIsSCA(currRing);
4761#else
4762  const bool bIsSCA = false;
4763#endif
4764
4765  if ((currQuotient!=NULL) && !bIsSCA)
4766  {
4767    WerrorS("qring not supported by slimgb at the moment");
4768    return TRUE;
4769  }
4770  if (rHasLocalOrMixedOrdering_currRing())
4771  {
4772    WerrorS("ordering must be global for slimgb");
4773    return TRUE;
4774  }
4775  intvec *w=(intvec *)atGet(u,"isHomog",INTVEC_CMD);
4776  tHomog hom=testHomog;
4777  ideal u_id=(ideal)u->Data();
4778  if (w!=NULL)
4779  {
4780    if (!idTestHomModule(u_id,currQuotient,w))
4781    {
4782      WarnS("wrong weights");
4783      w=NULL;
4784    }
4785    else
4786    {
4787      w=ivCopy(w);
4788      hom=isHomog;
4789    }
4790  }
4791
4792  assume(u_id->rank>=id_RankFreeModule(u_id, currRing));
4793  res->data=(char *)t_rep_gb(currRing,
4794    u_id,u_id->rank);
4795  //res->data=(char *)t_rep_gb(currRing, u_id);
4796
4797  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4798  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4799  return FALSE;
4800}
4801static BOOLEAN jjSBA(leftv res, leftv v)
4802{
4803  ideal result;
4804  ideal v_id=(ideal)v->Data();
4805  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4806  tHomog hom=testHomog;
4807  if (w!=NULL)
4808  {
4809    if (!idTestHomModule(v_id,currQuotient,w))
4810    {
4811      WarnS("wrong weights");
4812      w=NULL;
4813    }
4814    else
4815    {
4816      hom=isHomog;
4817      w=ivCopy(w);
4818    }
4819  }
4820  result=kSba(v_id,currQuotient,hom,&w,1,0);
4821  idSkipZeroes(result);
4822  res->data = (char *)result;
4823  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4824  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4825  return FALSE;
4826}
4827static BOOLEAN jjSBA_1(leftv res, leftv v, leftv u)
4828{
4829  ideal result;
4830  ideal v_id=(ideal)v->Data();
4831  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4832  tHomog hom=testHomog;
4833  if (w!=NULL)
4834  {
4835    if (!idTestHomModule(v_id,currQuotient,w))
4836    {
4837      WarnS("wrong weights");
4838      w=NULL;
4839    }
4840    else
4841    {
4842      hom=isHomog;
4843      w=ivCopy(w);
4844    }
4845  }
4846  result=kSba(v_id,currQuotient,hom,&w,(int)(long)u->Data(),0);
4847  idSkipZeroes(result);
4848  res->data = (char *)result;
4849  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4850  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4851  return FALSE;
4852}
4853static BOOLEAN jjSBA_2(leftv res, leftv v, leftv u, leftv t)
4854{
4855  ideal result;
4856  ideal v_id=(ideal)v->Data();
4857  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4858  tHomog hom=testHomog;
4859  if (w!=NULL)
4860  {
4861    if (!idTestHomModule(v_id,currQuotient,w))
4862    {
4863      WarnS("wrong weights");
4864      w=NULL;
4865    }
4866    else
4867    {
4868      hom=isHomog;
4869      w=ivCopy(w);
4870    }
4871  }
4872  result=kSba(v_id,currQuotient,hom,&w,(int)(long)u->Data(),(int)(long)t->Data());
4873  idSkipZeroes(result);
4874  res->data = (char *)result;
4875  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4876  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4877  return FALSE;
4878}
4879static BOOLEAN jjSTD(leftv res, leftv v)
4880{
4881  ideal result;
4882  ideal v_id=(ideal)v->Data();
4883  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4884  tHomog hom=testHomog;
4885  if (w!=NULL)
4886  {
4887    if (!idTestHomModule(v_id,currQuotient,w))
4888    {
4889      WarnS("wrong weights");
4890      w=NULL;
4891    }
4892    else
4893    {
4894      hom=isHomog;
4895      w=ivCopy(w);
4896    }
4897  }
4898  result=kStd(v_id,currQuotient,hom,&w);
4899  idSkipZeroes(result);
4900  res->data = (char *)result;
4901  if(!TEST_OPT_DEGBOUND) setFlag(res,FLAG_STD);
4902  if (w!=NULL) atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4903  return FALSE;
4904}
4905static BOOLEAN jjSort_Id(leftv res, leftv v)
4906{
4907  res->data = (char *)idSort((ideal)v->Data());
4908  return FALSE;
4909}
4910#ifdef HAVE_FACTORY
4911static BOOLEAN jjSQR_FREE(leftv res, leftv u)
4912{
4913  singclap_factorize_retry=0;
4914  intvec *v=NULL;
4915  ideal f=singclap_sqrfree((poly)(u->CopyD()), &v, 0, currRing);
4916  if (f==NULL) return TRUE;
4917  ivTest(v);
4918  lists l=(lists)omAllocBin(slists_bin);
4919  l->Init(2);
4920  l->m[0].rtyp=IDEAL_CMD;
4921  l->m[0].data=(void *)f;
4922  l->m[1].rtyp=INTVEC_CMD;
4923  l->m[1].data=(void *)v;
4924  res->data=(void *)l;
4925  return FALSE;
4926}
4927#endif
4928#if 1
4929static BOOLEAN jjSYZYGY(leftv res, leftv v)
4930{
4931  intvec *w=NULL;
4932  res->data = (char *)idSyzygies((ideal)v->Data(),testHomog,&w);
4933  if (w!=NULL) delete w;
4934  return FALSE;
4935}
4936#else
4937// activate, if idSyz handle module weights correctly !
4938static BOOLEAN jjSYZYGY(leftv res, leftv v)
4939{
4940  intvec *w=(intvec *)atGet(v,"isHomog",INTVEC_CMD);
4941  ideal v_id=(ideal)v->Data();
4942  tHomog hom=testHomog;
4943  int add_row_shift=0;
4944  if (w!=NULL)
4945  {
4946    w=ivCopy(w);
4947    add_row_shift=w->min_in();
4948    (*w)-=add_row_shift;
4949    if (idTestHomModule(v_id,currQuotient,w))
4950      hom=isHomog;
4951    else
4952    {
4953      //WarnS("wrong weights");
4954      delete w; w=NULL;
4955      hom=testHomog;
4956    }
4957  }
4958  res->data = (char *)idSyzygies(v_id,hom,&w);
4959  if (w!=NULL)
4960  {
4961    atSet(res,omStrDup("isHomog"),w,INTVEC_CMD);
4962  }
4963  return FALSE;
4964}
4965#endif
4966static BOOLEAN jjTRACE_IV(leftv res, leftv v)
4967{
4968  res->data = (char *)(long)ivTrace((intvec*)(v->Data()));
4969  return FALSE;
4970}
4971static BOOLEAN jjTRANSP_BIM(leftv res, leftv v)
4972{
4973  res->data = (char *)(((bigintmat*)(v->Data()))->transpose());
4974  return FALSE;
4975}
4976static BOOLEAN jjTRANSP_IV(leftv res, leftv v)
4977{
4978  res->data = (char *)ivTranp((intvec*)(v->Data()));
4979  return FALSE;
4980}
4981#ifdef HAVE_PLURAL
4982static BOOLEAN jjOPPOSITE(leftv res, leftv a)
4983{
4984  ring    r = (ring)a->Data();
4985  //if (rIsPluralRing(r))
4986  if (r->OrdSgn==1)
4987  {
4988    res->data = rOpposite(r);
4989  }
4990  else
4991  {
4992    WarnS("opposite only for global orderings");
4993    res->data = rCopy(r);
4994  }
4995  return FALSE;
4996}
4997static BOOLEAN jjENVELOPE(leftv res, leftv a)
4998{
4999  ring    r = (ring)a->Data();
5000  if (rIsPluralRing(r))
5001  {
5002    //    ideal   i;
5003//     if (a->rtyp == QRING_CMD)
5004//     {
5005//       i = r->qideal;
5006//       r->qideal = NULL;
5007//     }
5008    ring s = rEnvelope(r);
5009//     if (a->rtyp == QRING_CMD)
5010//     {
5011//       ideal is  = idOppose(r,i); /* twostd? */
5012//       is        = idAdd(is,i);
5013//       s->qideal = i;
5014//     }
5015    res->data = s;
5016  }
5017  else  res->data = rCopy(r);
5018  return FALSE;
5019}
5020static BOOLEAN jjTWOSTD(leftv res, leftv a)
5021{
5022  if (rIsPluralRing(currRing))  res->data=(ideal)twostd((ideal)a->Data());
5023  else  res->data=(ideal)a->CopyD();
5024  setFlag(res,FLAG_STD);
5025  setFlag(res,FLAG_TWOSTD);
5026  return FALSE;
5027}
5028#endif
5029
5030static BOOLEAN jjTYPEOF(leftv res, leftv v)
5031{
5032  int t=(int)(long)v->data;
5033  switch (t)
5034  {
5035    case INT_CMD:        res->data=omStrDup("int"); break;
5036    case POLY_CMD:       res->data=omStrDup("poly"); break;
5037    case VECTOR_CMD:     res->data=omStrDup("vector"); break;
5038    case STRING_CMD:     res->data=omStrDup("string"); break;
5039    case INTVEC_CMD:     res->data=omStrDup("intvec"); break;
5040    case IDEAL_CMD:      res->data=omStrDup("ideal"); break;
5041    case MATRIX_CMD:     res->data=omStrDup("matrix"); break;
5042    case MODUL_CMD:      res->data=omStrDup("module"); break;
5043    case MAP_CMD:        res->data=omStrDup("map"); break;
5044    case PROC_CMD:       res->data=omStrDup("proc"); break;
5045    case RING_CMD:       res->data=omStrDup("ring"); break;
5046    case QRING_CMD:      res->data=omStrDup("qring"); break;
5047    case INTMAT_CMD:     res->data=omStrDup("intmat"); break;
5048    case NUMBER_CMD:     res->data=omStrDup("number"); break;
5049    case BIGINT_CMD:     res->data=omStrDup("bigint"); break;
5050    case LIST_CMD:       res->data=omStrDup("list"); break;
5051    case PACKAGE_CMD:    res->data=omStrDup("package"); break;
5052    case LINK_CMD:       res->data=omStrDup("link"); break;
5053    case RESOLUTION_CMD: res->data=omStrDup("resolution");break;
5054    case DEF_CMD:
5055    case NONE:           res->data=omStrDup("none"); break;
5056    default:
5057    {
5058      if (t>MAX_TOK)
5059        res->data=omStrDup(getBlackboxName(t));
5060      else
5061        res->data=omStrDup("?unknown type?");
5062      break;
5063    }
5064  }
5065  return FALSE;
5066}
5067static BOOLEAN jjUNIVARIATE(leftv res, leftv v)
5068{
5069  res->data=(char *)pIsUnivariate((poly)v->Data());
5070  return FALSE;
5071}
5072static BOOLEAN jjVAR1(leftv res, leftv v)
5073{
5074  int i=(int)(long)v->Data();
5075  if ((0<i) && (i<=currRing->N))
5076  {
5077    poly p=pOne();
5078    pSetExp(p,i,1);
5079    pSetm(p);
5080    res->data=(char *)p;
5081  }
5082  else
5083  {
5084    Werror("var number %d out of range 1..%d",i,currRing->N);
5085    return TRUE;
5086  }
5087  return FALSE;
5088}
5089static BOOLEAN jjVARSTR1(leftv res, leftv v)
5090{
5091  if (currRing==NULL)
5092  {
5093    WerrorS("no ring active");
5094    return TRUE;
5095  }
5096  int i=(int)(long)v->Data();
5097  if ((0<i) && (i<=currRing->N))
5098    res->data=omStrDup(currRing->names[i-1]);
5099  else
5100  {
5101    Werror("var number %d out of range 1..%d",i,currRing->N);
5102    return TRUE;
5103  }
5104  return FALSE;
5105}
5106static BOOLEAN jjVDIM(leftv res, leftv v)
5107{
5108  assumeStdFlag(v);
5109  res->data = (char *)(long)scMult0Int((ideal)v->Data(),currQuotient);
5110  return FALSE;
5111}
5112BOOLEAN jjWAIT1ST1(leftv res, leftv u)
5113{
5114// input: u: a list with links of type
5115//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5116// returns: -1:  the read state of all links is eof
5117//          i>0: (at least) u[i] is ready
5118  lists Lforks = (lists)u->Data();
5119  int i = slStatusSsiL(Lforks, -1);
5120  if(i == -2) /* error */
5121  {
5122    return TRUE;
5123  }
5124  res->data = (void*)(long)i;
5125  return FALSE;
5126}
5127BOOLEAN jjWAITALL1(leftv res, leftv u)
5128{
5129// input: u: a list with links of type
5130//           ssi-fork, ssi-tcp, MPtcp-fork or MPtcp-launch
5131// returns: -1: the read state of all links is eof
5132//           1: all links are ready
5133//              (caution: at least one is ready, but some maybe dead)
5134  lists Lforks = (lists)u->CopyD();
5135  int i;
5136  int j = -1;
5137  for(int nfinished = 0; nfinished < Lforks->nr+1; nfinished++)
5138  {
5139    i = slStatusSsiL(Lforks, -1);
5140    if(i == -2) /* error */
5141    {
5142      return TRUE;
5143    }
5144    if(i == -1)
5145    {
5146      break;
5147    }
5148    j = 1;
5149    Lforks->m[i-1].CleanUp();
5150    Lforks->m[i-1].rtyp=DEF_CMD;
5151    Lforks->m[i-1].data=NULL;
5152  }
5153  res->data = (void*)(long)j;
5154  Lforks->Clean();
5155  return FALSE;
5156}
5157static BOOLEAN jjLOAD(leftv, leftv v, BOOLEAN autoexport)
5158{
5159  char * s=(char *)v->CopyD();
5160  char libnamebuf[256];
5161  lib_types LT = type_of_LIB(s, libnamebuf);
5162#ifdef HAVE_DYNAMIC_LOADING
5163  extern BOOLEAN load_modules(char *newlib, char *fullpath, BOOLEAN autoexport);
5164#endif /* HAVE_DYNAMIC_LOADING */
5165  switch(LT)
5166  {
5167      default:
5168      case LT_NONE:
5169        Werror("%s: unknown type", s);
5170        break;
5171      case LT_NOTFOUND:
5172        Werror("cannot open %s", s);
5173        break;
5174
5175      case LT_SINGULAR:
5176      {
5177        char *plib = iiConvName(s);
5178        idhdl pl = IDROOT->get(plib,0);
5179        if (pl==NULL)
5180        {
5181          pl = enterid( plib,0, PACKAGE_CMD, &(basePack->idroot), TRUE );
5182          IDPACKAGE(pl)->language = LANG_SINGULAR;
5183          IDPACKAGE(pl)->libname=omStrDup(plib);
5184        }
5185        else if (IDTYP(pl)!=PACKAGE_CMD)
5186        {
5187          Werror("can not create package `%s`",plib);
5188          omFree(plib);
5189          return TRUE;
5190        }
5191        package savepack=currPack;
5192        currPack=IDPACKAGE(pl);
5193        IDPACKAGE(pl)->loaded=TRUE;
5194        char libnamebuf[256];
5195        FILE * fp = feFopen( s, "r", libnamebuf, TRUE );
5196        BOOLEAN bo=iiLoadLIB(fp, libnamebuf, s, pl, autoexport, TRUE);
5197        currPack=savepack;
5198        IDPACKAGE(pl)->loaded=(!bo);
5199        return bo;
5200      }
5201      case LT_MACH_O:
5202      case LT_ELF:
5203      case LT_HPUX:
5204#ifdef HAVE_DYNAMIC_LOADING
5205        return load_modules(s, libnamebuf, autoexport);
5206#else /* HAVE_DYNAMIC_LOADING */
5207        WerrorS("Dynamic modules are not supported by this version of Singular");
5208        break;
5209#endif /* HAVE_DYNAMIC_LOADING */
5210  }
5211  return TRUE;
5212}
5213
5214#ifdef INIT_BUG
5215#define XS(A) -((short)A)
5216#define jjstrlen       (proc1)1
5217#define jjpLength      (proc1)2
5218#define jjidElem       (proc1)3
5219#define jjmpDetBareiss (proc1)4
5220#define jjidFreeModule (proc1)5
5221#define jjidVec2Ideal  (proc1)6
5222#define jjrCharStr     (proc1)7
5223#ifndef MDEBUG
5224#define jjpHead        (proc1)8
5225#endif
5226#define jjidMinBase    (proc1)11
5227#define jjsyMinBase    (proc1)12
5228#define jjpMaxComp     (proc1)13
5229#define jjmpTrace      (proc1)14
5230#define jjmpTransp     (proc1)15
5231#define jjrOrdStr      (proc1)16
5232#define jjrVarStr      (proc1)18
5233#define jjrParStr      (proc1)19
5234#define jjCOUNT_RES    (proc1)22
5235#define jjDIM_R        (proc1)23
5236#define jjidTransp     (proc1)24
5237
5238extern struct sValCmd1 dArith1[];
5239void jjInitTab1()
5240{
5241  int i=0;
5242  for (;dArith1[i].cmd!=0;i++)
5243  {
5244    if (dArith1[i].res<0)
5245    {
5246      switch ((int)dArith1[i].p)
5247      {
5248        case (int)jjstrlen:       dArith1[i].p=(proc1)strlen; break;
5249        case (int)jjpLength:      dArith1[i].p=(proc1)pLength; break;
5250        case (int)jjidElem:       dArith1[i].p=(proc1)idElem; break;
5251        case (int)jjidVec2Ideal:  dArith1[i].p=(proc1)idVec2Ideal; break;
5252#ifndef HAVE_FACTORY
5253        case (int)jjmpDetBareiss: dArith1[i].p=(proc1)mpDetBareiss; break;
5254#endif
5255        case (int)jjidFreeModule: dArith1[i].p=(proc1)idFreeModule; break;
5256        case (int)jjrCharStr:     dArith1[i].p=(proc1)rCharStr; break;
5257#ifndef MDEBUG
5258        case (int)jjpHead:        dArith1[i].p=(proc1)pHeadProc; break;
5259#endif
5260        case (int)jjidMinBase:    dArith1[i].p=(proc1)idMinBase; break;
5261        case (int)jjsyMinBase:    dArith1[i].p=(proc1)syMinBase; break;
5262        case (int)jjpMaxComp:     dArith1[i].p=(proc1)pMaxCompProc; break;
5263        case (int)jjmpTrace:      dArith1[i].p=(proc1)mpTrace; break;
5264        case (int)jjmpTransp:     dArith1[i].p=(proc1)mpTransp; break;
5265        case (int)jjrOrdStr:      dArith1[i].p=(proc1)rOrdStr; break;
5266        case (int)jjrVarStr:      dArith1[i].p=(proc1)rVarStr; break;
5267        case (int)jjrParStr:      dArith1[i].p=(proc1)rParStr; break;
5268        case (int)jjCOUNT_RES:    dArith1[i].p=(proc1)sySize; break;
5269        case (int)jjDIM_R:        dArith1[i].p=(proc1)syDim; break;
5270        case (int)jjidTransp:     dArith1[i].p=(proc1)idTransp; break;
5271        default: Werror("missing proc1-definition for %d",(int)(long)dArith1[i].p);
5272      }
5273    }
5274  }
5275}
5276#else
5277#if defined(PROC_BUG)
5278#define XS(A) A
5279static BOOLEAN jjstrlen(leftv res, leftv v)
5280{
5281  res->data = (char *)strlen((char *)v->Data());
5282  return FALSE;
5283}
5284static BOOLEAN jjpLength(leftv res, leftv v)
5285{
5286  res->data = (char *)pLength((poly)v->Data());
5287  return FALSE;
5288}
5289static BOOLEAN jjidElem(leftv res, leftv v)
5290{
5291  res->data = (char *)idElem((ideal)v->Data());
5292  return FALSE;
5293}
5294static BOOLEAN jjmpDetBareiss(leftv res, leftv v)
5295{
5296  res->data = (char *)mp_DetBareiss((matrix)v->Data(),currRing);
5297  return FALSE;
5298}
5299static BOOLEAN jjidFreeModule(leftv res, leftv v)
5300{
5301  res->data = (char *)id_FreeModule((int)(long)v->Data(), currRing);
5302  return FALSE;
5303}
5304static BOOLEAN jjidVec2Ideal(leftv res, leftv v)
5305{
5306  res->data = (char *)id_Vec2Ideal((poly)v->Data(), currRing);
5307  return FALSE;
5308}
5309static BOOLEAN jjrCharStr(leftv res, leftv v)
5310{
5311  res->data = rCharStr((ring)v->Data());
5312  return FALSE;
5313}
5314#ifndef MDEBUG
5315static BOOLEAN jjpHead(leftv res, leftv v)
5316{
5317  res->data = (char *)pHead((poly)v->Data());
5318  return FALSE;
5319}
5320#endif
5321static BOOLEAN jjidHead(leftv res, leftv v)
5322{
5323  res->data = (char *)id_Head((ideal)v->Data(),currRing);
5324  return FALSE;
5325}
5326static BOOLEAN jjidMinBase(leftv res, leftv v)
5327{
5328  res->data = (char *)idMinBase((ideal)v->Data());
5329  return FALSE;
5330}
5331static BOOLEAN jjsyMinBase(leftv res, leftv v)
5332{
5333  res->data = (char *)syMinBase((ideal)v->Data());
5334  return FALSE;
5335}
5336static BOOLEAN jjpMaxComp(leftv res, leftv v)
5337{
5338  res->data = (char *)pMaxComp((poly)v->Data());
5339  return FALSE;
5340}
5341static BOOLEAN jjmpTrace(leftv res, leftv v)
5342{
5343  res->data = (char *)mp_Trace((matrix)v->Data(),currRing);
5344  return FALSE;
5345}
5346static BOOLEAN jjmpTransp(leftv res, leftv v)
5347{
5348  res->data = (char *)mp_Transp((matrix)v->Data(),currRing);
5349  return FALSE;
5350}
5351static BOOLEAN jjrOrdStr(leftv res, leftv v)
5352{
5353  res->data = rOrdStr((ring)v->Data());
5354  return FALSE;
5355}
5356static BOOLEAN jjrVarStr(leftv res, leftv v)
5357{
5358  res->data = rVarStr((ring)v->Data());
5359  return FALSE;
5360}
5361static BOOLEAN jjrParStr(leftv res, leftv v)
5362{
5363  res->data = rParStr((ring)v->Data());
5364  return FALSE;
5365}
5366static BOOLEAN jjCOUNT_RES(leftv res, leftv v)
5367{
5368  res->data=(char *)sySize((syStrategy)v->Data());
5369  return FALSE;
5370}
5371static BOOLEAN jjDIM_R(leftv res, leftv v)
5372{
5373  res->data = (char *)syDim((syStrategy)v->Data());
5374  return FALSE;
5375}
5376static BOOLEAN jjidTransp(leftv res, leftv v)
5377{
5378  res->data = (char *)idTransp((ideal)v->Data());
5379  return FALSE;
5380}
5381#else
5382#define XS(A)          -((short)A)
5383#define jjstrlen       (proc1)strlen
5384#define jjpLength      (proc1)pLength
5385#define jjidElem       (proc1)idElem
5386#define jjmpDetBareiss (proc1)mpDetBareiss
5387#define jjidFreeModule (proc1)idFreeModule
5388#define jjidVec2Ideal  (proc1)idVec2Ideal
5389#define jjrCharStr     (proc1)rCharStr
5390#ifndef MDEBUG
5391#define jjpHead        (proc1)pHeadProc
5392#endif
5393#define jjidHead       (proc1)idHead
5394#define jjidMinBase    (proc1)idMinBase
5395#define jjsyMinBase    (proc1)syMinBase
5396#define jjpMaxComp     (proc1)pMaxCompProc
5397#define jjrOrdStr      (proc1)rOrdStr
5398#define jjrVarStr      (proc1)rVarStr
5399#define jjrParStr      (proc1)rParStr
5400#define jjCOUNT_RES    (proc1)sySize
5401#define jjDIM_R        (proc1)syDim
5402#define jjidTransp     (proc1)idTransp
5403#endif
5404#endif
5405static BOOLEAN jjnInt(leftv res, leftv u)
5406{
5407  number n=(number)u->Data();
5408  res->data=(char *)(long)n_Int(n,currRing->cf);
5409  return FALSE;
5410}
5411static BOOLEAN jjnlInt(leftv res, leftv u)
5412{
5413  number n=(number)u->Data();
5414  res->data=(char *)(long)n_Int(n,coeffs_BIGINT );
5415  return FALSE;
5416}
5417/*=================== operations with 3 args.: static proc =================*/
5418/* must be ordered: first operations for chars (infix ops),
5419 * then alphabetically */
5420static BOOLEAN jjBRACK_S(leftv res, leftv u, leftv v,leftv w)
5421{
5422  char *s= (char *)u->Data();
5423  int   r = (int)(long)v->Data();
5424  int   c = (int)(long)w->Data();
5425  int l = strlen(s);
5426
5427  if ( (r<1) || (r>l) || (c<0) )
5428  {
5429    Werror("wrong range[%d,%d] in string %s",r,c,u->Fullname());
5430    return TRUE;
5431  }
5432  res->data = (char *)omAlloc((long)(c+1));
5433  sprintf((char *)res->data,"%-*.*s",c,c,s+r-1);
5434  return FALSE;
5435}
5436static BOOLEAN jjBRACK_Im(leftv res, leftv u, leftv v,leftv w)
5437{
5438  intvec *iv = (intvec *)u->Data();
5439  int   r = (int)(long)v->Data();
5440  int   c = (int)(long)w->Data();
5441  if ((r<1)||(r>iv->rows())||(c<1)||(c>iv->cols()))
5442  {
5443    Werror("wrong range[%d,%d] in intmat %s(%d x %d)",
5444           r,c,u->Fullname(),iv->rows(),iv->cols());
5445    return TRUE;
5446  }
5447  res->data=u->data; u->data=NULL;
5448  res->rtyp=u->rtyp; u->rtyp=0;
5449  res->name=u->name; u->name=NULL;
5450  Subexpr e=jjMakeSub(v);
5451          e->next=jjMakeSub(w);
5452  if (u->e==NULL) res->e=e;
5453  else
5454  {
5455    Subexpr h=u->e;
5456    while (h->next!=NULL) h=h->next;
5457    h->next=e;
5458    res->e=u->e;
5459    u->e=NULL;
5460  }
5461  return FALSE;
5462}
5463static BOOLEAN jjBRACK_Bim(leftv res, leftv u, leftv v, leftv w)
5464{
5465  bigintmat *bim = (bigintmat *)u->Data();
5466  int   r = (int)(long)v->Data();
5467  int   c = (int)(long)w->Data();
5468  if ((r<1)||(r>bim->rows())||(c<1)||(c>bim->cols()))
5469  {
5470    Werror("wrong range[%d,%d] in bigintmat %s(%d x %d)",
5471           r,c,u->Fullname(),bim->rows(),bim->cols());
5472    return TRUE;
5473  }
5474  res->data=u->data; u->data=NULL;
5475  res->rtyp=u->rtyp; u->rtyp=0;
5476  res->name=u->name; u->name=NULL;
5477  Subexpr e=jjMakeSub(v);
5478          e->next=jjMakeSub(w);
5479  if (u->e==NULL)
5480    res->e=e;
5481  else
5482  {
5483    Subexpr h=u->e;
5484    while (h->next!=NULL) h=h->next;
5485    h->next=e;
5486    res->e=u->e;
5487    u->e=NULL;
5488  }
5489  return FALSE;
5490}
5491static BOOLEAN jjBRACK_Ma(leftv res, leftv u, leftv v,leftv w)
5492{
5493  matrix m= (matrix)u->Data();
5494  int   r = (int)(long)v->Data();
5495  int   c = (int)(long)w->Data();
5496  //Print("gen. elem %d, %d\n",r,c);
5497  if ((r<1)||(r>MATROWS(m))||(c<1)||(c>MATCOLS(m)))
5498  {
5499    Werror("wrong range[%d,%d] in matrix %s(%d x %d)",r,c,u->Fullname(),
5500      MATROWS(m),MATCOLS(m));
5501    return TRUE;
5502  }
5503  res->data=u->data; u->data=NULL;
5504  res->rtyp=u->rtyp; u->rtyp=0;
5505  res->name=u->name; u->name=NULL;
5506  Subexpr e=jjMakeSub(v);
5507          e->next=jjMakeSub(w);
5508  if (u->e==NULL)
5509    res->e=e;
5510  else
5511  {
5512    Subexpr h=u->e;
5513    while (h->next!=NULL) h=h->next;
5514    h->next=e;
5515    res->e=u->e;
5516    u->e=NULL;
5517  }
5518  return FALSE;
5519}
5520static BOOLEAN jjBRACK_Ma_I_IV(leftv res, leftv u, leftv v,leftv w)
5521{
5522  sleftv t;
5523  sleftv ut;
5524  leftv p=NULL;
5525  intvec *iv=(intvec *)w->Data();
5526  int l;
5527  BOOLEAN nok;
5528
5529  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5530  {
5531    WerrorS("cannot build expression lists from unnamed objects");
5532    return TRUE;
5533  }
5534  memcpy(&ut,u,sizeof(ut));
5535  memset(&t,0,sizeof(t));
5536  t.rtyp=INT_CMD;
5537  for (l=0;l< iv->length(); l++)
5538  {
5539    t.data=(char *)(long)((*iv)[l]);
5540    if (p==NULL)
5541    {
5542      p=res;
5543    }
5544    else
5545    {
5546      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5547      p=p->next;
5548    }
5549    memcpy(u,&ut,sizeof(ut));
5550    if (u->Typ() == MATRIX_CMD)
5551      nok=jjBRACK_Ma(p,u,v,&t);
5552    else /* INTMAT_CMD */
5553      nok=jjBRACK_Im(p,u,v,&t);
5554    if (nok)
5555    {
5556      while (res->next!=NULL)
5557      {
5558        p=res->next->next;
5559        omFreeBin((ADDRESS)res->next, sleftv_bin);
5560        // res->e aufraeumen !!!!
5561        res->next=p;
5562      }
5563      return TRUE;
5564    }
5565  }
5566  return FALSE;
5567}
5568static BOOLEAN jjBRACK_Ma_IV_I(leftv res, leftv u, leftv v,leftv w)
5569{
5570  sleftv t;
5571  sleftv ut;
5572  leftv p=NULL;
5573  intvec *iv=(intvec *)v->Data();
5574  int l;
5575  BOOLEAN nok;
5576
5577  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5578  {
5579    WerrorS("cannot build expression lists from unnamed objects");
5580    return TRUE;
5581  }
5582  memcpy(&ut,u,sizeof(ut));
5583  memset(&t,0,sizeof(t));
5584  t.rtyp=INT_CMD;
5585  for (l=0;l< iv->length(); l++)
5586  {
5587    t.data=(char *)(long)((*iv)[l]);
5588    if (p==NULL)
5589    {
5590      p=res;
5591    }
5592    else
5593    {
5594      p->next=(leftv)omAlloc0Bin(sleftv_bin);
5595      p=p->next;
5596    }
5597    memcpy(u,&ut,sizeof(ut));
5598    if (u->Typ() == MATRIX_CMD)
5599      nok=jjBRACK_Ma(p,u,&t,w);
5600    else /* INTMAT_CMD */
5601      nok=jjBRACK_Im(p,u,&t,w);
5602    if (nok)
5603    {
5604      while (res->next!=NULL)
5605      {
5606        p=res->next->next;
5607        omFreeBin((ADDRESS)res->next, sleftv_bin);
5608        // res->e aufraeumen !!
5609        res->next=p;
5610      }
5611      return TRUE;
5612    }
5613  }
5614  return FALSE;
5615}
5616static BOOLEAN jjBRACK_Ma_IV_IV(leftv res, leftv u, leftv v,leftv w)
5617{
5618  sleftv t1,t2,ut;
5619  leftv p=NULL;
5620  intvec *vv=(intvec *)v->Data();
5621  intvec *wv=(intvec *)w->Data();
5622  int vl;
5623  int wl;
5624  BOOLEAN nok;
5625
5626  if ((u->rtyp!=IDHDL)||(u->e!=NULL))
5627  {
5628    WerrorS("cannot build expression lists from unnamed objects");
5629    return TRUE;
5630  }
5631  memcpy(&ut,u,sizeof(ut));
5632  memset(&t1,0,sizeof(sleftv));
5633  memset(&t2,0,sizeof(sleftv));
5634  t1.rtyp=INT_CMD;
5635  t2.rtyp=INT_CMD;
5636  for (vl=0;vl< vv->length(); vl++)
5637  {
5638    t1.data=(char *)(long)((*vv)[vl]);
5639    for (wl=0;wl< wv->length(); wl++)
5640    {
5641      t2.data=(char *)(long)((*wv)[wl]);
5642      if (p==NULL)
5643      {
5644        p=res;
5645      }
5646      else
5647      {
5648        p->next=(leftv)omAlloc0Bin(sleftv_bin);
5649        p=p->next;
5650      }
5651      memcpy(u,&ut,sizeof(ut));
5652      if (u->Typ() == MATRIX_CMD)
5653        nok=jjBRACK_Ma(p,u,&t1,&t2);
5654      else /* INTMAT_CMD */
5655        nok=jjBRACK_Im(p,u,&t1,&t2);
5656      if (nok)
5657      {
5658        res->CleanUp();
5659        return TRUE;
5660      }
5661    }
5662  }
5663  return FALSE;
5664}
5665static BOOLEAN jjPROC3(leftv res, leftv u, leftv v, leftv w)
5666{
5667  v->next=(leftv)omAllocBin(sleftv_bin);
5668  memcpy(v->next,w,sizeof(sleftv));
5669  memset(w,0,sizeof(sleftv));
5670  return jjPROC(res,u,v);
5671}
5672static BOOLEAN jjBAREISS3(leftv res, leftv u, leftv v, leftv w)
5673{
5674  intvec *iv;
5675  ideal m;
5676  lists l=(lists)omAllocBin(slists_bin);
5677  int k=(int)(long)w->Data();
5678  if (k>=0)
5679  {
5680    sm_CallBareiss((ideal)u->Data(),(int)(long)v->Data(),(int)(long)w->Data(),m,&iv, currRing);
5681    l->Init(2);
5682    l->m[0].rtyp=MODUL_CMD;
5683    l->m[1].rtyp=INTVEC_CMD;
5684    l->m[0].data=(void *)m;
5685    l->m[1].data=(void *)iv;
5686  }
5687  else
5688  {
5689    m=sm_CallSolv((ideal)u->Data(), currRing);
5690    l->Init(1);
5691    l->m[0].rtyp=IDEAL_CMD;
5692    l->m[0].data=(void *)m;
5693  }
5694  res->data = (char *)l;
5695  return FALSE;
5696}
5697static BOOLEAN jjCOEFFS3_Id(leftv res, leftv u, leftv v, leftv w)
5698{
5699  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5700  {
5701    WerrorS("3rd argument must be a name of a matrix");
5702    return TRUE;
5703  }
5704  ideal i=(ideal)u->Data();
5705  int rank=(int)i->rank;
5706  BOOLEAN r=jjCOEFFS_Id(res,u,v);
5707  if (r) return TRUE;
5708  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5709  return FALSE;
5710}
5711static BOOLEAN jjCOEFFS3_KB(leftv res, leftv u, leftv v, leftv w)
5712{
5713  res->data=(void*)idCoeffOfKBase((ideal)(u->Data()),
5714           (ideal)(v->Data()),(poly)(w->Data()));
5715  return FALSE;
5716}
5717static BOOLEAN jjCOEFFS3_P(leftv res, leftv u, leftv v, leftv w)
5718{
5719  if ((w->rtyp!=IDHDL)||(w->e!=NULL))
5720  {
5721    WerrorS("3rd argument must be a name of a matrix");
5722    return TRUE;
5723  }
5724  // CopyD for POLY_CMD and VECTOR_CMD are identical:
5725  poly p=(poly)u->CopyD(POLY_CMD);
5726  ideal i=idInit(1,1);
5727  i->m[0]=p;
5728  sleftv t;
5729  memset(&t,0,sizeof(t));
5730  t.data=(char *)i;
5731  t.rtyp=IDEAL_CMD;
5732  int rank=1;
5733  if (u->Typ()==VECTOR_CMD)
5734  {
5735    i->rank=rank=pMaxComp(p);
5736    t.rtyp=MODUL_CMD;
5737  }
5738  BOOLEAN r=jjCOEFFS_Id(res,&t,v);
5739  t.CleanUp();
5740  if (r) return TRUE;
5741  mp_Monomials((matrix)res->data, rank, pVar((poly)v->Data()),(matrix)w->Data(),currRing);
5742  return FALSE;
5743}
5744static BOOLEAN jjELIMIN_HILB(leftv res, leftv u, leftv v, leftv w)
5745{
5746  res->data=(char *)idElimination((ideal)u->Data(),(poly)v->Data(),
5747    (intvec *)w->Data());
5748  //setFlag(res,FLAG_STD);
5749  return FALSE;
5750}
5751static BOOLEAN jjFIND3(leftv res, leftv u, leftv v, leftv w)
5752{
5753  /*4
5754  * look for the substring what in the string where
5755  * starting at position n
5756  * return the position of the first char of what in where
5757  * or 0
5758  */
5759  int n=(int)(long)w->Data();
5760  char *where=(char *)u->Data();
5761  char *what=(char *)v->Data();
5762  char *found;
5763  if ((1>n)||(n>(int)strlen(where)))
5764  {
5765    Werror("start position %d out of range",n);
5766    return TRUE;
5767  }
5768  found = strchr(where+n-1,*what);
5769  if (*(what+1)!='\0')
5770  {
5771    while((found !=NULL) && (strncmp(found+1,what+1,strlen(what+1))!=0))
5772    {
5773      found=strchr(found+1,*what);
5774    }
5775  }
5776  if (found != NULL)
5777  {
5778    res->data=(char *)((found-where)+1);
5779  }
5780  return FALSE;
5781}
5782static BOOLEAN jjFWALK3(leftv res, leftv u, leftv v, leftv w)
5783{
5784  if ((int)(long)w->Data()==0)
5785    res->data=(char *)walkProc(u,v);
5786  else
5787    res->data=(char *)fractalWalkProc(u,v);</