source: git/Singular/iparith.cc @ 283b70

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