source: git/Singular/iparith.cc @ 6993c83

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