source: git/Singular/iparith.cc @ 9b2407

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